small issues
This commit is contained in:
parent
0dc46628fd
commit
054cc85bdb
File diff suppressed because it is too large
Load diff
|
|
@ -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))
|
||||
}
|
||||
|
||||
# ============================================================================
|
||||
|
|
|
|||
|
|
@ -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
|
||||
))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
272
r_app/DEBUG_remove_date_tiffs.R
Normal file
272
r_app/DEBUG_remove_date_tiffs.R
Normal 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
20
r_app/FIX_INDENTATION.R
Normal 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")
|
||||
|
|
@ -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:
|
||||
#
|
||||
|
|
|
|||
|
|
@ -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()
|
||||
}
|
||||
|
|
@ -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
|
|
@ -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,
|
||||
|
|
|
|||
Loading…
Reference in a new issue