removed emoticons
This commit is contained in:
parent
fde60cbbdf
commit
3fe1cf8638
|
|
@ -2,7 +2,7 @@
|
|||
params:
|
||||
ref: "word-styles-reference-var1.docx"
|
||||
output_file: CI_report.docx
|
||||
report_date: "2025-09-30"
|
||||
report_date: "2026-01-22"
|
||||
data_dir: "aura"
|
||||
mail_day: "Wednesday"
|
||||
borders: FALSE
|
||||
|
|
@ -261,10 +261,10 @@ generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadr
|
|||
}
|
||||
|
||||
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)
|
||||
"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
|
||||
|
|
@ -561,21 +561,21 @@ generate_field_alerts <- function(field_details_table) {
|
|||
|
||||
# Generate alerts based on priority level
|
||||
if (priority_level == 1) {
|
||||
field_alerts <- c(field_alerts, "⚠️ Priority field - recommend inspection")
|
||||
field_alerts <- c(field_alerts, "Priority field - recommend inspection")
|
||||
} else if (priority_level == 2) {
|
||||
field_alerts <- c(field_alerts, "💡 Monitor - check when convenient")
|
||||
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, "<EFBFBD> Growth decline observed")
|
||||
field_alerts <- c(field_alerts, "Growth decline observed")
|
||||
}
|
||||
if (field_summary$highest_weed_risk == "High") {
|
||||
field_alerts <- c(field_alerts, "🌿 Increased weed presence")
|
||||
field_alerts <- c(field_alerts, "Increased weed presence")
|
||||
}
|
||||
if (field_summary$max_gap_score > 20) {
|
||||
field_alerts <- c(field_alerts, "◽ Gaps present - recommend review")
|
||||
field_alerts <- c(field_alerts, "Gaps present - recommend review")
|
||||
}
|
||||
|
||||
# Only add alerts if there are any (skip fields with no alerts)
|
||||
|
|
|
|||
584
r_app/90_CI_report_with_kpis_simple_NO_TABLES.Rmd
Normal file
584
r_app/90_CI_report_with_kpis_simple_NO_TABLES.Rmd
Normal file
|
|
@ -0,0 +1,584 @@
|
|||
---
|
||||
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)
|
||||
library(officer)
|
||||
})
|
||||
|
||||
# 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 - NO TABLES VERSION")
|
||||
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"))
|
||||
current_year <- as.numeric(format(as.Date(report_date), "%G"))
|
||||
week_suffix <- paste0("week", sprintf("%02d", current_week), "_", current_year)
|
||||
|
||||
# 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)
|
||||
)
|
||||
|
||||
kpi_text <- paste0("<span style='font-size:10pt'>", kpi_text, "</span>")
|
||||
|
||||
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 quadrant data for field-level analysis
|
||||
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)
|
||||
})
|
||||
|
||||
# NOTE: Overview maps skipped for this report
|
||||
# Individual field sections load their own per-field mosaics directly
|
||||
```
|
||||
```
|
||||
|
||||
```{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")`
|
||||
|
||||
**NOTE: THIS IS A NO-TABLES VERSION FOR DIAGNOSTIC PURPOSES - MAPS AND GRAPHS ONLY**
|
||||
|
||||
\newpage
|
||||
|
||||
# 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 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)
|
||||
})
|
||||
```
|
||||
|
||||
```{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')
|
||||
|
||||
# Use per-field weekly mosaic directory path from parameters_project.R
|
||||
weekly_mosaic_per_field_dir <- weekly_CI_mosaic
|
||||
|
||||
# Helper to get week/year from a date
|
||||
get_week_year <- function(date) {
|
||||
list(
|
||||
week = as.numeric(format(date, "%V")),
|
||||
year = as.numeric(format(date, "%G"))
|
||||
)
|
||||
}
|
||||
|
||||
# Get week/year for current and historical weeks (local to field section)
|
||||
current_ww <- get_week_year(as.Date(today))
|
||||
minus_1_ww <- get_week_year(as.Date(today) - lubridate::weeks(1))
|
||||
minus_2_ww <- get_week_year(as.Date(today) - lubridate::weeks(2))
|
||||
minus_3_ww <- get_week_year(as.Date(today) - lubridate::weeks(3))
|
||||
|
||||
# Debug: check how many fields we're iterating
|
||||
safe_log(paste("Starting visualization loop for", nrow(AllPivots_merged), "fields"), "DEBUG")
|
||||
safe_log(paste("Fields to process:", paste(AllPivots_merged$field, collapse=", ")), "DEBUG")
|
||||
|
||||
# Generate plots for each field
|
||||
for(i in seq_along(AllPivots_merged$field)) {
|
||||
field_name <- AllPivots_merged$field[i]
|
||||
safe_log(paste("Processing field", i, "of", nrow(AllPivots_merged), ":", field_name), "DEBUG")
|
||||
|
||||
# Skip if field_name is still NA (double check)
|
||||
if(is.na(field_name)) {
|
||||
safe_log(paste("Skipping field", i, "- NA name"), "DEBUG")
|
||||
next
|
||||
}
|
||||
|
||||
tryCatch({
|
||||
# Add page break before each field (except the first one)
|
||||
if(i > 1) {
|
||||
cat("\\newpage\n\n")
|
||||
}
|
||||
|
||||
# Load per-field mosaics directly for this field
|
||||
field_CI <- NULL
|
||||
field_CI_m1 <- NULL
|
||||
field_CI_m2 <- NULL
|
||||
field_CI_m3 <- NULL
|
||||
|
||||
tryCatch({
|
||||
# Load per-field mosaic for current week
|
||||
per_field_path_current <- get_per_field_mosaic_path(
|
||||
weekly_mosaic_per_field_dir, field_name, current_ww$week, current_ww$year
|
||||
)
|
||||
safe_log(paste("Looking for mosaic at:", per_field_path_current, "exists?", file.exists(per_field_path_current %||% "")), "DEBUG")
|
||||
if (!is.null(per_field_path_current) && file.exists(per_field_path_current)) {
|
||||
field_CI <- terra::rast(per_field_path_current)[["CI"]]
|
||||
safe_log(paste("Successfully loaded field_CI for", field_name), "DEBUG")
|
||||
} else {
|
||||
safe_log(paste("Could not load field_CI for", field_name, "- file not found"), "DEBUG")
|
||||
}
|
||||
|
||||
# Load per-field mosaic for week-1
|
||||
per_field_path_m1 <- get_per_field_mosaic_path(
|
||||
weekly_mosaic_per_field_dir, field_name, minus_1_ww$week, minus_1_ww$year
|
||||
)
|
||||
if (!is.null(per_field_path_m1) && file.exists(per_field_path_m1)) {
|
||||
field_CI_m1 <- terra::rast(per_field_path_m1)[["CI"]]
|
||||
}
|
||||
|
||||
# Load per-field mosaic for week-2
|
||||
per_field_path_m2 <- get_per_field_mosaic_path(
|
||||
weekly_mosaic_per_field_dir, field_name, minus_2_ww$week, minus_2_ww$year
|
||||
)
|
||||
if (!is.null(per_field_path_m2) && file.exists(per_field_path_m2)) {
|
||||
field_CI_m2 <- terra::rast(per_field_path_m2)[["CI"]]
|
||||
}
|
||||
|
||||
# Load per-field mosaic for week-3
|
||||
per_field_path_m3 <- get_per_field_mosaic_path(
|
||||
weekly_mosaic_per_field_dir, field_name, minus_3_ww$week, minus_3_ww$year
|
||||
)
|
||||
if (!is.null(per_field_path_m3) && file.exists(per_field_path_m3)) {
|
||||
field_CI_m3 <- terra::rast(per_field_path_m3)[["CI"]]
|
||||
}
|
||||
|
||||
safe_log(paste("Loaded per-field mosaics for", field_name), "DEBUG")
|
||||
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Could not load per-field mosaics for", field_name, ":", e$message), "WARNING")
|
||||
})
|
||||
|
||||
# Calculate difference rasters from per-field data (local to this field)
|
||||
last_week_dif_raster_field <- NULL
|
||||
three_week_dif_raster_field <- NULL
|
||||
|
||||
if (!is.null(field_CI) && !is.null(field_CI_m1)) {
|
||||
last_week_dif_raster_field <- field_CI - field_CI_m1
|
||||
}
|
||||
if (!is.null(field_CI) && !is.null(field_CI_m3)) {
|
||||
three_week_dif_raster_field <- field_CI - field_CI_m3
|
||||
}
|
||||
|
||||
# Call ci_plot with field-specific rasters
|
||||
ci_plot(
|
||||
pivotName = field_name,
|
||||
field_boundaries = AllPivots0,
|
||||
current_ci = field_CI,
|
||||
ci_minus_1 = field_CI_m1,
|
||||
ci_minus_2 = field_CI_m2,
|
||||
last_week_diff = last_week_dif_raster_field,
|
||||
three_week_diff = three_week_dif_raster_field,
|
||||
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")
|
||||
})
|
||||
```
|
||||
|
||||
\newpage
|
||||
|
||||
# END OF NO-TABLES DIAGNOSTIC REPORT
|
||||
|
||||
This diagnostic report contains only maps and graphs to help identify if the visualization system is working correctly.
|
||||
|
||||
*Generated for diagnostic purposes*
|
||||
|
|
@ -334,10 +334,10 @@ generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadr
|
|||
}
|
||||
|
||||
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)
|
||||
"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
|
||||
|
|
@ -690,13 +690,13 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
|
|||
alerts_data <- alerts_data %>%
|
||||
mutate(
|
||||
Alert = case_when(
|
||||
Alert == "germination_started" ~ "🌱 Germination started - crop emerging",
|
||||
Alert == "germination_complete" ~ "✓ Germination complete - established",
|
||||
Alert == "stress_detected_whole_field" ~ "🚨 Stress detected - check irrigation/disease",
|
||||
Alert == "strong_recovery" ~ "📈 Strong recovery - growth accelerating",
|
||||
Alert == "growth_on_track" ~ "✓ Growth on track - normal progression",
|
||||
Alert == "maturation_progressing" ~ "🌾 Maturation progressing - ripening phase",
|
||||
Alert == "harvest_ready" ~ "✂️ Harvest ready - 45+ weeks old",
|
||||
Alert == "germination_started" ~ "Germination started - crop emerging",
|
||||
Alert == "germination_complete" ~ "Germination complete - established",
|
||||
Alert == "stress_detected_whole_field" ~ "Stress detected - check irrigation/disease",
|
||||
Alert == "strong_recovery" ~ "Strong recovery - growth accelerating",
|
||||
Alert == "growth_on_track" ~ "Growth on track - normal progression",
|
||||
Alert == "maturation_progressing" ~ "Maturation progressing - ripening phase",
|
||||
Alert == "harvest_ready" ~ "Harvest ready - 45+ weeks old",
|
||||
TRUE ~ Alert
|
||||
)
|
||||
)
|
||||
|
|
|
|||
Loading…
Reference in a new issue