SmartCane/r_app/90_CI_report_with_kpis_simple.Rmd

1092 lines
42 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

---
params:
ref: "word-styles-reference-var1.docx"
output_file: CI_report.docx
report_date: "2025-09-30"
data_dir: "aura"
mail_day: "Wednesday"
borders: FALSE
ci_plot_type: "both" # options: "absolute", "cumulative", "both"
colorblind_friendly: TRUE # use colorblind-friendly palettes (viridis/plasma)
facet_by_season: FALSE # facet CI trend plots by season instead of overlaying
x_axis_unit: "days" # x-axis unit for trend plots: "days" or "weeks"
output:
word_document:
reference_docx: !expr file.path("word-styles-reference-var1.docx")
toc: no
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
ci_plot_type <- params$ci_plot_type
colorblind_friendly <- params$colorblind_friendly
facet_by_season <- params$facet_by_season
x_axis_unit <- params$x_axis_unit
```
```{r load_libraries, message=FALSE, warning=FALSE, include=FALSE}
# Configure knitr options
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
# Set flag for reporting scripts to use pivot.geojson instead of pivot_2.geojson
reporting_script <- TRUE
# Load all packages at once with suppressPackageStartupMessages
suppressPackageStartupMessages({
library(here)
library(sf)
library(terra)
library(tidyverse)
library(tmap)
library(lubridate)
library(zoo)
library(rsample)
library(caret)
library(randomForest)
library(CAST)
library(knitr)
library(tidyr)
library(flextable)
})
# 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)
})
})
# Function to determine field priority level based on CV and Moran's I
# Returns: 1=Urgent, 2=Monitor, 3=No stress
get_field_priority_level <- function(cv, morans_i) {
# Handle NA values
if (is.na(cv) || is.na(morans_i)) return(3) # Default to no stress
# Determine priority based on thresholds
if (cv < 0.1) {
if (morans_i < 0.7) {
return(3) # No stress
} else if (morans_i <= 0.9) {
return(2) # Monitor (young field with some clustering)
} else {
return(1) # Urgent
}
} else if (cv <= 0.15) {
if (morans_i < 0.7) {
return(2) # Monitor
} else {
return(1) # Urgent
}
} else { # cv > 0.15
return(1) # Urgent
}
}
```
```{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 with KPIs")
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 load_kpi_data, message=FALSE, warning=FALSE, include=FALSE}
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path("..", "laravel_app", "storage", "app", project_dir, "reports", "kpis")
date_suffix <- format(as.Date(report_date), "%Y%m%d")
# Calculate current week from report_date using ISO 8601 week numbering
current_week <- as.numeric(format(as.Date(report_date), "%V"))
week_suffix <- paste0("week", current_week)
# Candidate filenames we expect (exact and common variants)
expected_summary_names <- c(
paste0(project_dir, "_kpi_summary_tables_", week_suffix, ".rds"),
paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
paste0(project_dir, "_kpi_summary_tables.rds"),
"kpi_summary_tables.rds",
paste0("kpi_summary_tables_", week_suffix, ".rds"),
paste0("kpi_summary_tables_", date_suffix, ".rds")
)
expected_field_details_names <- c(
paste0(project_dir, "_field_details_", week_suffix, ".rds"),
paste0(project_dir, "_field_details_", date_suffix, ".rds"),
paste0(project_dir, "_field_details.rds"),
"field_details.rds"
)
# Helper to attempt loading a file from the directory or fallback to a workspace-wide search
try_load_from_dir <- function(dir, candidates) {
if (!dir.exists(dir)) return(NULL)
for (name in candidates) {
f <- file.path(dir, name)
if (file.exists(f)) return(f)
}
return(NULL)
}
# Try primary directory first
summary_file <- try_load_from_dir(kpi_data_dir, expected_summary_names)
field_details_file <- try_load_from_dir(kpi_data_dir, expected_field_details_names)
# If not found, perform a workspace-wide search (slower) limited to laravel_app storage
if (is.null(summary_file) || is.null(field_details_file)) {
safe_log(paste("KPI files not found in", kpi_data_dir, "—searching workspace for RDS files"))
# List rds files under laravel_app/storage/app recursively
files <- list.files(path = file.path("laravel_app", "storage", "app"), pattern = "\\.rds$", recursive = TRUE, full.names = TRUE)
# Try to match by expected names
if (is.null(summary_file)) {
matched <- files[basename(files) %in% expected_summary_names]
if (length(matched) > 0) summary_file <- matched[1]
}
if (is.null(field_details_file)) {
matched2 <- files[basename(files) %in% expected_field_details_names]
if (length(matched2) > 0) field_details_file <- matched2[1]
}
}
# Final checks and load with safe error messages
kpi_files_exist <- FALSE
if (!is.null(summary_file) && file.exists(summary_file)) {
safe_log(paste("Loading KPI summary from:", summary_file))
summary_tables <- tryCatch(readRDS(summary_file), error = function(e) { safe_log(paste("Failed to read summary RDS:", e$message), "ERROR"); NULL })
if (!is.null(summary_tables)) kpi_files_exist <- TRUE
} else {
safe_log(paste("KPI summary file not found. Searched:", paste(expected_summary_names, collapse=", ")), "WARNING")
}
if (!is.null(field_details_file) && file.exists(field_details_file)) {
safe_log(paste("Loading field details from:", field_details_file))
field_details_table <- tryCatch(readRDS(field_details_file), error = function(e) { safe_log(paste("Failed to read field details RDS:", e$message), "ERROR"); NULL })
if (!is.null(field_details_table)) kpi_files_exist <- kpi_files_exist && TRUE
} else {
safe_log(paste("Field details file not found. Searched:", paste(expected_field_details_names, collapse=", ")), "WARNING")
}
if (kpi_files_exist) {
safe_log("✓ KPI summary tables loaded successfully")
} else {
safe_log("KPI files could not be located or loaded. KPI sections will be skipped.", "WARNING")
}
#' Generate field-specific KPI summary for display in reports
#' @param field_name Name of the field to summarize
#' @param field_details_table Data frame with field-level KPI details
#' @return Formatted text string with field KPI summary
generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadrant) {
tryCatch({
# Get field age from CI quadrant data for the CURRENT SEASON only
# First identify the current season for this field
current_season <- CI_quadrant %>%
filter(field == field_name, Date <= as.Date(report_date)) %>%
group_by(season) %>%
summarise(season_end = max(Date), .groups = 'drop') %>%
filter(season == max(season)) %>%
pull(season)
# Get the most recent DOY from the current season
field_age <- CI_quadrant %>%
filter(field == field_name, season == current_season) %>%
pull(DOY) %>%
max(na.rm = TRUE)
# Filter data for this specific field
field_data <- field_details_table %>%
filter(Field == field_name)
if (nrow(field_data) == 0) {
return(paste("**Field", field_name, "KPIs:** Data not available"))
}
# Aggregate sub-field data for field-level summary
# For categorical data, take the most common value or highest risk level
field_summary <- field_data %>%
summarise(
field_size = sum(`Field Size (ha)`, na.rm = TRUE),
uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"),
avg_yield_forecast = ifelse(is.na(`Yield Forecast (t/ha)`[1]), NA, mean(`Yield Forecast (t/ha)`, na.rm = TRUE)),
max_gap_score = max(`Gap Score`, na.rm = TRUE),
highest_decline_risk = case_when(
any(`Decline Risk` == "Very-high") ~ "Very-high",
any(`Decline Risk` == "High") ~ "High",
any(`Decline Risk` == "Moderate") ~ "Moderate",
any(`Decline Risk` == "Low") ~ "Low",
TRUE ~ "Unknown"
),
highest_weed_risk = case_when(
any(`Weed Risk` == "High") ~ "High",
any(`Weed Risk` == "Moderate") ~ "Moderate",
any(`Weed Risk` == "Low") ~ "Low",
TRUE ~ "Unknown"
),
avg_mean_ci = mean(`Mean CI`, na.rm = TRUE),
avg_cv = mean(`CV Value`, na.rm = TRUE),
.groups = 'drop'
)
# Apply age-based filtering to yield forecast
if (is.na(field_age) || field_age < 240) {
field_summary$avg_yield_forecast <- NA_real_
}
# Format the summary text
yield_text <- if (is.na(field_summary$avg_yield_forecast)) {
"Yield Forecast: NA"
} else {
paste0("Yield Forecast: ", round(field_summary$avg_yield_forecast, 1), " t/ha")
}
kpi_text <- paste0(
"Size: ", round(field_summary$field_size, 1), " ha • Growth Uniformity: ", field_summary$uniformity_levels,
" • ", yield_text, " • Gap Score: ", round(field_summary$max_gap_score, 1),
" • Decline Risk: ", field_summary$highest_decline_risk, " • Weed Risk: ", field_summary$highest_weed_risk,
" • Mean CI: ", round(field_summary$avg_mean_ci, 2)
)
# Wrap in smaller text HTML tags for Word output
#kpi_text <- paste0("<small>", kpi_text, "</small>")
kpi_text <- paste0("<span style='font-size:10pt'>", kpi_text, "</span>")
# Add alerts based on risk levels (smaller font too)
# alerts <- c()
# if (field_summary$highest_decline_risk %in% c("High", "Very-high")) {
# alerts <- c(alerts, "<span style='font-size: 8pt; color: red;'>🚨 High risk of growth decline detected</span>")
# }
# if (field_summary$highest_weed_risk == "High") {
# alerts <- c(alerts, "<span style='font-size: 8pt; color: orange;'>⚠️ High weed presence detected</span>")
# }
# if (field_summary$max_gap_score > 20) {
# alerts <- c(alerts, "<span style='font-size: 8pt; color: blue;'>💡 Significant gaps detected - monitor closely</span>")
# }
# if (field_summary$avg_cv > 0.25) {
# alerts <- c(alerts, "<span style='font-size: 8pt; color: orange;'>⚠️ Poor field uniformity - check irrigation/fertility</span>")
# }
# if (length(alerts) > 0) {
# kpi_text <- paste0(kpi_text, "\n\n", paste(alerts, collapse = "\n"))
# }
return(kpi_text)
}, error = function(e) {
safe_log(paste("Error generating KPI summary for field", field_name, ":", e$message), "ERROR")
return(paste("**Field", field_name, "KPIs:** Error generating summary"))
})
}
```
```{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 report dates and weeks using ISO 8601 week numbering
report_date_obj <- as.Date(today)
current_week <- as.numeric(format(report_date_obj, "%V"))
year <- as.numeric(format(report_date_obj, "%Y"))
# Calculate dates for weekly analysis
week_start <- report_date_obj - ((as.numeric(format(report_date_obj, "%w")) + 1) %% 7)
week_end <- week_start + 6
# Calculate week days (copied from 05 script for compatibility)
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)
# 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)
}
# 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)
safe_log(paste("Report week:", current_week, "Year:", year))
safe_log(paste("Week range:", week_start, "to", week_end))
```
```{r load_ci_data, message=FALSE, warning=FALSE, 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
# DEBUG: Check which weeks were actually loaded and their data ranges
safe_log(paste("DEBUG - CI (current) range:", paste(terra::minmax(CI)[,1], collapse=" to ")))
safe_log(paste("DEBUG - CI_m1 (week-1) range:", paste(terra::minmax(CI_m1)[,1], collapse=" to ")))
safe_log(paste("DEBUG - CI_m2 (week-2) range:", paste(terra::minmax(CI_m2)[,1], collapse=" to ")))
safe_log(paste("DEBUG - CI_m3 (week-3) range:", paste(terra::minmax(CI_m3)[,1], collapse=" to ")))
}, error = function(e) {
stop("Error loading raster data: ", e$message)
})
```
```{r compute_benchmarks_once, include=FALSE}
# Compute CI benchmarks once for the entire estate
benchmarks <- compute_ci_benchmarks(CI_quadrant, project_dir, c(10, 50, 90))
if (!is.null(benchmarks)) {
safe_log("Benchmarks computed successfully for the report")
} else {
safe_log("Failed to compute benchmarks", "WARNING")
}
```
## Report Summary
**Farm Location:** `r toupper(project_dir)` Estate
**Report Period:** Week `r current_week` of `r year`
**Data Source:** Planet Labs Satellite Imagery
**Analysis Type:** Chlorophyll Index (CI) Monitoring
**Report Generated on:** `r format(Sys.time(), "%B %d, %Y at %H:%M")`
## Report Structure
**Section 1:** Farm-wide analyses, summaries and Key Performance Indicators (KPIs)
**Section 2:** Field-by-field detailed analyses with maps and trend graphs
**Section 3:** Explanation of the report, definitions, and methodology
## Key Insights
```{r key_insights, echo=FALSE, results='asis'}
# Calculate key insights from KPI data
if (exists("summary_tables") && !is.null(summary_tables)) {
# Field uniformity insights
uniformity_data <- summary_tables$field_uniformity_summary
good_uniformity <- uniformity_data$Percent[uniformity_data$`Uniformity Level` == "Good"]
excellent_uniformity <- uniformity_data$Percent[uniformity_data$`Uniformity Level` == "Excellent"]
# Area change insights
area_change_data <- summary_tables$area_change_summary
improving_area <- area_change_data$Hectares[area_change_data$`Change Type` == "Improving areas"]
improving_pct <- area_change_data$Percent[area_change_data$`Change Type` == "Improving areas"]
declining_area <- area_change_data$Hectares[area_change_data$`Change Type` == "Declining areas"]
declining_pct <- area_change_data$Percent[area_change_data$`Change Type` == "Declining areas"]
cat("- ", ifelse(length(good_uniformity) > 0, good_uniformity, "N/A"), "% of fields have good uniformity\n", sep="")
cat("- ", ifelse(length(excellent_uniformity) > 0, excellent_uniformity, "N/A"), "% of fields have excellent uniformity\n", sep="")
cat("- ", ifelse(length(improving_area) > 0, round(improving_area, 1), "N/A"), " hectares (", ifelse(length(improving_pct) > 0, improving_pct, "N/A"), "%) of farm area is improving week-over-week\n", sep="")
cat("- ", ifelse(length(declining_area) > 0, round(declining_area, 1), "N/A"), " hectares (", ifelse(length(declining_pct) > 0, declining_pct, "N/A"), "%) of farm area is declining week-over-week\n", sep="")
} else {
cat("KPI data not available for key insights.\n")
}
```
\newpage
# Section 1: Farm-wide Analyses and KPIs
## Executive Summary - Key Performance Indicators
```{r combined_kpi_table, echo=FALSE}
# Combine all KPI tables into a single table with standardized column names
display_names <- c(
field_uniformity_summary = "Field Uniformity",
area_change_summary = "Area Change",
tch_forecasted_summary = "TCH Forecasted",
growth_decline_summary = "Growth Decline",
weed_presence_summary = "Weed Presence",
gap_filling_summary = "Gap Filling"
)
combined_df <- bind_rows(lapply(names(summary_tables), function(kpi) {
df <- summary_tables[[kpi]]
names(df) <- c("Level", "Count", "Percent")
# Format Count as integer (no decimals)
df <- df %>%
mutate(
Count = as.integer(round(Count)),
KPI = display_names[kpi],
.before = 1
)
df
}), .id = NULL)
# Create grouped display where KPI name appears only once per group
combined_df <- combined_df %>%
group_by(KPI) %>%
mutate(
KPI_display = if_else(row_number() == 1, KPI, "")
) %>%
ungroup() %>%
select(KPI_display, Level, Count, Percent) %>%
rename(KPI = KPI_display)
# Render as flextable with merged cells
ft <- flextable(combined_df) %>%
# set_caption("Combined KPI Summary Table") %>%
merge_v(j = "KPI") %>% # Merge vertically identical cells in KPI column
autofit()
# Add horizontal lines after each KPI group
kpi_groups <- sapply(names(summary_tables), function(kpi) nrow(summary_tables[[kpi]]))
cum_rows <- cumsum(kpi_groups)
for (i in seq_along(cum_rows)) {
if (i < length(cum_rows)) {
ft <- ft %>% hline(i = cum_rows[i], border = officer::fp_border(width = 2))
}
}
ft
```
## Field Alerts
```{r field_alerts_table, echo=FALSE}
# Generate alerts for all fields
generate_field_alerts <- function(field_details_table) {
if (is.null(field_details_table) || nrow(field_details_table) == 0) {
return(data.frame(Field = character(), Alert = character()))
}
alerts_list <- list()
# Get unique fields
unique_fields <- unique(field_details_table$Field)
for (field_name in unique_fields) {
field_data <- field_details_table %>% filter(Field == field_name)
# Aggregate data for the field
field_summary <- field_data %>%
summarise(
field_size = sum(`Field Size (ha)`, na.rm = TRUE),
uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"),
avg_yield_forecast = mean(`Yield Forecast (t/ha)`, na.rm = TRUE),
max_gap_score = max(`Gap Score`, na.rm = TRUE),
highest_decline_risk = case_when(
any(`Decline Risk` == "Very-high") ~ "Very-high",
any(`Decline Risk` == "High") ~ "High",
any(`Decline Risk` == "Moderate") ~ "Moderate",
any(`Decline Risk` == "Low") ~ "Low",
TRUE ~ "Unknown"
),
highest_weed_risk = case_when(
any(`Weed Risk` == "High") ~ "High",
any(`Weed Risk` == "Moderate") ~ "Moderate",
any(`Weed Risk` == "Low") ~ "Low",
TRUE ~ "Unknown"
),
avg_mean_ci = mean(`Mean CI`, na.rm = TRUE),
avg_cv = mean(`CV Value`, na.rm = TRUE),
.groups = 'drop'
)
# Generate alerts for this field based on simplified CV-Moran's I priority system (3 levels)
field_alerts <- c()
# Get CV and Moran's I values
avg_cv <- field_summary$avg_cv
morans_i <- mean(field_data[["Moran's I"]], na.rm = TRUE)
# Determine priority level (1=Urgent, 2=Monitor, 3=No stress)
priority_level <- get_field_priority_level(avg_cv, morans_i)
# Generate alerts based on priority level
if (priority_level == 1) {
field_alerts <- c(field_alerts, "⚠️ Priority field - recommend inspection")
} else if (priority_level == 2) {
field_alerts <- c(field_alerts, "💡 Monitor - check when convenient")
}
# Priority 3: No alert (no stress)
# Keep other alerts for decline risk, weed risk, gap score
if (field_summary$highest_decline_risk %in% c("High", "Very-high")) {
field_alerts <- c(field_alerts, "<22> Growth decline observed")
}
if (field_summary$highest_weed_risk == "High") {
field_alerts <- c(field_alerts, "🌿 Increased weed presence")
}
if (field_summary$max_gap_score > 20) {
field_alerts <- c(field_alerts, "◽ Gaps present - recommend review")
}
# Only add alerts if there are any (skip fields with no alerts)
if (length(field_alerts) > 0) {
# Add to alerts list
for (alert in field_alerts) {
alerts_list[[length(alerts_list) + 1]] <- data.frame(
Field = field_name,
Alert = alert
)
}
}
}
# Combine all alerts
if (length(alerts_list) > 0) {
alerts_df <- do.call(rbind, alerts_list)
return(alerts_df)
} else {
return(data.frame(Field = character(), Alert = character()))
}
}
# Generate and display alerts table
if (exists("field_details_table") && !is.null(field_details_table)) {
alerts_data <- generate_field_alerts(field_details_table)
if (nrow(alerts_data) > 0) {
ft <- flextable(alerts_data) %>%
# set_caption("Field Alerts Summary") %>%
autofit()
ft
} else {
cat("No alerts data available.\n")
}
} else {
cat("Field details data not available for alerts generation.\n")
}
```
```{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
# When one week has NA values, the difference will also be NA (not zero)
# Initialize placeholders first to ensure they exist
last_week_dif_raster_abs <- NULL
three_week_dif_raster_abs <- NULL
tryCatch({
# Always calculate differences - NA values will propagate naturally
# This way empty weeks (all NA) result in NA differences, not misleading zeros
last_week_dif_raster_abs <- (CI - CI_m1)
three_week_dif_raster_abs <- (CI - CI_m3)
safe_log("Calculated difference rasters (NA values preserved)")
}, error = function(e) {
safe_log(paste("Error calculating difference rasters:", e$message), "ERROR")
# Fallback: create NA placeholders if calculation fails
if (is.null(last_week_dif_raster_abs)) {
last_week_dif_raster_abs <- CI * NA
}
if (is.null(three_week_dif_raster_abs)) {
three_week_dif_raster_abs <- CI * NA
}
})
# Final safety check - ensure variables exist in global environment
if (is.null(last_week_dif_raster_abs)) {
last_week_dif_raster_abs <- CI * NA
safe_log("Created NA placeholder for last_week_dif_raster_abs", "WARNING")
}
if (is.null(three_week_dif_raster_abs)) {
three_week_dif_raster_abs <- CI * NA
safe_log("Created NA placeholder for three_week_dif_raster_abs", "WARNING")
}
```
```{r load_field_boundaries, message=TRUE, warning=TRUE, include=FALSE}
# Load field boundaries from parameters
tryCatch({
AllPivots0 <- field_boundaries_sf %>%
dplyr::filter(!is.na(field), !is.na(sub_field)) # Filter out NA field names
safe_log("Successfully loaded field boundaries")
# Prepare merged field list for use in summaries
AllPivots_merged <- AllPivots0 %>%
dplyr::filter(!is.na(field), !is.na(sub_field)) %>% # Filter out NA field names
dplyr::group_by(field) %>%
dplyr::summarise(.groups = 'drop')
}, error = function(e) {
stop("Error loading field boundaries: ", e$message)
})
```
\newpage
## Chlorophyll Index (CI) Overview Map - Current Week
```{r render_ci_overview_map, echo=FALSE, fig.height=7, fig.width=10, dpi=300, dev='png', message=FALSE, warning=FALSE}
# Create overview chlorophyll index map
tryCatch({
# Choose palette based on colorblind_friendly parameter
ci_palette <- if (colorblind_friendly) "viridis" else "brewer.rd_yl_gn"
# Base shape
map <- tmap::tm_shape(CI, unit = "m")
# Add raster layer with continuous spectrum (fixed scale 1-8 for consistent comparison)
map <- map + tmap::tm_raster(col.scale = tm_scale_continuous(values = ci_palette,
limits = c(1, 8)),
col.legend = tm_legend(title = "Chlorophyll Index (CI)",
orientation = "landscape",
position = tm_pos_out("center", "bottom")))
# Complete the map with layout and other elements
map <- map +
tmap::tm_scalebar(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "black") +
tmap::tm_text("sub_field", size = 0.6, col = "black")
# Print the map
print(map)
}, error = function(e) {
safe_log(paste("Error creating CI overview map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating CI overview map", cex=1.5)
})
```
\newpage
## Weekly Chlorophyll Index Difference Map
```{r render_ci_difference_map, echo=FALSE, fig.height=7, fig.width=10, dpi=300, dev='png', message=FALSE, warning=FALSE}
# Create chlorophyll index difference map
tryCatch({
# Choose palette based on colorblind_friendly parameter
diff_palette <- if (colorblind_friendly) "plasma" else "brewer.rd_yl_gn"
# Base shape
map <- tmap::tm_shape(last_week_dif_raster_abs, unit = "m")
# Add raster layer with continuous spectrum (centered at 0 for difference maps, fixed scale)
map <- map + tmap::tm_raster(col.scale = tm_scale_continuous(values = diff_palette,
midpoint = 0,
limits = c(-3, 3)),
col.legend = tm_legend(title = "Chlorophyll Index (CI) Change",
orientation = "landscape",
position = tm_pos_out("center", "bottom")))
# Complete the map with layout and other elements
map <- map +
tmap::tm_scalebar(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "black") +
tmap::tm_text("sub_field", size = 0.6, col = "black")
# Print the map
print(map)
}, error = function(e) {
safe_log(paste("Error creating CI difference map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating CI difference map", cex=1.5)
})
```
# Section 2: Field-by-Field Analysis
## Overview of Field-Level Insights
This section provides detailed, field-specific analyses including chlorophyll index maps, trend graphs, and performance metrics. Each field is analyzed individually to support targeted interventions.
**Key Elements per Field:**
- Current and historical CI maps
- Week-over-week change visualizations
- Cumulative growth trends
- Field-specific KPI summaries
*Navigate to the following pages for individual field reports.*
\newpage
```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=10, dpi=300, dev='png', message=FALSE,echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
# Generate detailed visualizations for each field
tryCatch({
# Merge field polygons for processing and filter out NA field names
AllPivots_merged <- AllPivots0 %>%
dplyr::filter(!is.na(field), !is.na(sub_field)) %>% # Filter out NA fields
dplyr::group_by(field) %>%
dplyr::summarise(.groups = 'drop')
# Generate plots for each field
for(i in seq_along(AllPivots_merged$field)) {
field_name <- AllPivots_merged$field[i]
# Skip if field_name is still NA (double check)
if(is.na(field_name)) {
next
}
tryCatch({
# Add page break before each field (except the first one)
if(i > 1) {
cat("\\newpage\n\n")
}
# Call ci_plot with explicit parameters (ci_plot will generate its own header)
ci_plot(
pivotName = field_name,
field_boundaries = AllPivots0,
current_ci = CI,
ci_minus_1 = CI_m1,
ci_minus_2 = CI_m2,
last_week_diff = last_week_dif_raster_abs,
three_week_diff = three_week_dif_raster_abs,
harvesting_data = harvesting_data,
week = week,
week_minus_1 = week_minus_1,
week_minus_2 = week_minus_2,
week_minus_3 = week_minus_3,
borders = borders,
colorblind_friendly = colorblind_friendly
)
cat("\n\n")
# Special handling for ESA project field 00f25 - remove duplicate DOY values
if (project_dir == "esa" && field_name == "00F25") {
ci_quadrant_data <- CI_quadrant %>%
filter(field == "00F25") %>%
arrange(DOY) %>%
group_by(DOY) %>%
slice(1) %>%
ungroup()
} else {
ci_quadrant_data <- CI_quadrant
}
# Call cum_ci_plot with explicit parameters
cum_ci_plot(
pivotName = field_name,
ci_quadrant_data = ci_quadrant_data,
plot_type = ci_plot_type,
facet_on = facet_by_season,
x_unit = x_axis_unit,
colorblind_friendly = colorblind_friendly,
show_benchmarks = TRUE,
estate_name = project_dir,
benchmark_percentiles = c(10, 50, 90),
benchmark_data = benchmarks
)
cat("\n\n")
# Add field-specific KPI summary under the graphs
if (exists("field_details_table") && !is.null(field_details_table)) {
kpi_summary <- generate_field_kpi_summary(field_name, field_details_table, CI_quadrant)
cat(kpi_summary)
cat("\n\n")
}
}, error = function(e) {
safe_log(paste("Error generating plots for field", field_name, ":", e$message), "ERROR")
cat("\\newpage\n\n")
cat("# Error generating plots for field ", field_name, "\n\n")
cat(e$message, "\n\n")
})
}
}, error = function(e) {
safe_log(paste("Error in field visualization section:", e$message), "ERROR")
cat("Error generating field plots. See log for details.\n\n")
})
```
```{r generate_subarea_visualizations, echo=FALSE, fig.height=3.8, fig.width=10, message=FALSE, warning=FALSE, results='asis', eval=FALSE}
# Alternative visualization grouped by sub-area (disabled by default)
tryCatch({
# Group pivots by sub-area
pivots_grouped <- AllPivots0
# Iterate over each subgroup
for (subgroup in unique(pivots_grouped$sub_area)) {
# Add subgroup heading
cat("\n")
cat("## Subgroup: ", subgroup, "\n")
# Filter data for current subgroup
subset_data <- dplyr::filter(pivots_grouped, sub_area == subgroup)
# Generate visualizations for each field in the subgroup
purrr::walk(subset_data$field, function(field_name) {
cat("\n")
ci_plot(field_name)
cat("\n")
cum_ci_plot(field_name)
cat("\n")
})
# Add page break after each subgroup
cat("\\newpage\n")
}
}, error = function(e) {
safe_log(paste("Error in subarea visualization section:", e$message), "ERROR")
cat("Error generating subarea plots. See log for details.\n")
})
```
## KPI Summary by Field
## Detailed Field Performance Summary
The following table provides a comprehensive overview of all monitored fields with their key performance metrics from the KPI analysis.
```{r detailed_field_table, echo=FALSE}
# Load CI quadrant data to get field ages
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
# Identify the current season for each field based on report_date
# The current season is the one where the report_date falls within or shortly after the season
report_date_obj <- as.Date(report_date)
current_seasons <- CI_quadrant %>%
filter(Date <= report_date_obj) %>%
group_by(field, season) %>%
summarise(
season_start = min(Date),
season_end = max(Date),
.groups = 'drop'
) %>%
group_by(field) %>%
filter(season == max(season)) %>% # Take the most recent season
select(field, season)
# Get current field ages (most recent DOY for each field in their CURRENT SEASON only)
field_ages <- CI_quadrant %>%
inner_join(current_seasons, by = c("field", "season")) %>% # Filter to current season only
group_by(field) %>%
filter(DOY == max(DOY)) %>%
select(field, DOY) %>%
rename(Field = field, Age_days = DOY)
# Clean up the field details table - remove sub field column and round numeric values
field_details_clean <- field_details_table %>%
left_join(field_ages, by = "Field") %>%
mutate(
`Yield Forecast (t/ha)` = ifelse(is.na(Age_days) | Age_days < 240, NA_real_, `Yield Forecast (t/ha)`)
) %>%
select(Field, `Field Size (ha)`, `Growth Uniformity`, `Yield Forecast (t/ha)`, `Gap Score`, `Decline Risk`, `Weed Risk`, `Mean CI`, `CV Value`) %>% # Reorder columns as requested
mutate(
`Mean CI` = round(`Mean CI`, 2), # Round to 2 decimal places
`CV Value` = round(`CV Value`, 2), # Round to 2 decimal places
`Gap Score` = round(`Gap Score`, 0) # Round to nearest integer
)
# Display the cleaned field table with flextable
ft <- flextable(field_details_clean) %>%
set_caption("Detailed Field Performance Summary") %>%
autofit()
ft
```
\newpage
# Section 3: Report Methodology and Definitions
## About This Report
This automated report provides weekly analysis of sugarcane crop health using satellite-derived Chlorophyll Index (CI) measurements. The analysis supports:
• Scouting of growth related issues that are in need of attention
• Timely actions can be taken such that negative impact is reduced
• Monitoring of the crop growth rates of the farm, providing evidence of performance
• Planning of harvest moment and mill logistics is supported such that optimal tonnage and sucrose levels can be harvested.
The base of the report is the Chlorophyll Index. The chlorophyll index identifies:
• Field-level crop health variations => target problem area's
• Weekly changes in crop vigor => scout for diseases and stress
• Areas requiring attention by the agricultural and irrigation teams
• Growth patterns across different field sections
Key Features: - High-resolution satellite imagery analysis - Week-over-week change detection - Individual field performance metrics - Actionable insights for crop management
### Explanation of the Report
This report provides a detailed analysis (3x3m of resolution) of your sugarcane fields based on satellite imagery. It supports 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.
![Chlorophyll Index Example](CI_graph_example.png)
### What You'll Find in This Report:
1. **Key Performance Indicators (KPIs):**
The report provides a farm-wide analysis based on the Chlorophyll Index (CI) changes. KPIs are calculated field by field and summarized in tables. The current KPIs included are:
- **Field Uniformity:** Assesses the consistency of crop growth within each field using the coefficient of variation (CV) of CI values. Uniformity levels are classified as:
- **Excellent:** CV < 0.08 (very uniform growth)
- **Good:** CV < 0.15 (acceptable uniformity)
- **Moderate:** CV < 0.25 (some variation present)
- **Poor:** CV ≥ 0.25 (high variation - investigate irrigation, fertility, or pests)
- **Area Change:** Summarizes the proportion of field area that is improving, stable, or declining week-over-week, based on CI changes. Helps identify fields requiring immediate attention.
- **TCH Forecasted:** Provides yield predictions (tons cane per hectare) for mature fields (typically over 240 days old), using a machine learning model trained on historical CI and yield data. Helps plan harvest timing and logistics.
- **Weed Presence Score:** Detects rapid CI increases between weeks as a proxy for weed outbreaks in young fields (< 8 months old). After 8 months, canopy closure prevents weed growth. Risk levels based on percentage of pixels showing rapid growth (> 2.0 CI units increase):
- **Low:** < 10% of field area (minimal weed presence)
- **Moderate:** 1025% (monitor and scout)
- **High:** > 25% (requires immediate intervention)
- **Note:** Mature fields (≥ 8 months) show "Canopy closed - Low weed risk" as the closed canopy suppresses weed growth.
- **Gap Filling Score:** Indicates the proportion of a field with low CI values (lowest 25% of the distribution), highlighting areas with poor crop establishment or gaps that may need replanting.
2. **Overview Map: Growth on Farm:**
Provides a traffic light overview of field-by-field growth status for quick prioritization and reporting.
3. **Chlorophyll Index Overview Map:**
Shows current CI values for all fields, helping to identify high- and low-performing areas.
4. **Field-by-Field Analysis:**
Includes detailed maps, trend graphs, and performance metrics for each field.
5. **Yield Prediction:**
For mature crops (over 240 days), yield is predicted using current and historical CI data.
6. **Farm Overview Table:**
Presents numerical field-level results for all KPIs.
---
### Historical Benchmark Lines
The CI time series graphs include historical benchmark lines for the 10th, 50th, and 90th percentiles of CI values across all fields and seasons.
**Note:** These lines are now all rendered as solid lines (not dashed or dotted), with different colors for each percentile.
- **10th Percentile:** Lower end of historical performance
- **50th Percentile:** Median historical performance
- **90th Percentile:** Upper end of historical performance
Comparing the current season to these lines helps assess whether crop growth is below, at, or above historical norms.
\newpage
## Report Metadata
```{r report_metadata, echo=FALSE}
metadata_info <- data.frame(
Metric = c("Report Generated", "Data Source", "Analysis Period", "Total Fields", "Next Update"),
Value = c(
format(Sys.time(), "%Y-%m-%d %H:%M:%S"),
paste("Project", toupper(project_dir)),
paste("Week", current_week, "of", year),
ifelse(exists("AllPivots0"), nrow(AllPivots0 %>% filter(!is.na(field)) %>% group_by(field) %>% summarise()), "Unknown"),
"Next Wednesday"
)
)
ft <- flextable(metadata_info) %>%
set_caption("Report Metadata") %>%
autofit()
ft
```
*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team.*
```