small issues

This commit is contained in:
Timon 2026-02-10 15:38:23 +01:00
parent 0dc46628fd
commit 054cc85bdb
11 changed files with 956 additions and 1985 deletions

File diff suppressed because it is too large Load diff

View file

@ -353,71 +353,75 @@ calculate_weed_presence_kpi <- function(ci_pixels_by_field) {
return(result)
}
#' KPI 6: Calculate gap filling quality (data interpolation success)
#'
#' Measures how well cloud/missing data was interpolated during growth model
#'
#' @param ci_rds_path Path to combined CI RDS file (before/after interpolation)
#'
#' @return Data frame with gap-filling quality metrics
calculate_gap_filling_kpi <- function(ci_rds_path) {
# If ci_rds_path is NULL or not a valid path, return placeholder
if (is.null(ci_rds_path) || !is.character(ci_rds_path) || length(ci_rds_path) == 0) {
return(NULL)
#' Calculate Gap Filling Score KPI (placeholder)
#' @param ci_raster Current week CI raster
#' @param field_boundaries Field boundaries
#' @return List with summary data frame and field-level results data frame
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
}
# If ci_rds_path is a directory, find the cumulative CI file
if (dir.exists(ci_rds_path)) {
ci_files <- list.files(ci_rds_path, pattern = "^All_pivots.*\\.rds$", full.names = TRUE)
if (length(ci_files) == 0) {
return(NULL)
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_
))
}
ci_rds_path <- ci_files[1]
}
if (!file.exists(ci_rds_path)) {
return(NULL)
}
tryCatch({
ci_data <- readRDS(ci_rds_path)
# ci_data should be a wide matrix: fields × weeks
# NA values = missing data before interpolation
# (Gap filling is done during growth model stage)
result <- data.frame(
field_idx = seq_len(nrow(ci_data)),
na_percent_pre_interpolation = NA_real_,
na_percent_post_interpolation = NA_real_,
gap_filling_success = NA_character_,
stringsAsFactors = FALSE
)
for (field_idx in seq_len(nrow(ci_data))) {
na_count <- sum(is.na(ci_data[field_idx, ]))
na_pct <- na_count / ncol(ci_data) * 100
if (na_pct == 0) {
result$gap_filling_success[field_idx] <- "No gaps (100% data)"
} else if (na_pct < 10) {
result$gap_filling_success[field_idx] <- "Excellent"
} else if (na_pct < 25) {
result$gap_filling_success[field_idx] <- "Good"
} else if (na_pct < 40) {
result$gap_filling_success[field_idx] <- "Fair"
} else {
result$gap_filling_success[field_idx] <- "Poor"
}
result$na_percent_pre_interpolation[field_idx] <- round(na_pct, 2)
}
return(result)
}, error = function(e) {
message(paste("Error calculating gap filling KPI:", e$message))
return(NULL)
})
# Summarize results
gap_summary <- field_results %>%
dplyr::group_by(gap_level) %>%
dplyr::summarise(field_count = n(), .groups = 'drop') %>%
dplyr::mutate(percent = round((field_count / sum(field_count)) * 100, 1))
return(list(summary = gap_summary, field_results = field_results))
}
# ============================================================================

View file

