Added explanatory text for all visualizations Fixed priority map color scheme (red=high priority, green=low priority) Improved error handling in farm health data calculations Added fallback mechanisms for missing data
280 lines
7.5 KiB
R
280 lines
7.5 KiB
R
# test_report_utils.R
|
|
#
|
|
# Tests for visualization functions in report_utils.R
|
|
#
|
|
|
|
# Load the test framework
|
|
source("tests/test_framework.R")
|
|
|
|
# Set up test environment
|
|
env <- setup_test_env()
|
|
|
|
# Required libraries for testing
|
|
library(testthat)
|
|
library(terra)
|
|
library(sf)
|
|
library(dplyr)
|
|
library(ggplot2)
|
|
|
|
# Load the functions to test
|
|
source("../report_utils.R")
|
|
|
|
# Create mock data for testing
|
|
create_mock_data <- function() {
|
|
# Create a simple raster for testing
|
|
r <- terra::rast(nrows=10, ncols=10, xmin=0, xmax=10, ymin=0, ymax=10, vals=1:100)
|
|
names(r) <- "CI"
|
|
|
|
# Create a simple field boundary
|
|
field_boundaries <- sf::st_sf(
|
|
field = c("Field1", "Field2"),
|
|
sub_field = c("A", "B"),
|
|
geometry = sf::st_sfc(
|
|
sf::st_polygon(list(rbind(c(1,1), c(5,1), c(5,5), c(1,5), c(1,1)))),
|
|
sf::st_polygon(list(rbind(c(6,6), c(9,6), c(9,9), c(6,9), c(6,6))))
|
|
),
|
|
crs = sf::st_crs(r)
|
|
)
|
|
|
|
# Create mock harvest data
|
|
harvesting_data <- data.frame(
|
|
field = c("Field1", "Field2"),
|
|
sub_field = c("A", "B"),
|
|
age = c(100, 150),
|
|
season_start = as.Date(c("2023-01-01", "2023-02-01")),
|
|
year = c(2023, 2023)
|
|
)
|
|
|
|
# Create mock CI quadrant data
|
|
ci_quadrant <- data.frame(
|
|
field = rep(c("Field1", "Field2"), each=10),
|
|
sub_field = rep(c("A", "B"), each=10),
|
|
Date = rep(seq(as.Date("2023-01-01"), by="week", length.out=10), 2),
|
|
DOY = rep(1:10, 2),
|
|
cumulative_CI = rep(cumsum(1:10), 2),
|
|
value = rep(1:10, 2),
|
|
season = rep(2023, 20),
|
|
model = rep(c("northwest", "northeast", "southwest", "southeast"), 5)
|
|
)
|
|
|
|
return(list(
|
|
raster = r,
|
|
field_boundaries = field_boundaries,
|
|
harvesting_data = harvesting_data,
|
|
ci_quadrant = ci_quadrant
|
|
))
|
|
}
|
|
|
|
# Test the create_CI_map function
|
|
test_that("create_CI_map creates a valid tmap object", {
|
|
mock_data <- create_mock_data()
|
|
|
|
# Test with all required parameters
|
|
map <- create_CI_map(
|
|
pivot_raster = mock_data$raster,
|
|
pivot_shape = mock_data$field_boundaries[1,],
|
|
pivot_spans = mock_data$field_boundaries[1,],
|
|
week = "01",
|
|
age = 10,
|
|
borders = TRUE,
|
|
use_breaks = TRUE
|
|
)
|
|
|
|
# Check if it returned a tmap object
|
|
expect_true("tmap" %in% class(map))
|
|
|
|
# Test with missing parameters
|
|
expect_error(create_CI_map(pivot_shape = mock_data$field_boundaries[1,],
|
|
pivot_spans = mock_data$field_boundaries[1,],
|
|
week = "01", age = 10),
|
|
"pivot_raster is required")
|
|
|
|
expect_error(create_CI_map(pivot_raster = mock_data$raster,
|
|
pivot_spans = mock_data$field_boundaries[1,],
|
|
week = "01", age = 10),
|
|
"pivot_shape is required")
|
|
})
|
|
|
|
# Test the create_CI_diff_map function
|
|
test_that("create_CI_diff_map creates a valid tmap object", {
|
|
mock_data <- create_mock_data()
|
|
|
|
# Test with all required parameters
|
|
map <- create_CI_diff_map(
|
|
pivot_raster = mock_data$raster,
|
|
pivot_shape = mock_data$field_boundaries[1,],
|
|
pivot_spans = mock_data$field_boundaries[1,],
|
|
week_1 = "01",
|
|
week_2 = "02",
|
|
age = 10,
|
|
borders = TRUE,
|
|
use_breaks = TRUE
|
|
)
|
|
|
|
# Check if it returned a tmap object
|
|
expect_true("tmap" %in% class(map))
|
|
|
|
# Test with missing parameters
|
|
expect_error(create_CI_diff_map(pivot_shape = mock_data$field_boundaries[1,],
|
|
pivot_spans = mock_data$field_boundaries[1,],
|
|
week_1 = "01", week_2 = "02", age = 10),
|
|
"pivot_raster is required")
|
|
|
|
expect_error(create_CI_diff_map(pivot_raster = mock_data$raster,
|
|
pivot_spans = mock_data$field_boundaries[1,],
|
|
week_1 = "01", age = 10),
|
|
"week_1 and week_2 parameters are required")
|
|
})
|
|
|
|
# Test the ci_plot function
|
|
test_that("ci_plot handles input parameters correctly", {
|
|
mock_data <- create_mock_data()
|
|
|
|
# Capture output to avoid cluttering the test output
|
|
temp_file <- tempfile()
|
|
sink(temp_file)
|
|
|
|
# Test with all required parameters - should not throw an error
|
|
expect_error(
|
|
ci_plot(
|
|
pivotName = "Field1",
|
|
field_boundaries = mock_data$field_boundaries,
|
|
current_ci = mock_data$raster,
|
|
ci_minus_1 = mock_data$raster,
|
|
ci_minus_2 = mock_data$raster,
|
|
last_week_diff = mock_data$raster,
|
|
three_week_diff = mock_data$raster,
|
|
harvesting_data = mock_data$harvesting_data,
|
|
week = "01",
|
|
week_minus_1 = "52",
|
|
week_minus_2 = "51",
|
|
week_minus_3 = "50",
|
|
use_breaks = TRUE,
|
|
borders = TRUE
|
|
),
|
|
NA # Expect no error
|
|
)
|
|
|
|
# Test with missing parameters
|
|
expect_error(
|
|
ci_plot(),
|
|
"pivotName is required"
|
|
)
|
|
|
|
# Test with invalid field name
|
|
expect_error(
|
|
ci_plot(
|
|
pivotName = "NonExistentField",
|
|
field_boundaries = mock_data$field_boundaries,
|
|
current_ci = mock_data$raster,
|
|
ci_minus_1 = mock_data$raster,
|
|
ci_minus_2 = mock_data$raster,
|
|
last_week_diff = mock_data$raster,
|
|
three_week_diff = mock_data$raster,
|
|
harvesting_data = mock_data$harvesting_data
|
|
),
|
|
regexp = NULL # We expect some error related to the field not being found
|
|
)
|
|
|
|
# Reset output
|
|
sink()
|
|
unlink(temp_file)
|
|
})
|
|
|
|
# Test the cum_ci_plot function
|
|
test_that("cum_ci_plot handles input parameters correctly", {
|
|
mock_data <- create_mock_data()
|
|
|
|
# Capture output to avoid cluttering the test output
|
|
temp_file <- tempfile()
|
|
sink(temp_file)
|
|
|
|
# Test with all required parameters - should not throw an error
|
|
expect_error(
|
|
cum_ci_plot(
|
|
pivotName = "Field1",
|
|
ci_quadrant_data = mock_data$ci_quadrant,
|
|
plot_type = "value",
|
|
facet_on = FALSE,
|
|
x_unit = "days"
|
|
),
|
|
NA # Expect no error
|
|
)
|
|
|
|
# Test with different plot types
|
|
expect_error(
|
|
cum_ci_plot(
|
|
pivotName = "Field1",
|
|
ci_quadrant_data = mock_data$ci_quadrant,
|
|
plot_type = "CI_rate"
|
|
),
|
|
NA # Expect no error
|
|
)
|
|
|
|
expect_error(
|
|
cum_ci_plot(
|
|
pivotName = "Field1",
|
|
ci_quadrant_data = mock_data$ci_quadrant,
|
|
plot_type = "cumulative_CI"
|
|
),
|
|
NA # Expect no error
|
|
)
|
|
|
|
# Test with invalid plot type
|
|
expect_error(
|
|
cum_ci_plot(
|
|
pivotName = "Field1",
|
|
ci_quadrant_data = mock_data$ci_quadrant,
|
|
plot_type = "invalid_type"
|
|
),
|
|
"plot_type must be one of: 'value', 'CI_rate', or 'cumulative_CI'"
|
|
)
|
|
|
|
# Test with missing parameters
|
|
expect_error(
|
|
cum_ci_plot(),
|
|
"pivotName is required"
|
|
)
|
|
|
|
# Reset output
|
|
sink()
|
|
unlink(temp_file)
|
|
})
|
|
|
|
# Test the get_week_path function
|
|
test_that("get_week_path returns correct path", {
|
|
# Test with valid inputs
|
|
path <- get_week_path(
|
|
mosaic_path = "ci_max_mosaics",
|
|
input_date = "2023-01-15",
|
|
week_offset = 0
|
|
)
|
|
|
|
# Extract the week number and year from the path
|
|
expect_match(path, "week_02_2023\\.tif$", all = FALSE) # Week 2 of 2023
|
|
|
|
# Test with offset
|
|
path_minus_1 <- get_week_path(
|
|
mosaic_path = "ci_max_mosaics",
|
|
input_date = "2023-01-15",
|
|
week_offset = -1
|
|
)
|
|
expect_match(path_minus_1, "week_01_2023\\.tif$", all = FALSE)
|
|
|
|
# Test with missing parameters
|
|
expect_error(
|
|
get_week_path(input_date = "2023-01-15", week_offset = 0),
|
|
"mosaic_path is required"
|
|
)
|
|
|
|
expect_error(
|
|
get_week_path(mosaic_path = "ci_max_mosaics", week_offset = 0),
|
|
"input_date is required"
|
|
)
|
|
})
|
|
|
|
# Clean up
|
|
teardown_test_env()
|
|
|
|
# Print success message
|
|
cat("Report utility function tests completed successfully\n") |