diff --git a/.gitignore b/.gitignore
index 04de0ff..cf5b8fc 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,6 +9,14 @@
__pycache__/
*.pyc
*.pyo
+*.py[cod]
+*.py[cod]
+myenv/myenv/
+pip-wheel-metadata/
+dist/
+*.egg-info/
+*.egg/*.egg/
+.ipynb_checkpoints
# R Output Files
*.Rout
@@ -16,6 +24,7 @@ __pycache__/
*.RData
*.Rdata
.Rproj.user
+.Rprofile
Rplots.pdf
*.pdf
@@ -48,15 +57,24 @@ reports/
# Experiment Outputs (temporary plots, analysis artifacts)
python_app/harvest_detection_experiments/*/plots/
python_app/harvest_detection_experiments/*/*.ipynb_checkpoints/
+CI_report_dashboard_planet_files/
# Cache Files
rosm.cache/
-*.cache
+renv/cache/
# Logs
*.log
package_manager.log
+# Temporary Files
+*.tmp
+*.save
+*.bak
+*.swp
+*.swo
+package_manager.log
+
# Laravel Storage (contains user data and outputs)
laravel_app/storage/app/*/Data/
laravel_app/storage/app/*/reports/
diff --git a/.renvignore b/.renvignore
index d48919b..eaa6c15 100644
--- a/.renvignore
+++ b/.renvignore
@@ -5,9 +5,12 @@ laravel_app/
data_validation_tool/
python_app/harvest_detection_experiments/
python_app/experiments/
+r_app/old_scripts/
+r_app/experiments/
phase2_refinement/
webapps/
tools/
+old_sh/
output/
renv/
*.py
diff --git a/python_app/.gitignore b/python_app/.gitignore
deleted file mode 100644
index 7c3d9f1..0000000
--- a/python_app/.gitignore
+++ /dev/null
@@ -1,43 +0,0 @@
-# .gitignore
-
-# Ignore the virtual environment directory
-myenv/
-
-# Byte-compiled / optimized files
-__pycache__/
-*.py[cod]
-*$py.class
-
-# Ignore all .pyc files in any directory
-**/*.pyc
-
-# Ignore pip wheel metadata
-pip-wheel-metadata/
-
-# Ignore the `dist/` directory used for package distributions
-dist/
-
-# Ignore Python egg metadata, regenerated from source files by setuptools
-*.egg-info/
-*.egg-info/*
-*.egg/
-
-# Ignore Jupyter Notebook
-.ipynb_checkpoints
-
-# Ignore VSCode directory
-.vscode/
-
-# Ignore JetBrains IDEs directory
-.idea/
-
-# Ignore MacOS directory
-.DS_Store
-
-# Ignore other unwanted file
-*.log
-*.bak
-*.swp
-*.swo
-*.swp
-
diff --git a/python_app/22_harvest_baseline_prediction.py b/python_app/22_harvest_baseline_prediction.py
index 4184608..f20f937 100644
--- a/python_app/22_harvest_baseline_prediction.py
+++ b/python_app/22_harvest_baseline_prediction.py
@@ -111,7 +111,7 @@ def main():
# [3/4] Run model predictions with two-step detection
print("\n[3/4] Running two-step harvest detection...")
- print(" (Using threshold=0.3, consecutive_days=2 - tuned baseline with DOY reset)")
+ print(" (Using threshold=0.3, consecutive_days=2 - tuned baseline with DAH reset)")
refined_results = run_two_step_refinement(ci_data, model, config, scalers, device=device,
phase1_threshold=0.3, phase1_consecutive=2)
diff --git a/python_app/harvest_date_pred_utils.py b/python_app/harvest_date_pred_utils.py
index 012a9f2..d746e3a 100644
--- a/python_app/harvest_date_pred_utils.py
+++ b/python_app/harvest_date_pred_utils.py
@@ -144,7 +144,7 @@ def create_model(model_type: str, input_size: int, hidden_size: int = 128,
# FEATURE ENGINEERING (from src/feature_engineering.py, simplified for inline)
# ============================================================================
-def compute_ci_features(ci_series: pd.Series, doy_series: pd.Series = None) -> pd.DataFrame:
+def compute_ci_features(ci_series: pd.Series, dah_series: pd.Series = None) -> pd.DataFrame:
"""Compute all CI-based features (state, velocity, acceleration, min/max/range/std/CV)."""
features = pd.DataFrame(index=ci_series.index)
@@ -177,9 +177,9 @@ def compute_ci_features(ci_series: pd.Series, doy_series: pd.Series = None) -> p
ma = ci_series.rolling(window=window, min_periods=1).mean()
features[f'{window}d_CV'] = features[f'{window}d_std'] / (ma + 1e-6)
- # DOY normalized
- if doy_series is not None:
- features['DOY_normalized'] = doy_series / 450.0
+ # DAH normalized (Days After Harvest)
+ if dah_series is not None:
+ features['DAH_normalized'] = dah_series / 450.0
return features.fillna(0)
@@ -193,8 +193,8 @@ def extract_features(data_df: pd.DataFrame, feature_names: List[str], ci_column:
data_df: DataFrame with Date and CI data (may be a window after a harvest)
feature_names: List of feature names to extract
ci_column: Name of CI column
- season_anchor_day: Day in FULL sequence where this season started (for DOY reset)
- DOY will be recalculated as: 1, 2, 3, ... from this point
+ season_anchor_day: Day in FULL sequence where this season started (for DAH reset)
+ DAH will be recalculated as: 1, 2, 3, ... from this point
lookback_start: Starting index in original full data (for season reset calculation)
Returns:
@@ -203,23 +203,23 @@ def extract_features(data_df: pd.DataFrame, feature_names: List[str], ci_column:
# Compute all CI features
ci_series = data_df[ci_column].astype(float)
- # Compute DOY (age/days since season start) - NOT day-of-year!
- # DOY is a continuous counter: 1, 2, 3, ..., 475 (doesn't cycle at 365)
+ # Compute DAH (age/days since season start) - NOT day-of-year!
+ # DAH is a continuous counter: 1, 2, 3, ..., 475 (doesn't cycle at 365)
# It only resets to 1 after a harvest is detected (new season)
- doy_series = None
- if 'DOY_normalized' in feature_names:
+ dah_series = None
+ if 'DAH_normalized' in feature_names:
if season_anchor_day is not None and lookback_start >= season_anchor_day:
- # Season was reset after harvest. Recalculate DOY as simple counter from 1
- # This is a window starting at or after harvest, so DOY should be: 1, 2, 3, ...
- doy_series = pd.Series(np.arange(1, len(data_df) + 1), index=data_df.index)
- elif 'DOY' in data_df.columns:
- # Use DOY directly from CSV - already calculated as continuous age counter
- doy_series = pd.Series(data_df['DOY'].astype(float).values, index=data_df.index)
+ # Season was reset after harvest. Recalculate DAH as simple counter from 1
+ # This is a window starting at or after harvest, so DAH should be: 1, 2, 3, ...
+ dah_series = pd.Series(np.arange(1, len(data_df) + 1), index=data_df.index)
+ elif 'DAH' in data_df.columns:
+ # Use DAH directly from CSV - already calculated as continuous age counter
+ dah_series = pd.Series(data_df['DAH'].astype(float).values, index=data_df.index)
else:
# Fallback: create continuous age counter (1, 2, 3, ...)
- doy_series = pd.Series(np.arange(1, len(data_df) + 1), index=data_df.index)
+ dah_series = pd.Series(np.arange(1, len(data_df) + 1), index=data_df.index)
- all_features = compute_ci_features(ci_series, doy_series)
+ all_features = compute_ci_features(ci_series, dah_series)
# Select requested features
requested = [f for f in feature_names if f in all_features.columns]
@@ -303,9 +303,9 @@ def load_harvest_data(data_file: Path) -> pd.DataFrame:
def run_phase1_growing_window(field_data, model, config, scalers, ci_column, device,
threshold=0.45, consecutive_days=2):
"""
- Phase 1: Growing window detection with DOY season reset.
+ Phase 1: Growing window detection with DAH season reset.
- For each detected harvest, reset DOY counter for the next season.
+ For each detected harvest, reset DAH counter for the next season.
This allows the model to detect multiple consecutive harvests in multi-year data.
"""
harvest_dates = []
diff --git a/python_app/model_config.json b/python_app/model_config.json
index 3be1268..c0dcbd3 100644
--- a/python_app/model_config.json
+++ b/python_app/model_config.json
@@ -44,7 +44,7 @@
"7d_std",
"14d_std",
"21d_std",
- "DOY_normalized"
+ "DAH_normalized"
],
"model": {
"type": "LSTM",
diff --git a/r_app/.gitignore b/r_app/.gitignore
deleted file mode 100644
index ec29223..0000000
--- a/r_app/.gitignore
+++ /dev/null
@@ -1,20 +0,0 @@
-# .gitignore
-
-# Ignore renv binary cache
-renv/cache/
-renv
-
-# Ignore temporary files
-*.tmp
-*.swp
-*.save
-
-# Ignore files related to Rproj
-.Rproj.user/
-.Rhistory
-.RData
-.Rprofile
-# Ignore OSX files
-.DS_Store
-CI_report_dashboard_planet_files/
-
diff --git a/r_app/00_common_utils.R b/r_app/00_common_utils.R
index 49a7b58..e7e9a44 100644
--- a/r_app/00_common_utils.R
+++ b/r_app/00_common_utils.R
@@ -48,10 +48,30 @@
# #' safe_log("Check input file", "WARNING")
# #' safe_log("Failed to load data", "ERROR")
# #'
-# safe_log <- function(message, level = "INFO") {
-# prefix <- sprintf("[%s]", level)
-# cat(sprintf("%s %s\n", prefix, message))
-# }
+safe_log <- function(message, level = "INFO") {
+ # Build the full log message with timestamp
+ timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S")
+ log_msg <- sprintf("[%s] [%s] %s", timestamp, level, message)
+
+ # Only output to console if NOT rendering with knitr
+ if (!isTRUE(getOption('knitr.in.progress'))) {
+ cat(log_msg, "\n")
+ }
+
+ # Always write to log file if available
+ if (exists("LOG_FILE", envir = .GlobalEnv)) {
+ log_file <- get("LOG_FILE", envir = .GlobalEnv)
+ if (!is.null(log_file) && nzchar(log_file)) {
+ tryCatch({
+ cat(log_msg, "\n", file = log_file, append = TRUE)
+ }, error = function(e) {
+ # Silently fail if log file can't be written
+ })
+ }
+ }
+
+ invisible(log_msg)
+}
# #' SmartCane Debug Logging (Conditional)
# #'
diff --git a/r_app/21_convert_ci_rds_to_csv.R b/r_app/21_convert_ci_rds_to_csv.R
index 78af1bb..282e87f 100644
--- a/r_app/21_convert_ci_rds_to_csv.R
+++ b/r_app/21_convert_ci_rds_to_csv.R
@@ -14,7 +14,7 @@
# OUTPUT DATA:
# - Destination: laravel_app/storage/app/{project}/Data/extracted_ci/cumulative_vals/
# - Format: CSV (long format)
-# - Columns: field, sub_field, Date, FitData, DOY, value
+# - Columns: field, sub_field, Date, FitData, DAH, value
#
# USAGE:
# Rscript 21_convert_ci_rds_to_csv.R [project]
@@ -38,7 +38,7 @@
# NOTES:
# - Data source: Uses interpolated CI data from Script 30 (growth model output)
# - Handles both wide format and long format inputs from growth model
-# - DOY (Day of Year): Calculated from date for seasonal analysis
+# - DAH (Days After Harvest): Calculated from date; represents crop age in days
# - Python integration: CSV format compatible with pandas/scikit-learn workflows
# - Used by: Python harvest detection models (harvest_date_prediction.py)
# - Exports complete growth curves with interpolated values for ML training
@@ -82,13 +82,13 @@ wide_to_long_ci_data <- function(ci_data_wide) {
filter(!is.na(FitData))
}
-#' Create daily interpolated sequences with DOY for each field
+#' Create daily interpolated sequences with DAH for each field
#'
#' For each field/sub_field combination, creates complete daily sequences from first to last date,
#' fills in measurements, and interpolates missing dates.
#'
#' @param ci_data_long Long format tibble: field, sub_field, Date, FitData
-#' @return Tibble with: field, sub_field, Date, FitData, DOY, value
+#' @return Tibble with: field, sub_field, Date, FitData, DAH, value
create_interpolated_daily_sequences <- function(ci_data_long) {
ci_data_long %>%
group_by(field, sub_field) %>%
@@ -106,7 +106,7 @@ create_interpolated_daily_sequences <- function(ci_data_long) {
Date = date_seq,
value = NA_real_,
FitData = NA_real_,
- DOY = seq_along(date_seq) # Continuous day counter: 1, 2, 3, ...
+ DAH = seq_along(date_seq) # Continuous day counter: 1, 2, 3, ...
)
# Fill in actual measurement values
@@ -124,7 +124,7 @@ create_interpolated_daily_sequences <- function(ci_data_long) {
})
) %>%
unnest(data) %>%
- select(field, sub_field, Date, FitData, DOY, value) %>%
+ select(field, sub_field, Date, FitData, DAH, value) %>%
arrange(field, Date)
}
diff --git a/r_app/30_growth_model_utils.R b/r_app/30_growth_model_utils.R
index 647b811..cca107e 100644
--- a/r_app/30_growth_model_utils.R
+++ b/r_app/30_growth_model_utils.R
@@ -208,7 +208,7 @@ extract_CI_data <- function(field_name, harvesting_data, field_CI_data, season,
# Add additional columns
CI <- CI %>%
dplyr::mutate(
- DOY = seq(1, n(), 1),
+ DAH = seq(1, n(), 1),
model = paste0("Data", season, " : ", field_name),
season = season,
subField = field_name
diff --git a/r_app/80_calculate_kpis.R b/r_app/80_calculate_kpis.R
index c0f5a2b..64b95eb 100644
--- a/r_app/80_calculate_kpis.R
+++ b/r_app/80_calculate_kpis.R
@@ -141,12 +141,15 @@ suppressPackageStartupMessages({
library(writexl) # For writing Excel outputs (KPI summary tables)
library(progress) # For progress bars during field processing
- # ML/Analysis (optional - only for harvest model inference)
- tryCatch({
- library(torch) # For PyTorch model inference (harvest readiness prediction)
- }, error = function(e) {
- message("Note: torch package not available - harvest model inference will be skipped")
- })
+ # ML models (for yield prediction KPI)
+ library(caret) # For training Random Forest with cross-validation
+ library(CAST) # For Forward Feature Selection in caret models
+
+ # ML models (for yield prediction KPI)
+ library(caret) # For training Random Forest with cross-validation
+ library(CAST) # For Forward Feature Selection in caret models
+
+
})
# ============================================================================
@@ -316,6 +319,9 @@ main <- function() {
# Use centralized paths from setup object (no need for file.path calls)
weekly_mosaic <- setup$weekly_mosaic_dir
daily_vals_dir <- setup$daily_ci_vals_dir
+ reports_dir <- setup$kpi_reports_dir
+ data_dir <- setup$data_dir
+
tryCatch({
source(here("r_app", "30_growth_model_utils.R"))
@@ -332,8 +338,8 @@ main <- function() {
message("WORKFLOW: CALCULATING 6 FARM-LEVEL KPIs (Script 90 compatible)")
message(strrep("=", 70))
- # Prepare inputs for KPI calculation (already created by setup_project_directories)
- reports_dir_kpi <- setup$kpi_reports_dir
+ # Prepare outputs and inputs for KPI calculation (already created by setup_project_directories)
+ reports_dir_kpi <- file.path(setup$reports_dir, "kpis")
cumulative_CI_vals_dir <- setup$cumulative_CI_vals_dir
# Load field boundaries for workflow (use data_dir from setup)
@@ -356,18 +362,15 @@ main <- function() {
stop("ERROR loading field boundaries: ", e$message)
})
- # Load harvesting data
- if (!exists("harvesting_data")) {
- warning("harvesting_data not loaded. TCH KPI will use placeholder values.")
- harvesting_data <- data.frame(field = character(), year = numeric(), tonnage_ha = numeric())
- }
+ # Load harvesting data for yield prediction (using common helper function)
+ harvesting_data <- load_harvest_data(setup$data_dir)
# Extract current week/year from end_date
current_week <- as.numeric(format(end_date, "%V"))
current_year <- as.numeric(format(end_date, "%G"))
# Call with correct signature
- kpi_results <- calculate_all_kpis(
+ kpi_results <- calculate_all_field_analysis_agronomic_support(
field_boundaries_sf = field_boundaries_sf,
current_week = current_week,
current_year = current_year,
@@ -376,8 +379,13 @@ main <- function() {
ci_rds_path = NULL,
harvesting_data = harvesting_data,
output_dir = reports_dir_kpi,
+ data_dir = setup$data_dir,
project_dir = project_dir
)
+
+ # Extract results
+ field_analysis_df <- kpi_results$field_analysis_df
+ export_paths <- kpi_results$export_paths
cat("\n=== KPI CALCULATION COMPLETE ===\n")
cat("Summary tables saved for Script 90 integration\n")
@@ -389,599 +397,57 @@ main <- function() {
message("CANE_SUPPLY WORKFLOW: PER-FIELD ANALYSIS (Script 91 compatible)")
message(strrep("=", 70))
- # Set reports_dir for CANE_SUPPLY workflow (used by export functions)
- reports_dir <- setup$kpi_reports_dir
- data_dir <- setup$data_dir
-
- # Continue with existing per-field analysis code below
-
- message("\n", strrep("-", 70))
- message("PHASE 1: PER-FIELD WEEKLY ANALYSIS ")
- message(strrep("-", 70))
-
- weeks <- calculate_week_numbers(end_date)
- current_week <- weeks$current_week
- current_year <- weeks$current_year
- previous_week <- weeks$previous_week
- previous_year <- weeks$previous_year
-
- message(paste("Week:", current_week, "/ Year (ISO 8601):", current_year))
- # Find per-field weekly mosaics
- message("Finding per-field weekly mosaics...")
+ # Define variables needed for workflow functions
+ data_dir <- setup$data_dir
- if (!dir.exists(weekly_mosaic)) {
- stop(paste("ERROR: weekly_mosaic directory not found:", weekly_mosaic,
- "\nScript 40 (mosaic creation) must be run first."))
- }
-
- field_dirs <- list.dirs(weekly_mosaic, full.names = FALSE, recursive = FALSE)
- field_dirs <- field_dirs[field_dirs != ""]
-
- if (length(field_dirs) == 0) {
- stop(paste("ERROR: No field subdirectories found in:", weekly_mosaic,
- "\nScript 40 must create weekly_mosaic/{FIELD}/ structure."))
- }
-
- # Verify we have mosaics for this week
- single_file_pattern <- sprintf("week_%02d_%d\\.tif", current_week, current_year)
- per_field_files <- c()
- for (field in field_dirs) {
- field_mosaic_dir <- file.path(weekly_mosaic, field)
- files <- list.files(field_mosaic_dir, pattern = single_file_pattern, full.names = TRUE)
- if (length(files) > 0) {
- per_field_files <- c(per_field_files, files)
- }
- }
-
- if (length(per_field_files) == 0) {
- stop(paste("ERROR: No mosaics found for week", current_week, "year", current_year,
- "\nExpected pattern:", single_file_pattern,
- "\nChecked:", weekly_mosaic))
- }
-
- message(paste(" ✓ Found", length(per_field_files), "per-field weekly mosaics"))
-
- mosaic_mode <- "per-field"
- mosaic_dir <- weekly_mosaic
-
-
-
- # Load field boundaries
+ # Load field boundaries for workflow (use data_dir from setup)
+ message("\nLoading field boundaries for KPI calculation...")
tryCatch({
- boundaries_result <- load_field_boundaries(data_dir)
-
+ boundaries_result <- load_field_boundaries(setup$data_dir)
+
if (is.list(boundaries_result) && "field_boundaries_sf" %in% names(boundaries_result)) {
field_boundaries_sf <- boundaries_result$field_boundaries_sf
} else {
field_boundaries_sf <- boundaries_result
}
-
+
if (nrow(field_boundaries_sf) == 0) {
stop("No fields loaded from boundaries")
}
-
- message(paste(" Loaded", nrow(field_boundaries_sf), "fields"))
+
+ message(paste(" ✓ Loaded", nrow(field_boundaries_sf), "fields"))
}, error = function(e) {
stop("ERROR loading field boundaries: ", e$message)
})
+
+ # Load harvesting data for yield prediction (using common helper function)
+ harvesting_data <- load_harvest_data(setup$data_dir)
+
+ # Extract current week/year from end_date
+ current_week <- as.numeric(format(end_date, "%V"))
+ current_year <- as.numeric(format(end_date, "%G"))
+
- message("Loading historical field data for trend calculations...")
- # Load up to 8 weeks (max of 4-week and 8-week trend requirements)
- # Function gracefully handles missing weeks and loads whatever exists
- num_weeks_to_load <- max(WEEKS_FOR_FOUR_WEEK_TREND, WEEKS_FOR_CV_TREND_LONG) # Always 8
- message(paste(" Attempting to load up to", num_weeks_to_load, "weeks of historical data..."))
-
- # Only auto-generate on first call (not in recursive calls from within load_historical_field_data)
- allow_auto_gen <- !exists("_INSIDE_AUTO_GENERATE", envir = .GlobalEnv)
-
- historical_data <- load_historical_field_data(project_dir, current_week, current_year, reports_dir,
- num_weeks = num_weeks_to_load,
- auto_generate = allow_auto_gen,
- field_boundaries_sf = field_boundaries_sf,
- daily_vals_dir = daily_vals_dir)
-
- # Load harvest.xlsx for planting dates (season_start)
- message("\nLoading harvest data from harvest.xlsx for planting dates...")
- harvest_file_path <- file.path(data_dir, "harvest.xlsx")
-
- harvesting_data <- tryCatch({
- if (file.exists(harvest_file_path)) {
- harvest_raw <- readxl::read_excel(harvest_file_path)
- harvest_raw$season_start <- as.Date(harvest_raw$season_start)
- harvest_raw$season_end <- as.Date(harvest_raw$season_end)
- message(paste(" ✓ Loaded harvest data:", nrow(harvest_raw), "rows"))
- harvest_raw
- } else {
- message(paste(" WARNING: harvest.xlsx not found at", harvest_file_path))
- NULL
- }
- }, error = function(e) {
- message(paste(" ERROR loading harvest.xlsx:", e$message))
- NULL
- })
-
- planting_dates <- extract_planting_dates(harvesting_data, field_boundaries_sf)
-
- # Validate planting_dates
- if (is.null(planting_dates) || nrow(planting_dates) == 0) {
- message("WARNING: No planting dates available. Using NA for all fields.")
- planting_dates <- data.frame(
- field_id = field_boundaries_sf$field,
- planting_date = rep(as.Date(NA), nrow(field_boundaries_sf)),
- stringsAsFactors = FALSE
- )
- }
- # Build per-field configuration
- message("\nPreparing mosaic configuration for statistics calculation...")
- message(" ✓ Using per-field mosaic architecture (1 TIFF per field)")
-
- # Per-field mode: each field has its own TIFF in weekly_mosaic/{FIELD}/week_*.tif
- field_grid <- list(
- mosaic_dir = mosaic_dir,
- mode = "per-field"
- )
-
- message("\nUsing modular RDS-based approach for weekly statistics...")
-
- # Load/calculate CURRENT week stats (from tiles or RDS cache)
- message("\n1. Loading/calculating CURRENT week statistics (week", current_week, ")...")
- current_stats <- load_or_calculate_weekly_stats(
- week_num = current_week,
- year = current_year,
+ # Call the main orchestrator function from kpi_calculation_utils.R
+ workflow_results <- calculate_field_analysis_cane_supply(
+ setup = setup,
+ client_config = client_config,
+ end_date = end_date,
project_dir = project_dir,
+ weekly_mosaic = weekly_mosaic,
+ daily_vals_dir = daily_vals_dir,
field_boundaries_sf = field_boundaries_sf,
- mosaic_dir = field_grid$mosaic_dir,
- reports_dir = reports_dir,
- report_date = end_date
+ data_dir = data_dir
)
-
- message(paste(" ✓ Loaded/calculated stats for", nrow(current_stats), "fields in current week"))
-
- # Load/calculate PREVIOUS week stats (from RDS cache or tiles)
- message("\n2. Loading/calculating PREVIOUS week statistics (week", previous_week, ")...")
-
- # Calculate report date for previous week (7 days before current)
- prev_report_date <- end_date - 7
-
- prev_stats <- load_or_calculate_weekly_stats(
- week_num = previous_week,
- year = previous_year,
- project_dir = project_dir,
- field_boundaries_sf = field_boundaries_sf,
- mosaic_dir = field_grid$mosaic_dir,
- reports_dir = reports_dir,
- report_date = prev_report_date
- )
-
- message(paste(" ✓ Loaded/calculated stats for", nrow(prev_stats), "fields in previous week"))
- message(paste(" Columns in prev_stats:", paste(names(prev_stats), collapse = ", ")))
- message(paste(" CV column non-NA values in prev_stats:", sum(!is.na(prev_stats$CV))))
-
- # Apply trend calculations (requires both weeks)
- message("\n3. Calculating trend columns...")
- current_stats <- calculate_kpi_trends(current_stats, prev_stats,
- project_dir = project_dir,
- reports_dir = reports_dir,
- current_week = current_week,
- year = current_year)
-
- message(paste(" ✓ Added Weekly_ci_change, CV_Trend_Short_Term, Four_week_trend, CV_Trend_Long_Term, nmr_of_weeks_analysed"))
-
- # Load weekly harvest probabilities from script 31 (if available)
- # Note: Script 31 saves to reports/kpis/field_stats/ (not field_level)
- message("\n4. Loading harvest probabilities from script 31...")
- harvest_prob_dir <- file.path(data_dir, "..", "reports", "kpis", "field_stats")
- harvest_prob_file <- file.path(harvest_prob_dir,
- sprintf("%s_harvest_imminent_week_%02d_%d.csv", project_dir, current_week, current_year))
- message(paste(" Looking for:", harvest_prob_file))
-
- imminent_prob_data <- tryCatch({
- if (file.exists(harvest_prob_file)) {
- prob_df <- readr::read_csv(harvest_prob_file, show_col_types = FALSE,
- col_types = readr::cols(.default = readr::col_character()))
- message(paste(" ✓ Loaded harvest probabilities for", nrow(prob_df), "fields"))
- prob_df %>%
- select(field, imminent_prob, detected_prob) %>%
- rename(Field_id = field, Imminent_prob_actual = imminent_prob, Detected_prob = detected_prob)
- } else {
- message(paste(" INFO: Harvest probabilities not available (script 31 not run)"))
- NULL
- }
- }, error = function(e) {
- message(paste(" WARNING: Could not load harvest probabilities:", e$message))
- NULL
- })
-
- # ============================================================================
- # CALCULATE GAP FILLING KPI (2σ method from kpi_utils.R)
- # ============================================================================
-
- message("\nCalculating gap filling scores (2σ method)...")
-
- # Process per-field mosaics
- message(paste(" Using per-field mosaics for", length(per_field_files), "fields"))
-
- field_boundaries_by_id <- split(field_boundaries_sf, field_boundaries_sf$field)
-
- process_gap_for_field <- function(field_file) {
- field_id <- basename(dirname(field_file))
- field_bounds <- field_boundaries_by_id[[field_id]]
-
- if (is.null(field_bounds) || nrow(field_bounds) == 0) {
- return(data.frame(Field_id = field_id, gap_score = NA_real_))
- }
-
- tryCatch({
- field_raster <- terra::rast(field_file)
- ci_band_name <- "CI"
- if (!(ci_band_name %in% names(field_raster))) {
- return(data.frame(Field_id = field_id, gap_score = NA_real_))
- }
- field_ci_band <- field_raster[[ci_band_name]]
- names(field_ci_band) <- "CI"
-
- gap_result <- calculate_gap_filling_kpi(field_ci_band, field_bounds)
-
- if (is.null(gap_result) || is.null(gap_result$field_results) || nrow(gap_result$field_results) == 0) {
- return(data.frame(Field_id = field_id, gap_score = NA_real_))
- }
-
- gap_scores <- gap_result$field_results
- gap_scores$Field_id <- gap_scores$field
- gap_scores <- gap_scores[, c("Field_id", "gap_score")]
-
- stats::aggregate(gap_score ~ Field_id, data = gap_scores, FUN = function(x) mean(x, na.rm = TRUE))
- }, error = function(e) {
- message(paste(" WARNING: Gap score failed for field", field_id, ":", e$message))
- data.frame(Field_id = field_id, gap_score = NA_real_)
- })
- }
-
- # Process fields sequentially with progress bar
- message(" Processing gap scores for ", length(per_field_files), " fields...")
- pb <- utils::txtProgressBar(min = 0, max = length(per_field_files), style = 3, width = 50)
- results_list <- lapply(seq_along(per_field_files), function(idx) {
- result <- process_gap_for_field(per_field_files[[idx]])
- utils::setTxtProgressBar(pb, idx)
- result
- })
- close(pb)
-
- gap_scores_df <- dplyr::bind_rows(results_list)
-
- if (!is.null(gap_scores_df) && nrow(gap_scores_df) > 0) {
- gap_scores_df <- gap_scores_df %>%
- dplyr::group_by(Field_id) %>%
- dplyr::summarise(gap_score = mean(gap_score, na.rm = TRUE), .groups = "drop")
-
- message(paste(" ✓ Calculated gap scores for", nrow(gap_scores_df), "fields"))
- message(paste(" Gap score range:", round(min(gap_scores_df$gap_score, na.rm=TRUE), 2), "-", round(max(gap_scores_df$gap_score, na.rm=TRUE), 2), "%"))
- } else {
- message(" WARNING: No gap scores calculated from per-field mosaics")
- gap_scores_df <- NULL
- }
-
- # ============================================================================
- # Build final output dataframe with all 22 columns (including Gap_score)
- # ============================================================================
-
- message("\nBuilding final field analysis output...")
-
- # Pre-calculate acreages with geometry validation
- # This avoids geometry errors during field_analysis construction
- acreage_lookup <- tryCatch({
- lookup_df <- field_boundaries_sf %>%
- sf::st_drop_geometry() %>%
- as.data.frame() %>%
- mutate(
- geometry_valid = sapply(seq_len(nrow(field_boundaries_sf)), function(idx) {
- tryCatch({
- sf::st_is_valid(field_boundaries_sf[idx, ])
- }, error = function(e) FALSE)
- }),
- area_ha = 0
- )
+ # Extract results
+ field_analysis_df <- workflow_results$field_analysis_df
+ farm_kpi_results <- workflow_results$farm_kpi_results
+ export_paths <- workflow_results$export_paths
- # Calculate area for valid geometries
- for (idx in which(lookup_df$geometry_valid)) {
- tryCatch({
- area_m2 <- as.numeric(sf::st_area(field_boundaries_sf[idx, ]))
- lookup_df$area_ha[idx] <- area_m2 / 10000
- }, error = function(e) {
- lookup_df$area_ha[idx] <<- NA_real_
- })
- }
-
- # Convert hectares to acres
- lookup_df %>%
- mutate(acreage = area_ha / 0.404686) %>%
- select(field, acreage)
- }, error = function(e) {
- message(paste("Warning: Could not calculate acreages from geometries -", e$message))
- data.frame(field = character(0), acreage = numeric(0))
- })
-
- field_analysis_df <- current_stats %>%
- mutate(
- # Column 2: Farm_Section (user fills)
- Farm_Section = NA_character_,
- # Column 3: Field_name (from GeoJSON - already have Field_id, can look up)
- Field_name = Field_id,
- # Column 4: Acreage (calculate from geometry)
- Acreage = {
- acreages_vec <- acreage_lookup$acreage[match(Field_id, acreage_lookup$field)]
- if_else(is.na(acreages_vec), 0, acreages_vec)
- },
- # Columns 5-6: Already in current_stats (Mean_CI, Weekly_ci_change)
- # Column 7: Four_week_trend (from current_stats)
- # Column 8: Last_harvest_or_planting_date (from harvest.xlsx - season_start)
- Last_harvest_or_planting_date = {
- planting_dates$planting_date[match(Field_id, planting_dates$field_id)]
- },
- # Column 9: Age_week (calculated from report date and planting date)
- Age_week = {
- sapply(seq_len(nrow(current_stats)), function(idx) {
- planting_dt <- Last_harvest_or_planting_date[idx]
- if (is.na(planting_dt)) {
- return(NA_real_)
- }
- round(as.numeric(difftime(end_date, planting_dt, units = "weeks")), 0)
- })
- },
- # Column 10: Phase (recalculate based on updated Age_week)
- Phase = {
- sapply(Age_week, function(age) {
- if (is.na(age)) return(NA_character_)
- if (age >= 0 & age < 4) return("Germination")
- if (age >= 4 & age < 17) return("Tillering")
- if (age >= 17 & age < 39) return("Grand Growth")
- if (age >= 39) return("Maturation")
- NA_character_
- })
- },
- # Column 11: nmr_of_weeks_analysed (already in current_stats from calculate_kpi_trends)
- # Column 12: Germination_progress (calculated here from CI values)
- # Bin Pct_pixels_CI_gte_2 into 10% intervals: 0-10%, 10-20%, ..., 80-90%, 90-95%, 95-100%
- Germination_progress = sapply(Pct_pixels_CI_gte_2, function(pct) {
- if (is.na(pct)) return(NA_character_)
- if (pct >= 95) return("95-100%")
- else if (pct >= 90) return("90-95%")
- else if (pct >= 80) return("80-90%")
- else if (pct >= 70) return("70-80%")
- else if (pct >= 60) return("60-70%")
- else if (pct >= 50) return("50-60%")
- else if (pct >= 40) return("40-50%")
- else if (pct >= 30) return("30-40%")
- else if (pct >= 20) return("20-30%")
- else if (pct >= 10) return("10-20%")
- else return("0-10%")
- }),
- # Column 13: Imminent_prob (from script 31 or NA if not available)
- Imminent_prob = {
- if (!is.null(imminent_prob_data)) {
- imminent_prob_data$Imminent_prob_actual[match(Field_id, imminent_prob_data$Field_id)]
- } else {
- rep(NA_real_, nrow(current_stats))
- }
- },
- # Column 14: Status_Alert (based on harvest probability + crop health status)
- # Priority order: Ready for harvest-check → Strong decline → Harvested/bare → NA
- Status_Alert = {
- sapply(seq_len(nrow(current_stats)), function(idx) {
- imminent_prob <- Imminent_prob[idx]
- age_w <- Age_week[idx]
- weekly_ci_chg <- Weekly_ci_change[idx]
- mean_ci_val <- Mean_CI[idx]
-
- # Priority 1: Ready for harvest-check (imminent + mature cane ≥12 months)
- if (!is.na(imminent_prob) && imminent_prob > 0.5 && !is.na(age_w) && age_w >= 52) {
- return("Ready for harvest-check")
- }
-
- # Priority 2: Strong decline in crop health (drop ≥2 points but still >1.5)
- if (!is.na(weekly_ci_chg) && weekly_ci_chg <= -2.0 && !is.na(mean_ci_val) && mean_ci_val > 1.5) {
- return("Strong decline in crop health")
- }
-
- # Priority 3: Harvested/bare (Mean CI < 1.5)
- if (!is.na(mean_ci_val) && mean_ci_val < 1.5) {
- return("Harvested/bare")
- }
-
- # Fallback: no alert
- NA_character_
- })
- },
- # Columns 15-16: CI-based columns already in current_stats (CI_range, CI_Percentiles)
- # Column 17: Already in current_stats (CV)
- # Column 18: Already in current_stats (CV_Trend_Short_Term)
- # Column 19: CV_Trend_Long_Term (from current_stats - raw slope value)
- # Column 19b: CV_Trend_Long_Term_Category (categorical interpretation of slope)
- # 3 classes: More uniform (slope < -0.01), Stable uniformity (-0.01 to 0.01), Less uniform (slope > 0.01)
- CV_Trend_Long_Term_Category = {
- sapply(current_stats$CV_Trend_Long_Term, function(slope) {
- if (is.na(slope)) {
- return(NA_character_)
- } else if (slope < -0.01) {
- return("More uniform")
- } else if (slope > 0.01) {
- return("Less uniform")
- } else {
- return("Stable uniformity")
- }
- })
- },
- # Columns 20-21: Already in current_stats (Cloud_pct_clear, Cloud_category)
- # Bin Cloud_pct_clear into 10% intervals: 0-10%, 10-20%, ..., 80-90%, 90-95%, 95-100%
- Cloud_pct_clear = sapply(Cloud_pct_clear, function(pct) {
- if (is.na(pct)) return(NA_character_)
- if (pct >= 95) return("95-100%")
- else if (pct >= 90) return("90-95%")
- else if (pct >= 80) return("80-90%")
- else if (pct >= 70) return("70-80%")
- else if (pct >= 60) return("60-70%")
- else if (pct >= 50) return("50-60%")
- else if (pct >= 40) return("40-50%")
- else if (pct >= 30) return("30-40%")
- else if (pct >= 20) return("20-30%")
- else if (pct >= 10) return("10-20%")
- else return("0-10%")
- }),
- # Column 22: Gap_score (2σ below median - from kpi_utils.R)
- Gap_score = {
- if (!is.null(gap_scores_df) && nrow(gap_scores_df) > 0) {
- # Debug: Print first few gap scores
- message(sprintf(" Joining %d gap scores to field_analysis (first 3: %s)",
- nrow(gap_scores_df),
- paste(head(gap_scores_df$gap_score, 3), collapse=", ")))
- message(sprintf(" First 3 Field_ids in gap_scores_df: %s",
- paste(head(gap_scores_df$Field_id, 3), collapse=", ")))
- message(sprintf(" First 3 Field_ids in current_stats: %s",
- paste(head(current_stats$Field_id, 3), collapse=", ")))
-
- gap_scores_df$gap_score[match(current_stats$Field_id, gap_scores_df$Field_id)]
- } else {
- rep(NA_real_, nrow(current_stats))
- }
- }
- ) %>%
- select(
- all_of(c("Field_id", "Farm_Section", "Field_name", "Acreage", "Status_Alert",
- "Last_harvest_or_planting_date", "Age_week", "Phase",
- "Germination_progress",
- "Mean_CI", "Weekly_ci_change", "Four_week_trend", "CI_range", "CI_Percentiles",
- "CV", "CV_Trend_Short_Term", "CV_Trend_Long_Term", "CV_Trend_Long_Term_Category",
- "Imminent_prob", "Cloud_pct_clear", "Cloud_category", "Gap_score"))
- )
-
- message(paste("✓ Built final output with", nrow(field_analysis_df), "fields and 22 columns (including Gap_score)"))
-
- export_paths <- export_field_analysis_excel(
- field_analysis_df,
- NULL,
- project_dir,
- current_week,
- current_year,
- reports_dir
- )
-
- cat("\n--- Per-field Results (first 10) ---\n")
- available_cols <- c("Field_id", "Acreage", "Age_week", "Mean_CI", "Four_week_trend", "Status_Alert", "Cloud_category")
- available_cols <- available_cols[available_cols %in% names(field_analysis_df)]
- if (length(available_cols) > 0) {
- print(head(field_analysis_df[, available_cols], 10))
- }
-
- # ========== FARM-LEVEL KPI AGGREGATION ==========
- # Aggregate the per-field analysis into farm-level summary statistics
-
- cat("\n=== CALCULATING FARM-LEVEL KPI SUMMARY ===\n")
-
- # Filter to only fields that have actual data (non-NA CI and valid acreage)
- field_data <- field_analysis_df %>%
- filter(!is.na(Mean_CI) & !is.na(Acreage)) %>%
- filter(Acreage > 0)
-
- if (nrow(field_data) > 0) {
-
- if (nrow(field_data) > 0) {
- # Create summary statistics
- farm_summary <- list()
-
- # 1. PHASE DISTRIBUTION
- phase_dist <- field_data %>%
- group_by(Phase) %>%
- summarise(
- num_fields = n(),
- acreage = sum(Acreage, na.rm = TRUE),
- .groups = 'drop'
- ) %>%
- rename(Category = Phase)
-
- farm_summary$phase_distribution <- phase_dist
-
- # 2. STATUS ALERT DISTRIBUTION
- status_dist <- field_data %>%
- group_by(Status_Alert) %>%
- summarise(
- num_fields = n(),
- acreage = sum(Acreage, na.rm = TRUE),
- .groups = 'drop'
- ) %>%
- rename(Category = Status_Alert)
-
- farm_summary$status_distribution <- status_dist
-
- # 3. CLOUD COVERAGE DISTRIBUTION
- cloud_dist <- field_data %>%
- group_by(Cloud_category) %>%
- summarise(
- num_fields = n(),
- acreage = sum(Acreage, na.rm = TRUE),
- .groups = 'drop'
- ) %>%
- rename(Category = Cloud_category)
-
- farm_summary$cloud_distribution <- cloud_dist
-
- # 4. OVERALL STATISTICS
- farm_summary$overall_stats <- data.frame(
- total_fields = nrow(field_data),
- total_acreage = sum(field_data$Acreage, na.rm = TRUE),
- mean_ci = round(mean(field_data$Mean_CI, na.rm = TRUE), 2),
- median_ci = round(median(field_data$Mean_CI, na.rm = TRUE), 2),
- mean_cv = round(mean(field_data$CV, na.rm = TRUE), 4),
- week = current_week,
- year = current_year,
- date = as.character(end_date)
- )
-
- # Print summaries
- cat("\n--- PHASE DISTRIBUTION ---\n")
- print(phase_dist)
-
- cat("\n--- STATUS TRIGGER DISTRIBUTION ---\n")
- print(status_dist)
-
- cat("\n--- CLOUD COVERAGE DISTRIBUTION ---\n")
- print(cloud_dist)
-
- cat("\n--- OVERALL FARM STATISTICS ---\n")
- print(farm_summary$overall_stats)
-
- farm_kpi_results <- farm_summary
- } else {
- farm_kpi_results <- NULL
- }
- } else {
- farm_kpi_results <- NULL
- }
-
- # ========== FINAL SUMMARY ==========
-
- cat("\n", strrep("=", 70), "\n")
- cat("80_CALCULATE_KPIs.R - COMPLETION SUMMARY\n")
- cat(strrep("=", 70), "\n")
- cat("Per-field analysis fields analyzed:", nrow(field_analysis_df), "\n")
- cat("Excel export:", export_paths$excel, "\n")
- cat("RDS export:", export_paths$rds, "\n")
- cat("CSV export:", export_paths$csv, "\n")
-
- if (!is.null(farm_kpi_results)) {
- cat("\nFarm-level KPIs: CALCULATED\n")
- } else {
- cat("\nFarm-level KPIs: SKIPPED (no valid tile data extracted)\n")
- }
-
- cat("\n✓ Consolidated KPI calculation complete!\n")
- cat(" - Per-field data exported\n")
- cat(" - Farm-level KPIs calculated\n")
- cat(" - All outputs in:", reports_dir, "\n\n")
-
- } else {
- # Unknown client type - log warning and exit
- warning(sprintf("Unknown client type: %s - no workflow matched", client_type))
+ } else {
+ # Unknown client type - log warning and exit
+ warning(sprintf("Unknown client type: %s - no workflow matched", client_type))
cat("\n⚠️ Warning: Client type '", client_type, "' does not match any known workflow\n", sep = "")
cat("Expected: 'agronomic_support' (aura) or 'cane_supply' (angata, etc.)\n")
cat("Check CLIENT_TYPE_MAP in parameters_project.R\n\n")
diff --git a/r_app/80_utils_agronomic_support.R b/r_app/80_utils_agronomic_support.R
index 421b35f..9408b2b 100644
--- a/r_app/80_utils_agronomic_support.R
+++ b/r_app/80_utils_agronomic_support.R
@@ -1,8 +1,8 @@
# 80_UTILS_AGRONOMIC_SUPPORT.R
# ============================================================================
-# SPECIFIC KPI UTILITIES (SCRIPT 80 - CLIENT TYPE: agronomic_support)
+# AURA-SPECIFIC KPI UTILITIES (SCRIPT 80 - CLIENT TYPE: agronomic_support)
#
-# Contains all 6 KPI calculation functions and helpers:
+# Contains all 6 AURA KPI calculation functions and helpers:
# - Field uniformity KPI (CV-based, spatial autocorrelation)
# - Area change KPI (week-over-week CI changes)
# - TCH forecasted KPI (tonnage projections from harvest data)
@@ -12,7 +12,7 @@
# - KPI reporting (summary tables, field details, text interpretation)
# - KPI export (Excel, RDS, data export)
#
-# Orchestrator: calculate_all_kpis()
+# Orchestrator: calculate_all_field_analysis_agronomic_support()
# Dependencies: 00_common_utils.R (safe_log), sourced from common
# Used by: 80_calculate_kpis.R (when client_type == "agronomic_support")
# ============================================================================
@@ -41,31 +41,8 @@ library(spdep)
# These are now sourced from common utils and shared by all client types.
# ============================================================================
-#' Prepare harvest predictions and ensure proper alignment with field data
-prepare_predictions <- function(harvest_model, field_data, scenario = "optimistic") {
- if (is.null(harvest_model) || is.null(field_data)) {
- return(NULL)
- }
-
- tryCatch({
- scenario_factor <- switch(scenario,
- "pessimistic" = 0.85,
- "realistic" = 1.0,
- "optimistic" = 1.15,
- 1.0)
-
- predictions <- field_data %>%
- mutate(tch_forecasted = field_data$mean_ci * scenario_factor)
-
- return(predictions)
- }, error = function(e) {
- message(paste("Error preparing predictions:", e$message))
- return(NULL)
- })
-}
-
# ============================================================================
-# KPI CALCULATION FUNCTIONS (6 KPIS)
+# AURA KPI CALCULATION FUNCTIONS (6 KPIS)
# ============================================================================
#' KPI 1: Calculate field uniformity based on CV and spatial autocorrelation
@@ -75,40 +52,82 @@ prepare_predictions <- function(harvest_model, field_data, scenario = "optimisti
#'
#' @param ci_pixels_by_field List of CI pixel arrays for each field
#' @param field_boundaries_sf SF object with field geometries
-#' @param ci_raster Raster object with CI values (for spatial autocorrelation)
+#' @param ci_band Raster band with CI values
#'
#' @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) {
- results_list <- list()
+calculate_field_uniformity_kpi <- function(ci_pixels_by_field, field_boundaries_sf, ci_band = NULL,
+ mosaic_dir = NULL, week_file = NULL) {
+ result <- data.frame(
+ field_idx = integer(),
+ cv_value = numeric(),
+ morans_i = numeric(),
+ uniformity_score = numeric(),
+ uniformity_category = character(),
+ interpretation = character(),
+ stringsAsFactors = FALSE
+ )
+
+ # Determine if we're using per-field structure
+ is_per_field <- !is.null(mosaic_dir) && !is.null(week_file)
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) {
- results_list[[length(results_list) + 1]] <- list(
+ result <- rbind(result, data.frame(
field_idx = field_idx,
cv_value = NA_real_,
morans_i = NA_real_,
uniformity_score = NA_real_,
- interpretation = "No data"
- )
+ uniformity_category = "No data",
+ interpretation = "No data",
+ stringsAsFactors = FALSE
+ ))
next
}
cv_val <- calculate_cv(ci_pixels)
+ # Calculate Moran's I
morans_i <- NA_real_
- if (!is.null(ci_raster)) {
- morans_result <- calculate_spatial_autocorrelation(ci_raster, field_boundaries_sf[field_idx, ])
- if (is.list(morans_result)) {
- morans_i <- morans_result$morans_i
- } else {
- morans_i <- morans_result
+ if (is_per_field) {
+ # Load individual field raster for per-field structure
+ field_name <- field_boundaries_sf$field[field_idx]
+ field_mosaic_path <- file.path(mosaic_dir, field_name, week_file)
+
+ if (file.exists(field_mosaic_path)) {
+ tryCatch({
+ field_raster <- terra::rast(field_mosaic_path)[["CI"]]
+ single_field <- field_boundaries_sf[field_idx, ]
+ morans_result <- calculate_spatial_autocorrelation(field_raster, single_field)
+
+ if (is.list(morans_result)) {
+ morans_i <- morans_result$morans_i
+ } else {
+ morans_i <- morans_result
+ }
+ }, error = function(e) {
+ message(paste(" Warning: Spatial autocorrelation failed for field", field_name, ":", e$message))
+ })
}
+ } else if (!is.null(ci_band) && inherits(ci_band, "SpatRaster")) {
+ # Use single raster for single-file structure
+ tryCatch({
+ single_field <- field_boundaries_sf[field_idx, ]
+ morans_result <- calculate_spatial_autocorrelation(ci_band, single_field)
+
+ if (is.list(morans_result)) {
+ morans_i <- morans_result$morans_i
+ } else {
+ morans_i <- morans_result
+ }
+ }, error = function(e) {
+ message(paste(" Warning: Spatial autocorrelation failed for field", field_idx, ":", e$message))
+ })
}
# Normalize CV (0-1 scale, invert so lower CV = higher score)
- cv_normalized <- min(cv_val / 0.3, 1) # 0.3 = threshold for CV
+ cv_normalized <- min(cv_val / 0.3, 1)
cv_score <- 1 - cv_normalized
# Normalize Moran's I (-1 to 1 scale, shift to 0-1)
@@ -123,30 +142,34 @@ calculate_field_uniformity_kpi <- function(ci_pixels_by_field, field_boundaries_
# Interpretation
if (is.na(cv_val)) {
interpretation <- "No data"
+ uniformity_category <- "No data"
} else if (cv_val < 0.08) {
interpretation <- "Excellent uniformity"
+ uniformity_category <- "Excellent"
} else if (cv_val < 0.15) {
interpretation <- "Good uniformity"
+ uniformity_category <- "Good"
} else if (cv_val < 0.25) {
interpretation <- "Acceptable uniformity"
+ uniformity_category <- "Acceptable"
} else if (cv_val < 0.4) {
interpretation <- "Poor uniformity"
+ uniformity_category <- "Poor"
} else {
interpretation <- "Very poor uniformity"
+ uniformity_category <- "Very poor"
}
- results_list[[length(results_list) + 1]] <- list(
+ result <- rbind(result, data.frame(
field_idx = field_idx,
cv_value = cv_val,
morans_i = morans_i,
uniformity_score = round(uniformity_score, 3),
- interpretation = interpretation
- )
- }
-
- # Convert accumulated list to data frame in a single operation
- result <- do.call(rbind, lapply(results_list, as.data.frame))
-
+ uniformity_category = uniformity_category,
+ interpretation = interpretation,
+ stringsAsFactors = FALSE
+ ))
+ }
return(result)
}
@@ -158,70 +181,167 @@ calculate_field_uniformity_kpi <- function(ci_pixels_by_field, field_boundaries_
#' @param previous_stats Previous week field statistics
#'
#' @return Data frame with field-level CI changes
-calculate_area_change_kpi <- function(current_stats, previous_stats) {
- result <- calculate_change_percentages(current_stats, previous_stats)
+calculate_area_change_kpi <- function(current_stats, previous_stats, field_boundaries_sf = NULL) {
- # Add interpretation
- result$interpretation <- NA_character_
-
- for (i in seq_len(nrow(result))) {
- change <- result$mean_ci_pct_change[i]
-
- if (is.na(change)) {
- result$interpretation[i] <- "No previous data"
- } else if (change > 15) {
- result$interpretation[i] <- "Rapid growth"
- } else if (change > 5) {
- result$interpretation[i] <- "Positive growth"
- } else if (change > -5) {
- result$interpretation[i] <- "Stable"
- } else if (change > -15) {
- result$interpretation[i] <- "Declining"
- } else {
- result$interpretation[i] <- "Rapid decline"
- }
+ # Initialize field index vector
+ field_idx_vec <- seq_len(nrow(current_stats))
+ if (!is.null(field_boundaries_sf) && "Field_id" %in% names(current_stats)) {
+ field_idx_vec <- match(current_stats$Field_id, field_boundaries_sf$field)
}
+ # Initialize result data frame
+ result <- data.frame(
+ field_idx = field_idx_vec,
+ mean_ci_abs_change = NA_real_,
+ interpretation = NA_character_,
+ stringsAsFactors = FALSE
+ )
+
+ # Handle case where previous stats is NULL or empty
+ if (is.null(previous_stats) || nrow(previous_stats) == 0) {
+ result$interpretation <- "No previous data"
+ return(result)
+ }
+
+ # Match fields between current and previous stats
+ # Handle both naming conventions (Field_id vs field_idx)
+ if ("Field_id" %in% names(current_stats)) {
+ current_field_col <- "Field_id"
+ prev_field_col <- "Field_id"
+ ci_col <- "Mean_CI"
+ } else {
+ current_field_col <- "field_idx"
+ prev_field_col <- "field_idx"
+ ci_col <- "mean_ci"
+ }
+
+ # Create lookup for previous stats
+ prev_lookup <- setNames(
+ previous_stats[[ci_col]],
+ previous_stats[[prev_field_col]]
+ )
+
+ # Calculate percentage change for each field
+ for (i in seq_len(nrow(current_stats))) {
+ current_field_id <- current_stats[[current_field_col]][i]
+ current_ci <- current_stats[[ci_col]][i]
+
+ # Find matching previous CI value
+ prev_ci <- prev_lookup[[as.character(current_field_id)]]
+
+ if (!is.null(prev_ci) && !is.na(prev_ci) && !is.na(current_ci)) {
+ # Calculate absolute change (CI units)
+ abs_change <- current_ci - prev_ci
+ result$mean_ci_abs_change[i] <- round(abs_change, 2)
+
+ # Add interpretation
+ if (abs_change > 0.5) {
+ result$interpretation[i] <- "Rapid growth"
+ } else if (abs_change > 0.2) {
+ result$interpretation[i] <- "Positive growth"
+ } else if (abs_change >= -0.2) {
+ result$interpretation[i] <- "Stable"
+ } else if (abs_change >= -0.5) {
+ result$interpretation[i] <- "Declining"
+ } else {
+ result$interpretation[i] <- "Rapid decline"
+ }
+ } else {
+ result$interpretation[i] <- "No previous data"
+ }
+ }
return(result)
}
#' KPI 3: Calculate TCH forecasted (tonnes of cane per hectare)
#'
-#' Projects final harvest tonnage based on CI growth trajectory
+#' Projects final harvest tonnage based on historical yield data and CI growth trajectory.
+#' Uses a Random Forest model trained on harvest data to predict yields for mature fields.
+#' Delegates to calculate_yield_prediction_kpi() in 80_utils_common.R.
#'
-#' @param field_statistics Current field statistics
-#' @param harvesting_data Historical harvest data (with yield observations)
-#' @param field_boundaries_sf Field geometries
+#' @param field_statistics Current field statistics (dataframe with Mean_CI or mean_ci column)
+#' @param harvesting_data Historical harvest data frame (with tonnage_ha column)
+#' @param field_boundaries_sf SF object with field geometries
+#' @param cumulative_CI_vals_dir Directory with combined CI RDS files (optional)
+#' @param data_dir Project data directory (from setup_project_directories or parameters_project.R)
+#' Used to build cumulative_CI_vals_dir path if not provided directly (optional)
+#' @param project_dir Deprecated: only used if data_dir not provided (optional)
#'
-#' @return Data frame with field-level TCH forecasts
-calculate_tch_forecasted_kpi <- function(field_statistics, harvesting_data = NULL, field_boundaries_sf = NULL) {
- result <- data.frame(
- field_idx = field_statistics$field_idx,
- mean_ci = field_statistics$mean_ci,
- tch_forecasted = NA_real_,
- tch_lower_bound = NA_real_,
- tch_upper_bound = NA_real_,
- confidence = NA_character_,
- stringsAsFactors = FALSE
- )
+#' @return Data frame with field-level yield forecasts ready for orchestrator
+#' Columns: field_idx, tch_forecasted (yields in t/ha)
+calculate_tch_forecasted_kpi <- function(field_statistics, harvesting_data = NULL,
+ field_boundaries_sf = NULL,
+ cumulative_CI_vals_dir = NULL,
+ data_dir = NULL,
+ project_dir = NULL) {
- # Base TCH model: TCH = 50 + (CI * 10)
- # This is a simplified model; production use should include more variables
+ # Use common utils yield prediction function (handles all ML logic)
+ # This replaces the previous linear model (TCH = 50 + CI*10) with proper ML prediction
- for (i in seq_len(nrow(result))) {
- if (is.na(result$mean_ci[i])) {
- result$confidence[i] <- "No data"
- next
- }
-
- 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"
+ # Validate required parameters
+ if (is.null(field_boundaries_sf)) {
+ safe_log("field_boundaries_sf is NULL in calculate_tch_forecasted_kpi", "WARNING")
+ return(data.frame(
+ field_idx = integer(),
+ tch_forecasted = numeric(),
+ stringsAsFactors = FALSE
+ ))
+ }
+
+ # Determine cumulative CI directory
+ if (is.null(cumulative_CI_vals_dir)) {
+ # Priority 1: Use provided data_dir parameter
+ if (!is.null(data_dir)) {
+ cumulative_CI_vals_dir <- file.path(data_dir, "extracted_ci", "cumulative_vals")
+ } else if (exists("data_dir", envir = .GlobalEnv)) {
+ # Priority 2: Fallback to global data_dir from parameters_project.R
+ cumulative_CI_vals_dir <- file.path(get("data_dir", envir = .GlobalEnv), "extracted_ci", "cumulative_vals")
+ } else {
+ # Priority 3: Last resort - log warning and fail gracefully
+ safe_log("Missing project data directory configuration: provide data_dir parameter or ensure parameters_project.R has set data_dir globally", "WARNING")
+ safe_log("No training data available for yield prediction", "WARNING")
+ return(data.frame(
+ field_idx = integer(),
+ tch_forecasted = numeric(),
+ stringsAsFactors = FALSE
+ ))
}
}
+ # Call the shared yield prediction function from common utils
+ yield_result <- calculate_yield_prediction_kpi(field_boundaries_sf, harvesting_data, cumulative_CI_vals_dir)
+
+ # Extract field-level results from the list
+ field_results <- yield_result$field_results
+
+ # Convert to format expected by orchestrator
+ # If no predictions, return empty data frame
+ if (is.null(field_results) || nrow(field_results) == 0) {
+ return(data.frame(
+ field_idx = integer(),
+ tch_forecasted = numeric(),
+ stringsAsFactors = FALSE
+ ))
+ }
+
+ # Map field names to field_idx using field_boundaries_sf
+ result <- field_results %>%
+ mutate(
+ field_idx = match(field, field_boundaries_sf$field),
+ tch_forecasted = yield_forecast_t_ha
+ ) %>%
+ filter(!is.na(field_idx)) %>%
+ select(field_idx, tch_forecasted)
+
+ # Ensure result has proper structure even if empty
+ if (nrow(result) == 0) {
+ return(data.frame(
+ field_idx = integer(),
+ tch_forecasted = numeric(),
+ stringsAsFactors = FALSE
+ ))
+ }
+
return(result)
}
@@ -283,295 +403,300 @@ calculate_growth_decline_kpi <- function(ci_values_list) {
return(result)
}
-#' KPI 5: Calculate weed presence indicator
+
#'
-#' Detects field fragmentation/patchiness (potential weed/pest pressure)
+#' Combines two complementary metrics for comprehensive heterogeneity assessment:
+#' - Gini Coefficient: Distribution inequality of CI values (0=uniform, 1=unequal)
+#' - Moran's I: Spatial autocorrelation (-1 to +1, indicates clustering vs dispersal)
#'
#' @param ci_pixels_by_field List of CI pixel arrays for each field
+#' @param field_boundaries_sf SF object with field geometries
+#' @param mosaic_dir Directory path to per-field mosaic files (for Moran's I)
+#' @param week_file Week file pattern (for Moran's I calculation)
+#' @param mean_ci_values Optional vector of mean CI values per field
#'
-#' @return Data frame with fragmentation indicators
-calculate_weed_presence_kpi <- function(ci_pixels_by_field) {
+#' @return Data frame with gini_coefficient, morans_i, patchiness_risk, patchiness_interpretation
+calculate_patchiness_kpi <- function(ci_pixels_by_field, field_boundaries_sf = NULL,
+ mosaic_dir = NULL, week_file = NULL, mean_ci_values = NULL) {
+
+ n_fields <- length(ci_pixels_by_field)
+
result <- data.frame(
- field_idx = seq_len(length(ci_pixels_by_field)),
- cv_value = NA_real_,
- low_ci_percent = NA_real_,
- fragmentation_index = NA_real_,
- weed_pressure_risk = NA_character_,
+ field_idx = seq_len(n_fields),
+ gini_coefficient = NA_real_,
+ morans_i = NA_real_,
+ patchiness_risk = NA_character_,
+ patchiness_interpretation = NA_character_,
stringsAsFactors = FALSE
)
- for (field_idx in seq_len(length(ci_pixels_by_field))) {
- ci_pixels <- ci_pixels_by_field[[field_idx]]
+ # Determine if per-field structure available
+ is_per_field <- !is.null(mosaic_dir) && !is.null(week_file) && !is.null(field_boundaries_sf)
+
+ for (i in seq_len(n_fields)) {
+ ci_pixels <- ci_pixels_by_field[[i]]
if (is.null(ci_pixels) || length(ci_pixels) == 0) {
- result$weed_pressure_risk[field_idx] <- "No data"
+ result$patchiness_risk[i] <- "No data"
+ result$patchiness_interpretation[i] <- "No data"
next
}
ci_pixels <- ci_pixels[!is.na(ci_pixels)]
if (length(ci_pixels) == 0) {
- result$weed_pressure_risk[field_idx] <- "No data"
+ result$patchiness_risk[i] <- "No data"
+ result$patchiness_interpretation[i] <- "No data"
next
}
- cv_val <- calculate_cv(ci_pixels)
- low_ci_pct <- sum(ci_pixels < 1.5) / length(ci_pixels) * 100
- fragmentation <- cv_val * low_ci_pct / 100
-
- result$cv_value[field_idx] <- cv_val
- result$low_ci_percent[field_idx] <- round(low_ci_pct, 2)
- result$fragmentation_index[field_idx] <- round(fragmentation, 3)
-
- if (is.na(fragmentation)) {
- result$weed_pressure_risk[field_idx] <- "No data"
- } else if (fragmentation > 0.15) {
- result$weed_pressure_risk[field_idx] <- "High"
- } else if (fragmentation > 0.08) {
- result$weed_pressure_risk[field_idx] <- "Medium"
- } else if (fragmentation > 0.04) {
- result$weed_pressure_risk[field_idx] <- "Low"
- } else {
- result$weed_pressure_risk[field_idx] <- "Minimal"
+ # =========================================
+ # METRIC 1: Calculate Gini Coefficient
+ # =========================================
+ gini <- NA_real_
+ if (length(ci_pixels) > 1) {
+ ci_sorted <- sort(ci_pixels)
+ n <- length(ci_sorted)
+ numerator <- 2 * sum(seq_len(n) * ci_sorted)
+ denominator <- n * sum(ci_sorted)
+ gini <- (numerator / denominator) - (n + 1) / n
+ gini <- max(0, min(1, gini)) # Clamp to 0-1
}
+ result$gini_coefficient[i] <- gini
+
+ # =========================================
+ # METRIC 2: Calculate Moran's I (spatial clustering)
+ # =========================================
+ morans_i <- NA_real_
+ if (is_per_field) {
+ field_name <- field_boundaries_sf$field[i]
+ field_mosaic_path <- file.path(mosaic_dir, field_name, week_file)
+
+ if (file.exists(field_mosaic_path)) {
+ tryCatch({
+ field_raster <- terra::rast(field_mosaic_path)[["CI"]]
+ single_field <- field_boundaries_sf[i, ]
+ morans_result <- calculate_spatial_autocorrelation(field_raster, single_field)
+
+ if (is.list(morans_result)) {
+ morans_i <- morans_result$morans_i
+ } else {
+ morans_i <- morans_result
+ }
+ }, error = function(e) {
+ safe_log(paste("Warning: Moran's I failed for field", field_name, ":", e$message), "WARNING")
+ })
+ }
+ }
+ result$morans_i[i] <- morans_i
+
+ # =========================================
+ # RISK DETERMINATION: Gini + Moran's I combination
+ # =========================================
+ # Logic:
+ # - High Gini (>0.3) + High Moran's I (>0.85) = High patchiness (localized clusters)
+ # - High Gini + Low Moran's I = Medium patchiness (scattered heterogeneity)
+ # - Low Gini (<0.15) = Minimal patchiness (uniform)
+ # - Moderate Gini = Low to Medium patchiness
+
+ if (is.na(gini)) {
+ result$patchiness_risk[i] <- "No data"
+ } else if (gini < 0.15) {
+ result$patchiness_risk[i] <- "Minimal"
+ } else if (gini < 0.30) {
+ # Low-to-moderate Gini
+ if (!is.na(morans_i) && morans_i > 0.85) {
+ result$patchiness_risk[i] <- "Medium" # Some clustering
+ } else {
+ result$patchiness_risk[i] <- "Low"
+ }
+ } else if (gini < 0.50) {
+ # High Gini
+ if (!is.na(morans_i) && morans_i > 0.85) {
+ result$patchiness_risk[i] <- "High" # Localized problem clusters
+ } else {
+ result$patchiness_risk[i] <- "Medium" # Scattered issues
+ }
+ } else {
+ # Very high Gini (>0.5)
+ result$patchiness_risk[i] <- "High"
+ }
+
+ # =========================================
+ # INTERPRETATION: Combined Gini + Moran's I narrative
+ # =========================================
+ result$patchiness_interpretation[i] <- dplyr::case_when(
+ is.na(gini) ~ "No data",
+ gini < 0.15 & (is.na(morans_i) | morans_i < 0.75) ~
+ "Excellent uniformity - minimal patchiness",
+ gini < 0.30 & (is.na(morans_i) | morans_i < 0.75) ~
+ "Good uniformity - low patchiness",
+ gini < 0.30 & !is.na(morans_i) & morans_i > 0.85 ~
+ "Moderate uniformity with localized clustering",
+ gini < 0.50 & (is.na(morans_i) | morans_i < 0.75) ~
+ "Poor uniformity - scattered heterogeneity",
+ gini < 0.50 & !is.na(morans_i) & morans_i > 0.85 ~
+ "Poor uniformity with clustered problem areas",
+ gini >= 0.50 ~
+ "Severe heterogeneity - requires field investigation",
+ TRUE ~ "Mixed heterogeneity"
+ )
}
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
-# }
-# 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)
-
-# 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]
-
-# # 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
-
-# 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))
-
- return(field_results)
-}
# ============================================================================
# KPI ORCHESTRATOR AND REPORTING
# ============================================================================
-#' Create summary tables for all 6 KPIs (AGGREGATED farm-level summaries)
+#' Create summary tables for all 6 KPIs
#'
-#' @param all_kpis List containing results from all 6 KPI functions (per-field data)
+#' @param all_kpis List containing results from all 6 KPI functions
#'
-#' @return List of summary data frames ready for reporting (farm-level aggregates)
+#' @return List of summary data frames ready for reporting
create_summary_tables <- function(all_kpis) {
-
- # ==========================================
- # 1. UNIFORMITY SUMMARY (count by interpretation)
- # ==========================================
- uniformity_summary <- all_kpis$uniformity %>%
- group_by(interpretation) %>%
- summarise(
- field_count = n(),
- avg_cv = mean(cv_value, na.rm = TRUE),
- avg_morans_i = mean(morans_i, na.rm = TRUE),
- .groups = 'drop'
- ) %>%
- rename(
- Status = interpretation,
- `Field Count` = field_count,
- `Avg CV` = avg_cv,
- `Avg Moran's I` = avg_morans_i
- )
-
- # ==========================================
- # 2. AREA CHANGE SUMMARY (improving/stable/declining counts)
- # ==========================================
- area_change_summary <- all_kpis$area_change %>%
- group_by(interpretation) %>%
- summarise(
- field_count = n(),
- avg_ci_change = mean(mean_ci_pct_change, na.rm = TRUE),
- .groups = 'drop'
- ) %>%
- rename(
- Status = interpretation,
- `Field Count` = field_count,
- `Avg CI Change %` = avg_ci_change
- )
-
- # ==========================================
- # 3. TCH FORECAST SUMMARY (yield statistics)
- # ==========================================
- tch_summary <- all_kpis$tch_forecasted %>%
- summarise(
- avg_tch = mean(tch_forecasted, na.rm = TRUE),
- min_tch = min(tch_forecasted, na.rm = TRUE),
- max_tch = max(tch_forecasted, na.rm = TRUE),
- avg_ci = mean(mean_ci, na.rm = TRUE),
- fields_with_data = sum(!is.na(tch_forecasted))
- ) %>%
- rename(
- `Avg Forecast (t/ha)` = avg_tch,
- `Min (t/ha)` = min_tch,
- `Max (t/ha)` = max_tch,
- `Avg CI` = avg_ci,
- `Fields` = fields_with_data
- )
-
- # ==========================================
- # 4. GROWTH DECLINE SUMMARY (trend interpretation)
- # ==========================================
- growth_summary <- all_kpis$growth_decline %>%
- group_by(trend_interpretation) %>%
- summarise(
- field_count = n(),
- avg_trend = mean(four_week_trend, na.rm = TRUE),
- .groups = 'drop'
- ) %>%
- rename(
- Trend = trend_interpretation,
- `Field Count` = field_count,
- `Avg 4-Week Trend` = avg_trend
- )
-
- # ==========================================
- # 5. WEED PRESSURE SUMMARY (risk level counts)
- # ==========================================
- weed_summary <- all_kpis$weed_presence %>%
- group_by(weed_pressure_risk) %>%
- summarise(
- field_count = n(),
- avg_fragmentation = mean(fragmentation_index, na.rm = TRUE),
- .groups = 'drop'
- ) %>%
- rename(
- `Risk Level` = weed_pressure_risk,
- `Field Count` = field_count,
- `Avg Fragmentation` = avg_fragmentation
- )
-
- # ==========================================
- # 6. GAP FILLING SUMMARY
- # ==========================================
- gap_summary <- if (!is.null(all_kpis$gap_filling) && is.data.frame(all_kpis$gap_filling) && nrow(all_kpis$gap_filling) > 0) {
- all_kpis$gap_filling %>%
- summarise(
- avg_gap_filling = mean(gap_filling_success, na.rm = TRUE),
- avg_na_percent = mean(na_percent_pre_interpolation, na.rm = TRUE),
- fields_with_data = n()
- ) %>%
- rename(
- `Avg Gap Filling Success %` = avg_gap_filling,
- `Avg NA % Pre-Interpolation` = avg_na_percent,
- `Fields Analyzed` = fields_with_data
- )
- } else {
- data.frame(`Avg Gap Filling Success %` = NA_real_, `Avg NA % Pre-Interpolation` = NA_real_, `Fields Analyzed` = 0, check.names = FALSE)
- }
-
- # Return as list (each element is a farm-level summary table)
kpi_summary <- list(
- uniformity = uniformity_summary,
- area_change = area_change_summary,
- tch_forecast = tch_summary,
- growth_decline = growth_summary,
- weed_pressure = weed_summary,
- gap_filling = gap_summary
+ uniformity = all_kpis$uniformity %>%
+ select(field_idx, cv_value, uniformity_category, interpretation),
+
+ area_change = all_kpis$area_change %>%
+ select(field_idx, mean_ci_abs_change, interpretation),
+
+ tch_forecast = all_kpis$tch_forecasted %>%
+ select(field_idx, tch_forecasted),
+
+ growth_decline = all_kpis$growth_decline %>%
+ select(field_idx, four_week_trend, trend_interpretation, decline_severity),
+
+ patchiness = all_kpis$patchiness %>%
+ select(field_idx, gini_coefficient, morans_i, patchiness_interpretation, patchiness_risk),
+
+ gap_filling = if (!is.null(all_kpis$gap_filling) && nrow(all_kpis$gap_filling) > 0) {
+ all_kpis$gap_filling %>%
+ select(field_idx, gap_score, gap_level)
+ } else {
+ NULL
+ }
)
-
return(kpi_summary)
}
-#' Create detailed field-by-field KPI report
+#' Create detailed field-by-field KPI report (ALL KPIs in one row)
#'
-#' @param field_df Data frame with field identifiers and acreage
-#' @param all_kpis List with all KPI results
#' @param field_boundaries_sf SF object with field boundaries
+#' @param all_kpis List with all KPI results
+#' @param current_week Current week number
+#' @param current_year Current year
#'
-#' @return Data frame with one row per field, all KPI columns (renamed for reporting compatibility)
-create_field_detail_table <- function(field_df, all_kpis, field_boundaries_sf) {
- result <- field_df %>%
- left_join(
- all_kpis$uniformity %>% select(field_idx, cv_value, uniformity_interpretation = interpretation),
- by = c("field_idx")
- ) %>%
- left_join(
- all_kpis$area_change %>% select(field_idx, mean_ci_pct_change),
- by = c("field_idx")
- ) %>%
- left_join(
- all_kpis$tch_forecasted %>% select(field_idx, tch_forecasted, mean_ci),
- by = c("field_idx")
- ) %>%
- left_join(
- all_kpis$growth_decline %>% select(field_idx, decline_severity),
- by = c("field_idx")
- ) %>%
- left_join(
- all_kpis$weed_presence %>% select(field_idx, weed_pressure_risk),
- by = c("field_idx")
- ) %>%
- # Rename columns to match reporting script expectations
- rename(
- Field = field_name,
- `Growth Uniformity` = uniformity_interpretation,
- `Yield Forecast (t/ha)` = tch_forecasted,
- `Decline Risk` = decline_severity,
- `Weed Risk` = weed_pressure_risk,
- `CI Change %` = mean_ci_pct_change,
- `Mean CI` = mean_ci,
- `CV Value` = cv_value
- ) %>%
- # Add placeholder columns expected by reporting script (will be populated from other sources)
+#' @return Data frame with one row per field, all KPI columns
+create_field_detail_table <- function(field_boundaries_sf, all_kpis, current_week, current_year, current_stats = NULL) {
+
+ # Start with field identifiers AND field_idx for joining
+ result <- field_boundaries_sf %>%
+ sf::st_drop_geometry() %>%
mutate(
- `Field Size (ha)` = NA_real_,
- `Gap Score` = NA_real_
+ field_idx = row_number(),
+ Field_id = field,
+ Field_name = field,
+ Week = current_week,
+ Year = current_year
) %>%
- select(field_idx, Field, `Field Size (ha)`, `Growth Uniformity`, `Yield Forecast (t/ha)`,
- `Gap Score`, `Decline Risk`, `Weed Risk`, `CI Change %`, `Mean CI`, `CV Value`)
+ select(field_idx, Field_id, Field_name, Week, Year)
+
+ # ============================================
+ # GROUP 0: MEAN CI (from field statistics)
+ # ============================================
+ if (!is.null(current_stats)) {
+ result <- result %>%
+ left_join(
+ current_stats %>%
+ select(Field_id, Mean_CI),
+ by = "Field_id"
+ )
+ } else {
+ result$Mean_CI <- NA_real_
+ }
+
+ # ============================================
+ # GROUP 1: FIELD UNIFORMITY (KPI 1)
+ # ============================================
+ result <- result %>%
+ left_join(
+ all_kpis$uniformity %>%
+ select(field_idx, CV = cv_value,
+ Uniformity_Category = uniformity_category,
+ Uniformity_Interpretation = interpretation),
+ by = "field_idx"
+ )
+
+ # ============================================
+ # GROUP 2: GROWTH & TREND ANALYSIS (KPI 2 + KPI 4)
+ # ============================================
+ # KPI 2: Area Change
+ result <- result %>%
+ left_join(
+ all_kpis$area_change %>%
+ select(field_idx, Weekly_CI_Change = mean_ci_abs_change,
+ Area_Change_Interpretation = interpretation),
+ by = "field_idx"
+ )
+
+ # KPI 4: Growth Decline
+ result <- result %>%
+ left_join(
+ all_kpis$growth_decline %>%
+ select(field_idx, Four_Week_Trend = four_week_trend,
+ Trend_Interpretation = trend_interpretation,
+ Decline_Severity = decline_severity),
+ by = "field_idx"
+ )
+
+ # ============================================
+ # GROUP 3: FIELD HETEROGENEITY/PATCHINESS (KPI 5)
+ # ============================================
+ # KPI 5: Field Patchiness (Gini + Moran's I combination)
+ result <- result %>%
+ left_join(
+ all_kpis$patchiness %>%
+ select(field_idx, Gini_Coefficient = gini_coefficient,
+ Morans_I = morans_i,
+ Patchiness_Interpretation = patchiness_interpretation,
+ Patchiness_Risk = patchiness_risk),
+ by = "field_idx"
+ )
+
+ # ============================================
+ # GROUP 4: YIELD FORECAST (KPI 3)
+ # ============================================
+ result <- result %>%
+ left_join(
+ all_kpis$tch_forecasted %>%
+ select(field_idx, TCH_Forecasted = tch_forecasted),
+ by = "field_idx"
+ )
+
+ # ============================================
+ # GROUP 5: DATA QUALITY / GAP FILLING (KPI 6)
+ # ============================================
+ # Add gap filling if available
+ if (!is.null(all_kpis$gap_filling) && nrow(all_kpis$gap_filling) > 0) {
+ result <- result %>%
+ left_join(
+ all_kpis$gap_filling %>%
+ select(field_idx, Gap_Score = gap_score, Gap_Level = gap_level),
+ by = "field_idx"
+ )
+ }
+
+ # Remove field_idx from final output
+ result <- result %>%
+ select(-field_idx)
+
+ # Round numeric columns
+ result <- result %>%
+ mutate(across(where(is.numeric), ~ round(., 2)))
return(result)
}
@@ -583,7 +708,7 @@ create_field_detail_table <- function(field_df, all_kpis, field_boundaries_sf) {
#' @return Character string with formatted KPI summary text
create_field_kpi_text <- function(all_kpis) {
text_parts <- c(
- "## KPI ANALYSIS SUMMARY\n",
+ "## AURA KPI ANALYSIS SUMMARY\n",
"### Field Uniformity\n",
paste(all_kpis$uniformity$interpretation, collapse = "; "), "\n",
"### Growth Trends\n",
@@ -595,115 +720,37 @@ create_field_kpi_text <- function(all_kpis) {
return(paste(text_parts, collapse = ""))
}
-#' Export detailed KPI data to Excel/RDS
+#' Export detailed KPI data to Excel/RDS
#'
-#' @param all_kpis List with all KPI results (per-field data)
-#' @param kpi_summary List with summary tables (farm-level aggregates)
-#' @param project_dir Project name (for filename)
+#' @param field_detail_df Data frame with all KPI columns (one row per field)
+#' @param kpi_summary List with summary tables (optional, for metadata)
#' @param output_dir Directory for output files
#' @param week Week number
#' @param year Year
-#' @param field_boundaries_sf SF object with field boundaries (optional, for field_details_table)
-#'
+#' @param project_dir Project name
#' @return List of output file paths
-export_kpi_data <- function(all_kpis, kpi_summary, project_dir, output_dir, week, year, field_boundaries_sf = NULL) {
- # Ensure output directory exists
- if (!dir.exists(output_dir)) {
- dir.create(output_dir, recursive = TRUE)
- }
+export_kpi_data <- function(field_detail_df, kpi_summary, output_dir, week, year, project_dir) {
- # Create unified field details table if field_boundaries_sf is provided
- field_details_table <- NULL
- if (!is.null(field_boundaries_sf)) {
- tryCatch({
- # Create a basic field_df from the boundaries
- # Robust field name extraction with multiple fallbacks
- field_name <- NA_character_
-
- # Check for 'name' column in the data.frame
- if ("name" %in% names(field_boundaries_sf)) {
- field_name <- field_boundaries_sf$name
- } else if ("properties" %in% names(field_boundaries_sf)) {
- # Extract from properties column (may be a list-column)
- props <- field_boundaries_sf$properties
- if (is.list(props) && length(props) > 0 && "name" %in% names(props[[1]])) {
- field_name <- sapply(props, function(x) ifelse(is.null(x$name), NA_character_, x$name))
- } else if (!is.list(props)) {
- # Try direct access if properties is a simple column
- field_name <- props
- }
- }
-
- # 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(
- field_idx = 1:nrow(field_boundaries_sf),
- field_name = field_name,
- stringsAsFactors = FALSE
- )
-
- field_details_table <- create_field_detail_table(field_df, all_kpis, field_boundaries_sf)
- message(paste("✓ Field details table created with", nrow(field_details_table), "fields"))
- }, error = function(e) {
- message(paste("WARNING: Could not create field_details_table:", e$message))
- })
- }
-
- # Export all KPI tables to a single Excel file - use project_dir"
- excel_file <- file.path(output_dir, paste0(project_dir, "_kpi_summary_tables_week", sprintf("%02d_%d", week, year), ".xlsx"))
-
- sheets <- list(
- "Uniformity" = as.data.frame(kpi_summary$uniformity),
- "Area_Change" = as.data.frame(kpi_summary$area_change),
- "TCH_Forecast" = as.data.frame(kpi_summary$tch_forecast),
- "Growth_Decline" = as.data.frame(kpi_summary$growth_decline),
- "Weed_Pressure" = as.data.frame(kpi_summary$weed_pressure),
- "Gap_Filling" = as.data.frame(kpi_summary$gap_filling)
+ # Use the common export function from 80_utils_common.R
+ export_paths <- export_field_analysis_excel(
+ field_df = field_detail_df,
+ summary_df = NULL, # No separate summary sheet for agronomic support
+ project_dir = project_dir,
+ current_week = week,
+ year = year,
+ reports_dir = output_dir
)
- write_xlsx(sheets, excel_file)
- message(paste("✓ KPI data exported to:", excel_file))
-
- # Export to RDS for programmatic access (CRITICAL: Both per-field AND summary tables)
- # The reporting script expects: summary_tables (list of 6 summary tables)
- # We also provide: all_kpis (per-field data) and field_details (unified field view)
- rds_file <- file.path(output_dir, paste0(project_dir, "_kpi_summary_tables_week", sprintf("%02d_%d", week, year), ".rds"))
-
- # Create the export structure that reporting scripts expect
- export_data <- list(
- summary_tables = kpi_summary, # Farm-level aggregates (6 KPI summaries)
- all_kpis = all_kpis, # Per-field data (6 KPI per-field tables)
- field_details = field_details_table # Unified field-level detail table
- )
-
- saveRDS(export_data, rds_file)
- message(paste("✓ KPI RDS exported to:", rds_file))
- message(" Structure: list($summary_tables, $all_kpis, $field_details)")
-
- # Return including field_details for orchestrator to capture
- return(list(
- excel = excel_file,
- rds = rds_file,
- field_details = field_details_table
- ))
+ return(export_paths)
}
# ============================================================================
# ORCHESTRATOR FUNCTION
# ============================================================================
-#' Calculate all 6 KPIs
+#' Calculate all 6 AURA KPIs
#'
-#' Main entry point for KPI calculation.
+#' Main entry point for AURA KPI calculation.
#' This function orchestrates the 6 KPI calculations and returns all results.
#'
#' @param field_boundaries_sf SF object with field geometries
@@ -714,7 +761,6 @@ export_kpi_data <- function(all_kpis, kpi_summary, project_dir, output_dir, week
#' @param ci_rds_path Path to combined CI RDS file
#' @param harvesting_data Data frame with harvest data (optional)
#' @param output_dir Directory for KPI exports
-#' @param project_dir Project name (for filename in exports)
#'
#' @return List with results from all 6 KPI functions
#'
@@ -722,11 +768,11 @@ export_kpi_data <- function(all_kpis, kpi_summary, project_dir, output_dir, week
#' This function:
#' 1. Loads current week mosaic and extracts field statistics
#' 2. (Optionally) loads previous week mosaic for comparison metrics
-#' 3. Calculates all 6 KPIs
+#' 3. Calculates all 6 AURA KPIs
#' 4. Creates summary tables
#' 5. Exports results to Excel/RDS
#'
-calculate_all_kpis <- function(
+calculate_all_field_analysis_agronomic_support <- function(
field_boundaries_sf,
current_week,
current_year,
@@ -735,66 +781,311 @@ calculate_all_kpis <- function(
ci_rds_path = NULL,
harvesting_data = NULL,
output_dir = NULL,
+ data_dir = NULL,
project_dir = NULL
) {
- message("\n============ KPI CALCULATION (6 KPIs) ============")
+ message("\n============ AURA KPI CALCULATION (6 KPIs) ============")
- # Load current week mosaic
- message("Loading current week mosaic...")
- current_mosaic <- load_weekly_ci_mosaic(current_week, current_year, current_mosaic_dir)
+ # DETECT STRUCTURE FIRST - before any use of is_per_field
+ week_file <- sprintf("week_%02d_%d.tif", current_week, current_year)
- if (is.null(current_mosaic)) {
- stop("Could not load current week mosaic")
+ # Safely identify immediate child directories (not including root)
+ # Use list.files + dir.exists filter instead of list.dirs for robustness
+ all_entries <- list.files(current_mosaic_dir, full.names = FALSE)
+ field_dirs <- all_entries[sapply(
+ file.path(current_mosaic_dir, all_entries),
+ dir.exists
+ )]
+
+ is_per_field <- length(field_dirs) > 0 &&
+ file.exists(file.path(current_mosaic_dir, field_dirs[1], week_file))
+
+ if (is_per_field) {
+ message("Detected per-field mosaic structure...")
+ message("Using field-by-field extraction (similar to cane supply workflow)...")
+
+ # Use the same extraction method as cane supply
+ current_stats <- calculate_field_statistics(
+ field_boundaries_sf,
+ current_week,
+ current_year,
+ current_mosaic_dir,
+ report_date = Sys.Date()
+ )
+
+ # Extract CI pixels for each field from their individual mosaics
+ ci_pixels_by_field <- list()
+ for (i in seq_len(nrow(field_boundaries_sf))) {
+ field_name <- field_boundaries_sf$field[i]
+ field_mosaic_path <- file.path(current_mosaic_dir, field_name, week_file)
+
+ if (file.exists(field_mosaic_path)) {
+ tryCatch({
+ field_raster <- terra::rast(field_mosaic_path)
+ ci_band <- field_raster[["CI"]]
+ field_vect <- terra::vect(field_boundaries_sf[i, ])
+ ci_pixels_by_field[[i]] <- extract_ci_values(ci_band, field_vect)
+ }, error = function(e) {
+ message(paste(" Warning: Could not extract CI for field", field_name, ":", e$message))
+ ci_pixels_by_field[[i]] <- NULL
+ })
+ } else {
+ ci_pixels_by_field[[i]] <- NULL
+ }
+ }
+
+ # For uniformity calculations that need a reference raster, load first available
+ current_mosaic <- NULL
+ for (field_name in field_dirs) {
+ field_mosaic_path <- file.path(current_mosaic_dir, field_name, week_file)
+ if (file.exists(field_mosaic_path)) {
+ tryCatch({
+ current_mosaic <- terra::rast(field_mosaic_path)[["CI"]]
+ break
+ }, error = function(e) {
+ next
+ })
+ }
+ }
+
+ } else {
+ # Single-file mosaic (original behavior)
+ message("Loading current week mosaic...")
+ current_mosaic <- load_weekly_ci_mosaic(current_week, current_year, current_mosaic_dir)
+
+ if (is.null(current_mosaic)) {
+ stop("Could not load current week mosaic")
+ }
+
+ message("Extracting field statistics from current mosaic...")
+ current_stats <- extract_field_statistics_from_ci(current_mosaic, field_boundaries_sf)
+
+ # Extract CI pixels for each field individually
+ ci_pixels_by_field <- list()
+ for (i in seq_len(nrow(field_boundaries_sf))) {
+ field_vect <- terra::vect(field_boundaries_sf[i, ])
+ ci_pixels_by_field[[i]] <- extract_ci_values(current_mosaic, field_vect)
+ }
}
- # Extract field statistics
- message("Extracting field statistics from current mosaic...")
- current_stats <- extract_field_statistics_from_ci(current_mosaic, field_boundaries_sf)
- ci_pixels_by_field <- extract_ci_values(current_mosaic, field_boundaries_sf)
-
# Load previous week mosaic (if available)
previous_stats <- NULL
- if (!is.null(previous_mosaic_dir)) {
+ if (!is.null(previous_mosaic_dir) || is_per_field) {
target_prev <- calculate_target_week_and_year(current_week, current_year, offset_weeks = 1)
message(paste("Loading previous week mosaic (week", target_prev$week, target_prev$year, ")..."))
- previous_mosaic <- load_weekly_ci_mosaic(target_prev$week, target_prev$year, previous_mosaic_dir)
- if (!is.null(previous_mosaic)) {
- previous_stats <- extract_field_statistics_from_ci(previous_mosaic, field_boundaries_sf)
- } else {
- message("Previous week mosaic not available - skipping area change KPI")
+ if (is_per_field) {
+ # Try loading previous week from the same directory structure
+ prev_week_file <- sprintf("week_%02d_%d.tif", target_prev$week, target_prev$year)
+ prev_field_exists <- any(sapply(field_dirs, function(field) {
+ file.exists(file.path(current_mosaic_dir, field, prev_week_file))
+ }))
+
+ if (prev_field_exists) {
+ message(" Found previous week per-field mosaics, calculating statistics...")
+ previous_stats <- calculate_field_statistics(
+ field_boundaries_sf,
+ target_prev$week,
+ target_prev$year,
+ current_mosaic_dir,
+ report_date = Sys.Date() - 7
+ )
+ } else {
+ message(" Previous week mosaic not available - skipping area change KPI")
+ }
+ } else if (!is.null(previous_mosaic_dir)) {
+ previous_mosaic <- load_weekly_ci_mosaic(target_prev$week, target_prev$year, previous_mosaic_dir)
+
+ if (!is.null(previous_mosaic)) {
+ previous_stats <- extract_field_statistics_from_ci(previous_mosaic, field_boundaries_sf)
+ } else {
+ message(" Previous week mosaic not available - skipping area change KPI")
+ }
}
}
# Calculate 6 KPIs
message("\nCalculating KPI 1: Field Uniformity...")
- uniformity_kpi <- calculate_field_uniformity_kpi(ci_pixels_by_field, field_boundaries_sf, current_mosaic)
+ if (is_per_field) {
+ uniformity_kpi <- calculate_field_uniformity_kpi(
+ ci_pixels_by_field,
+ field_boundaries_sf,
+ ci_band = NULL,
+ mosaic_dir = current_mosaic_dir,
+ week_file = week_file
+ )
+ } else {
+ uniformity_kpi <- calculate_field_uniformity_kpi(
+ ci_pixels_by_field,
+ field_boundaries_sf,
+ current_mosaic
+ )
+ }
message("Calculating KPI 2: Area Change...")
if (!is.null(previous_stats)) {
- area_change_kpi <- calculate_area_change_kpi(current_stats, previous_stats)
+ area_change_kpi <- calculate_area_change_kpi(current_stats, previous_stats, field_boundaries_sf)
} else {
area_change_kpi <- data.frame(
field_idx = seq_len(nrow(field_boundaries_sf)),
- mean_ci_pct_change = NA_real_,
+ mean_ci_abs_change = NA_real_,
interpretation = rep("No previous data", nrow(field_boundaries_sf))
)
}
message("Calculating KPI 3: TCH Forecasted...")
- tch_kpi <- calculate_tch_forecasted_kpi(current_stats, harvesting_data, field_boundaries_sf)
+ tch_kpi <- calculate_tch_forecasted_kpi(current_stats, harvesting_data, field_boundaries_sf,
+ data_dir = data_dir, project_dir = project_dir)
message("Calculating KPI 4: Growth Decline...")
- growth_decline_kpi <- calculate_growth_decline_kpi(
- ci_pixels_by_field # Would need historical data for real trend
+
+ # Load historical field statistics to build weekly mean CI time series per field
+ # (growth_decline_kpi expects temporal series, not spatial pixel arrays)
+ weekly_mean_ci_by_field <- list()
+
+ # Build list of weekly mean CI values for each field (4-week lookback)
+ for (field_idx in seq_len(nrow(field_boundaries_sf))) {
+ weekly_ci_values <- c()
+ }
+
+ # Try to load historical data for trend calculation
+ if (!is.null(output_dir) && !is.null(project_dir)) {
+ tryCatch({
+ historical_data <- load_historical_field_data(
+ project_dir = project_dir,
+ current_week = current_week,
+ current_year = current_year,
+ reports_dir = output_dir,
+ num_weeks = 4,
+ auto_generate = FALSE,
+ field_boundaries_sf = field_boundaries_sf
+ )
+
+ if (!is.null(historical_data) && length(historical_data) > 0) {
+ message(" Building weekly mean CI time series from historical data...")
+
+ # Initialize list with empty vectors for each field
+ for (field_idx in seq_len(nrow(field_boundaries_sf))) {
+ weekly_mean_ci_by_field[[field_idx]] <- c()
+ }
+
+ # Extract Mean_CI from each historical week (reverse order to go chronologically)
+ for (hist_idx in rev(seq_along(historical_data))) {
+ hist_week <- historical_data[[hist_idx]]
+ hist_data <- hist_week$data
+
+ # Extract Mean_CI column if available
+ if ("Mean_CI" %in% names(hist_data)) {
+ # Match fields between historical data and field_boundaries
+ for (field_idx in seq_len(nrow(field_boundaries_sf))) {
+ field_name <- field_boundaries_sf$field[field_idx]
+
+ # Find matching row in historical data by field name/ID
+ field_row <- which(
+ (hist_data$Field_id == field_name | hist_data$Field_name == field_name) &
+ !is.na(hist_data$Mean_CI)
+ )
+
+ if (length(field_row) > 0) {
+ mean_ci_val <- as.numeric(hist_data$Mean_CI[field_row[1]])
+ if (!is.na(mean_ci_val)) {
+ weekly_mean_ci_by_field[[field_idx]] <- c(weekly_mean_ci_by_field[[field_idx]], mean_ci_val)
+ }
+ }
+ }
+ }
+ }
+
+ message(paste(" ✓ Loaded weekly Mean_CI for", sum(sapply(weekly_mean_ci_by_field, length) > 0), "fields"))
+ }
+ }, error = function(e) {
+ message(paste(" Note: Could not load historical field data for trend analysis:", e$message))
+ })
+ }
+
+ # If no historical data available, create empty vectors (will result in "Insufficient data")
+ if (length(weekly_mean_ci_by_field) == 0 || all(sapply(weekly_mean_ci_by_field, length) == 0)) {
+ message(" Warning: No historical weekly CI data available - using current week only")
+ for (field_idx in seq_len(nrow(field_boundaries_sf))) {
+ # Use current week mean CI as single-point series (insufficient for trend)
+ if (!is.null(current_stats) && nrow(current_stats) > 0) {
+ field_name <- field_boundaries_sf$field[field_idx]
+ matching_row <- which(
+ (current_stats$Field_id == field_name | current_stats$Field_name == field_name) &
+ !is.na(current_stats$Mean_CI)
+ )
+ if (length(matching_row) > 0) {
+ weekly_mean_ci_by_field[[field_idx]] <- c(as.numeric(current_stats$Mean_CI[matching_row[1]]))
+ } else {
+ weekly_mean_ci_by_field[[field_idx]] <- NA_real_
+ }
+ } else {
+ weekly_mean_ci_by_field[[field_idx]] <- NA_real_
+ }
+ }
+ }
+
+ # Calculate growth decline using weekly time series (not spatial pixel arrays)
+ growth_decline_kpi <- calculate_growth_decline_kpi(weekly_mean_ci_by_field)
+
+ message("Calculating KPI 5: Field Patchiness...")
+ # Calculate patchiness using both Gini coefficient and Moran's I spatial clustering
+ patchiness_kpi <- calculate_patchiness_kpi(
+ ci_pixels_by_field,
+ field_boundaries_sf = field_boundaries_sf,
+ mosaic_dir = current_mosaic_dir,
+ week_file = week_file,
+ mean_ci_values = current_stats$Mean_CI
)
- message("Calculating KPI 5: Weed Presence...")
- weed_kpi <- calculate_weed_presence_kpi(ci_pixels_by_field)
-
message("Calculating KPI 6: Gap Filling...")
- gap_filling_kpi <- calculate_gap_filling_kpi(current_mosaic, field_boundaries_sf)
+ # Build list of per-field files for this week
+ per_field_files <- c()
+ for (field_name in field_dirs) {
+ field_mosaic_path <- file.path(current_mosaic_dir, field_name, week_file)
+ if (file.exists(field_mosaic_path)) {
+ per_field_files <- c(per_field_files, field_mosaic_path)
+ }
+ }
+
+ if (length(per_field_files) > 0) {
+ # Use the common wrapper function (same as cane supply)
+ gap_scores_result <- calculate_gap_scores(per_field_files, field_boundaries_sf)
+
+ # Guard against NULL or empty result from calculate_gap_scores
+ if (is.null(gap_scores_result) || nrow(gap_scores_result) == 0) {
+ message(" Warning: calculate_gap_scores returned NULL/empty - creating fallback")
+ gap_scores_result <- data.frame(
+ Field_id = field_boundaries_sf$field,
+ gap_score = NA_real_,
+ stringsAsFactors = FALSE
+ )
+ }
+
+ # Convert to the format expected by orchestrator
+ gap_filling_kpi <- gap_scores_result %>%
+ mutate(field_idx = match(Field_id, field_boundaries_sf$field)) %>%
+ select(field_idx, gap_score) %>%
+ mutate(
+ gap_level = dplyr::case_when(
+ gap_score < 10 ~ "Minimal",
+ gap_score < 25 ~ "Moderate",
+ TRUE ~ "Significant"
+ ),
+ mean_ci = NA_real_,
+ outlier_threshold = NA_real_
+ )
+ } else {
+ # Fallback: no per-field files
+ gap_filling_kpi <- data.frame(
+ field_idx = seq_len(nrow(field_boundaries_sf)),
+ gap_score = NA_real_,
+ gap_level = NA_character_,
+ mean_ci = NA_real_,
+ outlier_threshold = NA_real_
+ )
+ }
# Compile results
all_kpis <- list(
@@ -802,26 +1093,62 @@ calculate_all_kpis <- function(
area_change = area_change_kpi,
tch_forecasted = tch_kpi,
growth_decline = growth_decline_kpi,
- weed_presence = weed_kpi,
+ patchiness = patchiness_kpi,
gap_filling = gap_filling_kpi
)
+ # Deduplicate KPI dataframes to ensure one row per field_idx
+ # (sometimes joins or calculations can create duplicate rows)
+ message("Deduplicating KPI results (keeping first occurrence per field)...")
+ all_kpis$uniformity <- all_kpis$uniformity %>%
+ distinct(field_idx, .keep_all = TRUE)
+ all_kpis$area_change <- all_kpis$area_change %>%
+ distinct(field_idx, .keep_all = TRUE)
+ all_kpis$tch_forecasted <- all_kpis$tch_forecasted %>%
+ distinct(field_idx, .keep_all = TRUE)
+ all_kpis$growth_decline <- all_kpis$growth_decline %>%
+ distinct(field_idx, .keep_all = TRUE)
+ all_kpis$patchiness <- all_kpis$patchiness %>%
+ distinct(field_idx, .keep_all = TRUE)
+ all_kpis$gap_filling <- all_kpis$gap_filling %>%
+ distinct(field_idx, .keep_all = TRUE)
+
+ # Built single-sheet field detail table with all KPIs
+ message("\nBuilding comprehensive field detail table...")
+ field_detail_df <- create_field_detail_table(
+ field_boundaries_sf = field_boundaries_sf,
+ all_kpis = all_kpis,
+ current_week = current_week,
+ current_year = current_year,
+ current_stats = current_stats
+ )
+
# Create summary tables
+ message("\nCreating summary tables...")
kpi_summary <- create_summary_tables(all_kpis)
- # Export - pass project_dir for proper filename and field_boundaries_sf for field details table
- if (is.null(project_dir)) {
- project_dir <- "AURA" # Fallback if not provided
- }
- export_result <- export_kpi_data(all_kpis, kpi_summary, project_dir, output_dir, current_week, current_year, field_boundaries_sf)
+ # Export
+ message("\nExporting KPI data (single-sheet format)...")
+ export_paths <- export_kpi_data(
+ field_detail_df = field_detail_df,
+ kpi_summary = kpi_summary,
+ output_dir = output_dir,
+ week = current_week,
+ year = current_year,
+ project_dir = project_dir
+ )
- message(paste("\n✓", project_dir, "KPI calculation complete. Week", current_week, current_year, "\n"))
+ message(paste("\n✓ AURA KPI calculation complete. Week", current_week, current_year))
- # Return combined structure (for integration with 80_calculate_kpis.R)
- # Capture field_details from export_result to propagate it out
return(list(
- all_kpis = all_kpis,
- summary_tables = kpi_summary,
- field_details = export_result$field_details # Propagate field_details from export_kpi_data
+ field_analysis_df = field_detail_df,
+ kpis = all_kpis,
+ summary_tables = kpi_summary,
+ export_paths = export_paths,
+ metadata = list(
+ week = current_week,
+ year = current_year,
+ project = project_dir
+ )
))
}
diff --git a/r_app/80_utils_cane_supply.R b/r_app/80_utils_cane_supply.R
index df6e319..7c75958 100644
--- a/r_app/80_utils_cane_supply.R
+++ b/r_app/80_utils_cane_supply.R
@@ -27,173 +27,685 @@ library(tidyr)
library(readxl)
library(writexl)
+# ============================================================================
+# ALERT THRESHOLDS & CONFIGURATION CONSTANTS
+# ============================================================================
+
+# CI change thresholds for alert categorization and status determination
+# These values are project-standard and should be consistent across all workflows
+CI_CHANGE_RAPID_GROWTH_THRESHOLD <- 0.5 # Weekly CI change for positive growth alert
+CI_CHANGE_POSITIVE_GROWTH_THRESHOLD <- 0.2 # Weekly CI change for acceptable growth
+CI_CHANGE_STABLE_THRESHOLD <- -0.2 # Weekly CI change for stable status (between -0.2 and +0.2)
+CI_CHANGE_STRESS_TREND_THRESHOLD <- -0.3 # 4-week trend threshold for stress detection
+CI_CHANGE_RAPID_DECLINE_THRESHOLD <- -0.5 # Weekly CI change for rapid decline alert
+# Deprecated aliases (for backward compatibility if needed):
+CI_CHANGE_DECLINE_THRESHOLD <- CI_CHANGE_RAPID_DECLINE_THRESHOLD # Weekly CI change threshold for decline alerts
+CI_CHANGE_INCREASE_THRESHOLD <- CI_CHANGE_RAPID_GROWTH_THRESHOLD # Weekly CI change threshold for increase alerts
+
# ============================================================================
# ANGATA-SPECIFIC HELPER FUNCTIONS (Placeholder Section)
# ============================================================================
-#' Placeholder: ANGATA harvest readiness assessment
+#' Calculate acreage for each field from geometry
+#' @param field_boundaries_sf sf object with field geometries
+#' @return data.frame with field and acreage columns
+calculate_field_acreages <- function(field_boundaries_sf) {
+ tryCatch({
+ # Project to equal-area CRS (EPSG:6933) for accurate area calculations
+ field_boundaries_proj <- sf::st_transform(field_boundaries_sf, "EPSG:6933")
+
+ lookup_df <- field_boundaries_proj %>%
+ sf::st_drop_geometry() %>%
+ as.data.frame() %>%
+ mutate(
+ geometry_valid = sapply(seq_len(nrow(field_boundaries_proj)), function(idx) {
+ tryCatch({
+ sf::st_is_valid(field_boundaries_proj[idx, ])
+ }, error = function(e) FALSE)
+ }),
+ area_ha = 0
+ )
+
+ # Calculate area for valid geometries
+ valid_indices <- which(lookup_df$geometry_valid)
+ areas_ha <- vapply(valid_indices, function(idx) {
+ tryCatch({
+ area_m2 <- as.numeric(sf::st_area(field_boundaries_proj[idx, ]))
+ area_m2 / 10000
+ }, error = function(e) NA_real_)
+ }, numeric(1))
+ lookup_df$area_ha[valid_indices] <- areas_ha
+
+ # Convert hectares to acres
+ lookup_df %>%
+ mutate(acreage = area_ha / 0.404686) %>%
+ # Aggregate by field to handle multi-row fields (e.g., sub_fields)
+ group_by(field) %>%
+ summarise(acreage = sum(acreage, na.rm = TRUE), .groups = "drop") %>%
+ select(field, acreage)
+ }, error = function(e) {
+ message(paste("Warning: Could not calculate acreages from geometries -", e$message))
+ data.frame(field = character(0), acreage = numeric(0))
+ })
+}
+
+#' Calculate age in weeks from planting date
#'
-#' Future implementation will integrate ANGATA-specific harvest readiness criteria:
-#' - Maturation phase detection (CI threshold-based)
-#' - Field age tracking (days since planting)
-#' - Weather-based ripeness indicators (if available)
-#' - Historical yield correlations
-#'
-#' @param field_ci CI values for the field
-#' @param field_age_days Days since planting
-#'
-#' @return Character string with harvest readiness assessment
-assess_harvest_readiness <- function(field_ci, field_age_days = NULL) {
- # Placeholder implementation
- # Real version would check:
- # - Mean CI > 3.5 (maturation threshold)
- # - Age > 350 days
- # - Weekly growth rate < threshold (mature plateau)
-
- if (is.null(field_ci) || all(is.na(field_ci))) {
- return("No data available")
+#' @param planting_date Date of planting
+#' @param reference_date Date to calculate age relative to (typically end_date)
+#' @return Numeric age in weeks (rounded to nearest week)
+calculate_age_week <- function(planting_date, reference_date) {
+ if (is.na(planting_date)) {
+ return(NA_real_)
}
-
- mean_ci <- mean(field_ci, na.rm = TRUE)
-
- if (mean_ci > 3.5) {
- return("Ready for harvest")
- } else if (mean_ci > 2.5) {
- return("Approaching harvest readiness")
+ round(as.numeric(difftime(reference_date, planting_date, units = "weeks")), 0)
+}
+
+#' Assign crop phase based on age in weeks
+#'
+#' Determines crop phase from age in weeks using canonical PHASE_DEFINITIONS
+#' from 80_utils_common.R for consistency across all workflows.
+#'
+#' @param age_week Numeric age in weeks
+#' @return Character phase name (from PHASE_DEFINITIONS or "Unknown")
+#'
+#' @details
+#' Uses the shared PHASE_DEFINITIONS to ensure identical phase boundaries
+#' across all scripts. This wrapper delegates to get_phase_by_age() which
+#' is the authoritative phase lookup function.
+#'
+#' Phase boundaries (from PHASE_DEFINITIONS):
+#' - Germination: 0-6 weeks
+#' - Tillering: 4-16 weeks
+#' - Grand Growth: 17-39 weeks
+#' - Maturation: 39+ weeks
+calculate_phase <- function(age_week) {
+ # Delegate to canonical get_phase_by_age() from 80_utils_common.R
+ # This ensures all phase boundaries are consistent across workflows
+ get_phase_by_age(age_week)
+}
+
+#' Bin percentage into 10% intervals with special handling for 90-100%
+#'
+#' @param pct Numeric percentage value (0-100)
+#' @return Character bin label
+bin_percentage <- function(pct) {
+ if (is.na(pct)) return(NA_character_)
+ if (pct >= 95) return("95-100%")
+ else if (pct >= 90) return("90-95%")
+ else if (pct >= 80) return("80-90%")
+ else if (pct >= 70) return("70-80%")
+ else if (pct >= 60) return("60-70%")
+ else if (pct >= 50) return("50-60%")
+ else if (pct >= 40) return("40-50%")
+ else if (pct >= 30) return("30-40%")
+ else if (pct >= 20) return("20-30%")
+ else if (pct >= 10) return("10-20%")
+ else return("0-10%")
+}
+
+#' Calculate germination progress from CI threshold percentage
+#'
+#' @param pct_pixels_ci_gte_2 Percentage of pixels with CI >= 2
+#' @return Character bin label
+calculate_germination_progress <- function(pct_pixels_ci_gte_2) {
+ bin_percentage(pct_pixels_ci_gte_2)
+}
+
+#' Categorize CV trend (long-term slope) into qualitative labels
+#'
+#' @param cv_slope Numeric slope from CV trend analysis
+#' @return Character category: "More uniform", "Stable uniformity", or "Less uniform"
+categorize_cv_trend_long_term <- function(cv_slope) {
+ if (is.na(cv_slope)) {
+ return(NA_character_)
+ } else if (cv_slope < -0.01) {
+ return("More uniform")
+ } else if (cv_slope > 0.01) {
+ return("Less uniform")
} else {
- return("Not ready - continue monitoring")
+ return("Stable uniformity")
}
}
-#' Placeholder: ANGATA supply chain status flags
+#' Determine status alert for CANE_SUPPLY client (harvest/milling workflow)
+#'
+#' Alerts focus on: harvest readiness, crop health monitoring, exception detection
+#' Uses WEEKLY trends (Four_week_trend) not daily noise for consistency
+#' Designed for harvest/milling clients who manage expectation, not daily operations
#'
-#' Future implementation will add supply chain-specific status indicators:
-#' - Harvest scheduling readiness
-#' - Equipment availability impact
-#' - Transportation/logistics flags
-#' - Quality parameter flags
+#' Priority order:
+#' 1. harvest_ready → Schedule harvest operations
+#' 2. harvested_bare → Record completion / detect unexpected harvest
+#' 3. stress_detected → Monitor crop health (consistent decline)
+#' 4. germination_delayed → Early warning for young fields
+#' 5. growth_on_track → Positive signal (no action needed)
+#' 6. NA → Normal growth (no alert)
#'
-#' @param field_analysis Data frame with field analysis results
-#'
-#' @return Data frame with supply chain status columns
-assess_supply_chain_status <- function(field_analysis) {
- # Placeholder: return field analysis as-is
- # Real version would add columns for:
- # - schedule_ready (bool)
- # - harvest_window_days (numeric)
- # - transportation_priority (char)
- # - quality_flags (char)
+#' @param imminent_prob Numeric harvest probability (0-1)
+#' @param age_week Numeric age in weeks since planting/harvest
+#' @param mean_ci Numeric mean Chlorophyll Index
+#' @param four_week_trend Numeric 4-week trend in CI (slope of growth)
+#' @param weekly_ci_change Numeric week-over-week CI change
+#' @param cv Numeric coefficient of variation (field uniformity)
+#' @return Character status alert code or NA
+calculate_status_alert <- function(imminent_prob, age_week, mean_ci,
+ four_week_trend, weekly_ci_change, cv) {
- return(field_analysis)
+ # Priority 1: HARVEST READY - highest business priority
+ # Field is mature (≥12 months) AND harvest model predicts imminent harvest
+ if (!is.na(imminent_prob) && imminent_prob > 0.5 && !is.na(age_week) && age_week >= 52) {
+ return("harvest_ready")
+ }
+
+ # Priority 2: HARVESTED/BARE - indicator of completion (or unexpected harvest)
+ # Mean CI dropped below vegetative threshold
+ if (!is.na(mean_ci) && mean_ci < 1.5) {
+ return("harvested_bare")
+ }
+
+ # Priority 3: STRESS DETECTED - consistent health decline (weekly trend)
+ # Uses Four_week_trend (smooth trend) NOT daily fluctuation to avoid noise
+ # Crop declining but not yet bare → opportunity to investigate
+ # References: CI_CHANGE_STRESS_TREND_THRESHOLD for 4-week trend detection
+ if (!is.na(four_week_trend) && four_week_trend < CI_CHANGE_STRESS_TREND_THRESHOLD &&
+ !is.na(mean_ci) && mean_ci > 1.5) {
+ return("stress_detected")
+ }
+
+ # Priority 4: GERMINATION DELAYED - early warning for young fields
+ # Age 4-8 weeks is typical germination window; low CI = slow start
+ if (!is.na(age_week) && age_week >= 4 && age_week <= 8 &&
+ !is.na(mean_ci) && mean_ci < 1.5) {
+ return("germination_delayed")
+ }
+
+ # Priority 5: GROWTH ON TRACK - positive operational status
+ # Field is healthy, uniform, and growing steadily (no action needed)
+ # Conditions: good uniformity (CV < 0.15) AND stable/positive weekly trend
+ # References: CI_CHANGE_STABLE_THRESHOLD (±0.2 = stable, no change)
+ if (!is.na(cv) && cv < 0.15 &&
+ !is.na(four_week_trend) && four_week_trend >= CI_CHANGE_STABLE_THRESHOLD &&
+ !is.na(weekly_ci_change) && weekly_ci_change >= CI_CHANGE_STABLE_THRESHOLD) {
+ return("growth_on_track")
+ }
+
+ # Default: NORMAL GROWTH (no specific alert)
+ # Field is growing but may have minor variability; continues normal monitoring
+ NA_character_
}
+#' Calculate yield prediction for CANE_SUPPLY workflows (Wrapper)
+#'
+#' This function wraps the shared yield prediction model from 80_utils_common.R
+#' to provide CANE_SUPPLY clients (e.g., ANGATA) with ML-based yield forecasting.
+#'
+#' Uses Random Forest with Forward Feature Selection trained on:
+#' - Cumulative Canopy Index (CI) from growth model
+#' - Days After Harvest (DAH) / crop age
+#' - CI-per-day (growth velocity)
+#'
+#' Predicts yields for mature fields (DAH >= DAH_MATURITY_THRESHOLD, ~8 months) into quartiles:
+#' - Top 25%: High-yield fields
+#' - Average: Mid-range yield fields
+#' - Lowest 25%: Lower-yield fields
+#'
+#' @param field_boundaries_sf SF object with field geometries
+#' @param harvesting_data Data frame with harvest history (must have tonnage_ha column)
+#' @param cumulative_CI_vals_dir Directory with combined CI RDS files
+#'
+#' @return List with:
+#' - summary: Data frame with field_groups, count, and yield quartile predictions
+#' - field_results: Data frame with field-level forecasts (yield_forecast_t_ha in t/ha)
+#'
+#' @details
+#' **Data Requirements:**
+#' - harvesting_data must include tonnage_ha column (yield in t/ha) for training
+#' - cumulative_CI_vals_dir must contain "All_pivots_Cumulative_CI_quadrant_year_v2.rds"
+#' - If either is missing, returns graceful fallback with NA values (not fake numbers)
+#'
+#' **Integration:**
+#' This can be called from calculate_all_field_kpis() in cane_supply workflow to add
+#' a new "Yield_Forecast" column to the 22-column KPI output.
+#'
+#' **Example:**
+#' ```r
+#' yield_result <- calculate_yield_prediction_kpi_cane_supply(
+#' field_boundaries_sf,
+#' harvesting_data,
+#' file.path(data_dir, "combined_CI")
+#' )
+#' # yield_result$summary has quartiles
+#' # yield_result$field_results has per-field forecasts
+#' ```
+calculate_yield_prediction_kpi_cane_supply <- function(field_boundaries_sf,
+ harvesting_data,
+ cumulative_CI_vals_dir) {
+
+ # Call the shared yield prediction function from 80_utils_common.R
+ result <- calculate_yield_prediction_kpi(field_boundaries_sf, harvesting_data, cumulative_CI_vals_dir)
+
+ return(result)
+}
+
+
+#' Build complete per-field KPI dataframe with all 22 columns
+#' @param current_stats data.frame with current week statistics from load_or_calculate_weekly_stats
+#' @param planting_dates data.frame with field_id and planting_date columns
+#' @param imminent_prob_data data.frame with Field_id and Imminent_prob_actual columns (or NULL)
+#' @param gap_scores_df data.frame with Field_id and gap_score columns (or NULL)
+#' @param field_boundaries_sf sf object with field geometries
+#' @param end_date Date object for current report date
+#' @return data.frame with all 22 KPI columns
+calculate_all_field_kpis <- function(current_stats,
+ planting_dates,
+ imminent_prob_data,
+ gap_scores_df,
+ field_boundaries_sf,
+ end_date) {
+
+ message("\nBuilding final field analysis output...")
+
+ # Pre-calculate acreages
+ acreage_lookup <- calculate_field_acreages(field_boundaries_sf)
+
+ field_analysis_df <- current_stats %>%
+ mutate(
+ # Column 2: Farm_Section (user fills manually)
+ Farm_Section = NA_character_,
+
+ # Column 3: Field_name (from GeoJSON)
+ Field_name = Field_id,
+
+ # Column 4: Acreage (from geometry)
+ Acreage = {
+ acreages_vec <- acreage_lookup$acreage[match(Field_id, acreage_lookup$field)]
+ if_else(is.na(acreages_vec), 0, acreages_vec)
+ },
+
+ # Column 8: Last_harvest_or_planting_date (from harvest.xlsx)
+ Last_harvest_or_planting_date = {
+ planting_dates$planting_date[match(Field_id, planting_dates$field_id)]
+ },
+
+ # Column 9: Age_week (calculated)
+ Age_week = {
+ sapply(seq_len(nrow(current_stats)), function(idx) {
+ calculate_age_week(Last_harvest_or_planting_date[idx], end_date)
+ })
+ },
+
+ # Column 10: Phase (based on Age_week)
+ Phase = sapply(Age_week, calculate_phase),
+
+ # Column 12: Germination_progress (binned Pct_pixels_CI_gte_2)
+ Germination_progress = sapply(Pct_pixels_CI_gte_2, calculate_germination_progress),
+
+ # Column 13: Imminent_prob (from script 31 or NA)
+ Imminent_prob = {
+ if (!is.null(imminent_prob_data)) {
+ as.numeric(imminent_prob_data$Imminent_prob_actual[match(Field_id, imminent_prob_data$Field_id)])
+ } else {
+ rep(NA_real_, nrow(current_stats))
+ }
+ },
+
+ # Column 14: Status_Alert (multi-priority logic for harvest/milling workflow)
+ Status_Alert = {
+ sapply(seq_len(nrow(current_stats)), function(idx) {
+ calculate_status_alert(
+ imminent_prob = Imminent_prob[idx],
+ age_week = Age_week[idx],
+ mean_ci = Mean_CI[idx],
+ four_week_trend = Four_week_trend[idx],
+ weekly_ci_change = Weekly_ci_change[idx],
+ cv = CV[idx]
+ )
+ })
+ },
+
+ # Column 19b: CV_Trend_Long_Term_Category (categorical slope)
+ CV_Trend_Long_Term_Category = sapply(current_stats$CV_Trend_Long_Term, categorize_cv_trend_long_term),
+
+ # Column 21: Cloud_pct_clear (binned into intervals)
+ Cloud_pct_clear = sapply(Cloud_pct_clear, bin_percentage),
+
+ # Column 22: Gap_score (2σ method)
+ Gap_score = {
+ if (!is.null(gap_scores_df) && nrow(gap_scores_df) > 0) {
+ gap_scores_df$gap_score[match(current_stats$Field_id, gap_scores_df$Field_id)]
+ } else {
+ rep(NA_real_, nrow(current_stats))
+ }
+ }
+ ) %>%
+ select(
+ all_of(c("Field_id", "Farm_Section", "Field_name", "Acreage", "Status_Alert",
+ "Last_harvest_or_planting_date", "Age_week", "Phase",
+ "Germination_progress",
+ "Mean_CI", "Weekly_ci_change", "Four_week_trend", "CI_range", "CI_Percentiles",
+ "CV", "CV_Trend_Short_Term", "CV_Trend_Long_Term", "CV_Trend_Long_Term_Category",
+ "Imminent_prob", "Cloud_pct_clear", "Cloud_category", "Gap_score"))
+ )
+
+ message(paste("✓ Built final output with", nrow(field_analysis_df), "fields and 22 columns"))
+
+ return(field_analysis_df)
+}
+
+#' Aggregate per-field data into farm-level KPI summary
+#'
+#' @param field_analysis_df data.frame with per-field KPI data
+#' @param current_week Numeric current week number
+#' @param current_year Numeric current year
+#' @param end_date Date object for current report date
+#' @return List with phase_distribution, status_distribution, cloud_distribution, overall_stats
+calculate_farm_level_kpis <- function(field_analysis_df, current_week, current_year, end_date) {
+
+ cat("\n=== CALCULATING FARM-LEVEL KPI SUMMARY ===\n")
+
+ # Filter to only fields with actual data
+ field_data <- field_analysis_df %>%
+ filter(!is.na(Mean_CI) & !is.na(Acreage)) %>%
+ filter(Acreage > 0)
+
+ if (nrow(field_data) == 0) {
+ message("No valid field data for farm-level aggregation")
+ return(NULL)
+ }
+
+ farm_summary <- list()
+
+ # 1. PHASE DISTRIBUTION
+ phase_dist <- field_data %>%
+ group_by(Phase) %>%
+ summarise(
+ num_fields = n(),
+ acreage = sum(Acreage, na.rm = TRUE),
+ .groups = 'drop'
+ ) %>%
+ rename(Category = Phase)
+
+ farm_summary$phase_distribution <- phase_dist
+
+ # 2. STATUS ALERT DISTRIBUTION
+ status_dist <- field_data %>%
+ group_by(Status_Alert) %>%
+ summarise(
+ num_fields = n(),
+ acreage = sum(Acreage, na.rm = TRUE),
+ .groups = 'drop'
+ ) %>%
+ rename(Category = Status_Alert)
+
+ farm_summary$status_distribution <- status_dist
+
+ # 3. CLOUD COVERAGE DISTRIBUTION
+ cloud_dist <- field_data %>%
+ group_by(Cloud_category) %>%
+ summarise(
+ num_fields = n(),
+ acreage = sum(Acreage, na.rm = TRUE),
+ .groups = 'drop'
+ ) %>%
+ rename(Category = Cloud_category)
+
+ farm_summary$cloud_distribution <- cloud_dist
+
+ # 4. OVERALL STATISTICS
+ farm_summary$overall_stats <- data.frame(
+ total_fields = nrow(field_data),
+ total_acreage = sum(field_data$Acreage, na.rm = TRUE),
+ mean_ci = round(mean(field_data$Mean_CI, na.rm = TRUE), 2),
+ median_ci = round(median(field_data$Mean_CI, na.rm = TRUE), 2),
+ mean_cv = round(mean(field_data$CV, na.rm = TRUE), 4),
+ week = current_week,
+ year = current_year,
+ date = as.character(end_date)
+ )
+
+ # Print summaries
+ cat("\n--- PHASE DISTRIBUTION ---\n")
+ print(phase_dist)
+
+ cat("\n--- STATUS TRIGGER DISTRIBUTION ---\n")
+ print(status_dist)
+
+ cat("\n--- CLOUD COVERAGE DISTRIBUTION ---\n")
+ print(cloud_dist)
+
+ cat("\n--- OVERALL FARM STATISTICS ---\n")
+ print(farm_summary$overall_stats)
+
+ return(farm_summary)
+}
+
+
# ============================================================================
# ORCHESTRATOR FOR CANE_SUPPLY WORKFLOWS
# ============================================================================
-#' Orchestrate ANGATA weekly field analysis and reporting
+#' Main orchestrator for CANE_SUPPLY per-field KPI workflow
#'
-#' Main entry point for CANE_SUPPLY (ANGATA, etc.) workflows.
-#' Currently uses common utilities; future versions will add client-specific logic.
+#' This function coordinates all KPI calculations for the per-field analysis workflow.
+#' It loads historical data, calculates current/previous week statistics, computes
+#' all 22 KPI columns, and aggregates farm-level summaries.
#'
-#' @param field_boundaries_sf SF object with field geometries
-#' @param current_week ISO week number (1-53)
-#' @param current_year ISO week year
-#' @param mosaic_dir Directory containing weekly mosaics
-#' @param field_boundaries_path Path to field GeoJSON
-#' @param harvesting_data Data frame with harvest data (optional)
-#' @param output_dir Directory for exports
-#' @param data_dir Base data directory
-#'
-#' @return List with field analysis results
-#'
-#' @details
-#' This function:
-#' 1. Loads weekly mosaic and extracts field statistics
-#' 2. Calculates field statistics (using common utilities)
-#' 3. Prepares field analysis summary
-#' 4. Exports to Excel/CSV/RDS
-#' 5. (Future) Applies ANGATA-specific assessments
-#'
-calculate_field_analysis_cane_supply <- function(
- field_boundaries_sf,
- current_week,
- current_year,
- mosaic_dir,
- field_boundaries_path = NULL,
- harvesting_data = NULL,
- output_dir = file.path(PROJECT_DIR, "output"),
- data_dir = NULL
-) {
+#' @param setup List with directory paths (kpi_reports_dir, data_dir, etc.)
+#' @param client_config List with workflow configuration (script_91_compatible, outputs)
+#' @param end_date Date object for current report date
+#' @param project_dir Character project identifier
+#' @param weekly_mosaic Character path to weekly mosaic directory
+#' @param daily_vals_dir Character path to daily values directory
+#' @param field_boundaries_sf sf object with field geometries
+#' @param data_dir Character path to data directory
+#' @return List with field_analysis_df, farm_kpi_results, export_paths
+calculate_field_analysis_cane_supply <- function(setup,
+ client_config,
+ end_date,
+ project_dir,
+ weekly_mosaic,
+ daily_vals_dir,
+ field_boundaries_sf,
+ data_dir) {
- message("\n============ CANE SUPPLY FIELD ANALYSIS (ANGATA, etc.) ============")
+ message("\n", strrep("=", 70))
+ message("CANE_SUPPLY WORKFLOW: PER-FIELD ANALYSIS (Script 91 compatible)")
+ message(strrep("=", 70))
- # Load current week mosaic
- message("Loading current week mosaic...")
- current_mosaic <- load_weekly_ci_mosaic(mosaic_dir, current_week, current_year)
+ reports_dir <- file.path(setup$reports_dir, "kpis")
- if (is.null(current_mosaic)) {
- warning(paste("Could not load current week mosaic for week", current_week, current_year))
- return(NULL)
+ # ========== PHASE 1: WEEKLY ANALYSIS SETUP ==========
+ message("\n", strrep("-", 70))
+ message("PHASE 1: PER-FIELD WEEKLY ANALYSIS ")
+ message(strrep("-", 70))
+
+ weeks <- calculate_week_numbers(end_date)
+ current_week <- weeks$current_week
+ current_year <- weeks$current_year
+ previous_week <- weeks$previous_week
+ previous_year <- weeks$previous_year
+
+ message(paste("Week:", current_week, "/ Year (ISO 8601):", current_year))
+
+ # Find per-field weekly mosaics
+ message("Finding per-field weekly mosaics...")
+
+ if (!dir.exists(weekly_mosaic)) {
+ stop(paste("ERROR: weekly_mosaic directory not found:", weekly_mosaic,
+ "\nScript 40 (mosaic creation) must be run first."))
}
- # Extract field statistics
- message("Extracting field statistics from current mosaic...")
- field_stats <- extract_field_statistics_from_ci(current_mosaic, field_boundaries_sf)
+ field_dirs <- list.dirs(weekly_mosaic, full.names = FALSE, recursive = FALSE)
+ field_dirs <- field_dirs[field_dirs != ""]
- # Load previous week stats for comparison
- message("Loading historical data for trends...")
- target_prev <- calculate_target_week_and_year(current_week, current_year, offset_weeks = 1)
- previous_stats <- NULL
-
- previous_mosaic <- load_weekly_ci_mosaic(mosaic_dir, target_prev$week, target_prev$year)
- if (!is.null(previous_mosaic)) {
- previous_stats <- extract_field_statistics_from_ci(previous_mosaic, field_boundaries_sf)
+ if (length(field_dirs) == 0) {
+ stop(paste("ERROR: No field subdirectories found in:", weekly_mosaic,
+ "\nScript 40 must create weekly_mosaic/{FIELD}/ structure."))
}
- # Calculate 4-week historical trend
- message("Calculating field trends...")
- ci_rds_path <- file.path(data_dir, "combined_CI", "combined_CI_data.rds")
+ # Verify we have mosaics for this week
+ single_file_pattern <- sprintf("week_%02d_%d\\.tif", current_week, current_year)
+ per_field_files <- c()
+ for (field in field_dirs) {
+ field_mosaic_dir <- file.path(weekly_mosaic, field)
+ files <- list.files(field_mosaic_dir, pattern = single_file_pattern, full.names = TRUE)
+ if (length(files) > 0) {
+ per_field_files <- c(per_field_files, files)
+ }
+ }
- field_analysis <- calculate_field_statistics(
- field_stats = field_stats,
- previous_stats = previous_stats,
+ if (length(per_field_files) == 0) {
+ stop(paste("ERROR: No mosaics found for week", current_week, "year", current_year,
+ "\nExpected pattern:", single_file_pattern,
+ "\nChecked:", weekly_mosaic))
+ }
+
+ message(paste(" ✓ Found", length(per_field_files), "per-field weekly mosaics"))
+
+ # ========== PHASE 2: LOAD HISTORICAL DATA ==========
+ message("\nLoading historical field data for trend calculations...")
+ num_weeks_to_load <- max(WEEKS_FOR_FOUR_WEEK_TREND, WEEKS_FOR_CV_TREND_LONG)
+ message(paste(" Attempting to load up to", num_weeks_to_load, "weeks of historical data..."))
+
+ allow_auto_gen <- !exists("_INSIDE_AUTO_GENERATE", envir = .GlobalEnv)
+
+ historical_data <- load_historical_field_data(
+ project_dir, current_week, current_year, reports_dir,
+ num_weeks = num_weeks_to_load,
+ auto_generate = allow_auto_gen,
+ field_boundaries_sf = field_boundaries_sf,
+ daily_vals_dir = daily_vals_dir
+ )
+
+ # ========== PHASE 3: LOAD PLANTING DATES ==========
+ message("\nLoading harvest data from harvest.xlsx for planting dates...")
+ # Use load_harvest_data() from 80_utils_common.R for consistency with 80_calculate_kpis.R
+ harvesting_data <- load_harvest_data(data_dir)
+
+ planting_dates <- extract_planting_dates(harvesting_data, field_boundaries_sf)
+
+ if (is.null(planting_dates) || nrow(planting_dates) == 0) {
+ message("WARNING: No planting dates available. Using NA for all fields.")
+ planting_dates <- data.frame(
+ field_id = field_boundaries_sf$field,
+ planting_date = rep(as.Date(NA), nrow(field_boundaries_sf)),
+ stringsAsFactors = FALSE
+ )
+ }
+
+ # ========== PHASE 4: CALCULATE WEEKLY STATISTICS ==========
+ message("\nUsing modular RDS-based approach for weekly statistics...")
+
+ # Current week
+ message("\n1. Loading/calculating CURRENT week statistics (week", current_week, ")...")
+ current_stats <- load_or_calculate_weekly_stats(
week_num = current_week,
year = current_year,
- ci_rds_path = ci_rds_path,
+ project_dir = project_dir,
field_boundaries_sf = field_boundaries_sf,
- harvesting_data = harvesting_data
+ mosaic_dir = weekly_mosaic,
+ reports_dir = reports_dir,
+ report_date = end_date
+ )
+ message(paste(" ✓ Loaded/calculated stats for", nrow(current_stats), "fields in current week"))
+
+ # Previous week
+ message("\n2. Loading/calculating PREVIOUS week statistics (week", previous_week, ")...")
+ prev_report_date <- end_date - 7
+
+ prev_stats <- load_or_calculate_weekly_stats(
+ week_num = previous_week,
+ year = previous_year,
+ project_dir = project_dir,
+ field_boundaries_sf = field_boundaries_sf,
+ mosaic_dir = weekly_mosaic,
+ reports_dir = reports_dir,
+ report_date = prev_report_date
+ )
+ message(paste(" ✓ Loaded/calculated stats for", nrow(prev_stats), "fields in previous week"))
+
+ # ========== PHASE 5: CALCULATE TRENDS ==========
+ message("\n3. Calculating trend columns...")
+ current_stats <- calculate_kpi_trends(
+ current_stats, prev_stats,
+ project_dir = project_dir,
+ reports_dir = reports_dir,
+ current_week = current_week,
+ year = current_year
+ )
+ message(paste(" ✓ Added Weekly_ci_change, CV_Trend_Short_Term, Four_week_trend, CV_Trend_Long_Term, nmr_of_weeks_analysed"))
+
+ # ========== PHASE 6: LOAD HARVEST PROBABILITIES ==========
+ message("\n4. Loading harvest probabilities from script 31...")
+ # Use get_harvest_output_path() to safely build path (stored in kpi_reports_dir)
+ harvest_prob_file <- get_harvest_output_path(project_dir, current_week, current_year)
+ message(paste(" Looking for:", harvest_prob_file))
+
+ imminent_prob_data <- tryCatch({
+ if (file.exists(harvest_prob_file)) {
+ prob_df <- readr::read_csv(harvest_prob_file, show_col_types = FALSE,
+ col_types = readr::cols(.default = readr::col_character()))
+ message(paste(" ✓ Loaded harvest probabilities for", nrow(prob_df), "fields"))
+ prob_df %>%
+ select(field, imminent_prob, detected_prob) %>%
+ rename(Field_id = field, Imminent_prob_actual = imminent_prob, Detected_prob = detected_prob)
+ } else {
+ message(paste(" INFO: Harvest probabilities not available (script 31 not run)"))
+ NULL
+ }
+ }, error = function(e) {
+ message(paste(" WARNING: Could not load harvest probabilities:", e$message))
+ NULL
+ })
+
+ # ========== PHASE 7: CALCULATE GAP SCORES ==========
+ gap_scores_df <- calculate_gap_scores(per_field_files, field_boundaries_sf)
+
+ # ========== PHASE 8: BUILD FINAL PER-FIELD DATAFRAME ==========
+ field_analysis_df <- calculate_all_field_kpis(
+ current_stats = current_stats,
+ planting_dates = planting_dates,
+ imminent_prob_data = imminent_prob_data,
+ gap_scores_df = gap_scores_df,
+ field_boundaries_sf = field_boundaries_sf,
+ end_date = end_date
)
- if (is.null(field_analysis)) {
- message("Could not generate field analysis")
- return(NULL)
- }
-
- # Generate summary
- message("Generating summary statistics...")
- summary_df <- generate_field_analysis_summary(field_analysis)
-
- # Export
- message("Exporting field analysis...")
+ # ========== PHASE 9: EXPORT PER-FIELD RESULTS ==========
export_paths <- export_field_analysis_excel(
- field_analysis,
- summary_df,
- PROJECT_DIR,
+ field_analysis_df,
+ NULL,
+ project_dir,
current_week,
current_year,
- output_dir
+ reports_dir
)
- message(paste("\n✓ CANE_SUPPLY field analysis complete. Week", current_week, current_year, "\n"))
+ # cat("\n--- Per-field Results (first 10) ---\n")
+ # available_cols <- c("Field_id", "Acreage", "Age_week", "Mean_CI", "Four_week_trend", "Status_Alert", "Cloud_category")
+ # available_cols <- available_cols[available_cols %in% names(field_analysis_df)]
+ # if (length(available_cols) > 0) {
+ # print(head(field_analysis_df[, available_cols], 10))
+ # }
- result <- list(
- field_analysis = field_analysis,
- summary = summary_df,
- exports = export_paths
- )
+ # ========== PHASE 10: CALCULATE FARM-LEVEL KPIS ==========
+ # farm_kpi_results <- calculate_farm_level_kpis(
+ # field_analysis_df,
+ # current_week,
+ # current_year,
+ # end_date
+ # )
- return(result)
+ # For now, farm-level KPIs are not implemented in CANE_SUPPLY workflow
+ farm_kpi_results <- NULL
+
+ # ========== RETURN RESULTS ==========
+ return(list(
+ field_analysis_df = field_analysis_df,
+ farm_kpi_results = farm_kpi_results,
+ export_paths = export_paths
+ ))
}
# ============================================================================
diff --git a/r_app/80_utils_common.R b/r_app/80_utils_common.R
index 3c0f75f..071b025 100644
--- a/r_app/80_utils_common.R
+++ b/r_app/80_utils_common.R
@@ -8,10 +8,34 @@
# - Field statistics extraction
# - Week/year calculations for consistent date handling
# - Excel/CSV/RDS export utilities
+# - Yield prediction using ML models (Random Forest with Feature Selection)
#
# Used by: 80_calculate_kpis.R, all client-specific utils files
+#
+# NOTE: Libraries required by yield prediction (caret, CAST, here) are loaded
+# in the main script 80_calculate_kpis.R, not here. This keeps dependencies
+# centralized in the orchestrator script.
# ============================================================================
+# ============================================================================
+# LOAD PROJECT CONFIGURATION (Guard against re-sourcing)
+# ============================================================================
+# Ensure parameters_project.R has been sourced to provide global configuration
+# (PROJECT, data_dir, field_boundaries_path, etc.). Use a sentinel to avoid double-sourcing.
+if (!exists("PROJECT", envir = .GlobalEnv)) {
+ tryCatch({
+ source(here::here("r_app", "parameters_project.R"))
+ }, error = function(e) {
+ # Fallback: try relative path if here() doesn't work
+ tryCatch({
+ source("parameters_project.R")
+ }, error = function(e2) {
+ warning(paste("Could not source parameters_project.R:", e2$message,
+ "- using defaults or expecting caller to set PROJECT/data_dir"))
+ })
+ })
+}
+
# ============================================================================
# CONSTANTS (from 80_calculate_kpis.R)
# ============================================================================
@@ -355,12 +379,11 @@ 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
+#' @param ci_raster Current week CI raster (single band)
+#' @param field_boundaries Field boundaries (sf or SpatVector)
+#' @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)
@@ -368,19 +391,11 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
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_name <- if ("field" %in% names(field_boundaries)) field_boundaries$field[i] else NA_character_
+ sub_field_name <- if ("sub_field" %in% names(field_boundaries)) field_boundaries$sub_field[i] else NA_character_
field_vect <- field_boundaries_vect[i]
# Extract CI values using helper function
@@ -391,16 +406,17 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
# 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)
+ outlier_threshold <- median_ci - (1 * sd_ci)
low_ci_pixels <- sum(valid_values < outlier_threshold)
total_pixels <- length(valid_values)
- gap_score <- (low_ci_pixels / total_pixels) * 100
+ gap_score <- round((low_ci_pixels / total_pixels) * 100, 2)
# Classify gap severity
gap_level <- dplyr::case_when(
gap_score < 10 ~ "Minimal",
gap_score < 25 ~ "Moderate",
- TRUE ~ "Significant"
+ gap_score >= 25 ~ "Significant",
+ TRUE ~ NA_character_
)
field_results <- rbind(field_results, data.frame(
@@ -412,7 +428,6 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
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,
@@ -423,9 +438,99 @@ calculate_gap_filling_kpi <- function(ci_raster, field_boundaries) {
))
}
}
+
+ # 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))
}
-
+#' Calculate gap filling scores for all per-field mosaics (wrapper)
+#'
+#' This wrapper handles per-field mosaic structure by iterating over
+#' individual field files and calling the basic KPI function
+#'
+#' @param per_field_files Character vector of paths to per-field mosaic TIFFs
+#' @param field_boundaries_sf sf object with field geometries
+#' @return data.frame with Field_id and gap_score columns
+calculate_gap_scores <- function(per_field_files, field_boundaries_sf) {
+ message("\nCalculating gap filling scores (2σ method)...")
+ message(paste(" Using per-field mosaics for", length(per_field_files), "fields"))
+
+ field_boundaries_by_id <- split(field_boundaries_sf, field_boundaries_sf$field)
+
+ process_gap_for_field <- function(field_file) {
+ field_id <- basename(dirname(field_file))
+ field_bounds <- field_boundaries_by_id[[field_id]]
+
+ if (is.null(field_bounds) || nrow(field_bounds) == 0) {
+ return(data.frame(Field_id = field_id, gap_score = NA_real_))
+ }
+
+ tryCatch({
+ field_raster <- terra::rast(field_file)
+ ci_band_name <- "CI"
+ if (!(ci_band_name %in% names(field_raster))) {
+ return(data.frame(Field_id = field_id, gap_score = NA_real_))
+ }
+ field_ci_band <- field_raster[[ci_band_name]]
+ names(field_ci_band) <- "CI"
+
+ gap_result <- calculate_gap_filling_kpi(field_ci_band, field_bounds)
+
+ if (is.null(gap_result) || is.null(gap_result$field_results) || nrow(gap_result$field_results) == 0) {
+ return(data.frame(Field_id = field_id, gap_score = NA_real_))
+ }
+
+ gap_scores <- gap_result$field_results
+ gap_scores$Field_id <- gap_scores$field
+ gap_scores <- gap_scores[, c("Field_id", "gap_score")]
+
+ stats::aggregate(gap_score ~ Field_id, data = gap_scores, FUN = function(x) mean(x, na.rm = TRUE))
+ }, error = function(e) {
+ message(paste(" WARNING: Gap score failed for field", field_id, ":", e$message))
+ data.frame(Field_id = field_id, gap_score = NA_real_)
+ })
+ }
+
+ # Process fields sequentially with progress bar
+ message(" Processing gap scores for ", length(per_field_files), " fields...")
+ pb <- utils::txtProgressBar(min = 0, max = length(per_field_files), style = 3, width = 50)
+
+ results_list <- lapply(seq_along(per_field_files), function(idx) {
+ result <- process_gap_for_field(per_field_files[[idx]])
+ utils::setTxtProgressBar(pb, idx)
+ result
+ })
+ close(pb)
+
+ gap_scores_df <- dplyr::bind_rows(results_list)
+
+ if (!is.null(gap_scores_df) && nrow(gap_scores_df) > 0) {
+ gap_scores_df <- gap_scores_df %>%
+ dplyr::group_by(Field_id) %>%
+ dplyr::summarise(gap_score = mean(gap_score, na.rm = TRUE), .groups = "drop")
+
+ message(paste(" ✓ Calculated gap scores for", nrow(gap_scores_df), "fields"))
+
+ # Guard against all-NA values which would produce Inf/-Inf warnings
+ if (any(is.finite(gap_scores_df$gap_score))) {
+ min_score <- round(min(gap_scores_df$gap_score, na.rm = TRUE), 2)
+ max_score <- round(max(gap_scores_df$gap_score, na.rm = TRUE), 2)
+ message(paste(" Gap score range:", min_score, "-", max_score, "%"))
+ } else {
+ message(" Gap score range: All values are NA (no valid gap scores)")
+ }
+ } else {
+ message(" WARNING: No gap scores calculated from per-field mosaics")
+ gap_scores_df <- NULL
+ }
+
+ return(gap_scores_df)
+}
# ============================================================================
# HELPER FUNCTIONS
@@ -517,6 +622,88 @@ extract_planting_dates <- function(harvesting_data, field_boundaries_sf = NULL)
})
}
+# ============================================================================
+# DATA LOADING HELPERS
+# ============================================================================
+
+#' Load and validate harvest data from harvest.xlsx
+#'
+#' Encapsulates harvest data loading with validation, type coercion, and error handling.
+#' Returns a data frame with required columns (field, year, tonnage_ha) or an empty
+#' data frame with proper structure if loading fails.
+#'
+#' @param data_dir Path to data directory containing harvest.xlsx
+#'
+#' @return data.frame with columns: field (character), year (numeric), tonnage_ha (numeric)
+#' - On success: data frame with N rows of harvest records
+#' - On failure: empty data frame with correct structure (0 rows, 3 columns)
+#'
+#' @details
+#' **File Location**: Expected at `file.path(data_dir, "harvest.xlsx")`
+#'
+#' **Validation**:
+#' - Checks file existence before reading
+#' - Validates required columns: field, year, tonnage_ha
+#' - Coerces year and tonnage_ha to numeric
+#' - Logs status messages for debugging
+#'
+#' **Error Handling**:
+#' - Missing file: Returns empty DF (logs NOTE)
+#' - Missing columns: Returns empty DF (logs WARNING)
+#' - Read errors: Returns empty DF (logs WARNING)
+#' - Always returns valid data frame structure (won't return NULL)
+#'
+#' **Usage**:
+#' ```r
+#' harvesting_data <- load_harvest_data(setup$data_dir)
+#' # harvesting_data is guaranteed to be a data.frame with 3 columns
+#' # even if harvest.xlsx is unavailable or invalid
+#' ```
+load_harvest_data <- function(data_dir) {
+ harvesting_data <- NULL
+ harvest_file <- file.path(data_dir, "harvest.xlsx")
+
+ if (file.exists(harvest_file)) {
+ tryCatch({
+ harvesting_data <- readxl::read_excel(harvest_file)
+
+ # Ensure required columns are present
+ required_cols <- c("field", "year", "tonnage_ha")
+ if (all(required_cols %in% names(harvesting_data))) {
+ # Convert to data frame and ensure column types
+ harvesting_data <- as.data.frame(harvesting_data)
+ # CRITICAL: Coerce field to character to preserve leading zeros (e.g., "01", "02")
+ harvesting_data$field <- as.character(harvesting_data$field)
+ harvesting_data$year <- as.numeric(harvesting_data$year)
+ harvesting_data$tonnage_ha <- as.numeric(harvesting_data$tonnage_ha)
+
+ message(paste(" ✓ Loaded harvest data:", nrow(harvesting_data), "records from harvest.xlsx"))
+ return(harvesting_data)
+ } else {
+ message(paste(" WARNING: harvest.xlsx missing required columns. Expected: field, year, tonnage_ha"))
+ harvesting_data <- NULL
+ }
+ }, error = function(e) {
+ message(paste(" WARNING: Could not read harvest.xlsx:", e$message))
+ })
+ } else {
+ message(paste(" NOTE: harvest.xlsx not found at", harvest_file))
+ }
+
+ # Fallback: create empty data frame if loading failed
+ if (is.null(harvesting_data)) {
+ message(" WARNING: No harvest data available. TCH yield prediction will use graceful fallback (NA values)")
+ harvesting_data <- data.frame(
+ field = character(), # Explicitly character to preserve leading zeros when data is added
+ year = numeric(),
+ tonnage_ha = numeric(),
+ stringsAsFactors = FALSE
+ )
+ }
+
+ return(harvesting_data)
+}
+
# ============================================================================
# FIELD STATISTICS EXTRACTION
# ============================================================================
@@ -678,13 +865,13 @@ export_field_analysis_excel <- function(field_df, summary_df, project_dir, curre
NULL
}
- output_subdir <- file.path(reports_dir, "field_analysis")
- if (!dir.exists(output_subdir)) {
- dir.create(output_subdir, recursive = TRUE)
+ output_dir <- file.path(reports_dir)
+ if (!dir.exists(output_dir)) {
+ dir.create(output_dir, recursive = TRUE)
}
excel_filename <- paste0(project_dir, "_field_analysis_week", sprintf("%02d_%d", current_week, year), ".xlsx")
- excel_path <- file.path(output_subdir, excel_filename)
+ excel_path <- file.path(output_dir, excel_filename)
excel_path <- normalizePath(excel_path, winslash = "\\", mustWork = FALSE)
# Build sheets list dynamically
@@ -709,14 +896,14 @@ export_field_analysis_excel <- function(field_df, summary_df, project_dir, curre
)
)
- rds_filename <- paste0(project_dir, "_kpi_summary_tables_week", sprintf("%02d_%d", current_week, year), ".rds")
- rds_path <- file.path(reports_dir, rds_filename)
+ rds_filename <- paste0(project_dir, "_field_analysis_week", sprintf("%02d_%d", current_week, year), ".rds")
+ rds_path <- file.path(output_dir, rds_filename)
saveRDS(kpi_data, rds_path)
message(paste("✓ Field analysis RDS exported to:", rds_path))
csv_filename <- paste0(project_dir, "_field_analysis_week", sprintf("%02d_%d", current_week, year), ".csv")
- csv_path <- file.path(output_subdir, csv_filename)
+ csv_path <- file.path(output_dir, csv_filename)
write_csv(field_df_rounded, csv_path)
message(paste("✓ Field analysis CSV exported to:", csv_path))
@@ -1304,7 +1491,7 @@ prepare_predictions <- function(predictions, newdata) {
dplyr::mutate(
sub_field = newdata$sub_field,
field = newdata$field,
- Age_days = newdata$DOY,
+ Age_days = newdata$DAH,
total_CI = round(newdata$cumulative_CI, 0),
predicted_Tcha = round(predicted_Tcha, 0),
season = newdata$season
@@ -1313,3 +1500,258 @@ prepare_predictions <- function(predictions, newdata) {
dplyr::left_join(., newdata, by = c("field", "sub_field", "season"))
)
}
+
+# ============================================================================
+# YIELD PREDICTION KPI (SHARED ML-BASED MODEL FOR ALL CLIENT TYPES)
+# ============================================================================
+
+#' Helper function for graceful fallback when training data unavailable
+#'
+#' @param field_boundaries Field boundaries (sf or SpatVector)
+#' @return List with summary and field_results (both with NA values)
+create_fallback_result <- function(field_boundaries) {
+ # Convert to SpatVector if needed (for terra::project)
+ if (!inherits(field_boundaries, "SpatVector")) {
+ field_boundaries <- terra::vect(field_boundaries)
+ }
+ field_boundaries_projected <- terra::project(field_boundaries, "EPSG:6933") # Equal Earth projection
+ field_areas <- terra::expanse(field_boundaries_projected) / 10000 # Convert m² to hectares
+ total_area <- sum(field_areas)
+
+ summary_result <- data.frame(
+ field_groups = c("Top 25%", "Average", "Lowest 25%", "Total area forecasted"),
+ count = c(0, 0, 0, nrow(field_boundaries)),
+ value = c(NA_real_, NA_real_, NA_real_, round(total_area, 1)),
+ stringsAsFactors = FALSE
+ )
+
+ field_results <- data.frame(
+ field = character(0),
+ sub_field = character(0),
+ Age_days = numeric(0),
+ yield_forecast_t_ha = numeric(0),
+ season = numeric(0),
+ stringsAsFactors = FALSE
+ )
+
+ return(list(summary = summary_result, field_results = field_results))
+}
+
+#' Calculate yield prediction KPI using Random Forest with Feature Selection
+#'
+#' Trains a Random Forest model on historical harvest data with cumulative CI,
+#' days after harvest (DAH), and CI-per-day as predictors. Uses CAST::ffs() for
+#' Forward Feature Selection. Predicts yields for mature fields (DAH >= DAH_MATURITY_THRESHOLD).
+#'
+#' @param field_boundaries Field boundaries (sf or SpatVector)
+#' @param harvesting_data Data frame with harvest data including tonnage_ha column
+#' @param cumulative_CI_vals_dir Directory containing "All_pivots_Cumulative_CI_quadrant_year_v2.rds"
+#'
+#' @return List with:
+#' - summary: Data frame with field_groups, count, value (quartiles and total area)
+#' - field_results: Data frame with field-level yield forecasts (yield_forecast_t_ha)
+#'
+#' @details
+#' **Training Data Requirements:**
+#' - cumulative_CI_vals_dir must contain "All_pivots_Cumulative_CI_quadrant_year_v2.rds"
+#' - harvesting_data must have tonnage_ha column with numeric yield values
+#' - Training stops gracefully if either is missing (returns NA values, not fake numbers)
+#'
+#' **Model Specifications:**
+#' - Algorithm: Random Forest (caret + CAST)
+#' - Feature Selection: Forward Feature Selection (CAST::ffs)
+#' - Cross-validation: 5-fold CV
+#' - Predictors: cumulative_CI, DAH, CI_per_day
+#' - Mature field threshold: DAH >= DAH_MATURITY_THRESHOLD (8 months, ~240 days)
+#' - Output: Field-level yield forecasts grouped by quartile
+#'
+#' **Error Handling:**
+#' - Missing tonnage_ha: Returns graceful fallback with NA (not zero) values
+#' - No training data: Logs WARNING, returns empty field_results
+#' - RDS file missing: Returns graceful fallback
+#' - Prediction errors: Wrapped in tryCatch, returns fallback on failure
+calculate_yield_prediction_kpi <- function(field_boundaries, harvesting_data, cumulative_CI_vals_dir) {
+ safe_log("Calculating yield prediction KPI using Random Forest with Feature Selection")
+
+ tryCatch({
+ # Check if tonnage_ha column is present and has valid data
+ if (is.null(harvesting_data) ||
+ !("tonnage_ha" %in% names(harvesting_data)) ||
+ all(is.na(harvesting_data$tonnage_ha))) {
+ safe_log("No harvest data available: lacking tonnage_ha column or all values are NA", "WARNING")
+ return(create_fallback_result(field_boundaries))
+ }
+
+ # Check if CI quadrant RDS file exists
+ ci_quadrant_path <- file.path(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds")
+ if (!file.exists(ci_quadrant_path)) {
+ safe_log(paste("CI quadrant file not found at:", ci_quadrant_path), "WARNING")
+ return(create_fallback_result(field_boundaries))
+ }
+
+ # Load CI quadrant data and fill missing field/sub_field values
+ CI_quadrant <- readRDS(ci_quadrant_path) %>%
+ dplyr::group_by(model) %>%
+ tidyr::fill(field, sub_field, .direction = "downup") %>%
+ dplyr::ungroup()
+
+ # Rename year column to season for consistency
+ harvesting_data_renamed <- harvesting_data %>% dplyr::rename(season = year)
+
+ # Join CI and yield data
+ CI_and_yield <- dplyr::left_join(CI_quadrant, harvesting_data_renamed,
+ by = c("field", "sub_field", "season")) %>%
+ dplyr::group_by(sub_field, season) %>%
+ dplyr::slice(which.max(DAH)) %>%
+ dplyr::select(field, sub_field, tonnage_ha, cumulative_CI, DAH, season, sub_area) %>%
+ dplyr::mutate(CI_per_day = ifelse(DAH > 0, cumulative_CI / DAH, NA_real_))
+
+
+ # Define predictors and response variables
+ predictors <- c("cumulative_CI", "DAH", "CI_per_day")
+ response <- "tonnage_ha"
+
+ # Prepare training dataset (fields with harvest data)
+ CI_and_yield_test <- CI_and_yield %>%
+ as.data.frame() %>%
+ dplyr::filter(!is.na(tonnage_ha))
+
+ # Check if we have minimum training data
+ if (nrow(CI_and_yield_test) == 0) {
+ safe_log("No training data available: no fields with tonnage_ha observations", "WARNING")
+ return(create_fallback_result(field_boundaries))
+ }
+
+ # Pre-clean training data: remove rows with any NAs in predictors or response
+ # This is required because CAST::ffs doesn't support na.rm parameter
+ CI_and_yield_test <- CI_and_yield_test %>%
+ dplyr::filter(!dplyr::if_any(dplyr::all_of(c(predictors, response)), is.na))
+
+ if (nrow(CI_and_yield_test) == 0) {
+ safe_log("No complete training data after removing NAs in predictors/response", "WARNING")
+ return(create_fallback_result(field_boundaries))
+ }
+
+ # Prepare prediction dataset (fields without harvest data, mature fields only)
+ prediction_yields <- CI_and_yield %>%
+ as.data.frame() %>%
+ dplyr::filter(is.na(tonnage_ha) & DAH >= DAH_MATURITY_THRESHOLD) # Mature fields only
+
+ # Configure model training parameters
+ ctrl <- caret::trainControl(
+ method = "cv",
+ savePredictions = TRUE,
+ allowParallel = TRUE,
+ number = 5,
+ verboseIter = FALSE
+ )
+
+ # Train the model with forward feature selection
+ set.seed(202) # For reproducibility
+ safe_log("Training Random Forest model with Forward Feature Selection...")
+ model_ffs_rf <- CAST::ffs(
+ CI_and_yield_test[, predictors],
+ CI_and_yield_test[, response],
+ method = "rf",
+ trControl = ctrl,
+ importance = TRUE,
+ withinSE = TRUE,
+ tuneLength = 5
+ )
+
+ # Predict yields on validation data (same as training data for RMSE calculation)
+ pred_ffs_rf <- prepare_predictions(
+ stats::predict(model_ffs_rf, newdata = CI_and_yield_test),
+ CI_and_yield_test
+ )
+
+ # Extract cross-validated RMSE from the model object (more honest than in-sample RMSE)
+ # The CAST::ffs model stores CV results in $results data frame
+ # We extract the RMSE from the best model (lowest RMSE across folds)
+ if (!is.null(model_ffs_rf$results) && "RMSE" %in% names(model_ffs_rf$results)) {
+ # Get minimum RMSE from cross-validation results (best model from feature selection)
+ rmse_value <- min(model_ffs_rf$results$RMSE, na.rm = TRUE)
+ safe_log(paste("Yield prediction RMSE (cross-validated):", round(rmse_value, 2), "t/ha"))
+ } else {
+ # Fallback: compute in-sample RMSE if CV results unavailable, but label it clearly
+ rmse_value <- sqrt(mean((pred_ffs_rf$predicted_Tcha - CI_and_yield_test$tonnage_ha)^2, na.rm = TRUE))
+ safe_log(paste("Yield prediction RMSE (in-sample/training):", round(rmse_value, 2), "t/ha"))
+ }
+
+ # Predict yields for current season (mature fields >= DAH_MATURITY_THRESHOLD days)
+ if (nrow(prediction_yields) > 0) {
+ pred_rf_current_season <- prepare_predictions(
+ stats::predict(model_ffs_rf, newdata = prediction_yields),
+ prediction_yields
+ ) %>%
+ dplyr::filter(Age_days >= DAH_MATURITY_THRESHOLD) %>%
+ dplyr::select(c("field", "Age_days", "predicted_Tcha", "season"))
+ } else {
+ pred_rf_current_season <- data.frame()
+ }
+
+ # Calculate summary statistics for KPI
+ if (nrow(pred_rf_current_season) > 0) {
+ safe_log(paste("Number of fields with yield predictions:", nrow(pred_rf_current_season)))
+ safe_log(paste("Predicted yield range:",
+ round(min(pred_rf_current_season$predicted_Tcha, na.rm = TRUE), 1),
+ "-",
+ round(max(pred_rf_current_season$predicted_Tcha, na.rm = TRUE), 1),
+ "t/ha"))
+
+ # Calculate quartiles for grouping
+ yield_quartiles <- quantile(pred_rf_current_season$predicted_Tcha,
+ probs = c(0.25, 0.5, 0.75), na.rm = TRUE)
+
+ # Count fields in each quartile
+ top_25_count <- sum(pred_rf_current_season$predicted_Tcha >= yield_quartiles[3], na.rm = TRUE)
+ average_count <- sum(pred_rf_current_season$predicted_Tcha >= yield_quartiles[1] &
+ pred_rf_current_season$predicted_Tcha < yield_quartiles[3], na.rm = TRUE)
+ lowest_25_count <- sum(pred_rf_current_season$predicted_Tcha < yield_quartiles[1], na.rm = TRUE)
+
+ # Calculate total area
+ if (!inherits(field_boundaries, "SpatVector")) {
+ field_boundaries_vect <- terra::vect(field_boundaries)
+ } else {
+ field_boundaries_vect <- field_boundaries
+ }
+
+ # Handle both sf and SpatVector inputs for area calculation
+ if (inherits(field_boundaries, "sf")) {
+ field_boundaries_projected <- sf::st_transform(field_boundaries, "EPSG:6933")
+ field_areas <- sf::st_area(field_boundaries_projected) / 10000 # m² to hectares
+ } else {
+ field_boundaries_projected <- terra::project(field_boundaries_vect, "EPSG:6933")
+ field_areas <- terra::expanse(field_boundaries_projected) / 10000
+ }
+ total_area <- sum(as.numeric(field_areas))
+
+ safe_log(paste("Total area:", round(total_area, 1), "hectares"))
+
+ # Build summary result
+ result <- data.frame(
+ field_groups = c("Top 25%", "Average", "Lowest 25%", "Total area forecasted"),
+ count = c(top_25_count, average_count, lowest_25_count, nrow(field_boundaries)),
+ value = c(round(yield_quartiles[3], 1), round(yield_quartiles[2], 1),
+ round(yield_quartiles[1], 1), round(total_area, 1)),
+ stringsAsFactors = FALSE
+ )
+
+ # Prepare field-level results
+ field_level_results <- pred_rf_current_season %>%
+ dplyr::select(field, Age_days, predicted_Tcha, season) %>%
+ dplyr::rename(yield_forecast_t_ha = predicted_Tcha)
+
+ safe_log("✓ Yield prediction complete")
+ return(list(summary = result, field_results = field_level_results))
+ } else {
+ safe_log(paste("No fields meet maturity threshold (DAH >=", DAH_MATURITY_THRESHOLD, ") for prediction"), "WARNING")
+ return(list(summary = create_fallback_result(field_boundaries)$summary,
+ field_results = data.frame()))
+ }
+
+ }, error = function(e) {
+ safe_log(paste("Error in yield prediction:", e$message), "ERROR")
+ return(create_fallback_result(field_boundaries))
+ })
+}
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 18457c3..4b63f09 100644
--- a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd
+++ b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd
@@ -2,8 +2,8 @@
params:
ref: "word-styles-reference-var1.docx"
output_file: "CI_report.docx"
- report_date: !r Sys.Date()
- data_dir: "angata"
+ report_date: "2026-02-04" #!r Sys.Date()
+ data_dir: "aura"
mail_day: "Wednesday"
borders: FALSE
ci_plot_type: "both"
@@ -67,6 +67,10 @@ suppressPackageStartupMessages({
library(glue) # For easy variable formatting in texts
})
+# Configure tmap for static plotting (required for legend.outside to work)
+tmap_mode("plot") # CRITICAL: Must be "plot" mode for legends outside to render properly
+tmap_options(component.autoscale = FALSE)
+
# Load custom utility functions
tryCatch({
source("report_utils.R")
@@ -113,15 +117,15 @@ safe_log(paste("weekly_CI_mosaic path:", weekly_CI_mosaic))
# NO workspace-wide fallback that might load wrong project
# Build expected KPI file path strictly from project_dir
-kpi_data_dir <- paths$kpi_reports_dir # Should be: laravel_app/storage/app/{project}/reports/kpis/field_level
+kpi_data_dir <- paths$kpi_reports_dir # file.path(paths$reports_dir, "kpis") # Should be: laravel_app/storage/app/{project}/reports/kpis
# Calculate week from report_date
current_week <- as.numeric(format(as.Date(report_date), "%V"))
current_year <- as.numeric(format(as.Date(report_date), "%G"))
# The ACTUAL filename format from 80_calculate_kpis.R output (after fix)
-# Format: {project_dir}_kpi_summary_tables_week{WW}_{YYYY}.rds
-kpi_rds_filename <- paste0(project_dir, "_kpi_summary_tables_week",
+# Format: {project_dir}_field_analysis_week{WW}_{YYYY}.rds
+kpi_rds_filename <- paste0(project_dir, "_field_analysis_week",
sprintf("%02d_%d", current_week, current_year), ".rds")
kpi_rds_path <- file.path(kpi_data_dir, kpi_rds_filename)
@@ -145,30 +149,174 @@ if (dir.exists(kpi_data_dir)) {
}
)
- # Handle new RDS structure (list with $summary_tables, $all_kpis, $field_details)
+ # Handle RDS structure from 80_utils_agronomic_support.R
+ # Expected: list(field_analysis = dataframe, kpis = list, summary_tables = list, ...)
+ # OR just a dataframe (for backward compatibility)
+
if (!is.null(loaded_data)) {
- if (is.list(loaded_data) && "summary_tables" %in% names(loaded_data)) {
- # New structure: extract summary_tables from the list
- summary_tables <- loaded_data$summary_tables
- if (!is.null(loaded_data$field_details)) {
- field_details_table <- loaded_data$field_details
+ # Try to extract field_analysis from different possible structures
+ if (is.data.frame(loaded_data)) {
+ # Direct dataframe (simplest case)
+ field_details_table <- loaded_data
+ safe_log("✓ Loaded field_analysis dataframe directly")
+ } else if (is.list(loaded_data)) {
+ # List structure - try different key names
+ if ("field_analysis_df" %in% names(loaded_data)) {
+ field_details_table <- loaded_data$field_analysis_df
+ safe_log("✓ Loaded field_analysis_df from list")
+ } else if ("field_analysis" %in% names(loaded_data)) {
+ field_details_table <- loaded_data$field_analysis
+ safe_log("✓ Loaded field_analysis from list")
+ } else if ("kpis" %in% names(loaded_data)) {
+ # Might be the full output from orchestrator - create combined table
+ safe_log("✓ Found kpis list in loaded data")
+ # For now, skip - we need the combined field table
+ }
+
+ # Also check if summary_tables already exists in the RDS
+ if ("summary_tables" %in% names(loaded_data)) {
+ summary_tables <- loaded_data$summary_tables
+ safe_log("✓ Loaded pre-computed summary_tables from RDS")
}
- safe_log("✓ Loaded KPI data (new structure with summary_tables)")
- kpi_files_exist <- TRUE
- } else if (is.list(loaded_data) && length(loaded_data) > 0) {
- # Legacy structure: directly use as summary_tables
- summary_tables <- loaded_data
- safe_log("✓ Loaded KPI tables (legacy structure)")
- kpi_files_exist <- TRUE
}
- if (kpi_files_exist) {
- safe_log(paste("✓ Available KPI tables:", paste(names(summary_tables), collapse=", ")))
+ # If we successfully loaded field_details_table, transform it into summary_tables
+ if (!is.null(field_details_table) && nrow(field_details_table) > 0) {
+ safe_log(paste("✓ Loaded field_details_table with", nrow(field_details_table), "fields"))
+ safe_log(paste(" Columns:", paste(names(field_details_table), collapse=", ")))
+
+ # NORMALIZATION: Normalize column structure (Field→Field_id rename + expected_cols injection)
+ field_details_table <- normalize_field_details_columns(field_details_table)
+
+ # Normalize other common column name variations
+ column_mappings <- list(
+ c("CV Value", "CV"),
+ c("Mean CI", "Mean_CI"),
+ c("Yield Forecast (t/ha)", "TCH_Forecasted"),
+ c("Gap Score", "Gap_Score"),
+ c("Growth Uniformity", "Growth_Uniformity"),
+ c("Decline Risk", "Decline_Risk"),
+ c("Patchiness Risk", "Patchiness_Risk"),
+ c("Moran's I", "Morans_I")
+ )
+
+ for (mapping in column_mappings) {
+ old_name <- mapping[1]
+ new_name <- mapping[2]
+ if (old_name != new_name && old_name %in% names(field_details_table) && !new_name %in% names(field_details_table)) {
+ field_details_table <- field_details_table %>%
+ dplyr::rename(!!new_name := old_name)
+ safe_log(paste(" ✓ Normalized:", old_name, "→", new_name))
+ }
+ }
+
+
+ # Only create summary_tables if not already loaded from RDS
+ if (is.null(summary_tables)) {
+ summary_tables <- list()
+
+ # 1. Uniformity summary - GROUP BY Uniformity_Category and COUNT
+ if ("Uniformity_Category" %in% names(field_details_table)) {
+ summary_tables$uniformity <- field_details_table %>%
+ group_by(interpretation = Uniformity_Category) %>%
+ summarise(field_count = n(), .groups = 'drop')
+ safe_log(" ✓ Created uniformity summary")
+ }
+
+ # 2. Area change summary - GROUP BY Area_Change_Interpretation and COUNT
+ if ("Area_Change_Interpretation" %in% names(field_details_table)) {
+ summary_tables$area_change <- field_details_table %>%
+ group_by(interpretation = Area_Change_Interpretation) %>%
+ summarise(field_count = n(), .groups = 'drop')
+ safe_log(" ✓ Created area_change summary")
+ }
+
+ # 3. Growth decline summary - GROUP BY Trend_Interpretation and COUNT
+ if ("Trend_Interpretation" %in% names(field_details_table)) {
+ summary_tables$growth_decline <- field_details_table %>%
+ group_by(trend_interpretation = Trend_Interpretation) %>%
+ summarise(field_count = n(), .groups = 'drop')
+ safe_log(" ✓ Created growth_decline summary")
+ }
+
+ # 4. Patchiness summary - GROUP BY Patchiness_Risk + Gini ranges
+ if ("Patchiness_Risk" %in% names(field_details_table) && "Gini_Coefficient" %in% names(field_details_table)) {
+ summary_tables$patchiness <- field_details_table %>%
+ mutate(
+ gini_category = case_when(
+ Gini_Coefficient < 0.2 ~ "Uniform (Gini<0.2)",
+ Gini_Coefficient < 0.4 ~ "Moderate (Gini 0.2-0.4)",
+ TRUE ~ "High (Gini≥0.4)"
+ )
+ ) %>%
+ group_by(gini_category, patchiness_risk = Patchiness_Risk) %>%
+ summarise(field_count = n(), .groups = 'drop')
+ safe_log(" ✓ Created patchiness summary")
+ }
+
+ # 5. TCH forecast summary - show actual value ranges (quartiles) instead of counts
+ if ("TCH_Forecasted" %in% names(field_details_table)) {
+ tch_values <- field_details_table %>%
+ filter(!is.na(TCH_Forecasted)) %>%
+ pull(TCH_Forecasted)
+
+ if (length(tch_values) > 0) {
+ # Defensive check: if all TCH values are identical, handle as special case
+ if (length(unique(tch_values)) == 1) {
+ # All values are identical
+ identical_value <- tch_values[1]
+ summary_tables$tch_forecast <- tibble::tibble(
+ tch_category = "All equal",
+ range = paste0(round(identical_value, 1), " t/ha"),
+ field_count = length(tch_values)
+ )
+ safe_log(" ✓ Created tch_forecast summary (all TCH values identical)")
+ } else {
+ # Multiple distinct values - use three-quartile approach
+ q25 <- quantile(tch_values, 0.25, na.rm = TRUE)
+ q50 <- quantile(tch_values, 0.50, na.rm = TRUE)
+ q75 <- quantile(tch_values, 0.75, na.rm = TRUE)
+ min_val <- min(tch_values, na.rm = TRUE)
+ max_val <- max(tch_values, na.rm = TRUE)
+
+ summary_tables$tch_forecast <- tibble::tibble(
+ tch_category = c("Top 25%", "Middle 50%", "Bottom 25%"),
+ range = c(
+ paste0(round(q75, 1), "-", round(max_val, 1), " t/ha"),
+ paste0(round(q25, 1), "-", round(q75, 1), " t/ha"),
+ paste0(round(min_val, 1), "-", round(q25, 1), " t/ha")
+ ),
+ field_count = c(
+ nrow(field_details_table %>% filter(TCH_Forecasted >= q75, !is.na(TCH_Forecasted))),
+ nrow(field_details_table %>% filter(TCH_Forecasted >= q25 & TCH_Forecasted < q75, !is.na(TCH_Forecasted))),
+ nrow(field_details_table %>% filter(TCH_Forecasted < q25, !is.na(TCH_Forecasted)))
+ )
+ )
+ safe_log(" ✓ Created tch_forecast summary with value ranges")
+ }
+ }
+ }
+
+ # 6. Gaps summary - GROUP BY Gap_Level and COUNT
+ if ("Gap_Level" %in% names(field_details_table)) {
+ summary_tables$gap_filling <- field_details_table %>%
+ group_by(gap_level = Gap_Level) %>%
+ summarise(field_count = n(), .groups = 'drop')
+ safe_log(" ✓ Created gap_filling summary")
+ }
+
+ safe_log(paste("✓ Created", length(summary_tables), "summary tables from field_details"))
+ }
+
+ kpi_files_exist <- TRUE
+
+ } else {
+ safe_log("ERROR: Could not extract field_analysis dataframe from RDS", "ERROR")
}
}
+
} else {
- safe_log(paste("KPI file not found in:", kpi_rds_path), "WARNING")
- safe_log(paste("Expected file:", kpi_rds_filename), "WARNING")
+ safe_log(paste("KPI file not found:", kpi_rds_path), "WARNING")
safe_log(paste("Files in directory:", paste(list.files(kpi_data_dir, pattern="\\.rds$"), collapse=", ")), "WARNING")
}
} else {
@@ -178,7 +326,23 @@ if (dir.exists(kpi_data_dir)) {
if (!kpi_files_exist) {
safe_log(paste("Skipping KPI sections - no data for", project_dir, "on", report_date), "WARNING")
summary_tables <- NULL
+ field_details_table <- NULL
}
+
+# DEBUG: Log what was actually loaded
+if (exists("summary_tables") && !is.null(summary_tables)) {
+ safe_log(paste("✓ summary_tables available with", length(summary_tables), "KPIs"))
+ for (kpi_name in names(summary_tables)) {
+ kpi_df <- summary_tables[[kpi_name]]
+ if (!is.null(kpi_df) && is.data.frame(kpi_df)) {
+ safe_log(paste(" -", kpi_name, ":", nrow(kpi_df), "rows"))
+ }
+ }
+} else {
+ safe_log("WARNING: summary_tables is NULL or does not exist", "WARNING")
+}
+
+# summary_tables # Uncomment for debugging
```
```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE}
@@ -209,13 +373,13 @@ prev_week_1_date <- report_date_obj - 7
prev_week_2_date <- report_date_obj - 14
prev_week_3_date <- report_date_obj - 21
-week_minus_1 <- lubridate::isoweek(prev_week_1_date)
+week_minus_1 <- sprintf("%02d", lubridate::isoweek(prev_week_1_date))
week_minus_1_year <- lubridate::isoyear(prev_week_1_date)
-week_minus_2 <- lubridate::isoweek(prev_week_2_date)
+week_minus_2 <- sprintf("%02d", lubridate::isoweek(prev_week_2_date))
week_minus_2_year <- lubridate::isoyear(prev_week_2_date)
-week_minus_3 <- lubridate::isoweek(prev_week_3_date)
+week_minus_3 <- sprintf("%02d", lubridate::isoweek(prev_week_3_date))
week_minus_3_year <- lubridate::isoyear(prev_week_3_date)
# Format current week with leading zeros
@@ -352,6 +516,19 @@ t <- function(key) {
}
```
+
+::: {custom-style="Cover_title" style="text-align:center; margin-top:120px;"}
+Satellite Based Field Reporting
+:::
+
+
+
+::: {custom-style="Cover_subtitle" style="text-align:center; margin-top:18px;"}
+Chlorophyll Index (CI) Monitoring Report — `r toupper(params$data_dir)` Farm (Week `r { rd <- params$report_date; rd <- if (inherits(rd, "Date")) rd else suppressWarnings(as.Date(rd)); if (is.na(rd)) rd <- Sys.Date(); if (!is.null(params$week)) params$week else format(rd, '%V') }`, `r { rd <- params$report_date; rd <- if (inherits(rd, "Date")) rd else suppressWarnings(as.Date(rd)); if (is.na(rd)) rd <- Sys.Date(); format(rd, '%Y') }`)
+:::
+
+\newpage
+
`r t("report_summary")`
`r t("report_structure")`
@@ -359,66 +536,75 @@ t <- function(key) {
`r t("key_insights")`
```{r key_insights, echo=FALSE, results='asis'}
-# Calculate key insights from aggregated KPI summary data
+# Calculate key insights from KPI data
if (exists("summary_tables") && !is.null(summary_tables) && length(summary_tables) > 0) {
- # Extract aggregated KPI summaries (farm-level, not per-field)
- uniformity_summary <- summary_tables$uniformity # Has: Status, Field Count, Avg CV, Avg Moran's I
- area_change_summary <- summary_tables$area_change # Has: Status, Field Count, Avg CI Change %
- growth_summary <- summary_tables$growth_decline # Has: Trend, Field Count, Avg 4-Week Trend
- weed_summary <- summary_tables$weed_pressure # Has: Risk Level, Field Count, Avg Fragmentation
+ # Aggregate per-field KPI data into summaries on-the-fly
- # Total fields analyzed (from uniformity summary)
- total_fields <- sum(uniformity_summary$`Field Count`, na.rm = TRUE)
-
- # Uniformity insights
- if (!is.null(uniformity_summary) && nrow(uniformity_summary) > 0) {
+ # 1. Uniformity insights - group by interpretation
+ if (!is.null(summary_tables$uniformity) && nrow(summary_tables$uniformity) > 0) {
cat(t("field_unif"))
- for (i in 1:nrow(uniformity_summary)) {
- status <- uniformity_summary$Status[i]
- count <- uniformity_summary$`Field Count`[i]
- if (count > 0) {
+ uniformity_counts <- summary_tables$uniformity %>%
+ dplyr::select(interpretation, count = field_count)
+
+ for (i in seq_len(nrow(uniformity_counts))) {
+ status <- uniformity_counts$interpretation[i]
+ count <- uniformity_counts$count[i]
+ if (!is.na(status) && !is.na(count) && count > 0) {
cat(t("unif_status"))
}
}
}
- # Area change insights
- if (!is.null(area_change_summary) && nrow(area_change_summary) > 0) {
+ # 2. Area change insights - group by interpretation
+ if (!is.null(summary_tables$area_change) && nrow(summary_tables$area_change) > 0) {
cat("\n", t("field_area"))
- for (i in 1:nrow(area_change_summary)) {
- status <- area_change_summary$Status[i]
- count <- area_change_summary$`Field Count`[i]
- if (count > 0 && !is.na(status)) {
+ area_counts <- summary_tables$area_change %>%
+ dplyr::select(interpretation, count = field_count)
+
+ for (i in seq_len(nrow(area_counts))) {
+ status <- area_counts$interpretation[i]
+ count <- area_counts$count[i]
+ if (!is.na(status) && !is.na(count) && count > 0) {
cat(t("area_status"))
}
}
}
- # Growth trend insights
- if (!is.null(growth_summary) && nrow(growth_summary) > 0) {
+ # 3. Growth trend insights - group by trend_interpretation
+ if (!is.null(summary_tables$growth_decline) && nrow(summary_tables$growth_decline) > 0) {
cat("\n", t("growth_trend"))
- for (i in 1:nrow(growth_summary)) {
- trend <- growth_summary$Trend[i]
- count <- growth_summary$`Field Count`[i]
- if (count > 0 && !is.na(trend)) {
+ growth_counts <- summary_tables$growth_decline %>%
+ dplyr::select(trend_interpretation, count = field_count)
+
+ for (i in seq_len(nrow(growth_counts))) {
+ trend <- growth_counts$trend_interpretation[i]
+ count <- growth_counts$count[i]
+ if (!is.na(trend) && !is.na(count) && count > 0) {
cat(t("trend_status"))
}
}
}
- # Weed pressure insights
- if (!is.null(weed_summary) && nrow(weed_summary) > 0) {
- cat("\n", t("weed_press"))
- for (i in 1:nrow(weed_summary)) {
- risk <- weed_summary$`Risk Level`[i]
- count <- weed_summary$`Field Count`[i]
- if (count > 0 && !is.na(risk)) {
- cat(t("weed_status"))
+ # 4. Patchiness insights - group by patchiness_risk
+ if (!is.null(summary_tables$patchiness) && nrow(summary_tables$patchiness) > 0) {
+ cat("\n", t("patch_risk"))
+ patchiness_counts <- summary_tables$patchiness %>%
+ dplyr::select(patchiness_risk, count = field_count)
+
+ for (i in seq_len(nrow(patchiness_counts))) {
+ risk <- patchiness_counts$patchiness_risk[i]
+ count <- patchiness_counts$count[i]
+ if (!is.na(risk) && !is.na(count) && count > 0) {
+ cat(t("patch_status"))
}
}
}
+ # 5. Total fields analyzed
+ total_fields <- sum(summary_tables$uniformity$field_count, na.rm = TRUE)
+ cat("\n", t("tot_fields_analyzed"))
+
} else {
cat(t("kpi_na"))
}
@@ -437,30 +623,37 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table
tryCatch({
# KPI metadata for display
kpi_display_order <- list(
- uniformity = list(display = "Field Uniformity", level_col = "Status", count_col = "Field Count"),
- area_change = list(display = "Area Change", level_col = "Status", count_col = "Field Count"),
- tch_forecast = list(display = "TCH Forecasted", level_col = NULL, count_col = "Fields"),
- growth_decline = list(display = "Growth Decline", level_col = "Trend", count_col = "Field Count"),
- weed_pressure = list(display = "Weed Presence", level_col = "Risk Level", count_col = "Field Count"),
- gap_filling = list(display = "Gap Filling", level_col = NULL, count_col = NULL)
+ uniformity = list(display = "Field Uniformity", level_col = "interpretation", count_col = "field_count"),
+ area_change = list(display = "Area Change", level_col = "interpretation", count_col = "field_count"),
+ growth_decline = list(display = "Growth Decline (4-Week Trend)", level_col = "trend_interpretation", count_col = "field_count"),
+ patchiness = list(display = "Field Patchiness", level_col = "gini_category", count_col = "field_count", detail_col = "patchiness_risk"),
+ tch_forecast = list(display = "TCH Forecasted", level_col = "tch_category", detail_col = "range", count_col = "field_count"),
+ gap_filling = list(display = "Gaps", level_col = "gap_level", count_col = "field_count")
)
- standardize_kpi <- function(df, level_col, count_col) {
+ standardize_kpi <- function(df, level_col, count_col, detail_col = NULL) {
if (is.null(level_col) || !(level_col %in% names(df)) || is.null(count_col) || !(count_col %in% names(df))) {
return(NULL)
}
total <- sum(df[[count_col]], na.rm = TRUE)
total <- ifelse(total == 0, NA_real_, total)
+ # If detail_col is specified, use it as the Level instead
+ if (!is.null(detail_col) && detail_col %in% names(df)) {
+ display_level <- df[[detail_col]]
+ } else {
+ display_level <- df[[level_col]]
+ }
+
df %>%
dplyr::transmute(
- Level = as.character(.data[[level_col]]),
+ Level = as.character(display_level),
Count = as.integer(round(as.numeric(.data[[count_col]]))),
- Percent = dplyr::if_else(
- is.na(total),
- NA_real_,
+ Percent = if (is.na(total)) {
+ NA_real_
+ } else {
round(Count / total * 100, 1)
- )
+ }
)
}
@@ -473,17 +666,9 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table
kpi_df <- summary_tables[[kpi_key]]
if (is.null(kpi_df) || !is.data.frame(kpi_df) || nrow(kpi_df) == 0) next
- kpi_rows <- standardize_kpi(kpi_df, config$level_col, config$count_col)
- if (is.null(kpi_rows) && kpi_key %in% c("tch_forecast", "gap_filling")) {
- numeric_cols <- names(kpi_df)[vapply(kpi_df, is.numeric, logical(1))]
- if (length(numeric_cols) > 0) {
- kpi_rows <- tibble::tibble(
- Level = numeric_cols,
- Count = round(as.numeric(kpi_df[1, numeric_cols]), 2),
- Percent = NA_real_
- )
- }
- }
+ # Pass detail_col if it exists in config
+ detail_col <- if (!is.null(config$detail_col)) config$detail_col else NULL
+ kpi_rows <- standardize_kpi(kpi_df, config$level_col, config$count_col, detail_col)
if (!is.null(kpi_rows)) {
kpi_rows$KPI <- config$display
@@ -495,21 +680,22 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table
if (nrow(combined_df) > 0) {
combined_df <- combined_df %>%
+ dplyr::mutate(KPI_group = KPI) %>%
dplyr::group_by(KPI) %>%
dplyr::mutate(
KPI_display = if_else(dplyr::row_number() == 1, KPI, "")
) %>%
- dplyr::ungroup() %>%
+ dplyr::ungroup()
+
+ kpi_group_sizes <- rle(combined_df$KPI_group)$lengths
+
+ display_df <- combined_df %>%
dplyr::select(KPI = KPI_display, Level, Count, Percent)
- ft <- flextable(combined_df) %>%
+ ft <- flextable(display_df) %>%
merge_v(j = "KPI") %>%
autofit()
- kpi_group_sizes <- combined_df %>%
- dplyr::group_by(KPI) %>%
- dplyr::tally() %>%
- dplyr::pull(n)
cum_rows <- cumsum(kpi_group_sizes)
for (i in seq_along(cum_rows)) {
if (i < length(cum_rows)) {
@@ -518,7 +704,7 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table
}
}
- print(ft)
+ ft
} else {
cat("No valid KPI summary tables found for display.\n")
}
@@ -533,6 +719,7 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table
}
```
+\newpage
`r t("field_alerts")`
```{r field_alerts_table, echo=FALSE, results='asis'}
@@ -543,8 +730,8 @@ generate_field_alerts <- function(field_details_table) {
}
# Check for required columns
- required_cols <- c("Field", "Field Size (ha)", "Growth Uniformity", "Yield Forecast (t/ha)",
- "Gap Score", "Decline Risk", "Weed Risk", "Mean CI", "CV Value", "Moran's I")
+ required_cols <- c("Field", "Field Size (acres)", "Growth Uniformity", "Yield Forecast (t/ha)",
+ "Gap Score", "Decline Risk", "Patchiness Risk", "Mean CI", "CV Value", "Moran's I")
missing_cols <- setdiff(required_cols, colnames(field_details_table))
if (length(missing_cols) > 0) {
@@ -563,7 +750,7 @@ generate_field_alerts <- function(field_details_table) {
# Aggregate data for the field
field_summary <- field_data %>%
summarise(
- field_size = sum(`Field Size (ha)`, na.rm = TRUE),
+ field_size = sum(`Field Size (acres)`, na.rm = TRUE),
uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"),
avg_yield_forecast = mean(`Yield Forecast (t/ha)`, na.rm = TRUE),
max_gap_score = max(`Gap Score`, na.rm = TRUE),
@@ -574,10 +761,11 @@ generate_field_alerts <- function(field_details_table) {
any(`Decline Risk` == "Low") ~ "Low",
TRUE ~ "Unknown"
),
- highest_weed_risk = case_when(
- any(`Weed Risk` == "High") ~ "High",
- any(`Weed Risk` == "Moderate") ~ "Moderate",
- any(`Weed Risk` == "Low") ~ "Low",
+ highest_patchiness_risk = case_when(
+ any(`Patchiness Risk` == "High") ~ "High",
+ any(`Patchiness Risk` == "Medium") ~ "Medium",
+ any(`Patchiness Risk` == "Low") ~ "Low",
+ any(`Patchiness Risk` == "Minimal") ~ "Minimal",
TRUE ~ "Unknown"
),
avg_mean_ci = mean(`Mean CI`, na.rm = TRUE),
@@ -603,12 +791,12 @@ generate_field_alerts <- function(field_details_table) {
}
# Priority 3: No alert (no stress)
- # Keep other alerts for decline risk, weed risk, gap score
+ # Keep other alerts for decline risk, patchiness risk, gap score
if (field_summary$highest_decline_risk %in% c("High", "Very-high")) {
field_alerts <- c(field_alerts, "Growth decline observed")
}
- if (field_summary$highest_weed_risk == "High") {
- field_alerts <- c(field_alerts, "Increased weed presence")
+ if (field_summary$highest_patchiness_risk == "High") {
+ field_alerts <- c(field_alerts, "High patchiness detected - recommend scouting")
}
if (field_summary$max_gap_score > 20) {
field_alerts <- c(field_alerts, "Gaps present - recommend review")
@@ -637,7 +825,43 @@ generate_field_alerts <- function(field_details_table) {
# Generate and display alerts table
if (exists("field_details_table") && !is.null(field_details_table) && nrow(field_details_table) > 0) {
- alerts_data <- generate_field_alerts(field_details_table)
+ # Adapter: Map normalized column names back to legacy names for generate_field_alerts()
+ # (generates from the normalized schema created by normalize_field_details_columns + column_mappings)
+ field_details_for_alerts <- field_details_table
+
+ # Rename normalized columns back to legacy names (only if they exist)
+ if ("Field_id" %in% names(field_details_for_alerts)) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(Field = Field_id)
+ }
+ if ("Mean_CI" %in% names(field_details_for_alerts)) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Mean CI` = Mean_CI)
+ }
+ if ("CV" %in% names(field_details_for_alerts) && !("CV Value" %in% names(field_details_for_alerts))) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`CV Value` = CV)
+ }
+ if ("TCH_Forecasted" %in% names(field_details_for_alerts)) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Yield Forecast (t/ha)` = TCH_Forecasted)
+ }
+ if ("Gap_Score" %in% names(field_details_for_alerts)) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Gap Score` = Gap_Score)
+ }
+ if ("Growth_Uniformity" %in% names(field_details_for_alerts)) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Growth Uniformity` = Growth_Uniformity)
+ }
+ if ("Decline_Risk" %in% names(field_details_for_alerts)) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Decline Risk` = Decline_Risk)
+ }
+ if ("Decline_Severity" %in% names(field_details_for_alerts) && !("Decline Risk" %in% names(field_details_for_alerts))) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Decline Risk` = Decline_Severity)
+ }
+ if ("Patchiness_Risk" %in% names(field_details_for_alerts)) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Patchiness Risk` = Patchiness_Risk)
+ }
+ if ("Morans_I" %in% names(field_details_for_alerts)) {
+ field_details_for_alerts <- field_details_for_alerts %>% dplyr::rename(`Moran's I` = Morans_I)
+ }
+
+ alerts_data <- generate_field_alerts(field_details_for_alerts)
if (!is.null(alerts_data) && nrow(alerts_data) > 0) {
ft <- flextable(alerts_data) %>%
# set_caption("Field Alerts Summary") %>%
@@ -705,23 +929,24 @@ if (!exists("field_details_table") || is.null(field_details_table)) {
# Try to calculate field sizes (area) from geometry if available
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
+ sf::st_area(sf::st_geometry(AllPivots0)) / 4046.86 # Convert m² to acres (1 acre = 4046.86 m²)
} else {
rep(NA_real_, length(field_names))
}
# Create minimal field details table with actual data we have + NAs for missing KPI columns
+ # IMPORTANT: Use column names that match downstream code expectations (no spaces, match exact names)
field_details_table <- tibble::tibble(
- Field = field_names,
- `Field Size (ha)` = as.numeric(field_sizes),
- `Growth Uniformity` = NA_character_,
- `Yield Forecast (t/ha)` = NA_real_,
- `Gap Score` = NA_real_,
- `Decline Risk` = NA_character_,
- `Weed Risk` = NA_character_,
- `Mean CI` = NA_real_,
- `CV Value` = NA_real_,
- `Moran's I` = NA_real_
+ Field_id = field_names,
+ Acreage = as.numeric(field_sizes),
+ Growth_Uniformity = NA_character_,
+ TCH_Forecasted = NA_real_,
+ Gap_Score = NA_real_,
+ Decline_Risk = NA_character_,
+ Patchiness_Risk = NA_character_,
+ Mean_CI = NA_real_,
+ CV = NA_real_,
+ Morans_I = NA_real_
)
safe_log(paste("Created field_details_table from geometries for", nrow(field_details_table), "fields"))
}
@@ -731,8 +956,6 @@ if (!exists("field_details_table") || is.null(field_details_table)) {
}
```
-`r t("overview_maps")`
-
```{r aggregate_farm_level_rasters, message=FALSE, warning=FALSE, include=FALSE}
# Aggregate per-field weekly mosaics into single farm-level rasters for visualization
# This creates on-the-fly mosaics for current week and historical weeks without saving intermediate files
@@ -768,8 +991,8 @@ tryCatch({
# Aggregate mosaics for three weeks: current, week-1, week-3
farm_mosaic_current <- aggregate_mosaics_safe(current_week, current_iso_year, "current week")
- farm_mosaic_minus_1 <- aggregate_mosaics_safe(week_minus_1, week_minus_1_year, "week-1")
- farm_mosaic_minus_3 <- aggregate_mosaics_safe(week_minus_3, week_minus_3_year, "week-3")
+ farm_mosaic_minus_1 <- aggregate_mosaics_safe(as.numeric(week_minus_1), week_minus_1_year, "week-1")
+ farm_mosaic_minus_3 <- aggregate_mosaics_safe(as.numeric(week_minus_3), week_minus_3_year, "week-3")
# Extract CI band (5th band, or named "CI") from each aggregated mosaic
farm_ci_current <- NULL
@@ -878,9 +1101,9 @@ tryCatch({
})
```
-`r t("ci_overview_map")`
+\newpage
-```{r render_farm_ci_map, echo=FALSE, fig.height=5.5, fig.width=6.5, dpi=150, dev='png', message=FALSE, warning=FALSE}
+```{r render_farm_ci_map, echo=FALSE, message=FALSE, warning=FALSE, fig.height=6.8, fig.width=8.5, dpi=150, dev='png'}
# Create farm-level chlorophyll index map with OpenStreetMap basemap
tryCatch({
if (!is.null(farm_ci_current_ll)) {
@@ -954,13 +1177,13 @@ tryCatch({
map <- map +
# Add scale bar and theme
ggspatial::annotation_scale(
- location = "br",
+ location = "tr",
width_hint = 0.25
) +
ggplot2::theme_void() +
ggplot2::theme(
- legend.position = "bottom",
- legend.direction = "horizontal",
+ legend.position = "right",
+ legend.direction = "vertical",
legend.title = ggplot2::element_text(size = 10),
legend.text = ggplot2::element_text(size = 9),
plot.title = ggplot2::element_text(hjust = 0.5, size = 12, face = "bold"),
@@ -986,9 +1209,7 @@ tryCatch({
})
```
-`r t("ci_diff_map")`
-
-```{r render_farm_ci_diff_map, echo=FALSE, fig.height=5.5, fig.width=6.5, dpi=150, dev='png', message=FALSE, warning=FALSE}
+```{r render_farm_ci_diff_map, echo=FALSE, message=FALSE, warning=FALSE, fig.height=6.8, fig.width=8.5, dpi=150, dev='png'}
# Create farm-level CI difference map (week-over-week change)
tryCatch({
if (!is.null(farm_ci_diff_week_ll)) {
@@ -1063,13 +1284,13 @@ tryCatch({
map <- map +
# Add scale bar and theme
ggspatial::annotation_scale(
- location = "br",
+ location = "tr",
width_hint = 0.25
) +
ggplot2::theme_void() +
ggplot2::theme(
- legend.position = "bottom",
- legend.direction = "horizontal",
+ legend.position = "right",
+ legend.direction = "vertical",
legend.title = ggplot2::element_text(size = 10),
legend.text = ggplot2::element_text(size = 9),
plot.title = ggplot2::element_text(hjust = 0.5, size = 12, face = "bold"),
@@ -1095,23 +1316,33 @@ tryCatch({
})
```
-\newpage
+# Section 2: Field-by-Field Analysis
-`r t("section_ii")`
+## Overview of Field-Level Insights
+This section provides detailed, field-specific analyses including chlorophyll index maps, trend graphs, and performance metrics. Each field is analyzed individually to support targeted interventions.
+
+**Key Elements per Field:**
+- Current and historical CI maps
+- Week-over-week change visualizations
+- Cumulative growth trends
+- Field-specific KPI summaries
+
+*Navigate to the following pages for individual field reports.*
\newpage
-```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=6.5, dpi=150, dev='png', message=TRUE, echo=FALSE, warning=TRUE, include=TRUE, results='asis'}
+```{r generate_field_visualizations, echo=FALSE, fig.height=3.8, fig.width=10, dev='png', dpi=150, results='asis'}
# Generate detailed visualizations for each field using purrr::walk
+
tryCatch({
- # Prepare merged field list and week/year info
- AllPivots_merged <- AllPivots0 %>%
+ # Prepare merged field list and week/year info
+ AllPivots_merged <- AllPivots0 %>%
dplyr::filter(!is.na(field), !is.na(sub_field)) %>%
dplyr::group_by(field) %>%
dplyr::summarise(.groups = 'drop')
- # Helper to get week/year from a date
- get_week_year <- function(date) {
+ # Helper to get week/year from a date
+ get_week_year <- function(date) {
list(
week = as.numeric(format(date, "%V")),
year = as.numeric(format(date, "%G"))
@@ -1130,9 +1361,7 @@ tryCatch({
# Helper function to safely load per-field mosaic if it exists
load_per_field_mosaic <- function(base_dir, field_name, week, year) {
path <- file.path(base_dir, field_name, paste0("week_", sprintf("%02d", week), "_", year, ".tif"))
- cat(paste(" [DEBUG] Field:", field_name, "trying path:", path, "\n"))
if (file.exists(path)) {
- cat(paste(" ✓ File found\n"))
tryCatch({
rast_obj <- terra::rast(path)
# Extract CI band if present, otherwise first band
@@ -1145,22 +1374,13 @@ tryCatch({
message(paste("Warning: Could not load", path, ":", e$message))
return(NULL)
})
- } else {
- cat(paste(" ✗ File NOT found\n"))
}
return(NULL)
}
# Iterate through fields using purrr::walk
- is_first_field <- TRUE
purrr::walk(AllPivots_merged$field, function(field_name) {
tryCatch({
- # Add page break before each field (except first)
- if (!is_first_field) {
- cat("\\newpage\n\n")
- }
- is_first_field <<- FALSE
-
message(paste("Processing field:", field_name))
# Load per-field rasters for all 4 weeks
@@ -1204,7 +1424,7 @@ tryCatch({
borders = borders,
colorblind_friendly = colorblind_friendly
)
- cat("\n\n")
+ #cat("\n\n")
} else {
message(paste("Warning: No raster data found for field", field_name))
}
@@ -1213,8 +1433,8 @@ tryCatch({
ci_quadrant_data <- if (project_dir == "esa" && field_name == "00F25") {
CI_quadrant %>%
dplyr::filter(field == "00F25") %>%
- dplyr::arrange(DOY) %>%
- dplyr::group_by(DOY) %>%
+ dplyr::arrange(DAH) %>%
+ dplyr::group_by(DAH) %>%
dplyr::slice(1) %>%
dplyr::ungroup()
} else {
@@ -1235,20 +1455,51 @@ tryCatch({
benchmark_percentiles = c(10, 50, 90),
benchmark_data = benchmarks
)
- cat("\n\n")
+ #cat("\n")
}
# Add field-specific KPI summary if available
- # NOTE: generate_field_kpi_summary function not yet implemented
- # Skipping field-level KPI text for now; KPI tables are available in Section 1
- if (FALSE) { # Disabled pending function implementation
- # if (exists("field_details_table") && !is.null(field_details_table) && nrow(field_details_table) > 0) {
- # kpi_summary <- generate_field_kpi_summary(field_name, field_details_table, CI_quadrant)
- # if (!is.null(kpi_summary)) {
- # cat(kpi_summary)
- # cat("\n\n")
- # }
- # }
+ if (exists("field_details_table") && !is.null(field_details_table) && nrow(field_details_table) > 0) {
+ field_kpi <- field_details_table %>%
+ dplyr::filter(Field_id == field_name)
+
+ if (nrow(field_kpi) > 0) {
+ # Format KPIs as compact single line (no interpretations, just values)
+ kpi_parts <- c(
+ sprintf("**CV:** %.2f", field_kpi$CV),
+ sprintf("**Mean CI:** %.2f", field_kpi$Mean_CI)
+ )
+
+ # Add Weekly_CI_Change if available (note: capital C and I)
+ if (!is.null(field_kpi$Weekly_CI_Change) && !is.na(field_kpi$Weekly_CI_Change)) {
+ change_sign <- ifelse(field_kpi$Weekly_CI_Change >= 0, "+", "")
+ kpi_parts <- c(kpi_parts, sprintf("**Δ CI:** %s%.2f", change_sign, field_kpi$Weekly_CI_Change))
+ }
+
+ # Compact trend display with symbols
+ trend_compact <- case_when(
+ grepl("Strong growth", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↑↑",
+ grepl("Growth|Increasing", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↑",
+ grepl("Stable|No growth", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "→",
+ grepl("Slight decline", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↓",
+ grepl("Strong decline|Severe", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↓↓",
+ TRUE ~ field_kpi$Trend_Interpretation
+ )
+ kpi_parts <- c(kpi_parts, sprintf("**Trend:** %s", trend_compact))
+
+ if (!is.na(field_kpi$TCH_Forecasted) && field_kpi$TCH_Forecasted > 0) {
+ kpi_parts <- c(kpi_parts, sprintf("**Yield:** %.1f t/ha", field_kpi$TCH_Forecasted))
+ }
+
+ kpi_parts <- c(
+ kpi_parts,
+ sprintf("**Gap:** %.0f", field_kpi$Gap_Score),
+ sprintf("**Patchiness:** %s", field_kpi$Patchiness_Risk),
+ sprintf("**Decline:** %s", field_kpi$Decline_Severity)
+ )
+
+ cat(paste(kpi_parts, collapse = " | "), "\n\n") # Double newline for markdown paragraph break
+ }
}
}, error = function(e) {
@@ -1298,100 +1549,244 @@ tryCatch({
})
```
-`r t("kpi_per_field")`
+\newpage
+## Detailed Field Performance Summary by Field
+
+The following table provides a comprehensive overview of all monitored fields with their key performance metrics from the KPI analysis.
```{r detailed_field_table, echo=FALSE, results='asis'}
# Detailed field performance table
-report_date_obj <- as.Date(report_date)
-# Initialize empty dataframe for field_ages if CI_quadrant is unavailable
-field_ages <- data.frame(Field = character(), Age_days = numeric())
-
-# Try to get field ages from CI quadrant if available
-if (!is.null(CI_quadrant) && nrow(CI_quadrant) > 0) {
- tryCatch({
- # Identify the current season for each field based on report_date
- current_seasons <- CI_quadrant %>%
- filter(Date <= report_date_obj) %>%
- group_by(field, season) %>%
- summarise(
- season_start = min(Date),
- season_end = max(Date),
- .groups = 'drop'
- ) %>%
- group_by(field) %>%
- filter(season == max(season)) %>%
- select(field, season)
-
- # Get current field ages (most recent DOY for each field in their CURRENT SEASON only)
- field_ages <- CI_quadrant %>%
- inner_join(current_seasons, by = c("field", "season")) %>%
- group_by(field) %>%
- filter(DOY == max(DOY)) %>%
- select(field, DOY) %>%
- rename(Field = field, Age_days = DOY)
- }, error = function(e) {
- safe_log(paste("Error extracting field ages:", e$message), "WARNING")
- })
+if (!exists("field_details_table") || is.null(field_details_table) || nrow(field_details_table) == 0) {
+ safe_log("No field details available for table", "WARNING")
+ cat("No field-level KPI data available for this report period.\n")
+
} else {
- safe_log("CI quadrant data unavailable - field ages will not be included in detailed table", "WARNING")
-}
-
-# Clean up the field details table - remove sub field column and round numeric values
-# Check if field_details_table was loaded successfully
-if (!exists("field_details_table") || is.null(field_details_table)) {
- # Initialize empty tibble with expected columns
- field_details_clean <- tibble(
- Field = character(),
- `Field Size (ha)` = numeric(),
- `Growth Uniformity` = character(),
- `Yield Forecast (t/ha)` = numeric(),
- `Gap Score` = numeric(),
- `Decline Risk` = character(),
- `Weed Risk` = character(),
- `Mean CI` = numeric(),
- `CV Value` = numeric()
- )
-} else {
- field_details_clean <- field_details_table %>%
- left_join(field_ages, by = "Field") %>%
+ # Calculate field sizes from boundaries (convert to acres)
+ field_sizes_source <- if (exists("AllPivots_merged") && inherits(AllPivots_merged, "sf")) AllPivots_merged else AllPivots0
+ field_sizes_df <- field_sizes_source %>%
mutate(
- `Yield Forecast (t/ha)` = ifelse(is.na(Age_days) | Age_days < 240, NA_real_, `Yield Forecast (t/ha)`)
+ field_size_acres = as.numeric(sf::st_area(geometry) / 4046.86) # m² to acres
) %>%
- select(Field, `Field Size (ha)`, `Growth Uniformity`, `Yield Forecast (t/ha)`, `Gap Score`, `Decline Risk`, `Weed Risk`, `Mean CI`, `CV Value`) %>% # Reorder columns as requested
+ sf::st_drop_geometry() %>%
+ select(field, field_size_acres)
+
+ # Get field ages from CI quadrant if available
+ field_ages_df <- if (!is.null(CI_quadrant) && nrow(CI_quadrant) > 0) {
+ tryCatch({
+ # Get current season and age for each field
+ CI_quadrant %>%
+ filter(Date <= as.Date(report_date)) %>%
+ group_by(field, season) %>%
+ summarise(last_date = max(Date), last_dah = max(DAH), .groups = 'drop') %>%
+ group_by(field) %>%
+ filter(season == max(season)) %>%
+ select(field, Age_days = last_dah)
+ }, error = function(e) {
+ data.frame(field = character(), Age_days = numeric())
+ })
+ } else {
+ data.frame(field = character(), Age_days = numeric())
+ }
+
+ # Join field sizes and ages to KPI data, simplified column selection
+ # DEFENSIVE: Normalize field_details_table column structure before joining
+ # Uses shared normalization function to ensure Field_id exists and all expected columns are present
+ field_details_table <- normalize_field_details_columns(field_details_table)
+
+ field_details_clean <- field_details_table %>%
+ left_join(field_sizes_df, by = c("Field_id" = "field")) %>%
+ left_join(field_ages_df, by = c("Field_id" = "field")) %>%
mutate(
- `Mean CI` = round(`Mean CI`, 2), # Round to 2 decimal places
- `CV Value` = round(`CV Value`, 2), # Round to 2 decimal places
- `Gap Score` = round(`Gap Score`, 0) # Round to nearest integer
+ # Only show yield forecast for fields >= 240 days old
+ TCH_Forecasted = if_else(is.na(Age_days) | Age_days < 240, NA_real_, TCH_Forecasted),
+ # Round numeric columns
+ field_size_acres = round(field_size_acres, 1),
+ Mean_CI = round(Mean_CI, 2),
+ CV = round(CV, 2),
+ Gap_Score = round(Gap_Score, 2),
+ TCH_Forecasted = round(TCH_Forecasted, 1)
)
+
+ # Add Weekly_CI_Change if it exists in the data (note: capital C and I)
+ if ("Weekly_CI_Change" %in% names(field_details_clean)) {
+ field_details_clean <- field_details_clean %>%
+ mutate(Weekly_CI_Change = round(Weekly_CI_Change, 2)) %>%
+ select(
+ Field = Field_id,
+ `Field Size (acres)` = field_size_acres,
+ `Mean CI` = Mean_CI,
+ `Weekly CI Change` = Weekly_CI_Change,
+ `Yield Forecast (t/ha)` = TCH_Forecasted,
+ `Gap Score %` = Gap_Score,
+ `Decline Risk` = Decline_Severity,
+ `Patchiness Risk` = Patchiness_Risk,
+ `CV Value` = CV
+ )
+ } else {
+ field_details_clean <- field_details_clean %>%
+ select(
+ Field = Field_id,
+ `Field Size (acres)` = field_size_acres,
+ `Mean CI` = Mean_CI,
+ `Yield Forecast (t/ha)` = TCH_Forecasted,
+ `Gap Score %` = Gap_Score,
+ `Decline Risk` = Decline_Severity,
+ `Patchiness Risk` = Patchiness_Risk,
+ `CV Value` = CV
+ )
+ }
+
+ # Display the cleaned field table with flextable (fit to page width)
+ ft <- flextable(field_details_clean) %>%
+ set_caption("Detailed Field Performance Summary") %>%
+ theme_booktabs() %>%
+ set_table_properties(width = 1, layout = "autofit") # Fit to 100% page width with auto-adjust
+
+ knit_print(ft)
}
-
-# Set names according to localisation
-names(field_details_clean) <- c(t("field"), t("field_size"), t("grow_unif"), t("yield_forecast"), t("gap_score"), t("decline_risk"), t("weed_risk"), t("mean_ci"), t("cv_value"))
-
-# Display the cleaned field table with flextable
-# Set column widths to fit page (approximately 6.5 inches for 1-inch margins)
-# Scale widths proportionally: original total = 8.0 inches, scale to 6.2 inches
-col_widths <- c(0.97, 0.73, 0.80, 0.80, 0.65, 0.73, 0.65, 0.56, 0.48) # inches for each column
-
-ft <- flextable(field_details_clean) %>%
- set_caption(t("detailed_kpi_caption")) %>%
- width(width = col_widths)
-
-ft
```
\newpage
-`r t("section_iii")`
+This automated report provides weekly analysis of sugarcane crop health using satellite-derived Chlorophyll Index (CI) measurements. The analysis supports:
+• Scouting of growth related issues that are in need of attention
+• Timely actions can be taken such that negative impact is reduced
+• Monitoring of the crop growth rates of the farm, providing evidence of performance
+• Planning of harvest moment and mill logistics is supported such that optimal tonnage and sucrose levels can be harvested.
+
+The base of the report is the Chlorophyll Index. The chlorophyll index identifies:
+• Field-level crop health variations => target problem area's
+• Weekly changes in crop vigor => scout for diseases and stress
+• Areas requiring attention by the agricultural and irrigation teams
+• Growth patterns across different field sections
+
+Key Features: - High-resolution satellite imagery analysis - Week-over-week change detection - Individual field performance metrics - Actionable insights for crop management
+
+### Explanation of the Report
+
+This report provides a detailed analysis (3x3m of resolution) of your sugarcane fields based on satellite imagery. It supports you monitor crop health and development throughout the growing season. The data is processed weekly to give you timely insights for optimal farm management decisions.
+
+### What is the Chlorophyll Index (CI)?
+
+The Chlorophyll Index (CI) is a vegetation index that measures the relative amount of chlorophyll in plant leaves. Chlorophyll is the green pigment responsible for photosynthesis in plants. Higher CI values indicate:
+• Greater photosynthetic activity
+• Healthier plant tissue
+• Better nitrogen uptake
+• More vigorous crop growth
+
+CI values typically range from 0 (bare soil or severely stressed vegetation) to 7+ (very healthy, dense vegetation). For sugarcane, values between 3-7 generally indicate good crop health, depending on the growth stage.
+
+
+
-`r t("find_report")`
+### What You'll Find in This Report:
+
+1. **Key Performance Indicators (KPIs):**
+ The report provides a farm-wide analysis based on weekly Chlorophyll Index (CI) measurements. Five comprehensive KPIs are calculated field by field to assess crop health:
+
+ - **KPI 1: Field Uniformity** — Measures how consistently crop is developing across the field
+ - **Metric:** Coefficient of Variation (CV) of CI pixel values
+ - **Calculation:** CV = (Standard Deviation of CI) / (Mean CI)
+ - **Categories:**
+ - **Excellent:** CV < 0.08 (very uniform growth, minimal intervention needed)
+ - **Good:** CV < 0.15 (acceptable uniformity, routine monitoring)
+ - **Acceptable:** CV < 0.25 (moderate variation, monitor irrigation/fertility)
+ - **Poor:** CV < 0.4 (high variation, investigate management issues)
+ - **Very poor:** CV ≥ 0.4 (severe variation, immediate field scout required)
+ - **Why it matters:** Uniform fields are easier to manage and typically produce better yields. Uneven growth suggests irrigation problems, fertility gaps, pests, or disease.
+
+ - **KPI 2: Area Change (Weekly Growth)** — Tracks week-over-week CI changes to detect rapid improvements or declines
+ - **Calculation:** Current Mean CI − Previous Mean CI (absolute change in CI units)
+ - **Categories:**
+ - **Rapid growth:** > +0.5 (excellent weekly progress)
+ - **Positive growth:** +0.2 to +0.5 (steady improvement)
+ - **Stable:** −0.2 to +0.2 (field maintained, no significant change)
+ - **Declining:** −0.5 to −0.2 (slow decline, warrant closer monitoring)
+ - **Rapid decline:** < −0.5 (alert: urgent issue requiring investigation)
+ - **Why it matters:** Week-to-week changes reveal developing problems early, enabling timely intervention.
+
+ - **KPI 3: TCH Forecasted (Yield Prediction)** — Predicts final harvest tonnage for mature fields
+ - **Applies to:** Fields ≥ 240 days old (mature stage)
+ - **Method:** Random Forest machine learning model trained on historical harvest data and CI trajectories
+ - **Inputs:** Days after harvest (DAH) and CI growth rate (CI_per_day)
+ - **Output:** Predicted tons of cane per hectare (t/ha)
+ - **Why it matters:** Helps plan harvest timing, mill throughput, and revenue forecasting for mature crops.
+
+ - **KPI 4: Growth Decline (4-Week Trend)** — Assesses short-term growth trajectory using linear regression
+ - **Calculation:** Linear slope of CI values over the previous 4 weeks
+ - **Categories:**
+ - **Strong growth:** Slope > 0.1 CI units/week (excellent sustained progress)
+ - **Weak growth:** Slope 0–0.1 (slow improvement, monitor closely)
+ - **Slight decline:** Slope −0.1–0 (low severity, non-urgent observation)
+ - **Moderate decline:** Slope −0.3 to −0.1 (medium severity, scouting recommended)
+ - **Strong decline:** Slope < −0.3 (high severity, immediate field investigation required)
+ - **Why it matters:** Trend analysis reveals whether crop is accelerating, stalling, or stressed over time.
+
+ - **KPI 5: Field Patchiness (Heterogeneity)** — Combines two complementary spatial metrics for comprehensive heterogeneity assessment
+ - **Metric 1: Gini Coefficient** — Statistical measure of distribution inequality in CI pixel values
+ - **Formula:** (2 × Σ(i × sorted_CI)) / (n × Σ(sorted_CI)) − (n+1)/n
+ - **Range:** 0 (perfectly uniform) to 1 (highly unequal)
+ - **Interpretation:** Low Gini (< 0.15) = good uniformity; High Gini (> 0.3) = significant heterogeneity
+ - **Metric 2: Moran's I** — Spatial autocorrelation indicating whether high/low areas are clustered or scattered
+ - **Range:** −1 (dispersed pattern) to +1 (strong clustering)
+ - **Thresholds:** Moran's I > 0.85 indicates clustered problem areas; < 0.75 suggests scattered issues
+ - **Risk Determination (Gini + Moran's I Combined):**
+ - **Minimal Risk:** Gini < 0.15 (excellent uniformity regardless of spatial pattern)
+ - **Low Risk:** Gini 0.15–0.30, Moran's I < 0.85 (moderate variation, scattered distribution)
+ - **Medium Risk:** Gini 0.15–0.30, Moran's I > 0.85 OR Gini 0.30–0.50, Moran's I < 0.85 (notable issues)
+ - **High Risk:** Gini > 0.30, Moran's I > 0.85 (severe heterogeneity with localized clusters—urgent scouting needed)
+ - **Why it matters:** High patchiness may indicate irrigation inefficiencies, localized pest pressure, fertility variation, or disease spread. Combined Gini + Moran's I reveals not just *how much* variation exists, but also *how it's distributed* spatially. CI reflects chlorophyll = nitrogen status + plant health + vigor. High CV/Patchiness often signals N gaps, water stress, pests (borers), or ratoon decline.
+
+ - **Uniformity vs. Patchiness — What's the Difference?**
+ Both KPIs measure variation, but they answer different questions and drive different management actions:
+ - **Uniformity (CV-based)** answers: "*Is* growth even across the field?" — it detects whether a problem exists but not where.
+ - **Patchiness (Gini + Moran's I)** answers: "*Where* are problems and how are they arranged?" — it reveals the spatial pattern.
+
+ **Practical example:** Two fields both score "Poor" on Uniformity (CV = 0.25). However:
+ - Field A has scattered low-CI patches (Moran's I = 0.6) → suggests *random* stress (disease pressure, uneven irrigation)
+ - Field B has clustered low-CI in one corner (Moran's I = 0.95) → suggests *localized* problem (drainage, compaction, pest hotspot)
+
+ Your scouting and remediation strategy should differ: Field A might need systemic irrigation adjustment or disease management; Field B might need soil remediation in the affected corner. **Patchiness tells you *where to focus your effort*.**
+
+ - **KPI 6: Gap Score (Establishment Quality)** — Quantifies field gaps and areas of poor crop establishment
+ - **Calculation Method:** Statistical outlier detection (2σ method)
+ - Identifies pixels with CI below: **Median CI − (2 × Standard Deviation)**
+ - Calculates: **Gap Score = (Outlier Pixels / Total Pixels) × 100**
+ - Example: If 2 of 100 pixels fall below threshold → Gap Score = 2%
+ - **Score Ranges & Interpretation:**
+ - **0–10%:** Minimal gaps (excellent establishment, healthy field)
+ - **10–25%:** Moderate gaps (monitor for expansion, coordinate with agronomy)
+ - **≥ 25%:** Significant gaps (consider targeted replanting or rehabilitation)
+ - **Why it matters:** Gap scores reveal areas of poor establishment that may indicate early growth problems or harvest-related residue issues. Lower is better (0–3% is typical for healthy fields).
+
+2. **Overview Map: Growth on Farm:**
+ Provides a traffic light overview of field-by-field growth status for quick prioritization and reporting.
+
+3. **Chlorophyll Index Overview Map:**
+ Shows current CI values for all fields, helping to identify high- and low-performing areas.
+
+4. **Field-by-Field Analysis:**
+ Includes detailed maps, trend graphs, and performance metrics for each field.
+
+5. **Yield Prediction:**
+ For mature crops (over 240 days), yield is predicted using current and historical CI data.
+
+6. **Farm Overview Table:**
+ Presents numerical field-level results for all KPIs.
---
-`r t("historical_benchmark")`
+### Historical Benchmark Lines
+
+The CI time series graphs include historical benchmark lines for the 10th, 50th, and 90th percentiles of CI values across all fields and seasons.
+**Note:** These lines are now all rendered as solid lines (not dashed or dotted), with different colors for each percentile.
+- **10th Percentile:** Lower end of historical performance
+- **50th Percentile:** Median historical performance
+- **90th Percentile:** Upper end of historical performance
+Comparing the current season to these lines helps assess whether crop growth is below, at, or above historical norms.
\newpage
`r t("metadata")`
@@ -1418,4 +1813,4 @@ ft <- flextable(metadata_info) %>%
ft
```
-`r t("disclaimer")`
+`r t("disclaimer")`
\ No newline at end of file
diff --git a/r_app/91_CI_report_with_kpis_cane_supply.Rmd b/r_app/91_CI_report_with_kpis_cane_supply.Rmd
index 085476d..f9edca8 100644
--- a/r_app/91_CI_report_with_kpis_cane_supply.Rmd
+++ b/r_app/91_CI_report_with_kpis_cane_supply.Rmd
@@ -2,7 +2,7 @@
params:
ref: "word-styles-reference-var1.docx"
output_file: CI_report.docx
- report_date: "2025-09-30"
+ report_date: "2026-02-04"
data_dir: "angata"
mail_day: "Wednesday"
borders: FALSE
@@ -61,6 +61,10 @@ suppressPackageStartupMessages({
library(flextable) # For formatted tables in Word output (professional table styling)
})
+# Configure tmap for static plotting (required for legend.outside to work)
+tmap_mode("plot") # CRITICAL: Must be "plot" mode for legends outside to render properly
+tmap_options(component.autoscale = FALSE)
+
# Load custom utility functions
tryCatch({
source("r_app/report_utils.R")
@@ -140,12 +144,12 @@ week_suffix <- paste0("week", sprintf("%02d", current_week), "_", current_year)
# Candidate filenames we expect (exact and common variants)
expected_summary_names <- c(
- paste0(project_dir, "_kpi_summary_tables_", week_suffix, ".rds"),
- paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
- paste0(project_dir, "_kpi_summary_tables.rds"),
- "kpi_summary_tables.rds",
- paste0("kpi_summary_tables_", week_suffix, ".rds"),
- paste0("kpi_summary_tables_", date_suffix, ".rds")
+ paste0(project_dir, "_field_analysis_", week_suffix, ".rds"),
+ paste0(project_dir, "_field_analysis_", date_suffix, ".rds"),
+ paste0(project_dir, "_field_analysis.rds"),
+ "field_analysis.rds",
+ paste0("field_analysis_", week_suffix, ".rds"),
+ paste0("field_analysis_", date_suffix, ".rds")
)
expected_field_details_names <- c(
@@ -165,13 +169,26 @@ try_load_from_dir <- function(dir, candidates) {
return(NULL)
}
-# Try primary directory first
+# Try primary directory first (field_level/)
summary_file <- try_load_from_dir(kpi_data_dir, expected_summary_names)
field_details_file <- try_load_from_dir(kpi_data_dir, expected_field_details_names)
-# If not found, perform a workspace-wide search (slower) limited to laravel_app storage
+# If not found, try parent directory (kpis/) where RDS is often saved by Script 80
if (is.null(summary_file) || is.null(field_details_file)) {
- safe_log(paste("KPI files not found in", kpi_data_dir, "—searching workspace for RDS files"))
+ parent_dir <- dirname(kpi_data_dir) # One level up: reports/kpis/
+ safe_log(paste("KPI files not found in", kpi_data_dir, "—trying parent directory:", parent_dir))
+
+ if (is.null(summary_file)) {
+ summary_file <- try_load_from_dir(parent_dir, expected_summary_names)
+ }
+ if (is.null(field_details_file)) {
+ field_details_file <- try_load_from_dir(parent_dir, expected_field_details_names)
+ }
+}
+
+# If still not found, perform a workspace-wide search (slower) limited to laravel_app storage
+if (is.null(summary_file) || is.null(field_details_file)) {
+ safe_log(paste("KPI files not found in", kpi_data_dir, "or parent directory—searching workspace for RDS files"))
# List rds files under laravel_app/storage/app recursively
files <- list.files(path = file.path("laravel_app", "storage", "app"), pattern = "\\.rds$", recursive = TRUE, full.names = TRUE)
# Try to match by expected names
@@ -483,7 +500,7 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
## 1.1 Overview of cane supply area, showing zones with number of acres being harvest ready
-```{r overview_map, fig.width=9, fig.height=7, fig.align="center", echo=FALSE, message=FALSE, warning=FALSE}
+```{r overview_map, fig.width=7, fig.height=6, fig.align="center", echo=FALSE, message=FALSE, warning=FALSE}
# Create a hexbin overview map with ggplot
tryCatch({
# Use per-field field_analysis data from RDS (already loaded in load_kpi_data chunk)
@@ -510,6 +527,8 @@ tryCatch({
TARGET_CRS <- 4326 # WGS84 for web basemap compatibility (was 32736 UTM)
# Process polygons into points
+ # IMPORTANT: Calculate centroids in projected CRS (UTM 36S for southern Africa) to avoid
+ # st_centroid warnings about longitude/latitude data, then transform back to WGS84
points_processed <- field_boundaries_sf %>%
st_make_valid() %>%
mutate(
@@ -525,8 +544,9 @@ tryCatch({
analysis_data %>% select(Field_id, Status_trigger),
by = c("field" = "Field_id")
) %>%
- st_transform(crs = TARGET_CRS) %>%
+ st_transform(crs = 32736) %>% # UTM zone 36S (southern Africa)
st_centroid() %>%
+ st_transform(crs = TARGET_CRS) %>%
bind_cols(st_coordinates(.))
# Validate coordinates - check for NaN, Inf, or missing values
@@ -553,30 +573,8 @@ tryCatch({
labels_vec[length(labels_vec)] <- ">30"
labels_vec[1] <- "0.1"
- # Create dummy point to anchor hexbin grids for consistency
- dummy_point <- data.frame(
- field = NA,
- sub_field = NA,
- area_ac = 0,
- Status_trigger = NA,
- X = min(points_processed$X, na.rm = TRUE),
- Y = min(points_processed$Y, na.rm = TRUE),
- geometry = NA
- )
-
- # Convert dummy point to sf and add xy coordinates
- dummy_point <- st_as_sf(dummy_point, coords = c("X", "Y"), crs = st_crs(points_ready))
- dummy_point <- cbind(dummy_point, st_coordinates(dummy_point))
-
- # Mark dummy point with anchor flag before binding
- # Referenced: dummy_point, st_as_sf, st_coordinates, area_ac
- dummy_point$anchor_dummy <- TRUE
-
- # Add dummy point to ensure consistent hexbin grid anchoring
- points_ready <- rbind(points_ready, dummy_point)
- points_not_ready <- rbind(points_not_ready, dummy_point)
-
# Calculate data bounds for coordinate limits (prevents basemap scale conflicts)
+ # Use actual data bounds without dummy points to avoid column mismatch
x_limits <- c(
floor(min(points_processed$X, na.rm = TRUE) * 20) / 20, # Round down to avoid edge clipping
ceiling(max(points_processed$X, na.rm = TRUE) * 20) / 20 # Round up for padding
@@ -653,22 +651,17 @@ tryCatch({
)
)
- # Remove dummy point rows after grid anchoring to prevent dummy cells in plot
- # Referenced: points_ready, points_not_ready, anchor_dummy flag filtering
- points_ready <- points_ready %>% filter(!anchor_dummy, na.rm = TRUE)
- points_not_ready <- points_not_ready %>% filter(!anchor_dummy, na.rm = TRUE)
-
}, error = function(e) {
warning("Error creating hexbin map:", e$message)
})
```
-\newpage
+
## 1.2 Key Performance Indicators
```{r combined_kpi_table, echo=FALSE, results='asis'}
-# Create summary KPI table from field_analysis_summary data
-# This shows: Phases, Triggers, Area Change, and Total Farm acreage
+# Create consolidated KPI table from field_analysis data
+# Shows: Phases, Triggers, Area Change, Cloud Influence, and Total Farm
if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
# Load field analysis data
@@ -679,24 +672,46 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
!is.data.frame(summary_data$field_analysis_summary)) {
# Create summary by aggregating by Status_Alert and Phase categories
- # This groups fields by their phase and status to show distribution
phase_summary <- field_analysis_df %>%
filter(!is.na(Phase)) %>%
group_by(Phase) %>%
- summarise(Acreage = sum(Acreage, na.rm = TRUE), .groups = "drop") %>%
+ summarise(
+ Acreage = sum(Acreage, na.rm = TRUE),
+ Field_count = n_distinct(Field_id),
+ .groups = "drop"
+ ) %>%
mutate(Category = Phase) %>%
- select(Category, Acreage)
+ select(Category, Acreage, Field_count)
- # Try to create Status trigger summary - use Status_Alert if available, otherwise use empty
+ # Create Status trigger summary - includes both active alerts and "No active triggers"
trigger_summary <- tryCatch({
- field_analysis_df %>%
+ # Active alerts (fields with non-NA Status_Alert)
+ active_alerts <- field_analysis_df %>%
filter(!is.na(Status_Alert), Status_Alert != "") %>%
group_by(Status_Alert) %>%
- summarise(Acreage = sum(Acreage, na.rm = TRUE), .groups = "drop") %>%
+ summarise(
+ Acreage = sum(Acreage, na.rm = TRUE),
+ Field_count = n_distinct(Field_id),
+ .groups = "drop"
+ ) %>%
mutate(Category = Status_Alert) %>%
- select(Category, Acreage)
+ select(Category, Acreage, Field_count)
+
+ # No active triggers (fields with NA Status_Alert)
+ no_alerts <- field_analysis_df %>%
+ filter(is.na(Status_Alert) | Status_Alert == "") %>%
+ summarise(
+ Acreage = sum(Acreage, na.rm = TRUE),
+ Field_count = n_distinct(Field_id),
+ .groups = "drop"
+ ) %>%
+ mutate(Category = "No active triggers") %>%
+ select(Category, Acreage, Field_count)
+
+ # Combine active alerts and no-alert fields
+ bind_rows(active_alerts, no_alerts)
}, error = function(e) {
- data.frame(Category = character(), Acreage = numeric())
+ data.frame(Category = character(), Acreage = numeric(), Field_count = numeric())
})
# Combine into summary
@@ -709,25 +724,38 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
# Phase names and trigger names to extract from summary
phase_names <- c("Germination", "Tillering", "Grand Growth", "Maturation", "Unknown Phase")
- trigger_names <- c("Harvest Ready", "Strong Recovery", "Growth On Track", "Stress Detected",
- "Germination Complete", "Germination Started", "No Active Trigger",
- "Ready for harvest-check", "Strong decline in crop health", "Harvested/bare")
+ # Trigger names now include both active alerts AND "No active triggers" (calculated dynamically above)
+ trigger_names <- c("harvest_ready", "harvested_bare", "stress_detected",
+ "germination_delayed", "growth_on_track", "No active triggers")
# Extract phase distribution - match on category names directly
if (!is.null(field_analysis_summary) && nrow(field_analysis_summary) > 0) {
+ # Phase rows with field count
phase_rows <- field_analysis_summary %>%
filter(Category %in% phase_names) %>%
- select(Category, Acreage) %>%
+ select(Category, Acreage, Field_count) %>%
mutate(KPI_Group = "PHASE DISTRIBUTION", .before = 1)
- # Extract status triggers - match on category names directly
+ # Trigger rows with field count
trigger_rows <- field_analysis_summary %>%
filter(Category %in% trigger_names) %>%
- select(Category, Acreage) %>%
- mutate(KPI_Group = "STATUS TRIGGERS", .before = 1)
+ select(Category, Acreage, Field_count) %>%
+ mutate(KPI_Group = "OPERATIONAL ALERTS", .before = 1)
+
+ # If no triggers found, add a placeholder row
+ if (nrow(trigger_rows) == 0) {
+ trigger_rows <- data.frame(
+ KPI_Group = "OPERATIONAL ALERTS",
+ Category = "No active triggers",
+ Acreage = 0,
+ Field_count = 0,
+ stringsAsFactors = FALSE
+ )
+ }
# Calculate area change from field_analysis data
total_acreage <- sum(field_analysis_df$Acreage, na.rm = TRUE)
+ total_fields <- n_distinct(field_analysis_df$Field_id)
# Parse Weekly_ci_change to determine improvement/decline
parse_ci_change <- function(change_str) {
@@ -741,10 +769,20 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
field_analysis_df$ci_change_numeric <- sapply(field_analysis_df$Weekly_ci_change, parse_ci_change)
- improving_acreage <- sum(field_analysis_df$Acreage[field_analysis_df$ci_change_numeric > 0.2], na.rm = TRUE)
- declining_acreage <- sum(field_analysis_df$Acreage[field_analysis_df$ci_change_numeric < -0.2], na.rm = TRUE)
- stable_acreage <- sum(field_analysis_df$Acreage[field_analysis_df$ci_change_numeric >= -0.2 &
- field_analysis_df$ci_change_numeric <= 0.2], na.rm = TRUE)
+ # Area change rows with field count
+ improving_df <- field_analysis_df %>%
+ filter(ci_change_numeric > 0.2)
+ stable_df <- field_analysis_df %>%
+ filter(ci_change_numeric >= -0.2 & ci_change_numeric <= 0.2)
+ declining_df <- field_analysis_df %>%
+ filter(ci_change_numeric < -0.2)
+
+ improving_acreage <- sum(improving_df$Acreage, na.rm = TRUE)
+ improving_field_count <- n_distinct(improving_df$Field_id)
+ stable_acreage <- sum(stable_df$Acreage, na.rm = TRUE)
+ stable_field_count <- n_distinct(stable_df$Field_id)
+ declining_acreage <- sum(declining_df$Acreage, na.rm = TRUE)
+ declining_field_count <- n_distinct(declining_df$Field_id)
improving_pct <- ifelse(total_acreage > 0, round(improving_acreage / total_acreage * 100, 1), 0)
declining_pct <- ifelse(total_acreage > 0, round(declining_acreage / total_acreage * 100, 1), 0)
@@ -761,24 +799,54 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
KPI_Group = "AREA CHANGE",
Category = c("Improving", "Stable", "Declining"),
Acreage = c(round(improving_acreage, 2), round(stable_acreage, 2), round(declining_acreage, 2)),
+ Field_count = c(improving_field_count, stable_field_count, declining_field_count),
Percent = c(paste0(improving_pct, "%"), paste0(stable_pct, "%"), paste0(declining_pct, "%")),
stringsAsFactors = FALSE
)
+ # Cloud influence rows with field count - aggregate by Cloud_category
+ cloud_rows <- tryCatch({
+ field_analysis_df %>%
+ filter(!is.na(Cloud_category)) %>%
+ group_by(Cloud_category) %>%
+ summarise(
+ Acreage = sum(Acreage, na.rm = TRUE),
+ Field_count = n_distinct(Field_id),
+ .groups = "drop"
+ ) %>%
+ mutate(
+ KPI_Group = "CLOUD INFLUENCE",
+ Category = Cloud_category,
+ Percent = paste0(round(Acreage / total_acreage * 100, 1), "%"),
+ Acreage = round(Acreage, 2)
+ ) %>%
+ select(KPI_Group, Category, Acreage, Field_count, Percent)
+ }, error = function(e) {
+ data.frame(
+ KPI_Group = character(),
+ Category = character(),
+ Acreage = numeric(),
+ Field_count = numeric(),
+ Percent = character()
+ )
+ })
+
# Total farm row
total_row <- data.frame(
KPI_Group = "TOTAL FARM",
Category = "Total Acreage",
Acreage = round(total_acreage, 2),
+ Field_count = total_fields,
Percent = "100%",
stringsAsFactors = FALSE
)
- # Combine all rows with percentages for all
+ # Combine all rows
combined_df <- bind_rows(
phase_pcts,
trigger_pcts,
area_change_rows,
+ cloud_rows,
total_row
)
@@ -789,7 +857,7 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
KPI_display = if_else(row_number() == 1, KPI_Group, "")
) %>%
ungroup() %>%
- select(KPI_display, Category, Acreage, Percent)
+ select(KPI_display, Category, Acreage, Percent, Field_count)
# Render as flextable with merged cells
ft <- flextable(combined_df) %>%
@@ -797,7 +865,8 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
KPI_display = "KPI Category",
Category = "Item",
Acreage = "Acreage",
- Percent = "Percent"
+ Percent = "Percentage of total fields",
+ Field_count = "# Fields"
) %>%
merge_v(j = "KPI_display") %>%
autofit()
@@ -807,8 +876,9 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
phase_count <- nrow(phase_rows)
trigger_count <- nrow(trigger_rows)
area_count <- nrow(area_change_rows)
+ cloud_count <- nrow(cloud_rows)
- # Add lines after phases, triggers, and area change groups (before totals)
+ # Add lines after phases, triggers, area change, and cloud groups (before totals)
if (phase_count > 0) {
ft <- ft %>% hline(i = phase_count, border = officer::fp_border(width = 1))
}
@@ -818,6 +888,9 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
if (area_count > 0) {
ft <- ft %>% hline(i = phase_count + trigger_count + area_count, border = officer::fp_border(width = 1))
}
+ if (cloud_count > 0) {
+ ft <- ft %>% hline(i = phase_count + trigger_count + area_count + cloud_count, border = officer::fp_border(width = 1))
+ }
ft
} else {
@@ -828,40 +901,6 @@ if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% na
}
```
-## Cloud Coverage Summary
-
-```{r cloud_coverage_summary, echo=FALSE}
-# Display cloud coverage summary aggregated by category
-# Cloud coverage data is included in the field_analysis RDS from Script 80
-if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
- field_analysis_df <- summary_data$field_analysis
-
- # Aggregate cloud coverage by category
- cloud_summary <- field_analysis_df %>%
- filter(!is.na(Cloud_category)) %>%
- group_by(Cloud_category) %>%
- summarise(
- "Number of Fields" = n(),
- "Total Acreage" = round(sum(Acreage, na.rm = TRUE), 1),
- .groups = "drop"
- ) %>%
- rename("Cloud Category" = Cloud_category) %>%
- arrange(`Cloud Category`)
- if (nrow(cloud_summary) > 0) {
- # Create flextable
- ft <- flextable(cloud_summary) %>%
- autofit() %>%
- theme_vanilla()
-
- ft
- } else {
- cat("Cloud coverage data not available for summary.\n")
- }
-} else {
- cat("Field analysis data not available for cloud coverage summary.\n")
-}
-```
-
```{r data, message=TRUE, warning=TRUE, include=FALSE}
# All data comes from the field analysis performed in 09_field_analysis_weekly.R
# The report renders KPI tables and field summaries from that data
@@ -951,9 +990,9 @@ CI values typically range from 0 (bare soil or severely stressed vegetation) to
-```{r ci_fig, echo=FALSE, fig.align='right', out.width='40%', fig.cap="Chlorophyll Index Example"}
-knitr::include_graphics("CI_graph_example.png")
-```
+
+
+
### Data File Structure and Columns
@@ -1025,15 +1064,42 @@ Both algorithms are not always in sync, and can have contradictory results. Wide
## Report Metadata
```{r report_metadata, echo=FALSE}
+# Calculate total area from field analysis data
+total_area_acres <- 0
+if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
+ total_area_acres <- sum(summary_data$field_analysis$Acreage, na.rm = TRUE)
+}
+
+# Calculate total fields
+total_fields_count <- 0
+if (exists("AllPivots0")) {
+ total_fields_count <- nrow(AllPivots0 %>% filter(!is.na(field)) %>% group_by(field) %>% summarise())
+} else if (exists("summary_data") && !is.null(summary_data) && "field_analysis" %in% names(summary_data)) {
+ total_fields_count <- n_distinct(summary_data$field_analysis$Field_id)
+}
+
metadata_info <- data.frame(
- Metric = c("Report Generated", "Data Source", "Analysis Period", "Total Fields", "Next Update"),
+ Metric = c(
+ "Report Generated",
+ "Data Source",
+ "Analysis Period",
+ "Total Fields [number]",
+ "Total Area [acres]",
+ "Next Update",
+ "Service provided",
+ "Starting date service"
+ ),
Value = c(
format(Sys.time(), "%Y-%m-%d %H:%M:%S"),
paste("Project", toupper(project_dir)),
paste("Week", current_week, "of", year),
- ifelse(exists("AllPivots0"), nrow(AllPivots0 %>% filter(!is.na(field)) %>% group_by(field) %>% summarise()), "Unknown"),
- "Next Wednesday"
- )
+ ifelse(total_fields_count > 0, total_fields_count, "Unknown"),
+ ifelse(total_area_acres > 0, round(total_area_acres, 0), "Unknown"),
+ "Next Wednesday",
+ "Cane Supply Office - Weekly",
+ "23 dec 2025"
+ ),
+ stringsAsFactors = FALSE
)
ft <- flextable(metadata_info) %>%
@@ -1043,4 +1109,4 @@ ft <- flextable(metadata_info) %>%
ft
```
-*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team.*
\ No newline at end of file
+*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team at info@smartcane.ag.*
\ No newline at end of file
diff --git a/r_app/MANUAL_PIPELINE_RUNNER.R b/r_app/MANUAL_PIPELINE_RUNNER.R
index b2c20db..0a6f7d6 100644
--- a/r_app/MANUAL_PIPELINE_RUNNER.R
+++ b/r_app/MANUAL_PIPELINE_RUNNER.R
@@ -239,7 +239,7 @@
#
# OUTPUT:
# - laravel_app/storage/app/{PROJECT}/ci_data_for_python.csv
-# - Columns: field, sub_field, Date, FitData, DOY, value
+# - Columns: field, sub_field, Date, FitData, DAH, value
#
# PARAMETERS:
# PROJECT: angata, chemba, xinavane, esa, simba
@@ -438,8 +438,8 @@
# rmarkdown::render(
rmarkdown::render(
"r_app/90_CI_report_with_kpis_agronomic_support.Rmd",
- params = list(data_dir = "aura", report_date = as.Date("2022-12-08")),
- output_file = "SmartCane_Report_agronomic_support_aura_2022-12-08.docx",
+ params = list(data_dir = "aura", report_date = as.Date("2026-02-04")),
+ output_file = "SmartCane_Report_agronomic_support_aura_2026-02-04.docx",
output_dir = "laravel_app/storage/app/aura/reports"
)
#
@@ -450,7 +450,7 @@ rmarkdown::render(
rmarkdown::render(
"r_app/91_CI_report_with_kpis_cane_supply.Rmd",
params = list(data_dir = "angata", report_date = as.Date("2026-02-04")),
- output_file = "SmartCane_Report_basemap_test.docx",
+ output_file = "SmartCane_Report_cane_supply_angata_2026-02-04.docx",
output_dir = "laravel_app/storage/app/angata/reports"
)
#
diff --git a/r_app/parameters_project.R b/r_app/parameters_project.R
index 6c3565f..2272772 100644
--- a/r_app/parameters_project.R
+++ b/r_app/parameters_project.R
@@ -33,8 +33,14 @@ suppressPackageStartupMessages({
})
# ==============================================================================
-# SECTION 2: CLIENT TYPE MAPPING & CONFIGURATION
+# SECTION 2: GLOBAL AGRONOMIC THRESHOLDS & CLIENT TYPE MAPPING
# ==============================================================================
+
+# Maturity threshold for yield prediction: crop age in Days After Harvest (DAH)
+# Only fields >= DAH_MATURITY_THRESHOLD days old receive yield forecasts
+# ~240 days ≈ 8 months, typical sugarcane maturity window
+DAH_MATURITY_THRESHOLD <- 240
+
# Maps project names to client types for pipeline control
# This determines which scripts run and what outputs they produce
@@ -45,7 +51,8 @@ CLIENT_TYPE_MAP <- list(
"esa" = "agronomic_support",
"simba" = "agronomic_support",
"john" = "agronomic_support",
- "huss" = "agronomic_support"
+ "huss" = "agronomic_support",
+ "aura" = "agronomic_support"
)
#' Get client type for a project
@@ -162,13 +169,11 @@ setup_project_directories <- function(project_dir, data_source = "merged_tif") {
# TIER 5: MOSAICS (Script 40 output)
weekly_mosaic_dir <- here(laravel_storage_dir, "weekly_mosaic")
- field_tiles_ci_dir <- here(weekly_mosaic_dir, "field_tiles_CI")
+ weekly_tile_max_dir <- here(laravel_storage_dir, "weekly_tile_max")
# TIER 6: KPI & REPORTING (Scripts 80/90/91 output)
reports_dir <- here(laravel_storage_dir, "reports")
- kpi_reports_dir <- here(reports_dir, "kpis", "field_level")
- kpi_field_stats_dir <- here(reports_dir, "kpis", "field_stats")
- kpi_field_analysis_dir <- here(reports_dir, "kpis", "field_analysis")
+ kpi_reports_dir <- here(reports_dir, "kpis")
# TIER 7: SUPPORT (various scripts)
vrt_dir <- here(data_dir, "vrt") # Virtual Raster files created during CI extraction
@@ -180,8 +185,8 @@ setup_project_directories <- function(project_dir, data_source = "merged_tif") {
merged_tif_folder, field_tiles_dir, field_tiles_ci_dir,
extracted_ci_base_dir, daily_ci_vals_dir, cumulative_ci_vals_dir, ci_for_python_dir,
growth_model_interpolated_dir,
- weekly_mosaic_dir, field_tiles_ci_dir,
- reports_dir, kpi_reports_dir, kpi_field_stats_dir, kpi_field_analysis_dir,
+ weekly_mosaic_dir, weekly_tile_max_dir,
+ reports_dir, kpi_reports_dir,
data_dir, vrt_dir, harvest_dir, log_dir
)
@@ -215,13 +220,11 @@ setup_project_directories <- function(project_dir, data_source = "merged_tif") {
# TIER 5: Mosaics
weekly_mosaic_dir = weekly_mosaic_dir,
- field_tiles_ci_dir = field_tiles_ci_dir,
+ weekly_tile_max_dir = weekly_tile_max_dir,
# TIER 6: KPI & reporting
reports_dir = reports_dir,
kpi_reports_dir = kpi_reports_dir,
- kpi_field_stats_dir = kpi_field_stats_dir,
- kpi_field_analysis_dir = kpi_field_analysis_dir,
# TIER 7: Support
data_dir = data_dir,
@@ -511,7 +514,63 @@ setup_logging <- function(log_dir) {
# ==============================================================================
# Centralized helper functions for run_full_pipeline.R to avoid hardcoding paths
+#' Detect mosaic mode from project structure
+#'
+#' Determines if project uses "tiled" (legacy) or "single-file" (per-field) mosaics
+#'
+#' @param project_dir Character. Project name
+#' @return Character. "tiled" or "single-file"
+detect_mosaic_mode <- function(project_dir) {
+ # Per-field architecture is standard - always return "single-file"
+ # unless weekly_tile_max directory exists with content
+ mosaic_tiled_dir <- file.path("laravel_app", "storage", "app", project_dir, "weekly_tile_max")
+
+ if (dir.exists(mosaic_tiled_dir) && length(list.files(mosaic_tiled_dir)) > 0) {
+ return("tiled")
+ }
+ return("single-file")
+}
+#' Detect grid size from tile directory structure
+#'
+#' For per-field architecture, returns "unknown" (grid-based tiling is legacy)
+#'
+#' @param project_dir Character. Project name
+#' @return Character. Grid size ("unknown" for per-field)
+detect_grid_size <- function(project_dir) {
+ # Per-field architecture doesn't use grid-based organization
+ return("unknown")
+}
+
+#' Get project storage path
+#'
+#' @param project_dir Character. Project name
+#' @param subdir Character. Optional subdirectory (default NULL)
+#' @return Character. Full path
+get_project_storage_path <- function(project_dir, subdir = NULL) {
+ path <- file.path("laravel_app", "storage", "app", project_dir)
+ if (!is.null(subdir)) {
+ path <- file.path(path, subdir)
+ }
+ return(path)
+}
+
+#' Get mosaic directory
+#'
+#' @param project_dir Character. Project name
+#' @param mosaic_mode Character. "tiled" or "single-file"
+#' @return Character. Full path to mosaic directory
+get_mosaic_dir <- function(project_dir, mosaic_mode = "auto") {
+ if (mosaic_mode == "auto") {
+ mosaic_mode <- detect_mosaic_mode(project_dir)
+ }
+
+ if (mosaic_mode == "tiled") {
+ get_project_storage_path(project_dir, "weekly_tile_max")
+ } else {
+ get_project_storage_path(project_dir, "weekly_mosaic")
+ }
+}
#' Get KPI directory based on client type
#'
@@ -552,6 +611,20 @@ check_harvest_output_exists <- function(project_dir, week_num, year_num) {
file.exists(path)
}
+#' Get mosaic verification directory
+#'
+#' @param project_dir Character. Project name
+#' @param mosaic_mode Character. "tiled" or "single-file"
+#' @return Character. Full path to mosaic directory
+get_mosaic_verification_dir <- function(project_dir, mosaic_mode) {
+ base <- file.path("laravel_app", "storage", "app", project_dir)
+
+ if (mosaic_mode == "tiled") {
+ file.path(base, "weekly_tile_max")
+ } else {
+ file.path(base, "weekly_mosaic")
+ }
+}
#' Check if mosaic files exist for a specific week
#'
diff --git a/r_app/report_utils.R b/r_app/report_utils.R
index 02c84cd..6f11757 100644
--- a/r_app/report_utils.R
+++ b/r_app/report_utils.R
@@ -24,7 +24,7 @@ subchunkify <- function(g, fig_height=7, fig_width=5) {
"\n`","``
")
- cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE))
+ cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE))
}
#' Creates a Chlorophyll Index map for a pivot
@@ -34,12 +34,13 @@ subchunkify <- function(g, fig_height=7, fig_width=5) {
#' @param pivot_spans Additional boundary data for the field
#' @param show_legend Whether to show the legend (default: FALSE)
#' @param legend_is_portrait Whether to show the legend in portrait orientation (default: FALSE)
+#' @param legend_position Position for the legend when shown: "left", "right", "top", "bottom" (default: "bottom")
#' @param week Week number to display in the title
#' @param age Age of the crop in weeks
#' @param borders Whether to display field borders (default: FALSE)
#' @return A tmap object with the CI map
#'
-create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week, age, borders = FALSE, colorblind = FALSE){
+create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, legend_position = "bottom", week, age, borders = FALSE, colorblind = FALSE){
# Input validation
if (missing(pivot_raster) || is.null(pivot_raster)) {
stop("pivot_raster is required")
@@ -64,25 +65,29 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
map <- tm_shape(pivot_raster, unit = "m")
# Add raster with continuous spectrum (fixed scale 8-1 for consistent comparison, reversed)
- map <- map + tm_raster(col.scale = tm_scale_continuous(values = palette,
- limits = c(1,8)),
- col.legend = tm_legend(title = "CI",
- orientation = if(legend_is_portrait) "portrait" else "landscape",
- show = show_legend,
- position = if(show_legend) tm_pos_out("left", "center") else c("left", "bottom"),
- reverse = TRUE
- ))
+ map <- map + tm_raster(
+ "CI",
+ col.scale = tm_scale_continuous(
+ values = palette,
+ limits = c(1, 8),
+ ticks = seq(1, 8, by = 1),
+ outliers.trunc = c(TRUE, TRUE)
+ ),
+ col.legend = tm_legend(
+ title = "CI",
+ orientation = if (legend_is_portrait) "portrait" else "landscape",
+ show = show_legend,
+ position = if (show_legend) tm_pos_out(legend_position, "center") else c("left", "bottom"),
+ reverse = TRUE
+ )
+ )
# Add layout elements
- map <- map + tm_title(text = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"),
- size = 0.7)
- # Add layout configuration to prevent legend rescaling
- map <- map + tm_layout(legend.position = c("left", "bottom"),
- legend.outside = FALSE,
- inner.margins = 0.05,
- asp = 1) # Force 1:1 aspect ratio for consistent sizing
-
- # Add bounds/view settings for fixed aspect ratio
- map <- map + tm_view(asp = 1)
+ map <- map + tm_layout(
+ main.title = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"),
+ main.title.size = 0.7,
+ #legend.height = 0.85, # Constrain vertical legend height to not exceed map
+ asp = 1 # Fixed aspect ratio
+ )
# Add borders if requested
if (borders) {
@@ -104,13 +109,14 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
#' @param pivot_spans Additional boundary data for the field
#' @param show_legend Whether to show the legend (default: FALSE)
#' @param legend_is_portrait Whether to show the legend in portrait orientation (default: FALSE)
+#' @param legend_position Position for the legend when shown: "left", "right", "top", "bottom" (default: "bottom")
#' @param week_1 First week number for comparison
#' @param week_2 Second week number for comparison
#' @param age Age of the crop in weeks
#' @param borders Whether to display field borders (default: TRUE)
#' @return A tmap object with the CI difference map
#'
-create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week_1, week_2, age, borders = TRUE, colorblind = FALSE){
+create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, legend_position = "bottom", week_1, week_2, age, borders = TRUE, colorblind = FALSE){
# Input validation
if (missing(pivot_raster) || is.null(pivot_raster)) {
stop("pivot_raster is required")
@@ -135,26 +141,30 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
map <- tm_shape(pivot_raster, unit = "m")
# Add raster with continuous spectrum (centered at 0 for difference maps, fixed scale, reversed)
- map <- map + tm_raster(col.scale = tm_scale_continuous(values = palette,
- midpoint = 0,
- limits = c(-3, 3)),
- col.legend = tm_legend(title = "CI diff.",
- orientation = if(legend_is_portrait) "portrait" else "landscape",
- show = show_legend,
- position = if(show_legend) tm_pos_out("right", "center") else c("left", "bottom"),
- reverse = TRUE
- ))
+ map <- map + tm_raster(
+ "CI",
+ col.scale = tm_scale_continuous(
+ values = palette,
+ limits = c(-3, 3),
+ ticks = seq(-3, 3, by = 1),
+ midpoint = 0,
+ outliers.trunc = c(TRUE, TRUE)
+ ),
+ col.legend = tm_legend(
+ title = "CI diff.",
+ orientation = if (legend_is_portrait) "portrait" else "landscape",
+ show = show_legend,
+ position = if (show_legend) tm_pos_out(legend_position, "center") else c("left", "bottom"),
+ reverse = TRUE
+ )
+ )
# Add layout elements
- map <- map + tm_title(text = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks (", age * 7, " days) old"),
- size = 0.7)
- # Add layout configuration to prevent legend rescaling
- map <- map + tm_layout(legend.position = c("right", "bottom"),
- legend.outside = FALSE,
- inner.margins = 0.05,
- asp = 1) # Force 1:1 aspect ratio for consistent sizing
-
- # Add bounds/view settings for fixed aspect ratio
- map <- map + tm_view(asp = 1)
+ map <- map + tm_layout(
+ main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks (", age * 7, " days) old"),
+ main.title.size = 0.7,
+ #legend.height = 0.85, # Constrain vertical legend height to not exceed map
+ asp = 1 # Fixed aspect ratio
+ )
# Add borders if requested
if (borders) {
@@ -269,18 +279,16 @@ ci_plot <- function(pivotName,
# Create historical maps only if data is available
# Build list with all available maps - order matches original: [m2, m1, current, diff_1w, diff_3w]
- # Widths match original hardcoded: c(0.23, 0.18, 0.18, 0.18, 0.23)
maps_to_arrange <- list()
- widths_to_use <- c()
field_heading_note <- ""
# Try to create 2-week ago map (legend on left)
if (!is.null(singlePivot_m2)) {
CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2,
show_legend = TRUE, legend_is_portrait = TRUE,
+ legend_position = "left",
week = week_minus_2, age = age - 2, borders = borders, colorblind = colorblind_friendly)
maps_to_arrange <- c(maps_to_arrange, list(CImap_m2))
- widths_to_use <- c(widths_to_use, 0.24)
}
# Try to create 1-week ago map
@@ -289,12 +297,10 @@ ci_plot <- function(pivotName,
show_legend = FALSE, legend_is_portrait = FALSE,
week = week_minus_1, age = age - 1, borders = borders, colorblind = colorblind_friendly)
maps_to_arrange <- c(maps_to_arrange, list(CImap_m1))
- widths_to_use <- c(widths_to_use, 0.17)
}
# Always add current week map (center position)
maps_to_arrange <- c(maps_to_arrange, list(CImap))
- widths_to_use <- c(widths_to_use, 0.17)
# Try to create 1-week difference map
if (!is.null(abs_CI_last_week)) {
@@ -302,21 +308,17 @@ ci_plot <- function(pivotName,
show_legend = FALSE, legend_is_portrait = FALSE,
week_1 = week, week_2 = week_minus_1, age = age, borders = borders, colorblind = colorblind_friendly)
maps_to_arrange <- c(maps_to_arrange, list(CI_max_abs_last_week))
- widths_to_use <- c(widths_to_use, 0.17)
}
# Try to create 3-week difference map (legend on right)
if (!is.null(abs_CI_three_week)) {
CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2,
show_legend = TRUE, legend_is_portrait = TRUE,
+ legend_position = "right",
week_1 = week, week_2 = week_minus_3, age = age, borders = borders, colorblind = colorblind_friendly)
maps_to_arrange <- c(maps_to_arrange, list(CI_max_abs_three_week))
- widths_to_use <- c(widths_to_use, 0.24)
}
- # Normalize widths to sum to 1
- widths_to_use <- widths_to_use / sum(widths_to_use)
-
# Add note if historical data is limited
if (length(maps_to_arrange) == 1) {
field_heading_note <- " (Current week only - historical data not yet available)"
@@ -324,8 +326,21 @@ ci_plot <- function(pivotName,
field_heading_note <- " (Limited historical data)"
}
- # Arrange the maps with normalized widths
- tst <- do.call(tmap_arrange, c(maps_to_arrange, list(nrow = 1, widths = widths_to_use)))
+ # Arrange the maps in a row with more width for first and last (for legends)
+ # Give maps with legends (1st and 5th) more space: 23%, middle maps get 18% each
+ widths <- if (length(maps_to_arrange) == 5) {
+ c(0.23, 0.18, 0.18, 0.18, 0.23)
+ } else if (length(maps_to_arrange) == 4) {
+ c(0.25, 0.25, 0.25, 0.25) # Equal if only 4 maps
+ } else if (length(maps_to_arrange) == 3) {
+ c(0.33, 0.33, 0.34) # Equal if only 3 maps
+ } else if (length(maps_to_arrange) == 2) {
+ c(0.5, 0.5) # Equal if only 2 maps
+ } else {
+ NULL # Single map or other cases
+ }
+
+ tst <- do.call(tmap_arrange, c(maps_to_arrange, list(nrow = 1, widths = widths)))
# Output heading and map to R Markdown
age_months <- round(age / 4.348, 1)
@@ -342,10 +357,10 @@ ci_plot <- function(pivotName,
#' Creates a plot showing Chlorophyll Index data over time for a pivot field
#'
#' @param pivotName The name or ID of the pivot field to visualize
-#' @param ci_quadrant_data Data frame containing CI quadrant data with field, sub_field, Date, DOY, cumulative_CI, value and season columns
+#' @param ci_quadrant_data Data frame containing CI quadrant data with field, sub_field, Date, DAH, cumulative_CI, value and season columns
#' @param plot_type Type of plot to generate: "absolute", "cumulative", or "both"
#' @param facet_on Whether to facet the plot by season (TRUE) or overlay all seasons (FALSE)
-#' @param x_unit Unit for x-axis: "days" for DOY or "weeks" for week number (default: "days")
+#' @param x_unit Unit for x-axis: "days" for DAH or "weeks" for week number (default: "days")
#' @param colorblind_friendly Whether to use colorblind-friendly color schemes (default: FALSE)
#' @param show_benchmarks Whether to show historical benchmark lines (default: FALSE)
#' @param estate_name Name of the estate for benchmark calculation (required if show_benchmarks = TRUE)
@@ -378,7 +393,7 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Process data
data_ci2 <- data_ci %>%
- dplyr::mutate(CI_rate = cumulative_CI / DOY,
+ dplyr::mutate(CI_rate = cumulative_CI / DAH,
week = lubridate::week(Date)) %>%
dplyr::group_by(field) %>%
dplyr::mutate(mean_CIrate_rolling_10_days = zoo::rollapplyr(CI_rate, width = 10, FUN = mean, partial = TRUE),
@@ -433,7 +448,7 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Determine x-axis variable based on x_unit parameter
x_var <- if (x_unit == "days") {
- if (facet_on) "Date" else "DOY"
+ if (facet_on) "Date" else "DAH"
} else {
"week"
}
@@ -443,14 +458,21 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
"weeks" = "Week Number")
# Calculate dynamic max values for breaks
- max_doy <- max(plot_data$DOY, na.rm = TRUE) + 20
+ max_dah <- max(plot_data$DAH, na.rm = TRUE) + 20
max_week <- max(as.numeric(plot_data$week), na.rm = TRUE) + ceiling(20 / 7)
- # Create plot with either facets by season or overlay by DOY/week
+ # Create plot with either facets by season or overlay by DAH/week
if (facet_on) {
g <- ggplot2::ggplot(data = plot_data) +
ggplot2::facet_wrap(~season, scales = "free_x") +
- ggplot2::geom_line(ggplot2::aes_string(x = x_var, y = "ci_value", col = "sub_field", group = "sub_field")) +
+ ggplot2::geom_line(
+ ggplot2::aes(
+ x = .data[[x_var]],
+ y = .data[["ci_value"]],
+ col = .data[["sub_field"]],
+ group = .data[["sub_field"]]
+ )
+ ) +
ggplot2::labs(title = paste("Plot of", y_label),
color = "Field Name",
y = y_label,
@@ -460,10 +482,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
breaks = scales::breaks_pretty(),
labels = function(x) round(as.numeric(x - min(x)) / 30.44, 1))) +
ggplot2::theme_minimal() +
- ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5),
+ ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5),
axis.text.x.top = ggplot2::element_text(hjust = 0.5),
axis.title.x.top = ggplot2::element_text(size = 8),
- legend.justification = c(1, 0), legend.position = c(1, 0),
+ legend.justification = c(1, 0),
+ legend.position = "inside",
+ legend.position.inside = c(1, 0),
legend.title = ggplot2::element_text(size = 8),
legend.text = ggplot2::element_text(size = 8)) +
ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
@@ -482,32 +506,46 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
benchmark_subset <- benchmark_data %>%
dplyr::filter(ci_type == ci_type_filter) %>%
dplyr::mutate(
- benchmark_x = if (x_var == "DOY") {
- DOY
+ benchmark_x = if (x_var == "DAH") {
+ DAH
} else if (x_var == "week") {
- DOY / 7 # Approximate conversion
+ DAH / 7 # Approximate conversion
} else {
- DOY # For Date, use DOY as is (may not align perfectly)
+ DAH # For Date, use DAH as is (may not align perfectly)
}
)
ggplot2::geom_smooth(
data = benchmark_subset,
- ggplot2::aes_string(x = "benchmark_x", y = "benchmark_value", group = "factor(percentile)"),
- color = "gray70", size = 0.5, se = FALSE, inherit.aes = FALSE
+ ggplot2::aes(
+ x = .data[["benchmark_x"]],
+ y = .data[["benchmark_value"]],
+ group = factor(.data[["percentile"]])
+ ),
+ color = "gray70", linewidth = 0.5, se = FALSE, inherit.aes = FALSE
)
}
} +
# Plot older seasons with lighter lines
ggplot2::geom_line(
data = plot_data %>% dplyr::filter(!is_latest),
- ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season"),
- size = 0.7, alpha = 0.4
+ ggplot2::aes(
+ x = .data[[x_var]],
+ y = .data[["ci_value"]],
+ col = .data[["season"]],
+ group = .data[["season"]]
+ ),
+ linewidth = 0.7, alpha = 0.4
) +
# Plot latest season with thicker, more prominent line
ggplot2::geom_line(
data = plot_data %>% dplyr::filter(is_latest),
- ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season"),
- size = 1.5, alpha = 1
+ ggplot2::aes(
+ x = .data[[x_var]],
+ y = .data[["ci_value"]],
+ col = .data[["season"]],
+ group = .data[["season"]]
+ ),
+ linewidth = 1.5, alpha = 1
) +
ggplot2::labs(title = paste("Plot of", y_label, "for Field", pivotName, title_suffix),
color = "Season",
@@ -515,17 +553,19 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
x = x_label) +
color_scale +
{
- if (x_var == "DOY") {
- ggplot2::scale_x_continuous(breaks = seq(0, max_doy, by = 50), sec.axis = ggplot2::sec_axis(~ . / 30.44, name = "Age in Months", breaks = seq(0, 14, by = 1)))
+ if (x_var == "DAH") {
+ ggplot2::scale_x_continuous(breaks = seq(0, 450, by = 50), sec.axis = ggplot2::sec_axis(~ . / 30.44, name = "Age in Months", breaks = seq(0, 14, by = 1)))
} else if (x_var == "week") {
ggplot2::scale_x_continuous(breaks = seq(0, max_week, by = 4), sec.axis = ggplot2::sec_axis(~ . / 4.348, name = "Age in Months", breaks = seq(0, 14, by = 1)))
}
} +
ggplot2::theme_minimal() +
- ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5),
+ ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5),
axis.text.x.top = ggplot2::element_text(hjust = 0.5),
axis.title.x.top = ggplot2::element_text(size = 8),
- legend.justification = c(1, 0), legend.position = c(1, 0),
+ legend.justification = c(1, 0),
+ legend.position = "inside",
+ legend.position.inside = c(1, 0),
legend.title = ggplot2::element_text(size = 8),
legend.text = ggplot2::element_text(size = 8)) +
ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
@@ -561,7 +601,7 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Determine x-axis variable based on x_unit parameter
x_var <- if (x_unit == "days") {
- if (facet_on) "Date" else "DOY"
+ if (facet_on) "Date" else "DAH"
} else {
"week"
}
@@ -578,7 +618,7 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
}
# Calculate dynamic max values for breaks
- max_doy_both <- max(plot_data_both$DOY, na.rm = TRUE) + 20
+ max_dah_both <- max(plot_data_both$DAH, na.rm = TRUE) + 20
max_week_both <- max(as.numeric(plot_data_both$week), na.rm = TRUE) + ceiling(20 / 7)
# Create the faceted plot
@@ -588,12 +628,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
if (!is.null(benchmark_data)) {
benchmark_subset <- benchmark_data %>%
dplyr::mutate(
- benchmark_x = if (x_var == "DOY") {
- DOY
+ benchmark_x = if (x_var == "DAH") {
+ DAH
} else if (x_var == "week") {
- DOY / 7
+ DAH / 7
} else {
- DOY
+ DAH
},
ci_type_label = case_when(
ci_type == "value" ~ "10-Day Rolling Mean CI",
@@ -603,8 +643,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
)
ggplot2::geom_smooth(
data = benchmark_subset,
- ggplot2::aes_string(x = "benchmark_x", y = "benchmark_value", group = "factor(percentile)"),
- color = "gray70", size = 0.5, se = FALSE, inherit.aes = FALSE
+ ggplot2::aes(
+ x = .data[["benchmark_x"]],
+ y = .data[["benchmark_value"]],
+ group = factor(.data[["percentile"]])
+ ),
+ color = "gray70", linewidth = 0.5, se = FALSE, inherit.aes = FALSE
)
}
} +
@@ -612,14 +656,24 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Plot older seasons with lighter lines
ggplot2::geom_line(
data = plot_data_both %>% dplyr::filter(!is_latest),
- ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season"),
- size = 0.7, alpha = 0.4
+ ggplot2::aes(
+ x = .data[[x_var]],
+ y = .data[["ci_value"]],
+ col = .data[["season"]],
+ group = .data[["season"]]
+ ),
+ linewidth = 0.7, alpha = 0.4
) +
# Plot latest season with thicker, more prominent line
ggplot2::geom_line(
data = plot_data_both %>% dplyr::filter(is_latest),
- ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season"),
- size = 1.5, alpha = 1
+ ggplot2::aes(
+ x = .data[[x_var]],
+ y = .data[["ci_value"]],
+ col = .data[["season"]],
+ group = .data[["season"]]
+ ),
+ linewidth = 1.5, alpha = 1
) +
ggplot2::labs(title = paste("CI Analysis for Field", pivotName),
color = "Season",
@@ -627,8 +681,8 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
x = x_label) +
color_scale +
{
- if (x_var == "DOY") {
- ggplot2::scale_x_continuous(breaks = seq(0, max_doy_both, by = 50), sec.axis = ggplot2::sec_axis(~ . / 30.44, name = "Age in Months", breaks = seq(0, 14, by = 1)))
+ if (x_var == "DAH") {
+ ggplot2::scale_x_continuous(breaks = seq(0, 450, by = 50), sec.axis = ggplot2::sec_axis(~ . / 30.44, name = "Age in Months", breaks = seq(0, 14, by = 1)))
} else if (x_var == "week") {
ggplot2::scale_x_continuous(breaks = seq(0, max_week_both, by = 4), sec.axis = ggplot2::sec_axis(~ . / 4.348, name = "Age in Months", breaks = seq(0, 14, by = 1)))
} else if (x_var == "Date") {
@@ -636,12 +690,14 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
}
} +
ggplot2::theme_minimal() +
- ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5),
- axis.text.x.top = ggplot2::element_text(hjust = 0.5),
- axis.title.x.top = ggplot2::element_text(size = 8),
- legend.justification = c(1, 0), legend.position = c(1, 0),
- legend.title = ggplot2::element_text(size = 8),
- legend.text = ggplot2::element_text(size = 8)) +
+ ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5),
+ axis.text.x.top = ggplot2::element_text(hjust = 0.5),
+ axis.title.x.top = ggplot2::element_text(size = 8),
+ legend.justification = c(1, 0),
+ legend.position = "inside",
+ legend.position.inside = c(1, 0),
+ legend.title = ggplot2::element_text(size = 8),
+ legend.text = ggplot2::element_text(size = 8)) +
ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
# For the rolling mean data, we want to set reasonable y-axis limits
@@ -659,9 +715,11 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
dummy_data[["season"]] <- factor("dummy", levels = levels(plot_data_both[["season"]]))
g_both <- g_both +
- ggplot2::geom_point(data = dummy_data,
- ggplot2::aes_string(x = x_var, y = "ci_value"),
- alpha = 0, size = 0) # Invisible points to set scale
+ ggplot2::geom_point(
+ data = dummy_data,
+ ggplot2::aes(x = .data[[x_var]], y = .data[["ci_value"]]),
+ alpha = 0, size = 0
+ ) # Invisible points to set scale
# Display the combined faceted plot
subchunkify(g_both, 2.8, 10)
@@ -698,9 +756,11 @@ cum_ci_plot2 <- function(pivotName){
x = "Date", y = "CI Rate") +
theme_minimal() +
theme(axis.text.x = element_text(hjust = 0.5),
- legend.justification = c(1, 0), legend.position = c(1, 0),
- legend.title = element_text(size = 8),
- legend.text = element_text(size = 8)) +
+ legend.justification = c(1, 0),
+ legend.position = "inside",
+ legend.position.inside = c(1, 0),
+ legend.title = element_text(size = 8),
+ legend.text = element_text(size = 8)) +
annotate("text", x = midpoint_date, y = 2, label = "No data available", size = 6, hjust = 0.5)
subchunkify(g, 3.2, 10)
@@ -750,30 +810,9 @@ get_week_path <- function(mosaic_path, input_date, week_offset) {
target_week <- sprintf("%02d", lubridate::isoweek(target_date)) # Left-pad week number with a zero if needed
target_year <- lubridate::isoyear(target_date)
- # Primary approach: Try single-file mosaic path first
+ # Load single-file mosaic for the given week
path_to_week <- here::here(mosaic_path, paste0("week_", target_week, "_", target_year, ".tif"))
- # Smart fallback: If single-file doesn't exist AND path contains "weekly_mosaic", check for tiles
- if (!file.exists(path_to_week) && grepl("weekly_mosaic", mosaic_path)) {
- # Try to locate tile-based mosaics in weekly_tile_max instead
- tile_mosaic_path <- sub("weekly_mosaic", "weekly_tile_max", mosaic_path)
-
- # Look for any tile files matching the week pattern (e.g., week_XX_YYYY_00.tif, week_XX_YYYY_01.tif, etc.)
- if (dir.exists(tile_mosaic_path)) {
- tile_files <- list.files(tile_mosaic_path,
- pattern = paste0("^week_", target_week, "_", target_year, "_(\\d{2})\\.tif$"),
- full.names = TRUE)
-
- if (length(tile_files) > 0) {
- # Found tiles - return the first tile as primary, note that multiple tiles exist
- safe_log(paste("Single-file mosaic not found for week", target_week, target_year,
- "but found", length(tile_files), "tile files in weekly_tile_max. Using tile approach."), "INFO")
- # Return first tile - caller should aggregate if needed
- path_to_week <- tile_files[1] # Return first tile; downstream can handle multiple tiles
- }
- }
- }
-
# Log the path calculation
safe_log(paste("Calculated path for week", target_week, "of year", target_year, ":", path_to_week), "INFO")
@@ -788,11 +827,11 @@ get_week_path <- function(mosaic_path, input_date, week_offset) {
#' Computes historical percentile benchmarks for CI data per estate
#'
-#' @param ci_quadrant_data Data frame containing CI quadrant data with field, Date, DOY, cumulative_CI, value, season columns
+#' @param ci_quadrant_data Data frame containing CI quadrant data with field, Date, DAH, cumulative_CI, value, season columns
#' @param estate_name Name of the estate/client to filter data for
#' @param percentiles Vector of percentiles to compute (e.g., c(10, 50, 90))
#' @param min_seasons Minimum number of seasons required for reliable benchmarks (default: 3)
-#' @return Data frame with DOY, percentile, ci_type, benchmark_value, or NULL if insufficient data
+#' @return Data frame with DAH, percentile, ci_type, benchmark_value, or NULL if insufficient data
#'
compute_ci_benchmarks <- function(ci_quadrant_data, estate_name, percentiles = c(10, 50, 90), min_seasons = 3) {
# Input validation
@@ -821,7 +860,7 @@ compute_ci_benchmarks <- function(ci_quadrant_data, estate_name, percentiles = c
# Prepare data for both CI types
data_prepared <- data_filtered %>%
dplyr::ungroup() %>% # Ensure no existing groupings
- dplyr::select(DOY, value, cumulative_CI, season) %>%
+ dplyr::select(DAH, value, cumulative_CI, season) %>%
tidyr::pivot_longer(
cols = c("value", "cumulative_CI"),
names_to = "ci_type",
@@ -829,9 +868,9 @@ compute_ci_benchmarks <- function(ci_quadrant_data, estate_name, percentiles = c
) %>%
dplyr::filter(!is.na(ci_value)) # Remove NA values
- # Compute percentiles for each DOY and ci_type
+ # Compute percentiles for each DAH and ci_type
benchmarks <- data_prepared %>%
- dplyr::group_by(DOY, ci_type) %>%
+ dplyr::group_by(DAH, ci_type) %>%
dplyr::summarise(
p10 = tryCatch(quantile(ci_value, 0.1, na.rm = TRUE), error = function(e) NA_real_),
p50 = tryCatch(quantile(ci_value, 0.5, na.rm = TRUE), error = function(e) NA_real_),
@@ -839,7 +878,7 @@ compute_ci_benchmarks <- function(ci_quadrant_data, estate_name, percentiles = c
n_observations = n(),
.groups = 'drop'
) %>%
- dplyr::filter(n_observations >= min_seasons) %>% # Only include DOYs with sufficient data
+ dplyr::filter(n_observations >= min_seasons) %>% # Only include DAHs with sufficient data
tidyr::pivot_longer(
cols = c(p10, p50, p90),
names_to = "percentile",
@@ -856,7 +895,7 @@ compute_ci_benchmarks <- function(ci_quadrant_data, estate_name, percentiles = c
# Rename columns for clarity
benchmarks <- benchmarks %>%
- dplyr::select(DOY, ci_type, percentile, benchmark_value)
+ dplyr::select(DAH, ci_type, percentile, benchmark_value)
safe_log(paste("Computed CI benchmarks for estate", estate_name, "with", length(unique_seasons), "seasons and", nrow(benchmarks), "benchmark points"), "INFO")
@@ -1043,7 +1082,7 @@ get_field_priority_level <- function(cv, morans_i) {
#'
#' @param field_name Name of the field to summarize
#' @param field_details_table Data frame with field-level KPI details
-#' @param CI_quadrant Data frame containing CI quadrant data with Date, DOY, season columns
+#' @param CI_quadrant Data frame containing CI quadrant data with Date, DAH, season columns
#' @param report_date Report date (used for filtering current season data)
#' @return Formatted text string with field KPI summary
#'
@@ -1064,10 +1103,10 @@ generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadr
}
current_season <- current_season_data %>% pull(season)
- # Get the most recent DOY from the current season
+ # Get the most recent DAH from the current season
field_age_data <- CI_quadrant %>%
filter(field == field_name, season == current_season) %>%
- pull(DOY)
+ pull(DAH)
field_age <- if (length(field_age_data) > 0) max(field_age_data, na.rm = TRUE) else NA_real_
# Filter data for this specific field
@@ -1082,7 +1121,7 @@ generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadr
# For categorical data, take the most common value or highest risk level
field_summary <- field_data %>%
summarise(
- field_size = sum(`Field Size (ha)`, na.rm = TRUE),
+ field_size = sum(`Field Size (acres)`, na.rm = TRUE),
uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"),
avg_yield_forecast = ifelse(is.na(`Yield Forecast (t/ha)`[1]), NA, mean(`Yield Forecast (t/ha)`, na.rm = TRUE)),
max_gap_score = max(`Gap Score`, na.rm = TRUE),
@@ -1117,10 +1156,10 @@ generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadr
}
kpi_text <- paste0(
- "Size: ", round(field_summary$field_size, 1), " ha | Growth Uniformity: ", field_summary$uniformity_levels,
+ "Size: ", round(field_summary$field_size * 0.404686, 1), " ha | Mean CI: ", round(field_summary$avg_mean_ci, 2),
+ " | Growth Uniformity: ", field_summary$uniformity_levels,
" | ", yield_text, " | Gap Score: ", round(field_summary$max_gap_score, 1),
- " | Decline Risk: ", field_summary$highest_decline_risk, " | Weed Risk: ", field_summary$highest_weed_risk,
- " | Mean CI: ", round(field_summary$avg_mean_ci, 2)
+ " | Decline Risk: ", field_summary$highest_decline_risk, " | Weed Risk: ", field_summary$highest_weed_risk
)
# Wrap in smaller text HTML tags for Word output
@@ -1134,4 +1173,33 @@ generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadr
})
}
-
+#' Normalize field_details_table column structure
+#'
+#' Standardizes column names and ensures all expected KPI columns exist.
+#' Handles Field → Field_id rename and injects missing columns as NA.
+#'
+#' @param field_details_table data.frame to normalize
+#' @return data.frame with standardized column structure
+normalize_field_details_columns <- function(field_details_table) {
+ if (is.null(field_details_table) || nrow(field_details_table) == 0) {
+ return(field_details_table)
+ }
+
+ # Rename Field → Field_id if needed
+ if ("Field" %in% names(field_details_table) && !("Field_id" %in% names(field_details_table))) {
+ field_details_table <- field_details_table %>%
+ dplyr::rename(Field_id = Field)
+ }
+
+ # Ensure all expected KPI columns exist; add as NA if missing
+ expected_cols <- c("Field_id", "Mean_CI", "CV", "TCH_Forecasted", "Gap_Score",
+ "Trend_Interpretation", "Weekly_CI_Change", "Uniformity_Interpretation",
+ "Decline_Severity", "Patchiness_Risk")
+ for (col in expected_cols) {
+ if (!col %in% names(field_details_table)) {
+ field_details_table[[col]] <- NA
+ }
+ }
+
+ return(field_details_table)
+}
diff --git a/r_app/translations/translations.xlsx b/r_app/translations/translations.xlsx
index 715556e..82896f2 100644
Binary files a/r_app/translations/translations.xlsx and b/r_app/translations/translations.xlsx differ
diff --git a/renv.lock b/renv.lock
index d1cff92..9e78b85 100644
--- a/renv.lock
+++ b/renv.lock
@@ -9,71 +9,6 @@
]
},
"Packages": {
- "CAST": {
- "Package": "CAST",
- "Version": "1.0.3",
- "Source": "Repository",
- "Type": "Package",
- "Title": "'caret' Applications for Spatial-Temporal Models",
- "Authors@R": "c(person(\"Hanna\", \"Meyer\", email = \"hanna.meyer@uni-muenster.de\", role = c(\"cre\", \"aut\")), person(\"Carles\", \"Milà\", role = c(\"aut\")), person(\"Marvin\", \"Ludwig\", role = c(\"aut\")), person(\"Jan\", \"Linnenbrink\", role = c(\"aut\")), person(\"Fabian\", \"Schumacher\", role = c(\"aut\")), person(\"Philipp\", \"Otto\", role = c(\"ctb\")), person(\"Chris\", \"Reudenbach\", role = c(\"ctb\")), person(\"Thomas\", \"Nauss\", role = c(\"ctb\")), person(\"Edzer\", \"Pebesma\", role = c(\"ctb\")), person(\"Jakub\", \"Nowosad\", role = c(\"ctb\")))",
- "Author": "Hanna Meyer [cre, aut], Carles Milà [aut], Marvin Ludwig [aut], Jan Linnenbrink [aut], Fabian Schumacher [aut], Philipp Otto [ctb], Chris Reudenbach [ctb], Thomas Nauss [ctb], Edzer Pebesma [ctb], Jakub Nowosad [ctb]",
- "Maintainer": "Hanna Meyer ",
- "Description": "Supporting functionality to run 'caret' with spatial or spatial-temporal data. 'caret' is a frequently used package for model training and prediction using machine learning. CAST includes functions to improve spatial or spatial-temporal modelling tasks using 'caret'. It includes the newly suggested 'Nearest neighbor distance matching' cross-validation to estimate the performance of spatial prediction models and allows for spatial variable selection to selects suitable predictor variables in view to their contribution to the spatial model performance. CAST further includes functionality to estimate the (spatial) area of applicability of prediction models. Methods are described in Meyer et al. (2018) ; Meyer et al. (2019) ; Meyer and Pebesma (2021) ; Milà et al. (2022) ; Meyer and Pebesma (2022) ; Linnenbrink et al. (2023) ; Schumacher et al. (2024) . The package is described in detail in Meyer et al. (2024) .",
- "License": "GPL (>= 2)",
- "URL": "https://github.com/HannaMeyer/CAST, https://hannameyer.github.io/CAST/",
- "Encoding": "UTF-8",
- "LazyData": "false",
- "Depends": [
- "R (>= 4.1.0)"
- ],
- "BugReports": "https://github.com/HannaMeyer/CAST/issues/",
- "Imports": [
- "caret",
- "stats",
- "utils",
- "ggplot2",
- "graphics",
- "FNN",
- "plyr",
- "zoo",
- "methods",
- "grDevices",
- "data.table",
- "sf",
- "forcats",
- "twosamples",
- "terra",
- "sp"
- ],
- "Suggests": [
- "doParallel",
- "lubridate",
- "randomForest",
- "knitr",
- "geodata",
- "mapview",
- "rmarkdown",
- "scales",
- "parallel",
- "gridExtra",
- "viridis",
- "stars",
- "scam",
- "rnaturalearth",
- "MASS",
- "RColorBrewer",
- "tmap",
- "PCAmixdata",
- "gower",
- "clustMixType",
- "testthat (>= 3.0.0)"
- ],
- "RoxygenNote": "7.3.2",
- "VignetteBuilder": "knitr",
- "Config/testthat/edition": "3",
- "NeedsCompilation": "no",
- "Repository": "CRAN"
- },
"DBI": {
"Package": "DBI",
"Version": "1.2.3",
@@ -123,28 +58,6 @@
"Maintainer": "Kirill Müller ",
"Repository": "CRAN"
},
- "FNN": {
- "Package": "FNN",
- "Version": "1.1.4.1",
- "Source": "Repository",
- "Date": "2023-12-31",
- "Title": "Fast Nearest Neighbor Search Algorithms and Applications",
- "Authors@R": "c(person(\"Alina\", \"Beygelzimer\", role = \"aut\", comment = \"cover tree library\"), person(\"Sham\", \"Kakadet\", role = \"aut\", comment = \"cover tree library\"), person(\"John\", \"Langford\", role = \"aut\", comment = \"cover tree library\"), person(\"Sunil\", \"Arya\", role = \"aut\", comment = \"ANN library 1.1.2 for the kd-tree approach\"), person(\"David\", \"Mount\", role = \"aut\", comment = \"ANN library 1.1.2 for the kd-tree approach\"), person(\"Shengqiao\", \"Li\", role = c(\"aut\", \"cre\"), email = \"lishengqiao@yahoo.com\"))",
- "Copyright": "ANN Copyright (c) 1997-2010 University of Maryland and Sunil Arya and David Mount. All Rights Reserved.",
- "Depends": [
- "R (>= 4.0.0)"
- ],
- "Suggests": [
- "chemometrics",
- "mvtnorm"
- ],
- "Description": "Cover-tree and kd-tree fast k-nearest neighbor search algorithms and related applications including KNN classification, regression and information measures are implemented.",
- "License": "GPL (>= 2)",
- "NeedsCompilation": "yes",
- "Repository": "CRAN",
- "Author": "Alina Beygelzimer [aut] (cover tree library), Sham Kakadet [aut] (cover tree library), John Langford [aut] (cover tree library), Sunil Arya [aut] (ANN library 1.1.2 for the kd-tree approach), David Mount [aut] (ANN library 1.1.2 for the kd-tree approach), Shengqiao Li [aut, cre]",
- "Maintainer": "Shengqiao Li "
- },
"KernSmooth": {
"Package": "KernSmooth",
"Version": "2.23-24",
@@ -251,36 +164,6 @@
"Maintainer": "Martin Maechler ",
"Repository": "CRAN"
},
- "ModelMetrics": {
- "Package": "ModelMetrics",
- "Version": "1.2.2.2",
- "Source": "Repository",
- "Title": "Rapid Calculation of Model Metrics",
- "Date": "2018-11-03",
- "Authors@R": "person(\"Tyler\", \"Hunt\", email = \"thunt@snapfinance.com\", role = c(\"aut\", \"cre\"))",
- "Description": "Collection of metrics for evaluating models written in C++ using 'Rcpp'. Popular metrics include area under the curve, log loss, root mean square error, etc.",
- "Depends": [
- "R (>= 3.2.2)"
- ],
- "License": "GPL (>= 2)",
- "Encoding": "UTF-8",
- "LazyData": "true",
- "LinkingTo": [
- "Rcpp"
- ],
- "Imports": [
- "Rcpp",
- "data.table"
- ],
- "RoxygenNote": "6.0.1",
- "Suggests": [
- "testthat"
- ],
- "NeedsCompilation": "yes",
- "Author": "Tyler Hunt [aut, cre]",
- "Maintainer": "Tyler Hunt ",
- "Repository": "CRAN"
- },
"R6": {
"Package": "R6",
"Version": "2.6.1",
@@ -353,161 +236,6 @@
"Maintainer": "Dirk Eddelbuettel ",
"Repository": "CRAN"
},
- "RcppArmadillo": {
- "Package": "RcppArmadillo",
- "Version": "15.2.2-1",
- "Source": "Repository",
- "Type": "Package",
- "Title": "'Rcpp' Integration for the 'Armadillo' Templated Linear Algebra Library",
- "Date": "2025-11-21",
- "Authors@R": "c(person(\"Dirk\", \"Eddelbuettel\", role = c(\"aut\", \"cre\"), email = \"edd@debian.org\", comment = c(ORCID = \"0000-0001-6419-907X\")), person(\"Romain\", \"Francois\", role = \"aut\", comment = c(ORCID = \"0000-0002-2444-4226\")), person(\"Doug\", \"Bates\", role = \"aut\", comment = c(ORCID = \"0000-0001-8316-9503\")), person(\"Binxiang\", \"Ni\", role = \"aut\"), person(\"Conrad\", \"Sanderson\", role = \"aut\", comment = c(ORCID = \"0000-0002-0049-4501\")))",
- "Description": "'Armadillo' is a templated C++ linear algebra library aiming towards a good balance between speed and ease of use. It provides high-level syntax and functionality deliberately similar to Matlab. It is useful for algorithm development directly in C++, or quick conversion of research code into production environments. It provides efficient classes for vectors, matrices and cubes where dense and sparse matrices are supported. Integer, floating point and complex numbers are supported. A sophisticated expression evaluator (based on template meta-programming) automatically combines several operations to increase speed and efficiency. Dynamic evaluation automatically chooses optimal code paths based on detected matrix structures. Matrix decompositions are provided through integration with LAPACK, or one of its high performance drop-in replacements (such as 'MKL' or 'OpenBLAS'). It can automatically use 'OpenMP' multi-threading (parallelisation) to speed up computationally expensive operations. . The 'RcppArmadillo' package includes the header files from the 'Armadillo' library; users do not need to install 'Armadillo' itself in order to use 'RcppArmadillo'. Starting from release 15.0.0, the minimum compilation standard is C++14 so 'Armadillo' version 14.6.3 is included as a fallback when an R package forces the C++11 standard. Package authors should set a '#define' to select the 'current' version, or select the 'legacy' version (also chosen as default) if they must. See 'GitHub issue #475' for details. . Since release 7.800.0, 'Armadillo' is licensed under Apache License 2; previous releases were under licensed as MPL 2.0 from version 3.800.0 onwards and LGPL-3 prior to that; 'RcppArmadillo' (the 'Rcpp' bindings/bridge to Armadillo) is licensed under the GNU GPL version 2 or later, as is the rest of 'Rcpp'.",
- "License": "GPL (>= 2)",
- "LazyLoad": "yes",
- "Depends": [
- "R (>= 3.3.0)"
- ],
- "LinkingTo": [
- "Rcpp"
- ],
- "Imports": [
- "Rcpp (>= 1.0.12)",
- "stats",
- "utils",
- "methods"
- ],
- "Suggests": [
- "tinytest",
- "Matrix (>= 1.3.0)",
- "pkgKitten",
- "reticulate",
- "slam"
- ],
- "URL": "https://github.com/RcppCore/RcppArmadillo, https://dirk.eddelbuettel.com/code/rcpp.armadillo.html",
- "BugReports": "https://github.com/RcppCore/RcppArmadillo/issues",
- "RoxygenNote": "6.0.1",
- "NeedsCompilation": "yes",
- "Author": "Dirk Eddelbuettel [aut, cre] (ORCID: ), Romain Francois [aut] (ORCID: ), Doug Bates [aut] (ORCID: ), Binxiang Ni [aut], Conrad Sanderson [aut] (ORCID: )",
- "Maintainer": "Dirk Eddelbuettel ",
- "Repository": "CRAN"
- },
- "RcppTOML": {
- "Package": "RcppTOML",
- "Version": "0.2.3",
- "Source": "Repository",
- "Type": "Package",
- "Title": "'Rcpp' Bindings to Parser for \"Tom's Obvious Markup Language\"",
- "Date": "2025-03-08",
- "Authors@R": "c(person(\"Dirk\", \"Eddelbuettel\", role = c(\"aut\", \"cre\"), email = \"edd@debian.org\", comment = c(ORCID = \"0000-0001-6419-907X\")), person(\"Mark\", \"Gillard\", role = \"aut\", comment = \"Author of 'toml++' header library\"))",
- "Description": "The configuration format defined by 'TOML' (which expands to \"Tom's Obvious Markup Language\") specifies an excellent format (described at ) suitable for both human editing as well as the common uses of a machine-readable format. This package uses 'Rcpp' to connect to the 'toml++' parser written by Mark Gillard to R.",
- "SystemRequirements": "A C++17 compiler",
- "BugReports": "https://github.com/eddelbuettel/rcpptoml/issues",
- "URL": "http://dirk.eddelbuettel.com/code/rcpp.toml.html",
- "Imports": [
- "Rcpp (>= 1.0.8)"
- ],
- "Depends": [
- "R (>= 3.3.0)"
- ],
- "LinkingTo": [
- "Rcpp"
- ],
- "Suggests": [
- "tinytest"
- ],
- "License": "GPL (>= 2)",
- "NeedsCompilation": "yes",
- "Author": "Dirk Eddelbuettel [aut, cre] (), Mark Gillard [aut] (Author of 'toml++' header library)",
- "Maintainer": "Dirk Eddelbuettel ",
- "Repository": "CRAN",
- "Encoding": "UTF-8"
- },
- "Rdpack": {
- "Package": "Rdpack",
- "Version": "2.6.4",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Update and Manipulate Rd Documentation Objects",
- "Authors@R": "c( person(given = c(\"Georgi\", \"N.\"), family = \"Boshnakov\", role = c(\"aut\", \"cre\"), email = \"georgi.boshnakov@manchester.ac.uk\", comment = c(ORCID = \"0000-0003-2839-346X\")), person(given = \"Duncan\", family = \"Murdoch\", role = \"ctb\", email = \"murdoch.duncan@gmail.com\") )",
- "Description": "Functions for manipulation of R documentation objects, including functions reprompt() and ereprompt() for updating 'Rd' documentation for functions, methods and classes; 'Rd' macros for citations and import of references from 'bibtex' files for use in 'Rd' files and 'roxygen2' comments; 'Rd' macros for evaluating and inserting snippets of 'R' code and the results of its evaluation or creating graphics on the fly; and many functions for manipulation of references and Rd files.",
- "URL": "https://geobosh.github.io/Rdpack/ (doc), https://github.com/GeoBosh/Rdpack (devel)",
- "BugReports": "https://github.com/GeoBosh/Rdpack/issues",
- "Depends": [
- "R (>= 2.15.0)",
- "methods"
- ],
- "Imports": [
- "tools",
- "utils",
- "rbibutils (>= 1.3)"
- ],
- "Suggests": [
- "grDevices",
- "testthat",
- "rstudioapi",
- "rprojroot",
- "gbRd"
- ],
- "License": "GPL (>= 2)",
- "LazyLoad": "yes",
- "RoxygenNote": "7.1.1",
- "NeedsCompilation": "no",
- "Author": "Georgi N. Boshnakov [aut, cre] (), Duncan Murdoch [ctb]",
- "Maintainer": "Georgi N. Boshnakov ",
- "Repository": "CRAN",
- "Encoding": "UTF-8"
- },
- "SQUAREM": {
- "Package": "SQUAREM",
- "Version": "2021.1",
- "Source": "Repository",
- "Date": "2021-01-12",
- "Title": "Squared Extrapolation Methods for Accelerating EM-Like Monotone Algorithms",
- "Description": "Algorithms for accelerating the convergence of slow, monotone sequences from smooth, contraction mapping such as the EM algorithm. It can be used to accelerate any smooth, linearly convergent acceleration scheme. A tutorial style introduction to this package is available in a vignette on the CRAN download page or, when the package is loaded in an R session, with vignette(\"SQUAREM\"). Refer to the J Stat Software article: .",
- "Depends": [
- "R (>= 3.0)"
- ],
- "Suggests": [
- "setRNG"
- ],
- "LazyLoad": "yes",
- "License": "GPL (>= 2)",
- "Author": "Ravi Varadhan",
- "Maintainer": "Ravi Varadhan ",
- "URL": "https://coah.jhu.edu/people/Faculty_personal_Pages/Varadhan.html",
- "Repository": "CRAN",
- "NeedsCompilation": "no"
- },
- "TTR": {
- "Package": "TTR",
- "Version": "0.24.4",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Technical Trading Rules",
- "Authors@R": "c( person(given=\"Joshua\", family=\"Ulrich\", role=c(\"cre\",\"aut\"), email=\"josh.m.ulrich@gmail.com\"), person(given=c(\"Ethan\",\"B.\"), family=\"Smith\", role=\"ctb\") )",
- "Imports": [
- "xts (>= 0.10-0)",
- "zoo",
- "curl"
- ],
- "LinkingTo": [
- "xts"
- ],
- "Enhances": [
- "quantmod"
- ],
- "Suggests": [
- "RUnit"
- ],
- "Description": "A collection of over 50 technical indicators for creating technical trading rules. The package also provides fast implementations of common rolling-window functions, and several volatility calculations.",
- "License": "GPL (>= 2)",
- "URL": "https://github.com/joshuaulrich/TTR",
- "BugReports": "https://github.com/joshuaulrich/TTR/issues",
- "NeedsCompilation": "yes",
- "Author": "Joshua Ulrich [cre, aut], Ethan B. Smith [ctb]",
- "Maintainer": "Joshua Ulrich ",
- "Repository": "CRAN"
- },
"XML": {
"Package": "XML",
"Version": "3.99-0.18",
@@ -620,47 +348,6 @@
"NeedsCompilation": "yes",
"Repository": "CRAN"
},
- "bfast": {
- "Package": "bfast",
- "Version": "1.7.1",
- "Source": "Repository",
- "Title": "Breaks for Additive Season and Trend",
- "Authors@R": "c(person(given = \"Jan\", family = \"Verbesselt\", role = c(\"aut\"), email = \"Jan.Verbesselt@wur.nl\"), person(given = \"Dainius\", family = \"Masili\\u016Bnas\", role = c(\"aut\", \"cre\"), email = \"pastas4@gmail.com\", comment = c(ORCID = \"0000-0001-5654-1277\")), person(given = \"Achim\", family = \"Zeileis\", role = \"aut\", email = \"Achim.Zeileis@R-project.org\"), person(given = \"Rob\", family = \"Hyndman\", role = \"ctb\", email = \"Rob.Hyndman@buseco.monash.edu.au\"), person(given = \"Marius\", family = \"Appel\", role = \"aut\", email = \"marius.appel@uni-muenster.de\"), person(given = \"Martin\", family = \"Jung\", role = \"ctb\", email = \"m.jung@sussex.ac.uk\"), person(given = \"Andrei\", family = \"M\\u00EEr\\u021B\", role = \"ctb\", email = \"andrei.mirt@wur.nl\", comment = c(ORCID = \"0000-0003-3654-2090\")), person(given = c(\"Paulo\", \"Negri\"), family = \"Bernardino\", role = \"ctb\", email = \"paulo.negribernardino@wur.nl\"), person(given = \"Dongdong\", family = \"Kong\", role = \"ctb\", email = \"kongdd@mail2.sysu.edu.cn\", comment = c(ORCID = \"0000-0003-1836-8172\")) )",
- "Description": "Decomposition of time series into trend, seasonal, and remainder components with methods for detecting and characterizing abrupt changes within the trend and seasonal components. 'BFAST' can be used to analyze different types of satellite image time series and can be applied to other disciplines dealing with seasonal or non-seasonal time series, such as hydrology, climatology, and econometrics. The algorithm can be extended to label detected changes with information on the parameters of the fitted piecewise linear models. 'BFAST' monitoring functionality is described in Verbesselt et al. (2010) . 'BFAST monitor' provides functionality to detect disturbance in near real-time based on 'BFAST'- type models, and is described in Verbesselt et al. (2012) . 'BFAST Lite' approach is a flexible approach that handles missing data without interpolation, and will be described in an upcoming paper. Furthermore, different models can now be used to fit the time series data and detect structural changes (breaks).",
- "Depends": [
- "R (>= 3.0.0)",
- "strucchangeRcpp (>= 1.5-4)"
- ],
- "Imports": [
- "graphics",
- "stats",
- "zoo",
- "forecast",
- "Rcpp (>= 0.12.7)",
- "Rdpack (>= 0.7)"
- ],
- "Suggests": [
- "MASS",
- "sfsmisc",
- "stlplus",
- "terra"
- ],
- "License": "GPL (>= 2)",
- "URL": "https://bfast2.github.io/",
- "BugReports": "https://github.com/bfast2/bfast/issues",
- "LazyLoad": "yes",
- "LazyData": "yes",
- "LinkingTo": [
- "Rcpp"
- ],
- "RoxygenNote": "7.3.2",
- "RdMacros": "Rdpack",
- "Encoding": "UTF-8",
- "NeedsCompilation": "yes",
- "Author": "Jan Verbesselt [aut], Dainius Masiliūnas [aut, cre] (ORCID: ), Achim Zeileis [aut], Rob Hyndman [ctb], Marius Appel [aut], Martin Jung [ctb], Andrei Mîrț [ctb] (ORCID: ), Paulo Negri Bernardino [ctb], Dongdong Kong [ctb] (ORCID: )",
- "Maintainer": "Dainius Masiliūnas ",
- "Repository": "CRAN"
- },
"bit": {
"Package": "bit",
"Version": "4.6.0",
@@ -1030,78 +717,6 @@
"Maintainer": "Gábor Csárdi ",
"Repository": "CRAN"
},
- "caret": {
- "Package": "caret",
- "Version": "7.0-1",
- "Source": "Repository",
- "Title": "Classification and Regression Training",
- "Authors@R": "c(person(given = \"Max\", family = \"Kuhn\", role = c(\"aut\", \"cre\"), email = \"mxkuhn@gmail.com\", comment = c(ORCID = \"0000-0003-2402-136X\")), person(given = \"Jed\", family = \"Wing\", role = \"ctb\"), person(given = \"Steve\", family = \"Weston\", role = \"ctb\"), person(given = \"Andre\", family = \"Williams\", role = \"ctb\"), person(given = \"Chris\", family = \"Keefer\", role = \"ctb\"), person(given = \"Allan\", family = \"Engelhardt\", role = \"ctb\"), person(given = \"Tony\", family = \"Cooper\", role = \"ctb\"), person(given = \"Zachary\", family = \"Mayer\", role = \"ctb\"), person(given = \"Brenton\", family = \"Kenkel\", role = \"ctb\"), person(given = \"R Core Team\", role = \"ctb\"), person(given = \"Michael\", family = \"Benesty\", role = \"ctb\"), person(given = \"Reynald\", family = \"Lescarbeau\", role = \"ctb\"), person(given = \"Andrew\", family = \"Ziem\", role = \"ctb\"), person(given = \"Luca\", family = \"Scrucca\", role = \"ctb\"), person(given = \"Yuan\", family = \"Tang\", role = \"ctb\"), person(given = \"Can\", family = \"Candan\", role = \"ctb\"), person(given = \"Tyler\", family = \"Hunt\", role = \"ctb\"))",
- "Description": "Misc functions for training and plotting classification and regression models.",
- "License": "GPL (>= 2)",
- "URL": "https://github.com/topepo/caret/",
- "BugReports": "https://github.com/topepo/caret/issues",
- "Depends": [
- "ggplot2",
- "lattice (>= 0.20)",
- "R (>= 3.2.0)"
- ],
- "Imports": [
- "e1071",
- "foreach",
- "grDevices",
- "methods",
- "ModelMetrics (>= 1.2.2.2)",
- "nlme",
- "plyr",
- "pROC",
- "recipes (>= 0.1.10)",
- "reshape2",
- "stats",
- "stats4",
- "utils",
- "withr (>= 2.0.0)"
- ],
- "Suggests": [
- "BradleyTerry2",
- "covr",
- "Cubist",
- "dplyr",
- "earth (>= 2.2-3)",
- "ellipse",
- "fastICA",
- "gam (>= 1.15)",
- "ipred",
- "kernlab",
- "klaR",
- "knitr",
- "MASS",
- "Matrix",
- "mda",
- "mgcv",
- "mlbench",
- "MLmetrics",
- "nnet",
- "pamr",
- "party (>= 0.9-99992)",
- "pls",
- "proxy",
- "randomForest",
- "RANN",
- "rmarkdown",
- "rpart",
- "spls",
- "superpc",
- "testthat (>= 0.9.1)",
- "themis (>= 0.1.3)"
- ],
- "VignetteBuilder": "knitr",
- "Encoding": "UTF-8",
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "yes",
- "Author": "Max Kuhn [aut, cre] (), Jed Wing [ctb], Steve Weston [ctb], Andre Williams [ctb], Chris Keefer [ctb], Allan Engelhardt [ctb], Tony Cooper [ctb], Zachary Mayer [ctb], Brenton Kenkel [ctb], R Core Team [ctb], Michael Benesty [ctb], Reynald Lescarbeau [ctb], Andrew Ziem [ctb], Luca Scrucca [ctb], Yuan Tang [ctb], Can Candan [ctb], Tyler Hunt [ctb]",
- "Maintainer": "Max Kuhn ",
- "Repository": "CRAN"
- },
"cellranger": {
"Package": "cellranger",
"Version": "1.1.0",
@@ -1273,52 +888,6 @@
"Maintainer": "Matthew Lincoln ",
"Repository": "CRAN"
},
- "clock": {
- "Package": "clock",
- "Version": "0.7.3",
- "Source": "Repository",
- "Title": "Date-Time Types and Tools",
- "Authors@R": "c( person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
- "Description": "Provides a comprehensive library for date-time manipulations using a new family of orthogonal date-time classes (durations, time points, zoned-times, and calendars) that partition responsibilities so that the complexities of time zones are only considered when they are really needed. Capabilities include: date-time parsing, formatting, arithmetic, extraction and updating of components, and rounding.",
- "License": "MIT + file LICENSE",
- "URL": "https://clock.r-lib.org, https://github.com/r-lib/clock",
- "BugReports": "https://github.com/r-lib/clock/issues",
- "Depends": [
- "R (>= 4.0.0)"
- ],
- "Imports": [
- "cli (>= 3.6.4)",
- "lifecycle (>= 1.0.4)",
- "rlang (>= 1.1.5)",
- "tzdb (>= 0.5.0)",
- "vctrs (>= 0.6.5)"
- ],
- "Suggests": [
- "covr",
- "knitr",
- "magrittr",
- "pillar",
- "rmarkdown",
- "slider (>= 0.3.2)",
- "testthat (>= 3.0.0)",
- "withr"
- ],
- "LinkingTo": [
- "cpp11 (>= 0.5.2)",
- "tzdb (>= 0.5.0)"
- ],
- "VignetteBuilder": "knitr",
- "Config/build/compilation-database": "true",
- "Config/Needs/website": "lubridate, tidyverse/tidytemplate",
- "Config/testthat/edition": "3",
- "Encoding": "UTF-8",
- "LazyData": "true",
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "yes",
- "Author": "Davis Vaughan [aut, cre], Posit Software, PBC [cph, fnd]",
- "Maintainer": "Davis Vaughan ",
- "Repository": "CRAN"
- },
"codetools": {
"Package": "codetools",
"Version": "0.2-20",
@@ -1759,27 +1328,6 @@
"NeedsCompilation": "yes",
"Repository": "CRAN"
},
- "diagram": {
- "Package": "diagram",
- "Version": "1.6.5",
- "Source": "Repository",
- "Title": "Functions for Visualising Simple Graphs (Networks), Plotting Flow Diagrams",
- "Author": "Karline Soetaert ",
- "Maintainer": "Karline Soetaert ",
- "Depends": [
- "R (>= 2.01)",
- "shape"
- ],
- "Imports": [
- "stats",
- "graphics"
- ],
- "Description": "Visualises simple graphs (networks) based on a transition matrix, utilities to plot flow diagrams, visualising webs, electrical networks, etc. Support for the book \"A practical guide to ecological modelling - using R as a simulation platform\" by Karline Soetaert and Peter M.J. Herman (2009), Springer. and the book \"Solving Differential Equations in R\" by Karline Soetaert, Jeff Cash and Francesca Mazzia (2012), Springer. Includes demo(flowchart), demo(plotmat), demo(plotweb).",
- "License": "GPL (>= 2)",
- "LazyData": "yes",
- "NeedsCompilation": "no",
- "Repository": "CRAN"
- },
"dichromat": {
"Package": "dichromat",
"Version": "2.0-0.1",
@@ -2003,46 +1551,6 @@
"Maintainer": "Hadley Wickham ",
"Repository": "CRAN"
},
- "exactextractr": {
- "Package": "exactextractr",
- "Version": "0.10.0",
- "Source": "Repository",
- "Title": "Fast Extraction from Raster Datasets using Polygons",
- "Authors@R": "c( person(\"Daniel Baston\", email = \"dbaston@isciences.com\", role = c(\"aut\", \"cre\")), person(\"ISciences, LLC\", role=\"cph\"))",
- "Description": "Quickly and accurately summarizes raster values over polygonal areas (\"zonal statistics\").",
- "Depends": [
- "R (>= 3.4.0)"
- ],
- "License": "Apache License (== 2.0)",
- "SystemRequirements": "GEOS (>= 3.5.0)",
- "Imports": [
- "Rcpp (>= 0.12.12)",
- "methods",
- "raster",
- "sf (>= 0.9.0)"
- ],
- "URL": "https://isciences.gitlab.io/exactextractr/, https://github.com/isciences/exactextractr",
- "BugReports": "https://github.com/isciences/exactextractr/issues",
- "LinkingTo": [
- "Rcpp"
- ],
- "Suggests": [
- "dplyr",
- "foreign",
- "knitr",
- "ncdf4",
- "rmarkdown",
- "testthat",
- "terra (>= 1.5.17)"
- ],
- "Encoding": "UTF-8",
- "RoxygenNote": "7.1.2",
- "VignetteBuilder": "knitr",
- "NeedsCompilation": "yes",
- "Author": "Daniel Baston [aut, cre], ISciences, LLC [cph]",
- "Maintainer": "Daniel Baston ",
- "Repository": "CRAN"
- },
"fansi": {
"Package": "fansi",
"Version": "1.0.6",
@@ -2324,124 +1832,6 @@
"Maintainer": "Hadley Wickham ",
"Repository": "CRAN"
},
- "foreach": {
- "Package": "foreach",
- "Version": "1.5.2",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Provides Foreach Looping Construct",
- "Authors@R": "c(person(\"Folashade\", \"Daniel\", role=\"cre\", email=\"fdaniel@microsoft.com\"), person(\"Hong\", \"Ooi\", role=\"ctb\"), person(\"Rich\", \"Calaway\", role=\"ctb\"), person(\"Microsoft\", role=c(\"aut\", \"cph\")), person(\"Steve\", \"Weston\", role=\"aut\"))",
- "Description": "Support for the foreach looping construct. Foreach is an idiom that allows for iterating over elements in a collection, without the use of an explicit loop counter. This package in particular is intended to be used for its return value, rather than for its side effects. In that sense, it is similar to the standard lapply function, but doesn't require the evaluation of a function. Using foreach without side effects also facilitates executing the loop in parallel.",
- "License": "Apache License (== 2.0)",
- "URL": "https://github.com/RevolutionAnalytics/foreach",
- "BugReports": "https://github.com/RevolutionAnalytics/foreach/issues",
- "Depends": [
- "R (>= 2.5.0)"
- ],
- "Imports": [
- "codetools",
- "utils",
- "iterators"
- ],
- "Suggests": [
- "randomForest",
- "doMC",
- "doParallel",
- "testthat",
- "knitr",
- "rmarkdown"
- ],
- "VignetteBuilder": "knitr",
- "RoxygenNote": "7.1.1",
- "Collate": "'callCombine.R' 'foreach.R' 'do.R' 'foreach-ext.R' 'foreach-pkg.R' 'getDoPar.R' 'getDoSeq.R' 'getsyms.R' 'iter.R' 'nextElem.R' 'onLoad.R' 'setDoPar.R' 'setDoSeq.R' 'times.R' 'utils.R'",
- "NeedsCompilation": "no",
- "Author": "Folashade Daniel [cre], Hong Ooi [ctb], Rich Calaway [ctb], Microsoft [aut, cph], Steve Weston [aut]",
- "Maintainer": "Folashade Daniel ",
- "Repository": "CRAN"
- },
- "forecast": {
- "Package": "forecast",
- "Version": "8.24.0",
- "Source": "Repository",
- "Title": "Forecasting Functions for Time Series and Linear Models",
- "Description": "Methods and tools for displaying and analysing univariate time series forecasts including exponential smoothing via state space models and automatic ARIMA modelling.",
- "Depends": [
- "R (>= 3.5.0)"
- ],
- "Imports": [
- "colorspace",
- "fracdiff",
- "generics (>= 0.1.2)",
- "ggplot2 (>= 2.2.1)",
- "graphics",
- "lmtest",
- "magrittr",
- "nnet",
- "parallel",
- "Rcpp (>= 0.11.0)",
- "stats",
- "timeDate",
- "tseries",
- "urca",
- "withr",
- "zoo"
- ],
- "Suggests": [
- "forecTheta",
- "knitr",
- "methods",
- "rmarkdown",
- "rticles",
- "scales",
- "seasonal",
- "testthat (>= 3.0.0)",
- "uroot"
- ],
- "LinkingTo": [
- "Rcpp (>= 0.11.0)",
- "RcppArmadillo (>= 0.2.35)"
- ],
- "LazyData": "yes",
- "ByteCompile": "TRUE",
- "Authors@R": "c( person(\"Rob\", \"Hyndman\", email = \"Rob.Hyndman@monash.edu\", role = c(\"aut\", \"cre\", \"cph\"), comment = c(ORCID = \"0000-0002-2140-5352\")), person(\"George\", \"Athanasopoulos\", role = \"aut\", comment = c(ORCID = \"0000-0002-5389-2802\")), person(\"Christoph\", \"Bergmeir\", role = \"aut\", comment = c(ORCID = \"0000-0002-3665-9021\")), person(\"Gabriel\", \"Caceres\", role = \"aut\", comment = c(ORCID = \"0000-0002-2947-2023\")), person(\"Leanne\", \"Chhay\", role = \"aut\"), person(\"Kirill\", \"Kuroptev\", role = \"aut\"), person(\"Mitchell\", \"O'Hara-Wild\", role = \"aut\", comment = c(ORCID = \"0000-0001-6729-7695\")), person(\"Fotios\", \"Petropoulos\", role = \"aut\", comment = c(ORCID = \"0000-0003-3039-4955\")), person(\"Slava\", \"Razbash\", role = \"aut\"), person(\"Earo\", \"Wang\", role = \"aut\", comment = c(ORCID = \"0000-0001-6448-5260\")), person(\"Farah\", \"Yasmeen\", role = \"aut\", comment = c(ORCID = \"0000-0002-1479-5401\")), person(\"Federico\", \"Garza\", role = \"ctb\"), person(\"Daniele\", \"Girolimetto\", role = \"ctb\"), person(\"Ross\", \"Ihaka\", role = c(\"ctb\", \"cph\")), person(\"R Core Team\", role = c(\"ctb\", \"cph\")), person(\"Daniel\", \"Reid\", role = \"ctb\"), person(\"David\", \"Shaub\", role = \"ctb\"), person(\"Yuan\", \"Tang\", role = \"ctb\", comment = c(ORCID = \"0000-0001-5243-233X\")), person(\"Xiaoqian\", \"Wang\", role = \"ctb\"), person(\"Zhenyu\", \"Zhou\", role = \"ctb\") )",
- "BugReports": "https://github.com/robjhyndman/forecast/issues",
- "License": "GPL-3",
- "URL": "https://pkg.robjhyndman.com/forecast/, https://github.com/robjhyndman/forecast",
- "VignetteBuilder": "knitr",
- "Encoding": "UTF-8",
- "RoxygenNote": "7.3.2",
- "Config/testthat/edition": "3",
- "NeedsCompilation": "yes",
- "Author": "Rob Hyndman [aut, cre, cph] (), George Athanasopoulos [aut] (), Christoph Bergmeir [aut] (), Gabriel Caceres [aut] (), Leanne Chhay [aut], Kirill Kuroptev [aut], Mitchell O'Hara-Wild [aut] (), Fotios Petropoulos [aut] (), Slava Razbash [aut], Earo Wang [aut] (), Farah Yasmeen [aut] (), Federico Garza [ctb], Daniele Girolimetto [ctb], Ross Ihaka [ctb, cph], R Core Team [ctb, cph], Daniel Reid [ctb], David Shaub [ctb], Yuan Tang [ctb] (), Xiaoqian Wang [ctb], Zhenyu Zhou [ctb]",
- "Maintainer": "Rob Hyndman ",
- "Repository": "CRAN"
- },
- "fracdiff": {
- "Package": "fracdiff",
- "Version": "1.5-3",
- "Source": "Repository",
- "VersionNote": "Released 1.5-0 on 2019-12-09, 1.5-1 on 2020-01-20, 1.5-2 on 2022-10-31",
- "Date": "2024-02-01",
- "Title": "Fractionally Differenced ARIMA aka ARFIMA(P,d,q) Models",
- "Authors@R": "c(person(\"Martin\",\"Maechler\", role=c(\"aut\",\"cre\"), email=\"maechler@stat.math.ethz.ch\", comment = c(ORCID = \"0000-0002-8685-9910\")) , person(\"Chris\", \"Fraley\", role=c(\"ctb\",\"cph\"), comment = \"S original; Fortran code\") , person(\"Friedrich\", \"Leisch\", role = \"ctb\", comment = c(\"R port\", ORCID = \"0000-0001-7278-1983\")) , person(\"Valderio\", \"Reisen\", role=\"ctb\", comment = \"fdGPH() & fdSperio()\") , person(\"Artur\", \"Lemonte\", role=\"ctb\", comment = \"fdGPH() & fdSperio()\") , person(\"Rob\", \"Hyndman\", email=\"Rob.Hyndman@monash.edu\", role=\"ctb\", comment = c(\"residuals() & fitted()\", ORCID = \"0000-0002-2140-5352\")) )",
- "Description": "Maximum likelihood estimation of the parameters of a fractionally differenced ARIMA(p,d,q) model (Haslett and Raftery, Appl.Statistics, 1989); including inference and basic methods. Some alternative algorithms to estimate \"H\".",
- "Imports": [
- "stats"
- ],
- "Suggests": [
- "longmemo",
- "forecast",
- "urca"
- ],
- "License": "GPL (>= 2)",
- "URL": "https://github.com/mmaechler/fracdiff",
- "BugReports": "https://github.com/mmaechler/fracdiff/issues",
- "Encoding": "UTF-8",
- "NeedsCompilation": "yes",
- "Author": "Martin Maechler [aut, cre] (), Chris Fraley [ctb, cph] (S original; Fortran code), Friedrich Leisch [ctb] (R port, ), Valderio Reisen [ctb] (fdGPH() & fdSperio()), Artur Lemonte [ctb] (fdGPH() & fdSperio()), Rob Hyndman [ctb] (residuals() & fitted(), )",
- "Maintainer": "Martin Maechler ",
- "Repository": "CRAN"
- },
"fs": {
"Package": "fs",
"Version": "1.6.5",
@@ -2563,41 +1953,6 @@
"Maintainer": "Henrik Bengtsson ",
"Repository": "CRAN"
},
- "future.apply": {
- "Package": "future.apply",
- "Version": "1.11.3",
- "Source": "Repository",
- "Title": "Apply Function to Elements in Parallel using Futures",
- "Depends": [
- "R (>= 3.2.0)",
- "future (>= 1.28.0)"
- ],
- "Imports": [
- "globals (>= 0.16.1)",
- "parallel",
- "utils"
- ],
- "Suggests": [
- "datasets",
- "stats",
- "tools",
- "listenv (>= 0.8.0)",
- "R.rsp",
- "markdown"
- ],
- "VignetteBuilder": "R.rsp",
- "Authors@R": "c(person(\"Henrik\", \"Bengtsson\", role = c(\"aut\", \"cre\", \"cph\"), email = \"henrikb@braju.com\", comment = c(ORCID = \"0000-0002-7579-5165\")), person(\"R Core Team\", role = c(\"cph\", \"ctb\")))",
- "Description": "Implementations of apply(), by(), eapply(), lapply(), Map(), .mapply(), mapply(), replicate(), sapply(), tapply(), and vapply() that can be resolved using any future-supported backend, e.g. parallel on the local machine or distributed on a compute cluster. These future_*apply() functions come with the same pros and cons as the corresponding base-R *apply() functions but with the additional feature of being able to be processed via the future framework .",
- "License": "GPL (>= 2)",
- "LazyLoad": "TRUE",
- "URL": "https://future.apply.futureverse.org, https://github.com/futureverse/future.apply",
- "BugReports": "https://github.com/futureverse/future.apply/issues",
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "no",
- "Author": "Henrik Bengtsson [aut, cre, cph] (), R Core Team [cph, ctb]",
- "Maintainer": "Henrik Bengtsson ",
- "Repository": "CRAN"
- },
"gargle": {
"Package": "gargle",
"Version": "1.5.2",
@@ -2859,6 +2214,57 @@
"Maintainer": "Thomas Lin Pedersen ",
"Repository": "CRAN"
},
+ "ggspatial": {
+ "Package": "ggspatial",
+ "Version": "1.1.10",
+ "Source": "Repository",
+ "Type": "Package",
+ "Title": "Spatial Data Framework for ggplot2",
+ "Authors@R": "c( person(\"Dewey\", \"Dunnington\", email = \"dewey@fishandwhistle.net\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-9415-4582\") ), person(\"Brent\", \"Thorne\", role = \"ctb\", comment = c(ORCID = \"0000-0002-1099-3857\")), person(\"Diego\", \"Hernangómez\", role = \"ctb\", comment = c(ORCID = \"0000-0001-8457-4658\")) )",
+ "Maintainer": "Dewey Dunnington ",
+ "Description": "Spatial data plus the power of the ggplot2 framework means easier mapping when input data are already in the form of spatial objects.",
+ "License": "GPL-3",
+ "Depends": [
+ "R (>= 2.10)"
+ ],
+ "Imports": [
+ "sf",
+ "ggplot2 (>= 3.0.0)",
+ "rosm (>= 0.2)",
+ "abind",
+ "methods",
+ "tibble",
+ "scales",
+ "tidyr",
+ "rlang",
+ "grid",
+ "glue"
+ ],
+ "Suggests": [
+ "prettymapr",
+ "knitr",
+ "rmarkdown",
+ "sp",
+ "raster",
+ "terra",
+ "testthat (>= 3.0.0)",
+ "dplyr",
+ "withr",
+ "ggrepel",
+ "stars",
+ "covr",
+ "vdiffr",
+ "lwgeom"
+ ],
+ "URL": "https://paleolimbot.github.io/ggspatial/, https://github.com/paleolimbot/ggspatial",
+ "BugReports": "https://github.com/paleolimbot/ggspatial/issues",
+ "RoxygenNote": "7.3.2",
+ "Encoding": "UTF-8",
+ "Config/testthat/edition": "3",
+ "NeedsCompilation": "no",
+ "Author": "Dewey Dunnington [aut, cre] (ORCID: ), Brent Thorne [ctb] (ORCID: ), Diego Hernangómez [ctb] (ORCID: )",
+ "Repository": "CRAN"
+ },
"globals": {
"Package": "globals",
"Version": "0.16.3",
@@ -3024,57 +2430,6 @@
"Maintainer": "Jennifer Bryan ",
"Repository": "CRAN"
},
- "gower": {
- "Package": "gower",
- "Version": "1.0.2",
- "Source": "Repository",
- "Maintainer": "Mark van der Loo ",
- "License": "GPL-3",
- "Title": "Gower's Distance",
- "Type": "Package",
- "LazyLoad": "yes",
- "Authors@R": "c( person(\"Mark\", \"van der Loo\", role=c(\"aut\",\"cre\"),email=\"mark.vanderloo@gmail.com\") , person(\"David\", \"Turner\", role=\"ctb\"))",
- "Description": "Compute Gower's distance (or similarity) coefficient between records. Compute the top-n matches between records. Core algorithms are executed in parallel on systems supporting OpenMP.",
- "URL": "https://github.com/markvanderloo/gower",
- "BugReports": "https://github.com/markvanderloo/gower/issues",
- "Suggests": [
- "tinytest (>= 0.9.3)"
- ],
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "yes",
- "Author": "Mark van der Loo [aut, cre], David Turner [ctb]",
- "Repository": "CRAN"
- },
- "gridExtra": {
- "Package": "gridExtra",
- "Version": "2.3",
- "Source": "Repository",
- "Authors@R": "c(person(\"Baptiste\", \"Auguie\", email = \"baptiste.auguie@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Anton\", \"Antonov\", email = \"tonytonov@gmail.com\", role = c(\"ctb\")))",
- "License": "GPL (>= 2)",
- "Title": "Miscellaneous Functions for \"Grid\" Graphics",
- "Type": "Package",
- "Description": "Provides a number of user-level functions to work with \"grid\" graphics, notably to arrange multiple grid-based plots on a page, and draw tables.",
- "VignetteBuilder": "knitr",
- "Imports": [
- "gtable",
- "grid",
- "grDevices",
- "graphics",
- "utils"
- ],
- "Suggests": [
- "ggplot2",
- "egg",
- "lattice",
- "knitr",
- "testthat"
- ],
- "RoxygenNote": "6.0.1",
- "NeedsCompilation": "no",
- "Author": "Baptiste Auguie [aut, cre], Anton Antonov [ctb]",
- "Maintainer": "Baptiste Auguie ",
- "Repository": "CRAN"
- },
"gtable": {
"Package": "gtable",
"Version": "0.3.6",
@@ -3115,52 +2470,6 @@
"Maintainer": "Thomas Lin Pedersen ",
"Repository": "CRAN"
},
- "hardhat": {
- "Package": "hardhat",
- "Version": "1.4.1",
- "Source": "Repository",
- "Title": "Construct Modeling Packages",
- "Authors@R": "c( person(\"Hannah\", \"Frick\", , \"hannah@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-6049-5258\")), person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = \"aut\"), person(\"Max\", \"Kuhn\", , \"max@posit.co\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
- "Description": "Building modeling packages is hard. A large amount of effort generally goes into providing an implementation for a new method that is efficient, fast, and correct, but often less emphasis is put on the user interface. A good interface requires specialized knowledge about S3 methods and formulas, which the average package developer might not have. The goal of 'hardhat' is to reduce the burden around building new modeling packages by providing functionality for preprocessing, predicting, and validating input.",
- "License": "MIT + file LICENSE",
- "URL": "https://github.com/tidymodels/hardhat, https://hardhat.tidymodels.org",
- "BugReports": "https://github.com/tidymodels/hardhat/issues",
- "Depends": [
- "R (>= 3.5.0)"
- ],
- "Imports": [
- "cli (>= 3.6.0)",
- "glue (>= 1.6.2)",
- "rlang (>= 1.1.0)",
- "sparsevctrs (>= 0.2.0)",
- "tibble (>= 3.2.1)",
- "vctrs (>= 0.6.0)"
- ],
- "Suggests": [
- "covr",
- "crayon",
- "devtools",
- "knitr",
- "Matrix",
- "modeldata (>= 0.0.2)",
- "recipes (>= 1.0.5)",
- "rmarkdown (>= 2.3)",
- "roxygen2",
- "testthat (>= 3.0.0)",
- "usethis (>= 2.1.5)",
- "withr (>= 3.0.0)"
- ],
- "VignetteBuilder": "knitr",
- "Config/Needs/website": "tidyverse/tidytemplate",
- "Config/testthat/edition": "3",
- "Encoding": "UTF-8",
- "LazyData": "true",
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "no",
- "Author": "Hannah Frick [aut, cre] (), Davis Vaughan [aut], Max Kuhn [aut], Posit Software, PBC [cph, fnd]",
- "Maintainer": "Hannah Frick ",
- "Repository": "CRAN"
- },
"haven": {
"Package": "haven",
"Version": "2.5.4",
@@ -3248,6 +2557,42 @@
"Maintainer": "Kirill Müller ",
"Repository": "CRAN"
},
+ "hexbin": {
+ "Package": "hexbin",
+ "Version": "1.28.5",
+ "Source": "Repository",
+ "Title": "Hexagonal Binning Routines",
+ "Authors@R": "c(person(given = \"Dan\", family = \"Carr\", role = \"aut\", email = \"dcarr@voxel.galaxy.gmu.edu\"), person(given = c(\"Nicholas\"), family = \"Lewin-Koh\", role = \"aut\"), person(given = \"Martin\", family = \"Maechler\", role = \"aut\", email = \"maechler@stat.math.ethz.ch\"), person(given = \"Deepayan\", family = \"Sarkar\", role = \"aut\", email = \"deepayan.sarkar@r-project.org\"), person(given = \"Edzer\", family = \"Pebesma\", role = \"cre\", comment = c(ORCID = \"0000-0001-8049-7069\"), email = \"edzer.pebesma@uni-muenster.de\"))",
+ "Depends": [
+ "R (>= 2.0.1)",
+ "methods"
+ ],
+ "Imports": [
+ "lattice",
+ "grid",
+ "graphics",
+ "grDevices",
+ "stats",
+ "utils"
+ ],
+ "Suggests": [
+ "marray",
+ "affy",
+ "Biobase",
+ "limma",
+ "knitr"
+ ],
+ "Description": "Binning and plotting functions for hexagonal bins.",
+ "Collate": "lattice.R BTC.R BTY.R grid.hexagons.R grid.hexlegend.R hbox.R hdiffplot.R hexbinList.R hexbinplot.R hexbin.s4.R hexpanel.R hexplom.R hexPlotMA.R hexutil.R hexViewport.R HO.R LINGRAY.R LOCS.R MAG.R RB.R smoothHexbin.R",
+ "License": "GPL-2",
+ "VignetteBuilder": "knitr",
+ "NeedsCompilation": "yes",
+ "URL": "https://github.com/edzer/hexbin",
+ "Author": "Dan Carr [aut], Nicholas Lewin-Koh [aut], Martin Maechler [aut], Deepayan Sarkar [aut], Edzer Pebesma [cre] ()",
+ "Maintainer": "Edzer Pebesma ",
+ "Repository": "CRAN",
+ "Encoding": "UTF-8"
+ },
"highr": {
"Package": "highr",
"Version": "0.11",
@@ -3496,38 +2841,6 @@
"Maintainer": "Rich FitzJohn ",
"Repository": "CRAN"
},
- "ipred": {
- "Package": "ipred",
- "Version": "0.9-15",
- "Source": "Repository",
- "Title": "Improved Predictors",
- "Date": "2024-07-18",
- "Authors@R": "c(person(\"Andrea\", \"Peters\", role = \"aut\"), person(\"Torsten\", \"Hothorn\", role = c(\"aut\", \"cre\"), email = \"Torsten.Hothorn@R-project.org\"), person(\"Brian D.\", \"Ripley\", role = \"ctb\"), person(\"Terry\", \"Therneau\", role = \"ctb\"), person(\"Beth\", \"Atkinson\", role = \"ctb\"))",
- "Description": "Improved predictive models by indirect classification and bagging for classification, regression and survival problems as well as resampling based estimators of prediction error.",
- "Depends": [
- "R (>= 2.10)"
- ],
- "Imports": [
- "rpart (>= 3.1-8)",
- "MASS",
- "survival",
- "nnet",
- "class",
- "prodlim"
- ],
- "Suggests": [
- "mvtnorm",
- "mlbench",
- "TH.data",
- "randomForest",
- "party"
- ],
- "License": "GPL (>= 2)",
- "NeedsCompilation": "yes",
- "Author": "Andrea Peters [aut], Torsten Hothorn [aut, cre], Brian D. Ripley [ctb], Terry Therneau [ctb], Beth Atkinson [ctb]",
- "Maintainer": "Torsten Hothorn ",
- "Repository": "CRAN"
- },
"isoband": {
"Package": "isoband",
"Version": "0.2.7",
@@ -3564,28 +2877,25 @@
"Maintainer": "Hadley Wickham ",
"Repository": "CRAN"
},
- "iterators": {
- "Package": "iterators",
- "Version": "1.0.14",
+ "jpeg": {
+ "Package": "jpeg",
+ "Version": "0.1-11",
"Source": "Repository",
- "Type": "Package",
- "Title": "Provides Iterator Construct",
- "Authors@R": "c(person(\"Folashade\", \"Daniel\", role=\"cre\", email=\"fdaniel@microsoft.com\"), person(\"Revolution\", \"Analytics\", role=c(\"aut\", \"cph\")), person(\"Steve\", \"Weston\", role=\"aut\"))",
- "Description": "Support for iterators, which allow a programmer to traverse through all the elements of a vector, list, or other collection of data.",
- "URL": "https://github.com/RevolutionAnalytics/iterators",
+ "Title": "Read and write JPEG images",
+ "Author": "Simon Urbanek [aut, cre, cph] (https://urbanek.org, )",
+ "Authors@R": "person(\"Simon\", \"Urbanek\", role=c(\"aut\",\"cre\",\"cph\"), email=\"Simon.Urbanek@r-project.org\", comment=c(\"https://urbanek.org\", ORCID=\"0000-0003-2297-1732\"))",
+ "Maintainer": "Simon Urbanek ",
"Depends": [
- "R (>= 2.5.0)",
- "utils"
+ "R (>= 2.9.0)"
],
- "Suggests": [
- "RUnit",
- "foreach"
- ],
- "License": "Apache License (== 2.0)",
- "NeedsCompilation": "no",
- "Author": "Folashade Daniel [cre], Revolution Analytics [aut, cph], Steve Weston [aut]",
- "Maintainer": "Folashade Daniel ",
- "Repository": "CRAN"
+ "Description": "This package provides an easy and simple way to read, write and display bitmap images stored in the JPEG format. It can read and write both files and in-memory raw vectors.",
+ "License": "GPL-2 | GPL-3",
+ "SystemRequirements": "libjpeg",
+ "URL": "https://www.rforge.net/jpeg/",
+ "BugReports": "https://github.com/s-u/jpeg/issues",
+ "NeedsCompilation": "yes",
+ "Repository": "CRAN",
+ "Encoding": "UTF-8"
},
"jquerylib": {
"Package": "jquerylib",
@@ -3829,68 +3139,6 @@
"Maintainer": "Deepayan Sarkar ",
"Repository": "CRAN"
},
- "lava": {
- "Package": "lava",
- "Version": "1.8.1",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Latent Variable Models",
- "Authors@R": "c(person(\"Klaus K.\", \"Holst\", email=\"klaus@holst.it\", role=c(\"aut\", \"cre\")), person(\"Brice\", \"Ozenne\", role = \"ctb\"), person(\"Thomas\", \"Gerds\", role = \"ctb\"))",
- "Author": "Klaus K. Holst [aut, cre], Brice Ozenne [ctb], Thomas Gerds [ctb]",
- "Maintainer": "Klaus K. Holst ",
- "Description": "A general implementation of Structural Equation Models with latent variables (MLE, 2SLS, and composite likelihood estimators) with both continuous, censored, and ordinal outcomes (Holst and Budtz-Joergensen (2013) ). Mixture latent variable models and non-linear latent variable models (Holst and Budtz-Joergensen (2020) ). The package also provides methods for graph exploration (d-separation, back-door criterion), simulation of general non-linear latent variable models, and estimation of influence functions for a broad range of statistical models.",
- "URL": "https://kkholst.github.io/lava/",
- "BugReports": "https://github.com/kkholst/lava/issues",
- "License": "GPL-3",
- "LazyLoad": "yes",
- "Depends": [
- "R (>= 3.0)"
- ],
- "Imports": [
- "cli",
- "future.apply",
- "graphics",
- "grDevices",
- "methods",
- "numDeriv",
- "progressr",
- "stats",
- "survival",
- "SQUAREM",
- "utils"
- ],
- "Suggests": [
- "KernSmooth",
- "Rgraphviz",
- "data.table",
- "ellipse",
- "fields",
- "geepack",
- "graph",
- "knitr",
- "rmarkdown",
- "igraph (>= 0.6)",
- "lavaSearch2",
- "lme4 (>= 1.1.35.1)",
- "MASS",
- "Matrix (>= 1.6.3)",
- "mets (>= 1.1)",
- "nlme",
- "optimx",
- "polycor",
- "quantreg",
- "rgl",
- "targeted (>= 0.4)",
- "testthat (>= 0.11)",
- "visNetwork"
- ],
- "VignetteBuilder": "knitr,rmarkdown",
- "ByteCompile": "yes",
- "Encoding": "UTF-8",
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "no",
- "Repository": "CRAN"
- },
"lazyeval": {
"Package": "lazyeval",
"Version": "0.2.2",
@@ -4200,38 +3448,6 @@
"Maintainer": "Henrik Bengtsson ",
"Repository": "CRAN"
},
- "lmtest": {
- "Package": "lmtest",
- "Version": "0.9-40",
- "Source": "Repository",
- "Title": "Testing Linear Regression Models",
- "Date": "2022-03-21",
- "Authors@R": "c(person(given = \"Torsten\", family = \"Hothorn\", role = \"aut\", email = \"Torsten.Hothorn@R-project.org\", comment = c(ORCID = \"0000-0001-8301-0471\")), person(given = \"Achim\", family = \"Zeileis\", role = c(\"aut\", \"cre\"), email = \"Achim.Zeileis@R-project.org\", comment = c(ORCID = \"0000-0003-0918-3766\")), person(given = c(\"Richard\", \"W.\"), family = \"Farebrother\", role = \"aut\", comment = \"pan.f\"), person(given = \"Clint\", family = \"Cummins\", role = \"aut\", comment = \"pan.f\"), person(given = \"Giovanni\", family = \"Millo\", role = \"ctb\"), person(given = \"David\", family = \"Mitchell\", role = \"ctb\"))",
- "Description": "A collection of tests, data sets, and examples for diagnostic checking in linear regression models. Furthermore, some generic tools for inference in parametric models are provided.",
- "LazyData": "yes",
- "Depends": [
- "R (>= 3.0.0)",
- "stats",
- "zoo"
- ],
- "Suggests": [
- "car",
- "strucchange",
- "sandwich",
- "dynlm",
- "stats4",
- "survival",
- "AER"
- ],
- "Imports": [
- "graphics"
- ],
- "License": "GPL-2 | GPL-3",
- "NeedsCompilation": "yes",
- "Author": "Torsten Hothorn [aut] (), Achim Zeileis [aut, cre] (), Richard W. Farebrother [aut] (pan.f), Clint Cummins [aut] (pan.f), Giovanni Millo [ctb], David Mitchell [ctb]",
- "Maintainer": "Achim Zeileis ",
- "Repository": "CRAN"
- },
"logger": {
"Package": "logger",
"Version": "0.4.0",
@@ -4584,50 +3800,6 @@
"Maintainer": "R Core Team ",
"Repository": "CRAN"
},
- "nnet": {
- "Package": "nnet",
- "Version": "7.3-19",
- "Source": "Repository",
- "Priority": "recommended",
- "Date": "2023-05-02",
- "Depends": [
- "R (>= 3.0.0)",
- "stats",
- "utils"
- ],
- "Suggests": [
- "MASS"
- ],
- "Authors@R": "c(person(\"Brian\", \"Ripley\", role = c(\"aut\", \"cre\", \"cph\"), email = \"ripley@stats.ox.ac.uk\"), person(\"William\", \"Venables\", role = \"cph\"))",
- "Description": "Software for feed-forward neural networks with a single hidden layer, and for multinomial log-linear models.",
- "Title": "Feed-Forward Neural Networks and Multinomial Log-Linear Models",
- "ByteCompile": "yes",
- "License": "GPL-2 | GPL-3",
- "URL": "http://www.stats.ox.ac.uk/pub/MASS4/",
- "NeedsCompilation": "yes",
- "Author": "Brian Ripley [aut, cre, cph], William Venables [cph]",
- "Maintainer": "Brian Ripley ",
- "Repository": "CRAN"
- },
- "numDeriv": {
- "Package": "numDeriv",
- "Version": "2016.8-1.1",
- "Source": "Repository",
- "Title": "Accurate Numerical Derivatives",
- "Description": "Methods for calculating (usually) accurate numerical first and second order derivatives. Accurate calculations are done using 'Richardson''s' extrapolation or, when applicable, a complex step derivative is available. A simple difference method is also provided. Simple difference is (usually) less accurate but is much quicker than 'Richardson''s' extrapolation and provides a useful cross-check. Methods are provided for real scalar and vector valued functions.",
- "Depends": [
- "R (>= 2.11.1)"
- ],
- "LazyLoad": "yes",
- "ByteCompile": "yes",
- "License": "GPL-2",
- "Copyright": "2006-2011, Bank of Canada. 2012-2016, Paul Gilbert",
- "Author": "Paul Gilbert and Ravi Varadhan",
- "Maintainer": "Paul Gilbert ",
- "URL": "http://optimizer.r-forge.r-project.org/",
- "NeedsCompilation": "no",
- "Repository": "CRAN"
- },
"officer": {
"Package": "officer",
"Version": "0.7.0",
@@ -4705,47 +3877,6 @@
"Maintainer": "Jeroen Ooms ",
"Repository": "CRAN"
},
- "pROC": {
- "Package": "pROC",
- "Version": "1.18.5",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Display and Analyze ROC Curves",
- "Date": "2023-11-01",
- "Encoding": "UTF-8",
- "Depends": [
- "R (>= 2.14)"
- ],
- "Imports": [
- "methods",
- "plyr",
- "Rcpp (>= 0.11.1)"
- ],
- "Suggests": [
- "microbenchmark",
- "tcltk",
- "MASS",
- "logcondens",
- "doParallel",
- "testthat",
- "vdiffr",
- "ggplot2",
- "rlang"
- ],
- "LinkingTo": [
- "Rcpp"
- ],
- "Authors@R": "c(person(\"Xavier\", \"Robin\", role = c(\"cre\", \"aut\"), email = \"pROC-cran@xavier.robin.name\", comment = c(ORCID = \"0000-0002-6813-3200\")), person(\"Natacha\", \"Turck\", role = \"aut\"), person(\"Alexandre\", \"Hainard\", role = \"aut\"), person(\"Natalia\", \"Tiberti\", role = \"aut\"), person(\"Frédérique\", \"Lisacek\", role = \"aut\"), person(\"Jean-Charles\", \"Sanchez\", role = \"aut\"), person(\"Markus\", \"Müller\", role = \"aut\"), person(\"Stefan\", \"Siegert\", role = \"ctb\", comment = \"Fast DeLong code\", email = \"stefan_siegert@gmx.de\"), person(\"Matthias\", \"Doering\", role = \"ctb\", comment = \"Hand & Till Multiclass\"), person(\"Zane\", \"Billings\", role = \"ctb\", comment = \"DeLong paired test CI\"))",
- "Description": "Tools for visualizing, smoothing and comparing receiver operating characteristic (ROC curves). (Partial) area under the curve (AUC) can be compared with statistical tests based on U-statistics or bootstrap. Confidence intervals can be computed for (p)AUC or ROC curves.",
- "License": "GPL (>= 3)",
- "URL": "https://xrobin.github.io/pROC/",
- "BugReports": "https://github.com/xrobin/pROC/issues",
- "LazyData": "yes",
- "NeedsCompilation": "yes",
- "Author": "Xavier Robin [cre, aut] (), Natacha Turck [aut], Alexandre Hainard [aut], Natalia Tiberti [aut], Frédérique Lisacek [aut], Jean-Charles Sanchez [aut], Markus Müller [aut], Stefan Siegert [ctb] (Fast DeLong code), Matthias Doering [ctb] (Hand & Till Multiclass), Zane Billings [ctb] (DeLong paired test CI)",
- "Maintainer": "Xavier Robin ",
- "Repository": "CRAN"
- },
"parallelly": {
"Package": "parallelly",
"Version": "1.43.0",
@@ -4775,50 +3906,6 @@
"Maintainer": "Henrik Bengtsson ",
"Repository": "CRAN"
},
- "patchwork": {
- "Package": "patchwork",
- "Version": "1.3.2",
- "Source": "Repository",
- "Type": "Package",
- "Title": "The Composer of Plots",
- "Authors@R": "person(given = \"Thomas Lin\", family = \"Pedersen\", role = c(\"cre\", \"aut\"), email = \"thomasp85@gmail.com\", comment = c(ORCID = \"0000-0002-5147-4711\"))",
- "Maintainer": "Thomas Lin Pedersen ",
- "Description": "The 'ggplot2' package provides a strong API for sequentially building up a plot, but does not concern itself with composition of multiple plots. 'patchwork' is a package that expands the API to allow for arbitrarily complex composition of plots by, among others, providing mathematical operators for combining multiple plots. Other packages that try to address this need (but with a different approach) are 'gridExtra' and 'cowplot'.",
- "License": "MIT + file LICENSE",
- "Encoding": "UTF-8",
- "Imports": [
- "ggplot2 (>= 3.0.0)",
- "gtable (>= 0.3.6)",
- "grid",
- "stats",
- "grDevices",
- "utils",
- "graphics",
- "rlang (>= 1.0.0)",
- "cli",
- "farver"
- ],
- "RoxygenNote": "7.3.2",
- "URL": "https://patchwork.data-imaginist.com, https://github.com/thomasp85/patchwork",
- "BugReports": "https://github.com/thomasp85/patchwork/issues",
- "Suggests": [
- "knitr",
- "rmarkdown",
- "gridGraphics",
- "gridExtra",
- "ragg",
- "testthat (>= 2.1.0)",
- "vdiffr",
- "covr",
- "png",
- "gt (>= 0.11.0)"
- ],
- "VignetteBuilder": "knitr",
- "Config/Needs/website": "gifski",
- "NeedsCompilation": "no",
- "Author": "Thomas Lin Pedersen [cre, aut] (ORCID: )",
- "Repository": "CRAN"
- },
"pillar": {
"Package": "pillar",
"Version": "1.10.2",
@@ -4900,43 +3987,6 @@
"NeedsCompilation": "no",
"Repository": "CRAN"
},
- "plyr": {
- "Package": "plyr",
- "Version": "1.8.9",
- "Source": "Repository",
- "Title": "Tools for Splitting, Applying and Combining Data",
- "Authors@R": "person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", role = c(\"aut\", \"cre\"))",
- "Description": "A set of tools that solves a common set of problems: you need to break a big problem down into manageable pieces, operate on each piece and then put all the pieces back together. For example, you might want to fit a model to each spatial location or time point in your study, summarise data by panels or collapse high-dimensional arrays to simpler summary statistics. The development of 'plyr' has been generously supported by 'Becton Dickinson'.",
- "License": "MIT + file LICENSE",
- "URL": "http://had.co.nz/plyr, https://github.com/hadley/plyr",
- "BugReports": "https://github.com/hadley/plyr/issues",
- "Depends": [
- "R (>= 3.1.0)"
- ],
- "Imports": [
- "Rcpp (>= 0.11.0)"
- ],
- "Suggests": [
- "abind",
- "covr",
- "doParallel",
- "foreach",
- "iterators",
- "itertools",
- "tcltk",
- "testthat"
- ],
- "LinkingTo": [
- "Rcpp"
- ],
- "Encoding": "UTF-8",
- "LazyData": "true",
- "RoxygenNote": "7.2.3",
- "NeedsCompilation": "yes",
- "Author": "Hadley Wickham [aut, cre]",
- "Maintainer": "Hadley Wickham ",
- "Repository": "CRAN"
- },
"png": {
"Package": "png",
"Version": "0.1-8",
@@ -5019,37 +4069,6 @@
"Maintainer": "Gábor Csárdi ",
"Repository": "CRAN"
},
- "prodlim": {
- "Package": "prodlim",
- "Version": "2024.06.25",
- "Source": "Repository",
- "Title": "Product-Limit Estimation for Censored Event History Analysis",
- "Author": "Thomas A. Gerds",
- "Description": "Fast and user friendly implementation of nonparametric estimators for censored event history (survival) analysis. Kaplan-Meier and Aalen-Johansen method.",
- "Depends": [
- "R (>= 2.9.0)"
- ],
- "Imports": [
- "Rcpp (>= 0.11.5)",
- "stats",
- "data.table",
- "grDevices",
- "graphics",
- "diagram",
- "survival",
- "KernSmooth",
- "lava"
- ],
- "LinkingTo": [
- "Rcpp"
- ],
- "Maintainer": "Thomas A. Gerds ",
- "BugReports": "https://github.com/tagteam/prodlim/issues",
- "License": "GPL (>= 2)",
- "RoxygenNote": "7.3.1",
- "NeedsCompilation": "yes",
- "Repository": "CRAN"
- },
"progress": {
"Package": "progress",
"Version": "1.2.3",
@@ -5083,53 +4102,6 @@
"Maintainer": "Gábor Csárdi ",
"Repository": "CRAN"
},
- "progressr": {
- "Package": "progressr",
- "Version": "0.15.1",
- "Source": "Repository",
- "Title": "An Inclusive, Unifying API for Progress Updates",
- "Description": "A minimal, unifying API for scripts and packages to report progress updates from anywhere including when using parallel processing. The package is designed such that the developer can to focus on what progress should be reported on without having to worry about how to present it. The end user has full control of how, where, and when to render these progress updates, e.g. in the terminal using utils::txtProgressBar(), cli::cli_progress_bar(), in a graphical user interface using utils::winProgressBar(), tcltk::tkProgressBar() or shiny::withProgress(), via the speakers using beepr::beep(), or on a file system via the size of a file. Anyone can add additional, customized, progression handlers. The 'progressr' package uses R's condition framework for signaling progress updated. Because of this, progress can be reported from almost anywhere in R, e.g. from classical for and while loops, from map-reduce API:s like the lapply() family of functions, 'purrr', 'plyr', and 'foreach'. It will also work with parallel processing via the 'future' framework, e.g. future.apply::future_lapply(), furrr::future_map(), and 'foreach' with 'doFuture'. The package is compatible with Shiny applications.",
- "Authors@R": "c(person(\"Henrik\", \"Bengtsson\", role = c(\"aut\", \"cre\", \"cph\"), email = \"henrikb@braju.com\", comment = c(ORCID = \"0000-0002-7579-5165\")))",
- "License": "GPL (>= 3)",
- "Depends": [
- "R (>= 3.5.0)"
- ],
- "Imports": [
- "digest",
- "utils"
- ],
- "Suggests": [
- "graphics",
- "tcltk",
- "beepr",
- "cli",
- "crayon",
- "pbmcapply",
- "progress",
- "purrr",
- "foreach",
- "plyr",
- "doFuture",
- "future",
- "future.apply",
- "furrr",
- "ntfy",
- "RPushbullet",
- "rstudioapi",
- "shiny",
- "commonmark",
- "base64enc",
- "tools"
- ],
- "VignetteBuilder": "progressr",
- "URL": "https://progressr.futureverse.org, https://github.com/futureverse/progressr",
- "BugReports": "https://github.com/futureverse/progressr/issues",
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "no",
- "Author": "Henrik Bengtsson [aut, cre, cph] ()",
- "Maintainer": "Henrik Bengtsson ",
- "Repository": "CRAN"
- },
"promises": {
"Package": "promises",
"Version": "1.3.2",
@@ -5282,60 +4254,6 @@
"Maintainer": "Hadley Wickham ",
"Repository": "CRAN"
},
- "quadprog": {
- "Package": "quadprog",
- "Version": "1.5-8",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Functions to Solve Quadratic Programming Problems",
- "Date": "2019-11-20",
- "Author": "S original by Berwin A. Turlach R port by Andreas Weingessel Fortran contributions from Cleve Moler (dposl/LINPACK and (a modified version of) dpodi/LINPACK)",
- "Maintainer": "Berwin A. Turlach ",
- "Description": "This package contains routines and documentation for solving quadratic programming problems.",
- "Depends": [
- "R (>= 3.1.0)"
- ],
- "License": "GPL (>= 2)",
- "NeedsCompilation": "yes",
- "Repository": "CRAN"
- },
- "quantmod": {
- "Package": "quantmod",
- "Version": "0.4.28",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Quantitative Financial Modelling Framework",
- "Authors@R": "c( person(given=c(\"Jeffrey\",\"A.\"), family=\"Ryan\", role=c(\"aut\",\"cph\")), person(given=c(\"Joshua\",\"M.\"), family=\"Ulrich\", role=c(\"cre\",\"aut\"), email=\"josh.m.ulrich@gmail.com\"), person(given=c(\"Ethan\",\"B.\"), family=\"Smith\", role=\"ctb\"), person(given=\"Wouter\", family=\"Thielen\", role=\"ctb\"), person(given=\"Paul\", family=\"Teetor\", role=\"ctb\"), person(given=\"Steve\", family=\"Bronder\", role=\"ctb\") )",
- "Depends": [
- "R (>= 3.2.0)",
- "xts(>= 0.9-0)",
- "zoo",
- "TTR(>= 0.2)",
- "methods"
- ],
- "Imports": [
- "curl",
- "jsonlite(>= 1.1)"
- ],
- "Suggests": [
- "DBI",
- "RMySQL",
- "RSQLite",
- "timeSeries",
- "xml2",
- "downloader",
- "tinytest"
- ],
- "Description": "Specify, build, trade, and analyse quantitative financial trading strategies.",
- "LazyLoad": "yes",
- "License": "GPL-3",
- "URL": "https://www.quantmod.com/, https://github.com/joshuaulrich/quantmod",
- "BugReports": "https://github.com/joshuaulrich/quantmod/issues",
- "NeedsCompilation": "no",
- "Author": "Jeffrey A. Ryan [aut, cph], Joshua M. Ulrich [cre, aut], Ethan B. Smith [ctb], Wouter Thielen [ctb], Paul Teetor [ctb], Steve Bronder [ctb]",
- "Maintainer": "Joshua M. Ulrich ",
- "Repository": "CRAN"
- },
"ragg": {
"Package": "ragg",
"Version": "1.3.3",
@@ -5371,29 +4289,6 @@
"Author": "Thomas Lin Pedersen [cre, aut] (), Maxim Shemanarev [aut, cph] (Author of AGG), Tony Juricic [ctb, cph] (Contributor to AGG), Milan Marusinec [ctb, cph] (Contributor to AGG), Spencer Garrett [ctb] (Contributor to AGG), Posit, PBC [cph, fnd]",
"Repository": "CRAN"
},
- "randomForest": {
- "Package": "randomForest",
- "Version": "4.7-1.2",
- "Source": "Repository",
- "Title": "Breiman and Cutlers Random Forests for Classification and Regression",
- "Date": "2022-01-24",
- "Depends": [
- "R (>= 4.1.0)",
- "stats"
- ],
- "Suggests": [
- "RColorBrewer",
- "MASS"
- ],
- "Authors@R": "c(person(\"Leo\", \"Breiman\", role = \"aut\", comment = \"Fortran original\"), person(\"Adele\", \"Cutler\", role = \"aut\", comment = \"Fortran original\"), person(\"Andy\", \"Liaw\", role = c(\"aut\", \"cre\"), email = \"andy_liaw@merck.com\", comment = \"R port\"), person(\"Matthew\", \"Wiener\", role = \"aut\", comment = \"R port\"))",
- "Description": "Classification and regression based on a forest of trees using random inputs, based on Breiman (2001) .",
- "License": "GPL (>= 2)",
- "URL": "https://www.stat.berkeley.edu/~breiman/RandomForests/",
- "NeedsCompilation": "yes",
- "Repository": "CRAN",
- "Author": "Leo Breiman [aut] (Fortran original), Adele Cutler [aut] (Fortran original), Andy Liaw [aut, cre] (R port), Matthew Wiener [aut] (R port)",
- "Maintainer": "Andy Liaw "
- },
"rapidjsonr": {
"Package": "rapidjsonr",
"Version": "1.2.0",
@@ -5484,34 +4379,6 @@
"Maintainer": "Robert J. Hijmans ",
"Repository": "CRAN"
},
- "rbibutils": {
- "Package": "rbibutils",
- "Version": "2.4",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Read 'Bibtex' Files and Convert Between Bibliography Formats",
- "Authors@R": "c( person(given = c(\"Georgi\", \"N.\"), family = \"Boshnakov\", role = c(\"aut\", \"cre\"), \t email = \"georgi.boshnakov@manchester.ac.uk\", comment = c(\"R port, R code, new C code and modifications to bibutils' C code, conversion to Bibentry (R and C code)\", comment = c(ORCID = \"0000-0003-2839-346X\")) ), person(given = \"Chris\", family = \"Putman\", role = \"aut\", comment = \"src/*, author of the bibutils libraries, https://sourceforge.net/projects/bibutils/\"), person(given = \"Richard\", family = \"Mathar\", role = \"ctb\", comment = \"src/addsout.c\"), person(given = \"Johannes\", family = \"Wilm\", role = \"ctb\", comment = \"src/biblatexin.c, src/bltypes.c\"), person(\"R Core Team\", role = \"ctb\", comment = \"base R's bibentry and bibstyle implementation\") )",
- "Description": "Read and write 'Bibtex' files. Convert between bibliography formats, including 'Bibtex', 'Biblatex', 'PubMed', 'Endnote', and 'Bibentry'. Includes a port of the 'bibutils' utilities by Chris Putnam . Supports all bibliography formats and character encodings implemented in 'bibutils'.",
- "License": "GPL-2",
- "URL": "https://geobosh.github.io/rbibutils/ (doc), https://github.com/GeoBosh/rbibutils (devel)",
- "BugReports": "https://github.com/GeoBosh/rbibutils/issues",
- "Depends": [
- "R (>= 2.10)"
- ],
- "Imports": [
- "utils",
- "tools"
- ],
- "Suggests": [
- "testthat"
- ],
- "Encoding": "UTF-8",
- "NeedsCompilation": "yes",
- "Config/Needs/memcheck": "devtools, rcmdcheck",
- "Author": "Georgi N. Boshnakov [aut, cre] (R port, R code, new C code and modifications to bibutils' C code, conversion to Bibentry (R and C code), comment.ORCID: 0000-0003-2839-346X), Chris Putman [aut] (src/*, author of the bibutils libraries, https://sourceforge.net/projects/bibutils/), Richard Mathar [ctb] (src/addsout.c), Johannes Wilm [ctb] (src/biblatexin.c, src/bltypes.c), R Core Team [ctb] (base R's bibentry and bibstyle implementation)",
- "Maintainer": "Georgi N. Boshnakov ",
- "Repository": "CRAN"
- },
"readr": {
"Package": "readr",
"Version": "2.1.5",
@@ -5608,77 +4475,6 @@
"Maintainer": "Jennifer Bryan ",
"Repository": "CRAN"
},
- "recipes": {
- "Package": "recipes",
- "Version": "1.2.1",
- "Source": "Repository",
- "Title": "Preprocessing and Feature Engineering Steps for Modeling",
- "Authors@R": "c( person(\"Max\", \"Kuhn\", , \"max@posit.co\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Emil\", \"Hvitfeldt\", , \"emil.hvitfeldt@posit.co\", role = \"aut\"), person(given = \"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
- "Description": "A recipe prepares your data for modeling. We provide an extensible framework for pipeable sequences of feature engineering steps provides preprocessing tools to be applied to data. Statistical parameters for the steps can be estimated from an initial data set and then applied to other data sets. The resulting processed output can then be used as inputs for statistical or machine learning models.",
- "License": "MIT + file LICENSE",
- "URL": "https://github.com/tidymodels/recipes, https://recipes.tidymodels.org/",
- "BugReports": "https://github.com/tidymodels/recipes/issues",
- "Depends": [
- "dplyr (>= 1.1.0)",
- "R (>= 3.6)"
- ],
- "Imports": [
- "cli",
- "clock (>= 0.6.1)",
- "generics (>= 0.1.2)",
- "glue",
- "gower",
- "hardhat (>= 1.4.1)",
- "ipred (>= 0.9-12)",
- "lifecycle (>= 1.0.3)",
- "lubridate (>= 1.8.0)",
- "magrittr",
- "Matrix",
- "purrr (>= 1.0.0)",
- "rlang (>= 1.1.0)",
- "sparsevctrs (>= 0.3.0)",
- "stats",
- "tibble",
- "tidyr (>= 1.0.0)",
- "tidyselect (>= 1.2.0)",
- "timeDate",
- "utils",
- "vctrs (>= 0.5.0)",
- "withr"
- ],
- "Suggests": [
- "covr",
- "ddalpha",
- "dials (>= 1.2.0)",
- "ggplot2",
- "igraph",
- "kernlab",
- "knitr",
- "methods",
- "modeldata (>= 0.1.1)",
- "parsnip (>= 1.2.0)",
- "RANN",
- "RcppRoll",
- "rmarkdown",
- "rpart",
- "rsample",
- "RSpectra",
- "splines2",
- "testthat (>= 3.0.0)",
- "workflows",
- "xml2"
- ],
- "VignetteBuilder": "knitr",
- "RdMacros": "lifecycle",
- "Config/Needs/website": "tidyverse/tidytemplate",
- "Config/testthat/edition": "3",
- "Encoding": "UTF-8",
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "no",
- "Author": "Max Kuhn [aut, cre], Hadley Wickham [aut], Emil Hvitfeldt [aut], Posit Software, PBC [cph, fnd]",
- "Maintainer": "Max Kuhn ",
- "Repository": "CRAN"
- },
"rematch": {
"Package": "rematch",
"Version": "2.0.0",
@@ -5829,89 +4625,6 @@
"Maintainer": "Jennifer Bryan ",
"Repository": "CRAN"
},
- "reshape2": {
- "Package": "reshape2",
- "Version": "1.4.4",
- "Source": "Repository",
- "Title": "Flexibly Reshape Data: A Reboot of the Reshape Package",
- "Author": "Hadley Wickham ",
- "Maintainer": "Hadley Wickham ",
- "Description": "Flexibly restructure and aggregate data using just two functions: melt and 'dcast' (or 'acast').",
- "License": "MIT + file LICENSE",
- "URL": "https://github.com/hadley/reshape",
- "BugReports": "https://github.com/hadley/reshape/issues",
- "Depends": [
- "R (>= 3.1)"
- ],
- "Imports": [
- "plyr (>= 1.8.1)",
- "Rcpp",
- "stringr"
- ],
- "Suggests": [
- "covr",
- "lattice",
- "testthat (>= 0.8.0)"
- ],
- "LinkingTo": [
- "Rcpp"
- ],
- "Encoding": "UTF-8",
- "LazyData": "true",
- "RoxygenNote": "7.1.0",
- "NeedsCompilation": "yes",
- "Repository": "CRAN"
- },
- "reticulate": {
- "Package": "reticulate",
- "Version": "1.43.0",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Interface to 'Python'",
- "Authors@R": "c( person(\"Tomasz\", \"Kalinowski\", role = c(\"ctb\", \"cre\"), email = \"tomasz@posit.co\"), person(\"Kevin\", \"Ushey\", role = c(\"aut\"), email = \"kevin@posit.co\"), person(\"JJ\", \"Allaire\", role = c(\"aut\"), email = \"jj@posit.co\"), person(\"RStudio\", role = c(\"cph\", \"fnd\")), person(\"Yuan\", \"Tang\", role = c(\"aut\", \"cph\"), email = \"terrytangyuan@gmail.com\", comment = c(ORCID = \"0000-0001-5243-233X\")), person(\"Dirk\", \"Eddelbuettel\", role = c(\"ctb\", \"cph\"), email = \"edd@debian.org\"), person(\"Bryan\", \"Lewis\", role = c(\"ctb\", \"cph\"), email = \"blewis@illposed.net\"), person(\"Sigrid\", \"Keydana\", role = c(\"ctb\"), email = \"sigrid@posit.co\"), person(\"Ryan\", \"Hafen\", role = c(\"ctb\", \"cph\"), email = \"rhafen@gmail.com\"), person(\"Marcus\", \"Geelnard\", role = c(\"ctb\", \"cph\"), comment = \"TinyThread library, http://tinythreadpp.bitsnbites.eu/\") )",
- "Description": "Interface to 'Python' modules, classes, and functions. When calling into 'Python', R data types are automatically converted to their equivalent 'Python' types. When values are returned from 'Python' to R they are converted back to R types. Compatible with all versions of 'Python' >= 2.7.",
- "License": "Apache License 2.0",
- "URL": "https://rstudio.github.io/reticulate/, https://github.com/rstudio/reticulate",
- "BugReports": "https://github.com/rstudio/reticulate/issues",
- "SystemRequirements": "Python (>= 2.7.0)",
- "Encoding": "UTF-8",
- "Depends": [
- "R (>= 3.5)"
- ],
- "Imports": [
- "Matrix",
- "Rcpp (>= 1.0.7)",
- "RcppTOML",
- "graphics",
- "here",
- "jsonlite",
- "methods",
- "png",
- "rappdirs",
- "utils",
- "rlang",
- "withr"
- ],
- "Suggests": [
- "callr",
- "knitr",
- "glue",
- "cli",
- "rmarkdown",
- "pillar",
- "testthat"
- ],
- "LinkingTo": [
- "Rcpp"
- ],
- "RoxygenNote": "7.3.2",
- "VignetteBuilder": "knitr",
- "Config/build/compilation-database": "true",
- "NeedsCompilation": "yes",
- "Author": "Tomasz Kalinowski [ctb, cre], Kevin Ushey [aut], JJ Allaire [aut], RStudio [cph, fnd], Yuan Tang [aut, cph] (ORCID: ), Dirk Eddelbuettel [ctb, cph], Bryan Lewis [ctb, cph], Sigrid Keydana [ctb], Ryan Hafen [ctb, cph], Marcus Geelnard [ctb, cph] (TinyThread library, http://tinythreadpp.bitsnbites.eu/)",
- "Maintainer": "Tomasz Kalinowski ",
- "Repository": "CRAN"
- },
"rlang": {
"Package": "rlang",
"Version": "1.1.5",
@@ -6016,33 +4729,47 @@
"Maintainer": "Yihui Xie ",
"Repository": "CRAN"
},
- "rpart": {
- "Package": "rpart",
- "Version": "4.1.23",
+ "rosm": {
+ "Package": "rosm",
+ "Version": "0.3.1",
"Source": "Repository",
- "Priority": "recommended",
- "Date": "2023-12-04",
- "Authors@R": "c(person(\"Terry\", \"Therneau\", role = \"aut\", email = \"therneau@mayo.edu\"), person(\"Beth\", \"Atkinson\", role = c(\"aut\", \"cre\"), email = \"atkinson@mayo.edu\"), person(\"Brian\", \"Ripley\", role = \"trl\", email = \"ripley@stats.ox.ac.uk\", comment = \"producer of the initial R port, maintainer 1999-2017\"))",
- "Description": "Recursive partitioning for classification, regression and survival trees. An implementation of most of the functionality of the 1984 book by Breiman, Friedman, Olshen and Stone.",
- "Title": "Recursive Partitioning and Regression Trees",
- "Depends": [
- "R (>= 2.15.0)",
- "graphics",
- "stats",
- "grDevices"
+ "Type": "Package",
+ "Title": "Plot Raster Map Tiles from Open Street Map and Other Sources",
+ "Encoding": "UTF-8",
+ "Authors@R": "c(person(\"Dewey\", \"Dunnington\", role = c(\"aut\", \"cre\"), email = \"dewey@fishandwhistle.net\", comment = c(ORCID = \"0000-0002-9415-4582\")), person(\"Timothée\", \"Giraud\", role = \"ctb\"))",
+ "Maintainer": "Dewey Dunnington ",
+ "Description": "Download and plot Open Street Map , Bing Maps and other tiled map sources. Use to create basemaps quickly and add hillshade to vector-based maps.",
+ "License": "GPL-2",
+ "Imports": [
+ "curl",
+ "jpeg",
+ "png",
+ "wk",
+ "glue",
+ "progress",
+ "rlang"
],
"Suggests": [
- "survival"
+ "sp",
+ "plyr",
+ "raster",
+ "testthat (>= 3.0.0)",
+ "withr",
+ "sf",
+ "terra",
+ "abind",
+ "methods",
+ "jsonlite",
+ "tiff",
+ "vdiffr"
],
- "License": "GPL-2 | GPL-3",
- "LazyData": "yes",
- "ByteCompile": "yes",
- "NeedsCompilation": "yes",
- "Author": "Terry Therneau [aut], Beth Atkinson [aut, cre], Brian Ripley [trl] (producer of the initial R port, maintainer 1999-2017)",
- "Maintainer": "Beth Atkinson ",
- "Repository": "CRAN",
- "URL": "https://github.com/bethatkinson/rpart, https://cran.r-project.org/package=rpart",
- "BugReports": "https://github.com/bethatkinson/rpart/issues"
+ "URL": "https://github.com/paleolimbot/rosm",
+ "BugReports": "https://github.com/paleolimbot/rosm/issues",
+ "RoxygenNote": "7.3.3",
+ "Config/testthat/edition": "3",
+ "NeedsCompilation": "no",
+ "Author": "Dewey Dunnington [aut, cre] (ORCID: ), Timothée Giraud [ctb]",
+ "Repository": "CRAN"
},
"rprojroot": {
"Package": "rprojroot",
@@ -6076,61 +4803,6 @@
"Maintainer": "Kirill Müller ",
"Repository": "CRAN"
},
- "rsample": {
- "Package": "rsample",
- "Version": "1.3.0",
- "Source": "Repository",
- "Title": "General Resampling Infrastructure",
- "Authors@R": "c( person(\"Hannah\", \"Frick\", , \"hannah@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-6049-5258\")), person(\"Fanny\", \"Chow\", , \"fannybchow@gmail.com\", role = \"aut\"), person(\"Max\", \"Kuhn\", , \"max@posit.co\", role = \"aut\"), person(\"Michael\", \"Mahoney\", , \"mike.mahoney.218@gmail.com\", role = c(\"aut\"), comment = c(ORCID = \"0000-0003-2402-304X\")), person(\"Julia\", \"Silge\", , \"julia.silge@posit.co\", role = c(\"aut\"), comment = c(ORCID = \"0000-0002-3671-836X\")), person(\"Hadley\", \"Wickham\", , \"hadley@posit.co\", role = \"aut\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
- "Description": "Classes and functions to create and summarize different types of resampling objects (e.g. bootstrap, cross-validation).",
- "License": "MIT + file LICENSE",
- "URL": "https://rsample.tidymodels.org, https://github.com/tidymodels/rsample",
- "BugReports": "https://github.com/tidymodels/rsample/issues",
- "Depends": [
- "R (>= 3.6)"
- ],
- "Imports": [
- "cli",
- "dplyr (>= 1.1.1)",
- "furrr",
- "generics",
- "glue",
- "lifecycle",
- "methods",
- "pillar",
- "purrr (>= 1.0.0)",
- "rlang (>= 1.1.0)",
- "slider (>= 0.1.5)",
- "tibble",
- "tidyr",
- "tidyselect",
- "vctrs (>= 0.5.0)"
- ],
- "Suggests": [
- "broom",
- "covr",
- "ggplot2",
- "knitr",
- "modeldata",
- "recipes (>= 0.1.4)",
- "rmarkdown",
- "stats",
- "testthat (>= 3.0.0)",
- "utils",
- "whisker",
- "withr",
- "xml2"
- ],
- "VignetteBuilder": "knitr",
- "Config/Needs/website": "GGally, nlstools, tidymodels, tidyverse/tidytemplate",
- "Encoding": "UTF-8",
- "RoxygenNote": "7.3.2",
- "Config/testthat/edition": "3",
- "NeedsCompilation": "no",
- "Author": "Hannah Frick [aut, cre] (), Fanny Chow [aut], Max Kuhn [aut], Michael Mahoney [aut] (), Julia Silge [aut] (), Hadley Wickham [aut], Posit Software, PBC [cph, fnd]",
- "Maintainer": "Hannah Frick ",
- "Repository": "CRAN"
- },
"rstudioapi": {
"Package": "rstudioapi",
"Version": "0.17.1",
@@ -6241,48 +4913,6 @@
"Maintainer": "Edzer Pebesma ",
"Repository": "CRAN"
},
- "sandwich": {
- "Package": "sandwich",
- "Version": "3.1-1",
- "Source": "Repository",
- "Date": "2024-09-16",
- "Title": "Robust Covariance Matrix Estimators",
- "Authors@R": "c(person(given = \"Achim\", family = \"Zeileis\", role = c(\"aut\", \"cre\"), email = \"Achim.Zeileis@R-project.org\", comment = c(ORCID = \"0000-0003-0918-3766\")), person(given = \"Thomas\", family = \"Lumley\", role = \"aut\", email = \"t.lumley@auckland.ac.nz\", comment = c(ORCID = \"0000-0003-4255-5437\")), person(given = \"Nathaniel\", family = \"Graham\", role = \"ctb\", email = \"npgraham1@gmail.com\", comment = c(ORCID = \"0009-0002-1215-5256\")), person(given = \"Susanne\", family = \"Koell\", role = \"ctb\"))",
- "Description": "Object-oriented software for model-robust covariance matrix estimators. Starting out from the basic robust Eicker-Huber-White sandwich covariance methods include: heteroscedasticity-consistent (HC) covariances for cross-section data; heteroscedasticity- and autocorrelation-consistent (HAC) covariances for time series data (such as Andrews' kernel HAC, Newey-West, and WEAVE estimators); clustered covariances (one-way and multi-way); panel and panel-corrected covariances; outer-product-of-gradients covariances; and (clustered) bootstrap covariances. All methods are applicable to (generalized) linear model objects fitted by lm() and glm() but can also be adapted to other classes through S3 methods. Details can be found in Zeileis et al. (2020) , Zeileis (2004) and Zeileis (2006) .",
- "Depends": [
- "R (>= 3.0.0)"
- ],
- "Imports": [
- "stats",
- "utils",
- "zoo"
- ],
- "Suggests": [
- "AER",
- "car",
- "geepack",
- "lattice",
- "lme4",
- "lmtest",
- "MASS",
- "multiwayvcov",
- "parallel",
- "pcse",
- "plm",
- "pscl",
- "scatterplot3d",
- "stats4",
- "strucchange",
- "survival"
- ],
- "License": "GPL-2 | GPL-3",
- "URL": "https://sandwich.R-Forge.R-project.org/",
- "BugReports": "https://sandwich.R-Forge.R-project.org/contact.html",
- "NeedsCompilation": "no",
- "Author": "Achim Zeileis [aut, cre] (), Thomas Lumley [aut] (), Nathaniel Graham [ctb] (), Susanne Koell [ctb]",
- "Maintainer": "Achim Zeileis ",
- "Repository": "CRAN"
- },
"sass": {
"Package": "sass",
"Version": "0.4.9",
@@ -6541,26 +5171,6 @@
"Maintainer": "David Cooley ",
"Repository": "CRAN"
},
- "shape": {
- "Package": "shape",
- "Version": "1.4.6.1",
- "Source": "Repository",
- "Title": "Functions for Plotting Graphical Shapes, Colors",
- "Author": "Karline Soetaert ",
- "Maintainer": "Karline Soetaert ",
- "Depends": [
- "R (>= 2.01)"
- ],
- "Imports": [
- "stats",
- "graphics",
- "grDevices"
- ],
- "Description": "Functions for plotting graphical shapes such as ellipses, circles, cylinders, arrows, ...",
- "License": "GPL (>= 3)",
- "NeedsCompilation": "no",
- "Repository": "CRAN"
- },
"shiny": {
"Package": "shiny",
"Version": "1.10.0",
@@ -6630,49 +5240,6 @@
"Maintainer": "Winston Chang ",
"Repository": "CRAN"
},
- "slider": {
- "Package": "slider",
- "Version": "0.3.2",
- "Source": "Repository",
- "Title": "Sliding Window Functions",
- "Authors@R": "c( person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
- "Description": "Provides type-stable rolling window functions over any R data type. Cumulative and expanding windows are also supported. For more advanced usage, an index can be used as a secondary vector that defines how sliding windows are to be created.",
- "License": "MIT + file LICENSE",
- "URL": "https://github.com/r-lib/slider, https://slider.r-lib.org",
- "BugReports": "https://github.com/r-lib/slider/issues",
- "Depends": [
- "R (>= 4.0.0)"
- ],
- "Imports": [
- "cli (>= 3.6.1)",
- "rlang (>= 1.1.1)",
- "vctrs (>= 0.6.3)",
- "warp"
- ],
- "Suggests": [
- "covr",
- "dplyr (>= 1.0.0)",
- "knitr",
- "lubridate",
- "rmarkdown",
- "testthat (>= 3.0.0)"
- ],
- "LinkingTo": [
- "vctrs (>= 0.6.3)"
- ],
- "VignetteBuilder": "knitr",
- "Config/build/compilation-database": "true",
- "Config/Needs/website": "tidyverse/tidytemplate",
- "Config/testthat/edition": "3",
- "Config/usethis/last-upkeep": "2024-10-25",
- "Encoding": "UTF-8",
- "RoxygenNote": "7.3.2",
- "Collate": "'arithmetic.R' 'block.R' 'conditions.R' 'hop-common.R' 'hop-index-common.R' 'hop-index.R' 'hop-index2.R' 'hop.R' 'hop2.R' 'phop-index.R' 'phop.R' 'slide-index2.R' 'pslide-index.R' 'slide-period2.R' 'pslide-period.R' 'slide2.R' 'pslide.R' 'segment-tree.R' 'slide-common.R' 'slide-index-common.R' 'slide-index.R' 'slide-period-common.R' 'slide-period.R' 'slide.R' 'slider-package.R' 'summary-index.R' 'summary-slide.R' 'utils.R' 'zzz.R'",
- "NeedsCompilation": "yes",
- "Author": "Davis Vaughan [aut, cre], Posit Software, PBC [cph, fnd]",
- "Maintainer": "Davis Vaughan ",
- "Repository": "CRAN"
- },
"sourcetools": {
"Package": "sourcetools",
"Version": "0.1.7-1",
@@ -6802,43 +5369,6 @@
"NeedsCompilation": "no",
"Author": "Glenn Davis [aut, cre]"
},
- "sparsevctrs": {
- "Package": "sparsevctrs",
- "Version": "0.3.2",
- "Source": "Repository",
- "Title": "Sparse Vectors for Use in Data Frames",
- "Authors@R": "c( person(\"Emil\", \"Hvitfeldt\", , \"emil.hvitfeldt@posit.co\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-0679-1945\")), person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
- "Description": "Provides sparse vectors powered by ALTREP (Alternative Representations for R Objects) that behave like regular vectors, and can thus be used in data frames. Also provides tools to convert between sparse matrices and data frames with sparse columns and functions to interact with sparse vectors.",
- "License": "MIT + file LICENSE",
- "URL": "https://github.com/r-lib/sparsevctrs, https://r-lib.github.io/sparsevctrs/",
- "BugReports": "https://github.com/r-lib/sparsevctrs/issues",
- "Depends": [
- "R (>= 4.0.0)"
- ],
- "Imports": [
- "cli (>= 3.4.0)",
- "rlang (>= 1.1.0)",
- "vctrs"
- ],
- "Suggests": [
- "knitr",
- "Matrix",
- "methods",
- "rmarkdown",
- "testthat (>= 3.0.0)",
- "tibble",
- "withr"
- ],
- "VignetteBuilder": "knitr",
- "Config/Needs/website": "tidyverse/tidytemplate, rmarkdown, lobstr, ggplot2, bench, tidyr, ggbeeswarm",
- "Config/testthat/edition": "3",
- "Encoding": "UTF-8",
- "RoxygenNote": "7.3.2",
- "NeedsCompilation": "yes",
- "Author": "Emil Hvitfeldt [aut, cre] (), Davis Vaughan [ctb], Posit Software, PBC [cph, fnd]",
- "Maintainer": "Emil Hvitfeldt ",
- "Repository": "CRAN"
- },
"spdep": {
"Package": "spdep",
"Version": "1.4-1",
@@ -7078,80 +5608,6 @@
"Maintainer": "Hadley Wickham ",
"Repository": "CRAN"
},
- "strucchangeRcpp": {
- "Package": "strucchangeRcpp",
- "Version": "1.5-4-1.0.1",
- "Source": "Repository",
- "Title": "Testing, Monitoring, and Dating Structural Changes: C++ Version",
- "Authors@R": "c(person(given = \"Dainius\", family = \"Masiliunas\", role = c(\"aut\", \"cre\"), email = \"pastas4@gmail.com\", comment = c(ORCID = \"0000-0001-5654-1277\")), person(given = \"Achim\", family = \"Zeileis\", role = c(\"aut\"), email = \"Achim.Zeileis@R-project.org\", comment = c(ORCID = \"0000-0003-0918-3766\")), person(given = \"Marius\", family = \"Appel\", role = \"aut\", email = \"marius.appel@uni-muenster.de\"), person(given = \"Friedrich\", family = \"Leisch\", role = \"aut\", email = \"Friedrich.Leisch@R-project.org\"), person(given = \"Kurt\", family = \"Hornik\", role = \"aut\", email = \"Kurt.Hornik@R-project.org\"), person(given = \"Christian\", family = \"Kleiber\", role = \"aut\", email = \"Christian.Kleiber@unibas.ch\"), person(given = \"Andrei\", family = \"Mirt\", role = \"ctb\", email = \"andrei.mirt@wur.nl\", comment = c(ORCID = \"0000-0003-3654-2090\")), person(given = \"Bruce\", family = \"Hansen\", role = \"ctb\"), person(given = c(\"Edgar\", \"C.\"), family = \"Merkle\", role = \"ctb\"), person(given = \"Nikolaus\", family = \"Umlauf\", role = \"ctb\"))",
- "Description": "A fast implementation with additional experimental features for testing, monitoring and dating structural changes in (linear) regression models. 'strucchangeRcpp' features tests/methods from the generalized fluctuation test framework as well as from the F test (Chow test) framework. This includes methods to fit, plot and test fluctuation processes (e.g. cumulative/moving sum, recursive/moving estimates) and F statistics, respectively. These methods are described in Zeileis et al. (2002) . Finally, the breakpoints in regression models with structural changes can be estimated together with confidence intervals, and their magnitude as well as the model fit can be evaluated using a variety of statistical measures.",
- "LazyData": "yes",
- "LinkingTo": [
- "Rcpp",
- "RcppArmadillo"
- ],
- "Depends": [
- "R (>= 2.10.0)",
- "zoo",
- "sandwich"
- ],
- "Suggests": [
- "stats4",
- "car",
- "dynlm",
- "e1071",
- "foreach",
- "lmtest",
- "mvtnorm",
- "tseries",
- "bfast"
- ],
- "Imports": [
- "graphics",
- "stats",
- "Rcpp (>= 0.12.7)",
- "utils"
- ],
- "License": "GPL-2 | GPL-3",
- "URL": "https://github.com/bfast2/strucchangeRcpp/",
- "BugReports": "https://github.com/bfast2/strucchangeRcpp/issues",
- "RoxygenNote": "7.1.1",
- "Encoding": "UTF-8",
- "NeedsCompilation": "yes",
- "Author": "Dainius Masiliunas [aut, cre] (ORCID: ), Achim Zeileis [aut] (ORCID: ), Marius Appel [aut], Friedrich Leisch [aut], Kurt Hornik [aut], Christian Kleiber [aut], Andrei Mirt [ctb] (ORCID: ), Bruce Hansen [ctb], Edgar C. Merkle [ctb], Nikolaus Umlauf [ctb]",
- "Maintainer": "Dainius Masiliunas ",
- "Repository": "CRAN"
- },
- "survival": {
- "Package": "survival",
- "Version": "3.7-0",
- "Source": "Repository",
- "Title": "Survival Analysis",
- "Priority": "recommended",
- "Date": "2024-06-01",
- "Depends": [
- "R (>= 3.5.0)"
- ],
- "Imports": [
- "graphics",
- "Matrix",
- "methods",
- "splines",
- "stats",
- "utils"
- ],
- "LazyData": "Yes",
- "LazyDataCompression": "xz",
- "ByteCompile": "Yes",
- "Authors@R": "c(person(c(\"Terry\", \"M\"), \"Therneau\", email=\"therneau.terry@mayo.edu\", role=c(\"aut\", \"cre\")), person(\"Thomas\", \"Lumley\", role=c(\"ctb\", \"trl\"), comment=\"original S->R port and R maintainer until 2009\"), person(\"Atkinson\", \"Elizabeth\", role=\"ctb\"), person(\"Crowson\", \"Cynthia\", role=\"ctb\"))",
- "Description": "Contains the core survival analysis routines, including definition of Surv objects, Kaplan-Meier and Aalen-Johansen (multi-state) curves, Cox models, and parametric accelerated failure time models.",
- "License": "LGPL (>= 2)",
- "URL": "https://github.com/therneau/survival",
- "NeedsCompilation": "yes",
- "Author": "Terry M Therneau [aut, cre], Thomas Lumley [ctb, trl] (original S->R port and R maintainer until 2009), Atkinson Elizabeth [ctb], Crowson Cynthia [ctb]",
- "Maintainer": "Terry M Therneau ",
- "Repository": "CRAN"
- },
"sys": {
"Package": "sys",
"Version": "3.4.3",
@@ -7533,34 +5989,6 @@
"Maintainer": "Hadley Wickham ",
"Repository": "CRAN"
},
- "timeDate": {
- "Package": "timeDate",
- "Version": "4041.110",
- "Source": "Repository",
- "Title": "Rmetrics - Chronological and Calendar Objects",
- "Authors@R": "c(person(\"Diethelm\", \"Wuertz\", role=\"aut\", comment = \"original code\") , person(\"Tobias\", \"Setz\", role = c(\"aut\"), email = \"tobias.setz@live.com\") , person(\"Yohan\", \"Chalabi\", role = \"aut\") , person(\"Martin\",\"Maechler\", role = \"ctb\", email = \"maechler@stat.math.ethz.ch\", comment = c(ORCID = \"0000-0002-8685-9910\")) , person(given = c(\"Joe\", \"W.\"), family = \"Byers\", role = \"ctb\") , person(given = c(\"Georgi\", \"N.\"), family = \"Boshnakov\", role = c(\"cre\", \"aut\"), email = \"georgi.boshnakov@manchester.ac.uk\") )",
- "Description": "The 'timeDate' class fulfils the conventions of the ISO 8601 standard as well as of the ANSI C and POSIX standards. Beyond these standards it provides the \"Financial Center\" concept which allows to handle data records collected in different time zones and mix them up to have always the proper time stamps with respect to your personal financial center, or alternatively to the GMT reference time. It can thus also handle time stamps from historical data records from the same time zone, even if the financial centers changed day light saving times at different calendar dates.",
- "Depends": [
- "R (>= 3.6.0)",
- "methods"
- ],
- "Imports": [
- "graphics",
- "utils",
- "stats"
- ],
- "Suggests": [
- "RUnit"
- ],
- "License": "GPL (>= 2)",
- "Encoding": "UTF-8",
- "URL": "https://geobosh.github.io/timeDateDoc/ (doc), https://r-forge.r-project.org/scm/viewvc.php/pkg/timeDate/?root=rmetrics (devel), https://www.rmetrics.org",
- "BugReports": "https://r-forge.r-project.org/projects/rmetrics",
- "NeedsCompilation": "no",
- "Author": "Diethelm Wuertz [aut] (original code), Tobias Setz [aut], Yohan Chalabi [aut], Martin Maechler [ctb] (), Joe W. Byers [ctb], Georgi N. Boshnakov [cre, aut]",
- "Maintainer": "Georgi N. Boshnakov ",
- "Repository": "CRAN"
- },
"timechange": {
"Package": "timechange",
"Version": "0.3.0",
@@ -7724,56 +6152,6 @@
"Maintainer": "Martijn Tennekes ",
"Repository": "CRAN"
},
- "tseries": {
- "Package": "tseries",
- "Version": "0.10-58",
- "Source": "Repository",
- "Title": "Time Series Analysis and Computational Finance",
- "Authors@R": "c(person(\"Adrian\", \"Trapletti\", role = \"aut\", email = \"adrian@trapletti.org\"), person(\"Kurt\", \"Hornik\", role = c(\"aut\", \"cre\"), email = \"Kurt.Hornik@R-project.org\", comment = c(ORCID = \"0000-0003-4198-9911\")), person(\"Blake\", \"LeBaron\", role = \"ctb\", comment = \"BDS test code\"))",
- "Description": "Time series analysis and computational finance.",
- "Depends": [
- "R (>= 3.4.0)"
- ],
- "Imports": [
- "graphics",
- "stats",
- "utils",
- "quadprog",
- "zoo",
- "quantmod (>= 0.4-9)",
- "jsonlite"
- ],
- "License": "GPL-2 | GPL-3",
- "NeedsCompilation": "yes",
- "Author": "Adrian Trapletti [aut], Kurt Hornik [aut, cre] (), Blake LeBaron [ctb] (BDS test code)",
- "Maintainer": "Kurt Hornik ",
- "Repository": "CRAN"
- },
- "twosamples": {
- "Package": "twosamples",
- "Version": "2.0.1",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Fast Permutation Based Two Sample Tests",
- "Authors@R": "person(\"Connor\", \"Dowd\", , \"cd@codowd.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-9782-0931\"))",
- "Description": "Fast randomization based two sample tests. Testing the hypothesis that two samples come from the same distribution using randomization to create p-values. Included tests are: Kolmogorov-Smirnov, Kuiper, Cramer-von Mises, Anderson-Darling, Wasserstein, and DTS. The default test (two_sample) is based on the DTS test statistic, as it is the most powerful, and thus most useful to most users. The DTS test statistic builds on the Wasserstein distance by using a weighting scheme like that of Anderson-Darling. See the companion paper at or for details of that test statistic, and non-standard uses of the package (parallel for big N, weighted observations, one sample tests, etc). We also include the permutation scheme to make test building simple for others.",
- "License": "GPL (>= 2)",
- "Encoding": "UTF-8",
- "LinkingTo": [
- "cpp11"
- ],
- "RoxygenNote": "7.2.3",
- "URL": "https://twosampletest.com, https://github.com/cdowd/twosamples",
- "BugReports": "https://github.com/cdowd/twosamples/issues",
- "Suggests": [
- "testthat (>= 3.0.0)"
- ],
- "Config/testthat/edition": "3",
- "NeedsCompilation": "yes",
- "Author": "Connor Dowd [aut, cre] ()",
- "Maintainer": "Connor Dowd ",
- "Repository": "CRAN"
- },
"tzdb": {
"Package": "tzdb",
"Version": "0.5.0",
@@ -7847,30 +6225,6 @@
"Maintainer": "Edzer Pebesma ",
"Repository": "CRAN"
},
- "urca": {
- "Package": "urca",
- "Version": "1.3-4",
- "Source": "Repository",
- "Date": "2024-05-25",
- "Title": "Unit Root and Cointegration Tests for Time Series Data",
- "Authors@R": "c(person(\"Bernhard\", \"Pfaff\", email = \"bernhard@pfaffikus.de\", role = c(\"aut\", \"cre\")), person(\"Eric\", \"Zivot\",email = \"ezivot@u.washington.edu\", role = \"ctb\"), person(\"Matthieu\", \"Stigler\", role = \"ctb\"))",
- "Depends": [
- "R (>= 2.0.0)",
- "methods"
- ],
- "Imports": [
- "nlme",
- "graphics",
- "stats"
- ],
- "LazyLoad": "yes",
- "Description": "Unit root and cointegration tests encountered in applied econometric analysis are implemented.",
- "License": "GPL (>= 2)",
- "NeedsCompilation": "yes",
- "Author": "Bernhard Pfaff [aut, cre], Eric Zivot [ctb], Matthieu Stigler [ctb]",
- "Maintainer": "Bernhard Pfaff ",
- "Repository": "CRAN"
- },
"utf8": {
"Package": "utf8",
"Version": "1.2.4",
@@ -7967,52 +6321,6 @@
"Maintainer": "Davis Vaughan ",
"Repository": "CRAN"
},
- "viridis": {
- "Package": "viridis",
- "Version": "0.6.5",
- "Source": "Repository",
- "Type": "Package",
- "Title": "Colorblind-Friendly Color Maps for R",
- "Date": "2024-01-28",
- "Authors@R": "c( person(\"Simon\", \"Garnier\", email = \"garnier@njit.edu\", role = c(\"aut\", \"cre\")), person(\"Noam\", \"Ross\", email = \"noam.ross@gmail.com\", role = c(\"ctb\", \"cph\")), person(\"Bob\", \"Rudis\", email = \"bob@rud.is\", role = c(\"ctb\", \"cph\")), person(\"Marco\", \"Sciaini\", email = \"sciaini.marco@gmail.com\", role = c(\"ctb\", \"cph\")), person(\"Antônio Pedro\", \"Camargo\", role = c(\"ctb\", \"cph\")), person(\"Cédric\", \"Scherer\", email = \"scherer@izw-berlin.de\", role = c(\"ctb\", \"cph\")) )",
- "Maintainer": "Simon Garnier ",
- "Description": "Color maps designed to improve graph readability for readers with common forms of color blindness and/or color vision deficiency. The color maps are also perceptually-uniform, both in regular form and also when converted to black-and-white for printing. This package also contains 'ggplot2' bindings for discrete and continuous color and fill scales. A lean version of the package called 'viridisLite' that does not include the 'ggplot2' bindings can be found at .",
- "License": "MIT + file LICENSE",
- "Encoding": "UTF-8",
- "Depends": [
- "R (>= 2.10)",
- "viridisLite (>= 0.4.0)"
- ],
- "Imports": [
- "ggplot2 (>= 1.0.1)",
- "gridExtra"
- ],
- "Suggests": [
- "hexbin (>= 1.27.0)",
- "scales",
- "MASS",
- "knitr",
- "dichromat",
- "colorspace",
- "httr",
- "mapproj",
- "vdiffr",
- "svglite (>= 1.2.0)",
- "testthat",
- "covr",
- "rmarkdown",
- "maps",
- "terra"
- ],
- "LazyData": "true",
- "VignetteBuilder": "knitr",
- "URL": "https://sjmgarnier.github.io/viridis/, https://github.com/sjmgarnier/viridis/",
- "BugReports": "https://github.com/sjmgarnier/viridis/issues",
- "RoxygenNote": "7.3.1",
- "NeedsCompilation": "no",
- "Author": "Simon Garnier [aut, cre], Noam Ross [ctb, cph], Bob Rudis [ctb, cph], Marco Sciaini [ctb, cph], Antônio Pedro Camargo [ctb, cph], Cédric Scherer [ctb, cph]",
- "Repository": "CRAN"
- },
"viridisLite": {
"Package": "viridisLite",
"Version": "0.4.2",
@@ -8111,34 +6419,6 @@
"Maintainer": "Jennifer Bryan ",
"Repository": "CRAN"
},
- "warp": {
- "Package": "warp",
- "Version": "0.2.1",
- "Source": "Repository",
- "Title": "Group Dates",
- "Authors@R": "c( person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = c(\"aut\", \"cre\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
- "Description": "Tooling to group dates by a variety of periods including: yearly, monthly, by second, by week of the month, and more. The groups are defined in such a way that they also represent the distance between dates in terms of the period. This extracts valuable information that can be used in further calculations that rely on a specific temporal spacing between observations.",
- "License": "MIT + file LICENSE",
- "URL": "https://github.com/DavisVaughan/warp, https://davisvaughan.github.io/warp/",
- "BugReports": "https://github.com/DavisVaughan/warp/issues",
- "Depends": [
- "R (>= 3.2)"
- ],
- "Suggests": [
- "covr",
- "knitr",
- "rmarkdown",
- "testthat (>= 3.0.0)"
- ],
- "VignetteBuilder": "knitr",
- "Config/Needs/website": "tidyverse/tidytemplate",
- "Encoding": "UTF-8",
- "RoxygenNote": "7.2.3",
- "NeedsCompilation": "yes",
- "Author": "Davis Vaughan [aut, cre], Posit Software, PBC [cph, fnd]",
- "Maintainer": "Davis Vaughan ",
- "Repository": "CRAN"
- },
"withr": {
"Package": "withr",
"Version": "3.0.2",
@@ -8349,41 +6629,6 @@
"NeedsCompilation": "no",
"Author": "David B. Dahl [aut], David Scott [aut, cre], Charles Roosen [aut], Arni Magnusson [aut], Jonathan Swinton [aut], Ajay Shah [ctb], Arne Henningsen [ctb], Benno Puetz [ctb], Bernhard Pfaff [ctb], Claudio Agostinelli [ctb], Claudius Loehnert [ctb], David Mitchell [ctb], David Whiting [ctb], Fernando da Rosa [ctb], Guido Gay [ctb], Guido Schulz [ctb], Ian Fellows [ctb], Jeff Laake [ctb], John Walker [ctb], Jun Yan [ctb], Liviu Andronic [ctb], Markus Loecher [ctb], Martin Gubri [ctb], Matthieu Stigler [ctb], Robert Castelo [ctb], Seth Falcon [ctb], Stefan Edwards [ctb], Sven Garbade [ctb], Uwe Ligges [ctb]"
},
- "xts": {
- "Package": "xts",
- "Version": "0.14.1",
- "Source": "Repository",
- "Type": "Package",
- "Title": "eXtensible Time Series",
- "Authors@R": "c( person(given=c(\"Jeffrey\",\"A.\"), family=\"Ryan\", role=c(\"aut\",\"cph\")), person(given=c(\"Joshua\",\"M.\"), family=\"Ulrich\", role=c(\"cre\",\"aut\"), email=\"josh.m.ulrich@gmail.com\"), person(given=\"Ross\", family=\"Bennett\", role=\"ctb\"), person(given=\"Corwin\", family=\"Joy\", role=\"ctb\") )",
- "Depends": [
- "R (>= 3.6.0)",
- "zoo (>= 1.7-12)"
- ],
- "Imports": [
- "methods"
- ],
- "LinkingTo": [
- "zoo"
- ],
- "Suggests": [
- "timeSeries",
- "timeDate",
- "tseries",
- "chron",
- "tinytest"
- ],
- "LazyLoad": "yes",
- "Description": "Provide for uniform handling of R's different time-based data classes by extending zoo, maximizing native format information preservation and allowing for user level customization and extension, while simplifying cross-class interoperability.",
- "License": "GPL (>= 2)",
- "URL": "https://joshuaulrich.github.io/xts/, https://github.com/joshuaulrich/xts",
- "BugReports": "https://github.com/joshuaulrich/xts/issues",
- "Encoding": "UTF-8",
- "NeedsCompilation": "yes",
- "Author": "Jeffrey A. Ryan [aut, cph], Joshua M. Ulrich [cre, aut], Ross Bennett [ctb], Corwin Joy [ctb]",
- "Maintainer": "Joshua M. Ulrich ",
- "Repository": "CRAN"
- },
"yaml": {
"Package": "yaml",
"Version": "2.3.10",
diff --git a/renv/settings.json b/renv/settings.json
index ffdbb32..c35954b 100644
--- a/renv/settings.json
+++ b/renv/settings.json
@@ -15,5 +15,12 @@
"vcs.ignore.cellar": true,
"vcs.ignore.library": true,
"vcs.ignore.local": true,
- "vcs.manage.ignores": true
+ "vcs.manage.ignores": true,
+ "ignored.directories": [
+ "old_sh",
+ "r_app/old_scripts",
+ "r_app/experiments",
+ "python_app/experiments",
+ "webapps"
+ ]
}