dplyr: how to keep a column in a tibble using count() - r

I have
>head(p)
study treatment response
1 14 SSA 3
2 1 SSTR 4
3 14 SSA 3
4 6 SSTR 3
5 10 SSA 4
I want to count the response for each study and subsequently add bind_rows to obtain response for all.
Thus, I have
p %>% as_tibble() %>%
mutate(nystudie=as.character(study),
best.resp =as.factor(response)) %>%
bind_rows(., mutate(., nystudie="All")) %>%
count(nystudie, best.resp)
Yielding
# A tibble: 27 x 3
nystudie best.resp n
<chr> <fct> <int>
1 1 3 2
2 1 4 3
3 10 4 2
4 11 3 1
However, I want to do a facet_wrap in ggplot using this tibblestratified for p$treatment, ala + facet_wrap(., treatment) + ...
Therefore, I am seeking help on how to optimize my script so the expected output gives something like:
# A tibble: 27 x 3
nystudie best.resp n treatment
<chr> <fct> <int> <fct>
1 1 3 2 "SSTR"
2 1 4 3 "SSTR"
3 10 4 2 "SSTR"
4 11 3 1 "SSA"
Data
p <- structure(list(study = structure(c(13L, 2L, 1L, 4L, 4L, 8L, 1L,
3L, 1L, 4L, 12L, 1L, 13L, 1L, 8L, 1L, 6L, 4L, 9L, 13L, 14L, 1L,
8L, 12L, 5L, 11L, 13L, 8L, 4L, 8L, 9L, 4L, 11L, 1L, 4L, 9L, 4L,
15L, 11L, 9L, 12L, 2L, 11L, 6L, 12L, 12L, 8L, 10L, 4L, 2L), .Label = c("1",
"2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13",
"14", "15", "22"), class = "factor"), treatment = structure(c(2L,
1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L,
1L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 2L,
1L, 1L, 2L, 1L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 2L, 1L,
1L), .Label = c("SSTR", "SSA"), class = "factor"), response = c("1",
"3", "4", "3", "3", "3", "3", "3", "3", "3", "4", "4", "4", "3",
"2", "4", "4", "4", "4", "4", "4", "4", "1", "3", "3", "4", "4",
"1", "4", "1", "4", "4", "4", "3", "3", "2", "3", "4", "4", "2",
"3", "3", "3", "4", "3", "4", "2", "4", "4", "3")), row.names = c(NA,
-50L), class = "data.frame")

Try this:
#Code
p %>%
mutate(nystudie=as.character(study),
best.resp =as.factor(response)) %>%
bind_rows(., mutate(., nystudie="All")) %>%
group_by(nystudie,best.resp) %>%
summarise(N=n(),Val=unique(treatment))
Output:
# A tibble: 28 x 4
# Groups: nystudie, best.resp [26]
nystudie best.resp N Val
<chr> <fct> <int> <fct>
1 1 3 4 SSTR
2 1 4 4 SSTR
3 10 4 1 SSA
4 11 3 1 SSA
5 11 4 3 SSA
6 12 3 3 SSA
7 12 4 2 SSA
8 13 1 1 SSA
9 13 4 3 SSA
10 14 4 1 SSA
# ... with 18 more rows

Related

How to compare a data frame with another data frame?

