coderabbit fixes
This commit is contained in:
parent
dd83a9e27f
commit
a40b9c1dfe
|
|
@ -373,7 +373,15 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
|
|||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
for (i in seq_len(nrow(field_boundaries))) {
|
||||
# Ensure field_boundaries_vect is valid and matches field_boundaries dimensions
|
||||
n_fields_vect <- length(field_boundaries_vect)
|
||||
n_fields_sf <- nrow(field_boundaries)
|
||||
|
||||
if (n_fields_sf != n_fields_vect) {
|
||||
warning(paste("Field boundary mismatch: nrow(field_boundaries)=", n_fields_sf, "vs length(field_boundaries_vect)=", n_fields_vect, ". Using actual SpatVector length."))
|
||||
}
|
||||
|
||||
for (i in seq_len(n_fields_vect)) {
|
||||
field_vect <- field_boundaries_vect[i]
|
||||
|
||||
# Extract CI values using helper function
|
||||
|
|
@ -521,7 +529,7 @@ create_summary_tables <- function(all_kpis) {
|
|||
`Fields Analyzed` = fields_with_data
|
||||
)
|
||||
} else {
|
||||
data.frame(`Avg Gap Filling Success %` = NA_real_, `Avg NA % Pre-Interpolation` = NA_real_, `Fields Analyzed` = 0)
|
||||
data.frame(`Avg Gap Filling Success %` = NA_real_, `Avg NA % Pre-Interpolation` = NA_real_, `Fields Analyzed` = 0, check.names = FALSE)
|
||||
}
|
||||
|
||||
# Return as list (each element is a farm-level summary table)
|
||||
|
|
@ -573,7 +581,7 @@ create_field_detail_table <- function(field_df, all_kpis, field_boundaries_sf) {
|
|||
`Yield Forecast (t/ha)` = tch_forecasted,
|
||||
`Decline Risk` = decline_severity,
|
||||
`Weed Risk` = weed_pressure_risk,
|
||||
`Mean CI` = mean_ci_pct_change,
|
||||
`CI Change %` = mean_ci_pct_change,
|
||||
`CV Value` = cv_value
|
||||
) %>%
|
||||
# Add placeholder columns expected by reporting script (will be populated from other sources)
|
||||
|
|
@ -582,7 +590,7 @@ create_field_detail_table <- function(field_df, all_kpis, field_boundaries_sf) {
|
|||
`Gap Score` = NA_real_
|
||||
) %>%
|
||||
select(field_idx, Field, `Field Size (ha)`, `Growth Uniformity`, `Yield Forecast (t/ha)`,
|
||||
`Gap Score`, `Decline Risk`, `Weed Risk`, `Mean CI`, `CV Value`)
|
||||
`Gap Score`, `Decline Risk`, `Weed Risk`, `CI Change %`, `CV Value`)
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
|
@ -628,15 +636,31 @@ export_kpi_data <- function(all_kpis, kpi_summary, project_dir, output_dir, week
|
|||
if (!is.null(field_boundaries_sf)) {
|
||||
tryCatch({
|
||||
# Create a basic field_df from the boundaries
|
||||
# Robust field name extraction with multiple fallbacks
|
||||
field_name <- NA_character_
|
||||
|
||||
# Check for 'name' column in the data.frame
|
||||
if ("name" %in% names(field_boundaries_sf)) {
|
||||
field_name <- field_boundaries_sf$name
|
||||
} else if ("properties" %in% names(field_boundaries_sf)) {
|
||||
# Extract from properties column (may be a list-column)
|
||||
props <- field_boundaries_sf$properties
|
||||
if (is.list(props) && length(props) > 0 && "name" %in% names(props[[1]])) {
|
||||
field_name <- sapply(props, function(x) ifelse(is.null(x$name), NA_character_, x$name))
|
||||
} else if (!is.list(props)) {
|
||||
# Try direct access if properties is a simple column
|
||||
field_name <- props
|
||||
}
|
||||
}
|
||||
|
||||
# Fallback if name extraction didn't work
|
||||
if (any(is.na(field_name)) || length(field_name) != nrow(field_boundaries_sf)) {
|
||||
field_name <- paste0("Field_", 1:nrow(field_boundaries_sf))
|
||||
}
|
||||
|
||||
field_df <- data.frame(
|
||||
field_idx = 1:nrow(field_boundaries_sf),
|
||||
field_name = if (!is.null(field_boundaries_sf$properties$name)) {
|
||||
field_boundaries_sf$properties$name
|
||||
} else if (!is.null(field_boundaries_sf$name)) {
|
||||
field_boundaries_sf$name
|
||||
} else {
|
||||
paste0("Field_", 1:nrow(field_boundaries_sf))
|
||||
},
|
||||
field_name = field_name,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
|
|
@ -678,7 +702,12 @@ export_kpi_data <- function(all_kpis, kpi_summary, project_dir, output_dir, week
|
|||
message(paste("✓ KPI RDS exported to:", rds_file))
|
||||
message(" Structure: list($summary_tables, $all_kpis, $field_details)")
|
||||
|
||||
return(list(excel = excel_file, rds = rds_file))
|
||||
# Return including field_details for orchestrator to capture
|
||||
return(list(
|
||||
excel = excel_file,
|
||||
rds = rds_file,
|
||||
field_details = field_details_table
|
||||
))
|
||||
}
|
||||
|
||||
# ============================================================================
|
||||
|
|
@ -797,14 +826,15 @@ calculate_all_kpis <- function(
|
|||
if (is.null(project_dir)) {
|
||||
project_dir <- "AURA" # Fallback if not provided
|
||||
}
|
||||
export_paths <- export_kpi_data(all_kpis, kpi_summary, project_dir, output_dir, current_week, current_year, field_boundaries_sf)
|
||||
export_result <- export_kpi_data(all_kpis, kpi_summary, project_dir, output_dir, current_week, current_year, field_boundaries_sf)
|
||||
|
||||
message(paste("\n✓", project_dir, "KPI calculation complete. Week", current_week, current_year, "\n"))
|
||||
|
||||
# Return combined structure (for integration with 80_calculate_kpis.R)
|
||||
# Capture field_details from export_result to propagate it out
|
||||
return(list(
|
||||
all_kpis = all_kpis,
|
||||
summary_tables = kpi_summary,
|
||||
field_details = NULL # Will be populated if export_kpi_data succeeds
|
||||
field_details = export_result$field_details # Propagate field_details from export_kpi_data
|
||||
))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -540,44 +540,6 @@ if (exists("field_details_table") && !is.null(field_details_table) && nrow(field
|
|||
}
|
||||
```
|
||||
|
||||
```{r create_field_details_table, message=FALSE, warning=FALSE, include=FALSE}
|
||||
# Create field_details_table from available data
|
||||
# For projects without KPI data, create minimal table from field names/geometries
|
||||
|
||||
if (!exists("field_details_table") || is.null(field_details_table)) {
|
||||
tryCatch({
|
||||
if (!is.null(AllPivots0) && nrow(AllPivots0) > 0) {
|
||||
# Get field names from geometries
|
||||
field_names <- AllPivots0$field
|
||||
|
||||
# Try to calculate field sizes (area) from geometry if available
|
||||
field_sizes <- if ("geometry" %in% names(AllPivots0)) {
|
||||
sf::st_area(AllPivots0) / 10000 # Convert m² to hectares
|
||||
} else {
|
||||
rep(NA_real_, length(field_names))
|
||||
}
|
||||
|
||||
# Create minimal field details table with actual data we have + NAs for missing KPI columns
|
||||
field_details_table <- tibble::tibble(
|
||||
Field = field_names,
|
||||
`Field Size (ha)` = as.numeric(field_sizes),
|
||||
`Growth Uniformity` = NA_character_,
|
||||
`Yield Forecast (t/ha)` = NA_real_,
|
||||
`Gap Score` = NA_real_,
|
||||
`Decline Risk` = NA_character_,
|
||||
`Weed Risk` = NA_character_,
|
||||
`Mean CI` = NA_real_,
|
||||
`CV Value` = NA_real_,
|
||||
`Moran's I` = NA_real_
|
||||
)
|
||||
safe_log(paste("Created field_details_table from geometries for", nrow(field_details_table), "fields"))
|
||||
}
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error creating field_details_table from geometries:", e$message), "WARNING")
|
||||
})
|
||||
}
|
||||
```
|
||||
|
||||
```{r data, message=TRUE, warning=TRUE, include=FALSE}
|
||||
# Verify CI quadrant data is loaded from load_ci_data chunk
|
||||
if (!exists("CI_quadrant")) {
|
||||
|
|
@ -620,6 +582,44 @@ tryCatch({
|
|||
})
|
||||
```
|
||||
|
||||
```{r create_field_details_table, message=FALSE, warning=FALSE, include=FALSE}
|
||||
# Create field_details_table from available data (now that AllPivots0 is defined)
|
||||
# For projects without KPI data, create minimal table from field names/geometries
|
||||
|
||||
if (!exists("field_details_table") || is.null(field_details_table)) {
|
||||
tryCatch({
|
||||
if (!is.null(AllPivots0) && nrow(AllPivots0) > 0) {
|
||||
# Get field names from geometries
|
||||
field_names <- AllPivots0$field
|
||||
|
||||
# Try to calculate field sizes (area) from geometry if available
|
||||
field_sizes <- if ("geometry" %in% names(AllPivots0)) {
|
||||
sf::st_area(AllPivots0) / 10000 # Convert m² to hectares
|
||||
} else {
|
||||
rep(NA_real_, length(field_names))
|
||||
}
|
||||
|
||||
# Create minimal field details table with actual data we have + NAs for missing KPI columns
|
||||
field_details_table <- tibble::tibble(
|
||||
Field = field_names,
|
||||
`Field Size (ha)` = as.numeric(field_sizes),
|
||||
`Growth Uniformity` = NA_character_,
|
||||
`Yield Forecast (t/ha)` = NA_real_,
|
||||
`Gap Score` = NA_real_,
|
||||
`Decline Risk` = NA_character_,
|
||||
`Weed Risk` = NA_character_,
|
||||
`Mean CI` = NA_real_,
|
||||
`CV Value` = NA_real_,
|
||||
`Moran's I` = NA_real_
|
||||
)
|
||||
safe_log(paste("Created field_details_table from geometries for", nrow(field_details_table), "fields"))
|
||||
}
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error creating field_details_table from geometries:", e$message), "WARNING")
|
||||
})
|
||||
}
|
||||
```
|
||||
|
||||
# Section 2: Field-by-Field Analysis
|
||||
|
||||
## Overview of Field-Level Insights
|
||||
|
|
|
|||
|
|
@ -39,7 +39,12 @@ suppressPackageStartupMessages({
|
|||
# This determines which scripts run and what outputs they produce
|
||||
|
||||
CLIENT_TYPE_MAP <- list(
|
||||
"angata" = "cane_supply"
|
||||
"angata" = "cane_supply",
|
||||
"chemba" = "agronomic_support",
|
||||
"xinavane" = "agronomic_support",
|
||||
"esa" = "agronomic_support",
|
||||
"simba" = "agronomic_support",
|
||||
"john" = "agronomic_support"
|
||||
)
|
||||
|
||||
#' Get client type for a project
|
||||
|
|
@ -48,6 +53,7 @@ CLIENT_TYPE_MAP <- list(
|
|||
get_client_type <- function(project_name) {
|
||||
client_type <- CLIENT_TYPE_MAP[[project_name]]
|
||||
if (is.null(client_type)) {
|
||||
warning(paste("Project '", project_name, "' not found in CLIENT_TYPE_MAP. Defaulting to 'agronomic_support'.", sep=""))
|
||||
return("agronomic_support") # Default for all unlisted projects
|
||||
}
|
||||
return(client_type)
|
||||
|
|
|
|||
|
|
@ -1,32 +0,0 @@
|
|||
#!/usr/bin/env Rscript
|
||||
# Temporary script to inspect KPI structure
|
||||
|
||||
x <- readRDS('laravel_app/storage/app/john/reports/kpis/field_level/AURA_KPI_week_06_2026.rds')
|
||||
|
||||
cat("===== KPI RDS Structure =====\n")
|
||||
cat("Names:", paste(names(x), collapse=", "), "\n\n")
|
||||
|
||||
cat("---- UNIFORMITY TABLE ----\n")
|
||||
cat("Class:", class(x$uniformity), "\n")
|
||||
if (is.data.frame(x$uniformity)) {
|
||||
cat("Columns:", paste(names(x$uniformity), collapse=", "), "\n")
|
||||
print(head(x$uniformity, 3))
|
||||
} else if (is.list(x$uniformity)) {
|
||||
cat("List contents:", paste(names(x$uniformity), collapse=", "), "\n")
|
||||
}
|
||||
|
||||
cat("\n---- AREA CHANGE TABLE ----\n")
|
||||
cat("Class:", class(x$area_change), "\n")
|
||||
if (is.data.frame(x$area_change)) {
|
||||
cat("Columns:", paste(names(x$area_change), collapse=", "), "\n")
|
||||
print(head(x$area_change, 3))
|
||||
} else if (is.list(x$area_change)) {
|
||||
cat("List contents:", paste(names(x$area_change), collapse=", "), "\n")
|
||||
}
|
||||
|
||||
cat("\n---- TCH FORECASTED TABLE ----\n")
|
||||
cat("Class:", class(x$tch_forecasted), "\n")
|
||||
if (is.data.frame(x$tch_forecasted)) {
|
||||
cat("Columns:", paste(names(x$tch_forecasted), collapse=", "), "\n")
|
||||
print(head(x$tch_forecasted, 3))
|
||||
}
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
# Load the created RDS file
|
||||
rds_file <- "laravel_app/storage/app/john/reports/kpis/field_level/john_kpi_summary_tables_week06_2026.rds"
|
||||
data <- readRDS(rds_file)
|
||||
|
||||
# Check structure
|
||||
cat("Top-level structure:\n")
|
||||
cat("Names:", paste(names(data), collapse=", "), "\n")
|
||||
cat("Has summary_tables:", "summary_tables" %in% names(data), "\n")
|
||||
cat("Has all_kpis:", "all_kpis" %in% names(data), "\n")
|
||||
cat("Has field_details:", "field_details" %in% names(data), "\n\n")
|
||||
|
||||
# Check summary_tables structure
|
||||
if (!is.null(data$summary_tables)) {
|
||||
cat("Summary tables (KPI names):\n")
|
||||
cat(" -", paste(names(data$summary_tables), collapse=", "), "\n\n")
|
||||
|
||||
# Check one example
|
||||
cat("Uniformity KPI (first 3 rows):\n")
|
||||
print(head(data$summary_tables$uniformity, 3))
|
||||
}
|
||||
|
||||
cat("\n---\n")
|
||||
cat("all_kpis structure:\n")
|
||||
if (!is.null(data$all_kpis)) {
|
||||
cat(" -", paste(names(data$all_kpis), collapse=", "), "\n")
|
||||
}
|
||||
|
||||
cat("\n---\n")
|
||||
cat("field_details structure:\n")
|
||||
if (!is.null(data$field_details)) {
|
||||
cat("Columns:", paste(colnames(data$field_details), collapse=", "), "\n")
|
||||
print(data$field_details)
|
||||
} else {
|
||||
cat(" NULL (expected if field_boundaries_sf had issues)\n")
|
||||
}
|
||||
|
|
@ -1,22 +0,0 @@
|
|||
# Test rendering of 90 report
|
||||
library(rmarkdown)
|
||||
|
||||
# Use "john" project since it has the KPI data we just created
|
||||
render(
|
||||
input = "r_app/90_CI_report_with_kpis_agronomic_support.Rmd",
|
||||
params = list(
|
||||
data_dir = "john",
|
||||
report_date = "2026-02-04",
|
||||
mail_day = "Monday",
|
||||
borders = FALSE,
|
||||
ci_plot_type = "mosaic",
|
||||
colorblind_friendly = FALSE,
|
||||
facet_by_season = FALSE,
|
||||
x_axis_unit = "days"
|
||||
),
|
||||
output_file = "test_90_john_2026_02_04.docx",
|
||||
output_dir = "output",
|
||||
quiet = FALSE
|
||||
)
|
||||
|
||||
cat("\n✓ Report rendered!\n")
|
||||
Loading…
Reference in a new issue