From: Benjamin Auder Date: Tue, 20 Jun 2017 14:47:50 +0000 (+0200) Subject: update following 23/05 TODOs X-Git-Url: https://git.auder.net/images/assets/vendor/rpsls.js?a=commitdiff_plain;h=8f5671db610e1e455b33b54986ac2e57de0da0d7;p=talweg.git update following 23/05 TODOs --- diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index e3a14af..14d0551 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -41,3 +41,4 @@ Collate: 'Forecast.R' 'Data.R' 'A_NAMESPACE.R' + 'J_LastValue.R' diff --git a/pkg/R/F_Neighbors.R b/pkg/R/F_Neighbors.R index 8eb1ddc..0295cd5 100644 --- a/pkg/R/F_Neighbors.R +++ b/pkg/R/F_Neighbors.R @@ -57,7 +57,7 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", if (!opera) tdays = setdiff(tdays, today) #always exclude current day - # Shortcut if window is known #TODO: cross-validation for number of days, on similar (yerste)days + # Shortcut if window is known if (hasArg("window")) { return ( private$.predictShapeAux(data, tdays, today, predict_from, horizon, @@ -99,6 +99,11 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", best_window_exo = optimize( errorOnLastNdays, c(0,7), simtype="exo")$minimum } + if (local) + { + best_window_local = optimize( + errorOnLastNdays, c(3,30), simtype="none")$minimum + } best_window = if (simtype == "endo") @@ -107,8 +112,10 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", best_window_exo else if (simtype == "mix") c(best_window_endo,best_window_exo) - else #none: value doesn't matter - 1 + else #none: no value + NULL + if (local) + best_window = c(best_window, best_window_local) return( private$.predictShapeAux(data, tdays, today, predict_from, horizon, local, best_window, simtype, opera, TRUE) ) @@ -126,21 +133,22 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", if (local) { # limit=Inf to not censor any day (TODO: finite limit? 60?) - tdays = getSimilarDaysIndices(today, data, limit=Inf, same_season=TRUE, + tdays <- getSimilarDaysIndices(today, data, limit=Inf, same_season=TRUE, days_in=tdays_cut, operational=opera) + nb_neighbs <- round( window[length(window)] ) # TODO: 10 == magic number - tdays = .getConstrainedNeighbs(today, data, tdays, min_neighbs=10) + tdays <- .getConstrainedNeighbs(today, data, tdays, min_neighbs=nb_neighbs) if (length(tdays) == 1) { if (final_call) { private$.params$weights <- 1 private$.params$indices <- tdays - private$.params$window <- 1 + private$.params$window <- window } return ( data$getSerie(tdays[1])[predict_from:horizon] ) } - max_neighbs = 12 #TODO: 10 or 12 or... ? + max_neighbs = nb_neighbs #TODO: something else? if (length(tdays) > max_neighbs) { distances2 <- .computeDistsEndo(data, today, tdays, predict_from) @@ -153,23 +161,20 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", if (simtype == "endo" || simtype == "mix") { - # Compute endogen similarities using given window - window_endo = ifelse(simtype=="mix", window[1], window) - # Distances from last observed day to selected days in the past # TODO: redundant computation if local==TRUE distances2 <- .computeDistsEndo(data, today, tdays, predict_from) - simils_endo <- .computeSimils(distances2, window_endo) + # Compute endogen similarities using the given window + simils_endo <- .computeSimils(distances2, window[1]) } if (simtype == "exo" || simtype == "mix") { - # Compute exogen similarities using given window - window_exo = ifelse(simtype=="mix", window[2], window) - distances2 <- .computeDistsExo(data, today, tdays) + # Compute exogen similarities using the given window + window_exo = ifelse(simtype=="mix", window[2], window[1]) simils_exo <- .computeSimils(distances2, window_exo) } @@ -195,15 +200,7 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", { private$.params$weights <- similarities private$.params$indices <- tdays - private$.params$window <- - if (simtype=="endo") - window_endo - else if (simtype=="exo") - window_exo - else if (simtype=="mix") - c(window_endo,window_exo) - else #none - 1 + private$.params$window <- window } return (prediction) diff --git a/pkg/R/Forecaster.R b/pkg/R/Forecaster.R index 784f86e..a10f0bd 100644 --- a/pkg/R/Forecaster.R +++ b/pkg/R/Forecaster.R @@ -28,9 +28,8 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{initialize(data, pjump)}}{ -#' Initialize a Forecaster object with a Data object and a jump prediction function, -#' or NULL if \code{predictShape()} returns an adjusted curve.} +#' \item{\code{initialize(pjump)}}{ +#' Initialize a Forecaster object with a jump prediction function.} #' \item{\code{predictSerie(data,today,memory,predict_from,horizon,...)}}{ #' Predict the next curve (at index today) from predict_from to horizon (hours), using #' \code{memory} days in the past.} @@ -63,19 +62,15 @@ Forecaster = R6::R6Class("Forecaster", if (is.na(predicted_shape)) return (NA) - predicted_delta <- - if (is.null(private$.pjump)) - NULL - else - private$.pjump(data,today,memory,predict_from,horizon,private$.params,...) + predicted_delta <- private$.pjump(data, today, memory, predict_from, + horizon, private$.params, first_pred=predicted_shape[1], ...) - # Predicted shape is aligned on the end of current day + jump (if jump!=NULL) + # Predicted shape is aligned on the end of current day + jump c( data$getSerie(today)[if (predict_from>=2) 1:(predict_from-1) else c()], - predicted_shape + ifelse( is.null(private$.pjump), - 0, - predicted_delta - predicted_shape[1] + - ifelse(predict_from>=2, - data$getSerie(today)[predict_from-1], tail(data$getSerie(today-1),1)) ) ) + (predicted_shape - predicted_shape[1]) + #shape with first_pred = 0 + ifelse(predict_from>=2, #last observed value + data$getSerie(today)[predict_from-1], tail(data$getSerie(today-1),1)) + + predicted_delta ) #jump }, predictShape = function(data, today, memory, predict_from, horizon, ...) NULL #empty default implementation: to implement in inherited classes diff --git a/pkg/R/J_LastValue.R b/pkg/R/J_LastValue.R new file mode 100644 index 0000000..4190b9c --- /dev/null +++ b/pkg/R/J_LastValue.R @@ -0,0 +1,13 @@ +#' getLastValueJumpPredict +#' +#' Just predict zero "jump" (for reference, benchmarking at least). +#' +#' @inheritParams computeForecast +#' @inheritParams getZeroJumpPredict +#' +#' @aliases J_LastValue +#' +getLastValueJumpPredict = function(data, today, memory, horizon, params, ...) +{ + 0 +} diff --git a/pkg/R/J_Zero.R b/pkg/R/J_Zero.R index fb15e3d..16b6ed5 100644 --- a/pkg/R/J_Zero.R +++ b/pkg/R/J_Zero.R @@ -1,6 +1,6 @@ #' getZeroJumpPredict #' -#' Just predict zero "jump" (for reference, benchmarking at least). +#' "Reset level to 0": jump by -A where A is the last observed value. #' #' @inheritParams computeForecast #' @param today Index of the current day (predict tomorrow) @@ -10,5 +10,6 @@ #' getZeroJumpPredict = function(data, today, memory, horizon, params, ...) { - 0 + list(...)$first_pred - ifelse( predict_from >= 2, + data$getSerie(today)[predict_from-1], tail(data$getSerie(today-1),1) ) } diff --git a/pkg/R/computeForecast.R b/pkg/R/computeForecast.R index e1b29b6..082ba80 100644 --- a/pkg/R/computeForecast.R +++ b/pkg/R/computeForecast.R @@ -19,10 +19,9 @@ #' \itemize{ #' \item Persistence : use last (similar) day #' \item Neighbors: re-use the weights from F_Neighbors -#' \item Zero: just output 0 (no adjustment) +#' \item LastValue: start serie with last observed value +#' \item Zero: no adjustment => use shape prediction only #' } -#' If pjump=NULL, then no adjustment is performed (output of \code{predictShape()} is -#' used directly). #' @param predict_from First time step to predict. #' @param memory Data depth (in days) to be used for prediction. #' @param horizon Last time step to predict. @@ -36,7 +35,7 @@ #' ts_data <- system.file("extdata","pm10_mesures_H_loc.csv",package="talweg") #' exo_data <- system.file("extdata","meteo_extra_noNAs.csv",package="talweg") #' data <- getData(ts_data, exo_data, limit=200) -#' pred <- computeForecast(data, 100:130, "Persistence", "Zero", +#' pred <- computeForecast(data, 100:130, "Persistence", "LastValue", #' predict_from=8, memory=50, horizon=12, ncores=1) #' \dontrun{ #' #Sketch for real-time mode: @@ -77,15 +76,14 @@ computeForecast = function(data, indices, forecaster, pjump, predict_from, stop("Indices out of range") if (!is.character(forecaster)) stop("forecaster (name): character") - if (!is.null(pjump) && !is.character(pjump)) - stop("pjump (function): character or NULL") + if (!is.character(pjump)) + stop("pjump (function): character") pred = Forecast$new( sapply(indices, function(i) integerIndexToDate(i,data)) ) forecaster_class_name = getFromNamespace( paste(forecaster,"Forecaster",sep=""), "talweg") - if (!is.null(pjump)) - pjump <- getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg") + pjump <- getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg") forecaster = forecaster_class_name$new(pjump) computeOneForecast <- function(i) diff --git a/reports/year2015.gj b/reports/year2015.gj index 58340e7..678b962 100644 --- a/reports/year2015.gj +++ b/reports/year2015.gj @@ -14,11 +14,11 @@ indices = seq(as.Date("2015-01-01"),as.Date("2015-12-31"),"days") -----r p1 = computeForecast(data, indices, "Neighbors", "Neighbors", predict_from=P, horizon=H, simtype="mix", local=FALSE) -p2 = computeForecast(data, indices, "Neighbors", NULL, +p2 = computeForecast(data, indices, "Neighbors", "Zero", predict_from=P, horizon=H, simtype="none", local=TRUE) -p3 = computeForecast(data, indices, "Average", "Zero", +p3 = computeForecast(data, indices, "Average", "LastValue", predict_from=P, horizon=H) -p4 = computeForecast(data, indices, "Persistence", "Zero", +p4 = computeForecast(data, indices, "Persistence", "LastValue", predict_from=P, horizon=H, same_day=TRUE) -----r e1 = computeError(data, p1, P, H)