In R, conditionally left join two tables depending on the value of an indicator variable in the left-hand-side table - r

Background
I've got two dataframes about baseball cards and their market value. This information comes from Baseball Card "Almanacs", guides to cards' value published every year.
The first, d, is a table with the card_id of each card, as well as an indicator almanac_flag, which tells you if the card_id in that row came from the either the 1999 or 2009 editions of the Baseball Card Almanac:
d <- data.frame(card_id = c("48","2100","F7","2729","F4310","27700"),
almanac_flag = c(0,0,1,0,1,0), # 0 = 1999 Almanac, 1 = 2009 almanac
stringsAsFactors=T)
It looks like this:
The second dataframe is d2, which contains (not all) equivalent id's for 1999 and 2009, along with a description of which baseball player is depicted in that card. Note that d2 doesn't have all the ID's that appear in d -- it only has 3 "matches" and that's totally fine.
d2 <- data.frame(card_id_1999 = c("48","2100","31"),
card_id_2009 = c("J18","K02","F7"),
description = c("Wade Boggs","Frank Thomas","Mickey Mantle"),
stringsAsFactors=T)
d2 looks like this:
The Problem
I want to join these two tables so I get a table that looks like this:
What I've Tried
So of course, I could use left_join with the key being either card_id = card_id_1999 or card_id = card_id_2009, but that only gets me half of what I need, like so:
d_tried <- left_join(d, d2, by = c("card_id" = "card_id_1999"))
Which gives me this:
In a sense I'm asking to do 2 joins in one go, but I'm not sure how to do that.
Any thoughts?

If we do the reshape to 'long' format from 'd2', it should work
library(dplyr)
library(tidyr)
d2 %>%
pivot_longer(cols = starts_with('card'),
values_to = 'card_id', names_to = NULL) %>%
right_join(d) %>%
select(names(d), everything())
-output
# A tibble: 6 x 3
card_id almanac_flag description
<fct> <dbl> <fct>
1 48 0 Wade Boggs
2 2100 0 Frank Thomas
3 F7 1 Mickey Mantle
4 2729 0 <NA>
5 F4310 1 <NA>
6 27700 0 <NA>
or another option is to match separately for each column (or join separately) and then do a coalesce such as the first non-NA will be selected
d %>%
mutate(description = coalesce(d2$description[match(card_id,
d2$card_id_1999)], d2$description[match(card_id, d2$card_id_2009)]))
card_id almanac_flag description
1 48 0 Wade Boggs
2 2100 0 Frank Thomas
3 F7 1 Mickey Mantle
4 2729 0 <NA>
5 F4310 1 <NA>
6 27700 0 <NA>

Related

Aggregate week and date in R by some specific rules

