如何根据日期计算总结数据

Question

我有这样的数据(笔记日期采用DD-MM-YYYY格式)：

ID  date      drug  score
A   28/08/2016  2   3
A   29/08/2016  1   4
A   30/08/2016  2   4
A   2/09/2016   2   4
A   3/09/2016   1   4
A   4/09/2016   2   4
B   8/08/2016   1   3
B   9/08/2016   2   4
B   10/08/2016  2   3
B   11/08/2016  1   3
C   30/11/2016  2   4
C   2/12/2016   1   5
C   3/12/2016   2   1
C   5/12/2016   1   4
C   6/12/2016   2   4
C   8/12/2016   1   2
C   9/12/2016   1   2    

“毒品”：服用1=drug，服用2=no药物。

我需要总结一下每一个ID：

• 第一天:服用药物的日子的平均分数。
• -1天:服药前几天的平均得分。
• +1天:服药后第一天的平均得分。

如果一种药物连续服用2天(例如示例的最后2行)，那么这些分数不应计算在-1天或+1天的计算中(也就是说，最后两行中的每一行都将有助于0天的得分，但不会对其他指标作出贡献)。

因此，对于这个示例数据，我需要一个输出表，如下所示：

    -1day   0day      +1day
A   3.5     4         4
B   3       3         4
C           3.25      2.5

注意，并非所有日期都有记录，-1天和+1天的计算需要基于实际日期，而不仅仅是数据集中的记录。

我不知道该怎么做。

我还有两个额外的问题：

• 我很可能也需要计算-2天和+2天的分数，所以需要能够适应一个答案来做到这一点。
• 我如何计算一个NoDrug评分，这是所有的日子，不是在服用一天后的5天的平均数。

下面是用这个示例数据生成数据的代码：

data<-data.frame(ID=c("A","A","A","A","A","A","B","B","B","B","C","C","C","C","C","C","C"),
                 date=as.Date(c("28/08/2016","29/08/2016","30/08/2016","2/09/2016","3/09/2016","4/09/2016","8/08/2016","9/08/2016","10/08/2016","11/08/2016","30/11/2016","2/12/2016","3/12/2016","5/12/2016","6/12/2016","8/12/2016","9/12/2016"),format= "%d/%m/%Y"),
                 drug=c(2,1,2,2,1,2,1,2,2,1,2,1,2,1,2,1,1),
                 score=c(3,4,4,4,4,4,3,4,3,3,4,5,1,4,4,2,2))

Answer 1

您可以使用dplyr获得以下内容：

创建数据

df <- data.frame(
  ID=c("A","A","A","A","A","A","B","B","B","B","C","C","C","C","C","C","C"),
  date=as.Date(c("28/08/2016","29/08/2016","30/08/2016","2/09/2016","3/09/2016","4/09/2016","8/08/2016","9/08/2016","10/08/2016","11/08/2016","30/11/2016","2/12/2016","3/12/2016","5/12/2016","6/12/2016","8/12/2016","9/12/2016"),format= "%d/%m/%Y"),
  drug=c(2,1,2,2,1,2,1,2,2,1,2,1,2,1,2,1,1),
  score=c(3,4,4,4,4,4,3,4,3,3,4,5,1,4,4,2,2)
)

df

#>    ID       date drug score
#> 1   A 2016-08-28    2     3
#> 2   A 2016-08-29    1     4
#> 3   A 2016-08-30    2     4
#> 4   A 2016-09-02    2     4
#> 5   A 2016-09-03    1     4
#> 6   A 2016-09-04    2     4
#> 7   B 2016-08-08    1     3
#> 8   B 2016-08-09    2     4
#> 9   B 2016-08-10    2     3
#> 10  B 2016-08-11    1     3
#> 11  C 2016-11-30    2     4
#> 12  C 2016-12-02    1     5
#> 13  C 2016-12-03    2     1
#> 14  C 2016-12-05    1     4
#> 15  C 2016-12-06    2     4
#> 16  C 2016-12-08    1     2
#> 17  C 2016-12-09    1     2

填写缺失的行(天)

解决这类问题的一个很好的方法是使用tidyr::complete，从而使行隐式地丢失观察结果。

library(dplyr)
library(tidyr)

df1 <- df %>% 
  group_by(ID) %>% 
  complete(date = seq(min(date), max(date), by = "day"))

df1

#> Source: local data frame [22 x 4]
#> Groups: ID [3]
#> 
#> # A tibble: 22 x 4
#>        ID       date  drug score
#>    <fctr>     <date> <dbl> <dbl>
#>  1      A 2016-08-28     2     3
#>  2      A 2016-08-29     1     4
#>  3      A 2016-08-30     2     4
#>  4      A 2016-08-31    NA    NA
#>  5      A 2016-09-01    NA    NA
#>  6      A 2016-09-02     2     4
#>  7      A 2016-09-03     1     4
#>  8      A 2016-09-04     2     4
#>  9      B 2016-08-08     1     3
#> 10      B 2016-08-09     2     4
#> # ... with 12 more rows