I've got a Data Frame (df) with 4 Columns and n rows
df <- structure(list(x = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L,
11L, 12L, 13L, 1L, 2L), y = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 2L, 2L), pch = c(9L, 10L, 11L, 7L, 12L, 9L,
7L, 5L, 8L, 1L, 8L, 2L, 5L, 8L, 5L), col = c(7L, 8L, 3L, 3L,
4L, 6L, 3L, 4L, 2L, 1L, 7L, 5L, 4L, 7L, 6L)), class = "data.frame", row.names = c("1",
"2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13",
"14", "15"))
x y pch col
1 1 1 9 7
2 2 1 10 8
3 3 1 11 3
4 4 1 7 3
5 5 1 12 4
6 6 1 9 6
7 7 1 7 3
8 8 1 5 4
9 9 1 8 2
10 10 1 1 1
11 11 1 8 7
12 12 1 2 5
13 13 1 5 4
14 1 2 8 7
15 2 2 5 6
and I want to compare the X and Y with another Data Frame 1x1 (df2)
df2 <- structure(list(V1 = 7, V2 = 1), class = "data.frame", row.names = c(NA,
-1L))
V1 V2
1 7 1
and if it is the same I want to take the entry( in this case number 7) to draw it into my grid with the pch and col which are written in the first Data Frame.
My attempt was compare it with a if loop but I don't know how to get the right column from the first Data frame. In this case x = 7 y = 1 pch = 7 and col = 3
if(input$V1 == playfield$x && input$V2 == playfield$y)
{
}
Appreciate every help or idea.
You can just do:
new_df <- playfield[playfield$x == input$V1 & playfield$y == input$V2,]
You could use right_join from dplyr
library(dplyr)
right_join(df, df2, by=c("x"="V1", "y"="V2"))
output:
x y pch col
1 7 1 7 3
data:
df <- structure(list(x = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L,
11L, 12L, 13L, 1L, 2L), y = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 2L, 2L), pch = c(9L, 10L, 11L, 7L, 12L, 9L,
7L, 5L, 8L, 1L, 8L, 2L, 5L, 8L, 5L), col = c(7L, 8L, 3L, 3L,
4L, 6L, 3L, 4L, 2L, 1L, 7L, 5L, 4L, 7L, 6L)), class = "data.frame", row.names = c("1",
"2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13",
"14", "15"))
df2 <- structure(list(V1 = 7, V2 = 1), class = "data.frame", row.names = c(NA,
-1L))

Transform the frequency count data frame of categories columns in R

I've used the following code to create a frequency count.
df %>% group_by(INCOME, HAPPY) %>% summarise(count=n())
Output:
INCOME HAPPY count
<int> <int> <int>
1 1 1 6
2 1 2 17
3 1 3 13
4 1 8 1
5 2 1 5
6 2 2 11
7 2 3 12
8 2 8 0
9 3 1 4
10 3 2 10
11 3 3 5
12 3 8 0
Yet, I would like to have the following frequency format.
1 2 3
1 6 5 4
2 17 11 10
3 13 12 5
8 1 0 0
Using xtabs from base R
xtabs(count ~ HAPPY + INCOME, df1)
INCOME
HAPPY 1 2 3
1 6 5 4
2 17 11 10
3 13 12 5
8 1 0 0
data
df1 <- structure(list(INCOME = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L,
3L, 3L, 3L), HAPPY = c(1L, 2L, 3L, 8L, 1L, 2L, 3L, 8L, 1L, 2L,
3L, 8L), count = c(6L, 17L, 13L, 1L, 5L, 11L, 12L, 0L, 4L, 10L,
5L, 0L)), class = "data.frame", row.names = c("1", "2", "3",
"4", "5", "6", "7", "8", "9", "10", "11", "12"))
After your code: df %>% group_by(INCOME, HAPPY) %>% summarise(count=n())
You could use this code to achieve your task:
library(dplyr)
library(tidyr)
library(tibble)
df %>%
mutate(group_id = as.integer(gl(n(), 4, n()))) %>%
pivot_wider(
HAPPY,
names_from = group_id,
values_from = count
) %>%
column_to_rownames("HAPPY")
1 2 3
1 6 5 4
2 17 11 10
3 13 12 5
8 1 0 0
data:
structure(list(INCOME = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L,
3L, 3L, 3L), HAPPY = c(1L, 2L, 3L, 8L, 1L, 2L, 3L, 8L, 1L, 2L,
3L, 8L), count = c(6L, 17L, 13L, 1L, 5L, 11L, 12L, 0L, 4L, 10L,
5L, 0L)), class = "data.frame", row.names = c("1", "2", "3",
"4", "5", "6", "7", "8", "9", "10", "11", "12"))
I think this can be simplified to -
library(dplyr)
library(tidyr)
df %>%
count(INCOME, HAPPY) %>%
pivot_wider(names_from = INCOME, values_from = n)

ggplot: geom_text does not center-align above geom_col()

