滚动平均(移动平均)由组/ id与dplyr
我有一个纵向的血压logging的后续行动。
某一点的价值比移动平均值(滚动均值)要低,这就是我为什么要计算的原因。 数据看起来像
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的新variables。 这个variables应该是BLOOD_PRESSURE的移动平均值,并具有以下特征:
- 移动平均线是当前值加上以前的值除以2。
- 对于第一个观察,BLOOD_PRESSURE_UPDATED就是当前的BLOOD_PRESSURE。 如果缺less,BLOOD_PRESSURE_UPDATED应该是整体意思。
- 缺失的值应该填入最近的值。
我已经尝试了以下内容:
test2 <- test %>% group_by(ID) %>% arrange(ID, YEAR_VISIT) %>% mutate(BLOOD_PRESSURE_UPDATED = rollmean(x=BLOOD_PRESSURE, 2)) %>% ungroup()
我也尝试rollaply和rollmeanr没有成功。
我会很感激一些帮助。
如果你不承诺这个应该工作:
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解决scheme,如果你的数据集很大,这个解决scheme可能会快得多。
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 # ...
这个怎么样?
library(dplyr) test2<-arrange(test,ID,YEAR_VISIT) %>% mutate(lag1=lag(BLOOD_PRESSURE), lag2=lag(BLOOD_PRESSURE,2), movave=(lag1+lag2)/2)
另一个在动物园包中使用“rollapply”函数的解决scheme(我喜欢更多)
library(dplyr) library(zoo) test2<-arrange(test,ID,YEAR_VISIT) %>% mutate(ma2=rollapply(BLOOD_PRESSURE,2,mean,align='right',fill=NA))