将天数分类

df2 <- df1 %>% 
  group_by(ID) %>% 
  mutate(day_of = drug == 1,
         day_before = (lead(drug) == 1 & day_of == FALSE),
         day_after = (lag(drug) == 1 & day_of == FALSE))

df2

#> Source: local data frame [22 x 7]
#> Groups: ID [3]
#> 
#> # A tibble: 22 x 7
#>        ID       date  drug score day_of day_before day_after
#>    <fctr>     <date> <dbl> <dbl>  <lgl>      <lgl>     <lgl>
#>  1      A 2016-08-28     2     3  FALSE       TRUE        NA
#>  2      A 2016-08-29     1     4   TRUE      FALSE     FALSE
#>  3      A 2016-08-30     2     4  FALSE         NA      TRUE
#>  4      A 2016-08-31    NA    NA     NA         NA     FALSE
#>  5      A 2016-09-01    NA    NA     NA      FALSE        NA
#>  6      A 2016-09-02     2     4  FALSE       TRUE        NA
#>  7      A 2016-09-03     1     4   TRUE      FALSE     FALSE
#>  8      A 2016-09-04     2     4  FALSE         NA      TRUE
#>  9      B 2016-08-08     1     3   TRUE      FALSE     FALSE
#> 10      B 2016-08-09     2     4  FALSE      FALSE      TRUE
#> # ... with 12 more rows

按日类型汇总

dplyr::mutate_at将一个函数(在funs()中)应用于在vars()中选择的所有列。summarise_at的操作方式与对某些选定列的操作相同，但它没有更改完整数据集的值，而是将每个组的操作减少到一行。可以阅读更多关于mmutate、summarise和特殊*_at版本的信息。

df3 <- df2 %>% 
  mutate_at(vars(starts_with("day_")), funs(if_else(. == TRUE, score, NA_real_))) %>% 
  summarise_at(vars(starts_with("day_")), mean, na.rm = TRUE)

df3

#> # A tibble: 3 x 4
#>       ID day_of day_before day_after
#>   <fctr>  <dbl>      <dbl>     <dbl>
#> 1      A   4.00        3.5       4.0
#> 2      B   3.00        3.0       4.0
#> 3      C   3.25        NaN       2.5

Answer 2

这里有一种使用dplyr及其lead和lag函数的可能性：

  library(tidyverse)
data %>% group_by(ID) %>% 
    arrange(date)  %>% 
    mutate(
        # use ifelse for cases of drugs being take twice or more in a row
        `-1 day` = ifelse(dplyr::lag(drug) != 1, dplyr::lag(score, 1), NA),
        `+1 day` = ifelse(dplyr::lead(drug) != 1, dplyr::lead(score, 1), NA)
    ) %>%
    filter(drug == 1) %>% 
    summarise_all(mean, na.rm = TRUE) %>% 
    select(
        `-1 day`,
        `0 day` = score,
        `+1 day`,
        -date,
        -drug
    )

# A tibble: 3 × 3
  `-1 day` `0 day` `+1 day`
     <dbl>   <dbl>    <dbl>
1      3.5    4.00      4.0
2      3.0    3.00      4.0
3      3.0    3.25      2.5

Answer 3

我更喜欢使用时间序列包(如zoo)来执行这样的任务。

library(zoo)
#function that handles conversion to zoo time series
my_zoo=function(x,idx) {
  date_range=seq(min(idx),max(idx),by="day")
  #add missing dates
  dummy_zoo=merge(zoo(x,idx),zoo(NA,date_range),all=TRUE)[,1]
  #add NA entry at top/bottom
  rbind(dummy_zoo,rbind(zoo(NA,max(idx)+1),zoo(NA,min(idx)-1)))
}

#split by ID, handle cases where drug is NA
split_data=lapply(split(data,df$ID),function(x) {
  list(score=my_zoo(x$score,x$date),
       taken=(my_zoo(x$drug,x$date)==1)&
         !is.na(my_zoo(x$drug,x$date)))})

#calculate stats
#your requirement that subsequent days with drug taken...
#... are completely omitted is a bit tricky to handle 
res=data.frame(
  mean_m1=sapply(split_data,function(x) {
    mean(x$score[diff(x$taken,-1)>0&
                   lag(diff(x$taken),+1)],
         na.rm=TRUE)}),
  mean_0=sapply(split_data,function(x) {
    mean(x$score[x$taken],
         na.rm=TRUE)}),
  mean_p1=sapply(split_data,function(x) {
    mean(x$score[diff(x$taken,+1)<0&
                   lag(diff(x$taken),-1)],
         na.rm=TRUE)}))
res
#   mean_m1 mean_0 mean_p1
# A     3.5   4.00     4.0
# B     3.0   3.00     4.0
# C     NaN   3.25     2.5