Related
This question already has answers here:
Reshaping data.frame from wide to long format
(8 answers)
Closed 12 months ago.
My data look like this:
dput(srkw.dat)
structure(list(year = c(1962L, 1976L, 1981L, 1981L, 1982L,
1987L, 1989L, 1990L, 1992L, 1992L, 1992L, 1994L, 1998L, 2003L,
2003L, 2003L, 2003L, 2004L, 2004L, 2004L, 2005L, 2005L, 2005L,
2005L, 2005L, 2005L, 2005L, 2005L, 2005L, 2005L, 2006L, 2006L,
2006L, 2006L, 2006L, 2006L, 2007L, 2007L, 2007L, 2008L, 2008L,
2008L, 2009L, 2009L, 2009L, 2010L, 2010L, 2010L, 2011L, 2011L,
2013L, 2013L, 2013L, 2014L, 2014L, 2014L, 2014L, 2014L, 2015L,
2015L, 2015L, 2015L, 2015L, 2016L, 2016L, 2016L, 2016L, 2016L,
2016L, 2017L, 2018L, 2018L, 2018L, 2019L, 2020L, 2020L, 2020L,
2020L), whaleid1 = c("Lx", "Lx", "Lx", "Lx", "Lx", "L5",
"Lx", "Kx", "L5", "Lx", "L21", "L5", "Lx", "Jx", "L5", "L7",
"Jx", "L21", "L54", "Lx", "Jx", "J27", "J16", "J11", "Jx",
"L5", "L5", "J30", "L95", "Lx", "Jx", "J35", "K40", "Lx",
"L12", "Jx", "L106", "L21", "Kx", "L83", "L83", "L57", "J31",
"J27", "J30", "L55", "L22", "K36", "Jx", "L72", "K21", NA,
"K16", "J16", "J35", "L72", "J36", "L22", "K22", "K22", "L77",
"J47", "Jx", "J40", "L119", "J2", "J35", "L103", "L77", "L87",
"J39", "J22", "J38", "L115", "J31", NA, "J37", "Lx"), whalesex1 = c(NA,
0L, NA, NA, 0L, 0L, NA, NA, 0L, 0L, 0L, 0L, 1L, NA, 0L, 0L,
NA, 0L, 0L, NA, NA, 1L, 0L, 0L, NA, 0L, 0L, 1L, 1L, NA, NA,
0L, 0L, NA, 0L, NA, 1L, 0L, NA, 0L, 0L, 1L, 0L, 1L, 1L, 0L,
0L, 0L, NA, 0L, 1L, NA, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
1L, NA, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 1L, 1L, 0L, NA,
0L, NA), whaleage1 = c(NA, NA, NA, NA, NA, 23L, NA, NA, 28L,
NA, 42L, 30L, NA, NA, 39L, 42L, NA, 54L, 27L, NA, NA, 14L,
33L, 33L, NA, 41L, 41L, 10L, 9L, NA, NA, 8L, 43L, NA, 73L,
NA, 2L, 57L, NA, 18L, 18L, 31L, 14L, 18L, 14L, 33L, 39L,
7L, NA, 25L, 27L, NA, 28L, 42L, 16L, 28L, 15L, 43L, 28L,
28L, 28L, 5L, NA, 12L, 4L, 60L, 18L, 13L, 29L, 24L, 15L,
23L, 15L, 9L, 25L, NA, 19L, NA), whaleid2 = c("Lx", "Lx",
"Lx", "Lx", "Lx", "L58", "Lx", "Kx", "L58", "Lx", "Lx", "L58",
NA, "Jx", "L73", "L57", "Jx", "L47", "L100", "Lx", NA, "J31",
"J26", "J27", "Jx", "L73", "L73", "J31", "L72", "Lx", "Jx",
"J37", "K16", "Lx", "L41", NA, "L41", "L26", NA, "L110",
"L110", NA, "J36", "J31", "Kx", NA, "L94", "K42", NA, "Kx",
"K25", NA, NA, "J26", "J47", "L105", "J41", "L94", NA, "K33",
"L119", NA, NA, NA, NA, NA, "J47", "L109", "L119", "Jx",
NA, "J40", NA, NA, "J56", NA, "Jx", "Lx"), whalesex2 = c(NA,
NA, NA, NA, NA, 1L, NA, NA, 1L, 0L, NA, 1L, NA, NA, 1L, 1L,
NA, 0L, 1L, NA, NA, 0L, 1L, 1L, NA, 1L, 1L, 0L, 0L, NA, NA,
0L, 0L, NA, 1L, NA, 1L, 0L, NA, 1L, 1L, NA, 0L, 0L, NA, NA,
0L, 1L, NA, NA, 1L, NA, NA, 1L, 1L, 1L, 0L, 0L, NA, 1L, 0L,
NA, NA, NA, NA, NA, 1L, 1L, 0L, NA, NA, 0L, NA, NA, 0L, NA,
NA, NA), whaleage2 = c(NA, NA, NA, NA, NA, 7L, NA, NA, 12L,
NA, NA, 14L, NA, NA, 17L, 26L, NA, 30L, 3L, NA, NA, 10L,
14L, 14L, NA, 19L, 19L, 10L, 19L, NA, NA, 5L, 21L, NA, 29L,
NA, 30L, 51L, NA, 1L, 1L, NA, 10L, 14L, NA, NA, 15L, 2L,
NA, NA, 22L, NA, NA, 23L, 4L, 10L, 9L, 19L, NA, 14L, 3L,
NA, NA, NA, NA, NA, 6L, 9L, 4L, NA, NA, 14L, NA, NA, 1L,
NA, NA, NA), whaleid3 = c(NA, NA, NA, NA, "Lx", "L73", "Lx",
"Kx", "L73", "Lx", NA, "L73", NA, "Jx", NA, NA, NA, "Lx",
NA, NA, NA, "Jx", "J36", "J39", NA, "L67", "L67", NA, NA,
NA, NA, "J40", "K35", "Lx", "L77", NA, "L57", "L47", NA,
"L47", "L91", NA, "J39", "J39", NA, NA, "L113", NA, NA, NA,
"K26", NA, NA, "J36", NA, NA, "J42", "L113", NA, NA, NA,
NA, NA, NA, NA, NA, "L87", "L123", "L113", "Jx", NA, "J49",
NA, NA, "J36", NA, NA, "Lx"), whalesex3 = c(NA, NA, NA, NA,
0L, 1L, NA, NA, 1L, NA, NA, 1L, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, 0L, 1L, NA, 0L, 0L, NA, NA, NA, NA, 0L, 1L, NA,
0L, NA, 1L, 0L, NA, 0L, 0L, NA, 1L, 1L, NA, NA, 0L, NA, NA,
NA, 1L, NA, NA, 0L, NA, NA, 0L, 0L, NA, NA, NA, NA, NA, NA,
NA, NA, 1L, 1L, 0L, 0L, NA, 1L, NA, NA, 0L, NA, NA, NA),
whaleage3 = c(NA, NA, NA, NA, NA, 1L, NA, NA, 6L, NA, NA,
8L, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 6L, 2L, NA, 20L,
20L, NA, NA, NA, NA, 2L, 4L, NA, 19L, NA, 30L, 33L, NA, 34L,
13L, NA, 6L, 6L, NA, NA, 1L, NA, NA, NA, 20L, NA, NA, 15L,
NA, NA, 7L, 5L, NA, NA, NA, NA, NA, NA, NA, NA, 24L, 1L,
7L, NA, NA, 6L, NA, NA, 21L, NA, NA, NA), whaleid4 = c(NA,
NA, NA, NA, "Lx", NA, "Lx", "Kx", NA, "Lx", NA, NA, NA, "Jx",
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "L101", "L101",
NA, NA, NA, NA, NA, NA, "Lx", "L94", NA, "L82", "Lx", NA,
"L111", NA, NA, "Kx", NA, NA, NA, NA, NA, NA, NA, "K35",
NA, NA, "J42", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, "Jx", NA, NA, NA, NA, "J47", NA, NA, "Lx"
), whalesex4 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 1L,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
1L, 1L, NA, NA, NA, NA, NA, NA, NA, 0L, NA, 0L, NA, NA, 0L,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1L, NA, NA, 0L, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, 1L, NA, NA, NA), whaleage4 = c(NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, 3L, 3L, NA, NA, NA, NA, NA, NA,
NA, 11L, NA, 17L, NA, NA, 1L, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, 11L, NA, NA, 7L, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 10L,
NA, NA, NA), whaleid5 = c(NA, NA, NA, NA, NA, NA, "Lx", "Kx",
NA, NA, NA, NA, NA, "Jx", NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "L86",
NA, NA, "L91", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, "Jx", NA, NA, NA, NA, "J49", NA, NA, NA), whalesex5 = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, 0L, NA, NA, 0L, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1L, NA,
NA, NA), whaleage5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 16L, NA,
NA, 13L, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, 8L, NA, NA, NA), whaleid6 = c(NA,
NA, NA, NA, NA, NA, "Lx", "Kx", NA, NA, NA, NA, NA, "Jx",
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, "L95", NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "Jx", NA, NA,
NA, NA, NA, NA, NA, NA), whalesex6 = c(NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, 1L, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), whaleage6 = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, 11L, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA), whaleid7 = c(NA, NA, NA, NA, NA, NA, "Lx", "Kx",
NA, NA, NA, NA, NA, "Jx", NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "L77",
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, "Jx", NA, NA, NA, NA, NA, NA, NA, NA), whalesex7 = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, 0L, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA), whaleage7 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 20L, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), whaleid8 = c(NA,
NA, NA, NA, NA, NA, "Lx", "Kx", NA, NA, NA, NA, NA, "Jx",
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, "L94", NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "Jx", NA, NA,
NA, NA, NA, NA, NA, NA), whalesex8 = c(NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, 0L, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), whaleage8 = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, 12L, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA), event.id = 1:78), row.names = c(NA, -78L), class = "data.frame")
I want to use r_bind to group by whale IDs, while ascribing each whale's respective age and sex to its ID. I got this far:
events.by.id =
rbind(
srkw.dat %>%
select(event.id, year, id = whaleid1),
srkw.dat %>%
select(event.id, year, id = whaleid2),
srkw.dat %>%
select(event.id, year, id = whaleid3),
srkw.dat %>%
select(event.id, year, id = whaleid4),
srkw.dat %>%
select(event.id, year, id = whaleid5),
srkw.dat %>%
select(event.id, year, id = whaleid6),
srkw.dat %>%
select(event.id, year, id = whaleid7)
) %>%
filter(!is.na(id))
But I wasn't sure what extra syntax is needed to link each whale's age and sex to its ID?
Additionally, after that is done, is there an elegant way to selectively remove the whale IDs (and their ascribed sexes/ages) that are Jx, Lx, Kx, etc?
Thanks so much!
I think it would help if you get data in long format using pivot_longer with id, sex and age as separate columns. This might be simpler than your attempt.
res <- tidyr::pivot_longer(srkw.dat,
cols = -year,
names_to = c('.value', 'num'),
names_pattern = 'whale(.*?)(\\d+)',
values_drop_na = TRUE)
res
# A tibble: 211 x 5
# year num id sex age
# <int> <chr> <chr> <int> <int>
# 1 1962 1 Lx NA NA
# 2 1962 2 Lx NA NA
# 3 1976 1 Lx 0 NA
# 4 1976 2 Lx NA NA
# 5 1981 1 Lx NA NA
# 6 1981 2 Lx NA NA
# 7 1981 1 Lx NA NA
# 8 1981 2 Lx NA NA
# 9 1982 1 Lx 0 NA
#10 1982 2 Lx NA NA
# … with 201 more rows
It would be easy now to filter data with res. For example, to drop id's c('Jx', 'Lx', 'Kx') you may do -
res %>% filter(!id %in% c('Jx', 'Lx', 'Kx'))
What you want to do is pivot your data. You've actually kind of developed your own version of tidyr::pivot_longer() -- but it's easier with Hadley's version.
To your second question, you can use stringr::str_ends() to filter by ids ending in "x".
library(tidyverse)
srkw.dat_long <- srkw.dat %>%
pivot_longer(
cols = starts_with("whale"),
names_to = c(".value", NA),
names_pattern = "whale(\\D+)(\\d+)"
) %>%
filter(!(is.na(id) | str_ends(id, "x")))
# # A tibble: 132 x 5
# year event.id id sex age
# <int> <int> <chr> <int> <int>
# 1 1987 6 L5 0 23
# 2 1987 6 L58 1 7
# 3 1987 6 L73 1 1
# 4 1992 9 L5 0 28
# 5 1992 9 L58 1 12
# 6 1992 9 L73 1 6
# 7 1992 11 L21 0 42
# 8 1994 12 L5 0 30
# 9 1994 12 L58 1 14
# 10 1994 12 L73 1 8
# # ... with 122 more rows
I am plotting two variables with the following code:
ggplot()+
geom_point(data=subset(afc_reopening, key == "mean_spend_all"),
aes(x=day_after_reopening, y=mean_spend_cases * 100, color = winner2016)) +
stat_smooth(data=subset(afc_reopening,key == "mean_spend_all"),
formula = y~as.numeric(x), se = F,
aes(x=day_after_reopening, y=mean_spend_cases*100, color = winner2016))+
geom_point(data=subset(afc_reopening, key == "new_case_rate_07da"),
aes(x=day_after_reopening, y=mean_spend_cases,),) +
stat_smooth(data=subset(afc_reopening,key == "new_case_rate_07da"),
formula = y~as.numeric(x), se = F,
aes(x=day_after_reopening, y=mean_spend_cases, color = winner2016),)+
facet_wrap(.~deciles_income,scales = 'free')+
theme(legend.position = 'top')+
ylab('Change in consumer spending relative to 14th January and Past 7 Days New Cases Average')+
labs(title = "Change in spending and Past 7 Days New Cases Average in US Counties Grouped by Income Decile") +
scale_x_continuous(limits = c(-100,100))
The code results in the following graph:
The only problem I am having with the graph is that the points for both values are in the same color. I would like to have different color spectrum for spending and for cases (with each still being grouped by the winner of the 2016 election). How do I do this in ggplot?
Here is the output of the dput() function:
structure(list(day_month_year = structure(c(NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 18364, NA, NA, NA, NA,
NA, NA, NA, NA, NA, 18392, NA, NA, NA, NA, NA, NA, NA, 18427,
18392, NA, NA, NA, 18329, NA, 18427, NA, NA, NA, NA, NA, NA,
NA, NA, 18301, NA, NA, NA, NA, NA, NA, 18294, NA, NA, NA, NA,
NA, 18441, NA, NA, NA, 18378, NA, NA, 18420, 18294, NA, NA, NA,
NA), tzone = "Europe/Prague", class = "Date"), deciles_income = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 3L, NA,
NA, NA, NA, NA, NA, NA, NA, NA, 7L, NA, NA, NA, NA, NA, NA, NA,
3L, 5L, NA, NA, NA, 2L, NA, 9L, NA, NA, NA, NA, NA, NA, NA, NA,
5L, NA, NA, NA, NA, NA, NA, 8L, NA, NA, NA, NA, NA, 6L, NA, NA,
NA, 2L, NA, NA, 3L, 9L, NA, NA, NA, NA), winner2016 = c(NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "Donald Trump",
NA, NA, NA, NA, NA, NA, NA, NA, NA, "Hillary Clinton", NA, NA,
NA, NA, NA, NA, NA, "Hillary Clinton", "Hillary Clinton", NA,
NA, NA, "Hillary Clinton", NA, "Donald Trump", NA, NA, NA, NA,
NA, NA, NA, NA, "Hillary Clinton", NA, NA, NA, NA, NA, NA, "Hillary Clinton",
NA, NA, NA, NA, NA, "Hillary Clinton", NA, NA, NA, "Hillary Clinton",
NA, NA, "Donald Trump", NA, NA, NA, NA, NA), key = c(NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "new_case_rate_07da",
NA, NA, NA, NA, NA, NA, NA, NA, NA, "mean_spend_all", NA, NA,
NA, NA, NA, NA, NA, "new_case_rate_07da", "new_case_rate_07da",
NA, NA, NA, "mean_spend_all", NA, "mean_spend_all", NA, NA, NA,
NA, NA, NA, NA, NA, "new_case_rate_07da", NA, NA, NA, NA, NA,
NA, "new_case_rate_07da", NA, NA, NA, NA, NA, "new_case_rate_07da",
NA, NA, NA, "mean_spend_all", NA, NA, "new_case_rate_07da", "new_case_rate_07da",
NA, NA, NA, NA), mean_spend_cases = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, 2.98999975990396, NA, NA,
NA, NA, NA, NA, NA, NA, NA, -0.163540740740741, NA, NA, NA, NA,
NA, NA, NA, 8.37364285714286, 4.66982142857143, NA, NA, NA, -0.0154640434782609,
NA, -0.0665955440414508, NA, NA, NA, NA, NA, NA, NA, NA, 0, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 12.0187207792208,
NA, NA, NA, -0.187623043478261, NA, NA, 7.48311044417767, 0,
NA, NA, NA, NA)), row.names = c(NA, -75L), groups = structure(list(
day_month_year = structure(c(18294, 18294, 18301, 18329,
18364, 18378, 18392, 18392, 18420, 18427, 18427, 18441, NA
), tzone = "Europe/Prague", class = "Date"), deciles_income = c(8L,
9L, 5L, 2L, 3L, 2L, 5L, 7L, 3L, 3L, 9L, 6L, NA), .rows = structure(list(
57L, 71L, 50L, 39L, 16L, 67L, 35L, 26L, 70L, 34L, 41L,
63L, c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L,
12L, 13L, 14L, 15L, 17L, 18L, 19L, 20L, 21L, 22L, 23L,
24L, 25L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 36L, 37L,
38L, 40L, 42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 51L,
52L, 53L, 54L, 55L, 56L, 58L, 59L, 60L, 61L, 62L, 64L,
65L, 66L, 68L, 69L, 72L, 73L, 74L, 75L)), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), row.names = c(NA, 13L), class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"))
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 4 years ago.
Improve this question
I have a data frame like this:
df <- data.frame(stringsAsFactors=FALSE,
member = c(1L, 1L, 2L, 1L, 1L, 1L, 1L, 4L, 3L, 5L),
q_c3_1 = c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A"),
q_c4_1 = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
q_c5_1 = c(1900L, 1900L, 1900L, 1900L, 1900L, 1900L, 1900L, 1900L, 1900L,
1900L),
q_c6_1 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L),
q_c7_1 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L),
q_c3_2 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c4_2 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c5_2 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c6_2 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c7_2 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c3_3 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c4_3 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c5_3 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c6_3 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c7_3 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c3_4 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c4_4 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c5_4 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c6_4 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c7_4 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c3_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c4_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c5_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c6_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA),
q_c7_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)
)
base on member variable, I need to fill corresponding variables with dummy data.For example if member = 2 then q_c3_2:q_c7_2 should have dummy values --> q_c3 = some character like "Arne", q_c4 with 1 and q_c5 with 1900 and q_c6 and q_c7 with 0 , if member == 3 then q_c3_2:q_c7_2 and q_c3_3:q_c7_3 should have dummy values (same as dummy values as above) and so on. How may i do this and efficiently with tidyverse? Thanks
My desire output shall be like this data frame
df2 <- data.frame(stringsAsFactors=FALSE,
member = c(1L, 1L, 2L, 1L, 1L, 1L, 1L, 4L, 3L, 5L),
q_c3_1 = c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A"),
q_c4_1 = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
q_c5_1 = c(1900L, 1900L, 1900L, 1900L, 1900L, 1900L, 1900L, 1900L, 1900L,
1900L),
q_c6_1 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L),
q_c7_1 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L),
q_c3_2 = c(NA, NA, "Arne", NA, NA, NA, NA, "Arne", "Arne", "Arne"),
q_c4_2 = c(NA, NA, 1L, NA, NA, NA, NA, 1L, 1L, 1L),
q_c5_2 = c(NA, NA, 1900L, NA, NA, NA, NA, 1900L, 1900L, 1900L),
q_c6_2 = c(NA, NA, 0L, NA, NA, NA, NA, 0L, 0L, 0L),
q_c7_2 = c(NA, NA, 0L, NA, NA, NA, NA, 0L, 0L, 0L),
q_c3_3 = c(NA, NA, NA, NA, NA, NA, NA, "Arne", "Arne", "Arne"),
q_c4_3 = c(NA, NA, NA, NA, NA, NA, NA, 1L, 1L, 1L),
q_c5_3 = c(NA, NA, NA, NA, NA, NA, NA, 1900L, 1900L, 1900L),
q_c6_3 = c(NA, NA, NA, NA, NA, NA, NA, 0L, 0L, 0L),
q_c7_3 = c(NA, NA, NA, NA, NA, NA, NA, 0L, 0L, 0L),
q_c3_4 = c(NA, NA, NA, NA, NA, NA, NA, "Arne", NA, "Arne"),
q_c4_4 = c(NA, NA, NA, NA, NA, NA, NA, 1L, NA, 1L),
q_c5_4 = c(NA, NA, NA, NA, NA, NA, NA, 1900L, NA, 1900L),
q_c6_4 = c(NA, NA, NA, NA, NA, NA, NA, 0L, NA, 0L),
q_c7_4 = c(NA, NA, NA, NA, NA, NA, NA, 0L, NA, 0L),
q_c3_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, "Arne"),
q_c4_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 1L),
q_c5_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 1900L),
q_c6_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 0L),
q_c7_5 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 0L)
)
With the assumption that it does not matter what the dummy variables are and using dplyr:
library(dplyr)
temp <- df %>%
melt(id.vars = "member") %>%
mutate(compare = as.numeric(gsub("q_c\\d_(\\d)", "\\1", variable))) %>%
filter(compare <= member) %>%
mutate(value = "dummy",
compare = NULL) %>%
unique() %>%
spread(variable, value)
df <- df %>%
select(member) %>%
left_join(., temp, by = "member")
Edit: With dummy variables as requested.
library(dplyr)
temp <- df %>%
melt(id.vars = "member") %>%
mutate(compare = as.numeric(gsub("q_c\\d_(\\d)", "\\1", variable)),
dummy_match = as.numeric(gsub("q_c(\\d)_\\d", "\\1", variable))) %>%
filter(compare <= member) %>%
mutate(value = case_when(dummy_match == 4 ~ 1,
dummy_match == 5 ~ 1900,
dummy_match >= 6 ~ 0,
T ~ 9999),
compare = NULL,
dummy_match = NULL) %>%
unique() %>%
spread(variable, value)
df <- df %>%
select(member) %>%
left_join(., temp, by = "member")
df[df == 9999] <- "Arne"
For the following dataframe:
eu <- structure(list(land = structure(c(1L, 4L, 5L, 12L, 9L, 13L, 16L, 18L, 27L, 10L, 25L, 21L, 28L, 19L, 8L, 26L, 6L, 3L, 15L, 14L, 11L, 17L, 20L, 23L, 24L, 2L, 22L, 7L), .Label = c("Belgie", "Bulgarije", "Cyprus", "Denemarken", "Duitsland", "Estland", "Europese Unie", "Finland", "Frankrijk", "Griekenland", "Hongarije", "Ierland", "Italie", "Letland", "Litouwen", "Luxemburg", "Malta", "Nederland", "Oostenrijk", "Polen", "Portugal", "Roemenie", "Slovenie", "Slowakije", "Spanje", "Tsjechie", "Verenigd Koninkrijk", "Zweden"), class = "factor"), `1979` = c(91.36, 47.82, 65.73, 63.61, 60.71, 85.65, 88.91, 58.12, 32.35, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 61.99), `1981` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 81.48, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `1984` = c(92.09, 52.38, 56.76, 47.56, 56.72, 82.47, 88.79, 50.88, 32.57, 80.59, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 58.98), `1987` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 68.52, 72.42, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `1989` = c(90.73, 46.17, 62.28, 68.28, 48.8, 81.07, 87.39, 47.48, 36.37, 80.03, 54.71, 51.1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 58.41), `1994` = c(90.66, 52.92, 60.02, 43.98, 52.71, 73.6, 88.55, 35.69, 36.43, 73.18, 59.14, 35.54, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 56.67), `1995` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 41.63, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `1996` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 67.73, 57.6, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `1999` = c(91.05, 50.46, 45.19, 50.21, 46.76, 69.76, 87.27, 30.02, 24, 70.25, 63.05, 39.93, 38.84, 49.4, 30.14, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 49.51), `2004` = c(90.81, 47.89, 43, 58.58, 42.76, 71.72, 91.35, 39.26, 38.52, 63.22, 45.14, 38.6, 37.85, 42.43, 39.43, 28.3, 26.83, 72.5, 48.38, 41.34, 38.5, 82.39, 20.87, 28.35, 16.97, NA, NA, 45.47), `2007` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 29.22, 29.47, NA), `2009` = c(90.39, 59.54, 43.3, 58.64, 40.63, 65.05, 90.75, 36.75, 34.7, 52.61, 44.9, 36.78, 45.53, 45.97, 40.3, 28.2, 43.9, 59.4, 20.98, 53.7, 36.31, 78.79, 24.53, 28.33, 19.64, 38.99, 27.67, 43), inwoners = c(11161642, 5602628, 80523746, 4591087, 65578819, 59685227, 537039, 16779575, 63896071, 11062508, 46727890, 10487289, 9555893, 8451860, 5426674, 10516125, 1320174, 865878, 2971905, 2023825, 9908798, 421364, 38533299, 2058821, 5410836, 7284552, 20020074, 501403599), plicht = structure(c(1L, 2L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("ja", "nee"), class = "factor")), .Names = c("land", "1979", "1981", "1984", "1987", "1989", "1994", "1995", "1996", "1999", "2004", "2007", "2009", "inwoners", "plicht"), row.names = c(NA, -28L), class = "data.frame")
I need conditional column means. I can do that with:
verplicht <- c("Europese Unie (stemplicht)", colMeans(eu[eu$plicht=="ja",c(2:13)], na.rm=TRUE), NA)
vrij <- c("Europese Unie (geen stemplicht)", colMeans(eu[eu$plicht=="nee",c(2:13)], na.rm=TRUE), NA)
eu2 <- rbind(eu, verplicht, vrij)
However, I need weighted column means with country population (the inwoners column) as the weights. I tried to that with:
verplicht <- c("Europese Unie (stemplicht)", lapply(eu[eu$plicht=="ja",c(2:13)], weighted.mean(x, eu[eu$plicht=="ja",14], na.rm=TRUE)), NA)
but that resulted in the following error:
Error in weighted.mean.default(x, eu[eu$plicht == "ja", 14], na.rm = TRUE) :
'x' and 'w' must have the same length
I understand what the error-message is saying, but don't know how to solve this. Any suggestions?
The problem is with how you're using lapply. Here's the correct code:
lapply(eu[eu$plicht=='ja',2:13], weighted.mean, eu[eu$plicht=='ja','inwoners'], na.rm=TRUE)
lapply(eu[eu$plicht=='nee',2:13], weighted.mean, eu[eu$plicht=='nee','inwoners'], na.rm=TRUE)
Notice how weighted.mean is used as an argument, rather than inside an anonymous function with x as an argument. You could equivalently do:
lapply(eu[eu$plicht=='ja',2:13], function(x) weighted.mean(x, eu[eu$plicht=='ja','inwoners'], na.rm=TRUE))
lapply(eu[eu$plicht=='nee',2:13], function(x) weighted.mean(x, eu[eu$plicht=='nee','inwoners'], na.rm=TRUE))
But you're currently kind of mixing the two different ways of using lapply.
If inwoners is the population, then
> (weights <- with(eu, inwoners/sum(inwoners)))
# [1] 0.0111303968 0.0055869443 0.0802983327 0.0045782350 0.0653952416
# [6] 0.0595181478 0.0005355356 0.0167326033 0.0637172042 0.0110315403
# [11] 0.0465970828 0.0104579315 0.0095291428 0.0084282004 0.0054114829
# [16] 0.0104866868 0.0013164784 0.0008634541 0.0029635856 0.0020181596
# [21] 0.0098810599 0.0004201845 0.0384254312 0.0020530577 0.0053956892
# [26] 0.0072641601 0.0199640310 0.5000000000
and the weighted mean of the 2004 column, for example, is
> weighted.mean(eu$`2004`, w = weights, na.rm = TRUE)
# [1] 45.31782
To get the weighted mean of each of the year columns for when plicht == 'ja',
> s <- subset(eu, plicht == "ja")
> w2 <- weights[as.numeric(rownames(s))]
> newDF <- do.call(rbind, lapply(2:13, function(i){
data.frame(wtMean.ja = weighted.mean(s[,i], w = w2, na.rm = TRUE))
}))
> rownames(newDF) <- names(s)[2:13]
> newDF
# wtMean.ja
# 1979 86.56735
# 1981 81.48000
# 1984 83.56127
# 1987 68.52000
# 1989 72.30636
# 1994 69.86950
# 1995 NaN
# 1996 NaN
# 1999 69.28708
# 2004 63.17060
# 2007 NaN
# 2009 58.99465
In the last question I did they pointed out that less data would be easy to read and understand as part of the reproducible example. On the way to asking again I tried to shorten the data via dput(head(data)) but I get the same as if I do dput(data) or dput(data[1:6, ]) or even dput(data)[1:6, ] (in this last case I get also the 6 first rows of the data after the whole dput)
Is there a simple way to do it? At the dput options I didn't find anything and there must be a solution to avoid deleting by hand what I do not want to show.
Here is the whole dput data:
>dput(data)
structure(list(GOterm = structure(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, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L,
34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 45L, 46L,
47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, 56L, 57L, 58L, 59L,
60L, 61L, 62L, 63L, 64L, 65L, 66L, 67L, 71L, 72L, 76L, 77L, 78L,
83L, 87L, 88L, 89L, 93L, 96L, 97L, 101L, 103L, 104L, 105L, 106L,
109L, 111L, 113L, 114L, 116L), .Label = c("GO:0000746", "GO:0000910",
"GO:0006091", "GO:0006259", "GO:0006351", "GO:0006399", "GO:0006412",
"GO:0006457", "GO:0006464", "GO:0006468", "GO:0006486", "GO:0006520",
"GO:0006725", "GO:0006766", "GO:0006810", "GO:0006811", "GO:0006839",
"GO:0006897", "GO:0006950", "GO:0006970", "GO:0006974", "GO:0006979",
"GO:0006986", "GO:0006997", "GO:0007005", "GO:0007010", "GO:0007029",
"GO:0007031", "GO:0007033", "GO:0007034", "GO:0007049", "GO:0007059",
"GO:0007114", "GO:0007124", "GO:0007126", "GO:0007165", "GO:0009408",
"GO:0009409", "GO:0015031", "GO:0016044", "GO:0016050", "GO:0016070",
"GO:0016071", "GO:0016072", "GO:0016192", "GO:0016567", "GO:0016568",
"GO:0016570", "GO:0019725", "GO:0030435", "GO:0031505", "GO:0032196",
"GO:0032989", "GO:0042221", "GO:0042254", "GO:0042594", "GO:0043543",
"GO:0044255", "GO:0044257", "GO:0044262", "GO:0045333", "GO:0046483",
"GO:0048193", "GO:0051169", "GO:0051186", "GO:0051276", "GO:0070271",
"GO:0000278", "GO:0000902", "GO:0002181", "GO:0005975", "GO:0006325",
"GO:0006353", "GO:0006360", "GO:0006366", "GO:0006383", "GO:0006397",
"GO:0006401", "GO:0006414", "GO:0006418", "GO:0006470", "GO:0006605",
"GO:0006629", "GO:0006865", "GO:0006869", "GO:0006873", "GO:0006887",
"GO:0006914", "GO:0008033", "GO:0008213", "GO:0008643", "GO:0009311",
"GO:0009451", "GO:0015931", "GO:0016197", "GO:0023052", "GO:0031399",
"GO:0032543", "GO:0042255", "GO:0042273", "GO:0042274", "GO:0043144",
"GO:0043934", "GO:0045454", "GO:0051052", "GO:0051321", "GO:0051603",
"GO:0051604", "GO:0051726", "GO:0055086", "GO:0070647", "GO:0000054",
"GO:0001403", "GO:0006352", "GO:0006354", "GO:0006364", "GO:0006413",
"GO:0006417", "GO:0006497", "GO:0008380", "GO:0009072", "GO:0051049",
"GO:0061025", "GO:0071554"), class = "factor"), GOdesc = structure(c(16L,
17L, 23L, 19L, 58L, 62L, 59L, 37L, 39L, 40L, 38L, 3L, 4L, 67L,
60L, 27L, 30L, 20L, 51L, 48L, 46L, 49L, 52L, 33L, 29L, 18L, 21L,
34L, 64L, 63L, 2L, 14L, 1L, 43L, 28L, 56L, 47L, 45L, 41L, 9L,
65L, 54L, 31L, 55L, 66L, 42L, 12L, 26L, 7L, 57L, 22L, 61L, 6L,
44L, 53L, 50L, 35L, 8L, 10L, 5L, 11L, 25L, 24L, 32L, 15L, 13L,
36L, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA), .Label = c("cell budding", "cell cycle",
"cellular amino acid and metabolic process", "cellular aromatic compound metabolic process",
"cellular carbohydrate metabolic process", "cellular component morphogenesis",
"cellular homeostasis", "cellular lipid metabolic process", "cellular membrane organization",
"cellular protein catabolic process", "cellular respiration",
"chromatin modification", "chromosome organization and biogenesis",
"chromosome segregation", "cofactor metabolic process", "conjugation",
"cytokinesis", "cytoskeleton organization and biogenesis", "DNA metabolic process",
"endocytosis", "ER organization and biogenesis", "fungal-type cell wall organization",
"generation of precursor metabolites and energy", "golgi vesicle transport",
"heterocycle metabolic process", "histone modification", "ion transport",
"meiosis", "mitchondrion organization", "mitochondrial transport",
"mRNA metabolic process", "nuclear transport", "nucleus organization",
"peroxisome organization", "protein acylation", "protein complex biogenesis",
"protein folding", "protein glycosylation", "protein modification process",
"protein phosphorylation", "protein transport", "protein ubiquitination",
"pseudohyphal growth", "response to chemical stimulus", "response to cold",
"response to DNA damage stimulus", "response to heat", "response to osmotic stress",
"response to oxidative stress", "response to starvation", "response to stress",
"response to unfolded protein", "ribosome biogenesis", "RNA metabolic process",
"rRNA metabolic process", "signal transduction", "sporulation resulting in formation of a cellular spore",
"transcription", "translation", "transport", "transposition",
"tRNA metabolic process", "vacuolar transport", "vacuole organizations",
"vesicle organization", "vesicle-mediated transport", "vitamin metabolic process"
), class = "factor"), GSA_p33_SC = c(NA, -1, NA, NA, NA, NA,
NA, 1, NA, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA, -1, NA, NA,
-1, -1, NA, NA, NA, NA, NA, -1, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA), GSA_p33_X33 = c(NA, NA, -1, NA, NA, NA, NA, NA,
NA, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, 1, NA, NA, NA, NA, NA, NA, 1, 1, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -1,
NA, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, NA,
NA), GSA_p38_SC = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
1, NA, NA, NA, -1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA,
NA, NA, NA, -1, NA, NA, NA, -1, NA, NA, NA, NA, NA, NA), GSA_p38_X33 = c(NA,
1, NA, NA, NA, NA, NA, 1, NA, NA, 1, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -1, 1,
1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, -1, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, -1, NA, NA, 1, NA, NA), GSA_p52_SC = c(NA, NA, NA, NA,
NA, NA, NA, 1, NA, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA,
-1, -1, NA, NA, NA), GSA_p52_X33 = c(NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -1,
NA, -1, NA, 1, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, -1, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, -1, NA, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA, -1, NA,
NA, NA, NA), GSA_p64_SC = c(NA, NA, NA, NA, NA, NA, NA, 1, NA,
NA, 1, NA, NA, -1, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA,
1, NA, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, -1, NA, NA, NA, NA, NA, -1, NA, -1, -1,
NA, NA, NA, -1, NA, NA, NA, 1, NA, NA, NA, NA, NA, NA, -1, 1,
-1, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA, NA, NA, NA, NA
), GSA_p64_X33 = c(1, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1,
NA, NA, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA, 1, NA, NA,
NA, NA, NA, NA, -1, 1, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -1, NA, NA, NA,
NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, -1, -1), GSA_SC_X33 = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, -1, NA,
NA, NA, NA, NA, NA, NA, -1, NA, 1, NA, NA, NA, NA, NA, NA, 1,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, NA,
NA, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA,
1, NA, NA, 1, -1, NA, -1, NA, NA, NA, -1, 1, NA, NA, NA, NA,
NA, -1, NA, NA, NA, NA, NA, NA)), .Names = c("GOterm", "GOdesc",
"GSA_p33_SC", "GSA_p33_X33", "GSA_p38_SC", "GSA_p38_X33", "GSA_p52_SC",
"GSA_p52_X33", "GSA_p64_SC", "GSA_p64_X33", "GSA_SC_X33"), row.names = c(NA,
-89L), class = "data.frame")
A shortened version could be like:
structure(list(GOterm = structure(c(1L, 2L, 3L, 4L, 5L, 6L),
.Label = c("GO:0000746", "GO:0000910", "GO:0006091", "GO:0006259",
"GO:0006351", "GO:0006399"), class = "factor"),
GOdesc = structure(c(16L,17L, 23L, 19L, 58L, 62L),
.Label = c("cell budding", "cell cycle",
"cellular amino acid and metabolic process", "cellular aromatic compound
metabolic process", "cellular carbohydrate metabolic process", "cellular
component morphogenesis"), class = "factor"),
GSA_p33_SC = c(NA, -1, NA, NA, NA, NA),
GSA_p33_X33 = c(NA, NA, -1, NA, NA, NA),
GSA_p38_SC = c(NA, NA, NA, NA, NA, NA),
GSA_p38_X33 = c(NA, 1, NA, NA, NA, NA),
GSA_p52_SC = c(NA, NA, NA, NA, NA, NA),
GSA_p52_X33 = c(NA, NA, NA, NA, NA, NA),
GSA_p64_SC = c(NA, NA, NA, NA, NA, NA),
GSA_p64_X33 = c(1, NA, NA, NA, NA, NA),
GSA_SC_X33 = c(NA, NA, NA, NA, NA, NA)),
.Names = c("GOterm", "GOdesc",
"GSA_p33_SC", "GSA_p33_X33", "GSA_p38_SC", "GSA_p38_X33", "GSA_p52_SC",
"GSA_p52_X33", "GSA_p64_SC", "GSA_p64_X33", "GSA_SC_X33"), row.names = c(NA,
-6L), class = "data.frame"))
All of that extra funk is from your factor levels. If you know your problem will still be reproducible after dropping these levels, then you can consider (wait for it) droplevels:
> dput(droplevels(head(data)))
structure(list(GOterm = structure(1:6, .Label = c("GO:0000746",
"GO:0000910", "GO:0006091", "GO:0006259", "GO:0006351", "GO:0006399"
), class = "factor"), GOdesc = structure(c(1L, 2L, 4L, 3L, 5L,
6L), .Label = c("conjugation", "cytokinesis", "DNA metabolic process",
"generation of precursor metabolites and energy", "transcription",
"tRNA metabolic process"), class = "factor"), GSA_p33_SC = c(NA,
-1, NA, NA, NA, NA), GSA_p33_X33 = c(NA, NA, -1, NA, NA, NA),
GSA_p38_SC = c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,
NA_real_), GSA_p38_X33 = c(NA, 1, NA, NA, NA, NA), GSA_p52_SC = c(NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), GSA_p52_X33 = c(NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), GSA_p64_SC = c(NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), GSA_p64_X33 = c(1,
NA, NA, NA, NA, NA), GSA_SC_X33 = c(NA_real_, NA_real_, NA_real_,
NA_real_, NA_real_, NA_real_)), .Names = c("GOterm", "GOdesc",
"GSA_p33_SC", "GSA_p33_X33", "GSA_p38_SC", "GSA_p38_X33", "GSA_p52_SC",
"GSA_p52_X33", "GSA_p64_SC", "GSA_p64_X33", "GSA_SC_X33"), row.names = c(NA,
6L), class = "data.frame")
This is more easily demonstrated in the following example:
x <- factor("A", levels = LETTERS)
x
# [1] A
# Levels: A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
dput(x)
# structure(1L, .Label = c("A", "B", "C", "D", "E", "F", "G", "H",
# "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U",
# "V", "W", "X", "Y", "Z"), class = "factor")
dput(droplevels(x))
# structure(1L, .Label = "A", class = "factor")
Another way to shorten it up would be to convert the columns to character before dput. The data can then be read back in with as.data.frame and factor levels are preserved.
First subset
> data2 <- data[sample(nrow(data), 4), ]
Then dput as characters
> d <- dput(lapply(data2, as.character))
structure(list(GOterm = c("GO:0000746", "GO:0070647", "GO:0006914",
"GO:0007010"), GOdesc = c("conjugation", NA, NA, "cytoskeleton organization and biogenesis"
), GSA_p33_SC = c(NA_character_, NA_character_, NA_character_,
NA_character_), GSA_p33_X33 = c(NA, NA, "1", "1"), GSA_p38_SC = c(NA_character_,
NA_character_, NA_character_, NA_character_), GSA_p38_X33 = c(NA_character_,
NA_character_, NA_character_, NA_character_), GSA_p52_SC = c(NA,
"-1", NA, NA), GSA_p52_X33 = c(NA, NA, NA, "1"), GSA_p64_SC = c(NA,
NA, NA, "1"), GSA_p64_X33 = c("1", NA, NA, NA), GSA_SC_X33 = c(NA,
NA, NA, "1")), .Names = c("GOterm", "GOdesc", "GSA_p33_SC", "GSA_p33_X33",
"GSA_p38_SC", "GSA_p38_X33", "GSA_p52_SC", "GSA_p52_X33", "GSA_p64_SC",
"GSA_p64_X33", "GSA_SC_X33"))
And read back in
> as.data.frame(d)