Merge branch '134-allow-the-use-of-inconsistent-chronicles-in-pe_oudin' into 'dev'

Resolve "Allow the use of inconsistent chronicles in PE_Oudin"

Closes #134

See merge request HYCAR-Hydro/airgr!56

R/PE_Oudin.R

@@ -41,11 +41,10 @@ PE_Oudin <- function(JD, Temp,
   TimeStepIn  <- match.arg(TimeStepIn , choices = TimeStep)
   TimeStepOut <- match.arg(TimeStepOut, choices = TimeStep)
   rleJD <- rle(JD)
+  msgDaliy <- "each day should have only one identical value of Julian days. The time series is not sorted, or contains duplicate or missing dates"
+  msgHourly <- "each day must have 24 identical values of Julian days (one for each hour). The time series is not sorted, or contains duplicate or missing dates"
   if (TimeStepIn == "daily" & any(rleJD$lengths != 1)) {
-    stop("each day must have only one identical value of julian days")
-  }
-  if (TimeStepIn == "hourly" & any(rleJD$lengths != 24)) {
-    stop("each day must have 24 identical values of julian days (one for each hour)")
+    warning(msgDaliy)
   }
 
 
@@ -54,7 +53,14 @@ PE_Oudin <- function(JD, Temp,
   if (TimeStepIn == "hourly") {
     JD <- rleJD$values
     idJD <- rep(seq_along(JD), each = rleJD$lengths[1L])
-    Temp <- as.vector(tapply(X = Temp, INDEX = idJD, FUN = mean))
+    if (length(Temp) != length(idJD)) {
+      stop(msgHourly)
+    } else {
+      Temp <- as.vector(tapply(X = Temp, INDEX = idJD, FUN = mean))
+    }
+  }
+  if (TimeStepIn == "hourly" & any(rleJD$lengths != 24)) {
+    warning(msgHourly)
   }
 
 

tests/testthat/test-evap.R

 context("Test evaporation")
 
+
+rm(list = ls())
+data(L0123001); BasinObs_L0123001 <- BasinObs
+data(L0123002); BasinObs_L0123002 <- BasinObs
+data(L0123003); BasinObs_L0123003 <- BasinObs
+
 comp_evap <- function(BasinObs,
                       Lat, LatUnit,
                       TimeStepIn = "daily",
@@ -16,12 +22,9 @@ comp_evap <- function(BasinObs,
   all(range(PotEvap - PotEvapFor) < 0.000001)
 }
 
+
 test_that("PE_Oudin works", {
   skip_on_cran()
-  rm(list = ls())
-
-  data(L0123001); BasinObs_L0123001 <- BasinObs
-  data(L0123002); BasinObs_L0123002 <- BasinObs
 
   expect_true(comp_evap(BasinObs = BasinObs_L0123001,
                         Lat = 0.8, LatUnit = "rad",
@@ -59,3 +62,36 @@ test_that("PE_Oudin works", {
 
   expect_equal(PotEvapFor, c(PotEvapFor1, PotEvapFor2))
 })
+
+test_that("Inconsitent time series", {
+  skip_on_cran()
+
+  msgDaily <- "each day should have only one identical value of Julian days. The time series is not sorted, or contains duplicate or missing dates"
+  msgHoury <- "each day must have 24 identical values of Julian days (one for each hour). The time series is not sorted, or contains duplicate or missing dates"
+
+  # duplicated dates
+  DatesFor1Dupl <- BasinObs_L0123001$DatesR
+  DatesFor1Dupl[5L] <- DatesFor1Dupl[4L]
+  expect_warning(object = PE_Oudin(JD = as.POSIXlt(DatesFor1Dupl)$yday + 1,
+                                   Temp = BasinObs_L0123001$T,
+                                   Lat = 0.8, LatUnit = "rad"),
+                 regexp = msgDaily)
+
+  # not ordered daily dates
+  DatesFor1Messy <- sample(BasinObs_L0123001$DatesR)
+  expect_warning(object = PE_Oudin(JD = as.POSIXlt(DatesFor1Messy)$yday + 1,
+                                   Temp = BasinObs_L0123001$T,
+                                   Lat = 0.8, LatUnit = "rad"),
+                 regexp = msgDaily)
+
+  # not ordered hourly dates
+  DatesFor3Messy <- sample(BasinObs_L0123003$DatesR)
+  expect_error(object = PE_Oudin(JD = as.POSIXlt(DatesFor3Messy)$yday + 1,
+                                   Temp = seq_along(BasinObs_L0123003$T),
+                                   Lat = 0.8, LatUnit = "rad", TimeStepIn = "hourly"),
+                 regexp = msgHoury, fixed = TRUE)
+
+
+})
+
+