Подмножество временных рядов с интервалом в два года с использованием R

Question

Я хочу разработать модель с использованием автоаримы, и у меня есть данные временных рядов с 1970 по 2015 год. Я просто хочу посмотреть, как она прогнозирует, используя однолетние данные (1970), а затем прогнозировать 2005 год, использовать трехлетние данные. (1970, 1971, 1972), чтобы предсказать 2005 или 2006, использовать пятилетние данные (1970, 1971, 1972, 1973, 1974 (обучающие наборы) ... и это продолжается с интервалом в два года (например, 1,3,5, 7 .. год данных) до 2015 года, чтобы предсказать один год (наборы для тестирования). У меня проблемы с кодированием, но у меня есть следующая важная ссылка на Stackoverflow, я не могу ее изменить. Эта проблема подмножества сводит меня с ума Пожалуйста, помогите мне. Я получил этот хороший источник от StackOverflow для того, о чем я думаю, но как мне настроить его для моего случая? R многовариантный прогноз и точность на шаг впереди

pred2<-numeric(0)
rmse2<-numeric(0)

for(i in 1:15){

DF.train2<-DF[DF$YEAR < 2000+i & DF$YEAR > 1989+i,]
DF.test2<-DF[DF$YEAR == 2000+i,]
lmod2 <- lm(TEMP ~ PRESSURE + RAINFALL, data = DF.train2)
pred2[i]<- predict(lmod2, newdata = DF.test2)
rmse2[i]<-sqrt(mean((DF.test2$TEMP-pred2[i])^2))
} 

pred2
rmse2  
mean(rmse2) 

Answer 1

Рассмотрим поэлементно l oop с Map (оболочкой для mapply) между двумя парами поездов и годами испытаний для поднабора:

Значения года

test_yrs <- lapply(c(2005:2015), function(i) c(2005:i) )

train_yrs <- lapply(seq(1,(2015-1970), by=2), function(i) 
     c(1970:2004)[c(1:i)] 
)[seq_along(test_yrs)]


train_yrs    

# [[1]]
# [1] 1970
# 
# [[2]]
# [1] 1970 1971 1972
# 
# [[3]]
# [1] 1970 1971 1972 1973 1974
# 
# [[4]]
# [1] 1970 1971 1972 1973 1974 1975 1976
# 
# [[5]]
# [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978
# 
# [[6]]
# [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980
# 
# [[7]]
# [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982
# 
# [[8]]
# [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984
# 
# [[9]]
# [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986
# 
# [[10]]
# [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988
# 
# [[11]]
# [1] 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990


test_yrs

# [[1]]
# [1] 2005
# 
# [[2]]
# [1] 2005 2006
# 
# [[3]]
# [1] 2005 2006 2007
# 
# [[4]]
# [1] 2005 2006 2007 2008
# 
# [[5]]
# [1] 2005 2006 2007 2008 2009
# 
# [[6]]
# [1] 2005 2006 2007 2008 2009 2010
# 
# [[7]]
# [1] 2005 2006 2007 2008 2009 2010 2011
# 
# [[8]]
# [1] 2005 2006 2007 2008 2009 2010 2011 2012
# 
# [[9]]
# [1] 2005 2006 2007 2008 2009 2010 2011 2012 2013
# 
# [[10]]
# [1] 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014
# 
# [[11]]
# [1] 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015

Моделирование

model_func <- function(train_yrs, test_yrs) {

   train_df <- df[df$Year %in% train_yrs,]
   test_df <- df[df$Year %in% test_yrs,]

   mod <- lm(DepVar ~ IndepVar1 + IndepVar2 + IndepVar3, data = train_df)

   pred <- predict(mod, newdata = DF.test2),
   rmse <- sqrt(mean((test_df$DepVar - pred)^2))

   return(list(pred = pred, rmse = rmse))
}

results_list <- Map(model_func, train_yrs, test_yrs)

# ALL ELEMENTS
results_list

# ALL pred ELEMENTS
lapply(results_list, `[`, "pred")

# ALL rmse ELEMENTS
lapply(results_list, `[`, "rmse")    

# INDIVIDUAL ELEMENTS
results_list[[1]]$pred
results_list[[1]]$rmse

results_list[[2]]$pred
results_list[[2]]$rmse
...
results_list[[11]]$pred
results_list[[11]]$rmse

---

Чтобы запустить вышеуказанный процесс для нескольких фреймов данных, оберните процесс в метод и вызовите его с lapply в списке фреймов данных , Результаты будут вложены в верхние уровни

proc_df <- function(df) {
    # NEW PARAM
    model_func <- function(train_yrs, test_yrs, df) {    
       ...
    }

    # ADDED ARG
    results_list <- Map(model_func, train_yrs, test_yrs, MoreArgs=list(df))

    return(results_list)
}

dfs <- list(df1, df2, df3)
df_results_list <- lapply(dfs, proc_df)

# ALL ELEMENTS BY DATA FRAME
df_results_list[[1]]
df_results_list[[2]]
df_results_list[[3]]