按日期（包括列標題）對數據框列進行分組，並匯總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)