按日期（包括列标题）对数据框列进行分组，并汇总R中1和0的实例

Question

我有一个烦人的编码问题，感谢您的协助。

以下是一些示例数据：

ID     "2013-03-20"    "2013-04-09"    "2013-04-11"    "2013-04-17"    
5167f            0               0               0               1  
1214m            0               0               0               0  
1844f            0               1               1               0  
2113m            0               0               1               1  

麻烦之处在于：请注意示例数据框的列名称如何包含日期，并且某些日期可能彼此接近。 ID列是观察值的简单唯一标识符。

这是我的目标：

（1）我希望能够首先根据各列是否在2周（或14天）范围内（即从"2013-03-20"开始，以2周为增量定义”）对列进行分组"2013-03-20"直到"2016-12-20" ）； 因此，如果它们的确落在同一范围内，则它们将收到相同的标识符（对于新数据框；例如， Period1表示介于"2013-03-20"和"2013-04-03"之间的任何日期） 。

（2）将所有日期列都分配给特定时段后，我想按以下方式汇总每个时段的单元格数据（0和1s）：如果某个人在特定时段出现了1个（在全部），则该个人在整个期间内将收到1 （而且，如果该个人在该期间内只有0，则在该期间内将收到0 ）。

（3）定义完此工作流程后，我想根据日期和月份将日期按季节和年份分组（例如， WinterYYYY = 12月，1月，2月； SpringYYYY = 3月，4月，5月； SummerYYYY = 6月，7月， 8月； FallYYYY = 9月，10月，11月）以生成新的数据框。

总之，要手动演示产品：

（目标1和目标2的最终产品；即，仅用于示例数据的前两列[括号中的日期范围仅作参考）

ID     Period1 ("2013-03-20" - "2013-04-03")        Period2 ("2013-04-04" - "2013-04-18")      
5167f                                    0                                 1    
1214m                                    0                                 0    
1844f                                    0                                 1    
2113m                                    0                                 1    

（目标2和目标3的最终产品；即样本数据中的所有列[括号中的月份范围仅作参考）

ID                Spring2013  (March - May)    
5167f                                    1  
1214m                                    0  
1844f                                    1  
2113m                                    1

也许， dplyr软件包中的内容可能有用，但我不确定。

预先感谢您的帮助。 请随时提出任何后续问题进行澄清。

-广告-

Answer 1

请先将数据整理整齐。

library(dplyr)
data <- gather(data, date, value, -ID )

然后尝试：

library(lubridate)
data$date  <- ymd(data$date)
data <-  mutate(data, period = date - as.Date("2013-03-20")) #difference in days
data <- mutate(data, period2 = ceiling(as.numeric(data$period)/14))
data$period2 <- ifelse(data$period2 == 0, 1, data$period2) #change period 0 to period 1

newdat <- data %>% 
          group_by(ID, period2) %>%
          summarise(result = ifelse(sum(value)>0, 1, 0))

使用spread()函数更改回原始格式。

Answer 2

这是使用tidyverse函数的解决方案。

# Load packages
library(tidyverse)
library(data.table)
library(lubridate)

# Create example data frames
dt <- fread("ID     '2013-03-20'    '2013-04-09'    '2013-04-11'    '2013-04-17'    
5167f            0               0               0               1  
                 1214m            0               0               0               0  
                 1844f            0               1               1               0  
                 2113m            0               0               1               1")

关键是准备一个表，该表显示日期和分组变量（例如期间，月份或季节）之间的关联。 在此示例中， dt_merge是这样的表。

dt_merge <- data_frame(
  # Create a column showing the beginning date
  Date1 = seq(from = ymd("2013-03-20"), to = ymd("2016-12-20"), by = "2 weeks")) %>%
  # Create  a column showing the end date of each period
  mutate(Date2 = lead(Date1)) %>%
  # Adjust Date1
  mutate(Date1 = if_else(Date1 == ymd("2013-03-20"), Date1, Date1 + 1)) %>%
  # Remove the last row
  drop_na(Date2) %>%
  # Create date list
  mutate(Dates = map2(Date1, Date2, function(x, y){ seq(x, y, by = "day") })) %>%
  unnest() %>%
  # Create Group ID
  mutate(RunID = group_indices_(., dots. = c("Date1", "Date2"))) %>%
  # Create Period ID
  mutate(Period = paste0("Period", RunID)) %>%
  # Add a column showing Month
  mutate(Month = month(Dates)) %>%
  # Add a column showing Year
  mutate(Year = year(Dates)) %>%
  # Add a column showing season
  mutate(Season = case_when(
    Month %in% 3:5            ~ "Spring",
    Month %in% 6:8            ~ "Summer",
    Month %in% 9:11           ~ "Fall",
    Month %in% c(12, 1, 2)    ~ "Winter",
    TRUE                      ~ NA_character_
  )) %>%
  # Combine Season and Year
  mutate(SeasonYear = paste0(Season, Year)) %>%
  select(-Date1, -Date2, -RunID)

完成此步骤后，可以轻松生成所需的输出。 在此示例中， dt3是第一个最终产品。 dt4是第二个产品。

dt2 <- dt %>%
  # Reshape the data frame
  gather(Date, Value, -ID) %>%
  # Convert Date to date class
  mutate(Date = ymd(Date)) %>%
  # Join dt_merge
  left_join(dt_merge, by = c("Date" = "Dates"))

# Product 1
dt3 <- dt2 %>%
  group_by(ID, Period) %>%
  summarise(Value = max(Value)) %>%
  spread(Period, Value)

# Product 2
dt4 <- dt2 
  group_by(ID, SeasonYear) %>%
  summarise(Value = max(Value)) %>%
  spread(SeasonYear, Value)