시간 가중 평균을 계산하고 지연을 만드는 방법

Question

나는 포럼을 수색했지만 포럼에서 내가 원하는 것을 수행하는 방법에 대한 답변이나 힌트를 제공 할 수있는 것을 찾지 못했습니다.

나는 각 개인이 연구에 참여할 때를 기준으로 개인별 연평균 평균치를 계산하고자하는 노출 데이터를 매년 측정하고 있습니다. 각 행에 대해 1 년 노출 할당은 연구에 합류하기 전 지난 달로부터 시작하여 이전 12 개월의 데이터를 포함해야합니다. 예를 들어 샘플 데이터의 첫 번째 사람이 2002 년 2 월 7 일에 연구에 참여했습니다. 그의 노출은 2002 년 1 월 (연평균 평균 18 세)과 2001 년 2 월 ~ 12 월 (연간 평균 19 세)의 기여도를 포함합니다. 이 사람의 시간 가중 평균은 (1/12 * 18) + (11/12 * 19)가됩니다. 동일한 사람에 대한 2 년 평균 노출은 2002 년 1 월부터 2000 년 2 월까지 연장됩니다.

마찬가지로 2004 년 12 월에 연구에 합류 한 마지막 사람은 2004 년 11 개월 및 2003 년 1 개월에 대한 기여 연간 평균 노출은 2003 년의 연평균 평균 (11/12 * 5)과 2004 년의 평균 (1/12 * 6)이 될 것입니다.

1 년, 2 년 및 5 년 평균 노출은 어떻게 계산할 수 있습니까? 입학 일로부터 연구로 돌아 가셨습니까? 내가 어떻게 기술 한 방식으로 지연을 사용할 수 있습니까?

샘플 데이터는이 링크

https://drive.google.com/file/d/0B_4NdfcEvU7La1ZCd2EtbEdaeGs/view?usp=sharing

Answer 1

이 우아한 대답하지 않습니다에서 액세스 할 수 있습니다. 그러나 나는 내가 시도한 것을 떠나고 싶다. 먼저 데이터 프레임을 정렬했습니다. 각 연도의 주요 연도가 어느 연도인지 파악하고 싶었습니다. 그래서 id을 만들었습니다. variable은 원본 데이터 세트의 열 이름 (예 : pol_2000)에서 가져옵니다. entryYear은 데이터에 entry에서 온 것입니다. entryMonth은 entry에서도 제공됩니다. check은 각 참가자의 기준 연도를 식별하기 위해 작성되었습니다. 다음 단계에서는 SOfun 패키지에 getMyRows을 사용하여 각 참가자에 대해 6 개의 행을 추출했습니다. 다음 단계에서는 질문에 설명 된대로 lapply을 사용하고 수학을 수행했습니다. 2 년 또는 5 년 평균 계산을 위해 총 가치를 2 년 또는 5 년으로 나누었습니다. 나는 최종 출력물이 어떻게 생겼는지 확신 할 수 없었다. 그래서 각 주제에 기본 연도를 사용하기로 결정하고 세 개의 열을 추가했습니다.

library(stringi) 
library(SOfun) 
devtools::install_github("hadley/tidyr") 
library(tidyr) 
library(dplyr) 


### Big thanks to BondedDust for this function 
### http://stackoverflow.com/questions/6987478/convert-a-month-abbreviation-to-a-numeric-month-in-r 

mo2Num <- function(x) match(tolower(x), tolower(month.abb)) 


### Arrange the data frame. 
ana <- foo %>% 
     mutate(id = 1:n()) %>% 
     melt(id.vars = c("id","entry")) %>% 
     arrange(id) %>% 
     mutate(variable = as.numeric(gsub("^.*_", "", variable)), 
       entryYear = as.numeric(stri_extract_last(entry, regex = "\\d+")), 
       entryMonth = mo2Num(substr(entry, 3,5)) - 1, 
       check = ifelse(variable == entryYear, "Y", "N")) 

### Find a base year for each subject and get some parts of data for each participant. 
indx <- which(ana$check == "Y") 
bob <- getMyRows(ana, pattern = indx, -5:0) 


### Get one-year average 
cathy <- lapply(bob, function(x){ 
    x$one <- ((x[6,6]/12) * x[6,4]) + (((12-x[5,6])/12) * x[5,4]) 
    x 
}) 

one <- unnest(lapply(cathy, `[`, i = 6, j = 8)) 

### Get two-year average 
cathy <- lapply(bob, function(x){ 
    x$two <- (((x[6,6]/12) * x[6,4]) + x[5,4] + (((12-x[4,6])/12) * x[4,4]))/2 
    x 
}) 

two <- unnest(lapply(cathy, `[`, i = 6, j =8)) 


### Get five-year average 
cathy <- lapply(bob, function(x){ 
    x$five <- (((x[6,6]/12) * x[6,4]) + x[5,4] + x[4,4] + x[3,4] + x[2,4] + (((12-x[2,6])/12) * x[1,4]))/5 
    x 
}) 

five <- unnest(lapply(cathy, `[`, i =6 , j =8)) 

### Combine the results with the key observations 
final <- cbind(ana[which(ana$check == "Y"),], one, two, five) 
colnames(final) <- c(names(ana), "one", "two", "five") 

# id  entry variable value entryYear entryMonth check  one  two  five 
#6 1 07feb2002  2002 18  2002   1  Y 18.916667 18.500000 18.766667 
#14 2 06jun2002  2002 16  2002   5  Y 16.583333 16.791667 17.150000 
#23 3 16apr2003  2003 14  2003   3  Y 15.500000 15.750000 16.050000 
#31 4 26may2003  2003 16  2003   4  Y 16.666667 17.166667 17.400000 
#39 5 11jun2003  2003 13  2003   5  Y 13.583333 14.083333 14.233333 
#48 6 20feb2004  2004  3  2004   1  Y 3.000000 3.458333 3.783333 
#56 7 25jul2004  2004  2  2004   6  Y 2.000000 2.250000 2.700000 
#64 8 19aug2004  2004  4  2004   7  Y 4.000000 4.208333 4.683333 
#72 9 19dec2004  2004  5  2004   11  Y 5.083333 5.458333 4.800000