Timon
d5fd4bb463
Major Changes: - NEW: Scripts 09 & 10 for KPI calculation and enhanced reporting - NEW: Shell script wrappers (01-10) for easier execution - NEW: R packages flextable and officer for enhanced Word reports - NEW: DEPLOYMENT_README.md with complete deployment guide - RENAMED: Numbered R scripts (02, 03, 04) for clarity - REMOVED: Old package management scripts (using renv only) - UPDATED: Workflow now uses scripts 09->10 instead of 05 Files Changed: 90+ files New Packages: flextable, officer New Scripts: 09_run_calculate_kpis.sh, 10_run_kpi_report.sh Documentation: DEPLOYMENT_README.md, EMAIL_TO_ADMIN.txt See DEPLOYMENT_README.md for full deployment instructions.
294 lines
12 KiB
Plaintext
294 lines
12 KiB
Plaintext
# 06_CROP_MESSAGING.R
|
|
# ===================
|
|
# This script analyzes weekly CI mosaics to detect changes and generate automated messages
|
|
# about crop conditions. It compares two weeks of data to assess:
|
|
# - Field uniformity (high vs low variation)
|
|
# - CI change trends (increase, stable, decrease)
|
|
# - Generates contextual messages based on analysis
|
|
# - Outputs results in multiple formats: WhatsApp/Word text, CSV, and .docx
|
|
#
|
|
# Usage: Rscript 06_crop_messaging.R [current_week] [previous_week] [estate_name]
|
|
# - current_week: Current week number (e.g., 30)
|
|
# - previous_week: Previous week number (e.g., 29)
|
|
# - estate_name: Estate name (e.g., "simba", "chemba")
|
|
#
|
|
# Examples:
|
|
# Rscript 06_crop_messaging.R 32 31 simba
|
|
# Rscript 06_crop_messaging.R 30 29 chemba
|
|
#
|
|
# The script automatically:
|
|
# 1. Loads the correct estate configuration
|
|
# 2. Analyzes weekly mosaics
|
|
# 3. Generates field-by-field analysis
|
|
# 4. Creates output files in multiple formats
|
|
# 5. Displays WhatsApp-ready text in console
|
|
#
|
|
|
|
# 1. Load required packages
|
|
# -----------------------
|
|
suppressPackageStartupMessages({
|
|
library(sf)
|
|
library(terra)
|
|
library(tidyverse)
|
|
library(lubridate)
|
|
library(here)
|
|
library(spdep) # For spatial statistics
|
|
})
|
|
|
|
# 2. Main function to handle messaging workflow
|
|
# ---------------------------------------------
|
|
main <- function() {
|
|
# Capture command line arguments
|
|
args <- commandArgs(trailingOnly = TRUE)
|
|
|
|
# Process arguments with defaults
|
|
current_week <- if (length(args) >= 1 && !is.na(args[1])) {
|
|
as.numeric(args[1])
|
|
} else {
|
|
39 # Default for proof of concept
|
|
}
|
|
|
|
previous_week <- if (length(args) >= 2 && !is.na(args[2])) {
|
|
as.numeric(args[2])
|
|
} else {
|
|
38 # Default for proof of concept
|
|
}
|
|
|
|
estate_name <- if (length(args) >= 3 && !is.na(args[3])) {
|
|
as.character(args[3])
|
|
} else {
|
|
"aura" # Default estate
|
|
}
|
|
|
|
year <- 2025 # Current year - could be made dynamic
|
|
|
|
# Make estate_name available globally so parameters_project.R can use it
|
|
assign("project_dir", estate_name, envir = .GlobalEnv)
|
|
|
|
# Initialize project configuration and load utility functions
|
|
tryCatch({
|
|
source("parameters_project.R")
|
|
source("crop_messaging_utils.R")
|
|
}, error = function(e) {
|
|
warning("Default source files not found. Attempting to source from 'r_app' directory.")
|
|
tryCatch({
|
|
source(here::here("r_app", "parameters_project.R"))
|
|
source(here::here("r_app", "crop_messaging_utils.R"))
|
|
warning(paste("Successfully sourced files from 'r_app' directory."))
|
|
|
|
}, error = function(e) {
|
|
stop("Failed to source required files from both default and 'r_app' directories.")
|
|
})
|
|
})
|
|
|
|
log_message("Starting crop messaging analysis")
|
|
|
|
# Run the modular analysis
|
|
analysis_results <- run_estate_analysis(estate_name, current_week, previous_week, year)
|
|
field_results <- analysis_results$field_results
|
|
|
|
# Display detailed field-by-field analysis
|
|
cat("=== FIELD-BY-FIELD ANALYSIS ===\n\n")
|
|
|
|
for (field_id in names(field_results)) {
|
|
field_info <- field_results[[field_id]]
|
|
current_field <- field_info$current_stats
|
|
previous_field <- field_info$previous_stats
|
|
ci_change <- field_info$ci_change
|
|
change_category <- field_info$change_category
|
|
change_percentages <- field_info$change_percentages
|
|
uniformity_category <- field_info$uniformity_category
|
|
message_result <- field_info$message_result
|
|
|
|
# Print enhanced field analysis
|
|
cat("FIELD:", current_field$field, "-", current_field$sub_field, "\n")
|
|
cat("- Field size:", round(current_field$field_area_ha, 1), "hectares\n")
|
|
cat("- Week", previous_week, "CI:", round(previous_field$mean_ci, 3), "\n")
|
|
cat("- Week", current_week, "CI:", round(current_field$mean_ci, 3), "\n")
|
|
cat("- Terra stats: Mean =", round(current_field$mean_ci, 3),
|
|
", CV =", round(current_field$cv, 3),
|
|
", Range = [", round(current_field$min_ci, 2), "-", round(current_field$max_ci, 2), "]\n")
|
|
|
|
cat("- Within acceptable range (±25% of mean):", round(current_field$acceptable_pct, 1), "%\n")
|
|
|
|
# Display primary uniformity metrics (CV and Entropy)
|
|
cat("- Field uniformity: CV =", round(current_field$cv, 3))
|
|
if (current_field$cv < 0.08) {
|
|
cat(" (excellent)")
|
|
} else if (current_field$cv < 0.15) {
|
|
cat(" (good)")
|
|
} else if (current_field$cv < 0.30) {
|
|
cat(" (moderate)")
|
|
} else if (current_field$cv < 0.50) {
|
|
cat(" (high variation)")
|
|
} else {
|
|
cat(" (very high variation)")
|
|
}
|
|
|
|
# Add entropy information
|
|
if (!is.na(current_field$entropy)) {
|
|
cat(", Entropy =", round(current_field$entropy, 3))
|
|
# Entropy interpretation (higher = more heterogeneous)
|
|
# Adjusted thresholds to better match CV patterns
|
|
if (current_field$entropy < 1.3) {
|
|
cat(" (very uniform)")
|
|
} else if (current_field$entropy < 1.5) {
|
|
cat(" (uniform)")
|
|
} else if (current_field$entropy < 1.7) {
|
|
cat(" (moderate heterogeneity)")
|
|
} else {
|
|
cat(" (high heterogeneity)")
|
|
}
|
|
}
|
|
cat("\n")
|
|
|
|
cat("- Change: Mean =", round(ci_change, 3), "(", change_category, ")")
|
|
if (!is.na(change_percentages$positive_pct)) {
|
|
# Calculate hectares for this field using field area from geojson
|
|
field_hectares <- current_field$field_area_ha
|
|
improving_hectares <- (change_percentages$positive_pct / 100) * field_hectares
|
|
declining_hectares <- (change_percentages$negative_pct / 100) * field_hectares
|
|
|
|
cat(", Areas: ", round(change_percentages$positive_pct, 1), "% (", round(improving_hectares, 1), " ha) improving, ",
|
|
round(change_percentages$negative_pct, 1), "% (", round(declining_hectares, 1), " ha) declining\n")
|
|
} else {
|
|
cat("\n")
|
|
}
|
|
cat("- Spatial Pattern:", uniformity_category, "\n")
|
|
|
|
# Add spatial details if available
|
|
if (!is.na(current_field$spatial_autocorr$morans_i)) {
|
|
cat("- Moran's I:", round(current_field$spatial_autocorr$morans_i, 3),
|
|
"(", current_field$spatial_autocorr$interpretation, ")")
|
|
|
|
# Add agricultural context explanation for Moran's I
|
|
moran_val <- current_field$spatial_autocorr$morans_i
|
|
if (moran_val >= 0.7 && moran_val < 0.85) {
|
|
cat(" - normal field continuity")
|
|
} else if (moran_val >= 0.85 && moran_val < 0.95) {
|
|
cat(" - strong spatial pattern")
|
|
} else if (moran_val >= 0.95) {
|
|
cat(" - very strong clustering, monitor for management issues")
|
|
} else if (moran_val < 0.7 && moran_val > 0.3) {
|
|
cat(" - moderate spatial pattern")
|
|
} else {
|
|
cat(" - unusual spatial pattern for crop field")
|
|
}
|
|
cat("\n")
|
|
}
|
|
|
|
if (!is.na(current_field$extreme_percentages$hotspot_pct)) {
|
|
cat("- Extreme areas: ", round(current_field$extreme_percentages$hotspot_pct, 1),
|
|
"% hotspots (high-performing), ", round(current_field$extreme_percentages$coldspot_pct, 1),
|
|
"% coldspots (underperforming)")
|
|
|
|
# Show method used for extreme detection
|
|
if (!is.null(current_field$extreme_percentages$method)) {
|
|
if (current_field$extreme_percentages$method == "getis_ord_gi_star") {
|
|
cat(" [Getis-Ord Gi*]")
|
|
} else if (current_field$extreme_percentages$method == "simple_sd") {
|
|
cat(" [Simple SD]")
|
|
}
|
|
}
|
|
cat("\n")
|
|
}
|
|
|
|
cat("- Message:", message_result$message, "\n")
|
|
cat("- Alert needed:", if(message_result$worth_sending) "YES 🚨" else "NO", "\n\n")
|
|
}
|
|
|
|
# Summary of alerts
|
|
alert_fields <- sapply(field_results, function(x) x$message_result$worth_sending)
|
|
total_alerts <- sum(alert_fields)
|
|
|
|
cat("=== SUMMARY ===\n")
|
|
cat("Total fields analyzed:", length(field_results), "\n")
|
|
cat("Fields requiring alerts:", total_alerts, "\n")
|
|
|
|
if (total_alerts > 0) {
|
|
cat("\nFields needing attention:\n")
|
|
for (field_id in names(field_results)[alert_fields]) {
|
|
field_info <- field_results[[field_id]]
|
|
cat("-", field_info$current_stats$field, "-", field_info$current_stats$sub_field,
|
|
":", field_info$message_result$message, "\n")
|
|
}
|
|
}
|
|
|
|
# Farm-wide analysis summary table
|
|
cat("\n=== FARM-WIDE ANALYSIS SUMMARY ===\n")
|
|
|
|
# Field uniformity statistics with detailed categories
|
|
excellent_fields <- sapply(field_results, function(x) x$current_stats$cv <= 0.08)
|
|
good_fields <- sapply(field_results, function(x) x$current_stats$cv > 0.08 & x$current_stats$cv <= 0.15)
|
|
moderate_fields <- sapply(field_results, function(x) x$current_stats$cv > 0.15 & x$current_stats$cv <= 0.30)
|
|
poor_fields <- sapply(field_results, function(x) x$current_stats$cv > 0.30)
|
|
|
|
n_excellent <- sum(excellent_fields)
|
|
n_good <- sum(good_fields)
|
|
n_moderate <- sum(moderate_fields)
|
|
n_poor <- sum(poor_fields)
|
|
n_uniform_total <- n_excellent + n_good # Total uniform fields (CV ≤ 0.20)
|
|
|
|
# Calculate farm-wide area statistics
|
|
total_hectares <- sum(sapply(field_results, function(x) x$current_stats$field_area_ha), na.rm = TRUE)
|
|
total_improving_hectares <- sum(sapply(field_results, function(x) {
|
|
if (!is.na(x$change_percentages$positive_pct)) {
|
|
(x$change_percentages$positive_pct / 100) * x$current_stats$field_area_ha
|
|
} else 0
|
|
}), na.rm = TRUE)
|
|
|
|
total_declining_hectares <- sum(sapply(field_results, function(x) {
|
|
if (!is.na(x$change_percentages$negative_pct)) {
|
|
(x$change_percentages$negative_pct / 100) * x$current_stats$field_area_ha
|
|
} else 0
|
|
}), na.rm = TRUE)
|
|
|
|
# Calculate farm-wide percentages
|
|
farm_improving_pct <- (total_improving_hectares / total_hectares) * 100
|
|
farm_declining_pct <- (total_declining_hectares / total_hectares) * 100
|
|
|
|
# Display summary table
|
|
cat("\nFIELD UNIFORMITY SUMMARY:\n")
|
|
cat("│ Uniformity Level │ Count │ Percent │\n")
|
|
cat(sprintf("│ Excellent (CV≤0.08) │ %5d │ %6.1f%% │\n", n_excellent, (n_excellent/length(field_results))*100))
|
|
cat(sprintf("│ Good (CV 0.08-0.15) │ %5d │ %6.1f%% │\n", n_good, (n_good/length(field_results))*100))
|
|
cat(sprintf("│ Moderate (CV 0.15-0.30) │ %5d │ %6.1f%% │\n", n_moderate, (n_moderate/length(field_results))*100))
|
|
cat(sprintf("│ Poor (CV>0.30) │ %5d │ %6.1f%% │\n", n_poor, (n_poor/length(field_results))*100))
|
|
cat(sprintf("│ Total fields │ %5d │ %6.1f%% │\n", length(field_results), 100.0))
|
|
|
|
cat("\nFARM-WIDE AREA CHANGE SUMMARY:\n")
|
|
cat("│ Change Type │ Hectares│ Percent │\n")
|
|
cat(sprintf("│ Improving areas │ %7.1f │ %6.1f%% │\n", total_improving_hectares, farm_improving_pct))
|
|
cat(sprintf("│ Declining areas │ %7.1f │ %6.1f%% │\n", total_declining_hectares, farm_declining_pct))
|
|
cat(sprintf("│ Total area │ %7.1f │ %6.1f%% │\n", total_hectares, 100.0))
|
|
|
|
# Additional insights
|
|
cat("\nKEY INSIGHTS:\n")
|
|
cat(sprintf("• %d%% of fields have good uniformity (CV ≤ 0.15)\n", round((n_uniform_total/length(field_results))*100)))
|
|
cat(sprintf("• %d%% of fields have excellent uniformity (CV ≤ 0.08)\n", round((n_excellent/length(field_results))*100)))
|
|
cat(sprintf("• %.1f hectares (%.1f%%) of farm area is improving week-over-week\n", total_improving_hectares, farm_improving_pct))
|
|
cat(sprintf("• %.1f hectares (%.1f%%) of farm area is declining week-over-week\n", total_declining_hectares, farm_declining_pct))
|
|
cat(sprintf("• Total farm area analyzed: %.1f hectares\n", total_hectares))
|
|
if (farm_improving_pct > farm_declining_pct) {
|
|
cat(sprintf("• Overall trend: POSITIVE (%.1f%% more area improving than declining)\n", farm_improving_pct - farm_declining_pct))
|
|
} else if (farm_declining_pct > farm_improving_pct) {
|
|
cat(sprintf("• Overall trend: NEGATIVE (%.1f%% more area declining than improving)\n", farm_declining_pct - farm_improving_pct))
|
|
} else {
|
|
cat("• Overall trend: BALANCED (equal improvement and decline)\n")
|
|
}
|
|
|
|
# Generate and save multiple output formats
|
|
saved_files <- save_analysis_outputs(analysis_results)
|
|
|
|
# Analysis complete
|
|
cat("\n=== ANALYSIS COMPLETE ===\n")
|
|
cat("All field analysis results, farm-wide summary, and output files created.\n")
|
|
|
|
# Return results for potential further processing
|
|
invisible(analysis_results)
|
|
}
|
|
|
|
if (sys.nframe() == 0) {
|
|
main()
|
|
}
|