test-SeriesAggreg.R 8.21 KB
Newer Older
1
context("SeriesAggreg")
2

3
4
5
## load catchment data
data(L0123002)

6
7
test_that("No warning with InputsModel Cemaneige'", {
  ## preparation of the InputsModel object
8
9
10
11
12
13
14
15
16
  InputsModel <- CreateInputsModel(
    FUN_MOD = RunModel_CemaNeige,
    DatesR = BasinObs$DatesR,
    Precip = BasinObs$P,
    TempMean = BasinObs$T,
    ZInputs = BasinInfo$HypsoData[51],
    HypsoData = BasinInfo$HypsoData,
    NLayers = 5
  )
17
18
19
20
21
22
  # Expect no warning: https://stackoverflow.com/a/33638939/5300212
  expect_warning(SeriesAggreg(InputsModel, "%m"),
                 regexp = NA)
})

test_that("Warning: deprecated 'TimeFormat' argument", {
23
24
25
26
27
28
  InputsModel <- CreateInputsModel(
    FUN_MOD = RunModel_GR4J,
    DatesR = BasinObs$DatesR,
    Precip = BasinObs$P,
    PotEvap = BasinObs$E
  )
29
30
31
32
33
34
  expect_warning(SeriesAggreg(InputsModel, Format = "%Y%m", TimeFormat = "daily"),
                 regexp = "deprecated 'TimeFormat' argument")
})

test_that("Warning: deprecated 'NewTimeFormat' argument: please use 'Format' instead",
          {
35
36
37
38
39
40
            InputsModel <- CreateInputsModel(
              FUN_MOD = RunModel_GR4J,
              DatesR = BasinObs$DatesR,
              Precip = BasinObs$P,
              PotEvap = BasinObs$E
            )
41
42
43
44
45
46
            expect_warning(SeriesAggreg(InputsModel, NewTimeFormat = "monthly"),
                           regexp = "deprecated 'NewTimeFormat' argument: please use 'Format' instead")
          })

test_that("Warning: deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
          {
47
48
49
50
51
52
            InputsModel <- CreateInputsModel(
              FUN_MOD = RunModel_GR4J,
              DatesR = BasinObs$DatesR,
              Precip = BasinObs$P,
              PotEvap = BasinObs$E
            )
53
54
55
56
57
58
59
60
61
62
63
            expect_warning(SeriesAggreg(InputsModel, Format = "%Y%m", NewTimeFormat = "monthly"),
                           regexp = "deprecated 'NewTimeFormat' argument: 'Format' argument is used instead")
          })

test_that("Check SeriesAggreg output values on yearly aggregation", {
  TabSeries <- data.frame(
    DatesR = BasinObs$DatesR,
    P = BasinObs$P,
    E = BasinObs$E,
    Qmm = BasinObs$Qmm
  )
64
65
66
  GoodValues <- apply(BasinObs[BasinObs$DatesR >= "1984-09-01" &
                                 BasinObs$DatesR < "1985-09-01",
                               c("P", "E", "Qmm")], 2, sum)
67
68
  TestedValues <- unlist(SeriesAggreg(TabSeries,
                                      Format = "%Y",
69
70
                                      YearFirstMonth = 9,
                                      ConvertFun = rep("sum", 3))[1, c("P", "E", "Qmm")])
71
  expect_equal(GoodValues, TestedValues)
72
})
73

74
75
76
77
78
79
80
81
82
83
84
85
test_that("Regime calculation should switch ConvertFun to 'mean' for InputsModel", {
  InputsModel <- CreateInputsModel(
    FUN_MOD = RunModel_GR4J,
    DatesR = BasinObs$DatesR,
    Precip = BasinObs$P,
    PotEvap = BasinObs$E
  )

  expect_equal(SeriesAggreg(InputsModel, "%m")$Precip,
               SeriesAggreg(BasinObs[, c("DatesR", "P")], "%m", ConvertFun = "mean")$P)
})

86
87
88
89
90
91
92
test_that("No DatesR should warning", {
  TabSeries <- list(
    Dates = BasinObs$DatesR,
    P = BasinObs$P,
    E = BasinObs$E,
    Qmm = BasinObs$Qmm
  )
93
94
95
96
  expect_warning(
    SeriesAggreg(TabSeries, "%Y%m", ConvertFun = "sum"),
    regexp = "has been automatically chosen"
  )
97
98
})

99
test_that("Check SeriesAggreg.list 'DatesR' argument", {
100
101
102
103
104
105
  InputsModel <- CreateInputsModel(
    FUN_MOD = RunModel_GR4J,
    DatesR = BasinObs$DatesR,
    Precip = BasinObs$P,
    PotEvap = BasinObs$E
  )
106
107
108
109
110
111
112
113
114
115
  DatesR <- InputsModel$DatesR
  # No InputsModel$DatesR
  InputsModel$DatesR <- NULL
  expect_error(SeriesAggreg(InputsModel, "%Y%m"), regexp = "'POSIXt'")
  # Other list item chosen
  InputsModel$SuperDates <- DatesR
  expect_warning(SeriesAggreg(InputsModel, "%Y%m"), regexp = "SuperDates")
  # Wrong InputsModel$DatesR
  InputsModel$DatesR <- BasinObs$P
  expect_error(SeriesAggreg(InputsModel, "%Y%m"), regexp = "'POSIXt'")
116

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
})