Please find my data p below. I had to include 100 samples to reproduce the error.
Question: why is geom_text not printing consistently center-aligned above the geom_col - e.g. 21 and 28 in All in the right SSA-facet? I tried adjusting position.dodge2 and vjust, but that did not work.
This thread addressed the issue but did not solve my problem.
My script
ggplot(p %>%
mutate(nystudie=as.character(study),
best.resp =as.factor(response)) %>%
group_by(nystudie,best.resp) %>%
summarise(N=n(),Val=unique(treatment)) %>%
bind_rows(p %>% filter(response %in% 1:4, treatment!="Control") %>% droplevels() %>%
mutate(nystudie=as.character(study),
best.resp =as.factor(response)) %>%
group_by(best.resp,treatment) %>% summarise(N=n()) %>%
mutate(nystudie="All") %>%
rename(Val=treatment)),
aes(nystudie, N, color = best.resp, fill= best.resp)) +
geom_col(position = position_dodge2(preserve = "single", padding = 0.1)) +
facet_wrap(~Val,ncol = 2, scales="free") +
scale_fill_grey(name="") +
scale_color_grey(name="") +
scale_y_continuous(breaks = seq(0,120,20)) +
geom_text(aes(label=N),position = position_dodge2(.5), vjust=0, fontface=2, cex=4.5, show.legend = F) +
theme(strip.background = element_blank(),
strip.text = element_text(color = "black", size = 15),
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1),
plot.margin = unit(c(1,3,1,1), "lines"))
Data
p <- structure(list(study = structure(c(8L, 12L, 12L, 12L, 4L, 4L,
1L, 11L, 11L, 13L, 1L, 13L, 14L, 9L, 9L, 10L, 12L, 11L, 4L, 11L,
11L, 12L, 8L, 11L, 13L, 11L, 6L, 15L, 6L, 4L, 7L, 13L, 11L, 4L,
1L, 6L, 1L, 11L, 16L, 1L, 10L, 15L, 1L, 11L, 1L, 6L, 1L, 11L,
12L, 11L, 13L, 16L, 1L, 8L, 11L, 10L, 4L, 4L, 12L, 10L, 6L, 15L,
12L, 14L, 12L, 1L, 1L, 16L, 12L, 12L, 8L, 7L, 1L, 1L, 13L, 13L,
14L, 9L, 14L, 2L, 11L, 4L, 1L, 16L, 15L, 11L, 9L, 4L, 13L, 12L,
6L, 16L, 4L, 1L, 15L, 6L, 4L, 1L, 9L, 2L), .Label = c("1", "2",
"3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14",
"15", "22"), class = "factor"), response = c("1", "3", "4", "4",
"3", "3", "3", "4", "4", "4", "4", "4", "3", "4", "4", "4", "3",
"4", "4", "4", "4", "3", "1", "4", "4", "4", "3", "4", "3", "3",
"4", "4", "4", "3", "4", "4", "4", "4", "4", "3", "4", "4", "3",
"4", "4", "3", "3", "4", "3", "4", "4", "4", "4", "3", "3", "4",
"4", "3", "3", "4", "3", "4", "4", "4", "3", "3", "4", "4", "4",
"4", "2", "4", "4", "4", "4", "4", "3", "4", "3", "3", "4", "4",
"4", "4", "4", "4", "3", "3", "4", "4", "3", "4", "4", "4", "4",
"3", "3", "4", "2", "3"), treatment = structure(c(2L, 2L, 2L,
2L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 1L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 1L, 1L,
1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
1L, 1L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L,
1L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 1L,
1L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 2L,
1L), .Label = c("SSTR", "SSA"), class = "factor")), row.names = c(NA,
-100L), class = "data.frame")
When adding labels you have to take care to use the same positioning as for geom_col. To align the labels with the bars use position_dodge2(preserve = "single", width = .9, padding = 0.1):
library(ggplot2)
library(dplyr)
d1 <- p %>%
mutate(
nystudie = as.character(study),
best.resp = as.factor(response)
) %>%
group_by(nystudie, best.resp) %>%
summarise(N = n(), Val = unique(treatment))
#> `summarise()` regrouping output by 'nystudie' (override with `.groups` argument)
d2 <- p %>%
filter(response %in% 1:4, treatment != "Control") %>%
droplevels() %>%
mutate(
nystudie = as.character(study),
best.resp = as.factor(response)
) %>%
group_by(best.resp, treatment) %>%
summarise(N = n()) %>%
mutate(nystudie = "All") %>%
rename(Val = treatment)
#> `summarise()` regrouping output by 'best.resp' (override with `.groups` argument)
d <- bind_rows(d1, d2)
ggplot(d, aes(nystudie, N, color = best.resp, fill = best.resp)) +
geom_col(position = position_dodge2(preserve = "single", padding = 0.1)) +
facet_wrap(~Val, ncol = 2, scales = "free") +
scale_fill_grey(name = "") +
scale_color_grey(name = "") +
scale_y_continuous(breaks = seq(0, 120, 20)) +
geom_text(aes(label = N), position = position_dodge2(preserve = "single", width = .9, padding = 0.1), vjust = 0, fontface = 2, cex = 4.5, show.legend = F) +
theme(
strip.background = element_blank(),
strip.text = element_text(color = "black", size = 15),
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
plot.margin = unit(c(1, 3, 1, 1), "lines")
)

