pkg/R/utils.R

   1 #' @title dateIndexToInteger
   2 #'
   3 #' @description Transform a (potential) date index into an integer (relative to data)
   4 #'
   5 #' @param index Date (or integer) index
   6 #' @param data Object of class \code{Data}
   7 #'
   8 #' @export
   9 dateIndexToInteger = function(index, data)
  10 {
  11     index = index[1]
  12     if (is.numeric(index))
  13         index = as.integer(index)
  14     if (is.integer(index))
  15         return (index)
  16     if (inherits(index, "Date") || is.character(index))
  17     {
  18         tryCatch(indexAsDate <- as.Date(index), error=function(e) stop("Unrecognized index format"))
  19         #TODO: tz arg to difftime ?
  20         integerIndex <- round( as.numeric(
  21             difftime(indexAsDate, as.Date(data$getTime(1)[1])) ) ) + 1
  22         if (integerIndex >= 1 && integerIndex <= data$getSize())
  23         {
  24             #WARNING: if index>=2 && series start at date >0h, result must be shifted
  25             #Convention: if first date asked, return first matching index (i.e.: 1)
  26             shift = 0
  27             if (integerIndex >= 2)
  28             {
  29                 date1 = as.POSIXlt(data$getTime(1)[1])
  30                 date2 = as.POSIXlt(data$getTime(2)[1])
  31                 shift = (date1$year==date2$year && date1$mon==date2$mon && date1$mday==date2$mday)
  32             }
  33             return (integerIndex + shift)
  34         }
  35         stop("Date outside data range")
  36     }
  37     stop("Unrecognized index format")
  38 }
  39
  40 #' @title integerIndexToDate
  41 #'
  42 #' @description Transform an integer index to date index (relative to data)
  43 #'
  44 #' @param index Date (or integer) index
  45 #' @param data Object of class \code{Data}
  46 #'
  47 #' @export
  48 integerIndexToDate = function(index, data)
  49 {
  50     index = index[1]
  51     if (is.numeric(index))
  52         index = as.integer(index)
  53     if (!is.integer(index))
  54         stop("'index' should be an integer")
  55     as.Date( data$getTime(index)[1] )
  56 }
  57
  58 #' @title getSimilarDaysIndices
  59 #'
  60 #' @description Find similar days indices in the past
  61 #'
  62 #' @param index Day index (numeric or date)
  63 #' @param limit Maximum number of indices to return
  64 #' @param same_seaon Should the indices correspond to day in same season?
  65 #'
  66 #' @export
  67 getSimilarDaysIndices = function(index, limit, same_season)
  68 {
  69     index = dateIndexToInteger(index)
  70
  71     #TODO: mardi similaire à lundi mercredi jeudi aussi ...etc
  72     if (!same_season)
  73     {
  74         #take all similar days in recent past
  75         nb_days = min( (index-1) %/% 7, limit)
  76         return ( rep(index,nb_days) - 7*seq_len(nb_days) )
  77     }
  78
  79     #Look for similar days in similar season (+/- 30 days)
  80     days = c()
  81     i = index
  82     while (i >= 1 && length(days) < limit)
  83     {
  84         if (i < index)
  85         {
  86             days = c(days, i)
  87             #look in the "future of the past"
  88             for (j in 1:4)
  89                 days = c(days, i+7*j)
  90         }
  91         #...and in the "past of the past"
  92         for (j in 1:4)
  93         {
  94             if (i - 7*j >= 1)
  95                 days = c(days, i-7*j)
  96         }
  97         # TODO: exact computation instead of -364
  98         # 364 = closest multiple of 7 to 365 - drift along the years... but not so many years so OK
  99         i = i - 364
 100     }
 101
 102     return ( days[1:min(limit,length(days))] )
 103 }