Cán trung bình (di chuyển trung bình) theo nhóm/id với dplyr

Question

Tôi có theo dõi dọc các bản ghi huyết áp.

Giá trị tại một điểm nhất định ít dự đoán hơn là giá trị trung bình di chuyển (giá trị trung bình cán), đó là lý do tôi muốn tính toán giá trị đó. Dữ liệu trông giống như

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 
        ") 

Tôi muốn tính biến mới, được gọi là BLOOD_PRESSURE_UPDATED. Biến này phải là trung bình di chuyển cho BLOOD_PRESSURE và có các đặc điểm sau:

• Giá trị hiện tại cộng với giá trị trước đó chia cho hai.
• Đối với quan sát đầu tiên, BLOOD_PRESSURE_UPDATED chỉ là BLOOD_PRESSURE hiện tại. Nếu thiếu , BLOOD_PRESSURE_UPDATED phải là giá trị trung bình tổng thể.
• Giá trị thiếu phải được điền bằng giá trị trước đó gần nhất.

Tôi đã thử những điều sau đây:

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

Tôi cũng đã cố gắng rollaply và rollmeanr mà không thành công.

Tôi đánh giá cao một số trợ giúp.

Answer 1

Nếu bạn không cam kết để dplyr này nên làm việc:

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 
# ... 

này hoạt động cho việc di chuyển trung bình> 2 là tốt.

Và đây là giải pháp data.table, có khả năng là nhiều hơn nhanh hơn nếu tập dữ liệu của bạn lớn.

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 
# ... 

Answer 2

Làm thế nào về điều này?

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

Một giải pháp sử dụng chức năng 'rollapply' trong gói vườn thú (tôi thích hơn)

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