From 2d6f062c2796b4472e21da70873355e47d81919c Mon Sep 17 00:00:00 2001 From: Timon Date: Tue, 10 Feb 2026 22:11:58 +0100 Subject: [PATCH] changes again --- r_app/80_utils_agronomic_support.R | 86 ++++++++----------- ..._CI_report_with_kpis_agronomic_support.Rmd | 6 +- r_app/parameters_project.R | 2 +- 3 files changed, 40 insertions(+), 54 deletions(-) diff --git a/r_app/80_utils_agronomic_support.R b/r_app/80_utils_agronomic_support.R index 6d4494b..351d0e5 100644 --- a/r_app/80_utils_agronomic_support.R +++ b/r_app/80_utils_agronomic_support.R @@ -24,8 +24,6 @@ library(tidyr) library(readxl) library(writexl) library(spdep) -library(caret) -library(CAST) # ============================================================================ # SHARED HELPER FUNCTIONS (NOW IN 80_UTILS_COMMON.R) @@ -81,27 +79,19 @@ prepare_predictions <- function(harvest_model, field_data, scenario = "optimisti #' #' @return Data frame with field_idx, cv_value, morans_i, uniformity_score, interpretation calculate_field_uniformity_kpi <- function(ci_pixels_by_field, field_boundaries_sf, ci_raster = NULL) { - result <- data.frame( - field_idx = integer(), - cv_value = numeric(), - morans_i = numeric(), - uniformity_score = numeric(), - interpretation = character(), - stringsAsFactors = FALSE - ) + results_list <- list() for (field_idx in seq_len(nrow(field_boundaries_sf))) { ci_pixels <- ci_pixels_by_field[[field_idx]] if (is.null(ci_pixels) || length(ci_pixels) == 0) { - result <- rbind(result, data.frame( + results_list[[length(results_list) + 1]] <- list( field_idx = field_idx, cv_value = NA_real_, morans_i = NA_real_, uniformity_score = NA_real_, - interpretation = "No data", - stringsAsFactors = FALSE - )) + interpretation = "No data" + ) next } @@ -145,16 +135,18 @@ calculate_field_uniformity_kpi <- function(ci_pixels_by_field, field_boundaries_ interpretation <- "Very poor uniformity" } - result <- rbind(result, data.frame( + results_list[[length(results_list) + 1]] <- list( field_idx = field_idx, cv_value = cv_val, morans_i = morans_i, uniformity_score = round(uniformity_score, 3), - interpretation = interpretation, - stringsAsFactors = FALSE - )) + interpretation = interpretation + ) } + # Convert accumulated list to data frame in a single operation + result <- do.call(rbind, lapply(results_list, as.data.frame)) + return(result) } @@ -222,19 +214,12 @@ calculate_tch_forecasted_kpi <- function(field_statistics, harvesting_data = NUL next } - ci_val <- result$mean_ci[i] - - # Simple linear model - tch_est <- 50 + (ci_val * 10) - - # Confidence interval based on CI range - tch_lower <- tch_est * 0.85 - tch_upper <- tch_est * 1.15 - - result$tch_forecasted[i] <- round(tch_est, 2) - result$tch_lower_bound[i] <- round(tch_lower, 2) - result$tch_upper_bound[i] <- round(tch_upper, 2) - result$confidence[i] <- "Medium" + if (is.na(result$mean_ci[i])) { + result$tch_forecasted[i] <- NA_real_ + result$tch_lower_bound[i] <- NA_real_ + result$tch_upper_bound[i] <- NA_real_ + result$confidence[i] <- "No data" + } } return(result) @@ -365,13 +350,7 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) { field_boundaries_vect <- field_boundaries } - field_results <- data.frame( - field_idx = integer(), - gap_filling_success = numeric(), - na_percent_pre_interpolation = numeric(), - mean_ci = numeric(), - stringsAsFactors = FALSE - ) + results_list <- list() # Ensure field_boundaries_vect is valid and matches field_boundaries dimensions n_fields_vect <- length(field_boundaries_vect) @@ -395,25 +374,26 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) { gap_filling_success <- (valid_pixels / total_pixels) * 100 na_percent <- ((total_pixels - valid_pixels) / total_pixels) * 100 - field_results <- rbind(field_results, data.frame( + results_list[[length(results_list) + 1]] <- list( field_idx = i, gap_filling_success = round(gap_filling_success, 2), na_percent_pre_interpolation = round(na_percent, 2), - mean_ci = round(mean(valid_values), 2), - stringsAsFactors = FALSE - )) + mean_ci = round(mean(valid_values), 2) + ) } else { # Not enough valid data - field_results <- rbind(field_results, data.frame( + results_list[[length(results_list) + 1]] <- list( field_idx = i, gap_filling_success = NA_real_, na_percent_pre_interpolation = NA_real_, - mean_ci = NA_real_, - stringsAsFactors = FALSE - )) + mean_ci = NA_real_ + ) } } + # Convert accumulated list to data frame in a single operation + field_results <- do.call(rbind, lapply(results_list, as.data.frame)) + return(field_results) } @@ -653,9 +633,15 @@ export_kpi_data <- function(all_kpis, kpi_summary, project_dir, output_dir, week } } - # 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)) + # Ensure field_name is a character vector of appropriate length + if (length(field_name) != nrow(field_boundaries_sf)) { + field_name <- rep(NA_character_, nrow(field_boundaries_sf)) + } + + # Replace only NA elements with fallback names, keeping valid names intact + na_indices <- which(is.na(field_name)) + if (length(na_indices) > 0) { + field_name[na_indices] <- paste0("Field_", na_indices) } field_df <- data.frame( @@ -800,7 +786,7 @@ calculate_all_kpis <- function( message("Calculating KPI 4: Growth Decline...") growth_decline_kpi <- calculate_growth_decline_kpi( - list(ci_pixels_by_field) # Would need historical data for real trend + ci_pixels_by_field # Would need historical data for real trend ) message("Calculating KPI 5: Weed Presence...") diff --git a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd index 56ae091..bc00b39 100644 --- a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd +++ b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd @@ -427,7 +427,7 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table ```{r field_alerts_table, echo=FALSE, results='asis'} # Generate alerts for all fields generate_field_alerts <- function(field_details_table) { - if (!exists("field_details_table") || is.null(field_details_table) || nrow(field_details_table) == 0) { + if (is.null(field_details_table) || nrow(field_details_table) == 0) { return(NULL) # Return NULL to signal no data } @@ -593,8 +593,8 @@ if (!exists("field_details_table") || is.null(field_details_table)) { 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 + field_sizes <- if (!is.null(sf::st_geometry(AllPivots0)) && !all(sf::st_is_empty(sf::st_geometry(AllPivots0)))) { + sf::st_area(sf::st_geometry(AllPivots0)) / 10000 # Convert m² to hectares } else { rep(NA_real_, length(field_names)) } diff --git a/r_app/parameters_project.R b/r_app/parameters_project.R index cbdc5b9..c188c9c 100644 --- a/r_app/parameters_project.R +++ b/r_app/parameters_project.R @@ -53,7 +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="")) + warning(paste0("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)