How to "back" melt function from reshape2 package?

That's my data:
> head(data)
id C1 C2 C3 B1 B2 B3 Name
12 3 12 8 1 3 12 Agar
14 4 11 9 5 12 14 LB
18 7 17 6 7 14 16 YEF
20 9 15 4 3 11 17 KAN
so I used a melt function from reshape2 package to reorganize my data. Now it looks like that:
dt <- melt(data, measure.vars=2:7)
> head(dt)
n v variable value rt
1 id Name p C1 1
2 12 Agar p 3 2
3 14 LB p 4 3
4 18 YEF p 7 6
5 20 KAN p 9 3
6 id Name u C2 1
I did some calculations on my data and now there is an extra column. Let's call it "rt". I'd like to transform my data now to the previous "state" with this an extra column. Do you know any function which would be useful ?
dput(dt)
structure(list(n = structure(c(5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L,
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L,
4L, 5L, 1L, 2L, 3L, 4L), class = "factor", .Label = c("12", "14",
"18", "20", "id")), v = structure(c(4L, 1L, 3L, 5L, 2L, 4L, 1L,
3L, 5L, 2L, 4L, 1L, 3L, 5L, 2L, 4L, 1L, 3L, 5L, 2L, 4L, 1L, 3L,
5L, 2L, 4L, 1L, 3L, 5L, 2L), class = "factor", .Label = c("Agar",
"KAN", "LB", "Name", "YEF")), variable = structure(c(1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L,
4L, 4L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L), .Label = c("p",
"u", "k", "l", "t", "h"), class = "factor"), value = c("C1",
"3", "4", "7", "9", "C2", "12", "11", "17", "15", "C3", "8",
"9", "6", "4", "B1", "1", "5", "7", "3", "B2", "3", "12", "14",
"11", "B3", "12", "14", "16", "17")), .Names = c("n", "v", "variable",
"value"), row.names = c(NA, -30L), class = "data.frame")
In the "reshape2" universe, melt and *cast go hand-in-hand.
Here's an example of melting a data.frame and dcasting it back to its original form. You would need to take a similar approach with your data.
mydf <- data.frame(A = LETTERS[1:3], B = 1:3, C = 4:6)
mydf
# A B C
# 1 A 1 4
# 2 B 2 5
# 3 C 3 6
library(reshape2)
mDF <- melt(mydf, id.vars="A")
mDF
dcast(mDF, A ~ variable, value.var="value")
# A B C
# 1 A 1 4
# 2 B 2 5
# 3 C 3 6
In the dcast step, think of the items before the ~ as being the "id" variables, and those coming after as being the resulting column names. value.var should be the column from which the values will fill in the resulting "grid" created by the id variables and column names.

Wrapping base R reshape for ease-of-use