I'm not used to using R. I already asked a question on stack overflow and got a great answer.
I'm sorry to post a similar question, but I tried many times and got the output that I didn't expect.
This time, I want to do slightly different from my previous question.
Merge two data with respect to date and week using R
I have two data. One has a year_month_week column and the other has a date column.
df1<-data.frame(id=c(1,1,1,2,2,2,2),
year_month_week=c(2022051,2022052,2022053,2022041,2022042,2022043,2022044),
points=c(65,58,47,21,25,27,43))
df2<-data.frame(id=c(1,1,1,2,2,2),
date=c(20220503,20220506,20220512,20220401,20220408,20220409),
temperature=c(36.1,36.3,36.6,34.3,34.9,35.3))
For df1, 2022051 means 1st week of May,2022. Likewise, 2022052 means 2nd week of May,2022. For df2,20220503 means May 3rd, 2022. What I want to do now is merge df1 and df2 with respect to year_month_week. In this case, 20220503 and 20220506 are 1st week of May,2022.If more than one date are in year_month_week, I will just include the first of them. Now, here's the different part. Even if there is no date inside year_month_week,just leave it NA. So my expected output has a same number of rows as df1 which includes the column year_month_week.So my expected output is as follows:
df<-data.frame(id=c(1,1,1,2,2,2,2),
year_month_week=c(2022051,2022052,2022053,2022041,2022042,2022043,2022044),
points=c(65,58,47,21,25,27,43),
temperature=c(36.1,36.6,NA,34.3,34.9,NA,NA))
First we can convert the dates in df2 into year-month-date format, then join the two tables:
library(dplyr);library(lubridate)
df2$dt = ymd(df2$date)
df2$wk = day(df2$dt) %/% 7 + 1
df2$year_month_week = as.numeric(paste0(format(df2$dt, "%Y%m"), df2$wk))
df1 %>%
left_join(df2 %>% group_by(year_month_week) %>% slice(1) %>%
select(year_month_week, temperature))
Result
Joining, by = "year_month_week"
id year_month_week points temperature
1 1 2022051 65 36.1
2 1 2022052 58 36.6
3 1 2022053 47 NA
4 2 2022041 21 34.3
5 2 2022042 25 34.9
6 2 2022043 27 NA
7 2 2022044 43 NA
You can build off of a previous answer here by taking the function to count the week of the month, then generate a join key in df2. See here
df1 <- data.frame(
id=c(1,1,1,2,2,2,2),
year_month_week=c(2022051,2022052,2022053,2022041,2022042,2022043,2022044),
points=c(65,58,47,21,25,27,43))
df2 <- data.frame(
id=c(1,1,1,2,2,2),
date=c(20220503,20220506,20220512,20220401,20220408,20220409),
temperature=c(36.1,36.3,36.6,34.3,34.9,35.3))
# Take the function from the previous StackOverflow question
monthweeks.Date <- function(x) {
ceiling(as.numeric(format(x, "%d")) / 7)
}
# Create a year_month_week variable to join on
df2 <-
df2 %>%
mutate(
date = lubridate::parse_date_time(
x = date,
orders = "%Y%m%d"),
year_month_week = paste0(
lubridate::year(date),
0,
lubridate::month(date),
monthweeks.Date(date)),
year_month_week = as.double(year_month_week))
# Remove duplicate year_month_weeks
df2 <-
df2 %>%
arrange(year_month_week) %>%
distinct(year_month_week, .keep_all = T)
# Join dataframes
df1 <-
left_join(
df1,
df2,
by = "year_month_week")
Produces this result
id.x year_month_week points id.y date temperature
1 1 2022051 65 1 2022-05-03 36.1
2 1 2022052 58 1 2022-05-12 36.6
3 1 2022053 47 NA <NA> NA
4 2 2022041 21 2 2022-04-01 34.3
5 2 2022042 25 2 2022-04-08 34.9
6 2 2022043 27 NA <NA> NA
7 2 2022044 43 NA <NA> NA
>
Edit: forgot to mention that you need tidyverse loaded
library(tidyverse)

Turn field names into column names for specific variables and fill them with certain logic