test_that("Check SeriesAggreg.list with embedded lists", {
  InputsModel <-
    CreateInputsModel(
      FUN_MOD = RunModel_CemaNeige,
      DatesR = BasinObs$DatesR,
      Precip = BasinObs$P,
      TempMean = BasinObs$T,
      ZInputs = BasinInfo$HypsoData[51],
      HypsoData = BasinInfo$HypsoData,
      NLayers = 5
    )
  I2 <- SeriesAggreg(InputsModel, "%Y%m")
  expect_equal(length(I2$ZLayers), 5)
  expect_null(I2$LayerPrecip$DatesR)
  expect_equal(length(I2$DatesR), length(I2$LayerPrecip$L1))
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
})

test_that("Check SeriesAggreg.outputsModel", {
  InputsModel <-
    CreateInputsModel(
      FUN_MOD = RunModel_CemaNeigeGR4J,
      DatesR = BasinObs$DatesR,
      Precip = BasinObs$P,
      PotEvap = BasinObs$E,
      TempMean = BasinObs$T,
      ZInputs = median(BasinInfo$HypsoData),
      HypsoData = BasinInfo$HypsoData,
      NLayers = 5
    )

  ## run period selection
  Ind_Run <-
    seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
        which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))

  ## preparation of the RunOptions object
155
156
157
158
159
160
161
162
  suppressWarnings(
    RunOptions <-
      CreateRunOptions(
        FUN_MOD = RunModel_CemaNeigeGR4J,
        InputsModel = InputsModel,
        IndPeriod_Run = Ind_Run
      )
  )
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

  ## simulation
  Param <- c(
    X1 = 408.774,
    X2 = 2.646,
    X3 = 131.264,
    X4 = 1.174,
    CNX1 = 0.962,
    CNX2 = 2.249
  )
  OutputsModel <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
                                         RunOptions = RunOptions,
                                         Param = Param)

  O2 <- SeriesAggreg(OutputsModel, "%Y%m")
  expect_equal(length(O2$StateEnd), 3)
  expect_equal(length(O2$DatesR),
               length(O2$CemaNeigeLayers$Layer01$Pliq))
})
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199

test_that("Check data.frame handling in SeriesAggreg.list", {
  QObsUp <- imputeTS::na_interpolation(BasinObs$Qmm)
  InputsModelDown1 <- CreateInputsModel(
    FUN_MOD = RunModel_GR4J,
    DatesR = BasinObs$DatesR,
    Precip = BasinObs$P,
    PotEvap = BasinObs$E,
    Qupstream = matrix(QObsUp, ncol = 1),
    # Upstream observed flow
    LengthHydro = 100 * 1000,
    # Distance between upstream catchment outlet and the downstream one in m
    BasinAreas = c(180, 180) # Upstream and downstream areas in km²
  )
  expect_warning(SeriesAggreg(InputsModelDown1, "%Y%m"),
                 regexp = NA)
  I2 <- SeriesAggreg(InputsModelDown1, "%Y%m")
  expect_equal(length(I2$DatesR), nrow(I2$Qupstream))
200
201
  InputsModelDown1$Qupstream <-
    InputsModelDown1$Qupstream[-1, , drop = FALSE] # https://stackoverflow.com/a/7352287/5300212
202
  expect_warning(SeriesAggreg(InputsModelDown1, "%Y%m"),
203
                 regexp = "it will be ignored in the aggregation")
204
})
205

206
207
208
209
210
211
212
213
test_that("SeriesAggreg from and to the same time step should return initial time series", {
  InputsModel <- CreateInputsModel(
    FUN_MOD = RunModel_GR4J,
    DatesR = BasinObs$DatesR,
    Precip = BasinObs$P,
    PotEvap = BasinObs$E
  )
  I2 <- SeriesAggreg(InputsModel, "%Y%m")
214
215
  expect_warning(SeriesAggreg(I2, "%Y%m"), regexp = "No time-step conversion was performed")
  expect_equal(I2, suppressWarnings(SeriesAggreg(I2, "%Y%m")))
216
})
217

218
219
220
221
222
223
224
225
226
test_that("SeriesAggreg.data.frame with first column not named DatesR should work",
          {
            expect_warning(SeriesAggreg(
              data.frame(BasinObs$DatesR, BasinObs$Qmm),
              Format = "%Y%m",
              ConvertFun = "sum"
            ),
            regexp = NA)
          })
227
228
229
230
231

test_that("SeriesAggreg should work with ConvertFun 'min', 'max' and 'median'", {
  Qls <- BasinObs[, c("DatesR", "Qls")]
  test_ConvertFunRegime <- function(x, ConvertFun, TimeFormat) {
    expect_equal(nrow(SeriesAggreg(x, TimeFormat, ConvertFun = ConvertFun)),
232
                 length(unique(format(BasinObs$DatesR, "%Y"))))
233
234
235
  }
  lapply(c("max", "min", "median"), function(x) {test_ConvertFunRegime(Qls, x, "%Y")})
})
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251

test_that("Error on convertFun Q without 0-100", {
  Qls <- BasinObs[, c("DatesR", "Qls")]
  expect_error(SeriesAggreg(Qls, "%Y", "q101"))
  expect_error(SeriesAggreg(Qls, "%Y", "q-2"))
  expect_error(SeriesAggreg(Qls, "%Y", "q12.5"))
})

test_that("ConvertFun q50 should be equal to median", {
  Qls <- BasinObs[, c("DatesR", "Qls")]
  expect_equal(SeriesAggreg(Qls, "%Y", "q50"),
               SeriesAggreg(Qls, "%Y", "median"))
  expect_equal(SeriesAggreg(Qls, "%Y", "q50"),
               SeriesAggreg(Qls, "%Y", "q050"))
})