I have a dataframe where I want to do two separate gathers
library(tidyverse)
id <- c("A","B","C","D","E")
test_1_baseline <- c(1,2,4,5,6)
test_2_baseline <- c(21000, 23400, 26800,29000,30000)
test_1_followup <- c(0,4,2,3,1)
test_2_followup <- c(10000,12000,13000,15000,21000)
layout_1 <-data.frame(id,test_1_baseline,test_1_followup,test_2_baseline,test_2_followup)
This is the current layout.
Each person is 1 line.
The result of Test 1 at baseline is one variable
The result of Test 2 at baseline is a second variable
The same applies to Test 1/2 follow-up results
I would like the data to be tidier. One column for timepoint, one for result of test A, one for result of test B.
id2 <- c("A","B","C","D","E","A","B","C","D","E")
time <- c(rep("baseline",5),rep("followup",5))
test_1_result <- c(1,2,4,5,6,0,4,2,3,1)
test_2_result <- c(21000, 23400, 26800,29000,30000,10000,12000,13000,15000,21000)
layout_2 <- data.frame(id2, time,test_1_result,test_2_result)
I'm currently doing a what seems to me odd process where first of all I gather the test 1 data
test_1 <- select(layout_1,id,test_1_baseline,test_1_followup) %>%
gather("Timepoint","test_1",c(test_1_baseline,test_1_followup)) %>%
mutate(Timepoint = replace(Timepoint,Timepoint=="test_1_baseline", "baseline")) %>%
mutate(Timepoint = replace(Timepoint,Timepoint=="test_1_followup", "followup"))
Then I do same for test 2 and join them
test_2 <- select(layout_1,id,test_2_baseline,test_2_followup) %>%
gather("Timepoint","test_2",c(test_2_baseline,test_2_followup)) %>%
mutate(Timepoint = replace(Timepoint,Timepoint=="test_2_baseline", "baseline")) %>%
mutate(Timepoint = replace(Timepoint,Timepoint=="test_2_followup", "followup"))
test_combined <- full_join(test_1,test_2)
I tried doing the first Gather and then the second on the same dataframe but then you end up with duplicates; i.e you end up with
ID 1 Test_1 Baseline Test_2 Baseline
ID 1 Test_1 Baseline Test_2 Followup
ID 1 Test_1 Followup Test_2
Baseline ID 1 Test_1 Followup Test_2 Followup
== 4 rows where there should only be 2
I feel there must be a cleaner tidyverse way to do this.
Guidance welcomed
One option with data.table using melt which can take multiple measure patterns
library(data.table)
nm1 <- unique(sub(".*_", "", names(layout_1)[-1]))
melt(setDT(layout_1), measure = patterns("test_1", "test_2"),
value.name = c('test_1_result', 'test_2_result'),
variable.name = 'time')[, time := nm1[time]][]
You could gather all columns except id, then use separate to split into result and time.
Note that this code assumes that the result name is always 6 characters (test_1, test_2), and separates based on that assumption. You'll need to devise a different separate if that is not the case.
library(tidyr)
library(dplyr)
layout_1 %>%
gather(Var, Val, -id) %>%
separate(Var, into = c("result", "time"), sep = 6) %>%
spread(result, Val) %>%
mutate(time = gsub("_", "", time))
Result:
id time test_1 test_2
1 A baseline 1 21000
2 A followup 0 10000
3 B baseline 2 23400
4 B followup 4 12000
5 C baseline 4 26800
6 C followup 2 13000
7 D baseline 5 29000
8 D followup 3 15000
9 E baseline 6 30000
10 E followup 1 21000
Related
Im fairly new to R and struggling to find a solution for the following problem:
I have a tibble consisting of 3 columns. First column describes ids of stocks (e.g. ID1,ID2..), the second the Date of observation and third the corresponding return. (ID | Date | Return )
For tidying my dataset I need to delete all zero returns starting from end of sample period until i reach the first non zero return.
The following picture further visualises my issue.
DatasetExample
In case of the example Dataset depicted above, I need to delete the yellow coloured elements.
Hence, one needs to first group by ID and second iterate over the table from bottom to top until reaching a non zero return.
I already found a way by converting the tibble into a matrix and then looping over each element but this apporach is rather naive and does not perform well on large datasets (+2 mio. observations), which is exactly my case.
Is there any more effcient way to achieve this aim? Solutions using dplyr would be highly appreciated.
Thanks in advance.
Here is a dplyr solution. I believe it's a bit complicated, but it works.
library(dplyr)
df1 %>%
mutate(Date = as.Date(Date, format = "%d.%m.%Y")) %>%
group_by(ID) %>%
arrange(desc(Date), .by_group = TRUE) %>%
mutate(flag = min(which(Return == 0)),
flag = cumsum(Return != 0 & flag <= row_number())) %>%
filter(flag > 0) %>%
select(-flag) %>%
arrange(Date, .by_group = TRUE)
## A tibble: 7 x 3
## Groups: ID [2]
# ID Date Return
# <int> <date> <dbl>
#1 1 2020-09-20 0.377
#2 1 2020-09-21 0
#3 1 2020-09-22 -1.10
#4 2 2020-09-20 0.721
#5 2 2020-09-21 0
#6 2 2020-09-22 0
#7 2 2020-09-23 1.76
Test data creation code
set.seed(2020)
df1 <- data.frame(ID = rep(1:2, each = 5), Date = Sys.Date() - 5:1, Return = rnorm(10))
df1$Date <- format(df1$Date, "%d.%m.%Y")
df1$Return[sample(1:5, 2)] <- 0
df1$Return[sample(6:10, 2)] <- 0
df1$Return[10] <- 0
There might be a more elegant way but this could work:
split_data <- split(data,data$ID)
split_tidy_data <- lapply(split_data,function(x) x[1:which.max(x[,"Return"]!=0),])
tidy_data <- do.call(rbind,split_tidy_data)
Note: This only works if there is at least 1 "Return" which is not equal 0
I have a large dataframe(100K rows, 19 columns). I need to count the number of cases each month that contain each possible combination of 5 items.
The following code works for a small dataset but with my complete dataset it takes way too long. From my searching I suspect that pre-allocating a dataframe is the key, but I cannot figure out how to do that.
library(dplyr)
Case<-c(1,1,1,2,2,3,4,5,5,6,6,6,7,8,8,8,9,9,9)
Month<- c("Jan","Jan","Jan","Mar","Mar","Sep","Sep","Nov","Nov","Dec","Dec","Dec","Apr","Dec","Dec","Dec","Dec","Dec","Dec")
Fruits<-c("Apple","Orange","Grape","Grape","Orange","Apple","Apple","Orange","Grape","Apple","Orange","Grape","Grape","Apple","Orange","Grape","Apple","Orange","Grape")
df<-data.frame(Case,Month,Fruits)
Patterns <- with(df, do.call(rbind, lapply(unique(Case), function(x){
y <- subset(df, Case == x )
Date<-as.character(y$Month[1])
Fruits <- paste(unique(y$Fruits[order(y$Fruits)]), collapse = ' / ')
as.data.frame(unique (cbind(Case = y$Case, Date, Fruits)))
})))
Total<-Patterns %>%
group_by(Date,Fruits) %>%
tally()
The results I get are acceptable but the process takes too long and with a large dataset I run out of memory.
Over large datasets, data.table will be a lot quicker than dplyr:
library(data.table)
setDT(df)[, lapply(.SD, toString), by = c("Case","Month")][,.N, by = c("Fruits","Month")]
We could do all of it in one command using dplyr. First we group_by Case and Month to paste all Fruits together by group and then grouping by Month and Fruits we add the number of rows for each group using tally.
library(dplyr)
df %>%
group_by(Case, Month) %>%
summarise(Fruits = paste(Fruits, collapse = "/")) %>%
group_by(Month, Fruits) %>%
tally()
# OR count()
# Month Fruits n
# <fct> <chr> <int>
#1 Apr Grape 1
#2 Dec Apple/Orange/Grape 3
#3 Jan Apple/Orange/Grape 1
#4 Mar Grape/Orange 1
#5 Nov Orange/Grape 1
#6 Sep Apple 2
I've a dataset with 18 columns from which I need to return the column names with the highest value(s) for each observation, simple example below. I came across this answer, and it almost does what I need, but in some cases I need to combine the names (like abin maxcolbelow). How should I do this?
Any suggestions would be greatly appreciated! If it's possible it would be easier for me to understand a tidyverse based solution as I'm more familiar with that than base.
Edit: I forgot to mention that some of the columns in my data have NAs.
library(dplyr, warn.conflicts = FALSE)
#turn this
Df <- tibble(a = 4:2, b = 4:6, c = 3:5)
#into this
Df <- tibble(a = 4:2, b = 4:6, c = 3:5, maxol = c("ab", "b", "b"))
Created on 2018-10-30 by the reprex package (v0.2.1)
Continuing from the answer in the linked post, we can do
Df$maxcol <- apply(Df, 1, function(x) paste0(names(Df)[x == max(x)], collapse = ""))
Df
# a b c maxcol
# <int> <int> <int> <chr>
#1 4 4 3 ab
#2 3 5 4 b
#3 2 6 5 b
For every row, we check which position has max values and paste the names at that position together.
If you prefer the tidyverse approach
library(tidyverse)
Df %>%
mutate(row = row_number()) %>%
gather(values, key, -row) %>%
group_by(row) %>%
mutate(maxcol = paste0(values[key == max(key)], collapse = "")) %>%
spread(values, key) %>%
ungroup() %>%
select(-row)
# maxcol a b c
# <chr> <int> <int> <int>
#1 ab 4 4 3
#2 b 3 5 4
#3 b 2 6 5
We first convert dataframe from wide to long using gather, then group_by each row we paste column names for max key and then spread the long dataframe to wide again.
Here's a solution I found that loops through column names in case you find it hard to wrap your head around spread/gather (pivot_wider/longer)
out_df <- Df %>%
# calculate rowwise maximum
rowwise() %>%
mutate(rowmax = max(across())) %>%
# create empty maxcol column
mutate(maxcol = "")
# loop through column names
for (colname in colnames(Df)) {
out_df <- out_df %>%
# if the value at the specified column name is the maximum, paste it to the maxcol
mutate(maxcol = ifelse(.data[[colname]] == rowmax, paste0(maxcol, colname), maxcol))
}
# remove rowmax column if no longer needed
out_df <- out_df %>%
select(-rowmax)
Working with grouped data, I want to change the last entry in one column to match the corresponding value for that group in another column. So for my data below, for each 'nest' (group), the last 'Status' entry will equal the 'fate' for that nest.
Data like this:
nest Status fate
1 1 2
1 1 2
2 1 3
2 1 3
2 1 3
Desired result:
nest Status fate
1 1 2
1 2 2
2 1 3
2 1 3
2 3 3
It should be so simple. I tried the following from dplyr and tail to change last value in a group_by in r; it works properly for some groups, but in others it substitutes the wrong 'fate' value:
library(data.table)
indx <- setDT(df)[, .I[.N], by = .(nest)]$V1
df[indx, Status := df$fate]
I get various errors trying this approach dplyr mutate/replace on a subset of rows:
mutate_last <- function(.data, ...) {
n <- n_groups(.data)
indices <- attr(.data, "indices")[[n]] + 1
.data[indices, ] <- .data[indices, ] %>% mutate(...)
.data
}
df <- df %>%
group_by(nest) %>%
mutate_last(df, Status == fate)
I must be missing something simple from the resources mentioned above?
Something like
library(tidyverse)
df <- data.frame(nest = c(1,1,2,2,2),
status = rep(1, 5),
fate = c(2,2,3,3,3))
df %>%
group_by(nest) %>%
mutate(status = c(status[-n()], tail(fate,1)))
Not sure if this is definitely the best way to do it but here's a very simple solution:
library(dplyr)
dat <- data.frame(nest = c(1,1,2,2,2),
Status = c(1,1,1,1,1),
fate = c(2,2,3,3,3))
dat %>%
arrange(nest, Status, fate) %>% #enforce order
group_by(nest) %>%
mutate(Status = ifelse(is.na(lead(nest)), fate, Status))
E: Made a quick change.
I am working on my thesis with little knowledge of r, so the answer this question may be pretty obvious.
I have the a dataset looking like this:
county<-c('1001','1001','1001','1202','1202','1303','1303')
naics<-c('423620','423630','423720','423620','423720','423550','423720')
employment<-c(5,6,5,5,5,6,5)
data<-data.frame(county,naics,employment)
For every county, I want to sum the value of employment of rows with naics '423620' and '423720'. (So two conditions: 1. same county code 2. those two naics codes) The row in which they are added should be the first one ('423620'), and the second one ('423720') should be removed
The final dataset should look like this:
county2<-c('1001','1001','1202','1303','1303')
naics2<-c('423620','423630','423620','423550','423720')
employment2<-c(10,6,10,6,5)
data2<-data.frame(county2,naics2,employment2)
I have tried to do it myself with aggregate and rowSum, but because of the two conditions, I have failed thus far. Thank you very much.
We can do
library(dplyr)
data$naics <- as.character(data$naics)
data %>%
filter(naics %in% c(423620, 423720)) %>% group_by(county) %>%
summarise(naics = "423620", employment = sum(employment)) %>%
bind_rows(., filter(data, !naics %in% c(423620, 423720)))
# A tibble: 5 x 3
# county naics employment
# <fctr> <chr> <dbl>
#1 1001 423620 10
#2 1202 423620 10
#3 1303 423620 5
#4 1001 423630 6
#5 1303 423550 6
With such a condition, I'd first write a small helper and then pass it on to dplyr mutate:
# replace 423720 by 423620 only if both exist
onlyThoseNAICS <- function(v){
if( ("423620" %in% v) & ("423720" %in% v) ) v[v == "423720"] <- "423620"
v
}
data %>%
dplyr::group_by(county) %>%
dplyr::mutate(naics = onlyThoseNAICS(naics)) %>%
dplyr::group_by(county, naics) %>%
dplyr::summarise(employment = sum(employment)) %>%
dplyr::ungroup()