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 ==> "isSimilarDay()..."
  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     #Look for similar days in similar season
  77     nb_days = min( (index-1) %/% 7, limit)
  78     i = index - 7
  79     days = c()
  80     month_ref = as.POSIXlt(data$getTime(index)[1])$mon + 1
  81     while (i >= 1 && length(days) < limit)
  82     {
  83         if (isSameSeason(as.POSIXlt(data$getTime(i)[1])$mon + 1, month_ref))
  84             days = c(days, i)
  85         i = i-7
  86     }
  87     return ( days )
  88 }
  89
  90 #TODO: use data... 12-12-1-2 CH, 3-4-9-10 EP et le reste NP
  91 isSameSeason = function(month, month_ref)
  92 {
  93     if (month_ref %in% c(11,12,1,2))
  94         return (month %in% c(11,12,1,2))
  95     if (month_ref %in% c(3,4,9,10))
  96         return (month %in% c(3,4,9,10))
  97     return (month %in% c(5,6,7,8))
  98 }
  99
 100 #TODO:
 101 #distinction lun-jeudi, puis ven, sam, dim
 102 #isSameDay = function(day, day_ref)
 103 #{
 104 #   if (day_ref ==
 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 }