使用dplyr按组/ID滚动平均值（移动平均值）

Question

我有一组血压的纵向随访记录。

某一时间点上的值与移动平均线（滚动平均）相比不太具有预测性，这就是为什么我想要计算它的原因。数据看起来像：

test <- read.table(header=TRUE, text = "
  ID  AGE   YEAR_VISIT  BLOOD_PRESSURE  TREATMENT
  1 20  2000    NA 3
  1 21  2001    129 2
  1 22  2002    145 3
  1 22  2002    130 2
  2 23  2003    NA  NA
  2 30  2010    150 2
  2 31  2011    110 3
  4 50  2005    140 3
  4 50  2005    130 3
  4 50  2005    NA  3
  4 51  2006    312 2
  5 27  2010    140 4
  5 28  2011    170 4
  5 29  2012    160 NA
  7 40  2007    120 NA
                   ")

我想计算一个新变量，称之为BLOOD_PRESSURE_UPDATED。该变量应该是BLOOD_PRESSURE的移动平均值，并具有以下特征：

• 移动平均值是当前值加上前一个值除以二。
• 对于第一次观察，BLOOD_PRESSURE_UPDATED就是当前的BLOOD_PRESSURE。如果缺失，BLOOD_PRESSURE_UPDATED应该是整体平均值。
• 缺失值应填充最近的先前值。

我尝试了以下方法:

test2 <- test %>%
  group_by(ID) %>%
  arrange(ID, YEAR_VISIT) %>%
  mutate(BLOOD_PRESSURE_UPDATED = rollmean(x=BLOOD_PRESSURE, 2)) %>%
ungroup()

我也尝试过使用rollapply和rollmeanr，但没有成功。

- Adam Robinsson

---

在计算移动平均值时，返回的元素数量少于数据行数，即仅返回“n-1”个元素。因此可能会在这里引起问题。或者您是否考虑单独添加移动平均列，例如：test2$BLOOD_PRESSURE_UPDATED <- with(test2, c(mean(BLOOD_PRESSURE, na.rm = T), rollapply(BLOOD_PRESSURE, 2, mean, na.rm = T)))。 - KFB

感谢您的努力，KFB。不幸的是，它没有起作用。我也尝试了几个编辑版本。也许动物园函数不适合这个问题？我编写了以下代码，可以正常工作：test5 <- test test5$UM <- rep(NA, nrow(test5)) test5$first <- !duplicated(test5$ID) for(i in 1:nrow(test5)){ if(test5$first[i]){ test5$UM[i] <- test5$BLOOD_PRESSURE[i] }else{ test5$UM[i] <- mean(c(test5$BLOOD_PRESSURE[i] , test5$UM[i-1]), na.rm=TRUE) } } test5但是它运行得非常慢。 - Adam Robinsson

只是好奇，为什么要使用两种缺失值插补方法？似乎对于第一个观测值的缺失值插补（使用当前观测值或整个组的平均值进行插补）和其他观测值的缺失值插补（使用最近的前一个观测值进行插补）是不同的。 - Jason Goal

Answer 1

这个怎么样？

    library(dplyr)   
    test2<-arrange(test,ID,YEAR_VISIT) %>% 
           mutate(lag1=lag(BLOOD_PRESSURE),
                  lag2=lag(BLOOD_PRESSURE,2),
                  movave=(lag1+lag2)/2)

使用zoo包中的'rollapply'函数的另一个解决方案（我更喜欢）

library(dplyr)
library(zoo)
test2<-arrange(test,ID,YEAR_VISIT) %>%
       mutate(ma2=rollapply(BLOOD_PRESSURE,2,mean,align='right',fill=NA))

- hyunwoo jeong

---

请注意，如果使用rollapplyr，则可以省略align参数。 - G. Grothendieck

如果我想对当前位置的第15到18个值求平均，该怎么做？ - SqueakyBeak

始终使用 dplyr::mutate 以避免意外结果。 - Jason Goal

Answer 2

slider 是一个“较新”的替代方案，与 tidyverse 兼容性良好。

类似这样的东西就足够了。

test2 <- test %>%
  group_by(ID) %>%
  arrange(ID, YEAR_VISIT) %>%
  mutate(BLOOD_PRESSURE_UPDATED = slider::slide_dbl(BLOOD_PRESSURE, mean, .before = 1, .after = 0)) %>%
ungroup()

- elikesprogramming

Answer 3

如果您不想使用 dplyr，这应该可以工作：

get.mav <- function(bp,n=2){
  require(zoo)
  if(is.na(bp[1])) bp[1] <- mean(bp,na.rm=TRUE)
  bp <- na.locf(bp,na.rm=FALSE)
  if(length(bp)<n) return(bp)
  c(bp[1:(n-1)],rollapply(bp,width=n,mean,align="right"))  
}
test <- with(test,test[order(ID,YEAR_VISIT),])

test$BLOOD_PRESSURE_UPDATED <- 
  unlist(aggregate(BLOOD_PRESSURE~ID,test,get.mav,na.action=NULL,n=2)$BLOOD_PRESSURE)
test
#    ID AGE YEAR_VISIT BLOOD_PRESSURE TREATMENT BLOOD_PRESSURE_UPDATED
# 1   1  20       2000             NA         3               134.6667
# 2   1  21       2001            129         2               131.8333
# 3   1  22       2002            145         3               137.0000
# 4   1  22       2002            130         2               137.5000
# 5   2  23       2003             NA        NA               130.0000
# 6   2  30       2010            150         2               140.0000
# 7   2  31       2011            110         3               130.0000
# ...

这适用于移动平均值 > 2。

以下是一种使用data.table的解决方案，如果数据集很大，则可能会更快。

library(data.table)
setDT(test)     # converts test to a data.table in place
setkey(test,ID,YEAR_VISIT)
test[,BLOOD_PRESSURE_UPDATED:=as.numeric(get.mav(BLOOD_PRESSURE,2)),by=ID]
test
#    ID AGE YEAR_VISIT BLOOD_PRESSURE TREATMENT BLOOD_PRESSURE_UPDATED
#  1:  1  20       2000             NA         3               134.6667
#  2:  1  21       2001            129         2               131.8333
#  3:  1  22       2002            145         3               137.0000
#  4:  1  22       2002            130         2               137.5000
#  5:  2  23       2003             NA        NA               130.0000
#  6:  2  30       2010            150         2               140.0000
#  7:  2  31       2011            110         3               130.0000
# ...

- jlhoward

---

感谢@jlhoward！-它解决了问题，但data.table方法（两种方法中更快的一种）非常慢（300万行，在新MBP上需要15分钟）。但无论如何，问题已解决。 - Adam Robinsson

谢谢@jlhoward。这节省了我很长的计算时间...我之前使用ddply，但时间真的很糟糕！ - EsBee

@jhoward 新的 frollmean 函数应该可以作为 get.mav 的替代品。更多信息请参阅?froll。 - jangorecki

或许不需要，不确定这个第一个元素的NA值处理。 - jangorecki

Answer 4

试试这个：

library(dplyr)
library(zoo)
test2<-arrange(test,ID,YEAR_VISIT) %>% group_by(subject)%>%
       mutate(ma2=rollapply(BLOOD_PRESSURE,2,mean,align='right',fill=NA))

- pier

---

你也可以在最后一行使用 rollmean 函数： rollmean(BLOOD_PRESSURE,2,align='right',fill=NA) - Angie