시계열로 예측하는 함수

Question

R에서 작업하기. 초기 값과 일련의 전환 매개 변수를 사용하여 유행의 시계열을 예측하고 싶습니다. 다음과 같은 구조의 데이터에 대한 열의

cohort <- c(1980,1981,1982) 
A00 <- c(.15, .2,.4) 
B00 <- c(.25, .3, .4) 
C00 <-c(.6, .5,.2) 
Tab<-c(.6,.5,.4) 
Tac<-c(.2,.25,.35) 
ds <- data.frame(cohort,A00,B00,C00,Tab,Tac) 
print (ds) 

    cohort A00 B00 C00 Tab Tac 
1 1980 0.15 0.25 0.6 0.6 0.20 
2 1981 0.20 0.30 0.5 0.5 0.25 
3 1982 0.40 0.40 0.2 0.4 0.35 

초기 값은 A00, B00 및 C00은 시간 t = 00에서, 각 군 (A, B, C)의 적절한 크기를 나타낸다. 그들은 행 (A00 + B00 + C00 = 1)에 걸쳐 최대 1을 더합니다. 파라미터 탭 전술는 시간 t에서 예측 된 값을 계산하는 예

A01 = df$A00 -df$Tab +df$Tac. 

위한 수학적 모델을 사용하여 시간 t + 1에서 유행을 예측하는 기능을 사용 + 1

forecast<- function(df) { 
    dsResult <- data.frame(
    cohort= df$cohort, 
    A01 = df$A00 -df$Tab +df$Tac ,  
    B01 = df$B00 -df$Tab +df$Tac,  
    C01 = df$C00 -df$Tab +df$Tac  

) 
    dsResult<- merge(df,dsResult,by="cohort") 
    return(dsResult) 
} 
new<-forecast(ds) 

이며 생산 나는 매우 많은 1 t에 대한 (예측의 년의 원하는 번호를 순환 루프를 작성하는 방법을 학습에 도움 감사하겠습니다 결과

cohort A00 B00 C00 Tab Tac A01 B01 C01 
1 1980 0.15 0.25 0.6 0.6 0.20 -0.25 -0.15 0.20 
2 1981 0.20 0.30 0.5 0.5 0.25 -0.05 0.05 0.25 
3 1982 0.40 0.40 0.2 0.4 0.35 0.35 0.35 0.15 

다음 : 7 예를 들어). 미리 감사드립니다!

Answer 1

초기에는 코드 작성이 더 쉽도록 두 가지 제안을하고 싶습니다. 먼저 데이터 스키마를 수정하여 각 연도가 고유 한 행이되고 각 그룹이 고유 한 열이되도록합니다. 두 번째로, 코호트는 수학적으로 서로 독립적으로 취급되기 때문에 적어도 코드의 커널이 빌드 될 때까지는 코호트를 별도로 유지하십시오. 나중에이 둘레를 순환하는 고리를 놓으십시오. 첫 번째 코드 블록에는 관찰 된 데이터가있는 행렬과 예측 된 데이터를 수집하는 행렬이라는 두 개의 행렬이 있습니다.

yearCount <- 7 #Declare the number of time points. 
groupCount <- 3 #Declare the number of groups. 

#Create fake data that sum to 1 across rows/times. 
ob <- matrix(runif(yearCount*groupCount), ncol=groupCount) 
ob <- ob/apply(ob, 1, function(x){ return(sum(x))}) 

#Establish a container to old the predicted values. 
pred <- matrix(NA_real_, ncol=groupCount, nrow=yearCount) 

t12<-.5; t13<-.2; t11<-1-t12-t13 #Transition parameters from group 1 
t21<-.2; t23<-.4; t22<-1-t21-t23 #Transition parameters from group 2 
t31<-.3; t32<-.1; t33<-1-t31-t32 #Transition parameters from group 3 

for(i in 2:yearCount) { 
    pred[i, 1] <- ob[i-1, 1]*t11 + ob[i-1, 2]*t21 + ob[i-1, 3]*t31 
    pred[i, 2] <- ob[i-1, 1]*t12 + ob[i-1, 2]*t22 + ob[i-1, 3]*t32 
    pred[i, 3] <- ob[i-1, 1]*t13 + ob[i-1, 2]*t23 + ob[i-1, 3]*t33 
} 

#Calculate the squared errors 
ss <- (pred[-1, ] - ob[-1, ])^2 #Ignore the first year of data 

루프 내부에서 행렬 곱셈에 익숙한 구조를 알 수 있습니다. 각 행은 내부 제품을 사용하여 약간 압축 될 수 있습니다 (예 : ob 행렬의 한 행에 곱한 다음 t의 하나의 "열"과 합계 함) t12을 게시물의 Tab과 약간 다르게 사용하고 있습니다. 주어진 시점에서 그룹 2 그룹 1에서 전이 확률.

#Create transition parameters that sum to 1 across rows/groups. 
tt <- matrix(runif(groupCount*groupCount), ncol=groupCount) 
tt <- tt/apply(tt, 1, function(x){ return(sum(x))}) 

대신 t11의 별도의 변수는 tt 행렬은 앞서 정의 된 척 ... t33한다.

for(i in 2:yearCount) { 
    pred[i, 1] <- ob[i-1, ] %*% tt[, 1] 
    pred[i, 2] <- ob[i-1, ] %*% tt[, 2] 
    pred[i, 3] <- ob[i-1, ] %*% tt[, 3] 
} 

Th e 루프의 내용은 각 요소 쌍이 명시 적으로 곱 해져서 합산 될 때보 다 약간 깨끗합니다. 그러나 각 행/열 쌍을 개별적으로 처리 할 필요는 없습니다. ob 행렬의 세 열을 동시에 tt 행렬의 세 기둥에 의해 작동 할 수 있습니다 : R의 내부 메모리 시스템이 행렬을 재현하지 않기 때문에

for(i in 2:yearCount) { 
    pred[i, ] <- ob[i-1, ] %*% tt 
} 

이, 심지어 이전 버전보다 훨씬 빨리해야한다 각 행에 대해 세 번 - 행당 ​​한 번. 이 값을 행렬 당 한 번 줄이려면 apply 함수를 사용하고 목적에 맞는 행렬을 조 변경하십시오. 마지막으로 행은 pred이 아닌 다른 연도를 나타냅니다 (즉, i-1 행은 pred 행 i와 같습니다).

predictionWIthExtraYear <- t(apply(ob, 1, FUN=function(row){row %*% tt})) 

아마 당신은 (1980, 1981, 1982 개 코호트) 세 가지 요소 목록을 선언 할 수, 동료를 수용합니다.각 요소는 고유 한 ob 행렬입니다. 그리고 고유 한 pred 행렬에 대한 두 번째 목록을 만듭니다. 또는 3 차원 행렬을 사용할 수도 있습니다 (그러나 R이 대체 함수를 사용하여 메모리를 다시 만들 때 과세 될 수 있음).