diff --git a/R/PE_Oudin.R b/R/PE_Oudin.R index 0f6c8352e39c1ff6532201444304c99dd52164fb..4b5cbf755c24f3e81991486584c374b1c6b41513 100644 --- a/R/PE_Oudin.R +++ b/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) } diff --git a/tests/testthat/test-evap.R b/tests/testthat/test-evap.R index e68a47159c5e744cf5566b7b5e4241495ed99f61..bdf813dfbec218f54bd1d132c1539c97fe2449de 100644 --- a/tests/testthat/test-evap.R +++ b/tests/testthat/test-evap.R @@ -1,5 +1,11 @@ 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) + + +}) + +