Timon/SmartCane
1
1
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity
SmartCane/r_app/CI_report_executive_summary.Rmd
Timon bb2a599075 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
2025-04-23 09:47:19 +02:00

1464 lines
53 KiB
Plaintext
Raw Blame History

---
params:
ref: "word-styles-reference-var1.docx"
output_file: CI_report.docx
report_date: "2024-08-28"
data_dir: "Chemba"
mail_day: "Wednesday"
borders: TRUE
use_breaks: FALSE
output:
# html_document:
# toc: yes
# df_print: paged
word_document:
reference_docx: !expr file.path("word-styles-reference-var1.docx")
toc: yes
editor_options:
chunk_output_type: console
---
```{r setup_parameters, include=FALSE}
# Set up basic report parameters from input values
report_date <- params$report_date
mail_day <- params$mail_day
borders <- params$borders
use_breaks <- params$use_breaks # Whether to use breaks or continuous spectrum in visualizations
# Environment setup notes (commented out)
# # Activeer de renv omgeving
# renv::activate()
# renv::deactivate()
# # Optioneel: Herstel de omgeving als dat nodig is
# # Je kunt dit commentaar geven als je het normaal niet wilt uitvoeren
# renv::restore()
```
```{r load_libraries, message=FALSE, warning=FALSE, include=FALSE}
# Configure knitr options
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
# Path management
library(here)
# Spatial data libraries
library(sf)
library(terra)
library(exactextractr)
# library(raster) - Removed as it's no longer maintained
# Data manipulation and visualization
library(tidyverse) # Includes dplyr, ggplot2, etc.
library(tmap)
library(lubridate)
library(zoo)
# Machine learning
library(rsample)
library(caret)
library(randomForest)
library(CAST)
# Load custom utility functions
tryCatch({
source("report_utils.R")
}, error = function(e) {
message(paste("Error loading report_utils.R:", e$message))
# Try alternative path if the first one fails
tryCatch({
source(here::here("r_app", "report_utils.R"))
}, error = function(e) {
stop("Could not load report_utils.R from either location: ", e$message)
})
})
```
```{r initialize_project_config, message=FALSE, warning=FALSE, include=FALSE}
# Set the project directory from parameters
project_dir <- params$data_dir
# Source project parameters with error handling
tryCatch({
source(here::here("r_app", "parameters_project.R"))
}, error = function(e) {
stop("Error loading parameters_project.R: ", e$message)
})
# Log initial configuration
safe_log("Starting the R Markdown script")
safe_log(paste("mail_day params:", params$mail_day))
safe_log(paste("report_date params:", params$report_date))
safe_log(paste("mail_day variable:", mail_day))
```
```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE}
# Set locale for consistent date formatting
Sys.setlocale("LC_TIME", "C")
# Initialize date variables from parameters
today <- as.character(report_date)
mail_day_as_character <- as.character(mail_day)
# Calculate week days
report_date_as_week_day <- weekdays(lubridate::ymd(today))
days_of_week <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
# Calculate initial week number
week <- lubridate::week(today)
safe_log(paste("Initial week calculation:", week, "today:", today))
# Calculate previous dates for comparisons
today_minus_1 <- as.character(lubridate::ymd(today) - 7)
today_minus_2 <- as.character(lubridate::ymd(today) - 14)
today_minus_3 <- as.character(lubridate::ymd(today) - 21)
# Log the weekday calculations for debugging
safe_log(paste("Report date weekday:", report_date_as_week_day))
safe_log(paste("Weekday index:", which(days_of_week == report_date_as_week_day)))
safe_log(paste("Mail day:", mail_day_as_character))
safe_log(paste("Mail day index:", which(days_of_week == mail_day_as_character)))
# Adjust week calculation based on mail day
if (which(days_of_week == report_date_as_week_day) > which(days_of_week == mail_day_as_character)) {
safe_log("Adjusting weeks because of mail day")
week <- lubridate::week(today) + 1
today_minus_1 <- as.character(lubridate::ymd(today))
today_minus_2 <- as.character(lubridate::ymd(today) - 7)
today_minus_3 <- as.character(lubridate::ymd(today) - 14)
}
# Generate subtitle for report
subtitle_var <- paste("Report generated on", Sys.Date())
# Calculate week numbers for previous weeks
week_minus_1 <- week - 1
week_minus_2 <- week - 2
week_minus_3 <- week - 3
# Format current week with leading zeros
week <- sprintf("%02d", week)
# Get years for each date
year <- lubridate::year(today)
year_1 <- lubridate::year(today_minus_1)
year_2 <- lubridate::year(today_minus_2)
year_3 <- lubridate::year(today_minus_3)
```
```{r data, message=TRUE, warning=TRUE, include=FALSE}
# Load CI index data with error handling
tryCatch({
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
safe_log("Successfully loaded CI quadrant data")
}, error = function(e) {
stop("Error loading CI quadrant data: ", e$message)
})
# Get file paths for different weeks using the utility function
tryCatch({
path_to_week_current = get_week_path(weekly_CI_mosaic, today, 0)
path_to_week_minus_1 = get_week_path(weekly_CI_mosaic, today, -1)
path_to_week_minus_2 = get_week_path(weekly_CI_mosaic, today, -2)
path_to_week_minus_3 = get_week_path(weekly_CI_mosaic, today, -3)
# Log the calculated paths
safe_log("Required mosaic paths:")
safe_log(paste("Path to current week:", path_to_week_current))
safe_log(paste("Path to week minus 1:", path_to_week_minus_1))
safe_log(paste("Path to week minus 2:", path_to_week_minus_2))
safe_log(paste("Path to week minus 3:", path_to_week_minus_3))
# Validate that files exist
if (!file.exists(path_to_week_current)) warning("Current week mosaic file does not exist: ", path_to_week_current)
if (!file.exists(path_to_week_minus_1)) warning("Week minus 1 mosaic file does not exist: ", path_to_week_minus_1)
if (!file.exists(path_to_week_minus_2)) warning("Week minus 2 mosaic file does not exist: ", path_to_week_minus_2)
if (!file.exists(path_to_week_minus_3)) warning("Week minus 3 mosaic file does not exist: ", path_to_week_minus_3)
# Load raster data with terra functions
CI <- terra::rast(path_to_week_current)$CI
CI_m1 <- terra::rast(path_to_week_minus_1)$CI
CI_m2 <- terra::rast(path_to_week_minus_2)$CI
CI_m3 <- terra::rast(path_to_week_minus_3)$CI
}, error = function(e) {
stop("Error loading raster data: ", e$message)
})
```
```{r calculate_difference_rasters, message=TRUE, warning=TRUE, include=FALSE}
# Calculate difference rasters for comparisons
tryCatch({
# Calculate weekly difference
last_week_dif_raster_abs <- (CI - CI_m1)
safe_log("Calculated weekly difference raster")
# Calculate three-week difference
three_week_dif_raster_abs <- (CI - CI_m3)
safe_log("Calculated three-week difference raster")
}, error = function(e) {
safe_log(paste("Error calculating difference rasters:", e$message), "ERROR")
# Create placeholder rasters if calculations fail
if (!exists("last_week_dif_raster_abs")) {
last_week_dif_raster_abs <- CI * 0
}
if (!exists("three_week_dif_raster_abs")) {
three_week_dif_raster_abs <- CI * 0
}
})
```
```{r load_field_boundaries, message=TRUE, warning=TRUE, include=FALSE}
# Load field boundaries from parameters
tryCatch({
AllPivots0 <- field_boundaries_sf
safe_log("Successfully loaded field boundaries")
}, error = function(e) {
stop("Error loading field boundaries: ", e$message)
})
```
```{r create_farm_health_data, message=FALSE, warning=FALSE, include=FALSE}
# Create farm health summary data from scratch
tryCatch({
# Ensure we have the required data
if (!exists("AllPivots0") || !exists("CI") || !exists("CI_m1") || !exists("harvesting_data")) {
stop("Required input data (field boundaries, CI data, or harvesting data) not available")
}
safe_log("Starting to calculate farm health data")
# Get unique field names
fields <- unique(AllPivots0$field)
safe_log(paste("Found", length(fields), "unique fields"))
# Initialize result dataframe
farm_health_data <- data.frame(
field = character(),
mean_ci = numeric(),
ci_change = numeric(),
ci_uniformity = numeric(),
status = character(),
anomaly_type = character(),
priority_level = numeric(),
age_weeks = numeric(),
harvest_readiness = character(),
stringsAsFactors = FALSE
)
# Process each field with robust error handling
for (field_name in fields) {
tryCatch({
safe_log(paste("Processing field:", field_name))
# Get field boundary
field_shape <- AllPivots0 %>% dplyr::filter(field == field_name)
# Skip if field shape is empty
if (nrow(field_shape) == 0) {
safe_log(paste("Empty field shape for", field_name), "WARNING")
next
}
# Get field age from harvesting data - use direct filtering to avoid dplyr errors
field_age_data <- NULL
if (exists("harvesting_data") && !is.null(harvesting_data) && nrow(harvesting_data) > 0) {
field_age_data <- harvesting_data[harvesting_data$field == field_name, ]
if (nrow(field_age_data) > 0) {
field_age_data <- field_age_data[order(field_age_data$season_start, decreasing = TRUE), ][1, ]
}
}
# Default age if not available
field_age_weeks <- if (!is.null(field_age_data) && nrow(field_age_data) > 0 && !is.na(field_age_data$age)) {
field_age_data$age
} else {
10 # Default age
}
# Extract CI values using terra's extract function which is more robust
ci_values <- terra::extract(CI, field_shape)
ci_prev_values <- terra::extract(CI_m1, field_shape)
# Check if we got valid data
if (nrow(ci_values) == 0 || nrow(ci_prev_values) == 0) {
safe_log(paste("No CI data extracted for field", field_name), "WARNING")
# Add a placeholder row with Unknown status
farm_health_data <- rbind(farm_health_data, data.frame(
field = field_name,
mean_ci = NA,
ci_change = NA,
ci_uniformity = NA,
status = "Unknown",
anomaly_type = "Unknown",
priority_level = 5, # Low priority
age_weeks = field_age_weeks,
harvest_readiness = "Unknown",
stringsAsFactors = FALSE
))
next
}
# Calculate metrics - Handle NA values properly
ci_column <- if ("CI" %in% names(ci_values)) "CI" else colnames(ci_values)[1]
ci_prev_column <- if ("CI" %in% names(ci_prev_values)) "CI" else colnames(ci_prev_values)[1]
mean_ci <- mean(ci_values[[ci_column]], na.rm=TRUE)
mean_ci_prev <- mean(ci_prev_values[[ci_prev_column]], na.rm=TRUE)
ci_change <- mean_ci - mean_ci_prev
ci_sd <- sd(ci_values[[ci_column]], na.rm=TRUE)
ci_uniformity <- ci_sd / max(0.1, mean_ci) # Avoid division by zero
# Handle NaN or Inf results
if (is.na(mean_ci) || is.na(ci_change) || is.na(ci_uniformity) ||
is.nan(mean_ci) || is.nan(ci_change) || is.nan(ci_uniformity) ||
is.infinite(mean_ci) || is.infinite(ci_change) || is.infinite(ci_uniformity)) {
safe_log(paste("Invalid calculation results for field", field_name), "WARNING")
# Add a placeholder row with Unknown status
farm_health_data <- rbind(farm_health_data, data.frame(
field = field_name,
mean_ci = NA,
ci_change = NA,
ci_uniformity = NA,
status = "Unknown",
anomaly_type = "Unknown",
priority_level = 5, # Low priority
age_weeks = field_age_weeks,
harvest_readiness = "Unknown",
stringsAsFactors = FALSE
))
next
}
# Determine field status
status <- dplyr::case_when(
mean_ci >= 5 ~ "Excellent",
mean_ci >= 3.5 ~ "Good",
mean_ci >= 2 ~ "Fair",
mean_ci >= 1 ~ "Poor",
TRUE ~ "Critical"
)
# Determine anomaly type
anomaly_type <- dplyr::case_when(
ci_change > 2 ~ "Potential Weed Growth",
ci_change < -2 ~ "Potential Weeding/Harvesting",
ci_uniformity > 0.5 ~ "High Variability",
mean_ci < 1 ~ "Low Vigor",
TRUE ~ "None"
)
# Calculate priority level (1-5, with 1 being highest priority)
priority_score <- dplyr::case_when(
mean_ci < 1 ~ 1, # Critical - highest priority
anomaly_type == "Potential Weed Growth" ~ 2,
anomaly_type == "High Variability" ~ 3,
ci_change < -1 ~ 4,
TRUE ~ 5 # No urgent issues
)
# Determine harvest readiness
harvest_readiness <- dplyr::case_when(
field_age_weeks >= 52 & mean_ci >= 4 ~ "Ready for harvest",
field_age_weeks >= 48 & mean_ci >= 3.5 ~ "Approaching harvest",
field_age_weeks >= 40 & mean_ci >= 3 ~ "Mid-maturity",
field_age_weeks >= 12 ~ "Growing",
TRUE ~ "Early stage"
)
# Add to summary data
farm_health_data <- rbind(farm_health_data, data.frame(
field = field_name,
mean_ci = round(mean_ci, 2),
ci_change = round(ci_change, 2),
ci_uniformity = round(ci_uniformity, 2),
status = status,
anomaly_type = anomaly_type,
priority_level = priority_score,
age_weeks = field_age_weeks,
harvest_readiness = harvest_readiness,
stringsAsFactors = FALSE
))
}, error = function(e) {
safe_log(paste("Error processing field", field_name, ":", e$message), "ERROR")
# Add a placeholder row with Error status
farm_health_data <<- rbind(farm_health_data, data.frame(
field = field_name,
mean_ci = NA,
ci_change = NA,
ci_uniformity = NA,
status = "Unknown",
anomaly_type = "Unknown",
priority_level = 5, # Low priority since we don't know the status
age_weeks = NA,
harvest_readiness = "Unknown",
stringsAsFactors = FALSE
))
})
}
# Make sure we have data for all fields
if (nrow(farm_health_data) == 0) {
safe_log("No farm health data was created", "ERROR")
stop("Failed to create farm health data")
}
# Sort by priority level
farm_health_data <- farm_health_data %>% dplyr::arrange(priority_level, field)
safe_log(paste("Successfully created farm health data for", nrow(farm_health_data), "fields"))
}, error = function(e) {
safe_log(paste("Error creating farm health data:", e$message), "ERROR")
# Create an empty dataframe that can be filled by the verification chunk
})
```
```{r verify_farm_health_data, message=FALSE, warning=FALSE, include=FALSE}
# Verify farm_health_data exists and has content
if (!exists("farm_health_data") || nrow(farm_health_data) == 0) {
safe_log("farm_health_data not found or empty, generating default data", "WARNING")
# Create minimal fallback data
tryCatch({
# Get fields from boundaries
fields <- unique(AllPivots0$field)
# Create basic data frame with just field names
farm_health_data <- data.frame(
field = fields,
mean_ci = rep(NA, length(fields)),
ci_change = rep(NA, length(fields)),
ci_uniformity = rep(NA, length(fields)),
status = rep("Unknown", length(fields)),
anomaly_type = rep("Unknown", length(fields)),
priority_level = rep(5, length(fields)), # Low priority
age_weeks = rep(NA, length(fields)),
harvest_readiness = rep("Unknown", length(fields)),
stringsAsFactors = FALSE
)
safe_log("Created fallback farm_health_data with basic field information")
}, error = function(e) {
safe_log(paste("Error creating fallback farm_health_data:", e$message), "ERROR")
farm_health_data <<- data.frame(
field = character(),
mean_ci = numeric(),
ci_change = numeric(),
ci_uniformity = numeric(),
status = character(),
anomaly_type = character(),
priority_level = numeric(),
age_weeks = numeric(),
harvest_readiness = character(),
stringsAsFactors = FALSE
)
})
}
```
```{r calculate_farm_health, message=FALSE, warning=FALSE, include=FALSE}
# Calculate farm health summary metrics
tryCatch({
# Generate farm health summary data
farm_health_data <- generate_farm_health_summary(
field_boundaries = AllPivots0,
ci_current = CI,
ci_previous = CI_m1,
harvesting_data = harvesting_data
)
# Log the summary data
safe_log(paste("Generated farm health summary with", nrow(farm_health_data), "fields"))
}, error = function(e) {
safe_log(paste("Error in farm health calculation:", e$message), "ERROR")
# Create empty dataframe if calculation failed
farm_health_data <- data.frame(
field = character(),
mean_ci = numeric(),
ci_change = numeric(),
ci_uniformity = numeric(),
status = character(),
anomaly_type = character(),
priority_level = numeric(),
age_weeks = numeric(),
harvest_readiness = character(),
stringsAsFactors = FALSE
)
})
```
```{r executive_summary_functions, message=FALSE, warning=FALSE, include=FALSE}
# EXECUTIVE SUMMARY HELPER FUNCTIONS
#' Generate a summary of farm health status
#'
#' @param field_boundaries Field boundaries spatial data (sf object)
#' @param ci_current Current CI raster
#' @param ci_previous Previous week's CI raster
#' @param harvesting_data Data frame with harvesting information
#' @return A data frame with farm status summary metrics
#'
generate_farm_health_summary <- function(field_boundaries, ci_current, ci_previous, harvesting_data) {
# Generate a summary data frame of farm health by field
tryCatch({
# Get unique field names
fields <- unique(field_boundaries$field)
# Initialize result dataframe
summary_data <- data.frame(
field = character(),
mean_ci = numeric(),
ci_change = numeric(),
ci_uniformity = numeric(),
status = character(),
anomaly_type = character(),
priority_level = numeric(),
age_weeks = numeric(),
harvest_readiness = character(),
stringsAsFactors = FALSE
)
# Process each field with better error handling
for (field_name in fields) {
tryCatch({
# Get field boundary
field_shape <- field_boundaries %>% dplyr::filter(field == field_name)
# Skip if field shape is empty
if (nrow(field_shape) == 0) {
safe_log(paste("Empty field shape for", field_name), "WARNING")
next
}
# Get field age from harvesting data
field_age_data <- harvesting_data %>%
dplyr::filter(field == field_name) %>%
dplyr::arrange(desc(season_start)) %>%
dplyr::slice(1)
# Default age if not available
field_age_weeks <- if (nrow(field_age_data) > 0 && !is.na(field_age_data$age)) {
field_age_data$age
} else {
10 # Default age
}
# Extract CI values for this field using extract instead of crop/mask to avoid pointer issues
# This is more robust than the crop+mask approach
field_bbox <- sf::st_bbox(field_shape)
extent_vec <- c(field_bbox$xmin, field_bbox$xmax, field_bbox$ymin, field_bbox$ymax)
# Use terra extract function instead of crop+mask
ci_values <- terra::extract(ci_current, field_shape)
ci_prev_values <- terra::extract(ci_previous, field_shape)
# Calculate metrics
mean_ci <- mean(ci_values$CI, na.rm=TRUE)
mean_ci_prev <- mean(ci_prev_values$CI, na.rm=TRUE)
ci_change <- mean_ci - mean_ci_prev
ci_sd <- sd(ci_values$CI, na.rm=TRUE)
ci_uniformity <- ci_sd / max(0.1, mean_ci) # Avoid division by zero
# Determine field status
status <- dplyr::case_when(
mean_ci >= 5 ~ "Excellent",
mean_ci >= 3.5 ~ "Good",
mean_ci >= 2 ~ "Fair",
mean_ci >= 1 ~ "Poor",
TRUE ~ "Critical"
)
# Determine anomaly type
anomaly_type <- dplyr::case_when(
ci_change > 2 ~ "Potential Weed Growth",
ci_change < -2 ~ "Potential Weeding/Harvesting",
ci_uniformity > 0.5 ~ "High Variability",
mean_ci < 1 ~ "Low Vigor",
TRUE ~ "None"
)
# Calculate priority level (1-5, with 1 being highest priority)
priority_score <- dplyr::case_when(
mean_ci < 1 ~ 1, # Critical - highest priority
anomaly_type == "Potential Weed Growth" ~ 2,
anomaly_type == "High Variability" ~ 3,
ci_change < -1 ~ 4,
TRUE ~ 5 # No urgent issues
)
# Determine harvest readiness
harvest_readiness <- dplyr::case_when(
field_age_weeks >= 52 & mean_ci >= 4 ~ "Ready for harvest",
field_age_weeks >= 48 & mean_ci >= 3.5 ~ "Approaching harvest",
field_age_weeks >= 40 & mean_ci >= 3 ~ "Mid-maturity",
field_age_weeks >= 12 ~ "Growing",
TRUE ~ "Early stage"
)
# Add to summary data
summary_data <- rbind(summary_data, data.frame(
field = field_name,
mean_ci = round(mean_ci, 2),
ci_change = round(ci_change, 2),
ci_uniformity = round(ci_uniformity, 2),
status = status,
anomaly_type = anomaly_type,
priority_level = priority_score,
age_weeks = field_age_weeks,
harvest_readiness = harvest_readiness,
stringsAsFactors = FALSE
))
}, error = function(e) {
safe_log(paste("Error calculating health score for field", field_name, ":", e$message), "ERROR")
# Add a row with NA values for this field to ensure it still appears in outputs
summary_data <- rbind(summary_data, data.frame(
field = field_name,
mean_ci = NA,
ci_change = NA,
ci_uniformity = NA,
status = "Error",
anomaly_type = "Error",
priority_level = 1, # High priority because it needs investigation
age_weeks = NA,
harvest_readiness = "Unknown",
stringsAsFactors = FALSE
))
})
}
# Sort by priority level
summary_data <- summary_data %>% dplyr::arrange(priority_level, field)
return(summary_data)
}, error = function(e) {
safe_log(paste("Error in generate_farm_health_summary:", e$message), "ERROR")
return(data.frame(
field = character(),
mean_ci = numeric(),
ci_change = numeric(),
ci_uniformity = numeric(),
status = character(),
anomaly_type = character(),
priority_level = numeric(),
age_weeks = numeric(),
harvest_readiness = character(),
stringsAsFactors = FALSE
))
})
}
#' Create a farm-wide anomaly detection map
#'
#' @param ci_current Current CI raster
#' @param ci_previous Previous week's CI raster
#' @param field_boundaries Field boundaries spatial data (sf object)
#' @return A tmap object with anomaly visualization
#'
create_anomaly_map <- function(ci_current, ci_previous, field_boundaries) {
tryCatch({
# Calculate difference raster
ci_diff <- ci_current - ci_previous
# Create a categorical raster for anomalies
anomaly_raster <- ci_current * 0 # Initialize with same extent/resolution
# Extract values to manipulate
diff_values <- terra::values(ci_diff)
curr_values <- terra::values(ci_current)
# Define anomaly categories:
# 4: Significant growth (potential weeds) - CI increase > 2
# 3: Moderate growth - CI increase 1-2
# 2: Stable - CI change between -1 and 1
# 1: Moderate decline - CI decrease 1-2
# 0: Significant decline (potential weeding/harvesting) - CI decrease > 2
# Apply classification
anomaly_values <- rep(NA, length(diff_values))
# Significant growth (potential weeds)
sig_growth <- which(diff_values > 2 & !is.na(diff_values))
anomaly_values[sig_growth] <- 4
# Moderate growth
mod_growth <- which(diff_values > 1 & diff_values <= 2 & !is.na(diff_values))
anomaly_values[mod_growth] <- 3
# Stable
stable <- which(diff_values >= -1 & diff_values <= 1 & !is.na(diff_values))
anomaly_values[stable] <- 2
# Moderate decline
mod_decline <- which(diff_values < -1 & diff_values >= -2 & !is.na(diff_values))
anomaly_values[mod_decline] <- 1
# Significant decline (potential weeding)
sig_decline <- which(diff_values < -2 & !is.na(diff_values))
anomaly_values[sig_decline] <- 0
# Set values in raster
terra::values(anomaly_raster) <- anomaly_values
# Create anomaly map
map <- tm_shape(anomaly_raster) +
tm_raster(
style = "cat",
palette = c("#d73027", "#fc8d59", "#ffffbf", "#91cf60", "#1a9850"),
labels = c("Significant Decline", "Moderate Decline", "Stable", "Moderate Growth", "Significant Growth"),
title = "Weekly CI Change"
) +
tm_shape(field_boundaries) +
tm_borders(col = "black", lwd = 1.5) +
tm_text("field", size = 0.6) +
tm_layout(
main.title = "Farm-Wide Anomaly Detection",
legend.outside = TRUE,
legend.outside.position = "bottom"
) +
tm_scale_bar(position = tm_pos_out("right", "bottom"))
return(map)
}, error = function(e) {
safe_log(paste("Error in create_anomaly_map:", e$message), "ERROR")
return(NULL)
})
}
#' Create a choropleth map of field health status
#'
#' @param field_boundaries Field boundaries with health data
#' @param attribute Field to visualize (e.g., "priority_level", "mean_ci")
#' @param title Map title
#' @param palette Color palette to use
#' @param legend_title Legend title
#' @return A tmap object
#'
create_field_status_map <- function(field_boundaries, health_data, attribute,
title = "Field Status Overview",
palette = "RdYlGn",
legend_title = "Status") {
tryCatch({
# Join health data to field boundaries
field_data <- field_boundaries %>%
dplyr::left_join(health_data, by = "field")
# Create style based on attribute type
if (attribute == "status") {
# Categorical styling for status
map <- tm_shape(field_data) +
tm_fill(
col = attribute,
palette = c("Critical" = "#d73027", "Poor" = "#fc8d59",
"Fair" = "#ffffbf", "Good" = "#91cf60", "Excellent" = "#1a9850",
"Error" = "#999999"), # Added Error category
title = legend_title
)
} else if (attribute == "priority_level") {
# Numeric with custom breaks for priority (5 to 1, with 1 being highest priority)
map <- tm_shape(field_data) +
tm_fill(
col = attribute,
palette = "-RdYlGn", # Reversed so red is high priority
breaks = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5),
labels = c("Critical", "High", "Medium", "Low", "Minimal"),
title = legend_title
)
} else if (attribute == "anomaly_type") {
# Categorical styling for anomalies
map <- tm_shape(field_data) +
tm_fill(
col = attribute,
palette = c("Potential Weed Growth" = "#d73027",
"Potential Weeding/Harvesting" = "#4575b4",
"High Variability" = "#f46d43",
"Low Vigor" = "#fee090",
"None" = "#91cf60",
"Error" = "#999999"), # Added Error category
title = legend_title
)
} else if (attribute == "harvest_readiness") {
# Categorical styling for harvest readiness
map <- tm_shape(field_data) +
tm_fill(
col = attribute,
palette = c("Ready for harvest" = "#1a9850",
"Approaching harvest" = "#91cf60",
"Mid-maturity" = "#ffffbf",
"Growing" = "#fc8d59",
"Early stage" = "#d73027",
"Unknown" = "#999999"), # Added Unknown category
title = legend_title
)
} else {
# Default numerical styling
map <- tm_shape(field_data) +
tm_fill(
col = attribute,
palette = palette,
title = legend_title,
style = "cont",
na.color = "#999999" # Color for NA values
)
}
# Complete the map with borders and labels
map <- map +
tm_borders(col = "black", lwd = 1) +
tm_text("field", size = 0.7) +
tm_layout(
main.title = title,
legend.outside = TRUE,
legend.outside.position = "bottom"
) +
tm_scale_bar(position = tm_pos_out("right", "bottom"))
return(map)
}, error = function(e) {
safe_log(paste("Error in create_field_status_map:", e$message), "ERROR")
return(NULL)
})
}
#' Create a summary statistics visualization
#'
#' @param health_data Farm health summary data
#' @return A ggplot2 object
#'
create_summary_stats <- function(health_data) {
tryCatch({
# Handle empty dataframe case
if (nrow(health_data) == 0) {
return(ggplot2::ggplot() +
ggplot2::annotate("text", x = 0, y = 0, label = "No field data available") +
ggplot2::theme_void())
}
# Count fields by status
status_counts <- health_data %>%
dplyr::group_by(status) %>%
dplyr::summarise(count = n()) %>%
dplyr::mutate(status = factor(status, levels = c("Excellent", "Good", "Fair", "Poor", "Critical", "Error")))
# Create colors for status categories
status_colors <- c(
"Excellent" = "#1a9850",
"Good" = "#91cf60",
"Fair" = "#ffffbf",
"Poor" = "#fc8d59",
"Critical" = "#d73027",
"Error" = "#999999"
)
# Create bar chart
p <- ggplot2::ggplot(status_counts, ggplot2::aes(x = status, y = count, fill = status)) +
ggplot2::geom_bar(stat = "identity") +
ggplot2::scale_fill_manual(values = status_colors) +
ggplot2::labs(
title = "Field Status Summary",
x = "Status",
y = "Number of Fields",
fill = "Field Status"
) +
ggplot2::theme_minimal() +
ggplot2::theme(
axis.text.x = ggplot2::element_text(angle = 45, hjust = 1),
legend.position = "bottom"
)
return(p)
}, error = function(e) {
safe_log(paste("Error in create_summary_stats:", e$message), "ERROR")
return(ggplot2::ggplot() +
ggplot2::annotate("text", x = 0, y = 0, label = paste("Error:", e$message)) +
ggplot2::theme_void())
})
}
#' Create a bar chart of fields requiring attention
#'
#' @param health_data Farm health summary data
#' @param max_fields Maximum number of fields to display
#' @return A ggplot2 object
#'
create_priority_fields_chart <- function(health_data, max_fields = 10) {
tryCatch({
# Handle empty dataframe case
if (nrow(health_data) == 0) {
return(ggplot2::ggplot() +
ggplot2::annotate("text", x = 0, y = 0, label = "No field data available") +
ggplot2::theme_void())
}
# Filter for fields that need attention (priority 1-3)
priority_fields <- health_data %>%
dplyr::filter(priority_level <= 3) %>%
dplyr::arrange(priority_level) %>%
dplyr::slice_head(n = max_fields)
# If no priority fields, return message
if (nrow(priority_fields) == 0) {
return(ggplot2::ggplot() +
ggplot2::annotate("text", x = 0, y = 0, label = "No priority fields requiring attention") +
ggplot2::theme_void())
}
# Create priority labels
priority_fields$priority_label <- factor(
dplyr::case_when(
priority_fields$priority_level == 1 ~ "Critical",
priority_fields$priority_level == 2 ~ "High",
priority_fields$priority_level == 3 ~ "Medium",
TRUE ~ "Low"
),
levels = c("Critical", "High", "Medium", "Low")
)
# Priority colors
priority_colors <- c(
"Critical" = "#d73027",
"High" = "#fc8d59",
"Medium" = "#fee090",
"Low" = "#91cf60"
)
# Create chart
p <- ggplot2::ggplot(priority_fields,
ggplot2::aes(x = reorder(field, -priority_level),
y = mean_ci,
fill = priority_label)) +
ggplot2::geom_bar(stat = "identity") +
ggplot2::geom_text(ggplot2::aes(label = anomaly_type),
position = ggplot2::position_stack(vjust = 0.5),
size = 3, angle = 90, hjust = 0) +
ggplot2::scale_fill_manual(values = priority_colors) +
ggplot2::labs(
title = "Priority Fields Requiring Attention",
subtitle = "With anomaly types and CI values",
x = "Field",
y = "Chlorophyll Index (CI)",
fill = "Priority"
) +
ggplot2::theme_minimal() +
ggplot2::theme(
axis.text.x = ggplot2::element_text(angle = 45, hjust = 1),
legend.position = "bottom"
)
return(p)
}, error = function(e) {
safe_log(paste("Error in create_priority_fields_chart:", e$message), "ERROR")
return(ggplot2::ggplot() +
ggplot2::annotate("text", x = 0, y = 0, label = paste("Error:", e$message)) +
ggplot2::theme_void())
})
}
#' Creates a harvest readiness visualization
#'
#' @param health_data Farm health summary data
#' @return A ggplot2 object
create_harvest_readiness_chart <- function(health_data) {
tryCatch({
# Handle empty dataframe case
if (nrow(health_data) == 0) {
return(ggplot2::ggplot() +
ggplot2::annotate("text", x = 0, y = 0, label = "No field data available") +
ggplot2::theme_void())
}
# Count fields by harvest readiness
harvest_counts <- health_data %>%
dplyr::group_by(harvest_readiness) %>%
dplyr::summarise(count = n())
# Order factor levels
harvest_order <- c("Ready for harvest", "Approaching harvest", "Mid-maturity", "Growing", "Early stage", "Unknown")
harvest_counts$harvest_readiness <- factor(harvest_counts$harvest_readiness, levels = harvest_order)
# Create colors for harvest readiness categories
harvest_colors <- c(
"Ready for harvest" = "#1a9850",
"Approaching harvest" = "#91cf60",
"Mid-maturity" = "#ffffbf",
"Growing" = "#fc8d59",
"Early stage" = "#d73027",
"Unknown" = "#999999"
)
# Create pie chart
p <- ggplot2::ggplot(harvest_counts, ggplot2::aes(x="", y=count, fill=harvest_readiness)) +
ggplot2::geom_bar(stat="identity", width=1) +
ggplot2::coord_polar("y", start=0) +
ggplot2::scale_fill_manual(values = harvest_colors) +
ggplot2::labs(
title = "Harvest Readiness Overview",
fill = "Harvest Stage"
) +
ggplot2::theme_minimal() +
ggplot2::theme(
axis.title.x = ggplot2::element_blank(),
axis.title.y = ggplot2::element_blank(),
panel.border = ggplot2::element_blank(),
panel.grid = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
axis.text = ggplot2::element_blank(),
plot.title = ggplot2::element_text(size=14, face="bold")
)
return(p)
}, error = function(e) {
safe_log(paste("Error in create_harvest_readiness_chart:", e$message), "ERROR")
return(ggplot2::ggplot() +
ggplot2::annotate("text", x = 0, y = 0, label = paste("Error:", e$message)) +
ggplot2::theme_void())
})
}
#' Generate recommendations based on farm health
#'
#' @param health_data Farm health summary data
#' @return HTML formatted recommendations
generate_executive_recommendations <- function(health_data) {
tryCatch({
# Handle empty dataframe case
if (nrow(health_data) == 0) {
return("<div style='background-color: #f5f5f5; padding: 15px; border-radius: 5px;'><h3>Executive Recommendations</h3><p>No field data available to generate recommendations.</p></div>")
}
# Count fields by priority level
priority_counts <- health_data %>%
dplyr::group_by(priority_level) %>%
dplyr::summarise(count = n())
# Get critical and high priority fields
critical_fields <- health_data %>%
dplyr::filter(priority_level == 1) %>%
dplyr::pull(field)
high_priority_fields <- health_data %>%
dplyr::filter(priority_level == 2) %>%
dplyr::pull(field)
# Count harvest-ready fields
harvest_ready <- health_data %>%
dplyr::filter(harvest_readiness == "Ready for harvest") %>%
dplyr::pull(field)
approaching_harvest <- health_data %>%
dplyr::filter(harvest_readiness == "Approaching harvest") %>%
dplyr::pull(field)
# Count anomalies by type
anomaly_counts <- health_data %>%
dplyr::filter(anomaly_type != "None" & anomaly_type != "Error") %>%
dplyr::group_by(anomaly_type) %>%
dplyr::summarise(count = n())
# Generate HTML recommendations
html_output <- "<div style='background-color: #f5f5f5; padding: 15px; border-radius: 5px;'>"
html_output <- paste0(html_output, "<h3>Executive Recommendations</h3>")
# Priority recommendations
html_output <- paste0(html_output, "<h4>Priority Actions:</h4><ul>")
if (length(critical_fields) > 0) {
html_output <- paste0(html_output,
sprintf("<li><strong>Critical attention needed</strong> for fields: %s</li>",
paste(critical_fields, collapse = ", ")))
}
if (length(high_priority_fields) > 0) {
html_output <- paste0(html_output,
sprintf("<li><strong>High priority inspection</strong> for fields: %s</li>",
paste(high_priority_fields, collapse = ", ")))
}
if (length(harvest_ready) > 0) {
html_output <- paste0(html_output,
sprintf("<li><strong>Ready for harvest</strong>: %s</li>",
paste(harvest_ready, collapse = ", ")))
}
if (length(approaching_harvest) > 0) {
html_output <- paste0(html_output,
sprintf("<li><strong>Approaching harvest readiness</strong>: %s</li>",
paste(approaching_harvest, collapse = ", ")))
}
# If no specific recommendations, add general one
if (length(critical_fields) == 0 && length(high_priority_fields) == 0 &&
length(harvest_ready) == 0 && length(approaching_harvest) == 0) {
html_output <- paste0(html_output, "<li>No urgent actions required this week.</li>")
}
html_output <- paste0(html_output, "</ul>")
# Anomaly notifications
if (nrow(anomaly_counts) > 0) {
html_output <- paste0(html_output, "<h4>Anomaly Notifications:</h4><ul>")
for (i in 1:nrow(anomaly_counts)) {
html_output <- paste0(html_output,
sprintf("<li>%s detected in %d fields</li>",
anomaly_counts$anomaly_type[i], anomaly_counts$count[i]))
}
html_output <- paste0(html_output, "</ul>")
}
# Farm status summary
html_output <- paste0(html_output, "<h4>Farm Status Overview:</h4><ul>")
status_counts <- health_data %>%
dplyr::filter(status != "Error") %>%
dplyr::group_by(status) %>%
dplyr::summarise(count = n())
for (i in 1:nrow(status_counts)) {
html_output <- paste0(html_output,
sprintf("<li>%s: %d fields</li>",
status_counts$status[i], status_counts$count[i]))
}
html_output <- paste0(html_output, "</ul></div>")
return(html_output)
}, error = function(e) {
safe_log(paste("Error in generate_executive_recommendations:", e$message), "ERROR")
return("<p>Error generating recommendations.</p>")
})
}
```
`r subtitle_var`
\pagebreak
# Explanation of the Report
This report provides a detailed analysis of your sugarcane fields based on satellite imagery, helping you monitor crop health and development throughout the growing season. The data is processed weekly to give you timely insights for optimal farm management decisions.
## What is the Chlorophyll Index (CI)?
The **Chlorophyll Index (CI)** is a vegetation index that measures the relative amount of chlorophyll in plant leaves. Chlorophyll is the green pigment responsible for photosynthesis in plants. Higher CI values indicate:
* Greater photosynthetic activity
* Healthier plant tissue
* Better nitrogen uptake
* More vigorous crop growth
CI values typically range from 0 (bare soil or severely stressed vegetation) to 7+ (very healthy, dense vegetation). For sugarcane, values between 3-7 generally indicate good crop health, depending on the growth stage.
# Executive Dashboard
## Farm Health Status
The map below shows the overall health status of all fields based on current Chlorophyll Index values. This provides a quick overview of which areas of your farm are performing well and which might need intervention.
**How it works:** Field health status is determined by the average Chlorophyll Index (CI) value across each field:
- **Excellent** (dark green): CI ≥ 5.0
- **Good** (light green): CI 3.5-4.99
- **Fair** (yellow): CI 2.0-3.49
- **Poor** (orange): CI 1.0-1.99
- **Critical** (red): CI < 1.0
Fields with higher CI values indicate better crop vigor and photosynthetic activity, which typically correlate with healthier plants.
```{r render_field_status_map, echo=FALSE, fig.height=6, fig.width=9, message=FALSE, warning=FALSE}
# Create field status map
tryCatch({
# Create and display the field status map
field_status_map <- create_field_status_map(
field_boundaries = AllPivots0,
health_data = farm_health_data,
attribute = "status",
title = "Field Health Status Overview",
palette = "RdYlGn",
legend_title = "Health Status"
)
# Print the map
print(field_status_map)
}, error = function(e) {
safe_log(paste("Error creating field status map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating field status map", cex=1.5)
})
```
## Management Priorities
This map highlights which fields require priority management attention based on current health indicators and trends. Fields in red require immediate attention, while green fields are performing well with minimal intervention needed.
**How it works:** Priority levels are calculated based on a combination of factors:
- **Critical Priority** (dark red): Fields with CI < 1.0 or critical health issues
- **High Priority** (red): Fields with potential weed growth (CI increase > 2)
- **Medium Priority** (orange): Fields with high internal variability
- **Low Priority** (light green): Fields with moderate decline in CI
- **Minimal Priority** (dark green): Stable, healthy fields
The priority algorithm considers both absolute CI values and week-to-week changes to identify fields that need immediate management attention.
```{r render_priority_map, echo=FALSE, fig.height=6, fig.width=9, message=FALSE, warning=FALSE}
# Create priority management map
tryCatch({
# Fix the priority mapping so red = high priority, green = low priority
# Reverse the priority levels before mapping (1=critical becomes 5, 5=minimal becomes 1)
farm_health_data$display_priority <- 6 - farm_health_data$priority_level
# Create and display the priority map with corrected priority levels
priority_map <- tm_shape(AllPivots0 %>% dplyr::left_join(farm_health_data, by = "field")) +
tm_fill(
col = "display_priority",
palette = "RdYlGn", # Now properly oriented: red = high priority, green = low priority
breaks = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5),
labels = c("Minimal", "Low", "Medium", "High", "Critical"),
title = "Priority Level"
) +
tm_borders(col = "black", lwd = 1) +
tm_text("field", size = 0.7) +
tm_layout(
main.title = "Field Management Priority",
legend.outside = TRUE,
legend.outside.position = "bottom"
) +
tm_scale_bar(position = tm_pos_out("right", "bottom"))
# Print the map
print(priority_map)
}, error = function(e) {
safe_log(paste("Error creating priority map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating priority map", cex=1.5)
})
```
\pagebreak
## Crop Anomaly Detection
The map below highlights potential anomalies in your fields that may require investigation. Areas with sudden changes in CI values could indicate weeding activities, rapid weed growth, or other management interventions.
**How it works:** This map compares current week's CI values with those from the previous week:
- **Significant Growth** (dark green): CI increase > 2 units (potential weed growth)
- **Moderate Growth** (light green): CI increase of 1-2 units
- **Stable** (yellow): CI change between -1 and +1 units
- **Moderate Decline** (orange): CI decrease of 1-2 units
- **Significant Decline** (red): CI decrease > 2 units (potential weeding/harvesting activities)
Areas with significant growth (dark green) may indicate rapid weed growth that requires monitoring, while significant declines (red) often indicate recent management activities like weeding or harvesting.
```{r render_anomaly_map, echo=FALSE, fig.height=6, fig.width=9, message=FALSE, warning=FALSE}
# Create anomaly detection map
tryCatch({
# Create and display the anomaly map
anomaly_map <- create_anomaly_map(
ci_current = CI,
ci_previous = CI_m1,
field_boundaries = AllPivots0
)
# Print the map
print(anomaly_map)
}, error = function(e) {
safe_log(paste("Error creating anomaly map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating anomaly map", cex=1.5)
})
```
\pagebreak
## Harvest Planning
This map shows the harvest readiness status of all fields, helping you plan harvest operations and logistics. Fields in dark green are ready for harvest, while those in yellow through red are at earlier growth stages.
**How it works:** Harvest readiness is determined by combining field age and CI values:
- **Ready for harvest** (dark green): Fields ≥52 weeks old with CI ≥4.0
- **Approaching harvest** (light green): Fields ≥48 weeks old with CI ≥3.5
- **Mid-maturity** (yellow): Fields ≥40 weeks old with CI ≥3.0
- **Growing** (orange): Fields ≥12 weeks old
- **Early stage** (red): Fields <12 weeks old
This classification helps prioritize harvesting operations and logistical planning by identifying fields that are at optimal maturity for maximum sugar content.
```{r render_harvest_map, echo=FALSE, fig.height=6, fig.width=9, message=FALSE, warning=FALSE}
# Create harvest planning map
tryCatch({
# Create and display the harvest readiness map
harvest_map <- create_field_status_map(
field_boundaries = AllPivots0,
health_data = farm_health_data,
attribute = "harvest_readiness",
title = "Harvest Readiness Status",
palette = "RdYlGn",
legend_title = "Harvest Status"
)
# Print the map
print(harvest_map)
}, error = function(e) {
safe_log(paste("Error creating harvest map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating harvest map", cex=1.5)
})
```
\pagebreak
## Field Status Summary
The charts below provide an overview of your farm's health and harvest readiness status, showing the distribution of fields across different health categories and maturity stages.
**How the Field Status Chart works:** This bar chart displays the count of fields in each health status category, based on the same CI thresholds described in the Farm Health Status section:
- **Excellent** (dark green): CI ≥ 5.0
- **Good** (light green): CI 3.5-4.99
- **Fair** (yellow): CI 2.0-3.49
- **Poor** (orange): CI 1.0-1.99
- **Critical** (red): CI < 1.0
**How the Harvest Readiness Chart works:** This pie chart shows the distribution of fields by harvest readiness, allowing you to see at a glance how many fields are in each stage of development. Fields are categorized based on both age and CI values as described in the Harvest Planning section above.
```{r render_status_charts, echo=FALSE, fig.height=5, fig.width=10, message=FALSE, warning=FALSE}
# Create field status summary visualization
tryCatch({
# Create field status charts
status_chart <- create_summary_stats(farm_health_data)
# Print the chart
print(status_chart)
# Create a second row with harvest readiness chart
harvest_chart <- create_harvest_readiness_chart(farm_health_data)
# Print the chart
print(harvest_chart)
}, error = function(e) {
safe_log(paste("Error creating status summary charts:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating status summary charts", cex=1.5)
})
```
## Priority Fields Requiring Attention
The chart below highlights fields that require immediate management attention based on their health scores and anomaly detection. These should be prioritized for field inspections.
**How it works:** This chart shows fields with priority levels 1-3 (critical, high, and medium):
- Fields are ordered by priority level, with the most critical fields on the left
- Bar height represents the Chlorophyll Index (CI) value
- Bar colors indicate priority level: red (critical), orange (high), yellow (medium)
- Text labels show the detected anomaly type for each field
The table below the chart provides detailed metrics for these priority fields, including CI values, weekly changes, anomaly types, and harvest status. Only fields requiring management attention (priority levels 1-3) are included.
```{r render_priority_fields_chart, echo=FALSE, fig.height=5, fig.width=10, message=FALSE, warning=FALSE}
# Create priority fields chart
tryCatch({
# Create and display priority fields chart
priority_chart <- create_priority_fields_chart(farm_health_data)
# Print the chart
print(priority_chart)
# Create a table of priority fields
priority_table <- farm_health_data %>%
dplyr::filter(priority_level <= 3) %>%
dplyr::arrange(priority_level, field) %>%
dplyr::select(
Field = field,
Status = status,
`CI Value` = mean_ci,
`Weekly Change` = ci_change,
`Anomaly Type` = anomaly_type,
`Age (Weeks)` = age_weeks,
`Harvest Status` = harvest_readiness
)
# Display the table if there are priority fields
if (nrow(priority_table) > 0) {
knitr::kable(priority_table, caption = "Priority Fields Requiring Management Attention")
} else {
cat("No priority fields requiring immediate attention this week.")
}
}, error = function(e) {
safe_log(paste("Error creating priority fields chart:", e$message), "ERROR")
cat("Error generating priority fields visualization. See log for details.")
})
```
\pagebreak
## Management Recommendations
```{r render_recommendations, echo=FALSE, results='asis', message=FALSE, warning=FALSE}
# Generate executive recommendations
tryCatch({
# Create and display recommendations
recommendations_html <- generate_executive_recommendations(farm_health_data)
# Print the HTML recommendations
cat(recommendations_html)
}, error = function(e) {
safe_log(paste("Error creating recommendations:", e$message), "ERROR")
cat("<p>Error generating recommendations. Please see system administrator.</p>")
})
```
## Yield Prediction Overview
This section provides yield predictions for mature fields (over 300 days old) based on their Chlorophyll Index values and growth patterns. These predictions can help with harvest planning and yield forecasting.
```{r render_yield_summary, echo=FALSE, fig.height=5, fig.width=10, message=FALSE, warning=FALSE}
# Create yield summary
tryCatch({
if (exists("pred_rf_current_season") && nrow(pred_rf_current_season) > 0) {
# Calculate total estimated production
total_yield <- sum(pred_rf_current_season$predicted_Tcha, na.rm = TRUE)
# Create summary box
cat("<div style='background-color: #f5f5f5; padding: 15px; border-radius: 5px;'>")
cat("<h3>Yield Summary</h3>")
cat("<ul>")
cat(sprintf("<li><strong>Total estimated production</strong>: %s tonnes/ha</li>",
format(round(total_yield, 0), big.mark=",")))
cat(sprintf("<li><strong>Number of harvest-ready fields</strong>: %d</li>",
nrow(pred_rf_current_season)))
cat(sprintf("<li><strong>Average predicted yield</strong>: %s tonnes/ha</li>",
format(round(mean(pred_rf_current_season$predicted_Tcha, na.rm=TRUE), 1), big.mark=",")))
cat("</ul>")
cat("</div>")
# Display yield prediction table
harvest_ready_fields <- pred_rf_current_season %>%
dplyr::arrange(desc(predicted_Tcha)) %>%
dplyr::select(
Field = field,
`Sub Field` = sub_field,
`Age (Days)` = Age_days,
`Cumulative CI` = total_CI,
`Predicted Yield (Tonnes/ha)` = predicted_Tcha
)
knitr::kable(harvest_ready_fields,
caption = "Predicted Yields for Harvest-Ready Fields",
digits = 1)
} else {
cat("<div style='background-color: #f5f5f5; padding: 15px; border-radius: 5px;'>")
cat("<h3>Yield Summary</h3>")
cat("<p>No fields currently meet harvest readiness criteria (>300 days) for yield prediction.</p>")
cat("</div>")
}
}, error = function(e) {
safe_log(paste("Error creating yield summary:", e$message), "ERROR")
cat("<p>Error generating yield summary. Please see system administrator.</p>")
})
```
Reference in a new issue View git blame Copy permalink