Возвращаемое значение, если заголовок столбца попадает между двумя датами - PullRequest
0 голосов
/ 23 октября 2019

У меня есть два кадра данных ID_list и Attendance:

ID_list содержит список уникальных идентификаторов, дату их рождения и день рождения в последующие годы их жизни

ID DOB         Y1          Y2          Y3
1  01/05/2003  01/05/2004  01/05/2005  01/05/2006
2  05/02/2010  05/02/2011  05/02/2012  05/02/2013
3  17/06/2015  17/06/2016  17/06/2017  17/06/2018

Attendance содержит список идентификаторов, некоторые из которых соответствуют идентификаторам ID_list и процентам посещаемости на разные даты:

ID  01/07/2010  01/07/2011  01/07/2012
4   100%        50%         75%
2   60%         40%         30%
6   80%         60%         100%

Я хотел бы создать новый фрейм данных, содержащий списокидентификаторов и их посещаемости для каждого года их жизни, где даты, указанные в заголовках столбцов в кадре данных Attendance, находятся между двумя датами в кадре данных ID_List. Исходя из приведенного выше примера, это будет выглядеть так:

ID  Y1_att  Y2_att  Y3_att
1   NA      NA      NA
2   60%     40%     30%
3   NA      NA      NA

Я пытался сделать это, используя функции %within% и interval в сочетании с mutate:

ID_all <- left_join(ID_list, Attendance, by = ID)
ID_all <- mutate(ID_all, Y1_att = ifelse(**column name** %within% interval(DOB, Y1), **value from column name**, NA)

где значения в звездочках взяты из Attendance кадра данных. Идея состоит в том, чтобы перебрать столбцы, взятые из Attendance кадра данных, но я не уверен, как ссылаться на столбец в функции mutate, одновременно используя его в вычислениях, или если есть лучший способ сделать эточем объединение двух информационных фреймов с самого начала.

1 Ответ

1 голос
/ 24 октября 2019

Есть несколько вещей, которые вы можете сделать здесь, чтобы решить вашу проблему.

Во-первых, ID_list не очень полезен, поскольку дни рождения обычно разделены ровно одним годом, поэтому вы можете получить значение автоматически. Во-вторых, набор данных Attendance имеет неправильный формат для того, чего вы хотите достичь: он широкий (количество столбцов может интенсивно расти) и его легче обрабатывать до тех пор.

Для этого вы можетеиспользуйте новые функции pivot_longer и pivot_wider из пакета tidyr (которые ранее назывались gather и spread).

library(lubridate)
library(tidyverse)

ID_list = read.table(text = "
ID DOB         Y1          Y2          Y3
1  01/05/2003  01/05/2004  01/05/2005  01/05/2006
2  05/02/2010  05/02/2011  05/02/2012  05/02/2013
3  17/06/2015  17/06/2016  17/06/2017  17/06/2018
", header=T) 

Attendance = read.table(text = "
ID  01/07/2010  01/07/2011  01/07/2012
4   100%        50%         75%
2   60%         40%         30%
6   80%         60%         100%
", header=T) 


Attendance_long = Attendance %>% 
  pivot_longer(-ID, names_to = "date", values_to = "percent") %>% 
  mutate(date=date %>% str_remove("X") %>% str_replace_all("\\.", "/") %>% as.Date("%d/%m/%Y")) #dates as columns behave badly, needs refactoring :-(
Attendance_long

# A tibble: 9 x 3
#     ID date       percent
#  <int> <date>     <fct>  
#1     4 2010-07-01 100%   
#2     4 2011-07-01 50%    
#3     4 2012-07-01 75%    
#4     2 2010-07-01 60%    
#5     2 2011-07-01 40%    
#6     2 2012-07-01 30%    
#7     6 2010-07-01 80%    
#8     6 2011-07-01 60%    
#9     6 2012-07-01 100%    

С посещаемостью в длинном формате вы можетеТеперь объедините свои данные и вычислите номер года как разницу между датой посещения и датой рождения (выделено). Затем, чтобы получить ожидаемый результат, вы можете снова развернуть широкоформатный формат и удалить ненужные столбцы.

ID_all = ID_list %>% as_tibble %>% 
  select(ID, DOB) %>% #don't need other columns
  left_join(Attendance_long, by="ID") %>% 
  mutate_at(vars(DOB), as.Date, format="%d/%m/%Y") %>% 
  mutate(year = ceiling(interval(DOB, date) / years(1)),
         year = ifelse(!is.na(year), paste0("Y", year, "_att"), year))%>% 
  select(-date) %>% #important to pivot
  pivot_wider(names_from = year,
              values_from = percent) %>% 
  select(-`NA`, -DOB) 

ID_all

Надеюсь, это помогло!

...