R/daily_cluster_model.R

In EBlonkowski/timeseries:

# daily cluster model

# add flag to group days according to several factors
days_group <- function(data) {
  # build the worked / non worked factors
  data$worked <- "worked"
  data$worked[data$time.wday %in% c(1, 7)] <- "non_worked"
  data$worked[data$time.holiday != 'Normal'] <- "non_worked"
  data$worked <- factor(data$worked)
  
  # worked, weekend, ph groups
  data$w_we_ph <- "worked"
  data$w_we_ph[data$time.wday %in% c(1, 7)] <- "weekend"
  data$w_we_ph[data$time.holiday != 'Normal'] <- "ph"
  data$w_we_ph <- factor(data$w_we_ph)
  
  # weekday, saturday, sunday+ph
  data$wd_s_sph <- 'weekday'
  data$wd_s_sph[data$time.wday == 7] <- "sat"
  data$wd_s_sph[data$time.wday == 1] <- "sph"
  data$wd_s_sph[data$time.holiday != 'Normal'] <- "sph"
  data$wd_s_sph <- factor(data$wd_s_sph)
  
  data
}

# group_by = time.wday, worked, w_we_ph, wd_s_sph
daily_cluster_model <- function(tse, group_by, xcol) {
  tse <- tse %>% days_group # add the day grouping information
  stopifnot(is.tse(tse))
  stopifnot(c(group_by, xcol) %in% colnames(tse))
  
  # normalize the column names
  tse <- map_in(tse, group_by = group_by, x = xcol)

  structure(list(group_by = group_by, xcol = xcol, tsef = dcm(tse)), 
            class = 'daily_cluster_model')
}

predict.daily_cluster_model <- function(dcm, tse) {
  group_by <- dcm$group_by
  xcol <- dcm$xcol
  
  tse <- tse %>% days_group # add the day grouping information
  
  #input check
  stopifnot(is.tse(tse))
  stopifnot(c(group_by, xcol) %in% colnames(tse))
  
  # normalize the column names
  tse <- map_in(tse, group_by = group_by, x = xcol)
  dcm$tsef(tse)
}