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