'Forecast.R'
'Data.R'
'A_NAMESPACE.R'
+ 'J_LastValue.R'
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,
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")
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) )
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)
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)
}
{
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)
#'
#' @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.}
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
--- /dev/null
+#' 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
+}
#' 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)
#'
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) )
}
#' \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.
#' 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:
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)
-----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)
projects / talweg.git / commitdiff