It is a truth universally acknowledged that R's base reshape command is speedy and powerful but has miserable syntax. I have therefore written a quick wrapper around it which I will throw into the next release of the taRifx package. Before I did that, however, I want to solicit improvements.
Here's my version, with updates from #RichieCotton:
# reshapeasy: Version of reshape with way, way better syntax
# Written with the help of the StackOverflow R community
# x is a data.frame to be reshaped
# direction is "wide" or "long"
# vars are the names of the (stubs of) the variables to be reshaped (if omitted, defaults to everything not in id or vary)
# id are the names of the variables that identify unique observations
# vary is the variable that varies. Going to wide this variable will cease to exist. Going to long it will be created.
# omit is a vector of characters which are to be omitted if found at the end of variable names (e.g. price_1 becomes price in long)
# ... are options to be passed to stats::reshape
reshapeasy <- function( data, direction, id=(sapply(data,is.factor) | sapply(data,is.character)), vary=sapply(data,is.numeric), omit=c("_","."), vars=NULL, ... ) {
if(direction=="wide") data <- stats::reshape( data=data, direction=direction, idvar=id, timevar=vary, ... )
if(direction=="long") {
varying <- which(!(colnames(data) %in% id))
data <- stats::reshape( data=data, direction=direction, idvar=id, varying=varying, timevar=vary, ... )
}
colnames(data) <- gsub( paste("[",paste(omit,collapse="",sep=""),"]$",sep=""), "", colnames(data) )
return(data)
}
Note that you can move from wide to long without changing the options other than the direction. To me, this is the key to usability.
I'm happy to give acknowledgement in the function help files for any substantial improvements if you chat or e-mail me your info.
Improvements might fall in the following areas:
Naming the function and its arguments
Making it more general (currently it handles a fairly specific case, which I believe to be by far the most common, but it has not yet exhausted the capabilities of stats::reshape)
Code improvements
Examples
Sample data
x.wide <- structure(list(surveyNum = 1:6, pio_1 = structure(c(2L, 2L, 1L,
2L, 1L, 1L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), pio_2 = structure(c(2L, 1L, 2L, 1L,
2L, 2L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), pio_3 = structure(c(2L, 2L, 1L, 1L,
2L, 1L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), caremgmt_1 = structure(c(2L, 1L, 1L,
2L, 1L, 2L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), caremgmt_2 = structure(c(1L, 2L, 2L,
2L, 2L, 1L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), caremgmt_3 = structure(c(1L, 2L, 1L,
2L, 1L, 1L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), prev_1 = structure(c(1L, 2L, 2L, 1L,
1L, 2L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), prev_2 = structure(c(2L, 2L, 1L, 2L,
1L, 1L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), prev_3 = structure(c(2L, 1L, 2L, 2L,
1L, 1L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2"), class = "factor"), price_1 = structure(c(2L, 1L, 2L, 5L,
3L, 4L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2", "3", "4", "5", "6"), class = "factor"), price_2 = structure(c(6L,
5L, 5L, 4L, 4L, 2L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2", "3", "4", "5", "6"), class = "factor"), price_3 = structure(c(3L,
5L, 2L, 5L, 4L, 5L), .Names = c("1", "2", "3", "4", "5", "6"), .Label = c("1",
"2", "3", "4", "5", "6"), class = "factor")), .Names = c("surveyNum",
"pio_1", "pio_2", "pio_3", "caremgmt_1", "caremgmt_2", "caremgmt_3",
"prev_1", "prev_2", "prev_3", "price_1", "price_2", "price_3"
), idvars = "surveyNum", rdimnames = list(structure(list(surveyNum = 1:24), .Names = "surveyNum", row.names = c("1",
"2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13",
"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24"
), class = "data.frame"), structure(list(variable = structure(c(1L,
1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L), .Label = c("pio",
"caremgmt", "prev", "price"), class = "factor"), .id = c(1L,
2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L)), .Names = c("variable",
".id"), row.names = c("pio_1", "pio_2", "pio_3", "caremgmt_1",
"caremgmt_2", "caremgmt_3", "prev_1", "prev_2", "prev_3", "price_1",
"price_2", "price_3"), class = "data.frame")), row.names = c(NA,
6L), class = c("cast_df", "data.frame"))
x.long <- structure(list(.id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), pio = structure(c(2L,
2L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 2L, 1L,
2L, 1L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L,
1L, 2L, 1L, 2L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 1L, 2L,
1L, 2L, 2L, 1L, 2L, 1L, 1L), .Label = c("1", "2"), class = "factor"),
caremgmt = structure(c(2L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 1L,
2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 2L,
1L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 2L, 1L,
1L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 1L,
1L, 2L, 2L), .Label = c("1", "2"), class = "factor"), prev = structure(c(1L,
2L, 2L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 1L, 1L,
1L, 2L, 2L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 1L, 1L,
2L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 1L,
2L, 2L, 2L, 2L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 2L,
1L, 2L, 1L, 1L, 1L, 2L, 2L, 1L, 2L, 2L, 2L), .Label = c("1",
"2"), class = "factor"), price = structure(c(2L, 1L, 2L,
5L, 3L, 4L, 1L, 5L, 4L, 3L, 1L, 2L, 6L, 6L, 5L, 4L, 6L, 3L,
5L, 6L, 3L, 1L, 2L, 4L, 3L, 5L, 2L, 5L, 4L, 5L, 6L, 6L, 4L,
6L, 4L, 1L, 2L, 3L, 1L, 2L, 2L, 5L, 1L, 6L, 1L, 3L, 4L, 3L,
6L, 5L, 5L, 4L, 4L, 2L, 2L, 2L, 6L, 3L, 1L, 4L, 4L, 5L, 1L,
3L, 6L, 1L, 3L, 5L, 1L, 3L, 6L, 2L), .Label = c("1", "2",
"3", "4", "5", "6"), class = "factor"), surveyNum = c(1L,
2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L,
15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 1L, 2L,
3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L,
16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 1L, 2L, 3L,
4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L,
17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L)), .Names = c(".id",
"pio", "caremgmt", "prev", "price", "surveyNum"), row.names = c(NA,
-72L), class = "data.frame")
Examples
> x.wide
surveyNum pio_1 pio_2 pio_3 caremgmt_1 caremgmt_2 caremgmt_3 prev_1 prev_2 prev_3 price_1 price_2 price_3
1 1 2 2 2 2 1 1 1 2 2 2 6 3
2 2 2 1 2 1 2 2 2 2 1 1 5 5
3 3 1 2 1 1 2 1 2 1 2 2 5 2
4 4 2 1 1 2 2 2 1 2 2 5 4 5
5 5 1 2 2 1 2 1 1 1 1 3 4 4
6 6 1 2 1 2 1 1 2 1 1 4 2 5
> reshapeasy( x.wide, "long", NULL, id="surveyNum", vary="id", sep="_" )
surveyNum id pio caremgmt prev price
1.1 1 1 2 2 1 2
2.1 2 1 2 1 2 1
3.1 3 1 1 1 2 2
4.1 4 1 2 2 1 5
5.1 5 1 1 1 1 3
6.1 6 1 1 2 2 4
1.2 1 2 2 1 2 6
2.2 2 2 1 2 2 5
3.2 3 2 2 2 1 5
4.2 4 2 1 2 2 4
5.2 5 2 2 2 1 4
6.2 6 2 2 1 1 2
1.3 1 3 2 1 2 3
2.3 2 3 2 2 1 5
3.3 3 3 1 1 2 2
4.3 4 3 1 2 2 5
5.3 5 3 2 1 1 4
6.3 6 3 1 1 1 5
> head(x.long)
.id pio caremgmt prev price surveyNum
1 1 2 2 1 2 1
2 1 2 1 2 1 2
3 1 1 1 2 2 3
4 1 2 2 1 5 4
5 1 1 1 1 3 5
6 1 1 2 2 4 6
> head(reshapeasy( x.long, direction="wide", id="surveyNum", vary=".id" ))
surveyNum pio.1 caremgmt.1 prev.1 price.1 pio.3 caremgmt.3 prev.3 price.3 pio.2 caremgmt.2 prev.2 price.2
1 1 2 2 1 2 2 1 2 3 2 1 2 6
2 2 2 1 2 1 2 2 1 5 1 2 2 5
3 3 1 1 2 2 1 1 2 2 2 2 1 5
4 4 2 2 1 5 1 2 2 5 1 2 2 4
5 5 1 1 1 3 2 1 1 4 2 2 1 4
6 6 1 2 2 4 1 1 1 5 2 1 1 2
I would also like to see an option to order the output, since that's one of the things I don't like about reshape in base R. As an example, let's use the Stata Learning Module: Reshaping data wide to long, which you are already familiar with. The example I'm looking at is the "kids height and weight at age 1 and age 2" example.
Here's what I normally do with reshape():
# library(foreign)
kidshtwt = read.dta("http://www.ats.ucla.edu/stat/stata/modules/kidshtwt.dta")
kidshtwt.l = reshape(kidshtwt, direction="long", idvar=1:2,
varying=3:6, sep="", timevar="age")
# The reshaped data is correct, just not in the order I want it
# so I always have to do another step like this
kidshtwt.l = kidshtwt.l[order(kidshtwt.l$famid, kidshtwt.l$birth),]
Since this is an annoying step that I always have to go through when reshaping the data, I think it would be useful to add that into your function.
I also suggest at least having an option for doing the same thing with the final column order for reshaping from long to wide.
Example function for column ordering
I'm not sure of the best way to integrate this into your function, but I put this together to sort a data frame based on basic patterns for the variable names.
col.name.sort = function(data, patterns) {
a = names(data)
b = length(patterns)
subs = vector("list", b)
for (i in 1:b) {
subs[[i]] = sort(grep(patterns[i], a, value=T))
}
x = unlist(subs)
data[ , x ]
}
It can be used in the following manner. Imagine we had saved the output of your reshapeasy long to wide example as a data frame named a, and we wanted it ordered by "surveyNum", "caremgmt" (1-3), "prev" (1-3), "pio" (1-3), and "price" (1-3), we could use:
col.name.sort(a, c("sur", "car", "pre", "pio", "pri"))
Some initial thoughts:
I've always thought that the direction commands "wide" and "long" were a little fuzzy. Do they mean you want to convert the data to that format, or that the data is already in that format? It is something that you need to learn or look up. You can avoid that problem by having to separate functions reshapeToWide and reshapeToLong. As a bonus, the signature of each function has one less argument.
I don't think you meant to include the line
varying <- which(!(colnames(x.wide) %in% "surveyNum"))
since it refers to a specific dataset.
I prefer data to x for the first argument since it makes it clear that the input should be a data frame.
It is generally better form to have arguments without defaults first. So vars should come after id and vary.
Can you pick defaults for id and vary? reshape::melt defaults to factor and character columns for id and numeric columns for vary.
I think there might be a mistake in your example. For going from wide to long, I get the following error:
> reshapeasy( x.wide, "long", NULL, id="surveyNum", vary="id", sep="_" )
Error in gsub(paste("[", paste(omit, collapse = "", sep = ""), "]$", sep = ""), :
invalid regular expression '[]$', reason 'Missing ']''
Removing the NULL corrects the problem. Which leads me to ask, what is the intended purpose of that NULL?
I also think that the function would be improved if it generated a time variable by default, if not explicitly specified by the user (as is done in reshape()).
See, for instance, the following from base reshpae():
> head(reshape(x.wide, direction="long", idvar=1, varying=2:13, sep="_"))
surveyNum time pio caremgmt prev price
1.1 1 1 2 2 1 2
2.1 2 1 2 1 2 1
3.1 3 1 1 1 2 2
4.1 4 1 2 2 1 5
5.1 5 1 1 1 1 3
6.1 6 1 1 2 2 4
If I'm familiar with this, and I see that your function takes care of "varying" for me, I might be tempted to try:
> head(reshapeasy( x.wide, "long", id="surveyNum", sep="_" ))
Error in `row.names<-.data.frame`(`*tmp*`, value = paste(d[, idvar], times[1L], :
duplicate 'row.names' are not allowed
In addition: Warning message:
non-unique value when setting 'row.names': ‘1.1’
But that's not a very useful error. Perhaps including a custom error message might be useful for your final function.
Allowing the user to set vary to NULL, as you have done in your present version of the function, also doesn't seem wise to me. This yields output like this:
> head(reshapeasy( x.wide, "long", id="surveyNum", NULL, sep="_" ))
surveyNum pio caremgmt prev price
1.1 1 2 2 1 2
2.1 2 2 1 2 1
3.1 3 1 1 2 2
4.1 4 2 2 1 5
5.1 5 1 1 1 3
6.1 6 1 2 2 4
The problem with this output is that if I needed to reshape back to wide, I can't do it easily. Thus, I think that retaining reshape's default option of generating a time variable, but letting the user override that might be a useful feature.
Perhaps for those who are lazy and don't like to type the variable names, you can add the following to the head of your function:
if (is.numeric(id) == 1) {
id = colnames(data)[id]
} else if (is.numeric(id) == 0) {
id = id
}
if (is.numeric(vary) == 1) {
vary = colnames(data)[vary]
} else if (is.numeric(vary) == 0) {
vary = vary
}
Then, following with your examples, you can use the following shorthand:
reshapeasy(x.wide, direction="long", id=1, sep="_", vary="id")
reshapeasy(x.long, direction="wide", id=6, vary=1)
(I know, it might not be good practice since the code might be less readable or less easily understandable by someone later on, but it does happen frequently.)

Resources