I have the dataframe below:
product<-c("ab","ab","ab","ac","ac","ac")
shop<-c("sad","sad","sad","sadas","fghj","xzzv")
category<-c("a","a","a","c","b","b")
tempr<-c(35,35,14,24,14,5)
value<-c(0,0,-6,8,4,0)
store<-data.frame(product,shop,category,tempr,value)
product shop category tempr value
1 ab sad a 35 0
2 ab sad a 35 0
3 ab sad a 14 -6
4 ac sadas c 24 8
5 ac fghj b 14 4
6 ac xzzv b 5 0
I want to transform this dataframe in a way that I will keep the unique product names and turn shop names from field values to column names (and the opposite). I want to fill this data frame with a combination of tempr and its relative value but only for the value that is not 0 otherwise the cells should be empty. However, as you noticed I have records that have the same product and shop, but different tempr and value numbers (ab-sad). The problem is that they overwrite each other. In that case (same name,same shop but different tmpr-value) the non-zero case should prevail. For example 170(62) should be dispalyed instead of 170(0) if they both exist.The cells should also be empty in case that a product does not exist in a shop. An example of the final form is:
store2
product sad sadas fghj xzzv
1 ab 14(-6)
2 ac 24(8) 14(4)
1st possible approach:
store2 <- matrix(NA,ncol=length(unique(store$shop)),nrow=length(unique(store$product)))
colnames(store2) <- unique(store$shop)
rownames(store2) <- unique(store$product)
for(i in 1:ncol(store)) {
store2[store[i,'product'],store[i,'shop']] <- paste0(store[i,c('tempr')],'(',store[i,'value'],')')
}
2nd possible approach:
library(tidyverse)
store %>%
mutate(shop = factor(shop, levels = unique(shop))) %>%
filter(value != 0) %>%
mutate(val = sprintf("%s(%s)", tempr, value)) %>%
select(product, shop, val) %>%
group_by(product) %>%
complete(shop) %>%
spread(shop, val)
Except from this result I want to be able to use category as well with the same logic. The picture below shows all the possible combinations that I wish with the same filling logic.
Not sure I fully understand the question, but the code below produces your example dataframe.
library(tidyverse)
product<-c("ab","ab","ab","ac","ac","ac")
shop<-c("sad","sad","sad","sadas","fghj","xzzv")
category<-c("a","a","a","c","b","b")
tempr<-c(35,35,14,24,14,5)
value<-c(0,0,-6,8,4,0)
store<-data.frame(product,shop,category,tempr,value)
store %>% filter(value != 0 ) %>% # Remove 0 values
mutate(combined = paste0(tempr,"(",value,")")) %>% # Combine columns for spread
select(-tempr,-value) %>% #
spread(shop,combined) # spread to create shop columns and temr/value values.
# product category fghj sad sadas
# 1 ab a <NA> 14(-6) <NA>
# 2 ac b 14(4) <NA> <NA>
# 3 ac c <NA> <NA> 24(8)
store$shop<-factor(store$shop,levels=c("sad","sadas","fghj","xzzv"))
#to avoid the change of column sequence of final outcome
store$tv<-ifelse(store$value==0,"",paste(store$tempr,"(",store$value,")",sep=""))
cast(store[,c(-3,-4,-5)],product~shop,function(x) paste(x,sep="",collapse=""), value="tv")
#due to one colname of the original store dataset is "value", firstly masked
#the original "value" column,otherwise, it automatically used as value-fill
# column
product sad sadas fghj xzzv
ab 14(-6)
ac 24(8) 14(4)"

Joins in R while also spreading out information from one data frame

