R/run_simplex.R

In peterkuriyama/mtheory:

#' Run Simplex
#' Function to simulate data, sample data at some frequency, and
#' apply simplex methods to evaluate predictive ability

#' @param ctl_in Generated by mtheory_ctl function
#' @param ncores Number of cores

#' @export

run_simplex <- function(ctl_in, ncores = 6){

  #----------------------------------------------  
  #Load or generate the data
  samps <- load_dat(ctl_in, ncores = ncores)

  #----------------------------------------------
  #sample data at some frequency
  sample_ts <- sample_data(data_in = samps, samp_freq = ctl_in$samp_freq)
  #process sample_ts_df
  sample_ts_df <- ldply(sample_ts)
  names(sample_ts_df)[1] <- 'iter'

  #----------------------------------------------
  #apply simplex methods
  simplex_list <- apply_simplex_list(E = ctl_in$E, lib = ctl_in$lib, 
    pred = ctl_in$pred, samp_ts = sample_ts)
  simplex_df <- ldply(simplex_list)
  names(simplex_df)[1] <- "iter"

  #Order the iterations
  simplex_df$iter <- as.numeric(simplex_df$iter)
  simplex_df <- simplex_df[order(simplex_df$iter), ] 

  #----------------------------------------------
  #Evaluate the decay in prediction skill by using the best E values
  best_rho <- simplex_df %>% group_by(iter, variable) %>% filter(rho == max(rho)) %>% 
    as.data.frame

  #Loop over best_rho to calculate pred_decay
  pred_decay <- lapply(1:nrow(best_rho), FUN = function(xx){
      temp_rho <- best_rho[xx, ]
      temp <- sample_ts_df %>% filter(iter == temp_rho$iter)
  
      temp_out <- simplex(temp[, temp_rho$variable], tp = 1:10, lib = ctl_in$lib, 
        pred = ctl_in$pred, E = temp_rho$E)
      temp_out$iter <- xx
      temp_out$variable <- temp_rho$variable

      return(temp_out)
    })
  pred_decay <- ldply(pred_decay)
  
  #Change the iter values
  pred_decay$iter <- best_rho[pred_decay$iter, 'iter']

  #----------------------------------------------
  #Identify nonlinearity with Smaps
  nonlinear <- lapply(1:nrow(best_rho), FUN = function(xx){
    temp_rho <- best_rho[xx, ]
    temp <- sample_ts_df %>% filter(iter == temp_rho$iter)

    temp_out <- s_map(temp[, temp_rho$variable], lib = ctl_in$lib,
      pred = ctl_in$pred, E = temp_rho$E)
    temp_out$iter <- xx
    temp_out$variable <- temp_rho$variable

    return(temp_out)
  })

  nonlinear <- ldply(nonlinear)
  nonlinear$iter <- best_rho[nonlinear$iter, 'iter']
  
  return(list(samples = sample_ts_df, simplex_df = simplex_df,
    pred_decay = pred_decay, nonlinear = nonlinear, pars = samps[[1]]))

}