X-Git-Url: https://git.auder.net/?a=blobdiff_plain;f=pkg%2FR%2FF_Neighbors.R;h=ea27d5c12a002bdbc60ac20bba861c4fc028bb2c;hb=a3344f7591f6f4b3d337a69e4a568e9b16e33415;hp=17fdd58d7a19b3e448e92f37e2e8d192a824e261;hpb=9b9bb2d490e356ff0393aec66b137cff0a64803d;p=talweg.git diff --git a/pkg/R/F_Neighbors.R b/pkg/R/F_Neighbors.R index 17fdd58..ea27d5c 100644 --- a/pkg/R/F_Neighbors.R +++ b/pkg/R/F_Neighbors.R @@ -57,8 +57,8 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", if (!opera) tdays = setdiff(tdays, today) #always exclude current day - # Shortcut if window is known or local==TRUE && simtype==none - if (hasArg("window") || (local && simtype=="none")) + # Shortcut if window is known + if (hasArg("window")) { return ( private$.predictShapeAux(data, tdays, today, predict_from, horizon, local, list(...)$window, simtype, opera, TRUE) ) @@ -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, nb_neighbs, opera) 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 = 10 #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) + distances2 <- .computeDistsExo(data, today, tdays, opera) + # 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) @@ -221,9 +218,9 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", # @param min_neighbs Minimum number of points in a neighborhood # @param max_neighbs Maximum number of points in a neighborhood # -.getConstrainedNeighbs = function(today, data, tdays, min_neighbs=10) +.getConstrainedNeighbs = function(today, data, tdays, min_neighbs, opera) { - levelToday = data$getLevelHat(today) + levelToday = ifelse(opera, tail(data$getLevelHat(today),1), data$getLevel(today)) distances = sapply( tdays, function(i) abs(data$getLevel(i) - levelToday) ) #TODO: 1, +1, +3 : magic numbers dist_thresh = 1 @@ -268,10 +265,13 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", }) } -.computeDistsExo <- function(data, today, tdays) +.computeDistsExo <- function(data, today, tdays, opera) { M = matrix( ncol=1+length(tdays), nrow=1+length(data$getExo(1)) ) - M[,1] = c( data$getLevelHat(today), as.double(data$getExoHat(today)) ) + if (opera) + M[,1] = c( tail(data$getLevelHat(today),1), as.double(data$getExoHat(today)) ) + else + M[,1] = c( data$getLevel(today), as.double(data$getExo(today)) ) for (i in seq_along(tdays)) M[,i+1] = c( data$getLevel(tdays[i]), as.double(data$getExo(tdays[i])) )