Timon/SmartCane
1
1
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Refactor KPI reporting and status alert logic; streamline directory structure for KPI reports and enhance field analysis summaries with additional metrics and alerts.

Browse source
This commit is contained in:
Timon 2026-02-18 12:02:25 +01:00
parent f1821dab59
commit b2d4093601
4 changed files with 226 additions and 102 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
r_app/80_utils_cane_supply.R
View file

@ -145,33 +145,68 @@ categorize_cv_trend_long_term <- function(cv_slope) {
}
}
#' Determine status alert based on harvest probability and crop health
#' Determine status alert for CANE_SUPPLY client (harvest/milling workflow)
#'
#' Alerts focus on: harvest readiness, crop health monitoring, exception detection
#' Uses WEEKLY trends (Four_week_trend) not daily noise for consistency
#' Designed for harvest/milling clients who manage expectation, not daily operations
#'
#' Priority order:
#' 1. harvest_ready (imminent + mature ≥12 months)
#' 2. decline_stress (drop ≥CI_CHANGE_DECLINE_THRESHOLD but still >1.5)
#' 3. harvested_bare (Mean CI < 1.5)
#' @param imminent_prob Numeric harvest probability
#' @param age_week Numeric age in weeks
#' @param weekly_ci_change Numeric weekly CI change
#' @param mean_ci Numeric mean CI value
#' 1. harvest_ready → Schedule harvest operations
#' 2. harvested_bare → Record completion / detect unexpected harvest
#' 3. stress_detected → Monitor crop health (consistent decline)
#' 4. germination_delayed → Early warning for young fields
#' 5. growth_on_track → Positive signal (no action needed)
#' 6. NA → Normal growth (no alert)
#'
#' @param imminent_prob Numeric harvest probability (0-1)
#' @param age_week Numeric age in weeks since planting/harvest
#' @param mean_ci Numeric mean Chlorophyll Index
#' @param four_week_trend Numeric 4-week trend in CI (slope of growth)
#' @param weekly_ci_change Numeric week-over-week CI change
#' @param cv Numeric coefficient of variation (field uniformity)
#' @return Character status alert code or NA
calculate_status_alert <- function(imminent_prob, age_week, weekly_ci_change, mean_ci) {
# Priority 1: Ready for harvest-check
calculate_status_alert <- function(imminent_prob, age_week, mean_ci,
four_week_trend, weekly_ci_change, cv) {
# Priority 1: HARVEST READY - highest business priority
# Field is mature (≥12 months) AND harvest model predicts imminent harvest
if (!is.na(imminent_prob) && imminent_prob > 0.5 && !is.na(age_week) && age_week >= 52) {
return("harvest_ready")
}
# Priority 2: Strong decline (using configurable threshold)
if (!is.na(weekly_ci_change) && weekly_ci_change <= CI_CHANGE_DECLINE_THRESHOLD && !is.na(mean_ci) && mean_ci > 1.5) {
return("decline_stress")
}
# Priority 3: Harvested/bare
# Priority 2: HARVESTED/BARE - indicator of completion (or unexpected harvest)
# Mean CI dropped below vegetative threshold
if (!is.na(mean_ci) && mean_ci < 1.5) {
return("harvested_bare")
}
# Fallback: no alert
# Priority 3: STRESS DETECTED - consistent health decline (weekly trend)
# Uses Four_week_trend (smooth trend) NOT daily fluctuation to avoid noise
# Crop declining but not yet bare → opportunity to investigate
if (!is.na(four_week_trend) && four_week_trend < -0.3 &&
!is.na(mean_ci) && mean_ci > 1.5) {
return("stress_detected")
}
# Priority 4: GERMINATION DELAYED - early warning for young fields
# Age 4-8 weeks is typical germination window; low CI = slow start
if (!is.na(age_week) && age_week >= 4 && age_week <= 8 &&
!is.na(mean_ci) && mean_ci < 1.5) {
return("germination_delayed")
}
# Priority 5: GROWTH ON TRACK - positive operational status
# Field is healthy, uniform, and growing steadily (no action needed)
# Conditions: good uniformity (CV < 0.15) AND stable/positive weekly trend
if (!is.na(cv) && cv < 0.15 &&
!is.na(four_week_trend) && four_week_trend >= -0.2 &&
!is.na(weekly_ci_change) && weekly_ci_change >= -0.2) {
return("growth_on_track")
}
# Default: NORMAL GROWTH (no specific alert)
# Field is growing but may have minor variability; continues normal monitoring
NA_character_
}
@ -290,14 +325,16 @@ calculate_all_field_kpis <- function(current_stats,
}
},
# Column 14: Status_Alert (multi-priority logic)
# Column 14: Status_Alert (multi-priority logic for harvest/milling workflow)
Status_Alert = {
sapply(seq_len(nrow(current_stats)), function(idx) {
calculate_status_alert(
Imminent_prob[idx],
Age_week[idx],
Weekly_ci_change[idx],
Mean_CI[idx]
imminent_prob = Imminent_prob[idx],
age_week = Age_week[idx],
mean_ci = Mean_CI[idx],
four_week_trend = Four_week_trend[idx],
weekly_ci_change = Weekly_ci_change[idx],
cv = CV[idx]
)
})
},

