R/shuya_SVR.R

In EBlonkowski/timeseries:

#------------------------------------------------------------------------------#
# SVM model

# Support Vector Machine Regression
shuya_svm <- function(tse, gamma, cost, split = TRUE, X_col, ..., 
                      .orders_list) {
  if(missing(.orders_list))
    orders <- list(...)
  else orders <- .orders_list
  
  # input checks
  stopifnot(X_col %in% names(orders)) # must give the orders of the X_col
  # all the orders must match some column in the tse
  stopifnot(names(orders) %in% colnames(tse)) 
  # all orders must be non-negative
  stopifnot(all(c(orders, recursive = TRUE) >= 0)) 
  
  # construct lagged columns and remove useless ones
  tse$temp.group_by <- factor(tse$time.wday)
  tse <- tse %>%
    subcol(c(names(orders), 'temp.group_by')) %>% # remove useless columns
    D_multi(orders_list = orders)  # construct the lagged columns  
  if(!split) 
    tse <- select(tse, -temp.group_by)
  
  # remove the time columns, since the algorithm does not use them
  # and keep only the columns with all values
  data <- as.data.frame(tse)[tse$available, get_value_cols(tse)]
  
  # train the SVM
  model <- list(svm = svm(paste(X_col, '~ .') %>% as.formula, data = data, 
                          gamma = gamma, cost = cost))
  
  # save some metadata
  model$X_col <- X_col
  model$X_order <- orders[[X_col]]
  model$parameters <- c(gamma = gamma, cost = cost)
  model$orders = orders
  model$split = split
  
  structure(model, class = 'shuya_svm')
}

predict.shuya_svm <- function(m, tse) {
  build_columns(tse, m) %>% predict_one(m) # so clean wow
}

# build the lagged columns for the algorithm
build_columns.shuya_svm <- function(tse, m) {
  tse$temp.group_by <- factor(tse$time.wday)
  tse <- tse %>%
    subcol(c(names(m$orders), 'temp.group_by')) %>% # remove useless columns
    D_multi(orders_list = m$orders) %>%# construct the lagged columns
    select_(paste0('-', m$X_col)) %>%
    update_available
  
  if(!m$split)
    tse <- select(tse, -temp.group_by)
  
  tse
}

# predict one step, assuming all the lagged columns are already there
predict_one.shuya_svm <- function(tse, m) {
  result <- rep(NA_real_, dim(tse)[1])
  result[tse$available] <- predict(m$svm, tse %>% filter(available))
  
  result
}

# which one is the X (or forecasted) columns?
get_X.shuya_svm <- function(m) { return(m$X_col) }

# which lagged version of the forecasted columns are we using?
get_X_order.shuya_svm <- function(m) { return(m$X_order) }