improve doc of computeForecast for realtime usage
[talweg.git] / pkg / R / utils.R
CommitLineData
25b75559 1#' dateIndexToInteger
3d69ff21 2#'
25b75559 3#' Transform a (potential) date index into an integer (relative to data)
3d69ff21
BA
4#'
5#' @param index Date (or integer) index
6#' @param data Object of class \code{Data}
7#'
8#' @export
9dateIndexToInteger = function(index, data)
10{
98e958ca 11 #works on integers too: trust input
3d69ff21
BA
12 if (is.numeric(index))
13 index = as.integer(index)
3d69ff21 14 if (is.integer(index))
98e958ca
BA
15 return (index)
16
09cf9c19 17 if (inherits(index, "Date") || is.character(index))
3d69ff21 18 {
72b9c501
BA
19 tryCatch(indexAsDate <- as.Date(index),
20 error=function(e) stop("Unrecognized index format"))
3d69ff21 21 #TODO: tz arg to difftime ?
44a9990b
BA
22 integerIndex <- round( as.numeric(
23 difftime(indexAsDate, as.Date(data$getTime(1)[1])) ) ) + 1
24 if (integerIndex >= 1 && integerIndex <= data$getSize())
25b75559 25 return (integerIndex)
3d69ff21
BA
26 stop("Date outside data range")
27 }
28 stop("Unrecognized index format")
29}
30
25b75559 31#' integerIndexToDate
09cf9c19 32#'
25b75559 33#' Transform an integer index to date index (relative to data)
09cf9c19
BA
34#'
35#' @param index Date (or integer) index
36#' @param data Object of class \code{Data}
37#'
38#' @export
39integerIndexToDate = function(index, data)
40{
98e958ca
BA
41 #works on dates too: trust input
42 if (is.character(index))
43 index = as.Date(index)
a66a84b5 44 if (is(index,"Date"))
98e958ca
BA
45 return (index)
46
09cf9c19
BA
47 index = index[1]
48 if (is.numeric(index))
49 index = as.integer(index)
50 if (!is.integer(index))
a66a84b5 51 stop("'index' should be a date or integer")
09cf9c19
BA
52 as.Date( data$getTime(index)[1] )
53}
54
25b75559 55#' getSimilarDaysIndices
3d69ff21 56#'
4e25de2c 57#' Find similar days indices in the past.
3d69ff21
BA
58#'
59#' @param index Day index (numeric or date)
ee8b1b4e 60#' @param data Reference dataset, object output of \code{getData}
3d69ff21 61#' @param limit Maximum number of indices to return
4e25de2c 62#' @param same_season Should the indices correspond to day in same season?
6774e53d 63#' @param days_in Optional set to intersect with results (NULL to discard)
3d69ff21
BA
64#'
65#' @export
6774e53d 66getSimilarDaysIndices = function(index, data, limit, same_season, days_in=NULL)
3d69ff21 67{
ee8b1b4e 68 index = dateIndexToInteger(index, data)
3d69ff21 69
ee8b1b4e
BA
70 # Look for similar days (optionally in same season)
71 i = index - 1
3d69ff21 72 days = c()
ee8b1b4e
BA
73 dt_ref = as.POSIXlt(data$getTime(index)[1]) #first date-time of current day
74 day_ref = dt_ref$wday #1=monday, ..., 6=saturday, 0=sunday
75 month_ref = as.POSIXlt(data$getTime(index)[1])$mon+1 #month in 1...12
3d69ff21
BA
76 while (i >= 1 && length(days) < limit)
77 {
ee8b1b4e 78 dt = as.POSIXlt(data$getTime(i)[1])
6774e53d 79 if ((is.null(days_in) || i %in% days_in) && .isSameDay(dt$wday, day_ref))
ee8b1b4e
BA
80 {
81 if (!same_season || .isSameSeason(dt$mon+1, month_ref))
82 days = c(days, i)
83 }
84 i = i - 1
3d69ff21 85 }
a866acb3
BA
86 return ( days )
87}
3d69ff21 88
ee8b1b4e
BA
89# isSameSeason
90#
91# Check if two months fall in the same "season" (defined by estimated pollution rate)
92#
93# @param month month index to test
94# @param month_ref month to compare to
95#
96.isSameSeason = function(month, month_ref)
a866acb3 97{
ee8b1b4e 98 if (month_ref %in% c(11,12,1,2)) #~= mid-polluted
a866acb3 99 return (month %in% c(11,12,1,2))
ee8b1b4e 100 if (month_ref %in% c(3,4,9,10)) #~= high-polluted
a866acb3 101 return (month %in% c(3,4,9,10))
ee8b1b4e 102 return (month %in% c(5,6,7,8)) #~= non polluted
3d69ff21 103}
25b75559 104
ee8b1b4e
BA
105# isSameDay
106#
107# Monday=Tuesday=Wednesday=Thursday ; Friday, Saturday, Sunday: specials
108#
109# @param day day index to test
110# @param day_ref day index to compare to
111#
112.isSameDay = function(day, day_ref)
113{
114 if (day_ref == 0)
115 return (day==0)
116 if (day_ref <= 4)
117 return (day <= 4)
118 return (day == day_ref)
119}
a866acb3 120
98e958ca
BA
121#' getNoNA2
122#'
123#' Get indices in data of no-NA series followed by no-NA, within [first,last] range.
124#'
125#' @param data Object of class Data
126#' @param first First index (included)
127#' @param last Last index (included)
128#'
129#' @export
130getNoNA2 = function(data, first, last)
131{
132 (first:last)[ sapply(first:last, function(i)
133 !any( is.na(data$getCenteredSerie(i)) | is.na(data$getCenteredSerie(i+1)) )
134 ) ]
135}