Merge pull request #9 from TimonWeitkamp/review_perField_code

Review per field code

r_app/80_utils_agronomic_support.R

@@ -338,58 +338,58 @@ calculate_weed_presence_kpi <- function(ci_pixels_by_field) {
   return(result)
 }
 
-#' Calculate Gap Filling Score KPI (placeholder)
-#' @param ci_raster Current week CI raster
-#' @param field_boundaries Field boundaries
-#' @return Data frame with field-level gap filling scores
-calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
-  # Handle both sf and SpatVector inputs
-  if (!inherits(field_boundaries, "SpatVector")) {
-    field_boundaries_vect <- terra::vect(field_boundaries)
-  } else {
-    field_boundaries_vect <- field_boundaries
-  }
+# #' Calculate Gap Filling Score KPI (placeholder)
+# #' @param ci_raster Current week CI raster
+# #' @param field_boundaries Field boundaries
+# #' @return Data frame with field-level gap filling scores
+# calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
+#   # Handle both sf and SpatVector inputs
+#   if (!inherits(field_boundaries, "SpatVector")) {
+#     field_boundaries_vect <- terra::vect(field_boundaries)
+#   } else {
+#     field_boundaries_vect <- field_boundaries
+#   }
 
-  results_list <- list()
+#   results_list <- list()
 
-  # Ensure field_boundaries_vect is valid and matches field_boundaries dimensions
-  n_fields_vect <- length(field_boundaries_vect)
-  n_fields_sf <- 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."))
-  }
+#   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]
+#   for (i in seq_len(n_fields_vect)) {
+#     field_vect <- field_boundaries_vect[i]
 
-    # Extract CI values using helper function
-    ci_values <- extract_ci_values(ci_raster, field_vect)
-    valid_values <- ci_values[!is.na(ci_values) & is.finite(ci_values)]
+#     # Extract CI values using helper function
+#     ci_values <- extract_ci_values(ci_raster, field_vect)
+#     valid_values <- ci_values[!is.na(ci_values) & is.finite(ci_values)]
 
-    if (length(valid_values) > 1) {
-      # Calculate % of valid (non-NA) values = gap filling success
-      total_pixels <- length(ci_values)
-      valid_pixels <- length(valid_values)
-      gap_filling_success <- (valid_pixels / total_pixels) * 100
-      na_percent <- ((total_pixels - valid_pixels) / total_pixels) * 100
+#     if (length(valid_values) > 1) {
+#       # Calculate % of valid (non-NA) values = gap filling success
+#       total_pixels <- length(ci_values)
+#       valid_pixels <- length(valid_values)
+#       gap_filling_success <- (valid_pixels / total_pixels) * 100
+#       na_percent <- ((total_pixels - valid_pixels) / total_pixels) * 100
 
-      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)
-      )
-    } else {
-      # Not enough valid data
-      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_
-      )
-    }
-  }
+#       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)
+#       )
+#     } else {
+#       # Not enough valid data
+#       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_
+#       )
+#     }
+#   }
 
   # Convert accumulated list to data frame in a single operation
   field_results <- do.call(rbind, lapply(results_list, as.data.frame))

r_app/80_utils_common.R

@@ -354,6 +354,79 @@ calculate_cv_trend_long_term <- function(cv_values) {
   })
 }
 
+#' Calculate Gap Filling Score KPI (2σ method)
+#' @param ci_raster Current week CI raster
+#' @param field_boundaries Field boundaries
+#' @return Data frame with field-level gap filling scores
+calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
+  safe_log("Calculating Gap Filling Score KPI (placeholder)")
+
+  # Handle both sf and SpatVector inputs
+  if (!inherits(field_boundaries, "SpatVector")) {
+    field_boundaries_vect <- terra::vect(field_boundaries)
+  } else {
+    field_boundaries_vect <- 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."))
+  }
+
+  field_results <- data.frame()
+
+  for (i in seq_len(nrow(field_boundaries))) {
+    field_name <- field_boundaries$field[i]
+    sub_field_name <- field_boundaries$sub_field[i]
+    field_vect <- field_boundaries_vect[i]
+
+    # Extract CI values using helper function
+    ci_values <- extract_ci_values(ci_raster, field_vect)
+    valid_values <- ci_values[!is.na(ci_values) & is.finite(ci_values)]
+
+    if (length(valid_values) > 1) {
+      # Gap score using 2σ below median to detect outliers
+      median_ci <- median(valid_values)
+      sd_ci <- sd(valid_values)
+      outlier_threshold <- median_ci - (2 * sd_ci)
+      low_ci_pixels <- sum(valid_values < outlier_threshold)
+      total_pixels <- length(valid_values)
+      gap_score <- (low_ci_pixels / total_pixels) * 100
+
+      # Classify gap severity
+      gap_level <- dplyr::case_when(
+        gap_score < 10 ~ "Minimal",
+        gap_score < 25 ~ "Moderate", 
+        TRUE ~ "Significant"
+      )
+
+      field_results <- rbind(field_results, data.frame(
+        field = field_name,
+        sub_field = sub_field_name,
+        gap_level = gap_level,
+        gap_score = gap_score,
+        mean_ci = mean(valid_values),
+        outlier_threshold = outlier_threshold
+      ))
+    } else {
+      # Not enough valid data, fill with NA row
+      field_results <- rbind(field_results, data.frame(
+        field = field_name,
+        sub_field = sub_field_name,
+        gap_level = NA_character_,
+        gap_score = NA_real_,
+        mean_ci = NA_real_,
+        outlier_threshold = NA_real_
+      ))
+    }
+  }
+}
+
+
+
 # ============================================================================
 # HELPER FUNCTIONS
 # ============================================================================

r_app/parameters_project.R

@@ -44,7 +44,8 @@ CLIENT_TYPE_MAP <- list(
   "xinavane" = "agronomic_support",
   "esa" = "agronomic_support",
   "simba" = "agronomic_support",
-  "john" = "agronomic_support"
+  "john" = "agronomic_support",
+  "huss" = "agronomic_support"
 )
 
 #' Get client type for a project