I am attempting to join together two data frames. One contains records of when certain events happened. The other contains daily information on values that occurred for a given organization.
My current challenge is how to join together the information in the "when certain events happened" data frame fully into the records data frame. Most of dplyr's joins appear to simply join one line together. I need to fully spread out the record information based on start and end dates.
In other words, I need to spread out information from one line into many lines, while simultaneously joining to the daily data table. It is important that I do this in R because the alternative is quite a bit of filtering and dragging in Excel (the information covers thousands of rows).
Below is a representation of the daily data table
value year month day org link
12 1 1 1 AA AA-1-1
45 1 1 2 AA AA-1-2
31 1 1 3 AA AA-1-3
10 1 1 4 AA AA-1-4
Below is a representation of the records table
year month day org link end_link event event_info
1 1 2 AA AA-1-1-2 AA-1-1-3 Buy Yes
1 2 7 BB BB-1-2-7 BB-1-2-10 Sell Yes
And finally, here is what I am aiming for in the end:
value month day org link event event_info
12 1 1 AA AA-1-1-1
45 1 2 AA AA-1-1-2 Buy Yes
31 1 3 AA AA-1-1-3 Buy Yes
10 1 4 AA AA-1-1-4
Is there any way to accomplish this in R? I have tried using dplyr joins but usually am only able to join together the initial link.
Edit: The second "end" link refers to an end date. In the records table this is all in one line, while the second data frame has daily information.
Edit: Below I have put together a cleaner look at my real data. The first image is of DAILY DATA while the second is of RECORDS OF EVENTS. The third is what I would like to see (ideally).
Daily data, which will have multiple orgs present
Records data, note org id AA and the audience
Ideal combined data
We have first to build some dates in order to build date sequences that we'll unnest to get a long version of df2, which we right join on df1:
library(tidyverse)
df2 %>%
separate(link,c("org1","year1","month1","day1")) %>%
separate(end_link,c("org2","year2","month2","day2")) %>%
rowwise %>%
transmute(org,event,event_info, date = list(
as.Date(paste0(year1,"-",month1,"-",day1)):as.Date(paste0(year2,"-",month2,"-",day2)))) %>%
unnest %>%
right_join(df1 %>% mutate(date=as.numeric(as.Date(paste0(year,"-",month,"-",day))))) %>%
select(value, month, day, org, link, event,event_info)
# # A tibble: 4 x 7
# value month day org link event event_info
# <int> <int> <int> <chr> <chr> <chr> <chr>
# 1 12 1 1 AA AA-1-1 <NA> <NA>
# 2 45 1 2 AA AA-1-2 Buy Yes
# 3 31 1 3 AA AA-1-3 Buy Yes
# 4 10 1 4 AA AA-1-4 <NA> <NA>
data
df1 <- read.table(text="value year month day org link
12 1 1 1 AA AA-1-1
45 1 1 2 AA AA-1-2
31 1 1 3 AA AA-1-3
10 1 1 4 AA AA-1-4",h=T,strin=F)
df2 <- read.table(text="year month day org link end_link event event_info
1 1 2 AA AA-1-1-2 AA-1-1-3 Buy Yes
1 2 7 BB BB-1-2-7 BB-1-2-10 Sell Yes",h=T,strin=F)
I would use the Data table package, it is for me the best R package to do data analysis. Hope to have properly understood the problem, let me know if it does not work.
The first part creates the data-set (I created the two data.table objects in two different ways just to show both alternatives, you could read your data directly from excel, .txt, .csv or similar, let me know if you want to know how to do this).
library(data.table)
value<-c(12,45,31,10)
year<-c(1,1,1,1)
month<-c(1,1,1,1)
day<-c(1,2,3,4)
org<-c("AA","AA","AA","AA")
link<-c("AA-1-1","AA-1-2","AA-1-3","AA-1-4")
Daily_dt<-data.table(value, year,month,day,org,link)
Records_dt<-data.table(year=c(1,1),month=c(1,1),day=c(2,3),org=c("AA","BB"),link=c("AA-1-1-2","BB-1-2-7"),end_link=c("AA-1-1-3","BB-1-2-10"),
event=c("Buy","Buy"),event_info=c("Yes","Yes"))
Daily_dt[,Date:=as.Date(paste(year,"-",month,"-",day,sep=""))]
To achieve what you want you need these lines
Records_dt=rbind(Records_dt[,c("org","link","event","event_info")],
Records_dt[,list(org,link=end_link,event,event_info)])
Record_Dates<-as.data.table(tstrsplit(Records_dt$link,"-")[-1])
Record_Dates[,Dates:=as.Date(paste(V1,"-",V2,"-",V3,sep=""))]
Records_dt[,Date:=Record_Dates$Dates]
setkey(Records_dt,Date)
setkey(Daily_dt,Date)
Records_dt<-Records_dt[,c("Date","event","event_info")][Daily_dt,]
Records_dt<-Records_dt[,c("value","month","day","org","link","event","event_info")]
and this is the result
> Records_dt
value month day org link event event_info
1: 12 1 1 AA AA-1-1 NA NA
2: 45 1 2 AA AA-1-2 Buy Yes
3: 31 1 3 AA AA-1-3 Buy Yes
4: 10 1 4 AA AA-1-4 NA NA
If your input data had more than one event in the same day (with or without the same org) something like:
> Records_dt
year month day org link end_link event event_info
1: 1 1 2 AA AA-1-1-2 AA-1-1-3 Buy Yes
2: 1 1 3 BB BB-1-2-7 BB-1-2-10 Buy Yes
3: 1 1 2 AA AA-1-1-2 AA-1-1-3 Buy Yes
4: 1 1 3 AA AA-1-2-7 AA-1-2-10 Buy Yes
some tweaks may be required, but am not sure if you required this, so did not add it.

How to diagonally subtract different columns in R

I have a dataset of a hypothetical exam.
id <- c(1,1,3,4,5,6,7,7,8,9,9)
test_date <- c("2012-06-27","2012-07-10","2013-07-04","2012-03-24","2012-07-22", "2013-09-16","2012-06-21","2013-10-18", "2013-04-21", "2012-02-16", "2012-03-15")
result_date <- c("2012-07-29","2012-09-02","2013-08-01","2012-04-25","2012-09-01","2013-10-20","2012-07-01","2013-10-31", "2013-05-17", "2012-03-17", "2012-04-20")
data1 <- as_data_frame(id)
data1$test_date <- test_date
data1$result_date <- result_date
colnames(data1)[1] <- "id"
"id" indicates the ID of the students who have taken a particular exam. "test_date" is the date the students took the test and "result_date" is the date when the students' results are posted. I'm interested in finding out which students retook the exam BEFORE the result of that exam session was released, e.g. students who knew that they have underperformed and retook the exam without bothering to find out their scores. For example, student with "id" 1 took the exam for the second time on "2012-07-10" which was before the result date for his first exam - "2012-07-29".
I tried to:
data1%>%
group_by(id) %>%
arrange(id, test_date) %>%
filter(n() >= 2) %>% #To only get info on students who have taken the exam more than once and then merge it back in with the original data set using a join function
So essentially, I want to create a new column called "re_test" where it would equal 1 if a student retook the exam BEFORE receiving the result of a previous exam and 0 otherwise (those who retook after seeing their marks or those who did not retake).
I have tried to mutate in order to find cases where dates are either positive or negative by subtracting the 2nd test_date from the 1st result_date:
mutate(data1, re_test = result_date - lead(test_date, default = first(test_date)))
However, this leads to mixing up students with different id's. I tried to split but mutate won't work on a list of dataframes so now I'm stuck:
split(data1, data1$id)
Just to add on, this is a part of the desired result:
data2 <- as_data_frame(id <- c(1,1,3,4))
data2$test_date_result <- c("2012-06-27","2012-07-10", "2013-07-04","2012-03-24")
data2$result_date_result <- c("2012-07-29","2012-09-02","2013-08-01","2012-04-25")
data2$re_test <- c(1, 0, 0, 0)
Apologies for the verbosity and hope I was clear enough.
Thanks a lot in advance!
library(reshape2)
library(dplyr)
# first melt so that we can sequence by date
data1m <- data1 %>%
melt(id.vars = "id", measure.vars = c("test_date", "result_date"), value.name = "event_date")
# any two tests in a row is a flag - use dplyr::lag to comapre the previous
data1mc <- data1m %>%
arrange(id, event_date) %>%
group_by(id) %>%
mutate (multi_test = (variable == "test_date" & lag(variable == "test_date"))) %>%
filter(multi_test)
# id variable event_date multi_test
# 1 1 test_date 2012-07-10 TRUE
# 2 9 test_date 2012-03-15 TRUE
## join back to the original
data1 %>%
left_join (data1mc %>% select(id, event_date, multi_test),
by=c("id" = "id", "test_date" = "event_date"))
I have a piecewise answer that may work for you. I first create a data.frame called student that contains the re-test information, and then join it with the data1 object. If students re-took the test multiple times, it will compare the last test to the first, which is a flaw, but I'm unsure if students have the ability to re-test multiple times?
student <- data1 %>%
group_by(id) %>%
summarise(retest=(test_date[length(test_date)] < result_date[1]) == TRUE)
Some re-test values were NA. These were individuals that only took the test once. I set these to FALSE here, but you can retain the NA, as they do contain information.
student$retest[is.na(student$retest)] <- FALSE
Join the two data.frames to a single object called data2.
data2 <- left_join(data1, student, by='id')
I am sure there are more elegant ways to approach this. I did this by taking advantage of the structure of your data (sorted by id) and the lag function that can refer to the previous records while dealing with a current record.
### Ensure Data are sorted by ID ###
data1 <- arrange(data1,id)
### Create Flag for those that repeated ###
data1$repeater <- ifelse(lag(data1$id) == data1$id,1,0)
### I chose to do this on all data, you could filter on repeater flag first ###
data1$timegap <- as.Date(data1$result_date) - as.Date(data1$test_date)
data1$lagdate <- as.Date(data1$test_date) - lag(as.Date(data1$result_date))
### Display results where your repeater flag is 1 and there is negative time lag ###
data1[data1$repeater==1 & !is.na(data1$repeater) & as.numeric(data1$lagdate) < 0,]
# A tibble: 2 × 6
id test_date result_date repeater timegap lagdate
<dbl> <chr> <chr> <dbl> <time> <time>
1 1 2012-07-10 2012-09-02 1 54 days -19 days
2 9 2012-03-15 2012-04-20 1 36 days -2 days
I went with a simple shift comparison. 1 line of code.
data1 <- data.frame(id = c(1,1,3,4,5,6,7,7,8,9,9), test_date = c("2012-06-27","2012-07-10","2013-07-04","2012-03-24","2012-07-22", "2013-09-16","2012-06-21","2013-10-18", "2013-04-21", "2012-02-16", "2012-03-15"), result_date = c("2012-07-29","2012-09-02","2013-08-01","2012-04-25","2012-09-01","2013-10-20","2012-07-01","2013-10-31", "2013-05-17", "2012-03-17", "2012-04-20"))
data1$re_test <- unlist(lapply(split(data1,data1$id), function(x)
ifelse(as.Date(x$test_date) > c(NA, as.Date(x$result_date[-nrow(x)])), 0, 1)))
data1
id test_date result_date re_test
1 1 2012-06-27 2012-07-29 NA
2 1 2012-07-10 2012-09-02 1
3 3 2013-07-04 2013-08-01 NA
4 4 2012-03-24 2012-04-25 NA
5 5 2012-07-22 2012-09-01 NA
6 6 2013-09-16 2013-10-20 NA
7 7 2012-06-21 2012-07-01 NA
8 7 2013-10-18 2013-10-31 0
9 8 2013-04-21 2013-05-17 NA
10 9 2012-02-16 2012-03-17 NA
11 9 2012-03-15 2012-04-20 1
I think there is benefit in leaving NAs but if you really want all others as zero, simply:
data1$re_test <- ifelse(is.na(data1$re_test), 0, data1$re_test)
data1
id test_date result_date re_test
1 1 2012-06-27 2012-07-29 0
2 1 2012-07-10 2012-09-02 1
3 3 2013-07-04 2013-08-01 0
4 4 2012-03-24 2012-04-25 0
5 5 2012-07-22 2012-09-01 0
6 6 2013-09-16 2013-10-20 0
7 7 2012-06-21 2012-07-01 0
8 7 2013-10-18 2013-10-31 0
9 8 2013-04-21 2013-05-17 0
10 9 2012-02-16 2012-03-17 0
11 9 2012-03-15 2012-04-20 1
Let me know if you have any questions, cheers.

Applying functions on columns by group

I would like to apply a function on sets of data based on their category. Given the following data frame
pet <- c(rep("cat",5),rep("dog",5))
year <- c(rep(1991:1995,2))
karma <- c(5,4,1,1,1,6,4,3,2,6)
df <- data.frame(pet,year,karma)
that looks like this
pet year karma
1 cat 1991 5
2 cat 1992 4
3 cat 1993 1
4 cat 1994 1
5 cat 1995 1
6 dog 1991 6
7 dog 1992 4
8 dog 1993 3
9 dog 1994 2
10 dog 1995 6
I would like to perform operations on the karma column for each year. If I wanted to apply a function like sum, this can be done with ddply:
ddply(df, .(year),summarize, sum(karma))
How would I apply it to a function I have written myself, for example
calc <- function(d,c){(d*5+c*7)/12}
where d is a value corresponding to the dog's karma for each given year and c corresponding to that of the cat.
Ideally, I would like to have five more entries appended to this data frame with the pet both, a year and the karma value calculated by the function above. What would be the best way of doing that?
(Terribly sorry if this is trivial, but I really couldn't find a similar question this time.)
You can use spread to make your data frame wide and then mutate to implement your function
library('tidyr')
library('dplyr')
df %>%
spread(pet, karma, drop = FALSE) %>%
mutate(karma = calc(dog, cat), pet = "both") %>%
select(year, pet, karma) %>%
rbind(df)

Resources