微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

调整滚动回归

如何解决调整滚动回归

我在 http://christophj.github.io/replicating/r/replicating-goyal-welch-2008/ 上找到了以下 R 代码,我想调整该代码以便对我的 OOS 估计进行滚动回归。我尝试在 R 中使用 rollRegres 函数,但没有用。此外,我的估计应该针对滚动回归的新值进行更新。代码如下所示:

get_statistics <- function(ts_df,indep,dep,h=1,start=1871,end=2005,est_periods_OOS = 20) {
  #### IS ANALYSIS
  #1. Historical mean model
  avg   <- mean(window(ts_df,start,end)[,dep],na.rm=TRUE)
  IS_error_N <- (window(ts_df,dep] - avg)
  #2. OLS model
  reg <- dyn$lm(eval(parse(text=dep)) ~ lag(eval(parse(text=indep)),-1),data=window(ts_df,end)) 
  IS_error_A <- reg$residuals
  ### 
  ####OOS ANALYSIS
  OOS_error_N <- numeric(end - start - est_periods_OOS)
  OOS_error_A <- numeric(end - start - est_periods_OOS)
  #Only use information that is available up to the time at which the forecast is made
  j <- 0
  for (i in (start + est_periods_OOS):(end-1)) {
    j <- j + 1
    #Get the actual ERP that you want to predict
    actual_ERP <- as.numeric(window(ts_df,i+1,i+1)[,dep])
    #1. Historical mean model
    OOS_error_N[j] <- actual_ERP - mean(window(ts_df,i)[,na.rm=TRUE)
    #2. OLS model
    reg_OOS <- dyn$lm(eval(parse(text=dep)) ~ lag(eval(parse(text=indep)),i))
    #Compute_error
    df <- data.frame(x=as.numeric(window(ts_df,i,indep]))
    names(df) <- indep
    pred_ERP   <- predict.lm(reg_OOS,newdata=df)
    OOS_error_A[j] <-  pred_ERP - actual_ERP
  }
  
  #Compute statistics 
  MSE_N <- mean(OOS_error_N^2)
  MSE_A <- mean(OOS_error_A^2)
  T <- length(!is.na(ts_df[,dep]))
  OOS_R2  <- 1 - MSE_A/MSE_N
  #Is the -1 enough (maybe -2 needed because of lag)?
  OOS_oR2 <- OOS_R2 - (1-OOS_R2)*(reg$df.residual)/(T - 1) 
  dRMSE <- sqrt(MSE_N) - sqrt(MSE_A)
  ##
  #### CREATE PLOT
  IS  <- cumsum(IS_error_N[2:length(IS_error_N)]^2)-cumsum(IS_error_A^2)
  OOS <- cumsum(OOS_error_N^2)-cumsum(OOS_error_A^2)
  df  <- data.frame(x=seq.int(from=start + 1 + est_periods_OOS,to=end),IS=IS[(1 + est_periods_OOS):length(IS)],OOS=OOS) #Because you lose one observation due to the lag
  #Shift IS errors vertically,so that the IS line begins 
  # at zero on the date of first OOS prediction. (see Goyal/Welch (2008,p. 1465))
  df$IS <- df$IS - df$IS[1] 
  df  <- melt(df,id.var="x") 
  plotGG <- ggplot(df) + 
    geom_line(aes(x=x,y=value,color=variable)) + 
    geom_rect(data=data.frame(),#Needed by ggplot2,otherwise not transparent
              aes(xmin=1973,xmax=1975,ymin=-0.2,ymax=0.2),fill='red',alpha=0.1) + 
    scale_y_continuous('Cumulative SSE Difference',limits=c(-0.2,0.2)) + 
    scale_x_continuous('Year')
  ##
  return(list(IS_error_N = IS_error_N,IS_error_A = reg$residuals,OOS_error_N = OOS_error_N,OOS_error_A = OOS_error_A,IS_R2 = summary(reg)$r.squared,IS_aR2 = summary(reg)$adj.r.squared,OOS_R2  = OOS_R2,OOS_oR2 = OOS_oR2,dRMSE = dRMSE,plotGG = plotGG))
}

谁能帮忙。非常感谢。

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。