20f396b6caed027042ff917a396fd87880ee51c0
[talweg.git] / 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 }