Enhanced SmartCane executive summary report with explanatory text and fixed priority map coloring

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

r_app/CI_report_dashboard_planet.Rmd

@@ -437,7 +437,7 @@ tryCatch({
     dplyr::ungroup()
   
   # Check if tonnage_ha is empty
-  if (all(is.na(CI_quadrant$tonnage_ha))) {
+  if (all(is.na(harvesting_data$tonnage_ha))) {
     safe_log("Lacking historic harvest data, please provide for yield prediction calculation", "WARNING")
     knitr::knit_exit()  # Exit the chunk if tonnage_ha is empty
   }

r_app/ci_extraction.R

@@ -61,8 +61,19 @@ main <- function() {
   # 3. Initialize project configuration
   # --------------------------------
   new_project_question <- FALSE
-  source("r_app/parameters_project.R")
+  
-  source("r_app/ci_extraction_utils.R")
+  tryCatch({
+    source("parameters_project.R")
+    source("ci_extraction_utils.R")
+  }, error = function(e) {
+    warning("Default source files not found. Attempting to source from 'r_app' directory.")
+    tryCatch({
+      source("r_app/parameters_project.R")
+      source("r_app/ci_extraction_utils.R")
+    }, error = function(e) {
+      stop("Failed to source required files from both default and 'r_app' directories.")
+    })
+  })
   
   # 4. Generate date list for processing
   # ---------------------------------

r_app/interpolate_growth_model.R

@@ -33,8 +33,18 @@ main <- function() {
   }
   
   # Initialize project configuration and load utility functions
-  source("r_app/parameters_project.R")
+  tryCatch({
-  source("r_app/growth_model_utils.R")
+    source("parameters_project.R")
+    source("ci_extraction_utils.R")
+  }, error = function(e) {
+    warning("Default source files not found. Attempting to source from 'r_app' directory.")
+    tryCatch({
+      source("r_app/parameters_project.R")
+      source("r_app/ci_extraction_utils.R")
+    }, error = function(e) {
+      stop("Failed to source required files from both default and 'r_app' directories.")
+    })
+  })
   
   log_message("Starting CI growth model interpolation")
   

r_app/mosaic_creation.R

@@ -67,8 +67,18 @@ main <- function() {
   
   # 3. Initialize project configuration
   # --------------------------------
-  source("r_app/parameters_project.R")
+  tryCatch({
-  source("r_app/mosaic_creation_utils.R")
+    source("parameters_project.R")
+    source("ci_extraction_utils.R")
+  }, error = function(e) {
+    warning("Default source files not found. Attempting to source from 'r_app' directory.")
+    tryCatch({
+      source("r_app/parameters_project.R")
+      source("r_app/ci_extraction_utils.R")
+    }, error = function(e) {
+      stop("Failed to source required files from both default and 'r_app' directories.")
+    })
+  })
   
   # 4. Generate date range for processing
   # ---------------------------------

r_app/packages.R

@@ -56,7 +56,7 @@ load_smartcane_packages <- function(verbose = FALSE) {
     "sf",          # Simple Features for spatial vector data
     "terra",       # Raster data processing
     "exactextractr", # Fast extraction from rasters
-    "raster",      # Legacy raster package (for compatibility)
+    "tmap",        # Thematic mapping for spatial visualization
     
     # Data manipulation
     "tidyverse",   # Collection of data manipulation packages
@@ -64,12 +64,19 @@ load_smartcane_packages <- function(verbose = FALSE) {
     "readxl",      # Excel file reading
     "stringr",     # String manipulation
     "purrr",       # Functional programming tools
+    "zoo",         # Time series processing with rolling functions
     
     # Visualization
     "ggplot2",     # Advanced plotting
     "leaflet",     # Interactive maps
     "plotly",      # Interactive plots
     
+    # Machine learning and statistics
+    "caret",       # Classification and regression training
+    "rsample",     # Data sampling for modeling
+    "randomForest", # Random forest implementation
+    "CAST",        # Feature selection for spatial data
+    
     # Project management
     "here",        # Path handling
     

r_app/tests/test_report_utils.R

@@ -0,0 +1,280 @@
+# 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")