2
r_app/90_CI_report_with_kpis_agronomic_support.Rmd
View file

@ -111,7 +111,7 @@ safe_log(paste("weekly_CI_mosaic path:", weekly_CI_mosaic))
# NO workspace-wide fallback that might load wrong project
# Build expected KPI file path strictly from project_dir
kpi_data_dir <- file.path(paths$reports_dir, "kpis") # Should be: laravel_app/storage/app/{project}/reports/kpis
kpi_data_dir <- paths$kpi_reports_dir # file.path(paths$reports_dir, "kpis") # Should be: laravel_app/storage/app/{project}/reports/kpis
# Calculate week from report_date
current_week <- as.numeric(format(as.Date(report_date), "%V"))

232
r_app/91_CI_report_with_kpis_cane_supply.Rmd
View file

@ -144,12 +144,12 @@ 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")
paste0(project_dir, "_field_analysis_", week_suffix, ".rds"),
paste0(project_dir, "_field_analysis_", date_suffix, ".rds"),
paste0(project_dir, "_field_analysis.rds"),
"field_analysis.rds",
paste0("field_analysis_", week_suffix, ".rds"),
paste0("field_analysis_", date_suffix, ".rds")
)
expected_field_details_names <- c(
@ -169,13 +169,26 @@ try_load_from_dir <- function(dir, candidates) {
return(NULL)
}
# Try primary directory first
# Try primary directory first (field_level/)
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 not found, try parent directory (kpis/) where RDS is often saved by Script 80
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"))
parent_dir <- dirname(kpi_data_dir) # One level up: reports/kpis/
safe_log(paste("KPI files not found in", kpi_data_dir, "—trying parent directory:", parent_dir))
if (is.null(summary_file)) {
summary_file <- try_load_from_dir(parent_dir, expected_summary_names)
}
if (is.null(field_details_file)) {
field_details_file <- try_load_from_dir(parent_dir, expected_field_details_names)
}
}
# If still 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, "or parent directory—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
@ -487,7 +500,7 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
## 1.1 Overview of cane supply area, showing zones with number of acres being harvest ready
```{r overview_map, fig.width=8, fig.height=7, fig.align="center", echo=FALSE, message=FALSE, warning=FALSE}
```{r overview_map, fig.width=7, fig.height=6, fig.align="center", echo=FALSE, message=FALSE, warning=FALSE}
# Create a hexbin overview map with ggplot
tryCatch({
# Use per-field field_analysis data from RDS (already loaded in load_kpi_data chunk)
@ -647,8 +660,8 @@ tryCatch({
## 1.2 Key Performance Indicators
```{r combined_kpi_table, echo=FALSE, results='asis'}
# Create summary KPI table from field_analysis_summary data
# This shows: Phases, Triggers, Area Change, and Total Farm acreage
# Create consolidated KPI table from field_analysis data
# Shows: Phases, Triggers, Area Change, Cloud Influence, and Total Farm
if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
# Load field analysis data
@ -659,24 +672,46 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
!is.data.frame(summary_data$field_analysis_summary)) {
# Create summary by aggregating by Status_Alert and Phase categories
# This groups fields by their phase and status to show distribution
phase_summary <- field_analysis_df %>%
filter(!is.na(Phase)) %>%
group_by(Phase) %>%
summarise(Acreage = sum(Acreage, na.rm = TRUE), .groups = "drop") %>%
summarise(
Acreage = sum(Acreage, na.rm = TRUE),
Field_count = n_distinct(Field_id),
.groups = "drop"
) %>%
mutate(Category = Phase) %>%
select(Category, Acreage)
select(Category, Acreage, Field_count)
# Try to create Status trigger summary - use Status_Alert if available, otherwise use empty
# Create Status trigger summary - includes both active alerts and "No active triggers"
trigger_summary <- tryCatch({
field_analysis_df %>%
# Active alerts (fields with non-NA Status_Alert)
active_alerts <- field_analysis_df %>%
filter(!is.na(Status_Alert), Status_Alert != "") %>%
group_by(Status_Alert) %>%
summarise(Acreage = sum(Acreage, na.rm = TRUE), .groups = "drop") %>%
summarise(
Acreage = sum(Acreage, na.rm = TRUE),
Field_count = n_distinct(Field_id),
.groups = "drop"
) %>%
mutate(Category = Status_Alert) %>%
select(Category, Acreage)
select(Category, Acreage, Field_count)
# No active triggers (fields with NA Status_Alert)
no_alerts <- field_analysis_df %>%
filter(is.na(Status_Alert) | Status_Alert == "") %>%
summarise(
Acreage = sum(Acreage, na.rm = TRUE),
Field_count = n_distinct(Field_id),
.groups = "drop"
) %>%
mutate(Category = "No active triggers") %>%
select(Category, Acreage, Field_count)
# Combine active alerts and no-alert fields
bind_rows(active_alerts, no_alerts)
}, error = function(e) {
data.frame(Category = character(), Acreage = numeric())
data.frame(Category = character(), Acreage = numeric(), Field_count = numeric())
})
# Combine into summary
@ -689,25 +724,38 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
# Phase names and trigger names to extract from summary
phase_names <- c("Germination", "Tillering", "Grand Growth", "Maturation", "Unknown Phase")
trigger_names <- c("Harvest Ready", "Strong Recovery", "Growth On Track", "Stress Detected",
"Germination Complete", "Germination Started", "No Active Trigger",
"Ready for harvest-check", "Strong decline in crop health", "Harvested/bare")
# Trigger names now include both active alerts AND "No active triggers" (calculated dynamically above)
trigger_names <- c("harvest_ready", "harvested_bare", "stress_detected",
"germination_delayed", "growth_on_track", "No active triggers")
# Extract phase distribution - match on category names directly
if (!is.null(field_analysis_summary) && nrow(field_analysis_summary) > 0) {
# Phase rows with field count
phase_rows <- field_analysis_summary %>%
filter(Category %in% phase_names) %>%
select(Category, Acreage) %>%
select(Category, Acreage, Field_count) %>%
mutate(KPI_Group = "PHASE DISTRIBUTION", .before = 1)
# Extract status triggers - match on category names directly
# Trigger rows with field count
trigger_rows <- field_analysis_summary %>%
filter(Category %in% trigger_names) %>%
select(Category, Acreage) %>%
mutate(KPI_Group = "STATUS TRIGGERS", .before = 1)
select(Category, Acreage, Field_count) %>%
mutate(KPI_Group = "OPERATIONAL ALERTS", .before = 1)
# If no triggers found, add a placeholder row
if (nrow(trigger_rows) == 0) {
trigger_rows <- data.frame(
KPI_Group = "OPERATIONAL ALERTS",
Category = "No active triggers",
Acreage = 0,
Field_count = 0,
stringsAsFactors = FALSE
)
}
# Calculate area change from field_analysis data
total_acreage <- sum(field_analysis_df$Acreage, na.rm = TRUE)
total_fields <- n_distinct(field_analysis_df$Field_id)
# Parse Weekly_ci_change to determine improvement/decline
parse_ci_change <- function(change_str) {
@ -721,10 +769,20 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
field_analysis_df$ci_change_numeric <- sapply(field_analysis_df$Weekly_ci_change, parse_ci_change)
improving_acreage <- sum(field_analysis_df$Acreage[field_analysis_df$ci_change_numeric > 0.2], na.rm = TRUE)
declining_acreage <- sum(field_analysis_df$Acreage[field_analysis_df$ci_change_numeric < -0.2], na.rm = TRUE)
stable_acreage <- sum(field_analysis_df$Acreage[field_analysis_df$ci_change_numeric >= -0.2 &
field_analysis_df$ci_change_numeric <= 0.2], na.rm = TRUE)
# Area change rows with field count
improving_df <- field_analysis_df %>%
filter(ci_change_numeric > 0.2)
stable_df <- field_analysis_df %>%
filter(ci_change_numeric >= -0.2 & ci_change_numeric <= 0.2)
declining_df <- field_analysis_df %>%
filter(ci_change_numeric < -0.2)
improving_acreage <- sum(improving_df$Acreage, na.rm = TRUE)
improving_field_count <- n_distinct(improving_df$Field_id)
stable_acreage <- sum(stable_df$Acreage, na.rm = TRUE)
stable_field_count <- n_distinct(stable_df$Field_id)
declining_acreage <- sum(declining_df$Acreage, na.rm = TRUE)
declining_field_count <- n_distinct(declining_df$Field_id)
improving_pct <- ifelse(total_acreage > 0, round(improving_acreage / total_acreage * 100, 1), 0)
declining_pct <- ifelse(total_acreage > 0, round(declining_acreage / total_acreage * 100, 1), 0)
@ -741,24 +799,54 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
KPI_Group = "AREA CHANGE",
Category = c("Improving", "Stable", "Declining"),
Acreage = c(round(improving_acreage, 2), round(stable_acreage, 2), round(declining_acreage, 2)),
Field_count = c(improving_field_count, stable_field_count, declining_field_count),
Percent = c(paste0(improving_pct, "%"), paste0(stable_pct, "%"), paste0(declining_pct, "%")),
stringsAsFactors = FALSE
)
# Cloud influence rows with field count - aggregate by Cloud_category
cloud_rows <- tryCatch({
field_analysis_df %>%
filter(!is.na(Cloud_category)) %>%
group_by(Cloud_category) %>%
summarise(
Acreage = sum(Acreage, na.rm = TRUE),
Field_count = n_distinct(Field_id),
.groups = "drop"
) %>%
mutate(
KPI_Group = "CLOUD INFLUENCE",
Category = Cloud_category,
Percent = paste0(round(Acreage / total_acreage * 100, 1), "%"),
Acreage = round(Acreage, 2)
) %>%
select(KPI_Group, Category, Acreage, Field_count, Percent)
}, error = function(e) {
data.frame(
KPI_Group = character(),
Category = character(),
Acreage = numeric(),
Field_count = numeric(),
Percent = character()
)
})
# Total farm row
total_row <- data.frame(
KPI_Group = "TOTAL FARM",
Category = "Total Acreage",
Acreage = round(total_acreage, 2),
Field_count = total_fields,
Percent = "100%",
stringsAsFactors = FALSE
)
# Combine all rows with percentages for all
# Combine all rows
combined_df <- bind_rows(
phase_pcts,
trigger_pcts,
area_change_rows,
cloud_rows,
total_row
)
@ -769,7 +857,7 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
KPI_display = if_else(row_number() == 1, KPI_Group, "")
) %>%
ungroup() %>%
select(KPI_display, Category, Acreage, Percent)
select(KPI_display, Category, Acreage, Percent, Field_count)
# Render as flextable with merged cells
ft <- flextable(combined_df) %>%
@ -777,7 +865,8 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
KPI_display = "KPI Category",
Category = "Item",
Acreage = "Acreage",
Percent = "Percent"
Percent = "Percentage of total fields",
Field_count = "# Fields"
) %>%
merge_v(j = "KPI_display") %>%
autofit()
@ -787,8 +876,9 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
phase_count <- nrow(phase_rows)
trigger_count <- nrow(trigger_rows)
area_count <- nrow(area_change_rows)
cloud_count <- nrow(cloud_rows)
# Add lines after phases, triggers, and area change groups (before totals)
# Add lines after phases, triggers, area change, and cloud groups (before totals)
if (phase_count > 0) {
ft <- ft %>% hline(i = phase_count, border = officer::fp_border(width = 1))
}
@ -798,6 +888,9 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
if (area_count > 0) {
ft <- ft %>% hline(i = phase_count + trigger_count + area_count, border = officer::fp_border(width = 1))
}
if (cloud_count > 0) {
ft <- ft %>% hline(i = phase_count + trigger_count + area_count + cloud_count, border = officer::fp_border(width = 1))
}
ft
} else {
@ -808,40 +901,6 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
}
```
## Cloud Coverage Summary
```{r cloud_coverage_summary, echo=FALSE}
# Display cloud coverage summary aggregated by category
# Cloud coverage data is included in the field_analysis RDS from Script 80
if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
field_analysis_df <- summary_data$field_analysis
# Aggregate cloud coverage by category
cloud_summary <- field_analysis_df %>%
filter(!is.na(Cloud_category)) %>%
group_by(Cloud_category) %>%
summarise(
"Number of Fields" = n(),
"Total Acreage" = round(sum(Acreage, na.rm = TRUE), 1),
.groups = "drop"
) %>%
rename("Cloud Category" = Cloud_category) %>%
arrange(`Cloud Category`)
if (nrow(cloud_summary) > 0) {
# Create flextable
ft <- flextable(cloud_summary) %>%
autofit() %>%
theme_vanilla()
ft
} else {
cat("Cloud coverage data not available for summary.\n")
}
} else {
cat("Field analysis data not available for cloud coverage summary.\n")
}
```
```{r data, message=TRUE, warning=TRUE, include=FALSE}
# All data comes from the field analysis performed in 09_field_analysis_weekly.R
# The report renders KPI tables and field summaries from that data
@ -1005,15 +1064,42 @@ Both algorithms are not always in sync, and can have contradictory results. Wide
## Report Metadata
```{r report_metadata, echo=FALSE}
# Calculate total area from field analysis data
total_area_acres <- 0
if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
total_area_acres <- sum(summary_data$field_analysis$Acreage, na.rm = TRUE)
}
# Calculate total fields
total_fields_count <- 0
if (exists("AllPivots0")) {
total_fields_count <- nrow(AllPivots0 %>% filter(!is.na(field)) %>% group_by(field) %>% summarise())
} else if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
total_fields_count <- n_distinct(summary_data$field_analysis$Field_id)
}
metadata_info <- data.frame(
Metric = c("Report Generated", "Data Source", "Analysis Period", "Total Fields", "Next Update"),
Metric = c(
"Report Generated",
"Data Source",
"Analysis Period",
"Total Fields [number]",
"Total Area [acres]",
"Next Update",
"Service provided",
"Starting date service"
),
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"
)
ifelse(total_fields_count > 0, total_fields_count, "Unknown"),
ifelse(total_area_acres > 0, round(total_area_acres, 0), "Unknown"),
"Next Wednesday",
"Cane Supply Office - Weekly",
"23 dec 2025"
),
stringsAsFactors = FALSE
)
ft <- flextable(metadata_info) %>%

