changes again

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...")

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))
       }

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)