@ -822,7 +822,8 @@ load_historical_field_data <- function(project_dir, current_week, current_year,
if (file.exists(csv_path)) {
tryCatch({
data <- readr::read_csv(csv_path, show_col_types = FALSE)
data <- readr::read_csv(csv_path, show_col_types = FALSE,
col_types = readr::cols(.default = readr::col_character()))
historical_data[[lookback + 1]] <- list(
week = target_week,
year = target_year,
@ -878,7 +879,8 @@ calculate_kpi_trends <- function(current_stats, prev_stats = NULL,
analysis_files <- list.files(analysis_dir, pattern = "_field_analysis_week.*\\.csv$", full.names = TRUE)
if (length(analysis_files) > 0) {
recent_file <- analysis_files[which.max(file.info(analysis_files)$mtime)]
prev_field_analysis <- readr::read_csv(recent_file, show_col_types = FALSE,
prev_field_analysis <- readr::read_csv(recent_file, show_col_types = FALSE,
col_types = readr::cols(.default = readr::col_character()),
col_select = c(Field_id, nmr_of_weeks_analysed, Phase))
}
}
@ -1143,7 +1145,7 @@ calculate_week_numbers <- function(report_date = Sys.Date()) {
return(list(
current_week = current_week,
previous_week = previous_week,
year = current_year,
current_year = current_year,
previous_year = previous_year
))
}

View file

@ -704,7 +704,7 @@ The following table provides a comprehensive overview of all monitored fields wi
```{r detailed_field_table, echo=FALSE, results='asis'}
# Load CI quadrant data to get field ages
CI_quadrant <- readRDS(here::here(paths$cumulative_ci_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
#CI_quadrant <- readRDS(here::here(paths$cumulative_ci_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
# Identify the current season for each field based on report_date
# The current season is the one where the report_date falls within or shortly after the season

View file

@ -0,0 +1,272 @@
# ==============================================================================
# DEBUG_REMOVE_DATE_TIFFS.R
# ==============================================================================
# PURPOSE:
# Remove all TIFFs of a specific date from multiple storage folders.
# Useful for debugging/re-running parts of the pipeline without full re-download.
#
# USAGE:
# Rscript DEBUG_remove_date_tiffs.R [project] [date] [--dry-run] [--skip-merged] [--skip-field-tiles] [--skip-field-tiles-ci] [--skip-daily-vals]
#
# EXAMPLES:
# # Remove 2026-02-08 from all folders (WITH CONFIRMATION)
# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08
#
# # Remove from all folders without confirmation
# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --no-confirm
#
# # Dry run - show what WOULD be deleted without deleting
# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --dry-run
#
# # Remove only from merged_tif and field_tiles, skip CI folders
# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --skip-field-tiles-ci --skip-daily-vals
#
# # Remove from field_tiles_CI only
# Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --skip-merged --skip-field-tiles --skip-daily-vals
#
# ==============================================================================
# ==============================================================================
# CONFIGURATION - TOGGLE WHICH FOLDERS TO DELETE FROM (DEFAULT: ALL)
# ==============================================================================
# Set these to FALSE to skip deletion from that folder
DELETE_FROM_MERGED_TIF <- TRUE
DELETE_FROM_FIELD_TILES <- TRUE
DELETE_FROM_FIELD_TILES_CI <- TRUE
DELETE_FROM_DAILY_VALS <- TRUE
# Safety settings
DRY_RUN <- FALSE # Set to TRUE to preview deletions without actually deleting
REQUIRE_CONFIRMATION <- TRUE # Set to FALSE to delete without asking
# ==============================================================================
# MAIN FUNCTION
# ==============================================================================
main <- function() {
# Parse command-line arguments
args <- commandArgs(trailingOnly = TRUE)
# Validate minimum arguments
if (length(args) < 2) {
cat("\n[ERROR] Missing arguments\n")
cat("Usage: Rscript DEBUG_remove_date_tiffs.R [project] [date] [options]\n\n")
cat("Examples:\n")
cat(" Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08\n")
cat(" Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --dry-run\n")
cat(" Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --skip-field-tiles-ci\n\n")
cat("Options:\n")
cat(" --dry-run Preview deletions without actually deleting\n")
cat(" --no-confirm Delete without confirmation\n")
cat(" --skip-merged Skip merged_tif folder\n")
cat(" --skip-field-tiles Skip field_tiles folder\n")
cat(" --skip-field-tiles-ci Skip field_tiles_CI folder\n")
cat(" --skip-daily-vals Skip daily_vals folder\n\n")
quit(status = 1)
}
# Parse positional arguments
project <- args[1]
date_str <- args[2]
# Parse optional flags
if (length(args) >= 3) {
for (i in 3:length(args)) {
arg <- args[i]
# Skip NA or empty arguments
if (is.na(arg) || nchar(arg) == 0) {
next
}
if (arg == "--dry-run") {
DRY_RUN <<- TRUE
} else if (arg == "--no-confirm") {
REQUIRE_CONFIRMATION <<- FALSE
} else if (arg == "--skip-merged") {
DELETE_FROM_MERGED_TIF <<- FALSE
} else if (arg == "--skip-field-tiles") {
DELETE_FROM_FIELD_TILES <<- FALSE
} else if (arg == "--skip-field-tiles-ci") {
DELETE_FROM_FIELD_TILES_CI <<- FALSE
} else if (arg == "--skip-daily-vals") {
DELETE_FROM_DAILY_VALS <<- FALSE
}
}
}
# Validate date format
date_obj <- tryCatch(
as.Date(date_str, format = "%Y-%m-%d"),
error = function(e) NULL
)
if (is.na(date_obj)) {
cat(sprintf("[ERROR] Invalid date format: %s (expected YYYY-MM-DD)\n", date_str))
quit(status = 1)
}
# ===========================================================================
# BUILD LIST OF FOLDERS & FILES TO DELETE
# ===========================================================================
base_path <- file.path("laravel_app", "storage", "app", project)
files_to_delete <- list()
# FOLDER 1: merged_tif/{DATE}.tif
if (DELETE_FROM_MERGED_TIF) {
merged_tif_file <- file.path(base_path, "merged_tif", paste0(date_str, ".tif"))
if (file.exists(merged_tif_file)) {
files_to_delete[["merged_tif"]] <- merged_tif_file
}
}
# FOLDER 2: field_tiles/{FIELD}/{DATE}.tif (per-field structure)
if (DELETE_FROM_FIELD_TILES) {
field_tiles_dir <- file.path(base_path, "field_tiles")
if (dir.exists(field_tiles_dir)) {
field_dirs <- list.dirs(field_tiles_dir, full.names = TRUE, recursive = FALSE)
for (field_dir in field_dirs) {
tif_file <- file.path(field_dir, paste0(date_str, ".tif"))
if (file.exists(tif_file)) {
folder_name <- basename(field_dir)
key <- paste0("field_tiles/", folder_name)
files_to_delete[[key]] <- tif_file
}
}
}
}
# FOLDER 3: field_tiles_CI/{FIELD}/{DATE}.tif (per-field structure)
if (DELETE_FROM_FIELD_TILES_CI) {
field_tiles_ci_dir <- file.path(base_path, "field_tiles_CI")
if (dir.exists(field_tiles_ci_dir)) {
field_dirs <- list.dirs(field_tiles_ci_dir, full.names = TRUE, recursive = FALSE)
for (field_dir in field_dirs) {
tif_file <- file.path(field_dir, paste0(date_str, ".tif"))
if (file.exists(tif_file)) {
folder_name <- basename(field_dir)
key <- paste0("field_tiles_CI/", folder_name)
files_to_delete[[key]] <- tif_file
}
}
}
}
# FOLDER 4: Data/extracted_ci/daily_vals/{SUBDIR}/{DATE}.rds (per-subdirectory structure)
if (DELETE_FROM_DAILY_VALS) {
daily_vals_dir <- file.path(base_path, "Data", "extracted_ci", "daily_vals")
if (dir.exists(daily_vals_dir)) {
subdirs <- list.dirs(daily_vals_dir, full.names = TRUE, recursive = FALSE)
for (subdir in subdirs) {
rds_file <- file.path(subdir, paste0(date_str, ".rds"))
if (file.exists(rds_file)) {
subdir_name <- basename(subdir)
key <- paste0("daily_vals/", subdir_name)
files_to_delete[[key]] <- rds_file
}
}
}
}
# ===========================================================================
# SUMMARY & CONFIRMATION
# ===========================================================================
cat("\n")
cat(strrep("=", 70), "\n")
cat("DELETE DATE TIFFS - SUMMARY\n")
cat(strrep("=", 70), "\n")
cat(sprintf("Project: %s\n", project))
cat(sprintf("Date: %s\n", date_str))
cat(sprintf("Dry run: %s\n", if (DRY_RUN) "YES" else "NO"))
cat(sprintf("Files to delete: %d\n", length(files_to_delete)))
cat("\n")
if (length(files_to_delete) == 0) {
cat("[INFO] No files found to delete\n")
cat(strrep("=", 70), "\n\n")
quit(status = 0)
}
# Count files by folder type for compact summary
folder_counts <- table(sapply(names(files_to_delete), function(key) strsplit(key, "/")[[1]][1]))
cat("Files to delete by folder:\n")
for (folder in names(folder_counts)) {
cat(sprintf(" %s: %d file%s\n", folder, folder_counts[folder], if (folder_counts[folder] != 1) "s" else ""))
}
cat(sprintf(" Total: %d file%s\n", length(files_to_delete), if (length(files_to_delete) != 1) "s" else ""))
cat("\n")
# Ask for confirmation (unless --no-confirm flag was used)
if (REQUIRE_CONFIRMATION && !DRY_RUN) {
# Check if running in interactive mode
if (!interactive()) {
cat("\n[ERROR] Non-interactive mode detected (running via Rscript)\n")
cat("Cannot prompt for confirmation. Use --no-confirm flag to proceed:\n")
cat(" Rscript DEBUG_remove_date_tiffs.R angata 2026-02-08 --no-confirm\n\n")
cat(strrep("=", 70), "\n\n")
quit(status = 1)
}
cat("⚠️ This will PERMANENTLY DELETE the above files!\n")
cat("Use --no-confirm flag to skip this prompt\n")
# Use readline() for interactive input (only works in interactive R/RStudio)
response <- readline(prompt = "Type 'yes' to confirm, or anything else to cancel: ")
if (tolower(response) != "yes") {
cat("[CANCELLED] No files deleted\n")
cat(strrep("=", 70), "\n\n")
quit(status = 0)
}
}
# ===========================================================================
# DELETE OR DRY-RUN
# ===========================================================================
deleted_count <- 0
error_count <- 0
for (i in seq_along(files_to_delete)) {
folder_key <- names(files_to_delete)[i]
file_path <- files_to_delete[[i]]
if (!DRY_RUN) {
tryCatch({
file.remove(file_path)
deleted_count <- deleted_count + 1
}, error = function(e) {
error_count <<- error_count + 1
})
}
}
# ===========================================================================
# FINAL SUMMARY
# ===========================================================================
cat("\n")
if (DRY_RUN) {
cat(sprintf("[DRY RUN] Would have deleted %d files\n", length(files_to_delete)))
} else {
cat(sprintf("Deleted: %d files\n", deleted_count))
if (error_count > 0) {
cat(sprintf("Errors: %d files\n", error_count))
}
}
cat(strrep("=", 70), "\n\n")
quit(status = 0)
}
# ==============================================================================
# EXECUTE
# ==============================================================================
if (sys.nframe() == 0) {
main()
}

20
r_app/FIX_INDENTATION.R Normal file
View file

@ -0,0 +1,20 @@
# Fix indentation for lines 408-1022 in 80_calculate_kpis.R
# These lines should be inside the else-if block at the CANE_SUPPLY_WORKFLOW level
file_path <- "r_app/80_calculate_kpis.R"
lines <- readLines(file_path)
# Lines 408-1021 (0-indexed: 407-1020) need 2 more spaces of indentation
for (i in 408:1021) {
if (i <= length(lines)) {
line <- lines[i]
# Skip empty or whitespace-only lines
if (nchar(trimws(line)) > 0) {
# Add 2 spaces
lines[i] <- paste0(" ", line)
}
}
}
writeLines(lines, file_path)
cat("Fixed indentation for lines 408-1022\n")

View file

@ -73,6 +73,7 @@
# python 00_download_8band_pu_optimized.py [PROJECT] --date [DATE] --resolution 3 --cleanup
#
# Example:
# cd python_app
# python 00_download_8band_pu_optimized.py angata --date 2026-02-04 --resolution 3 --cleanup
#
# COMMAND #2 - Batch Download (Multiple Dates):
@ -125,8 +126,6 @@
#
# & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/10_create_per_field_tiffs.R angata
#
# Example:
# & "C:\Program Files\R\R-4.4.3\bin\x64\Rscript.exe" r_app/10_create_per_field_tiffs.R angata
#
# COMMAND #2 - Specific Date Range:
#

View file

@ -1,104 +0,0 @@
# EXTRACT_RDS_ONLY.R
# ===================
# Extract and combine daily CI values into combined_CI_data.rds
# Skips raster processing - assumes daily extracted files already exist
#
# Usage: Rscript r_app/extract_rds_only.R [project_dir]
# - project_dir: Project directory name (e.g., "angata", "aura", "chemba")
#
# Example:
# Rscript r_app/extract_rds_only.R angata
suppressPackageStartupMessages({
library(tidyverse)
library(here)
})
main <- function() {
# Capture command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Process project_dir argument
if (length(args) >= 1 && !is.na(args[1])) {
project_dir <- as.character(args[1])
} else {
project_dir <- "angata"
}
cat(sprintf("RDS Extraction: project=%s\n", project_dir))
# Source configuration
tryCatch({
source("parameters_project.R")
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source("r_app/parameters_project.R")
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source parameters_project.R from both default and 'r_app' directories.")
})
})
# Define paths for CI data
daily_CI_vals_dir <- file.path(
"laravel_app/storage/app", project_dir,
"Data/extracted_ci/daily_vals"
)
cumulative_CI_vals_dir <- file.path(
"laravel_app/storage/app", project_dir,
"Data/extracted_ci/cumulative_vals"
)
cat(sprintf("Daily CI values dir: %s\n", daily_CI_vals_dir))
cat(sprintf("Cumulative CI values dir: %s\n\n", cumulative_CI_vals_dir))
# Check if daily CI directory exists and has files
if (!dir.exists(daily_CI_vals_dir)) {
stop(sprintf("ERROR: Daily CI directory not found: %s", daily_CI_vals_dir))
}
# List RDS files
files <- list.files(path = daily_CI_vals_dir, pattern = "^extracted_.*\\.rds$", full.names = TRUE)
if (length(files) == 0) {
stop(sprintf("ERROR: No extracted CI values found in %s", daily_CI_vals_dir))
}
cat(sprintf("Found %d daily CI RDS files\n\n", length(files)))
# Create cumulative directory if it doesn't exist
if (!dir.exists(cumulative_CI_vals_dir)) {
dir.create(cumulative_CI_vals_dir, recursive = TRUE)
cat(sprintf("Created directory: %s\n\n", cumulative_CI_vals_dir))
}
# Combine all RDS files
cat("Combining daily RDS files...\n")
combined_data <- files %>%
purrr::map(readRDS) %>%
purrr::list_rbind() %>%
dplyr::group_by(sub_field)
# Save combined data
output_path <- file.path(cumulative_CI_vals_dir, "combined_CI_data.rds")
saveRDS(combined_data, output_path)
cat(sprintf("✓ Combined %d daily files\n", length(files)))
cat(sprintf("✓ Total rows: %d\n", nrow(combined_data))
cat(sprintf("✓ Saved to: %s\n\n", output_path))
# Summary
cat("Summary:\n")
cat(sprintf(" Fields: %d\n", n_distinct(combined_data$field, na.rm = TRUE)))
cat(sprintf(" Sub-fields: %d\n", n_distinct(combined_data$sub_field, na.rm = TRUE)))
cat(sprintf(" Total measurements: %d\n\n", nrow(combined_data)))
cat("✓ RDS extraction complete!\n")
cat("Next: Run 02b_convert_rds_to_csv.R to convert to CSV\n")
}
if (sys.nframe() == 0) {
main()
}

View file

@ -9,11 +9,6 @@
# 5. Weed Presence Score
# 6. Gap Filling Score
# Note: This file depends on functions from crop_messaging_utils.R:
# - safe_log()
# - calculate_cv()
# - calculate_spatial_autocorrelation()
# - calculate_change_percentages()
# 1. Helper Functions
# -----------------
@ -676,7 +671,7 @@ calculate_growth_decline_kpi <- function(current_ci, previous_ci, field_boundari
mean_change <- mean(ci_change)
# Calculate spatial metrics
spatial_result <- calculate_spatial_autocorrelation(current_ci, field_vect)
spatial_result <- calculate_spatial_autocorrelation(current_field_ci, field_vect)
cv_value <- calculate_cv(current_clean)
# Determine risk level based on CI decline and spatial distribution

File diff suppressed because it is too large Load diff

View file

@ -244,7 +244,8 @@ ci_plot <- function(pivotName,
# Create spans for borders
joined_spans2 <- field_boundaries %>%
sf::st_transform(sf::st_crs(pivotShape)) %>% dplyr::filter(field %in% pivotName)
sf::st_transform(sf::st_crs(pivotShape)) %>%
dplyr::filter(field %in% pivotName)
# Create the maps for different timepoints
CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2,