Address CodeRabbit review feedback - [description of changes]
This commit is contained in:
parent
51d479673d
commit
0dc46628fd
|
|
@ -368,13 +368,14 @@ main <- function() {
|
|||
|
||||
# Call with correct signature
|
||||
kpi_results <- calculate_all_kpis(
|
||||
report_date = end_date,
|
||||
output_dir = reports_dir_kpi,
|
||||
field_boundaries_sf = field_boundaries_sf,
|
||||
current_week = current_week,
|
||||
current_year = current_year,
|
||||
current_mosaic_dir = setup$weekly_mosaic_dir,
|
||||
harvesting_data = harvesting_data,
|
||||
ci_rds_path = cumulative_CI_vals_dir,
|
||||
output_dir = reports_dir_kpi
|
||||
cumulative_CI_vals_dir = cumulative_CI_vals_dir,
|
||||
weekly_CI_mosaic = setup$weekly_mosaic_dir,
|
||||
reports_dir = reports_dir_kpi,
|
||||
project_dir = project_dir
|
||||
)
|
||||
|
||||
cat("\n=== AURA KPI CALCULATION COMPLETE ===\n")
|
||||
|
|
@ -402,11 +403,9 @@ main <- function() {
|
|||
previous_week <- weeks$previous_week
|
||||
previous_year <- weeks$previous_year
|
||||
|
||||
message(paste("Week:", current_week, "/ Year (ISO 8601):", year))
|
||||
|
||||
message(paste("Week:", current_week, "/ Year (ISO 8601):", current_year))
|
||||
# Find per-field weekly mosaics
|
||||
message("Finding per-field weekly mosaics...")
|
||||
single_file_pattern <- sprintf("week_%02d_%d\\.tif", current_week, year)
|
||||
|
||||
if (!dir.exists(weekly_mosaic)) {
|
||||
stop(paste("ERROR: weekly_mosaic directory not found:", weekly_mosaic,
|
||||
|
|
@ -422,7 +421,7 @@ main <- function() {
|
|||
}
|
||||
|
||||
# Verify we have mosaics for this week
|
||||
single_file_pattern <- sprintf("week_%02d_%d\\.tif", current_week, year)
|
||||
single_file_pattern <- sprintf("week_%02d_%d\\.tif", current_week, current_year)
|
||||
per_field_files <- c()
|
||||
for (field in field_dirs) {
|
||||
field_mosaic_dir <- file.path(weekly_mosaic, field)
|
||||
|
|
@ -433,7 +432,7 @@ main <- function() {
|
|||
}
|
||||
|
||||
if (length(per_field_files) == 0) {
|
||||
stop(paste("ERROR: No mosaics found for week", current_week, "year", year,
|
||||
stop(paste("ERROR: No mosaics found for week", current_week, "year", current_year,
|
||||
"\nExpected pattern:", single_file_pattern,
|
||||
"\nChecked:", weekly_mosaic))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -73,31 +73,6 @@ tryCatch({
|
|||
})
|
||||
})
|
||||
|
||||
# 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}
|
||||
|
|
@ -203,111 +178,6 @@ if (kpi_files_exist) {
|
|||
} 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}
|
||||
|
|
@ -366,7 +236,7 @@ tryCatch({
|
|||
# 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
|
||||
|
|
@ -593,7 +463,7 @@ if (!exists("CI_quadrant") || is.null(CI_quadrant)) {
|
|||
}
|
||||
safe_log("CI quadrant data verified for field-level analysis")
|
||||
```
|
||||
```
|
||||
|
||||
|
||||
```{r load_field_boundaries, message=TRUE, warning=TRUE, include=FALSE}
|
||||
# Load field boundaries from parameters
|
||||
|
|
|
|||
|
|
@ -72,31 +72,6 @@ tryCatch({
|
|||
})
|
||||
})
|
||||
|
||||
# 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}
|
||||
|
|
@ -327,111 +302,6 @@ if (!is.null(cloud_file) && file.exists(cloud_file)) {
|
|||
}
|
||||
```
|
||||
|
||||
```{r generate_field_kpi_summary_function, include=FALSE, eval=TRUE}
|
||||
#' 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, eval=TRUE}
|
||||
|
|
@ -744,25 +614,7 @@ tryCatch({
|
|||
\newpage
|
||||
## 1.2 Key Performance Indicators
|
||||
|
||||
```{r combined_kpi_table, echo=TRUE}
|
||||
# Debug: check what variables exist
|
||||
cat("\n=== DEBUG: combined_kpi_table chunk ===\n")
|
||||
cat(paste("exists('summary_data'):", exists("summary_data"), "\n"))
|
||||
cat(paste("exists('kpi_files_exist'):", exists("kpi_files_exist"), "\n"))
|
||||
if (exists("kpi_files_exist")) {
|
||||
cat(paste("kpi_files_exist value:", kpi_files_exist, "\n"))
|
||||
}
|
||||
if (exists("summary_data")) {
|
||||
cat(paste("summary_data class:", class(summary_data), "\n"))
|
||||
if (is.list(summary_data)) {
|
||||
cat(paste("summary_data names:", paste(names(summary_data), collapse = ", "), "\n"))
|
||||
cat(paste("has field_analysis_summary:", "field_analysis_summary" %in% names(summary_data), "\n"))
|
||||
}
|
||||
} else {
|
||||
cat("summary_data DOES NOT EXIST in this chunk's environment!\n")
|
||||
}
|
||||
cat("\n")
|
||||
|
||||
```{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
|
||||
|
||||
|
|
@ -773,7 +625,6 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
|
|||
# If field_analysis_summary is NULL or doesn't exist, create it from field_analysis_df
|
||||
if (is.null(summary_data$field_analysis_summary) || !("field_analysis_summary" %in% names(summary_data)) ||
|
||||
!is.data.frame(summary_data$field_analysis_summary)) {
|
||||
cat("\nNote: field_analysis_summary not in RDS, creating from field_analysis...\n")
|
||||
|
||||
# Create summary by aggregating by Status_Alert and Phase categories
|
||||
# This groups fields by their phase and status to show distribution
|
||||
|
|
@ -793,15 +644,12 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
|
|||
mutate(Category = Status_Alert) %>%
|
||||
select(Category, Acreage)
|
||||
}, error = function(e) {
|
||||
cat("Could not create trigger summary:", e$message, "\n")
|
||||
data.frame(Category = character(), Acreage = numeric())
|
||||
})
|
||||
|
||||
# Combine into summary
|
||||
field_analysis_summary <- bind_rows(phase_summary, trigger_summary)
|
||||
|
||||
cat(paste("Created summary with", nrow(field_analysis_summary), "category rows\n"))
|
||||
|
||||
} else {
|
||||
# Use existing summary from RDS
|
||||
field_analysis_summary <- summary_data$field_analysis_summary
|
||||
|
|
@ -1042,16 +890,20 @@ tryCatch({
|
|||
|
||||
tryCatch({
|
||||
# Try to repair invalid geometries
|
||||
field_boundaries_sf_fixed <<- sf::st_make_valid(field_boundaries_sf)
|
||||
AllPivots0 <<- field_boundaries_sf_fixed %>%
|
||||
dplyr::filter(!is.na(field), !is.na(sub_field))
|
||||
field_boundaries_sf_fixed <- sf::st_make_valid(field_boundaries_sf)
|
||||
assign("field_boundaries_sf_fixed", field_boundaries_sf_fixed, envir = .GlobalEnv)
|
||||
|
||||
AllPivots_merged <<- AllPivots0 %>%
|
||||
AllPivots0 <- field_boundaries_sf_fixed %>%
|
||||
dplyr::filter(!is.na(field), !is.na(sub_field))
|
||||
assign("AllPivots0", AllPivots0, envir = .GlobalEnv)
|
||||
|
||||
AllPivots_merged <- AllPivots0 %>%
|
||||
dplyr::filter(!is.na(field), !is.na(sub_field)) %>%
|
||||
dplyr::group_by(field) %>%
|
||||
dplyr::summarise(.groups = 'drop')
|
||||
assign("AllPivots_merged", AllPivots_merged, envir = .GlobalEnv)
|
||||
|
||||
field_boundaries_loaded <<- TRUE
|
||||
assign("field_boundaries_loaded", TRUE, envir = .GlobalEnv)
|
||||
safe_log("✓ Fixed invalid geometries and loaded field boundaries")
|
||||
}, error = function(e2) {
|
||||
safe_log(paste("⚠ Could not repair geometries:", e2$message), "WARNING")
|
||||
|
|
|
|||
|
|
@ -464,10 +464,9 @@ calculate_tch_forecasted_kpi <- function(field_boundaries, harvesting_data, cumu
|
|||
|
||||
tryCatch({
|
||||
# Check if tonnage_ha is empty
|
||||
if (all(is.na(harvesting_data$tonnage_ha))) {
|
||||
if (is.null(harvesting_data) || !("tonnage_ha" %in% names(harvesting_data)) || all(is.na(harvesting_data$tonnage_ha))) {
|
||||
safe_log("Lacking historic harvest data, using placeholder yield prediction", "WARNING")
|
||||
return(create_fallback_result(field_boundaries))
|
||||
}
|
||||
return(create_fallback_result(field_boundaries)) }
|
||||
|
||||
# Load CI quadrant data and fill missing values
|
||||
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds")) %>%
|
||||
|
|
@ -657,8 +656,14 @@ calculate_growth_decline_kpi <- function(current_ci, previous_ci, field_boundari
|
|||
current_values <- c()
|
||||
previous_values <- c()
|
||||
}
|
||||
previous_values <- extract_ci_values(previous_ci, field_vect)
|
||||
|
||||
# Extract CI values for both weeks
|
||||
if (!is.null(current_field_ci) && !is.null(previous_field_ci)) {
|
||||
current_values <- extract_ci_values(current_field_ci, field_vect)
|
||||
previous_values <- extract_ci_values(previous_field_ci, field_vect)
|
||||
} else {
|
||||
current_values <- c()
|
||||
previous_values <- c()
|
||||
}
|
||||
# Clean values
|
||||
valid_idx <- !is.na(current_values) & !is.na(previous_values) &
|
||||
is.finite(current_values) & is.finite(previous_values)
|
||||
|
|
@ -776,6 +781,8 @@ calculate_weed_presence_kpi <- function(current_ci, previous_ci, field_boundarie
|
|||
rapid_growth_pixels = numeric(0)
|
||||
)
|
||||
return(list(summary = summary_result, field_results = field_results))
|
||||
}
|
||||
|
||||
# Handle both sf and SpatVector inputs
|
||||
if (!inherits(field_boundaries, "SpatVector")) {
|
||||
field_boundaries_vect <- terra::vect(field_boundaries)
|
||||
|
|
@ -1302,10 +1309,6 @@ calculate_all_kpis <- function(report_date = Sys.Date(),
|
|||
project_dir) {
|
||||
safe_log("=== STARTING KPI CALCULATION ===")
|
||||
safe_log(paste("Report date:", report_date))
|
||||
|
||||
# Calculate week numbers
|
||||
weeks <- calculate_week_numbers(report_date)
|
||||
weeks <- calculate_week_numbers(report_date)
|
||||
weeks <- calculate_week_numbers(report_date)
|
||||
safe_log(paste("Current week:", weeks$current_week, "Previous week:", weeks$previous_week))
|
||||
|
||||
|
|
@ -1314,7 +1317,11 @@ calculate_all_kpis <- function(report_date = Sys.Date(),
|
|||
previous_ci <- load_weekly_ci_mosaic(weeks$previous_week, weeks$previous_iso_year, weekly_CI_mosaic)
|
||||
|
||||
if (is.null(current_ci)) {
|
||||
stop("Current week CI mosaic is required but not found") stop("Field boundaries not loaded. Check parameters_project.R initialization.")
|
||||
stop("Current week CI mosaic is required but not found")
|
||||
}
|
||||
|
||||
if (is.null(field_boundaries_sf)) {
|
||||
stop("Field boundaries not loaded. Check parameters_project.R initialization.")
|
||||
}
|
||||
|
||||
# Calculate all KPIs
|
||||
|
|
@ -1353,8 +1360,6 @@ calculate_all_kpis <- function(report_date = Sys.Date(),
|
|||
kpi_results$gap_filling_field_results <- gap_filling_result$field_results
|
||||
|
||||
# Add metadata and field boundaries for later use
|
||||
kpi_results$metadata <- list(
|
||||
report_date = report_date,
|
||||
kpi_results$metadata <- list(
|
||||
report_date = report_date,
|
||||
current_week = weeks$current_week,
|
||||
|
|
@ -1362,7 +1367,9 @@ calculate_all_kpis <- function(report_date = Sys.Date(),
|
|||
year = weeks$current_iso_year,
|
||||
calculation_time = Sys.time(),
|
||||
total_fields = nrow(field_boundaries_sf)
|
||||
) kpi_results$field_boundaries_sf <- field_boundaries_sf
|
||||
)
|
||||
|
||||
kpi_results$field_boundaries_sf <- field_boundaries_sf
|
||||
|
||||
# Save results if output directory specified
|
||||
if (!is.null(output_dir)) {
|
||||
|
|
|
|||
|
|
@ -944,4 +944,129 @@ get_per_field_mosaic_path <- function(
|
|||
}
|
||||
}
|
||||
|
||||
#' Determine field priority level based on CV and Moran's I
|
||||
#'
|
||||
#' @param cv Coefficient of Variation (uniformity metric)
|
||||
#' @param morans_i Moran's I spatial autocorrelation index
|
||||
#' @return Priority level: 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
|
||||
}
|
||||
}
|
||||
|
||||
#' 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
|
||||
#' @param CI_quadrant Data frame containing CI quadrant data with Date, DOY, season columns
|
||||
#' @param report_date Report date (used for filtering current season data)
|
||||
#' @return Formatted text string with field KPI summary
|
||||
#'
|
||||
generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadrant, report_date = Sys.Date()) {
|
||||
tryCatch({
|
||||
# Get field age from CI quadrant data for the CURRENT SEASON only
|
||||
# First identify the current season for this field
|
||||
# Get field age from CI quadrant data for the CURRENT SEASON only
|
||||
# First identify the current season for this field
|
||||
current_season_data <- 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))
|
||||
|
||||
if (nrow(current_season_data) == 0) {
|
||||
return(paste("**Field", field_name, "KPIs:** No CI data available for current season"))
|
||||
}
|
||||
current_season <- current_season_data %>% pull(season)
|
||||
|
||||
# Get the most recent DOY from the current season
|
||||
field_age_data <- CI_quadrant %>%
|
||||
filter(field == field_name, season == current_season) %>%
|
||||
pull(DOY)
|
||||
|
||||
field_age <- if (length(field_age_data) > 0) max(field_age_data, na.rm = TRUE) else NA_real_
|
||||
# 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("<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"))
|
||||
})
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue