Please see write.xlsx(a, OutFile, row.names = F)
that falls on the end of the script below. Instead of outputting numeric data to the Excel file, the data is stored as text in the Excel output. What is the most seamless way to convert the output to numeric?
rm(list = ls()) #clears the workspace
library(caret)
library(ggplot2)
library(scales)
library(foreach)
library(doParallel)
library("xlsx")
Files = c("BBY", "BWLD", "CBRL", "CMG", "DLTR", "DNKN", "DSW", "FDO", "FIVE", "FL", "HD", "JCP", "JOSB",
"JWN", "KSS", "LOW", "LQ", "M", "MW", "PLCE", "PLNT", "PNRA", "PZZA", "ROST", "SBUX", "SIX", "TGT",
"TJX", "UA", "WEN", "CRI")
for(f in Files) {
InFile = paste("P:/R/R_Input/", f, "_Input.csv", sep="")
OutFile = paste("P:/Model_Output/", f, ".xlsx", sep="")
Macro <- read.csv(InFile)
cbind.fill <- function(...){
nm <- list(...)
nm <- lapply(nm, as.matrix)
n <- max(sapply(nm, nrow))
do.call(cbind, lapply(nm, function (x)
rbind(x, matrix(, n-nrow(x), ncol(x)))))
}
# set up
options(scipen = 999) #removes scientific notation
registerDoParallel(cores = 16)
# read data
proj_path = "P:/R/R_Files"
# prep data
source("P:/R/R_Files/Var.R") #Calls variables
# train set up
ctrl <- caret::trainControl(method = "timeslice", initialWindow = 8, horizon = 1,
fixedWindow = FALSE, savePredictions = TRUE)
# Loads all variable names from Macro and Macro2
vars_macro = names(Macro)[!names(Macro) %in% c("qtrs", "y", "s1", "s2", "s3")] #Returns names in Macro not in "qtrs", "y", "s1", "s2", "s3"
vars_macro2 = names(Macro2)[!names(Macro2) %in% c("y", "s1", "s2", "s3")]
vars_macro3 = names(Macro3)[!names(Macro3) %in% c("y", "s1", "s2", "s3")]
vars = c(vars_macro, vars_macro2, vars_macro3)
# run lm
lst = foreach(var = vars) %dopar% {
if (var %in% vars_macro)
foo <- function(start, mod_formula) {
myfit <- caret::train(mod_formula, data = Macro[start:14, ,drop = FALSE],
method = "lm", trControl = ctrl)
c(myfit$pred) ## return; drop dimension as a vector
}
if (var %in% vars_macro2)
foo <- function(start, mod_formula) {
myfit <- caret::train(mod_formula, data = Macro2[start:14, ,drop = FALSE],
method = "lm", trControl = ctrl)
c(myfit$pred) ## return; drop dimension as a vector
}
if (var %in% vars_macro3)
foo <- function(start, mod_formula) {
myfit <- caret::train(mod_formula, data = Macro3[start:14, ,drop = FALSE],
method = "lm", trControl = ctrl)
c(myfit$pred) ## return; drop dimension as a vector
}
f = formula(paste0("y ~ ", var, "+ s1 + s2 + s3"))
Forecast <- sapply(1:6, foo, mod_formula = f)
F9 <- c(Forecast[[1,1]][1])
F10 <- c(Forecast[[1,1]][2], Forecast[[1,2]][1])
F11 <- c(Forecast[[1,1]][3], Forecast[[1,2]][2], Forecast[[1,3]][1])
F12 <- c(Forecast[[1,1]][4], Forecast[[1,2]][3], Forecast[[1,3]][2],
Forecast[[1,4]][1])
F13 <- c(Forecast[[1,1]][5], Forecast[[1,2]][4], Forecast[[1,3]][3],
Forecast[[1,4]][2], Forecast[[1,5]][1])
F14 <- c(Forecast[[1,1]][6], Forecast[[1,2]][5], Forecast[[1,3]][4],
Forecast[[1,4]][3], Forecast[[1,5]][2], Forecast[[1,6]][1])
A <-c((mean(F9)/Macro[9:9,2:2]-1), (mean(F10)/Macro[10:10,2:2]-1),
(mean(F11)/Macro[11:11,2:2]-1), (mean(F12)/Macro[12:12,2:2]-1),
(mean(F13)/Macro[13:13,2:2]-1),(mean(F14)/Macro[14:14,2:2]-1))
Temp <- mean(abs(A[0:5]))
P <-c((mean(F9)/Macro[9:9,2:2]-1), (mean(F10)/Macro[10:10,2:2]-1),
(mean(F11)/Macro[11:11,2:2]-1), (mean(F12)/Macro[12:12,2:2]-1),
(mean(F13)/Macro[13:13,2:2]-1),(mean(F14)/Macro[14:14,2:2]-1),
Temp,(mean(F14)/(1+mean(A[3:5])))/Macro[14:14,2:2]-1)
#E <- scales::percent(P)
C <- c(mean(F9),mean(F10),mean(F11), mean(F12), mean(F13), mean(F14),
"abs error",mean(F14)/(1+mean(P[3:5])))
data.frame(C, P)
}
# Summary
model_error = as.character(sapply(lst, function(elt) elt$P[7]))
forecasts = as.numeric(as.character(sapply(lst, function(elt) elt$C[8])))
delta = as.character(sapply(lst, function(elt) elt$P[8]))
df = data.frame(Card = vars, Model_Avg_Error = model_error,
Forecast = forecasts, Delta = delta)
df$blankVar = NA
df_macro1 = df[df$Card %in% vars_macro,]
df_macro1$blankVar = NA
df_macro2 = df[df$Card %in% vars_macro2,]
df_macro2 = df_macro2[order(df_macro2$Model_Avg_Error),]
df_macro2$blankVar = NA
df_macro3 = df[df$Card %in% vars_macro3,]
df_macro3 = df_macro3[order(df_macro3$Model_Avg_Error),]
df_macro3$blankVar = NA
df_macro4 = df[df$Card %in% names(Macro4),]
df_macro4 = df_macro4[order(df_macro4$Model_Avg_Error),]
df = df[order(df$Model_Avg_Error),]
a = cbind.fill(df_macro1, df_macro2, df_macro3, df, df_macro4)
# save
write.xlsx(a, OutFile, row.names = F)
closeAllConnections()
}