From: Benjamin Auder Date: Mon, 27 Feb 2017 15:30:46 +0000 (+0100) Subject: 'update' X-Git-Url: https://git.auder.net/game/current/%7B%7B%20asset%28%27mixstore/css/base.css%27%29%20%7D%7D?a=commitdiff_plain;h=a66a84b56467194852f2faee15f4725759b24158;p=talweg.git 'update' --- diff --git a/pkg/R/Data.R b/pkg/R/Data.R index d970f7b..677d906 100644 --- a/pkg/R/Data.R +++ b/pkg/R/Data.R @@ -2,130 +2,86 @@ #' #' Data encapsulation #' -#' @field data List of -#' \itemize{ +#' @docType class +#' @importFrom R6 R6Class +#' +#' @field .data List of \itemize{ #' \item time: vector of times #' \item serie: centered series #' \item level: corresponding levels #' \item exo: exogenous variables -#' \item exo_hat: predicted exogenous variables -#' } -#' -#' @docType class -#' @importFrom R6 R6Class +#' \item exo_hat: predicted exogenous variables} #' -#' @export +#' @section Methods: \describe{ +#' \item{\code{getSize()}} +#' {Return number of series in dataset.} +#' \item{\code{getStdHorizon()}} +#' {Return number of time steps from serie[1] until midnight} +#' \item{\code{append(new_time, new_centered_serie, new_level, new_exo, new_exo_hat)}} +#' {Acquire a new vector of lists (time, centered_serie, level, exo, exo_hat).} +#' \item{\code{getTime(index)}} +#' {Get times at specified index.} +#' \item{\code{getCenteredSerie(index)}} +#' {Get centered serie at specified index.} +#' \item{\code{getLevel(index)}} +#' {Get level at specified index.} +#' \item{\code{getSerie(index)}} +#' {Get serie (centered+level) at specified index.} +#' \item{\code{getExo(index)}} +#' {Get exogenous variables at specified index.} +#' \item{\code{getExoHat(index)}} +#' {Get estimated exogenous variables at specified index.} } Data = R6::R6Class("Data", private = list( .data = list() ), public = list( getSize = function() - getSizeData(private) + length(private$.data) , getStdHorizon = function() - getStdHorizonData(private) - , - append = function(new_time, new_centered_serie, new_level, new_exo, new_exo_hat) - appendData(private, new_time, new_centered_serie, new_level, new_exo, new_exo_hat) + 24 - as.POSIXlt( private$.data[[1]]$time[1] )$hour + 1 , + append = function( + { + private$.data[[length(private$.data)+1]] <- list( + "time"=new_time, "centered_serie"=new_centered_serie, "level"=new_level, + "exo"=new_exo, "exo_hat"=new_exo_hat) + }, getTime = function(index) - getTimeData(self, private, index) - , + { + index = dateIndexToInteger(index, self) + private$.data[[index]]$time + }, getCenteredSerie = function(index) - getCenteredSerieData(self, private, index) - , + { + index = dateIndexToInteger(index, self) + private$.data[[index]]$centered_serie + }, getLevel = function(index) - getLevelData(self, private, index) - , + { + index = dateIndexToInteger(index, self) + private$.data[[index]]$level + }, getSerie = function(index) - getSerieData(self, private, index) - , + { + index = dateIndexToInteger(index, self) + private$.data[[index]]$centered_serie + private$.data[[index]]$level + }, getExo = function(index) - getExoData(self, private, index) - , + { + index = dateIndexToInteger(index, self) + private$.data[[index]]$exo + }, getExoHat = function(index) - getExoHatData(self, private, index) + { + index = dateIndexToInteger(index, self) + private$.data[[index]]$exo_hat + }, + removeFirst = function() + private$.data <- private$.data[2:length(private$.data)] + , + removeLast = function() + private$.data <- private$.data[1:(length(private$.data)-1)] ) ) - -#' Number of series in the dataset -#' -#' @param private List of private members in current object -getSizeData = function(private) - length(private$.data) - -#' 'Standard' horizon, from t+1 to midnight -#' -#' @inheritParams getSizeData -getStdHorizonData = function(private) - 24 - as.POSIXlt( private$.data[[1]]$time[1] )$hour + 1 - -#' Acquire a new vector of lists (time, centered_serie, level, exo, exo_hat) -#' -#' @inheritParams getSizeData -#' @param new_time Time -#' @param new_centered_serie Centered serie -#' @param new_level Level -#' @param new_exo Exogneous variables -#' @param new_exo_hat Predicted exogenous variables -appendData = function(private, new_time, new_centered_serie, new_level, new_exo, new_exo_hat) -{ - private$.data[[length(private$.data)+1]] <- list("time"=new_time, - "centered_serie"=new_centered_serie,"level"=new_level,"exo"=new_exo,"exo_hat"=new_exo_hat) -} - -#' Time values at specified index -#' -#' @inheritParams getSizeData -#' @param index Return value at this index -getTimeData = function(o, private, index) -{ - index = dateIndexToInteger(index, o) - private$.data[[index]]$time -} - -#' Centered serie values at specified index -#' -#' @inheritParams getTimeData -getCenteredSerieData = function(o, private, index) -{ - index = dateIndexToInteger(index, o) - private$.data[[index]]$centered_serie -} - -#' Level of the serie at specified index -#' -#' @inheritParams getTimeData -getLevelData = function(o, private, index) -{ - index = dateIndexToInteger(index, o) - private$.data[[index]]$level -} - -#' Serie values (centered+level) at specified index -#' -#' @inheritParams getTimeData -getSerieData = function(o, private, index) -{ - index = dateIndexToInteger(index, o) - private$.data[[index]]$centered_serie + data[[index]]$level -} - -#' Exogenous measures at specified index -#' -#' @inheritParams getTimeData -getExoData = function(o, private, index) -{ - index = dateIndexToInteger(index, o) - private$.data[[index]]$exo -} - -#' Exogeous predictions at specified index -#' -#' @inheritParams getTimeData -getExoHatData = function(o, private, index) -{ - index = dateIndexToInteger(index, o) - private$.data[[index]]$exo_hat -} diff --git a/pkg/R/F_Average.R b/pkg/R/F_Average.R index abc88be..a48952b 100644 --- a/pkg/R/F_Average.R +++ b/pkg/R/F_Average.R @@ -5,7 +5,7 @@ #' Return the (pointwise) average of the all the (similar) centered day curves #' in the past. Inherits \code{\link{Forecaster}} AverageForecaster = R6::R6Class("AverageForecaster", - inherit = "Forecaster", + inherit = Forecaster, public = list( predictShape = function(today, memory, horizon, ...) diff --git a/pkg/R/F_Neighbors.R b/pkg/R/F_Neighbors.R index ac0df04..4b6b7e7 100644 --- a/pkg/R/F_Neighbors.R +++ b/pkg/R/F_Neighbors.R @@ -5,19 +5,22 @@ #' Predict tomorrow as a weighted combination of "futures of the past" days. #' Inherits \code{\link{Forecaster}} NeighborsForecaster = R6::R6Class("NeighborsForecaster", - inherit = "Forecaster", + inherit = Forecaster, public = list( predictShape = function(today, memory, horizon, ...) { # (re)initialize computed parameters - params <<- list("weights"=NA, "indices"=NA, "window"=NA) + private$.params <- list("weights"=NA, "indices"=NA, "window"=NA) # Get optional args simtype = ifelse(hasArg("simtype"), list(...)$simtype, "mix") #or "endo", or "exo" kernel = ifelse(hasArg("kernel"), list(...)$kernel, "Gauss") #or "Epan" if (hasArg(h_window)) - return (.predictShapeAux(fdays,today,horizon,list(...)$h_window,kernel,simtype,TRUE)) + { + return ( private$.predictShapeAux( + fdays, today, horizon, list(...)$h_window, kernel, simtype, TRUE) ) + } # Determine indices of no-NAs days followed by no-NAs tomorrows first_day = max(today - memory, 1) @@ -36,7 +39,7 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", for (i in intersect(fdays,sdays)) { # mix_strategy is never used here (simtype != "mix"), therefore left blank - prediction = .predictShapeAux(fdays, i, horizon, h, kernel, simtype, FALSE) + prediction = private$.predictShapeAux(fdays, i, horizon, h, kernel, simtype, FALSE) if (!is.na(prediction[1])) { nb_jours = nb_jours + 1 @@ -52,13 +55,13 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", h_best_endo = optimize(errorOnLastNdays, c(0,10), kernel=kernel, simtype="endo")$minimum if (simtype == "endo") - return (.predictShapeAux(fdays, today, horizon, h_best_endo, kernel, "endo", TRUE)) + return(private$.predictShapeAux(fdays,today,horizon,h_best_endo,kernel,"endo",TRUE)) if (simtype == "exo") - return (.predictShapeAux(fdays, today, horizon, h_best_exo, kernel, "exo", TRUE)) + return(private$.predictShapeAux(fdays,today,horizon,h_best_exo,kernel,"exo",TRUE)) if (simtype == "mix") { h_best_mix = c(h_best_endo,h_best_exo) - return (.predictShapeAux(fdays, today, horizon, h_best_mix, kernel, "mix", TRUE)) + return(private$.predictShapeAux(fdays,today,horizon,h_best_mix,kernel,"mix",TRUE)) } } ), @@ -138,15 +141,15 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", simils_endo * simils_exo prediction = rep(0, horizon) - for (i in seq_along(fdays_indices)) - prediction = prediction + similarities[i] * data$getSerie(fdays_indices[i]+1)[1:horizon] + for (i in seq_along(fdays)) + prediction = prediction + similarities[i] * data$getSerie(fdays[i]+1)[1:horizon] prediction = prediction / sum(similarities, na.rm=TRUE) if (final_call) { - params$weights <<- similarities - params$indices <<- fdays_indices - params$window <<- + private$.params$weights <- similarities + private$.params$indices <- fdays + private$.params$window <- if (simtype=="endo") { h_endo } else if (simtype=="exo") { diff --git a/pkg/R/F_Persistence.R b/pkg/R/F_Persistence.R index 39e043c..bf5868e 100644 --- a/pkg/R/F_Persistence.R +++ b/pkg/R/F_Persistence.R @@ -5,7 +5,7 @@ #' Return the last centered (similar) day curve. #' Inherits \code{\link{Forecaster}} PersistenceForecaster = R6::R6Class("PersistenceForecaster", - inherit = "Forecaster", + inherit = Forecaster, public = list( predictShape = function(today, memory, horizon, ...) diff --git a/pkg/R/F_Zero.R b/pkg/R/F_Zero.R index ff6eb52..fdfee83 100644 --- a/pkg/R/F_Zero.R +++ b/pkg/R/F_Zero.R @@ -4,7 +4,7 @@ #' #' Return 0 (and then adjust). Inherits \code{\link{Forecaster}} ZeroForecaster = R6::R6Class("ZeroForecaster", - inherit = "Forecaster", + inherit = Forecaster, public = list( predictShape = function(today, memory, horizon, ...) diff --git a/pkg/R/Forecast.R b/pkg/R/Forecast.R index b68b6c9..f1b92ce 100644 --- a/pkg/R/Forecast.R +++ b/pkg/R/Forecast.R @@ -2,43 +2,52 @@ #' #' Forecast encapsulation #' -#' @field pred List with -#' \itemize{ -#' \item serie: forecasted serie -#' \item params: corresponding list of parameters (weights, neighbors...) -#' \item index: corresponding index in data object -#' } -#' #' @docType class #' @importFrom R6 R6Class #' -#' @export +#' @field .pred List with \itemize{ +#' \item serie: forecasted serie +#' \item params: corresponding list of parameters (weights, neighbors...) +#' \item index: corresponding index in data object} +#' @field .dates vector of day indices where forcast occurs +#' +#' @section Methods: \describe{ +#' \item{\code{initialize(dates)}} +#' {Initialize a Forecast object with a series of date indices.} +#' \item{\code{predictSerie(today,memory,horizon,...)}} +#' {Predict a new serie of \code{horizon} values at day index \code{today} using \code{memory} +#' days in the past.} TODO: continue ####################################### +#' \item{\code{predictShape(today,memory,horizon,...)}} +#' {Predict a new shape of \code{horizon} values at day index \code{today} using \code{memory} +#' days in the past.} +#' \item{\code{getParameters()}} +#' {Return (internal) parameters.} } Forecast = R6::R6Class("Forecast", private = list( - .pred = "list", - .dates = "Date" + .pred = list(), + .dates = c() ), public = list( initialize = function(dates) - initialize(self, private, dates) + initializeForecast(self, private, dates) , getSize = function() - getSize(private) + getSizeForecast(private) , append = function(new_serie, new_params, new_index) - append(private, new_serie, new_params, new_index) + appendForecast(private, new_serie, new_params, new_index) , getDates = function() - getDates(private) + getDatesForecast(private) , getSerie = function(index) - getSerie(private, index) + getSerieForecast(private, index) , getParams = function(index) - getParams(private, index) + getParamsForecast(private, index) , getIndexInData = function(index) - getIndexInData(private, index) + getIndexInDataForecast(private, index) ) ) @@ -47,39 +56,41 @@ Forecast = R6::R6Class("Forecast", #' @param o Object of class Forecast #' @param private List of private members in o #' @param dates vector of dates where forecast occurs -initialize = function(o, private, dates) +initializeForecast = function(o, private, dates) { - private$.dates <<- dates - private$.pred <<- list() + private$.dates <- dates invisible(o) } #' Number of individual forecasts" #' -#' @inheritParams initialize -getSize = function(private) +#' @inheritParams initializeForecast +getSizeForecast = function(private) length(private$.pred) #' Obtain a new pair (serie, params)" #' -#' @inheritParams initialize -append = function(new_serie, new_params, new_index_in_data) +#' @inheritParams initializeForecast +#' @param new_serie Values of a new serie +#' @param new_params Associated (optimized) parameters +#' @param new_index_in_data Corresponding index in data +appendForecast = function(private, new_serie, new_params, new_index_in_data) { - private$.pred[[length(private$.pred)+1]] <<- + private$.pred[[length(private$.pred)+1]] <- list("serie"=new_serie, "params"=new_params, "index_in_data"=new_index_in_data) } #' Dates where prediction occurs #' -#' inheritParams initialize -getDates = function(private) +#' inheritParams initializeForecast +getDatesForecast = function(private) private$.dates #' Serie values at specified index" #' -#' @inheritParams initialize +#' @inheritParams initializeForecast #' @param index Return value at this index -getSerie = function(index) +getSerieForecast = function(index) { if (is(index,"Date")) index = match(index, private$.dates) @@ -88,8 +99,8 @@ getSerie = function(index) #' Params at specified index" #' -#' @inheritParams getSerie -getParams = function(index) +#' @inheritParams getSerieForecast +getParamsForecast = function(index) { if (is(index,"Date")) index = match(index, private$.dates) @@ -98,8 +109,8 @@ getParams = function(index) #' (day) Index in data where prediction took place" #' -#' @inheritParams getSerie -getIndexInData = function(index) +#' @inheritParams getSerieForecast +getIndexInDataForecast = function(index) { if (is(index,"Date")) index = match(index, private$.dates) diff --git a/pkg/R/Forecaster.R b/pkg/R/Forecaster.R index 4c8437e..2bd2e4e 100644 --- a/pkg/R/Forecaster.R +++ b/pkg/R/Forecaster.R @@ -2,70 +2,49 @@ #' #' Forecaster (abstract class, implemented by all forecasters) #' +#' @docType class +#' @importFrom R6 R6Class +#' #' @field params List of computed parameters, for post-run analysis (dev) #' @field data Dataset, object of class Data #' @field pjump Function: how to predict the jump at day interface ? #' -#' @docType class -#' @importFrom R6 R6Class +#' @section Methods: \describe{ +#' \item{\code{initialize(data, pjump)}} +#' {Initialize a Forecaster object with a Data object and a jump prediction function.} +#' \item{\code{predictSerie(today,memory,horizon,...)}} +#' {Predict a new serie of \code{horizon} values at day index \code{today} using \code{memory} +#' days in the past.} +#' \item{\code{predictShape(today,memory,horizon,...)}} +#' {Predict a new shape of \code{horizon} values at day index \code{today} using \code{memory} +#' days in the past.} +#' \item{\code{getParameters()}} +#' {Return (internal) parameters.} } Forecaster = R6::R6Class("Forecaster", private = list( - .params = "list", - .data = "Data", - .pjump = "function" + .params = list(), + .data = NULL, + .pjump = NULL ), public = list( initialize = function(data, pjump) - initialize(self, private, data, pjump) - , + { + private$.data <- data + private$.pjump <- pjump + invisible(self) + }, predictSerie = function(today, memory, horizon, ...) - predictSerie(private, today, memory, horizon, ...) - , + { + # Parameters (potentially) computed during shape prediction stage + predicted_shape = o$predictShape(today, memory, horizon, ...) + predicted_delta = private$.pjump(private$.data,today,memory,horizon,private$.params,...) + # Predicted shape is aligned it on the end of current day + jump + predicted_shape+tail(private$.data$getSerie(today),1)-predicted_shape[1]+predicted_delta + }, predictShape = function(today, memory, horizon, ...) - predictShape(private, today, memory, horizon, ...) + #empty default implementation: to implement in inherited classes , getParameters = function() - getParameters(private) + private$.params ) ) - -#' Initialize (generic) Forecaster object -#' -#' @param o Object of class Forecaster -#' @param private List of private members in o -#' @param data Object of class Data -#' @param pjump Function to predict jump -initialize = function(o, private, data, pjump) -{ - .params <<- list() - .data <<- data - .pjump <<- pjump - invisible(o) -} - -#' Obtain a new forecasted time-serie -#' -#' @inheritParams initialize -#' @param today Index for current prediction -#' @param memory Depth in data (in days) -#' @param horizon Number of hours to forecast -predictSerie = function(private, today, memory, horizon, ...) -{ - # Parameters (potentially) computed during shape prediction stage - predicted_shape = predictShape(today, memory, horizon, ...) - predicted_delta = private$.pjump(private$.data, today, memory, horizon, params, ...) - # Predicted shape is aligned it on the end of current day + jump - predicted_shape + tail(private$.data$getSerie(today),1) - predicted_shape[1] + predicted_delta -} - -#' Shape prediction (centered curve) -#' -#' @inheritParams predictSerie -predictShape = function(private, today, memory, horizon, ...) - #empty default implementation: to implement in inherited classes - -#' Get parameters list -#' -#' @inheritParams initialize -getParameters = function(private) - private$.params diff --git a/pkg/R/computeForecast.R b/pkg/R/computeForecast.R index 0585e1b..ec6fa07 100644 --- a/pkg/R/computeForecast.R +++ b/pkg/R/computeForecast.R @@ -21,12 +21,7 @@ #' @param horizon Number of time steps to predict #' @param ... Additional parameters for the forecasting models #' -#' @return A list with the following items -#' \itemize{ -#' \item serie: forecasted serie -#' \item params: corresponding list of parameters (weights, neighbors...) -#' \item index: corresponding index in data object -#' } +#' @return An object of class Forecast #' #' @examples #' ts_data = system.file("extdata","pm10_mesures_H_loc.csv",package="talweg") @@ -50,18 +45,17 @@ computeForecast = function(data, indices, forecaster, pjump, horizon = as.integer(horizon)[1] if (horizon<=0 || horizon>length(data$getCenteredSerie(2))) stop("Horizon too short or too long") - indices = sapply( seq_along(indices), function(i) dateIndexToInteger(indices[i], data) ) - if (any(indices<=0 | indices>data$getSize())) + integer_indices = sapply(seq_along(indices), function(i) dateIndexToInteger(indices[i],data)) + if (any(integer_indices<=0 | integer_indices>data$getSize())) stop("Indices out of range") - indices = sapply(indices, dateIndexToInteger, data) - if (!is.character(forecaster)) - stop("forecaster (name) should be of class character") #pjump could be NULL + if (!is.character(forecaster) || !is.character(pjump)) + stop("forecaster (name) and pjump (function) should be of class character") - pred = Forecast$new() + pred = Forecast$new( dates=sapply( indices, integerIndexToDate, data ) ) forecaster_class_name = getFromNamespace(paste(forecaster,"Forecaster",sep=""), "talweg") forecaster = forecaster_class_name$new(data=data, pjump = getFromNamespace(paste("get",pjump,"JumpPredict",sep=""), "talweg")) - for (today in indices) + for (today in integer_indices) { pred$append( new_serie = forecaster$predictSerie(today, memory, horizon, ...), diff --git a/pkg/R/getData.R b/pkg/R/getData.R index df94895..a4e1e17 100644 --- a/pkg/R/getData.R +++ b/pkg/R/getData.R @@ -15,14 +15,7 @@ #' @param predict_at When does the prediction take place ? Integer, in hours. Default: 0 #' @param limit Number of days to extract (default: Inf, for "all") #' -#' @return A list where data[[i]] contains -#' \itemize{ -#' \item time: vector of times -#' \item centered_serie: centered serie -#' \item level: corresponding level -#' \item exo: exogenous variables -#' \item exo_hat: predicted exogenous variables -#' } +#' @return An object of class Data #' #' @examples #' ts_data = read.csv(system.file("extdata","pm10_mesures_H_loc.csv",package="talweg")) @@ -68,7 +61,7 @@ getData = function(ts_data, exo_data, input_tz="GMT", date_format="%d/%m/%Y %H:% line = 1 #index in PM10 file (24 lines for 1 cell) nb_lines = nrow(ts_df) nb_exos = ( ncol(exo_df) - 1 ) / 2 - data = list() + data = Data$new() i = 1 #index of a cell in data while (line <= nb_lines) { @@ -89,22 +82,17 @@ getData = function(ts_data, exo_data, input_tz="GMT", date_format="%d/%m/%Y %H:% exo_hat = as.data.frame( exo_df[i,(1+nb_exos+1):(1+2*nb_exos)] ) level = mean(serie, na.rm=TRUE) centered_serie = serie - level - data[[i]] = list("time"=time, "centered_serie"=centered_serie, "level"=level, - "exo"=exo, "exo_hat"=exo_hat) + data$append(time, centered_serie, level, exo, exo_hat) if (i >= limit) break i = i + 1 } - start = 1 - end = length(data) - if (length(data[[1]]$centered_serie) < length(data[[2]]$centered_serie)) - start = 2 - if (length(data[[length(data)]]$centered_serie) < - length(data[[length(data)-1]]$centered_serie)) + if (length(data$getCenteredSerie(1)) < length(data$getCenteredSerie(2))) + data$removeFirst() + if (length(data$getCenteredSerie(data$getSize())) + < length(data$getCenteredSerie(data$getSize()-1))) { - end = end-1 + data$removeLast() } - if (start>1 || end