context("Delta-hybrid (mod3) downscaling: simple and detailed deltaPPT")
# Inputs
seed <- 42
years <- 1979:2010
this_year <- years[1]
daily_months <- 1 + as.POSIXlt(seq(ISOdate(years[1], 1, 1),
ISOdate(years[length(years)], 12, 31), by = "day"))$mon
month <- as.POSIXlt(paste(this_year, 1:365, sep = "-"),
format = "%Y-%j")$mon + 1
iadd <- rep(TRUE, length(month))
inotadd <- rep(FALSE, length(month))
iadd6 <- iadd
iadd6[month <= 6] <- FALSE
daily <- readRDS(file.path("..", "test_data", "dailySW.rds"))
monthly <- rSOILWAT2::dbW_weatherData_to_monthly(dailySW = daily)
data0 <- daily[[as.character(this_year)]]@data[, "PPT_cm"]
ydelta0 <- c(1.221, 1.017, 0.844, 1.514, 1.283, 1.475, 0.788, 0.679, 1.093,
2.111, 1.765, 1.113)[month]
ydelta1 <- rep(-1, 12)[month]
ydelta2 <- rep(-10, 12)[month]
ydelta3 <- c(rep(1, 6), rep(-10, 6))[month]
# Expected results
ievents0 <- data0 > 0
events_per_month0 <- tapply(as.integer(ievents0), month, sum)[month]
res0s1 <- data0 * ydelta0
res0s2 <- data0
res0s2[ievents0] <- res0s2[ievents0] + ydelta0[ievents0] /
events_per_month0[ievents0]
res0s3 <- data0
res0s3[ievents0] <- res0s3[ievents0] + ydelta1[ievents0] /
events_per_month0[ievents0]
res0s4 <- data0
res0s4[ievents0] <- res0s4[ievents0] + ydelta2[ievents0] /
events_per_month0[ievents0]
res0s4nn <- res0s4
res0s4nn[res0s4nn < 0] <- 0
res0s5 <- data0
res0s5[ievents0] <- res0s5[ievents0] + ydelta3[ievents0] /
events_per_month0[ievents0]
res0s6 <- data0
res0s6[!iadd6] <- (data0 * ydelta3)[!iadd6]
res0s6[iadd6 & ievents0] <- res0s6[iadd6 & ievents0] +
ydelta3[iadd6 & ievents0] / events_per_month0[iadd6 & ievents0]
test_that("applyPPTdelta_simple", {
# All deltas are multiplications -> no problem
expect_equal(res0s1,
applyPPTdelta_simple(m = month, data = data0, ydelta = ydelta0,
add_days = inotadd, mult_days = !inotadd))
# All deltas are additions -> no problem
expect_equal(res0s2,
applyPPTdelta_simple(m = month, data = data0, ydelta = ydelta0,
add_days = iadd, mult_days = !iadd))
# Deltas are subtractions, but are smaller than precipitation events
expect_equal(res0s3,
applyPPTdelta_simple(m = month, data = data0, ydelta = ydelta1,
add_days = iadd, mult_days = !iadd))
# Deltas are subtractions, but some are larger than precipitation events
# causing negative precipitation
expect_equal(res0s4,
applyPPTdelta_simple(m = month, data = data0, ydelta = ydelta2,
add_days = iadd, mult_days = !iadd, set_negPPT_to0 = FALSE))
expect_equal(res0s4nn,
applyPPTdelta_simple(m = month, data = data0, ydelta = ydelta2,
add_days = iadd, mult_days = !iadd, set_negPPT_to0 = TRUE))
# Some deltas are additions, some are subtractions
expect_equal(res0s5,
applyPPTdelta_simple(m = month, data = data0, ydelta = ydelta3,
add_days = iadd, mult_days = !iadd, set_negPPT_to0 = FALSE))
# Some deltas are additions/subtractions, some are multiplications
expect_equal(res0s6,
applyPPTdelta_simple(m = month, data = data0, ydelta = ydelta3,
add_days = iadd6, mult_days = !iadd6, set_negPPT_to0 = FALSE))
})
test_that("applyPPTdelta_detailed", {
# All deltas are multiplications -> no problem
set.seed(seed)
temp <- applyPPTdelta_detailed(m = month, data = data0, ydelta = ydelta0,
add_days = inotadd, mult_days = !inotadd, daily, monthly)
expect_equal_to_reference(temp, file.path("..", "test_data",
"test_reference_applyPPTdelta_detailed_01.rds"))
expect_gte(min(temp$data), 0)
expect_equal(temp$PPT_to_remove, 0)
# All deltas are additions -> no problem
set.seed(seed)
temp <- applyPPTdelta_detailed(m = month, data = data0, ydelta = ydelta0,
add_days = iadd, mult_days = !iadd, daily, monthly)
expect_equal_to_reference(temp, file.path("..", "test_data",
"test_reference_applyPPTdelta_detailed_02.rds"))
expect_gte(min(temp$data), 0)
expect_equal(temp$PPT_to_remove, 0)
# Deltas are subtractions, but are smaller than precipitation events
set.seed(seed)
temp <- applyPPTdelta_detailed(m = month, data = data0, ydelta = ydelta1,
add_days = iadd, mult_days = !iadd, daily, monthly)
expect_equal_to_reference(temp, file.path("..", "test_data",
"test_reference_applyPPTdelta_detailed_03.rds"))
expect_gte(min(temp$data), 0)
expect_equal(temp$PPT_to_remove, 0)
# Deltas are subtractions, but some are larger than precipitation events
# causing negative precipitation
set.seed(seed)
temp <- applyPPTdelta_detailed(m = month, data = data0, ydelta = ydelta2,
add_days = iadd, mult_days = !iadd, daily, monthly)
expect_equal_to_reference(temp, file.path("..", "test_data",
"test_reference_applyPPTdelta_detailed_04.rds"))
expect_gte(min(temp$data), 0)
expect_equal(temp$PPT_to_remove, 0)
# Some deltas are additions, some are subtractions
set.seed(seed)
temp <- applyPPTdelta_detailed(m = month, data = data0, ydelta = ydelta3,
add_days = iadd, mult_days = !iadd, daily, monthly)
expect_equal_to_reference(temp, file.path("..", "test_data",
"test_reference_applyPPTdelta_detailed_05.rds"))
expect_gte(min(temp$data), 0)
expect_equal(temp$PPT_to_remove, 0)
# Some deltas are additions/subtractions, some are multiplications
set.seed(seed)
temp <- applyPPTdelta_detailed(m = month, data = data0, ydelta = ydelta3,
add_days = iadd6, mult_days = !iadd6, daily, monthly)
expect_equal_to_reference(temp, file.path("..", "test_data",
"test_reference_applyPPTdelta_detailed_06.rds"))
expect_gte(min(temp$data), 0)
expect_equal(temp$PPT_to_remove, 0)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.