pkg/R/utils.R

   1 #' dateIndexToInteger
   2 #'
   3 #' 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     #works on integers too: trust input
  12     if (is.numeric(index))
  13         index = as.integer(index)
  14     if (is.integer(index))
  15         return (index)
  16
  17     if (inherits(index, "Date") || is.character(index))
  18     {
  19         tryCatch(indexAsDate <- as.Date(index), error=function(e) stop("Unrecognized index format"))
  20         #TODO: tz arg to difftime ?
  21         integerIndex <- round( as.numeric(
  22             difftime(indexAsDate, as.Date(data$getTime(1)[1])) ) ) + 1
  23         if (integerIndex >= 1 && integerIndex <= data$getSize())
  24             return (integerIndex)
  25         stop("Date outside data range")
  26     }
  27     stop("Unrecognized index format")
  28 }
  29
  30 #' integerIndexToDate
  31 #'
  32 #' Transform an integer index to date index (relative to data)
  33 #'
  34 #' @param index Date (or integer) index
  35 #' @param data Object of class \code{Data}
  36 #'
  37 #' @export
  38 integerIndexToDate = function(index, data)
  39 {
  40     #works on dates too: trust input
  41     if (is.character(index))
  42         index = as.Date(index)
  43     if (is(index,"Date"))
  44         return (index)
  45
  46     index = index[1]
  47     if (is.numeric(index))
  48         index = as.integer(index)
  49     if (!is.integer(index))
  50         stop("'index' should be a date or integer")
  51     as.Date( data$getTime(index)[1] )
  52 }
  53
  54 #' getSimilarDaysIndices
  55 #'
  56 #' Find similar days indices in the past.
  57 #'
  58 #' @param index Day index (numeric or date)
  59 #' @param limit Maximum number of indices to return
  60 #' @param same_season Should the indices correspond to day in same season?
  61 #' @param data Dataset is required for a search in same season
  62 #'
  63 #' @export
  64 getSimilarDaysIndices = function(index, limit, same_season, data=NULL)
  65 {
  66     index = dateIndexToInteger(index)
  67
  68     #TODO: mardi similaire à lundi mercredi jeudi aussi ...etc
  69     if (!same_season)
  70     {
  71         #take all similar days in recent past
  72         nb_days = min( (index-1) %/% 7, limit)
  73         return ( rep(index,nb_days) - 7*seq_len(nb_days) )
  74     }
  75
  76
  77     #TODO: use data... 12-12-1-2 CH, 3-4-9-10 EP et le reste NP
  78     #Look for similar days in similar season
  79     days = c()
  80     i = index
  81     while (i >= 1 && length(days) < limit)
  82     {
  83         if (i < index)
  84         {
  85             days = c(days, i)
  86             #look in the "future of the past"
  87             for (j in 1:4)
  88                 days = c(days, i+7*j)
  89         }
  90         #...and in the "past of the past"
  91         for (j in 1:4)
  92         {
  93             if (i - 7*j >= 1)
  94                 days = c(days, i-7*j)
  95         }
  96         # TODO: exact computation instead of -364
  97         # 364 = closest multiple of 7 to 365 - drift along the years... but not so many years so OK
  98         i = i - 364
  99
 100
 101     }
 102
 103     return ( days[1:min(limit,length(days))] )
 104 }
 105
 106 #' getNoNA2
 107 #'
 108 #' Get indices in data of no-NA series followed by no-NA, within [first,last] range.
 109 #'
 110 #' @param data Object of class Data
 111 #' @param first First index (included)
 112 #' @param last Last index (included)
 113 #'
 114 #' @export
 115 getNoNA2 = function(data, first, last)
 116 {
 117     (first:last)[ sapply(first:last, function(i)
 118         !any( is.na(data$getCenteredSerie(i)) | is.na(data$getCenteredSerie(i+1)) )
 119     ) ]
 120 }