diff --git a/R/VizForecastPDF.R b/R/VizForecastPDF.R index 4dffe78a56db7466ad43287a353df2f6d5a9892c..c477bd6bb56447586e562a0d56ca94963f9ce6ab 100644 --- a/R/VizForecastPDF.R +++ b/R/VizForecastPDF.R @@ -58,7 +58,7 @@ VizForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, obs = NU fcst.names = NULL, add.ensmemb = c("above", "below", "no"), color.set = c("ggplot", "s2s4e", "hydro", "vitigeoss"), memb_dim = 'member') { - value <- init <- extremes <- x <- ymin <- ymax <- tercile <- NULL + value <- init <- extremes <- x <- ymin <- ymax <- tercile <- NULL y <- xend <- yend <- yjitter <- MLT <- lab.pos <- NULL ggColorHue <- function(n) { hues <- seq(15, 375, length = n + 1) diff --git a/R/VizWeeklyClim.R b/R/VizWeeklyClim.R index 663e4c5da2185e694c0ead1e778ce97ac940ac67..9615c3b9fa0dcedd5567fc927b1ec78a6273a66b 100644 --- a/R/VizWeeklyClim.R +++ b/R/VizWeeklyClim.R @@ -272,38 +272,51 @@ VizWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, geom_ribbon(aes(ymin = p10, ymax = p90, group = .data$week, fill = "p10-p90"), alpha = 0.7, show.legend = legend) + # extremes clim geom_ribbon(aes(ymin = p33, ymax = p66, group = .data$week, fill = "p33-p66"), - alpha = 0.7, show.legend = legend) + # terciles clim - geom_line(aes(y = clim, group = .data$week, color = "climatological mean", - linetype = "climatological mean"), - alpha = 1.0, linewidth = 0.7, show.legend = legend) + # mean clim - geom_line(aes(y = data, color = "observed daily mean", - linetype = "observed daily mean"), - alpha = 1, linewidth = 0.2, show.legend = legend) + # daily evolution - geom_line(aes(y = week_mean, group = .data$week, color = "observed weekly mean", - linetype = "observed weekly mean"), - alpha = 1, linewidth = 0.7, show.legend = legend) + # weekly evolution - theme_bw() + ylab(ytitle) + xlab(NULL) + - ggtitle(title, subtitle = subtitle) + - scale_x_date(breaks = seq(min(all$day), max(all$day), by = "7 days"), - minor_breaks = NULL, expand = c(0.03, 0.03), - labels = scales::date_format("%d %b %Y")) + - theme(axis.text.x = element_text(angle = 45, hjust = 1), - panel.grid.major = element_line(size = 0.5, linetype = 'solid', - colour = "gray92"), - panel.grid.minor = element_line(size = 0.25, linetype = 'solid', - colour = "gray92"), - legend.spacing = unit(-0.2, "cm")) + - scale_fill_manual(name = NULL, - values = c("p10-p90" = cols[3], "p33-p66" = cols[4])) + - scale_color_manual(name = NULL, values = c("climatological mean" = cols[5], - "observed daily mean" = "grey20", - "observed weekly mean" = "black")) + - scale_linetype_manual(name = NULL, values = c("climatological mean" = "solid", - "observed daily mean" = "dashed", - "observed weekly mean" = "solid"), - guide = guide_legend(override.aes = list(lwd = c(0.7, 0.2, 0.7)))) + - guides(fill = guide_legend(order = 1)) + - scale_y_continuous(limits = ylim) + alpha = 0.7, show.legend = legend) + # weekly evolution + if (packageVersion("ggplot2") < 3.4) { + p = p + geom_line(aes(y = clim, group = .data$week, color = "climatological mean", + linetype = "climatological mean"), + alpha = 1.0, size = 0.7, show.legend = legend) + # mean clim + geom_line(aes(y = data, color = "observed daily mean", + linetype = "observed daily mean"), + alpha = 1, size = 0.2, show.legend = legend) + # daily evolution + geom_line(aes(y = week_mean, group = .data$week, color = "observed weekly mean", + linetype = "observed weekly mean"), + alpha = 1, size = 0.7, show.legend = legend) + } else { + p = p + geom_line(aes(y = clim, group = .data$week, color = "climatological mean", + linetype = "climatological mean"), + alpha = 1.0, linewidth = 0.7, show.legend = legend) + # mean clim + geom_line(aes(y = data, color = "observed daily mean", + linetype = "observed daily mean"), + alpha = 1, linewidth = 0.2, show.legend = legend) + # daily evolution + geom_line(aes(y = week_mean, group = .data$week, color = "observed weekly mean", + linetype = "observed weekly mean"), + alpha = 1, linewidth = 0.7, show.legend = legend) + } + p = p + theme_bw() + ylab(ytitle) + xlab(NULL) + + ggtitle(title, subtitle = subtitle) + + scale_x_date(breaks = seq(min(all$day), max(all$day), by = "7 days"), + minor_breaks = NULL, expand = c(0.03, 0.03), + labels = scales::date_format("%d %b %Y")) + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + panel.grid.major = element_line(size = 0.5, linetype = 'solid', + colour = "gray92"), + panel.grid.minor = element_line(size = 0.25, linetype = 'solid', + colour = "gray92"), + legend.spacing = unit(-0.2, "cm")) + + scale_fill_manual(name = NULL, + values = c("p10-p90" = cols[3], "p33-p66" = cols[4])) + + scale_color_manual(name = NULL, values = c("climatological mean" = cols[5], + "observed daily mean" = "grey20", + "observed weekly mean" = "black")) + + scale_linetype_manual(name = NULL, values = c("climatological mean" = "solid", + "observed daily mean" = "dashed", + "observed weekly mean" = "solid"), + guide = guide_legend(override.aes = list(lwd = c(0.7, 0.2, 0.7)))) + + guides(fill = guide_legend(order = 1)) + + scale_y_continuous(limits = ylim) # Return the ggplot object if (is.null(fileout)) { diff --git a/tests/testthat/_snaps/PlotRobinson/PlotRobinson_1b.png b/tests/testthat/_snaps/PlotRobinson/PlotRobinson_1b.png deleted file mode 100644 index 31a42335dc96c816b19ba26f072b2ff44f4b0bd6..0000000000000000000000000000000000000000 Binary files a/tests/testthat/_snaps/PlotRobinson/PlotRobinson_1b.png and /dev/null differ diff --git a/tests/testthat/_snaps/PlotRobinson/PlotRobinson_1c.png b/tests/testthat/_snaps/PlotRobinson/PlotRobinson_1c.png deleted file mode 100644 index 6becc0fb0f9f168c7150cd899cb7a7e44e24cfe6..0000000000000000000000000000000000000000 Binary files a/tests/testthat/_snaps/PlotRobinson/PlotRobinson_1c.png and /dev/null differ diff --git a/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1a.png b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1a.png new file mode 100644 index 0000000000000000000000000000000000000000..79ed536dd8d9ac0dccf6937323691152e027950d Binary files /dev/null and b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1a.png differ diff --git a/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1b.png b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1b.png new file mode 100644 index 0000000000000000000000000000000000000000..b5834795a9b226a0be16606f42a458dfe41373cb Binary files /dev/null and b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1b.png differ diff --git a/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1c.png b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1c.png new file mode 100644 index 0000000000000000000000000000000000000000..150eaeed4769b4c9a3dd065cd722e3a959bf8b9b Binary files /dev/null and b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1c.png differ diff --git a/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1d.png b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1d.png new file mode 100644 index 0000000000000000000000000000000000000000..2301bc7f1451fabc980ff94703b15dc43389b409 Binary files /dev/null and b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_1d.png differ diff --git a/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_2a.png b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_2a.png new file mode 100644 index 0000000000000000000000000000000000000000..b76b48ab39c6ce885ed2a74a6fc5f383ac9deba6 Binary files /dev/null and b/tests/testthat/_snaps/VizCombinedMap/VizCombinedMap_2a.png differ diff --git a/tests/testthat/_snaps/VizForecastPDF/VizForecastPDF_1a.png b/tests/testthat/_snaps/VizForecastPDF/VizForecastPDF_1a.png new file mode 100644 index 0000000000000000000000000000000000000000..fff2fe041afce53d663c90f2d11d7248edfaa5c7 Binary files /dev/null and b/tests/testthat/_snaps/VizForecastPDF/VizForecastPDF_1a.png differ diff --git a/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1a.png b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1a.png new file mode 100644 index 0000000000000000000000000000000000000000..5198b04ffb64dda99fbe919ee8e6797df4f052ab Binary files /dev/null and b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1a.png differ diff --git a/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1b.png b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1b.png new file mode 100644 index 0000000000000000000000000000000000000000..e07cd2ec4316f1979b3b40018ff6151e851367ea Binary files /dev/null and b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1b.png differ diff --git a/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1c.png b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1c.png new file mode 100644 index 0000000000000000000000000000000000000000..4cbb9c3b3d6cddf68296e9bfa63a46d011a5fb3b Binary files /dev/null and b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1c.png differ diff --git a/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1d.png b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1d.png new file mode 100644 index 0000000000000000000000000000000000000000..6600b54c8c3e1c7934775949605b5409eb5cb498 Binary files /dev/null and b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_1d.png differ diff --git a/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_2a.png b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_2a.png new file mode 100644 index 0000000000000000000000000000000000000000..ad7e98016fbdfcbd1661afb18a1b6a9cda8dd796 Binary files /dev/null and b/tests/testthat/_snaps/VizMostLikelyQuantileMap/VizMostLikelyQuantileMap_2a.png differ diff --git a/tests/testthat/_snaps/VizTriangles4Categories/VizTriangles4Categories_1a.png b/tests/testthat/_snaps/VizTriangles4Categories/VizTriangles4Categories_1a.png new file mode 100644 index 0000000000000000000000000000000000000000..d3254194b1071faedae1d8c93bbf1ec0eee04dc7 Binary files /dev/null and b/tests/testthat/_snaps/VizTriangles4Categories/VizTriangles4Categories_1a.png differ diff --git a/tests/testthat/_snaps/VizWeeklyClim/VizWeeklyClim_1a.png b/tests/testthat/_snaps/VizWeeklyClim/VizWeeklyClim_1a.png new file mode 100644 index 0000000000000000000000000000000000000000..2af87f54d1908e82f75bb2628cfba8a0849675d9 Binary files /dev/null and b/tests/testthat/_snaps/VizWeeklyClim/VizWeeklyClim_1a.png differ diff --git a/tests/testthat/test-VizCombinedMap.R b/tests/testthat/test-VizCombinedMap.R new file mode 100644 index 0000000000000000000000000000000000000000..456571757e014ce7168c0a5f96e49c286fd27278 --- /dev/null +++ b/tests/testthat/test-VizCombinedMap.R @@ -0,0 +1,160 @@ +#=============================================================== +# NOTE: The figures are generated with the following environment: +# - On workstation +#=============================================================== + +# Simple example +x <- array(1:(20 * 10), dim = c(lat = 10, lon = 20)) / 200 +a <- x * 0.6 +b <- (1 - x) * 0.6 +c <- 1 - (a + b) +lons <- seq(0, 359.5, length = 20) +lats <- seq(-89.5, 89.5, length = 10) + +#-------------------------------------------------------------------- + +test_that("1. Input checks", { + # check probs + expect_error( + VizCombinedMap(maps = list(), lon = lons, lat = lats), + "Parameter 'maps' must be of length >= 1 if provided as a list." + ) + expect_error( + VizCombinedMap(maps = list(1:2, a), lon = lons, lat = lats), + paste0("All arrays in parameter 'maps' must have the same dimension ", + "sizes and names when 'maps' is provided as a list of arrays.") + ) + expect_error( + VizCombinedMap(1:10, lon = lons, lat = lats), + paste0("Parameter 'maps' must be either a numeric array with 3 dimensions ", + " or a list of numeric arrays of the same size with the 'lon' and ", + "'lat' dimensions.") + ) + # check cat_dim + expect_error( + VizCombinedMap(array(rnorm(240), dim = c(length(lons), length(lats), 3)), + lon = lons, lat = lats, map_dim = 'bin'), + paste0("Specified a dimension name in 'map_dim' but no dimension names provided ", + "in 'maps'.") + ) + expect_error( + VizCombinedMap(maps = array(rnorm(240), dim = c(lon = length(lons), lat = length(lats), bin = 3)), + lon = lons, lat = lats, cat_dim = 'a'), + "Dimension 'map_dim' not found in 'maps'." + ) + expect_error( + VizCombinedMap(maps = array(rnorm(240), dim = c(lon = length(lons), lat = length(lats), bin = 3)), + lon = lons, lat = lats, map_dim = NULL), + paste0("Parameter 'map_dim' must be either a numeric value or a ", + "dimension name.") + ) + expect_error( + VizCombinedMap(maps = array(rnorm(240), dim = c(lon = length(lons), lat = length(lats), bin = 3)), + lon = lons, lat = lats, map_dim = numeric(0)), + "Parameter 'map_dim' must be of length 1." + ) +}) + +#-------------------------------------------------------- + +# VizMostLikelyQuantileMap output tests + +save_fun <- function(...) { + path <- tempfile(fileext = ".png") + do.call(VizCombinedMap, list(..., fileout = path)) + path +} + +#-------------------------------------------------------- + +# Test triangle_ends +# Synthetic data +x <- array(1:(20 * 10), dim = c(lat = 10, lon = 20)) / 200 +a <- x * 0.85 +b <- (1 - x) * 0.85 +c <- 1 - (a + b) +lons <- seq(200, 359.5, length = 20) +lats <- seq(49.5, 89.5, length = 10) + +Lon <- seq(200, 359.5, length = 51) +Lat <- seq(49.5, 89.5, length = 26) +set.seed(1) +data <- rnorm(51 * 26 * 3) +dim(data) <- c(map = 3, lon = 51, lat = 26) +mask <- sample(c(0,1), replace = TRUE, size = 51 * 26) +dim(mask) <- c(lat = 26, lon = 51) + +bar_limits_each <- list(c(40, 70), c(40, 85), c(30, 70)) +brks_each <- list(5,6,8) + +test_that("2. Test outputs", { + expect_snapshot_file( + save_fun(list(a, b, c), lons, lats, + toptitle = 'full range', + map_select_fun = max, + display_range = c(0, 1), + bar_titles = paste('% of belonging to', c('a', 'b', 'c')), + brks = 5, bar_extra_margin = rep(0,4)), + name = 'VizCombinedMap_1a.png' + ) + expect_snapshot_file( + save_fun(list(a, b, c), lons, lats, + toptitle = 'Combined map', + map_select_fun = max, + display_range = c(0, 1), + bar_titles = paste('% of belonging to', c('a', 'b', 'c')), + brks = brks_each, bar_extra_margin = rep(0,4), + triangle_ends = c(F, T), bar_limits = bar_limits_each, + col_sup = list("black", "yellow", "pink")), + name = 'VizCombinedMap_1b.png' + ) + expect_snapshot_file( + save_fun(data, Lon, Lat, + map_select_fun = max, + display_range = range(data), + mask = mask, + width = 14, height = 10, brks = 5, + triangle_ends = c(F,T), bar_limits = range(data)), + name = 'VizCombinedMap_1c.png' + ) + expect_snapshot_file( + save_fun(data, Lon, Lat, + map_select_fun = max, + display_range = range(data), + mask = mask, + width = 14, height = 10, brks = 5, + triangle_ends = c(F, T), bar_limits = range(data), + col_sup = list("black", "yellow", "pink")), + name = 'VizCombinedMap_1d.png' + ) +}) + +#-------------------------------------------------------- +# Test triangle ends different category + +x <- array(1:(20 * 10), dim = c(lat = 10, lon = 20)) / 200 +a <- x * 0.88 +b <- (1 - x) * 0.88; b[c(1, 25, 26, 33)] <- b[c(1, 25, 26, 33)] - 0.4 +c <- 1 - (a + b); c[c(1, 25, 26, 33)] <- c[c(1, 25, 26, 33)] + 0.4 +lons <- seq(200, 359.5, length = 20) +lats <- seq(49.5, 89.5, length = 10) + +bar_limits_each <- list(c(40, 85), c(40, 85), c(40, 85)) +brks_each <- list(4,2,4) + +test_that("3. Test output 2", { + expect_snapshot_file( + save_fun(list(a, c, b), lons, lats, + toptitle = 'Combined map', + map_select_fun = max, + display_range = c(0, 1), + bar_titles = paste('% of belonging to', c('a', 'b', 'c')), + brks = brks_each, bar_extra_margin = rep(0,4), + triangle_ends = c(F, T), bar_limits = bar_limits_each, + cols = list(c("#6BAED6", "#4F9BCB", "#3787C0"), + c("grey"), + c("#FC4E2A", "#EB2B20", "#D6111F")), + col_sup = list("#08519CFF", "grey", "#800026FF")), + name = 'VizCombinedMap_2a.png' + ) +}) diff --git a/tests/testthat/test-VizForecastPDF.R b/tests/testthat/test-VizForecastPDF.R new file mode 100644 index 0000000000000000000000000000000000000000..5857f5784e0217574f8bb33185fe17c4399fa6fe --- /dev/null +++ b/tests/testthat/test-VizForecastPDF.R @@ -0,0 +1,47 @@ +#=============================================================== +# NOTE: The figures are generated with the following environment: +# - On workstation +#=============================================================== + + +test_that("Sanity checks", { + expect_error( + VizForecastPDF(fcst, tercile.limits), + "object 'fcst' not found") + expect_error( + VizForecastPDF(fcst, tercile.limits = c(0.25, 0.55)), + "object 'fcst' not found") + expect_error( + VizForecastPDF(fcst, tercile.limits = 10), + "object 'fcst' not found") + expect_error( + VizForecastPDF(fcst, tercile.limits = c(10, 20)), + "object 'fcst' not found") + fcsts2 <- array(rnorm(100),dim = c(member = 20, fcst = 5)) + expect_error( + VizForecastPDF(fcst = fcsts2, tercile.limits), + "object 'tercile.limits' not found") + expect_error( + VizForecastPDF(fcst = fcsts2, tercile.limits = c(-0.5, 0.5), extreme.limits = NA), + "Provide two extreme limits") +}) + + +#------------------------------------------------------------------- + +# Simple example +set.seed(1) +fcsts <- data.frame(fcst1 = rnorm(10), fcst2 = rnorm(10, 0.5, 1.2)) + +save_fun <- function(...) { + path <- tempfile(fileext = ".png") + do.call(VizForecastPDF, list(..., plotfile = path)) + path +} + +test_that("2. Output", { + expect_snapshot_file( + save_fun(fcsts, c(-1, 1)), + name = 'VizForecastPDF_1a.png' + ) +}) diff --git a/tests/testthat/test-VizMostLikelyQuantileMap.R b/tests/testthat/test-VizMostLikelyQuantileMap.R new file mode 100644 index 0000000000000000000000000000000000000000..6d84132bd666d855b3b8e97a30bf1f3798d748e2 --- /dev/null +++ b/tests/testthat/test-VizMostLikelyQuantileMap.R @@ -0,0 +1,145 @@ +#=============================================================== +# NOTE: The figures are generated with the following environment: +# - On workstation +#=============================================================== + +# Simple example +x <- array(1:(20 * 10), dim = c(lat = 10, lon = 20)) / 200 +a <- x * 0.6 +b <- (1 - x) * 0.6 +c <- 1 - (a + b) +lons <- seq(0, 359.5, length = 20) +lats <- seq(-89.5, 89.5, length = 10) + +#-------------------------------------------------------------------- + +test_that("1. Input checks", { + # check probs + expect_error( + VizMostLikelyQuantileMap(probs = list(), lon = lons, lat = lats), + "Parameter 'probs' must be of length >= 1 if provided as a list." + ) + expect_error( + VizMostLikelyQuantileMap(probs = list(1:2, a), lon = lons, lat = lats), + paste0("All arrays in parameter 'probs' must have the same dimension ", + "sizes and names when 'probs' is provided as a list of arrays.") + ) + expect_error( + VizMostLikelyQuantileMap(1:10, lon = lons, lat = lats), + paste0("Parameter 'probs' must be either a numeric array with 3 dimensions ", + " or a list of numeric arrays of the same size with the 'lon' and ", + "'lat' dimensions.") + ) + # check cat_dim + expect_error( + VizMostLikelyQuantileMap(array(rnorm(240), dim = c(length(lons), length(lats), 3)), + lon = lons, lat = lats, cat_dim = 'bin'), + paste0("Specified a dimension name in 'cat_dim' but no dimension names provided ", + "in 'probs'.") + ) + expect_error( + VizMostLikelyQuantileMap(probs = array(rnorm(240), dim = c(lon = length(lons), lat = length(lats), bin = 3)), + lon = lons, lat = lats, cat_dim = 'a'), + "Dimension 'cat_dim' not found in 'probs'." + ) + expect_error( + VizMostLikelyQuantileMap(probs = array(rnorm(240), dim = c(lon = length(lons), lat = length(lats), bin = 3)), + lon = lons, lat = lats, cat_dim = NULL), + paste0("Parameter 'cat_dim' must be either a numeric value or a ", + "dimension name.") + ) + expect_error( + VizMostLikelyQuantileMap(probs = array(rnorm(240), dim = c(lon = length(lons), lat = length(lats), bin = 3)), + lon = lons, lat = lats, cat_dim = numeric(0)), + "Parameter 'cat_dim' must be of length 1." + ) +}) + +#-------------------------------------------------------- + +# VizMostLikelyQuantileMap output tests + +save_fun <- function(...) { + path <- tempfile(fileext = ".png") + do.call(VizMostLikelyQuantileMap, list(..., fileout = path)) + path +} + +#-------------------------------------------------------- + +# Test triangle_ends +# Synthetic data +x <- array(1:(20 * 10), dim = c(lat = 10, lon = 20)) / 200 +a <- x * 0.85 +b <- (1 - x) * 0.85 +c <- 1 - (a + b) +lons <- seq(200, 359.5, length = 20) +lats <- seq(49.5, 89.5, length = 10) + +bar_limits_each <- list(c(40, 70), c(40, 85), c(30, 70)) +brks_each <- list(5,6,8) + +test_that("2. Output: test triangle ends", { + expect_snapshot_file( + save_fun(list(a, b, c), lons, lats, + toptitle = 'full range', + bar_titles = paste('% of belonging to', c('a', 'b', 'c')), + brks = 5, bar_extra_margin = rep(0,4)), + name = 'VizMostLikelyQuantileMap_1a.png' + ) + expect_snapshot_file( + save_fun(list(a, b, c), lons, lats, + toptitle = 'upper triangle with upper limit = 70', + bar_titles = paste('% of belonging to', c('a', 'b', 'c')), + brks = 5, bar_extra_margin = rep(0,4), + triangle_ends = c(F,T), bar_limits = c(40, 70)), + name = 'VizMostLikelyQuantileMap_1b.png' + ) + expect_snapshot_file( + save_fun(list(a, b, c), lons, lats, + toptitle = 'upper triangle with upper limit = 70 and specified col_sup', + bar_titles = paste('% of belonging to', c('a', 'b', 'c')), + brks = 5, bar_extra_margin = rep(0,4), + triangle_ends = c(F,T), bar_limits = c(40, 70), + col_sup = list("black", "yellow", "pink")), + name = 'VizMostLikelyQuantileMap_1c.png' + ) + expect_snapshot_file( + save_fun(list(a, b, c), lons, lats, + toptitle = 'Most likely tercile map', + bar_titles = paste('% of belonging to', c('a', 'b', 'c')), + brks = brks_each, bar_extra_margin = rep(0,4), + triangle_ends = c(F, T), bar_limits = bar_limits_each, + col_sup = list("black", "yellow", "pink")), + name = 'VizMostLikelyQuantileMap_1d.png' + ) +}) + +#-------------------------------------------------------- +# Test triangle ends different category + +x <- array(1:(20 * 10), dim = c(lat = 10, lon = 20)) / 200 +a <- x * 0.88 +b <- (1 - x) * 0.88; b[c(1, 25, 26, 33)] <- b[c(1, 25, 26, 33)] - 0.4 +c <- 1 - (a + b); c[c(1, 25, 26, 33)] <- c[c(1, 25, 26, 33)] + 0.4 +lons <- seq(200, 359.5, length = 20) +lats <- seq(49.5, 89.5, length = 10) + +bar_limits_each <- list(c(40, 85), c(40, 85), c(40, 85)) +brks_each <- list(4,2,4) + +test_that("3. Output: triangle ends 2", { + expect_snapshot_file( + save_fun(list(a, c, b), lons, lats, + toptitle = 'Most likely tercile map', + bar_titles = paste('% of belonging to', c('a', 'b', 'c')), + brks = brks_each, bar_extra_margin = rep(0,4), + triangle_ends = c(F, T), bar_limits = bar_limits_each, + cols = list(c("#6BAED6", "#4F9BCB", "#3787C0"), + c("grey"), + c("#FC4E2A", "#EB2B20", "#D6111F")), + col_sup = list("#08519CFF", "grey", "#800026FF")), + name = 'VizMostLikelyQuantileMap_2a.png' + ) +}) + diff --git a/tests/testthat/test-VizPDFsOLE.R b/tests/testthat/test-VizPDFsOLE.R new file mode 100644 index 0000000000000000000000000000000000000000..19e3af2c284e6f3da543e7a3a42d9c3f6702ddf3 --- /dev/null +++ b/tests/testthat/test-VizPDFsOLE.R @@ -0,0 +1,137 @@ +############################################## + +test_that("Sanity checks", { + pdf_1 <- c(1.1,0.6) + attr(pdf_1, "name") <- "NAO1" + dim(pdf_1) <- c(statistic = 2) + pdf_2 <- c(1,0.5) + attr(pdf_2, "name") <- "NAO2" + dim(pdf_2) <- c(statistic = 2) + + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + width = 30, height = 15, + units = "cm", dpi = '300') , + "Parameter 'dpi' must be numeric.") + + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + width = 30, height = 15, + units = 20, dpi = 300) , + "Parameter 'units' must be character") + + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + width = 30, height = 15, + units = "dm", dpi = 300) , + "Parameter 'units' must be equal to 'in', 'cm' or 'mm'.") + + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + width = 30, height = '15', + units = "cm", dpi = 300) , + "Parameter 'height' must be numeric.") + + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + width = list(30), height = 15, + units = "cm", dpi = 300) , + "Parameter 'width' must be numeric.") + + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = 0, + width = 30, height = 15, + units = "cm", dpi = 300) , + paste0("Parameter 'plotfile' must be a character string ", + "indicating the path and name of output png file.")) + + expect_error(VizPDFsOLE(pdf_1, pdf_2, legendPos = 1, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + "Parameter 'legendPos' must be character") + + expect_error(VizPDFsOLE(pdf_1, pdf_2, legendPos = 'arriba', + plotfile = "plot.png", + width = 30, height = 15, + units = "cm", dpi = 300) , + "Parameter 'legendPos' must be equal to 'bottom', 'top', 'right' or 'left'.") + + expect_error(VizPDFsOLE(pdf_1, pdf_2, legendSize = '3', plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + "Parameter 'legendSize' must be numeric.") + + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = '3', plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + "Parameter 'nsigma' must be numeric.") + + pdf_1 <- list(1.1,0.6) + attr(pdf_1, "name") <- "NAO1" + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + "Parameter 'pdf_1' must be an array.") + + pdf_1 <- c('1.1','0.6') + attr(pdf_1, "name") <- "NAO1" + dim(pdf_1) <- c(statistic = 2) + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + "Parameter 'pdf_1' must be a numeric array.") + + pdf_1 <- c(1.1,0.6) + attr(pdf_1, "name") <- "NAO1" + dim(pdf_1) <- c(2) + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + paste0("Parameters 'pdf_1' and 'pdf_2' ", + "should have dimmension names.")) + + pdf_1 <- c(1.1,0.6) + attr(pdf_1, "name") <- "NAO1" + dim(pdf_1) <- c(statisti = 2) + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + "Parameter 'pdf_1' must have dimension 'statistic'.") + + pdf_1 <- c(1.1,0.6) + attr(pdf_1, "name") <- "NAO1" + dim(pdf_1) <- c(statistic = 2, model = 1) + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + "Parameter 'pdf_1' must have only dimension 'statistic'.") + + pdf_1 <- c(1.1, 0.6, 0.2) + attr(pdf_1, "name") <- "NAO1" + dim(pdf_1) <- c(statistic = 3) + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + paste0("Length of dimension 'statistic'", + "of parameter 'pdf_1' and 'pdf_2' must be equal to 2.")) + + pdf_1 <- c(1.1, 0.6) + attr(pdf_1, "name") <- 12 + dim(pdf_1) <- c(statistic = 2) + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + paste0("The 'name' attribute of parameter 'pdf_1' must be a character ", + "indicating the name of the variable of parameter 'pdf_1'.")) + + pdf_1 <- c(1.1,0.6) + attr(pdf_1, "name") <- "NAO1" + dim(pdf_1) <- c(statistic = 2) + pdf_2 <- c(1,0.5) + attr(pdf_2, "name") <- 12 + dim(pdf_2) <- c(statistic = 2) + + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + width = 30, height = 15, + units = "cm", dpi = 300) , + paste0("The 'name' attribute of parameter 'pdf_2' must be a character ", + "indicating the name of the variable of parameter 'pdf_2'.")) + + + + +}) diff --git a/tests/testthat/test-VizTriangles4Categories.R b/tests/testthat/test-VizTriangles4Categories.R new file mode 100644 index 0000000000000000000000000000000000000000..a6bf908e56d0c584e17eb12e2fe50e27b6a88b9e --- /dev/null +++ b/tests/testthat/test-VizTriangles4Categories.R @@ -0,0 +1,100 @@ +#=============================================================== +# NOTE: The figures are generated with the following environment: +# - On workstation +#=============================================================== + +#------------------------------------------------------------------- + +test_that("Sanity checks", { + expect_error( + VizTriangles4Categories(data = 1:20), + paste0("Parameter 'data' must be an array with three dimensions.")) + + data1 <- array(runif(min = -1, max = 1, n = 30), dim=c(5,3,2)) + expect_error( + VizTriangles4Categories(data = data1), + paste0("Parameter 'data' must be an array with named dimensions.")) + + data1 <- runif(min = -1, max = 1, n = 30) + dim(data1) <- c(dim1 = 5, dim2 = 2, dim3 = 3) + expect_error( + VizTriangles4Categories(data = data1), + paste0("Parameter 'data' should contain 'dimx', 'dimy' and 'dimcat' dimension names.")) + + data1 <- runif(min = -1, max = 1, n = 30) + dim(data1) <- c(dimx = 5, dimy =2 , dimcat=3) + expect_error( + VizTriangles4Categories(data = data1), + paste0("Parameter 'data' should contain a dimcat dimension with length equals + to two or four as only two or four categories can be plotted")) + + data1 <- runif(min = -1, max = 1, n = 30) + data1[5:10] <- NA + dim(data1) <- c(dimx = 5, dimy =3 , dimcat=2) + expect_error( + VizTriangles4Categories(data = data1), + paste0("Parameter 'data' cannot contain NAs.")) + + data1 <- runif(min = -1, max = 1, n = 30) + dim(data1) <- c(dimx = 5, dimy =3 , dimcat=2) + expect_error( + VizTriangles4Categories(data = data1,sig_data = 0.5), + paste0("Parameter 'sig_data' array must be logical.")) + + expect_error( + VizTriangles4Categories(data = data1, sig_data = TRUE), + paste0("Parameter 'sig_data' must be an array with three dimensions.")) + + sig1 <- array(TRUE, dim=c(5,2,3)) + expect_error( + VizTriangles4Categories(data = data1, sig_data = sig1), + paste0("Parameter 'sig_data' must be an array with the same dimensions as 'data'")) + + sig1 <- array(TRUE, dim= c(5,3,2)) + dim(sig1) <- c(dimy = 5, dimx =3 , dimcat=2) + expect_error( + VizTriangles4Categories(data = data1, sig_data = sig1), + paste0("Parameter 'sig_data' must be an array with the same named dimensions as 'data'.")) + + data1 <- runif(min = -1, max = 1, n = 30) + dim(data1) <- c(dimx = 5, dimy =3 , dimcat=2) + expect_error( + VizTriangles4Categories(data = data1, lab_legend = c('1','2','3')), + paste0("Parameter 'lab_legend' should contain two or four names.")) + +expect_error( + VizTriangles4Categories(data = data1, brks=c(-1,0,1),cols=c('blue','red','black')), + paste0("The length of the parameter 'brks' must be one more than 'cols'.")) + + + +}) + +#------------------------------------------------------------------- + +# Simple example +# Example with random data +set.seed(1) +arr1 <- array(runif(n = 4 * 5 * 4, min = -1, max = 1), dim = c(4,5,4)) +names(dim(arr1)) <- c('dimx', 'dimy', 'dimcat') +arr2 <- array(TRUE, dim = dim(arr1)) +arr2[which(arr1 < 0.3)] <- FALSE + +save_fun <- function(...) { + path <- tempfile(fileext = ".png") + do.call(VizTriangles4Categories, list(..., fileout = path)) + path +} + +test_that("2. Output", { + expect_snapshot_file( + save_fun(data = arr1, + cols = c('white','#fef0d9','#fdd49e','#fdbb84','#fc8d59'), + brks = c(-1, 0, 0.1, 0.2, 0.3, 0.4), + figure.width = 2, + lab_legend = c('NAO+', 'BL','AR','NAO-'), + xtitle = "Target month", ytitle = "Lead time", + xlabels = c("Jan", "Feb", "Mar", "Apr")), + name = 'VizTriangles4Categories_1a.png' + ) +}) \ No newline at end of file diff --git a/tests/testthat/test-VizWeeklyClim.R b/tests/testthat/test-VizWeeklyClim.R new file mode 100644 index 0000000000000000000000000000000000000000..2edbdb0528396700dc0d5f33b80efc14fb73913b --- /dev/null +++ b/tests/testthat/test-VizWeeklyClim.R @@ -0,0 +1,160 @@ +#=============================================================== +# NOTE: The figures are generated with the following environment: +# - On workstation +#=============================================================== + +# dat1 +dat1 <- array(rnorm(1*7), dim = c(dat = 1, var = 1, sdate = 1, time = 7)) +dat2 <- array(rnorm(21), dim = c(dat = 1, var = 1, sdate = 3, time = 7)) + +#------------------------------------------------------------------- + +test_that("1. Input checks", { + # data + expect_error( + VizWeeklyClim(data = array(1:92), first_date = '2020-03-01', + ref_period = 1993:2021), + "Parameter 'data' must have named dimensions." + ) + expect_error( + VizWeeklyClim(data = data.frame(week = 1:92), first_date = '2020-03-01', + ref_period = 1993:2021), + paste0("If parameter 'data' is a data frame, it must contain the ", + "following column names: 'week', 'clim', 'p10', 'p90', 'p33', ", + "'p66', 'week_mean', 'day' and 'data'.") + ) + expect_error( + VizWeeklyClim(data = 1:92, first_date = '2020-03-01', + ref_period = 1993:2021), + "Parameter 'data' must be an array or a data frame." + ) + # time_dim + expect_error( + VizWeeklyClim(data = dat1, first_date = '2020-03-01', + ref_period = 2020, time_dim = 1), + "Parameter 'time_dim' must be a character string." + ) + expect_error( + VizWeeklyClim(data = array(rnorm(1), dim = c(dat = 1)), + first_date = '2020-03-01', ref_period = 2020), + "Parameter 'time_dim' is not found in 'data' dimension." + ) + expect_error( + VizWeeklyClim(data = array(rnorm(1*7), dim = c(time = 6)), + first_date = '2020-03-01', ref_period = 2020), + paste0("Parameter 'data' must have the dimension 'time_dim' of length ", + "equal or grater than 7 to compute the weekly means.") + ) + # sdate_dim + expect_error( + VizWeeklyClim(data = dat1, first_date = '2020-03-01', + ref_period = 2020, sdate_dim = 1), + "Parameter 'sdate_dim' must be a character string." + ) + expect_warning( + VizWeeklyClim(data = array(rnorm(7), dim = c(time = 7)), + first_date = '2020-03-01', ref_period = 2020), + paste0("Parameter 'sdate_dim' is not found in 'data' dimension. ", + "A dimension of length 1 has been added.") + ) + # legend + expect_error( + VizWeeklyClim(data = dat1, first_date = '2020-03-01', + ref_period = 2020, legend = 1), + "Parameter 'legend' must be a logical value." + ) + # ref_period (1) + expect_error( + VizWeeklyClim(data = dat1, first_date = '2020-03-01', ref_period = "2020"), + "Parameter 'ref_period' must be numeric." + ) + # first_date + expect_error( + VizWeeklyClim(data = dat1, first_date = 2020-03-01, ref_period = 2020), + paste0("Parameter 'first_date' must be a character string ", + "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", + "or 'Dates' class.") + ) + # data_years + expect_error( + VizWeeklyClim(data = dat2, first_date = '2020-03-01', ref_period = 2020, + data_years = '2020'), + "Parameter 'data_years' must be numeric." + ) + expect_error( + VizWeeklyClim(data = dat2, first_date = '2020-03-01', ref_period = 2020, + data_years = 2005:2020), + paste0("Parameter 'data_years' must have the same length as the ", + "dimension 'sdate' of 'data'.") + ) + expect_error( + VizWeeklyClim(data = dat2, first_date = '2010-03-01', + ref_period = 2020:2021, data_years = 2018:2020), + paste0("The 'ref_period' must be included in the 'data_years' ", + "period.") + ) + expect_error( + VizWeeklyClim(data = dat2, first_date = '2021-03-01', + ref_period = 2018:2019, data_years = 2018:2020), + paste0("Parameter 'first_date' must be a date included ", + "in the 'data_years' period.") + ) + # ref_period (2) + expect_error( + VizWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2021), + paste0("Parameter 'ref_period' must have the same length as the ", + "dimension 'sdate' of 'data' if 'data_years' is not provided.") + ) + expect_error( + VizWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2017:2019), + paste0("If parameter 'data_years' is NULL, parameter 'first_date' ", + "must be a date included in the 'ref_period' period.") + ) + # last_date + expect_error( + VizWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, last_date = 2020-03-01), + paste0("Parameter 'last_date' must be a character string ", + "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", + "or 'Dates' class.") + ) + expect_warning( + VizWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, last_date = '2020-03-08'), + paste0("Parameter 'last_date' is greater than the last date ", + "of 'data'. The last date of 'data' will be used.") + ) + # ylim + expect_warning( + VizWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, ylim = 'i'), + paste0("Parameter 'ylim' can't be a character string, it will ", + "not be used.") + ) +}) + +#------------------------------------------------------------------- + +# Simple example +set.seed(1) +data <- array(rnorm(49*20*3, 274), dim = c(time = 49, sdate = 20, member = 3)) + +save_fun <- function(...) { + path <- tempfile(fileext = ".png") + do.call(VizWeeklyClim, list(..., fileout = path)) + path +} + +test_that("2. Output", { + expect_snapshot_file( + save_fun(data = data, first_date = '2002-08-09', + last_date = '2002-09-15', ref_period = 2010:2019, + data_years = 2000:2019, time_dim = 'time', sdate_dim = 'sdate', + title = "Observed weekly means and climatology", + subtitle = "Target years: 2010 to 2019", + ytitle = paste0('tas', " (", "deg.C", ")")), + name = 'VizWeeklyClim_1a.png' + ) +}) \ No newline at end of file