13
r_app/parameters_project.R
View file

@ -173,9 +173,10 @@ setup_project_directories <- function(project_dir, data_source = "merged_tif") {
# TIER 6: KPI & REPORTING (Scripts 80/90/91 output)
reports_dir <- here(laravel_storage_dir, "reports")
kpi_reports_dir <- here(reports_dir, "kpis", "field_level")
kpi_field_stats_dir <- here(reports_dir, "kpis", "field_stats")
kpi_field_analysis_dir <- here(reports_dir, "kpis", "field_analysis")
kpi_reports_dir <- here(reports_dir, "kpis")
#kpi_reports_dir <- here(reports_dir, "kpis", "field_level")
#kpi_field_stats_dir <- here(reports_dir, "kpis", "field_stats")
#kpi_field_analysis_dir <- here(reports_dir, "kpis", "field_analysis")
# TIER 7: SUPPORT (various scripts)
vrt_dir <- here(data_dir, "vrt") # Virtual Raster files created during CI extraction
@ -188,7 +189,7 @@ setup_project_directories <- function(project_dir, data_source = "merged_tif") {
extracted_ci_base_dir, daily_ci_vals_dir, cumulative_ci_vals_dir, ci_for_python_dir,
growth_model_interpolated_dir,
weekly_mosaic_dir,
reports_dir, kpi_reports_dir, kpi_field_stats_dir, kpi_field_analysis_dir,
reports_dir, kpi_reports_dir, #kpi_field_stats_dir, kpi_field_analysis_dir,
data_dir, vrt_dir, harvest_dir, log_dir
)
@ -227,8 +228,8 @@ setup_project_directories <- function(project_dir, data_source = "merged_tif") {
# TIER 6: KPI & reporting
reports_dir = reports_dir,
kpi_reports_dir = kpi_reports_dir,
kpi_field_stats_dir = kpi_field_stats_dir,
kpi_field_analysis_dir = kpi_field_analysis_dir,
#kpi_field_stats_dir = kpi_field_stats_dir,
#kpi_field_analysis_dir = kpi_field_analysis_dir,
# TIER 7: Support
data_dir = data_dir,