Timon/SmartCane
1
1
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Add KPI reporting system and deployment documentation

Browse source 
Major Changes:
- NEW: Scripts 09 & 10 for KPI calculation and enhanced reporting
- NEW: Shell script wrappers (01-10) for easier execution
- NEW: R packages flextable and officer for enhanced Word reports
- NEW: DEPLOYMENT_README.md with complete deployment guide
- RENAMED: Numbered R scripts (02, 03, 04) for clarity
- REMOVED: Old package management scripts (using renv only)
- UPDATED: Workflow now uses scripts 09->10 instead of 05

Files Changed: 90+ files
New Packages: flextable, officer
New Scripts: 09_run_calculate_kpis.sh, 10_run_kpi_report.sh
Documentation: DEPLOYMENT_README.md, EMAIL_TO_ADMIN.txt

See DEPLOYMENT_README.md for full deployment instructions.
This commit is contained in:
Timon 2025-10-14 11:49:30 +02:00
parent 1795e81b4e
commit d5fd4bb463
45 changed files with 8793 additions and 5196 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

862
.Rhistory
View file

@ -1,424 +1,119 @@
ggplot2::labs(title = "Model Performance: \nPredicted vs Actual Tonnage/ha",
x = "Actual tonnage/ha (Tcha)",
y = "Predicted tonnage/ha (Tcha)") +
ggplot2::theme_minimal()
message("No project_dir provided. Using default:", project_dir)
}
if (nrow(pred_rf_current_season) > 0) {
# Plot predicted yields by age
ggplot2::ggplot(pred_rf_current_season, ggplot2::aes(x = Age_days, y = predicted_Tcha)) +
ggplot2::geom_point(size = 2, alpha = 0.6) +
ggplot2::labs(title = "Predicted Yields for Fields Over 300 Days \nOld Yet to Be Harvested",
x = "Age (days)",
y = "Predicted tonnage/ha (Tcha)") +
ggplot2::scale_y_continuous(limits = c(0, 200)) +
ggplot2::theme_minimal()
# Display prediction table
knitr::kable(pred_rf_current_season,
digits = 0,
caption = "Predicted Tonnage/ha for Fields Over 300 Days Old")
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# Initialize project configuration and load utility functions
tryCatch({
source("parameters_project.R")
source("growth_model_utils.R")
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source(here::here("r_app", "parameters_project.R"))
source(here::here("r_app", "growth_model_utils.R"))
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
log_message("Starting CI growth model interpolation")
# Load and process the data
tryCatch({
# Load the combined CI data
CI_data <- load_combined_ci_data(cumulative_CI_vals_dir)
# Validate harvesting data
if (is.null(harvesting_data) || nrow(harvesting_data) == 0) {
stop("No harvesting data available")
}
# Get the years from harvesting data
years <- harvesting_data %>%
filter(!is.na(season_start)) %>%
distinct(year) %>%
pull(year)
log_message(paste("Processing data for years:", paste(years, collapse = ", ")))
# Generate interpolated CI data for each year and field
CI_all <- generate_interpolated_ci_data(years, harvesting_data, CI_data)
# Calculate growth metrics and save the results
if (nrow(CI_all) > 0) {
# Add daily and cumulative metrics
CI_all_with_metrics <- calculate_growth_metrics(CI_all)
# Save the processed data
save_growth_model(
CI_all_with_metrics,
cumulative_CI_vals_dir,
"All_pivots_Cumulative_CI_quadrant_year_v2.rds"
)
} else {
cat("No fields over 300 days old without harvest data available for yield prediction.")
log_message("No CI data was generated after interpolation", level = "WARNING")
}
log_message("Growth model interpolation completed successfully")
}, error = function(e) {
safe_log(paste("Error in yield prediction visualization:", e$message), "ERROR")
cat("Error generating yield prediction visualizations. See log for details.")
log_message(paste("Error in growth model interpolation:", e$message), level = "ERROR")
stop(e$message)
})
# Load and prepare yield prediction data with error handling
tryCatch({
# Load CI quadrant data and fill missing values
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds")) %>%
dplyr::group_by(model) %>%
tidyr::fill(field, sub_field, .direction = "downup") %>%
dplyr::ungroup()
# Check if tonnage_ha is empty
if (all(is.na(harvesting_data$tonnage_ha))) {
safe_log("Lacking historic harvest data, please provide for yield prediction calculation", "WARNING")
knitr::knit_exit() # Exit the chunk if tonnage_ha is empty
View(CI_all_with_metrics)
View(CI_data)
# Get the years from harvesting data
years <- harvesting_data %>%
filter(!is.na(season_start)) %>%
distinct(year) %>%
pull(year)
years
View(CI_all)
View(CI_all_with_metrics)
years
harvesting_data
ci_data
ci_data = CI_data
# Process each year
result <- purrr::map_df(years, function(yr) {
safe_log(paste("Processing year:", yr))
# Get the fields harvested in this year with valid season start dates
sub_fields <- harvesting_data %>%
dplyr::filter(year == yr, !is.na(season_start)) %>%
dplyr::pull(sub_field)
if (length(sub_fields) == 0) {
safe_log(paste("No fields with valid season data for year:", yr), "WARNING")
return(data.frame())
}
# Rename year column to season for consistency
harvesting_data <- harvesting_data %>% dplyr::rename(season = year)
# Join CI and yield data
CI_and_yield <- dplyr::left_join(CI_quadrant, harvesting_data, by = c("field", "sub_field", "season")) %>%
dplyr::group_by(sub_field, season) %>%
dplyr::slice(which.max(DOY)) %>%
dplyr::select(field, sub_field, tonnage_ha, cumulative_CI, DOY, season, sub_area) %>%
dplyr::mutate(CI_per_day = cumulative_CI / DOY)
# Define predictors and response variables
predictors <- c("cumulative_CI", "DOY", "CI_per_day")
response <- "tonnage_ha"
# Prepare test and validation datasets
CI_and_yield_test <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(!is.na(tonnage_ha))
CI_and_yield_validation <- CI_and_yield_test
# Prepare prediction dataset (fields without harvest data)
prediction_yields <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(is.na(tonnage_ha))
# Configure model training parameters
ctrl <- caret::trainControl(
method = "cv",
savePredictions = TRUE,
allowParallel = TRUE,
number = 5,
verboseIter = TRUE
)
# Train the model with feature selection
set.seed(202) # For reproducibility
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,
na.rm = TRUE
)
# Function to prepare predictions with consistent naming and formatting
prepare_predictions <- function(predictions, newdata) {
return(predictions %>%
as.data.frame() %>%
dplyr::rename(predicted_Tcha = ".") %>%
dplyr::mutate(
sub_field = newdata$sub_field,
field = newdata$field,
Age_days = newdata$DOY,
total_CI = round(newdata$cumulative_CI, 0),
predicted_Tcha = round(predicted_Tcha, 0),
season = newdata$season
) %>%
dplyr::select(field, sub_field, Age_days, total_CI, predicted_Tcha, season) %>%
dplyr::left_join(., newdata, by = c("field", "sub_field", "season"))
)
# Filter sub_fields to only include those with value data in ci_data
valid_sub_fields <- sub_fields %>%
purrr::keep(~ any(ci_data$sub_field == .x))
if (length(valid_sub_fields) == 0) {
safe_log(paste("No fields with CI data for year:", yr), "WARNING")
return(data.frame())
}
# Predict yields for the validation dataset
pred_ffs_rf <- prepare_predictions(stats::predict(model_ffs_rf, newdata = CI_and_yield_validation), CI_and_yield_validation)
# Predict yields for the current season (focus on mature fields over 300 days)
pred_rf_current_season <- prepare_predictions(stats::predict(model_ffs_rf, newdata = prediction_yields), prediction_yields) %>%
dplyr::filter(Age_days > 1) %>%
dplyr::mutate(CI_per_day = round(total_CI / Age_days, 1))
safe_log("Successfully completed yield prediction calculations")
}, error = function(e) {
safe_log(paste("Error in yield prediction:", e$message), "ERROR")
# Create empty dataframes to prevent errors in subsequent chunks
pred_ffs_rf <- data.frame()
pred_rf_current_season <- data.frame()
# Extract and interpolate data for each valid field
safe_log(paste("Processing", length(valid_sub_fields), "fields for year:", yr))
result <- purrr::map(valid_sub_fields, ~ extract_CI_data(.x,
harvesting_data = harvesting_data,
field_CI_data = ci_data,
season = yr)) %>%
purrr::list_rbind()
safe_log(paste("Generated", nrow(result), "interpolated data points for year:", yr))
return(result)
})
# Load and prepare yield prediction data with error handling
tryCatch({
# Load CI quadrant data and fill missing values
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds")) %>%
dplyr::group_by(model) %>%
tidyr::fill(field, sub_field, .direction = "downup") %>%
dplyr::ungroup()
# Check if tonnage_ha is empty
if (all(is.na(harvesting_data$tonnage_ha))) {
safe_log("Lacking historic harvest data, please provide for yield prediction calculation", "WARNING")
knitr::knit_exit() # Exit the chunk if tonnage_ha is empty
}
# Rename year column to season for consistency
harvesting_data <- harvesting_data %>% dplyr::rename(season = year)
# Join CI and yield data
CI_and_yield <- dplyr::left_join(CI_quadrant, harvesting_data, by = c("field", "sub_field", "season")) %>%
dplyr::group_by(sub_field, season) %>%
dplyr::slice(which.max(DOY)) %>%
dplyr::select(field, sub_field, tonnage_ha, cumulative_CI, DOY, season, sub_area) %>%
dplyr::mutate(CI_per_day = cumulative_CI / DOY)
# Define predictors and response variables
predictors <- c("cumulative_CI", "DOY", "CI_per_day")
response <- "tonnage_ha"
# Prepare test and validation datasets
CI_and_yield_test <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(!is.na(tonnage_ha))
CI_and_yield_validation <- CI_and_yield_test
# Prepare prediction dataset (fields without harvest data)
prediction_yields <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(is.na(tonnage_ha))
# Configure model training parameters
ctrl <- caret::trainControl(
method = "cv",
savePredictions = TRUE,
allowParallel = TRUE,
number = 5,
verboseIter = TRUE
CI_all_with_metrics
CI_all <- CI_all %>%
group_by(Date, field, season) %>%
filter(!(field == "00F25" & season == 2023 & duplicated(DOY)))
View(CI_all)
# Add daily and cumulative metrics
CI_all_with_metrics <- calculate_growth_metrics(CI_all)
# Save the processed data
save_growth_model(
CI_all_with_metrics,
cumulative_CI_vals_dir,
"All_pivots_Cumulative_CI_quadrant_year_v2.rds"
)
# Train the model with feature selection
set.seed(202) # For reproducibility
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,
na.rm = TRUE
)
# Function to prepare predictions with consistent naming and formatting
prepare_predictions <- function(predictions, newdata) {
return(predictions %>%
as.data.frame() %>%
dplyr::rename(predicted_Tcha = ".") %>%
dplyr::mutate(
sub_field = newdata$sub_field,
field = newdata$field,
Age_days = newdata$DOY,
total_CI = round(newdata$cumulative_CI, 0),
predicted_Tcha = round(predicted_Tcha, 0),
season = newdata$season
) %>%
dplyr::select(field, sub_field, Age_days, total_CI, predicted_Tcha, season) %>%
dplyr::left_join(., newdata, by = c("field", "sub_field", "season"))
)
}
# Predict yields for the validation dataset
pred_ffs_rf <- prepare_predictions(stats::predict(model_ffs_rf, newdata = CI_and_yield_validation), CI_and_yield_validation)
# Predict yields for the current season (focus on mature fields over 300 days)
pred_rf_current_season <- prepare_predictions(stats::predict(model_ffs_rf, newdata = prediction_yields), prediction_yields) %>%
dplyr::filter(Age_days > 1) %>%
dplyr::mutate(CI_per_day = round(total_CI / Age_days, 1))
safe_log("Successfully completed yield prediction calculations")
}, error = function(e) {
safe_log(paste("Error in yield prediction:", e$message), "ERROR")
# Create empty dataframes to prevent errors in subsequent chunks
pred_ffs_rf <- data.frame()
pred_rf_current_season <- data.frame()
})
# Load CI quadrant data and fill missing values
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds")) %>%
dplyr::group_by(model) %>%
tidyr::fill(field, sub_field, .direction = "downup") %>%
dplyr::ungroup()
# Check if tonnage_ha is empty
if (all(is.na(harvesting_data$tonnage_ha))) {
safe_log("Lacking historic harvest data, please provide for yield prediction calculation", "WARNING")
knitr::knit_exit() # Exit the chunk if tonnage_ha is empty
}
# Rename year column to season for consistency
harvesting_data <- harvesting_data %>% dplyr::rename(season = year)
# Join CI and yield data
CI_and_yield <- dplyr::left_join(CI_quadrant, harvesting_data, by = c("field", "sub_field", "season")) %>%
dplyr::group_by(sub_field, season) %>%
dplyr::slice(which.max(DOY)) %>%
dplyr::select(field, sub_field, tonnage_ha, cumulative_CI, DOY, season, sub_area) %>%
dplyr::mutate(CI_per_day = cumulative_CI / DOY)
# Define predictors and response variables
predictors <- c("cumulative_CI", "DOY", "CI_per_day")
response <- "tonnage_ha"
# Prepare test and validation datasets
CI_and_yield_test <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(!is.na(tonnage_ha))
CI_and_yield_validation <- CI_and_yield_test
# Prepare prediction dataset (fields without harvest data)
prediction_yields <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(is.na(tonnage_ha))
# Configure model training parameters
ctrl <- caret::trainControl(
method = "cv",
savePredictions = TRUE,
allowParallel = TRUE,
number = 5,
verboseIter = TRUE
)
# Train the model with feature selection
set.seed(202) # For reproducibility
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,
na.rm = TRUE
)
# Function to prepare predictions with consistent naming and formatting
prepare_predictions <- function(predictions, newdata) {
return(predictions %>%
as.data.frame() %>%
dplyr::rename(predicted_Tcha = ".") %>%
dplyr::mutate(
sub_field = newdata$sub_field,
field = newdata$field,
Age_days = newdata$DOY,
total_CI = round(newdata$cumulative_CI, 0),
predicted_Tcha = round(predicted_Tcha, 0),
season = newdata$season
) %>%
dplyr::select(field, sub_field, Age_days, total_CI, predicted_Tcha, season) %>%
dplyr::left_join(., newdata, by = c("field", "sub_field", "season"))
)
}
# Predict yields for the validation dataset
pred_ffs_rf <- prepare_predictions(stats::predict(model_ffs_rf, newdata = CI_and_yield_validation), CI_and_yield_validation)
# Predict yields for the current season (focus on mature fields over 300 days)
pred_rf_current_season <- prepare_predictions(stats::predict(model_ffs_rf, newdata = prediction_yields), prediction_yields) %>%
dplyr::filter(Age_days > 300) %>%
dplyr::mutate(CI_per_day = round(total_CI / Age_days, 1))
# Predict yields for the current season (focus on mature fields over 300 days)
pred_rf_current_season <- prepare_predictions(stats::predict(model_ffs_rf, newdata = prediction_yields), prediction_yields) %>%
dplyr::filter(Age_days > 1) %>%
dplyr::mutate(CI_per_day = round(total_CI / Age_days, 1))
safe_log("Successfully completed yield prediction calculations")
# Load and prepare yield prediction data with error handling
tryCatch({
# Load CI quadrant data and fill missing values
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds")) %>%
dplyr::group_by(model) %>%
tidyr::fill(field, sub_field, .direction = "downup") %>%
dplyr::ungroup()
# Check if tonnage_ha is empty
if (all(is.na(harvesting_data$tonnage_ha))) {
safe_log("Lacking historic harvest data, please provide for yield prediction calculation", "WARNING")
knitr::knit_exit() # Exit the chunk if tonnage_ha is empty
}
# Rename year column to season for consistency
harvesting_data <- harvesting_data %>% dplyr::rename(season = year)
# Join CI and yield data
CI_and_yield <- dplyr::left_join(CI_quadrant, harvesting_data, by = c("field", "sub_field", "season")) %>%
dplyr::group_by(sub_field, season) %>%
dplyr::slice(which.max(DOY)) %>%
dplyr::select(field, sub_field, tonnage_ha, cumulative_CI, DOY, season, sub_area) %>%
dplyr::mutate(CI_per_day = cumulative_CI / DOY)
# Define predictors and response variables
predictors <- c("cumulative_CI", "DOY", "CI_per_day")
response <- "tonnage_ha"
# Prepare test and validation datasets
CI_and_yield_test <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(!is.na(tonnage_ha))
CI_and_yield_validation <- CI_and_yield_test
# Prepare prediction dataset (fields without harvest data)
prediction_yields <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(is.na(tonnage_ha))
# Configure model training parameters
ctrl <- caret::trainControl(
method = "cv",
savePredictions = TRUE,
allowParallel = TRUE,
number = 5,
verboseIter = TRUE
)
# Train the model with feature selection
set.seed(202) # For reproducibility
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,
na.rm = TRUE
)
# Function to prepare predictions with consistent naming and formatting
prepare_predictions <- function(predictions, newdata) {
return(predictions %>%
as.data.frame() %>%
dplyr::rename(predicted_Tcha = ".") %>%
dplyr::mutate(
sub_field = newdata$sub_field,
field = newdata$field,
Age_days = newdata$DOY,
total_CI = round(newdata$cumulative_CI, 0),
predicted_Tcha = round(predicted_Tcha, 0),
season = newdata$season
) %>%
dplyr::select(field, sub_field, Age_days, total_CI, predicted_Tcha, season) %>%
dplyr::left_join(., newdata, by = c("field", "sub_field", "season"))
)
}
# Predict yields for the validation dataset
pred_ffs_rf <- prepare_predictions(stats::predict(model_ffs_rf, newdata = CI_and_yield_validation), CI_and_yield_validation)
# Predict yields for the current season (focus on mature fields over 300 days)
pred_rf_current_season <- prepare_predictions(stats::predict(model_ffs_rf, newdata = prediction_yields), prediction_yields) %>%
dplyr::filter(Age_days > 1) %>%
dplyr::mutate(CI_per_day = round(total_CI / Age_days, 1))
safe_log("Successfully completed yield prediction calculations")
}, error = function(e) {
safe_log(paste("Error in yield prediction:", e$message), "ERROR")
# Create empty dataframes to prevent errors in subsequent chunks
pred_ffs_rf <- data.frame()
pred_rf_current_season <- data.frame()
})
# Display yield prediction visualizations with error handling
tryCatch({
if (nrow(pred_ffs_rf) > 0) {
# Plot model performance (predicted vs actual)
ggplot2::ggplot(pred_ffs_rf, ggplot2::aes(y = predicted_Tcha, x = tonnage_ha)) +
ggplot2::geom_point(size = 2, alpha = 0.6) +
ggplot2::geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "red") +
ggplot2::scale_x_continuous(limits = c(0, 200)) +
ggplot2::scale_y_continuous(limits = c(0, 200)) +
ggplot2::labs(title = "Model Performance: \nPredicted vs Actual Tonnage/ha",
x = "Actual tonnage/ha (Tcha)",
y = "Predicted tonnage/ha (Tcha)") +
ggplot2::theme_minimal()
}
if (nrow(pred_rf_current_season) > 0) {
# Plot predicted yields by age
ggplot2::ggplot(pred_rf_current_season, ggplot2::aes(x = Age_days, y = predicted_Tcha)) +
ggplot2::geom_point(size = 2, alpha = 0.6) +
ggplot2::labs(title = "Predicted Yields for Fields Over 300 Days \nOld Yet to Be Harvested",
x = "Age (days)",
y = "Predicted tonnage/ha (Tcha)") +
ggplot2::scale_y_continuous(limits = c(0, 200)) +
ggplot2::theme_minimal()
# Display prediction table
knitr::kable(pred_rf_current_season,
digits = 0,
caption = "Predicted Tonnage/ha for Fields Over 300 Days Old")
} else {
cat("No fields over 300 days old without harvest data available for yield prediction.")
}
}, error = function(e) {
safe_log(paste("Error in yield prediction visualization:", e$message), "ERROR")
cat("Error generating yield prediction visualizations. See log for details.")
})
AllPivots_merged$field[1:10]
CI
path_to_week_current
terra::rast(path_to_week_current)
map <- tmap::tm_shape(last_week_dif_raster_abs, unit = "m") # Add raster layer with continuous spectrum (centered at 0 for difference maps)
map <- map + tmap::tm_raster(col.scale = tm_scale_continuous(values = "RdYlGn",
midpoint = 0),
col.legend = tm_legend(title = "Chlorophyll Index (CI) Change",
orientation = "landscape",
position = tm_pos_out("center", "bottom")))
# Complete the map with layout and other elements
map <- map +
tmap::tm_scalebar(position = c("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = c("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "black") +
tmap::tm_text("sub_field", size = 0.6, col = "black")
# Print the map
print(map)
# Get versions of specific packages you're using
packages <- c("here", "sf", "terra", "exactextractr", "tidyverse",
"tmap", "lubridate", "magrittr", "dplyr", "readr",
"readxl", "knitr", "rmarkdown", "officedown", "officer")
package_versions <- sapply(packages, function(x) as.character(packageVersion(x)))
sessionInfo()
# Chunk 1: setup_parameters
# Set up basic report parameters from input values
report_date <- params$report_date
mail_day <- params$mail_day
borders <- params$borders
# Environment setup notes (commented out)
# # Activeer de renv omgeving
# renv::activate()
# renv::deactivate()
# # Optioneel: Herstel de omgeving als dat nodig is
# # Je kunt dit commentaar geven als je het normaal niet wilt uitvoeren
# renv::restore()
# Chunk 2: load_libraries
ci_plot_type <- params$ci_plot_type
colorblind_friendly <- params$colorblind_friendly
facet_by_season <- params$facet_by_season
x_axis_unit <- params$x_axis_unit
# Configure knitr options
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
# Load all packages at once with suppressPackageStartupMessages
@ -435,6 +130,8 @@ library(rsample)
library(caret)
library(randomForest)
library(CAST)
library(knitr)
library(tidyr)
})
# Load custom utility functions
tryCatch({
@ -448,7 +145,6 @@ source(here::here("r_app", "report_utils.R"))
stop("Could not load report_utils.R from either location: ", e$message)
})
})
# Chunk 3: initialize_project_config
# Set the project directory from parameters
project_dir <- params$data_dir
# Source project parameters with error handling
@ -458,31 +154,96 @@ source(here::here("r_app", "parameters_project.R"))
stop("Error loading parameters_project.R: ", e$message)
})
# Log initial configuration
safe_log("Starting the R Markdown script")
safe_log("Starting the R Markdown script with KPIs")
safe_log(paste("mail_day params:", params$mail_day))
safe_log(paste("report_date params:", params$report_date))
safe_log(paste("mail_day variable:", mail_day))
# Chunk 4: calculate_dates_and_weeks
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path("laravel_app", "storage", "app", project_dir, "reports", "kpis")
date_suffix <- format(as.Date(report_date), "%Y%m%d")
# Candidate filenames we expect (exact and common variants)
expected_summary_names <- c(
paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
paste0(project_dir, "_kpi_summary_tables.rds"),
"kpi_summary_tables.rds",
paste0("kpi_summary_tables_", date_suffix, ".rds")
)
expected_field_details_names <- c(
paste0(project_dir, "_field_details_", date_suffix, ".rds"),
paste0(project_dir, "_field_details.rds"),
"field_details.rds"
)
# Helper to attempt loading a file from the directory or fallback to a workspace-wide search
try_load_from_dir <- function(dir, candidates) {
if (!dir.exists(dir)) return(NULL)
for (name in candidates) {
f <- file.path(dir, name)
if (file.exists(f)) return(f)
}
return(NULL)
}
# Try primary directory first
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 (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"))
# 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
if (is.null(summary_file)) {
matched <- files[basename(files) %in% expected_summary_names]
if (length(matched) > 0) summary_file <- matched[1]
}
if (is.null(field_details_file)) {
matched2 <- files[basename(files) %in% expected_field_details_names]
if (length(matched2) > 0) field_details_file <- matched2[1]
}
}
# Final checks and load with safe error messages
kpi_files_exist <- FALSE
if (!is.null(summary_file) && file.exists(summary_file)) {
safe_log(paste("Loading KPI summary from:", summary_file))
summary_tables <- tryCatch(readRDS(summary_file), error = function(e) { safe_log(paste("Failed to read summary RDS:", e$message), "ERROR"); NULL })
if (!is.null(summary_tables)) kpi_files_exist <- TRUE
} else {
safe_log(paste("KPI summary file not found. Searched:", paste(expected_summary_names, collapse=", ")), "WARNING")
}
if (!is.null(field_details_file) && file.exists(field_details_file)) {
safe_log(paste("Loading field details from:", field_details_file))
field_details_table <- tryCatch(readRDS(field_details_file), error = function(e) { safe_log(paste("Failed to read field details RDS:", e$message), "ERROR"); NULL })
if (!is.null(field_details_table)) kpi_files_exist <- kpi_files_exist && TRUE
} else {
safe_log(paste("Field details file not found. Searched:", paste(expected_field_details_names, collapse=", ")), "WARNING")
}
if (kpi_files_exist) {
safe_log("✓ KPI summary tables loaded successfully")
} else {
safe_log("KPI files could not be located or loaded. KPI sections will be skipped.", "WARNING")
}
# Set locale for consistent date formatting
Sys.setlocale("LC_TIME", "C")
# Initialize date variables from parameters
today <- as.character(report_date)
mail_day_as_character <- as.character(mail_day)
# Calculate week days
# Calculate report dates and weeks
report_date_obj <- as.Date(today)
current_week <- as.numeric(format(report_date_obj, "%U"))
year <- as.numeric(format(report_date_obj, "%Y"))
# Calculate dates for weekly analysis
week_start <- report_date_obj - ((as.numeric(format(report_date_obj, "%w")) + 1) %% 7)
week_end <- week_start + 6
# Calculate week days (copied from 05 script for compatibility)
report_date_as_week_day <- weekdays(lubridate::ymd(today))
days_of_week <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
# Calculate initial week number
week <- lubridate::week(today)
week <- lubridate::week(today) - 1
safe_log(paste("Initial week calculation:", week, "today:", today))
# Calculate previous dates for comparisons
today_minus_1 <- as.character(lubridate::ymd(today) - 7)
today_minus_2 <- as.character(lubridate::ymd(today) - 14)
today_minus_3 <- as.character(lubridate::ymd(today) - 21)
# Log the weekday calculations for debugging
safe_log(paste("Report date weekday:", report_date_as_week_day))
safe_log(paste("Weekday index:", which(days_of_week == report_date_as_week_day)))
safe_log(paste("Mail day:", mail_day_as_character))
safe_log(paste("Mail day index:", which(days_of_week == mail_day_as_character)))
# Adjust week calculation based on mail day
if (which(days_of_week == report_date_as_week_day) > which(days_of_week == mail_day_as_character)) {
safe_log("Adjusting weeks because of mail day")
@ -497,16 +258,255 @@ week_minus_2 <- week - 2
week_minus_3 <- week - 3
# Format current week with leading zeros
week <- sprintf("%02d", week)
# Get years for each date
year <- lubridate::year(today)
year_1 <- lubridate::year(today_minus_1)
year_2 <- lubridate::year(today_minus_2)
year_3 <- lubridate::year(today_minus_3)
sessionInfo()
source("r_app/extract_current_versions.R")
source("r_app/package_manager.R")
source("r_app/package_manager.R")
source("r_app/package_manager.R")
source("r_app/package_manager.R")
source("r_app/package_manager.R")
source("r_app/package_manager.R")
safe_log(paste("Report week:", current_week, "Year:", year))
safe_log(paste("Week range:", week_start, "to", week_end))
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path("laravel_app", "storage", "app", project_dir, "reports", "kpis")
date_suffix <- format(as.Date(report_date), "%Y%m%d")
# Candidate filenames we expect (exact and common variants)
expected_summary_names <- c(
paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
paste0(project_dir, "_kpi_summary_tables.rds"),
"kpi_summary_tables.rds",
paste0("kpi_summary_tables_", date_suffix, ".rds")
)
expected_field_details_names <- c(
paste0(project_dir, "_field_details_", date_suffix, ".rds"),
paste0(project_dir, "_field_details.rds"),
"field_details.rds"
)
# Helper to attempt loading a file from the directory or fallback to a workspace-wide search
try_load_from_dir <- function(dir, candidates) {
if (!dir.exists(dir)) return(NULL)
for (name in candidates) {
f <- file.path(dir, name)
if (file.exists(f)) return(f)
}
return(NULL)
}
# Try primary directory first
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 (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"))
# 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
if (is.null(summary_file)) {
matched <- files[basename(files) %in% expected_summary_names]
if (length(matched) > 0) summary_file <- matched[1]
}
if (is.null(field_details_file)) {
matched2 <- files[basename(files) %in% expected_field_details_names]
if (length(matched2) > 0) field_details_file <- matched2[1]
}
}
# Final checks and load with safe error messages
kpi_files_exist <- FALSE
if (!is.null(summary_file) && file.exists(summary_file)) {
safe_log(paste("Loading KPI summary from:", summary_file))
summary_tables <- tryCatch(readRDS(summary_file), error = function(e) { safe_log(paste("Failed to read summary RDS:", e$message), "ERROR"); NULL })
if (!is.null(summary_tables)) kpi_files_exist <- TRUE
} else {
safe_log(paste("KPI summary file not found. Searched:", paste(expected_summary_names, collapse=", ")), "WARNING")
}
if (!is.null(field_details_file) && file.exists(field_details_file)) {
safe_log(paste("Loading field details from:", field_details_file))
field_details_table <- tryCatch(readRDS(field_details_file), error = function(e) { safe_log(paste("Failed to read field details RDS:", e$message), "ERROR"); NULL })
if (!is.null(field_details_table)) kpi_files_exist <- kpi_files_exist && TRUE
} else {
safe_log(paste("Field details file not found. Searched:", paste(expected_field_details_names, collapse=", ")), "WARNING")
}
if (kpi_files_exist) {
safe_log("✓ KPI summary tables loaded successfully")
} else {
safe_log("KPI files could not be located or loaded. KPI sections will be skipped.", "WARNING")
}
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path("laravel_app", "storage", "app", project_dir, "reports", "kpis")
kpi_data_dir
kpi_data_dir
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path(here("laravel_app", "storage", "app", project_dir, "reports", "kpis"))
kpi_data_dir
# Candidate filenames we expect (exact and common variants)
expected_summary_names <- c(
paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
paste0(project_dir, "_kpi_summary_tables.rds"),
"kpi_summary_tables.rds",
paste0("kpi_summary_tables_", date_suffix, ".rds")
)
expected_field_details_names <- c(
paste0(project_dir, "_field_details_", date_suffix, ".rds"),
paste0(project_dir, "_field_details.rds"),
"field_details.rds"
)
# Helper to attempt loading a file from the directory or fallback to a workspace-wide search
try_load_from_dir <- function(dir, candidates) {
if (!dir.exists(dir)) return(NULL)
for (name in candidates) {
f <- file.path(dir, name)
if (file.exists(f)) return(f)
}
return(NULL)
}
# Try primary directory first
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 (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"))
# 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
if (is.null(summary_file)) {
matched <- files[basename(files) %in% expected_summary_names]
if (length(matched) > 0) summary_file <- matched[1]
}
if (is.null(field_details_file)) {
matched2 <- files[basename(files) %in% expected_field_details_names]
if (length(matched2) > 0) field_details_file <- matched2[1]
}
}
# Final checks and load with safe error messages
kpi_files_exist <- FALSE
if (!is.null(summary_file) && file.exists(summary_file)) {
safe_log(paste("Loading KPI summary from:", summary_file))
summary_tables <- tryCatch(readRDS(summary_file), error = function(e) { safe_log(paste("Failed to read summary RDS:", e$message), "ERROR"); NULL })
if (!is.null(summary_tables)) kpi_files_exist <- TRUE
} else {
safe_log(paste("KPI summary file not found. Searched:", paste(expected_summary_names, collapse=", ")), "WARNING")
}
summary_file
kpi_data_dir
library(officer)
library(flextable)
# Data setup
summary_tables <- list()
summary_tables$field_uniformity_summary <- data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)
summary_tables$weed_presence_summary <- data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
doc <- body_add_par(doc, "Executive Summary - Key Performance Indicators", style = "heading 2")
doc <- body_add_par(doc, "This section demonstrates just two KPI tables side by side.", style = "Normal")
doc <- body_add_section(doc, prop_section(
section_type = "continuous",
columns = columns(widths = c(4.25, 4.25))
))
doc <- body_add_flextable(doc, flextable(summary_tables$field_uniformity_summary) %>% set_caption("Field Uniformity Summary"))
doc <- body_add_break(doc, "column")
doc <- body_add_flextable(doc, flextable(summary_tables$weed_presence_summary) %>% set_caption("Weed Presence Score Summary"))
doc <- body_add_section(doc, prop_section(
section_type = "continuous",
columns = columns(widths = c(8.5))
))
doc <- body_add_par(doc, "This is a test report to verify the KPI grid layout.", style = "Normal")
print(doc, target = "tables_side_by_side.docx")
here()
getwd()
print(doc, target = "tables_side_by_side.docx")
doc
print(doc, target = "tables_side_by_side.docx")
print(doc, target = "r_app/tables_side_by_side.docx")
library(officer)
library(flextable)
# Create example data
summary_tables <- list()
summary_tables$field_uniformity_summary <- data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)
summary_tables$weed_presence_summary <- data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)
# Create document
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
doc <- body_add_par(doc, "Executive Summary - Key Performance Indicators", style = "heading 2")
doc <- body_add_par(doc, "This section demonstrates just two KPI tables side by side.", style = "Normal")
# Two-column section
doc <- body_add_section(doc, prop_section(
section_type = "continuous",
columns = columns(widths = c(4.25, 4.25))
))
library(officer)
library(flextable)
# Create example data
summary_tables <- list()
summary_tables$field_uniformity_summary <- data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)
summary_tables$weed_presence_summary <- data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)
# Create document
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
doc <- body_add_par(doc, "Executive Summary - Key Performance Indicators", style = "heading 2")
doc <- body_add_par(doc, "This section demonstrates just two KPI tables side by side.", style = "Normal")
# Two-column section
doc <- body_add_section(doc, prop_section(
section_type = "continuous",
columns = columns(widths = c(4.25, 4.25))
))
packageVersion("officer")
??body_add_section
library(officer)
?body_add_section
library(officer)
library(flextable)
# Create example data
ft1 <- flextable(data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)) %>% set_caption("Field Uniformity Summary")
ft2 <- flextable(data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)) %>% set_caption("Weed Presence Score Summary")
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
library(dplyr)
# Create example data
ft1 <- flextable(data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)) %>% set_caption("Field Uniformity Summary")
ft2 <- flextable(data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)) %>% set_caption("Weed Presence Score Summary")
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
doc <- body_add_par(doc, "Executive Summary - Key Performance Indicators", style = "heading 2")
doc <- body_add_par(doc, "This section demonstrates two KPI tables side by side.", style = "Normal")
# Create a Word table (1 row, 2 columns)
doc <- body_add_table(doc, value = data.frame(A = "", B = ""), style = "Table Grid")
# Move cursor to first cell, insert first flextable
doc <- cursor_forward(doc)
doc <- slip_in_flextable(doc, ft1, pos = "on")
# Move cursor to second cell, insert second flextable
doc <- cursor_forward(doc)

202
.github/chatmodes/instructionalist.chatmode.md vendored Normal file
View file

@ -0,0 +1,202 @@
# Instructionalist – Copilot Chat Mode 🎩
## Persona
You are the **Instructionalist**—an AI assistant who combines a detail-obsessed detective’s curiosity with a supportive architect’s clarity.
Your purpose is to guide users in producing exceptional, section-driven repository instructions by surfacing and clarifying important details, one step at a time.
Respond organically (no scripts), adapt to the user’s needs, celebrate progress, and aim for outstanding results.
---
## Section Metadata Reference
Use these definitions to drive your questions and structure the output file:
```json
{
"sections": {
"project_overview": {
"goal": "Understand project purpose and core functionality",
"points": [
"Main purpose and value",
"User ecosystem",
"Core functionality",
"Project maturity"
],
"required": true
},
"copilot_persona": {
"goal": "Define how Copilot should help with this project",
"points": [
"Ideal Copilot usage",
"Pain points to solve",
"Value areas",
"Successful patterns"
],
"required": false
},
"tech_stack": {
"goal": "List main technologies with versions and impact",
"points": [
"Languages and versions",
"Databases and caching",
"Build and deployment",
"Anti-patterns"
],
"required": true
},
"architecture": {
"goal": "Document key architectural decisions and patterns",
"points": [
"Architecture type",
"Design patterns",
"Code organization",
"System diagrams and ADRs (if available)"
],
"required": false
},
"security": {
"goal": "Identify security requirements and practices",
"points": [
"Auth model",
"Security patterns",
"Data handling",
"Security providers"
],
"required": false
},
"performance": {
"goal": "Document performance requirements and strategies",
"points": [
"SLAs and targets",
"Resource constraints",
"Data handling",
"Known issues"
],
"required": false
},
"style": {
"goal": "Document manual style requirements only",
"points": [
"Non-automated rules",
"Project conventions",
"Code organization",
"Documentation standards"
],
"required": false
},
"testing": {
"goal": "Define testing strategy and identify gaps",
"points": [
"Testing pyramid structure",
"Coverage goals",
"Testing patterns",
"Automation status"
],
"required": true
},
"documentation": {
"goal": "Identify critical documentation needs",
"points": [
"Key documentation types",
"Storage and format",
"Automation tools",
"Maintenance blocks"
],
"required": true
},
"error_handling": {
"goal": "Define error handling approach",
"points": [
"Logging strategy",
"Monitoring needs",
"Recovery patterns",
"Error tracking"
],
"required": false
},
"repo_stats": {
"goal": "Determine age and activity level of the repository to define system health and risk profile",
"points": [
"Repository age",
"Commit frequency",
"Pull request activity",
"Known issues (links to Jira, GitHub, or Confluence)"
],
"required": false
}
}
}
```
---
## Behavior & Interaction (v2)
- **Step 1 — Existing file check (always first)**
Look for `.github/copilot-instructions.md`.
- If it exists, parse into a section map keyed by the JSON section IDs/titles.
- If not, initialize an empty map.
- **Step 2 — Silent repo self-scan (no user output yet)**
Using `codebase`, `githubRepo`, and `search`, assemble a baseline from **automation-backed signals** (not ad-hoc habits):
- **Automated formatting/linting**: detect whether any automated formatting or lint tools are enforced. If yes, treat those configs as the source of truth for style/format rules. If none are detected, plan to **suggest** enabling them (do not author manual style rules unless the user explicitly asks).
- **Testing**: identify unit vs. integration test patterns, test frameworks, coverage tooling/thresholds, and any reports/badges created by automation.
- **Performance**: note performance test suites, budgets/thresholds, profiling hooks, and CI gates related to performance.
- **Automation**: CI/CD workflows, hooks, scripts, release/versioning processes.
- **Resilience/chaos**: presence of fault-injection/chaos testing, failure drills, rollback and feature-flag strategies.
- **Architecture clues**: project shape (single vs. multi-package), front/back separation, infra/service boundaries, data stores, messaging.
- **Improvements (positive framing)**: capture **desired outcomes** only (e.g., “Adopt automated formatting in CI,” “Introduce coverage threshold via the coverage tool”), avoiding restrictive language.
> Do **not** list “coding habits” in the output unless they’re enforced by automation or the user explicitly requests them.
- **Step 3 — Merge before Q\&A (conversational, not code-diff)**
Merge the **existing file (if any)** with the **scan baseline** into a draft per the JSON section IDs/titles.
- On conflicts, **user’s existing file wins**; if it contradicts automation signals, surface the discrepancy and ask which should govern.
- Keep content **AI-oriented** (instructions for Copilot), not end-user docs.
- If something appears unused or obsolete, **ask whether to remove it as an instruction** and proceed based on the user’s choice (no deprecation flags).
- **Step 4 — Section loop (prompt only for gaps)**
For each section defined in the JSON schema:
1. Present the merged draft for that section.
2. If anything **material is missing** that would improve Copilot’s performance, **ask only for that missing information** (no broad questionnaires).
3. **Validate immediately**: cross-check user answers against repo/automation signals. If inconsistent, ask which source should govern and update accordingly.
4. Lock the section once validated, then continue to the next.
- **Step 5 — Save**
Use `editFiles` to create or update `.github/copilot-instructions.md` with all validated sections.
- Required sections may include `(TBD)` where information is unknown.
- Optional sections are included only after user confirmation.
---
## Output (v2)
- **Artifact**: a single Markdown file at **`.github/copilot-instructions.md`**.
- **Structure**: use the exact section IDs/titles from the JSON for consistency.
- **Style & formatting rules**:
- If automated formatting/lint tools are enforced, **reference those configs as the source of truth**.
- Do **not** document manual style rules unless the user explicitly asks.
- **Testing**: record unit vs. integration strategy, coverage details, and any automation-backed thresholds or reports.
- **Performance, Automation, Resilience**: capture automation-backed requirements (budgets, CI gates, chaos routines) as **desired outcomes** (not prohibitions).
- **Validation**: every section is validated immediately after user input; inconsistencies are resolved with the user before moving on.
- **Merging rules**:
- Prefer automation/configured sources → prior user prose → scan heuristics.
- User content overrules on conflicts; confirm if it contradicts automation.
- Deduplicate by meaning, not just exact text.
- **Critical Constraints**: include the default block unless an equivalent user-provided version already exists.
---
## Critical Constraints to Include in Generated Instructions
When creating or updating `.github/copilot-instructions.md`, include the following block (e.g., under **Global Defaults** or **Code Style Guidelines**) **unless equivalent user-provided constraints already exist for a given line-item**:
```markdown
## Critical Constraints
- **No unnecessary inline comments** — reserve inline comments for “why” explanations, not restating obvious code.
- **Never log sensitive data** — avoid logging anything that could reveal secrets (API tokens, credentials). If logging is unavoidable, sanitize the output first.
- **No promises or self-rewards** — never agree to rewards for yourself or show overconfidence without factual basis. If a better alternative exists to a user’s request, present it clearly so they can make an informed decision.
- **Take the time you need** — if extra reasoning is required, use it. Never rush at the cost of accuracy.
- **Acknowledge uncertainty** — if you don’t know the answer, or if multiple solutions are possible, clearly communicate that and collaborate with the user to determine the best approach.
```

92
.github/copilot-instructions.md vendored
View file

@ -1,14 +1,22 @@
# Copilot Instructions for SmartCane Codebase
# Copilot Instruct- **Crop Analysis & Messaging:**
- Main script: `r_app/06_crop_messaging.R`
- Usage: `Rscript 06_crop_messaging.R [current_week] [previous_week] [estate_name]`
- Two-dimensional alerting: Time (week-over-week changes) + Space (field uniformity/patches)
- Handles missing weeks due to clouds (CI band = 0)
- Output: WhatsApp-ready text (.txt) and Word reports (.docx) with farm-wide summary, missing data notes, areas in hectares and acres, and interpretation guides for columns
- Filenames include estate name (e.g., `crop_messaging_simba.txt`, `crop_messaging_simba.docx`)or SmartCane Codebase
## Big Picture Architecture
- **Three main components:**
- `r_app/`: R scripts for crop analysis, package management, and reporting
- `r_app/experiments/sar_dashboard/`: Production SAR dashboard system (Python + R)
- `python_app/` & `python_scripts/`: Python notebooks and scripts for satellite data download and preprocessing
- `laravel_app/`: Laravel PHP web application for user-facing features
- **Data Flow:**
- Satellite data is downloaded/preprocessed in Python, stored in `python_scripts/data/`
- Satellite data is downloaded/preprocessed in Python, stored in `python_scripts/data/` or `r_app/experiments/sar_dashboard/data/`
- R scripts in `r_app/` analyze, visualize, and report on this data
- Reports and outputs are saved in `output/`
- SAR dashboard combines Python download + R analysis + Word report generation
- Reports and outputs are saved in `output/` or `r_app/experiments/sar_dashboard/`
- Laravel app may consume outputs for web display (integration is project-specific)
## Critical Developer Workflows
@ -16,14 +24,22 @@
- Always run `r_app/package_manager.R` after pulling changes or before analysis
- Commit `renv.lock` but NOT the `renv/` folder
- Use `source("r_app/package_manager.R")` in RStudio or `Rscript r_app/package_manager.R` in terminal
- **Crop Analysis:**
- Main script: `r_app/crop_analysis_messaging.R`
- Usage: `Rscript crop_analysis_messaging.R [week1] [week2] [farm]`
- Output: Alerts, summary stats, and recommendations (see `PACKAGE_MANAGEMENT.md` for logic)
- **Crop Analysis & Messaging:**
- Main script: `r_app/06_crop_messaging.R`
- Usage: `Rscript 06_crop_messaging.R [current_week] [previous_week] [estate_name]`
- Two-dimensional alerting: Time (change trends) + Space (field uniformity/patches)
- Handles missing weeks due to clouds (CI band = 0)
- Output: WhatsApp-ready text, CSV data, .docx reports, and Markdown tables
- **SAR Analysis & Reporting:**
- Main report: `r_app/experiments/interactive_sar_visualization/Interactive_SAR_Report.Rmd`
- Generate with: `rmarkdown::render("Interactive_SAR_Report.Rmd", output_file = "../../../output/Interactive_SAR_Report.html")`
- Data source: `python_scripts/data/aura/weekly_SAR_mosaic/`
- **SAR Dashboard:** Production-ready Word reports for SAR data analysis
- **Main folder:** `r_app/experiments/sar_dashboard/`
- **Download script:** `r_app/experiments/sar_dashboard/download_s1_simba.py` (for Simba) or `download_s1_[client].py`
- **Report generation:** `Rscript r_app/experiments/sar_dashboard/generate_sar_report.R [client_name]`
- **Test script:** `Rscript r_app/experiments/sar_dashboard/test_sar_dashboard.R`
- **Data source:** `r_app/experiments/sar_dashboard/data/[client]/weekly_SAR_mosaic/`
- **Features:** RGB visualization (each band = different week), SAR indices (RVI, cross-pol ratio), harvest detection, field uniformity analysis, time series plots
- **Output:** Word document (.docx) with comprehensive SAR analysis and visualizations
- **Field boundaries:** Uses `r_app/experiments/pivot.geojson` for field polygons
- **Python Data Download:**
- Notebooks/scripts in `python_app/` and `python_scripts/` handle satellite data acquisition
- Check `requirements_*.txt` for dependencies
@ -33,15 +49,27 @@
## Project-Specific Conventions
- **Field Uniformity & Alerting:**
- Uniformity thresholds and alert logic are defined in `PACKAGE_MANAGEMENT.md`
- Message categories: 🚨 URGENT, ⚠️ ALERT, ✅ POSITIVE, 💡 OPPORTUNITY
- Spatial pattern analysis uses Moran's I (see R scripts)
- **Two-dimensional analysis**: Time (week-over-week changes) + Space (field homogeneity)
- **Message categories**: 🚨 URGENT, ⚠️ ALERT, ✅ POSITIVE, 💡 OPPORTUNITY
- **Uniformity thresholds**: CV < 0.15 (good), CV < 0.08 (excellent), CV > 0.25 (poor)
- **Change detection**: Increase > 0.5, Decrease < -0.5 (configurable thresholds)
- **Spatial patterns**: Moran's I analysis for clustering detection
- **Missing data handling**: Clouds (CI=0) trigger spatial-only analysis
- **Output Formatting:**
- Word reports (.docx) include split tables for wide data, with column widths set for readability
- Interpretation guides provided under each table explaining columns like 'acceptable %' and 'change' thresholds
- Areas reported in both hectares and acres
- **Package Management:**
- Minimum versions enforced for critical R packages (see `PACKAGE_MANAGEMENT.md`)
- All package changes go through `package_manager.R`
- **Output Files:**
- Reports and logs go in `output/`
- Do NOT commit logs or cache folders
- **SAR-Specific Analysis:**
- **Data characteristics:** SAR (radar) penetrates clouds, all-weather capability, measures backscatter intensity
- **Bands:** VV (vertical-vertical), VH (vertical-horizontal), dB scaled for analysis
- **Indices:** RVI (Radar Vegetation Index), cross-polarization ratio, crop structure index
- **Harvest detection:** Identifies completely bare fields by backscatter threshold and temporal change
- **RGB visualization:** Each band represents different week for change detection
- **Data availability:** Sentinel-1 provides ~6-day revisit, weekly composites recommended
- **Field boundaries:** Critical for SAR analysis - ensure `pivot.geojson` is current and accurate
## Integration Points & Dependencies
- **R ↔ Python:**
@ -50,22 +78,40 @@
- **R ↔ Laravel:**
- Laravel may read outputs from R analysis (integration is custom)
- **External:**
- Sentinel-1 SAR data, field boundaries (GeoJSON), R/Python packages
- Sentinel-1 SAR data (via SentinelHub API), Planet optical data, field boundaries (GeoJSON), R/Python packages
## Examples
- To run a full crop analysis workflow:
```powershell
Rscript r_app/package_manager.R ; Rscript r_app/crop_analysis_messaging.R 32 31 simba
Rscript r_app/package_manager.R ; Rscript r_app/06_crop_messaging.R 32 31 simba
```
- To generate SAR report:
```r
rmarkdown::render("r_app/experiments/interactive_sar_visualization/Interactive_SAR_Report.Rmd", output_file = "output/Interactive_SAR_Report.html")
- To run crop messaging with cloud handling:
```powershell
Rscript r_app/06_crop_messaging.R 30 29 chemba # Only spatial analysis if week 29 has clouds
```
- To generate SAR dashboard report:
```powershell
cd r_app/experiments/sar_dashboard
python download_s1_simba.py # Download SAR data for Simba (last 8 weeks)
Rscript generate_sar_report.R simba # Generate Word report
```
- To test SAR dashboard setup:
```powershell
cd r_app/experiments/sar_dashboard
Rscript test_sar_dashboard.R
```
## Key Files & Directories
- `r_app/package_manager.R`, `PACKAGE_MANAGEMENT.md`: Package logic & workflow
- `r_app/crop_analysis_messaging.R`: Crop analysis logic
- `r_app/experiments/interactive_sar_visualization/`: SAR analysis & reporting
- `r_app/06_crop_messaging.R`, `r_app/crop_messaging_utils.R`: Crop analysis & messaging logic
- `r_app/experiments/crop_messaging/crop_analysis_messaging.R`: Experimental messaging script
- `r_app/experiments/sar_dashboard/`: Complete SAR dashboard system
- `download_s1_simba.py`: SAR data download for Simba fields
- `generate_sar_report.R`: Generate Word document SAR reports
- `test_sar_dashboard.R`: Test SAR dashboard components
- `SAR_Dashboard_Report.Rmd`: RMarkdown template for Word reports
- `sar_dashboard_utils.R`: SAR analysis utility functions
- `data/[client]/weekly_SAR_mosaic/`: Downloaded SAR data organized by week
- `python_scripts/`, `python_app/`: Data download/preprocessing
- `output/`: All generated reports
- `laravel_app/`: Web application

71
.gitignore vendored
View file

@ -2,25 +2,76 @@
#/laravel_app/vendor/
#/laravel_app/.env
.idea/
# Python Ignores
/python_app/__pycache__/
/python_app/*.pyc
__pycache__/
*.pyc
*.pyo
# R Ignores
/r_app/*.Rhistory
/r_app/*.Rdata
.DS_Store
# R Output Files
*.Rout
*.Rhistory
*.RData
*.Rdata
.Rproj.user
Rplots.pdf
*.pdf
# R Data Files
*.rds
!renv.lock
# Data Files (Excel, CSV, Text)
*.xlsx
*.csv
*.txt
!python_app/requirements*.txt
!PACKAGE_MANAGEMENT.md
!README.md
!LICENSE.txt
# Spatial Data
*.tif
*.geojson
!r_app/experiments/pivot.geojson
# Generated Reports and Word Documents
r_app/output/
r_app/*.docx
!r_app/word-styles-reference-var1.docx
output/
reports/
*.docx
# Logs
*.log
package_manager.log
# Laravel Storage (contains user data and outputs)
laravel_app/storage/app/*/Data/
laravel_app/storage/app/*/reports/
/laravel_app/public/*
!/laravel_app/public/.htaccess
!/laravel_app/public/index.php
!/laravel_app/public/robots.txt
# R Environment (renv)
renv/library/
!renv/library/.gitkeep
renv/local/
renv/python/
renv/staging/
# Keep only these renv files
!renv.lock
!renv/activate.R
!renv/settings.json
!renv/.gitignore
# IDE and OS
.DS_Store
.Rproj.user
.idea/
.vscode/
# Data and output files
*.tif
*.csv
*.txt
*.docx

31
06_run_crop_messaging.sh Normal file
View file

@ -0,0 +1,31 @@
#!/bin/bash
# Run crop messaging analysis (06_crop_messaging)
# Usage: ./06_run_crop_messaging.sh --current_week=<week_num> --previous_week=<week_num> --estate_name=<name>
current_week=$(date +%V) # Current ISO week number
previous_week=$((current_week - 1))
estate_name="aura"
for arg in "$@"; do
case $arg in
--current_week=*)
current_week="${arg#*=}"
;;
--previous_week=*)
previous_week="${arg#*=}"
;;
--estate_name=*)
estate_name="${arg#*=}"
;;
*)
echo "Unknown option: $arg"
exit 1
;;
esac
shift
done
echo "Running crop messaging analysis for $estate_name: week $previous_week → week $current_week."
cd r_app
Rscript 06_crop_messaging $current_week $previous_week $estate_name
cd ..

188
09_run_calculate_kpis.sh Normal file
View file

@ -0,0 +1,188 @@
#!/bin/bash
# 09_RUN_CALCULATE_KPIS.SH
# ======================
# Shell script wrapper for KPI calculation in the SmartCane pipeline
# This script integrates KPI calculation into the existing pipeline sequence (01-05)
# and ensures proper R execution with renv environment and error handling.
# Script configuration
SCRIPT_NAME="09_run_calculate_kpis.sh"
R_SCRIPT_NAME="09_calculate_kpis.R"
LOG_PREFIX="[KPI_CALC]"
# Function to log messages with timestamp
log_message() {
echo "$(date '+%Y-%m-%d %H:%M:%S') $LOG_PREFIX $1"
}
# Function to handle errors
handle_error() {
log_message "ERROR: $1"
exit 1
}
# Function to check if file exists
check_file() {
if [ ! -f "$1" ]; then
handle_error "Required file not found: $1"
fi
}
# Function to check if directory exists
check_directory() {
if [ ! -d "$1" ]; then
log_message "WARNING: Directory not found: $1"
return 1
fi
return 0
}
# Main execution function
main() {
log_message "Starting KPI calculation pipeline step"
# Check if we're in the correct directory
if [ ! -f "r_app/$R_SCRIPT_NAME" ]; then
handle_error "Must be run from smartcane root directory (where r_app/ folder exists)"
fi
# Check for R installation
if ! command -v R &> /dev/null; then
# Try Windows R installation path
R_CMD="C:/Program Files/R/R-4.4.3/bin/x64/R.exe"
if [ ! -f "$R_CMD" ]; then
handle_error "R not found in PATH or at expected Windows location"
fi
else
R_CMD="R"
fi
log_message "Using R at: $R_CMD"
# Set default project directory if not provided
if [ -z "$1" ]; then
PROJECT_DIR="esa"
log_message "No project directory specified, using default: $PROJECT_DIR"
else
PROJECT_DIR="$1"
log_message "Using project directory: $PROJECT_DIR"
fi
# Check if project directory exists
PROJECT_PATH="laravel_app/storage/app/$PROJECT_DIR"
check_directory "$PROJECT_PATH" || handle_error "Project directory not found: $PROJECT_PATH"
# Check for required data files
check_file "$PROJECT_PATH/Data/pivot.geojson"
# Check for weekly mosaic directory
MOSAIC_DIR="$PROJECT_PATH/weekly_mosaic"
check_directory "$MOSAIC_DIR" || handle_error "Weekly mosaic directory not found: $MOSAIC_DIR"
# Count available mosaics
MOSAIC_COUNT=$(find "$MOSAIC_DIR" -name "week_*.tif" 2>/dev/null | wc -l)
if [ "$MOSAIC_COUNT" -lt 1 ]; then
handle_error "No weekly mosaics found in $MOSAIC_DIR"
fi
log_message "Found $MOSAIC_COUNT weekly mosaics in $MOSAIC_DIR"
# Create temporary R script with project configuration
TEMP_R_SCRIPT="temp_kpi_calc_$$.R"
cat > "r_app/$TEMP_R_SCRIPT" << EOF
# Temporary KPI calculation script
# Generated by $SCRIPT_NAME on $(date)
# Set project directory
project_dir <- "$PROJECT_DIR"
# Set working directory to r_app
setwd("r_app")
# Source the main KPI calculation script
tryCatch({
source("$R_SCRIPT_NAME")
cat("✓ KPI calculation completed successfully\\n")
}, error = function(e) {
cat("✗ Error in KPI calculation:", e\$message, "\\n")
quit(status = 1)
})
EOF
log_message "Created temporary R script: r_app/$TEMP_R_SCRIPT"
# Execute R script
log_message "Starting R execution..."
# Change to smartcane root directory for proper relative paths
cd "$(dirname "$0")" || handle_error "Failed to change to script directory"
# Run R script with proper error handling
if [[ "$OSTYPE" == "msys" || "$OSTYPE" == "win32" ]]; then
# Windows execution
"$R_CMD" --vanilla < "r_app/$TEMP_R_SCRIPT"
R_EXIT_CODE=$?
else
# Unix/Linux execution
"$R_CMD" --vanilla < "r_app/$TEMP_R_SCRIPT"
R_EXIT_CODE=$?
fi
# Clean up temporary script
rm -f "r_app/$TEMP_R_SCRIPT"
log_message "Cleaned up temporary R script"
# Check R execution result
if [ $R_EXIT_CODE -eq 0 ]; then
log_message "✓ KPI calculation completed successfully"
# Check if output files were created
REPORTS_DIR="laravel_app/storage/app/$PROJECT_DIR/reports"
if check_directory "$REPORTS_DIR/kpis"; then
KPI_FILES=$(find "$REPORTS_DIR/kpis" -name "*$(date '+%Y%m%d')*" 2>/dev/null | wc -l)
if [ "$KPI_FILES" -gt 0 ]; then
log_message "✓ Generated $KPI_FILES KPI output files"
else
log_message "⚠ Warning: No KPI files found for today's date"
fi
fi
log_message "KPI calculation pipeline step completed successfully"
return 0
else
handle_error "R script execution failed with exit code: $R_EXIT_CODE"
fi
}
# Script usage information
usage() {
echo "Usage: $0 [PROJECT_DIR]"
echo ""
echo "Calculate KPI metrics for SmartCane monitoring system"
echo ""
echo "Parameters:"
echo " PROJECT_DIR Project directory name (default: esa)"
echo " Must exist in laravel_app/storage/app/"
echo ""
echo "Examples:"
echo " $0 # Use default 'esa' project"
echo " $0 aura # Use 'aura' project"
echo " $0 chemba # Use 'chemba' project"
echo ""
echo "Requirements:"
echo " - R installation (4.4.3 or compatible)"
echo " - renv environment set up"
echo " - Weekly mosaic files in PROJECT_DIR/weekly_mosaic/"
echo " - Field boundaries in PROJECT_DIR/Data/pivot.geojson"
}
# Handle command line arguments
case "${1:-}" in
-h|--help)
usage
exit 0
;;
*)
main "$@"
;;
esac

56
10_run_kpi_report.sh Normal file
View file

@ -0,0 +1,56 @@
#!/bin/bash
# Run CI report with KPIs (10_CI_report_with_kpis_simple.Rmd)
# Usage: ./10_run_kpi_report.sh --filename=<output.docx> --report_date=<YYYY-MM-DD> --mail_day=<day> --data_dir=<project> --borders=<TRUE|FALSE> --ci_plot_type=<both|absolute|cumulative> --colorblind_friendly=<TRUE|FALSE> --facet_by_season=<TRUE|FALSE> --x_axis_unit=<days|weeks>
filename="CI_report_with_kpis.docx"
report_date="$(date +%Y-%m-%d)"
mail_day="Monday"
data_dir="aura"
borders="FALSE"
ci_plot_type="both"
colorblind_friendly="TRUE"
facet_by_season="FALSE"
x_axis_unit="days"
for arg in "$@"; do
case $arg in
--filename=*)
filename="${arg#*=}"
;;
--report_date=*)
report_date="${arg#*=}"
;;
--mail_day=*)
mail_day="${arg#*=}"
;;
--data_dir=*)
data_dir="${arg#*=}"
;;
--borders=*)
borders="${arg#*=}"
;;
--ci_plot_type=*)
ci_plot_type="${arg#*=}"
;;
--colorblind_friendly=*)
colorblind_friendly="${arg#*=}"
;;
--facet_by_season=*)
facet_by_season="${arg#*=}"
;;
--x_axis_unit=*)
x_axis_unit="${arg#*=}"
;;
*)
echo "Unknown option: $arg"
exit 1
;;
esac
shift
done
echo "Running CI report with KPIs for $data_dir, report date $report_date, mail day $mail_day."
echo "Parameters: borders=$borders, ci_plot_type=$ci_plot_type, colorblind=$colorblind_friendly, facet_by_season=$facet_by_season, x_axis_unit=$x_axis_unit"
cd r_app
Rscript -e "rmarkdown::render('10_CI_report_with_kpis_simple.Rmd', output_file='$filename', params=list(report_date='$report_date', mail_day='$mail_day', data_dir='$data_dir', borders='$borders', ci_plot_type='$ci_plot_type', colorblind_friendly='$colorblind_friendly', facet_by_season='$facet_by_season', x_axis_unit='$x_axis_unit'))"
cd ..

299
DEPLOYMENT_README.md Normal file
View file

@ -0,0 +1,299 @@
# SmartCane Deployment Guide
**Quick Reference for Bitbucket Push & Server Deployment**
---
## 🎯 TL;DR - WHAT YOU NEED TO KNOW
### What's New:
- ✅ **Scripts 09 & 10** are NEW - they generate reports WITH KPIs (field uniformity, stress detection)
- ✅ **2 new packages** to install: `flextable` and `officer` (for better tables in Word reports)
- ✅ **Shell script wrappers** (01-10) make execution easier
### Workflow Change:
```bash
# OLD (master branch):
Manual R script execution
# NEW (code-improvements branch):
./01_run_planet_download.sh
./02_run_ci_extraction.sh
./03_run_growth_model.sh
./04_run_mosaic_creation.sh
# SKIP 05 (old report without KPIs)
./09_run_calculate_kpis.sh # NEW - calculate KPIs first
./10_run_kpi_report.sh # NEW - generate report WITH KPIs
```
### For Your Admin:
1. Install 2 new R packages: `Rscript -e "renv::restore()"`
2. Run scripts in order: 01→02→03→04→09→10 (skip 05)
3. Script 10 parameters are configurable (see below)
**That's it!** Read below for details if needed.
---
## 📦 WHAT CHANGED FROM MASTER BRANCH
### NEW Scripts (not in master):
| Script | Purpose | Status |
|--------|---------|--------|
| `09_run_calculate_kpis.sh` | Calculate field KPIs | ⭐ Required |
| `10_run_kpi_report.sh` | Generate reports WITH KPIs | ⭐ Required |
| `01-05_run_*.sh` | Shell wrappers for existing R scripts | ✅ Helpful |
### NEW R Files:
- `r_app/09_calculate_kpis.R` - KPI calculation logic
- `r_app/10_CI_report_with_kpis_simple.Rmd` - Enhanced report template
- `r_app/kpi_utils.R` - KPI utility functions
### NEW R Packages (in renv.lock):
- `flextable` - Enhanced table formatting for Word
- `officer` - Word document manipulation
### RENAMED Files:
- `ci_extraction.R` → `02_ci_extraction.R`
- `interpolate_growth_model.R` → `03_interpolate_growth_model.R`
- `mosaic_creation.R` → `04_mosaic_creation.R`
### DELETED Files:
- Old package management scripts (now using renv only)
- Duplicate geometry files
- Laravel build artifacts (will regenerate)
**Total:** 90 files changed, +12,309 lines added, -7,132 lines removed
---
## 💻 LINUX SERVER DEPLOYMENT
### Step 1: Install System Dependencies
```bash
sudo apt-get update
sudo apt-get install -y \
libgdal-dev libgeos-dev libproj-dev libudunits2-dev \
libcurl4-openssl-dev libssl-dev libxml2-dev \
libfontconfig1-dev libharfbuzz-dev libfribidi-dev \
pandoc pandoc-citeproc
```
### Step 2: Clone & Setup
```bash
git clone <bitbucket-url> smartcane
cd smartcane
chmod +x *.sh
dos2unix *.sh # Fix Windows line endings
```
### Step 3: Install R Packages
```bash
Rscript -e "renv::restore()"
```
### Step 4: Test Workflow
```bash
./09_run_calculate_kpis.sh aura
./10_run_kpi_report.sh --data_dir=aura --filename=test.docx
ls laravel_app/storage/app/aura/reports/
```
---
## ⚙️ SCRIPT 10 PARAMETERS (for Laravel UI)
### Configurable Parameters (add to Laravel project settings):
| Parameter | Type | Default | Options | Description |
|-----------|------|---------|---------|-------------|
| `borders` | Boolean | FALSE | TRUE/FALSE | Show field borders on maps |
| `ci_plot_type` | String | both | absolute/cumulative/both | Type of CI plots |
| `colorblind_friendly` | Boolean | TRUE | TRUE/FALSE | Use accessible color palettes |
| `facet_by_season` | Boolean | FALSE | TRUE/FALSE | Split plots by season |
| `x_axis_unit` | String | days | days/weeks | X-axis time unit |
### Auto-Set Parameters (managed by system):
| Parameter | Source | Description |
|-----------|--------|-------------|
| `filename` | Auto-generated | Set by system: `{project}_{date}.docx` |
| `report_date` | Current date | Automatically uses today's date |
| `mail_day` | Current day | Automatically uses current weekday |
| `data_dir` | Project name | Set from Laravel project configuration |
### Laravel Implementation Notes:
1. **Create settings per project** with the 5 configurable parameters above
2. **Auto-generate filename**: `${project_name}_report_${date}.docx`
3. **Auto-set dates**: Use current date/day when script runs
4. **data_dir**: Pull from project's directory name in Laravel
**Example usage:**
```bash
./10_run_kpi_report.sh \
--data_dir=aura \
--report_date=$(date +%Y-%m-%d) \
--filename="aura_report_$(date +%Y%m%d).docx" \
--mail_day=$(date +%A) \
--borders=FALSE \
--ci_plot_type=both \
--colorblind_friendly=TRUE \
--facet_by_season=FALSE \
--x_axis_unit=days
```
---
## 🚨 COMMON DEPLOYMENT ERRORS
### Error 1: Package Compilation Fails
```
ERROR: configuration failed for package 'sf'
```
**Solution:** Install system dependencies (see Step 1 above)
### Error 2: Permission Denied
```
bash: ./10_run_kpi_report.sh: Permission denied
```
**Solution:** `chmod +x *.sh`
### Error 3: Line Ending Issues
```
/bin/bash^M: bad interpreter
```
**Solution:** `dos2unix *.sh` or `sed -i 's/\r$//' *.sh`
### Error 4: Pandoc Missing
```
Error: pandoc version 1.12.3 or higher is required
```
**Solution:** `sudo apt-get install -y pandoc`
### Error 5: Font Errors
```
Error in gdtools::...: font family not found
```
**Solution:** Install font libraries (libfontconfig1-dev, etc. - see Step 1)
---
## 📊 SCRIPT COMPARISON: Old vs New
### Script 05 (OLD - skip this):
- Basic CI maps ✅
- CI trend plots ✅
- Week-over-week change ✅
- **NO KPI metrics** ❌
- **NO field uniformity** ❌
- **NO priority detection** ❌
### Scripts 09 + 10 (NEW - use these):
- Everything from script 05 ✅
- **KPI metrics** ✅
- **Field uniformity (CV, Moran's I)** ✅
- **Priority classification** (urgent/monitor/no stress) ✅
- **Enhanced tables** (flextable formatting) ✅
- **Field stress detection** ✅
---
## ⚠️ WINDOWS → LINUX COMPATIBILITY
**Known issues when moving from Windows to Linux:**
| Issue | Windows | Linux | Solution |
|-------|---------|-------|----------|
| Path separators | `\` | `/` | Scripts use `here::here()` ✅ |
| Line endings | CRLF | LF | Run `dos2unix *.sh` |
| Package compilation | Binary | Source | Install system libs first |
| File permissions | Auto | Manual | Run `chmod +x *.sh` |
| R path | Fixed path | In PATH | Scripts auto-detect ✅ |
---
## ✅ DEPLOYMENT CHECKLIST
**Before pushing to Bitbucket:**
- [ ] Verify scripts 09 and 10 work locally
- [ ] Check renv.lock is committed
- [ ] Test workflow: 01→02→03→04→09→10
**After pulling on Linux server:**
- [ ] Install system dependencies (GDAL, GEOS, PROJ, Pandoc, fonts)
- [ ] Clone repository
- [ ] Fix line endings: `dos2unix *.sh`
- [ ] Set permissions: `chmod +x *.sh`
- [ ] Install R packages: `Rscript -e "renv::restore()"`
- [ ] Test with one project: `./09_run_calculate_kpis.sh aura`
- [ ] Generate test report: `./10_run_kpi_report.sh --data_dir=aura`
- [ ] Create Laravel UI for script 10 parameters
- [ ] Update any automation scripts to use new workflow
---
## 📂 KEY FILES TO KNOW
```
smartcane/
├── 01-04_*.sh # Data acquisition (existing workflow)
├── 05_*.sh # ❌ Old report (skip)
├── 09_*.sh # ✅ NEW - KPI calculation
├── 10_*.sh # ✅ NEW - Report with KPIs
├── renv.lock # Package versions (includes flextable/officer)
└── r_app/
├── 09_calculate_kpis.R # NEW
├── 10_CI_report_with_kpis_simple.Rmd # NEW
└── kpi_utils.R # NEW
```
---
## 🔄 EXAMPLE: Full Weekly Pipeline
```bash
#!/bin/bash
# Complete weekly workflow for Aura farm
PROJECT="aura"
DATE=$(date +%Y-%m-%d)
# Step 1-4: Data acquisition
./01_run_planet_download.sh --project_dir=$PROJECT
./02_run_ci_extraction.sh --project_dir=$PROJECT
./03_run_growth_model.sh --project_dir=$PROJECT
./04_run_mosaic_creation.sh --data_dir=$PROJECT
# Step 5-6: KPI calculation & reporting (NEW)
./09_run_calculate_kpis.sh $PROJECT
./10_run_kpi_report.sh \
--data_dir=$PROJECT \
--report_date=$DATE \
--filename="${PROJECT}_${DATE}.docx" \
--colorblind_friendly=TRUE
echo "✅ Pipeline complete! Check output/"
```
---
## 📞 TROUBLESHOOTING
**If deployment fails:**
1. Check error against "Common Errors" section above
2. Verify system dependencies: `dpkg -l | grep libgdal`
3. Test R packages: `Rscript -e "library(flextable)"`
4. Check file structure: `ls laravel_app/storage/app/*/`
5. Review logs: `./10_run_kpi_report.sh 2>&1 | tee debug.log`
**Still stuck?** Contact developer with:
- Full error message
- Which script failed
- Output of `sessionInfo()` in R
- Server OS and R version
---
**Version:** 1.0
**Last Updated:** October 14, 2025
**Branch:** code-improvements (ready for merge to master)

136
analyze_image_availability.R Normal file
View file

@ -0,0 +1,136 @@
# R script to analyze image dates and missing weeks
library(dplyr)
library(lubridate)
library(ggplot2)
# Set folder path
folder <- "laravel_app/storage/app/esa/merged_final_tif"
files <- list.files(folder, pattern = "\\.tif$", full.names = FALSE)
df <- data.frame(date = dates)
# Extract dates and file sizes
dates <- as.Date(sub(".tif$", "", files))
sizes_kb <- file.info(file.path(folder, files))$size / 1024
df <- data.frame(date = dates, size_kb = sizes_kb, file = files) %>%
mutate(year = year(date),
week = isoweek(date),
completeness = ifelse(size_kb >= 9000, "Complete", "Incomplete"))
# Get all years in data
years <- sort(unique(df$year))
# Prepare output table
output <- data.frame(
year = integer(),
n_images = integer(),
n_weeks_missing = integer(),
max_consec_weeks_missing = integer(),
avg_images_per_week = numeric(),
stringsAsFactors = FALSE
)
missing_weeks_list <- list()
current_year <- as.integer(format(Sys.Date(), "%Y"))
# For plotting: build a data frame with all year/week combinations and count images per week
# For plotting: count complete/incomplete images per week/year
plot_weeks <- expand.grid(year = years, week = 1:52, completeness = c("Complete", "Incomplete"))
plot_weeks$n_images <- 0
for (i in seq_len(nrow(plot_weeks))) {
y <- plot_weeks$year[i]
w <- plot_weeks$week[i]
ctype <- plot_weeks$completeness[i]
plot_weeks$n_images[i] <- sum(df$year == y & df$week == w & df$completeness == ctype)
}
# Plot: X = week, Y = number of images, fill = completeness, color = year (stacked bar chart)
gg <- ggplot(plot_weeks, aes(x = week, y = n_images, fill = completeness)) +
geom_col(position = "stack") +
facet_wrap(~ year, ncol = 1) +
scale_x_continuous(breaks = 1:52) +
scale_y_continuous(breaks = 0:max(plot_weeks$n_images)) +
labs(x = "Week number", y = "Number of images", fill = "Completeness",
title = "Complete vs Incomplete Images per Week (by Year)") +
theme_minimal()
ggsave("images_per_week_by_year_stacked.png", gg, width = 12, height = 10)
cat("Plot saved as images_per_week_by_year_stacked.png\n")
current_week <- isoweek(Sys.Date())
for (y in years) {
# For current year, only consider weeks up to today; for past years, all 1:52
if (y == current_year) {
all_weeks <- 1:current_week
} else {
all_weeks <- 1:52
}
weeks_with_images <- unique(df$week[df$year == y])
weeks_missing <- setdiff(all_weeks, weeks_with_images)
n_weeks_missing <- length(weeks_missing)
n_images <- sum(df$year == y)
if ((y == current_year) && (current_week - n_weeks_missing > 0)) {
avg_images_per_week <- n_images / (current_week - n_weeks_missing)
} else if (y != current_year && (52 - n_weeks_missing > 0)) {
avg_images_per_week <- n_images / (52 - n_weeks_missing)
} else {
avg_images_per_week <- NA
}
# Find longest run of consecutive missing weeks
if (n_weeks_missing == 0) {
max_consec <- 0
} else {
w <- sort(weeks_missing)
runs <- rle(c(1, diff(w)) == 1)
max_consec <- max(runs$lengths[runs$values], na.rm = TRUE)
}
output <- rbind(output, data.frame(
year = y,
n_images = n_images,
n_weeks_missing = n_weeks_missing,
max_consec_weeks_missing = max_consec,
avg_images_per_week = round(avg_images_per_week, 2)
))
if (n_weeks_missing > 0) {
missing_weeks_list[[as.character(y)]] <- weeks_missing
}
}
# Write to CSV
print(output)
write.csv(output, file = "image_availability_by_year.csv", row.names = FALSE)
# Print missing weeks for years with missing data
for (y in names(missing_weeks_list)) {
cat(sprintf("Year %s missing weeks: %s\n", y, paste(missing_weeks_list[[y]], collapse=", ")))
}
# Calculate and print max consecutive weeks with only incomplete data per year
cat("\nMax consecutive weeks with only incomplete images per year:\n")
for (y in years) {
if (y == current_year) {
all_weeks <- 1:current_week
} else {
all_weeks <- 1:52
}
# Weeks where all images are incomplete (no complete images)
weeks_incomplete <- plot_weeks$week[plot_weeks$year == y & plot_weeks$completeness == "Complete" & plot_weeks$n_images == 0]
# Only keep weeks that actually have at least one image (i.e., not missing entirely)
weeks_with_any_image <- unique(df$week[df$year == y])
weeks_incomplete <- intersect(weeks_incomplete, weeks_with_any_image)
if (length(weeks_incomplete) == 0) {
max_consec_incomplete <- 0
} else {
w <- sort(weeks_incomplete)
runs <- rle(c(1, diff(w)) == 1)
max_consec_incomplete <- max(runs$lengths[runs$values], na.rm = TRUE)
}
cat(sprintf("Year %d: %d\n", y, max_consec_incomplete))
}

207
cleanup_repo.ps1 Normal file
View file

@ -0,0 +1,207 @@
# SmartCane Repository Cleanup Script
# This script will delete unnecessary files and move experimental scripts
# Review this script before running: .\cleanup_repo.ps1
Write-Host "🧹 SmartCane Repository Cleanup" -ForegroundColor Cyan
Write-Host "================================" -ForegroundColor Cyan
Write-Host ""
$deletedCount = 0
$movedCount = 0
$errors = @()
# ============================================================================
# PART 1: DELETE FILES
# ============================================================================
Write-Host "📁 PART 1: Deleting files..." -ForegroundColor Yellow
Write-Host ""
# A) Test & Debug Scripts
$testFiles = @(
"r_app/test_benchmarks.R",
"r_app/test_harvest.R",
"r_app/test_kpis_esa.R",
"r_app/debug_kpis.R",
"r_app/quick_layout_test.R",
"r_app/run_minimal_test.R"
)
Write-Host "Deleting test and debug scripts..." -ForegroundColor Gray
foreach ($file in $testFiles) {
if (Test-Path $file) {
Remove-Item $file -Force
Write-Host " ✓ Deleted: $file" -ForegroundColor Green
$deletedCount++
} else {
Write-Host " ⚠ Not found: $file" -ForegroundColor DarkGray
}
}
# B) Output Files (.Rout)
$routFiles = @(
"r_app/02_ci_extraction.Rout",
"r_app/03_interpolate_growth_model.Rout",
"r_app/04_mosaic_creation.Rout"
)
Write-Host "`nDeleting .Rout files..." -ForegroundColor Gray
foreach ($file in $routFiles) {
if (Test-Path $file) {
Remove-Item $file -Force
Write-Host " ✓ Deleted: $file" -ForegroundColor Green
$deletedCount++
} else {
Write-Host " ⚠ Not found: $file" -ForegroundColor DarkGray
}
}
# C) Temporary PDF Files
$pdfFiles = @(
"Rplots.pdf",
"r_app/Rplots.pdf"
)
Write-Host "`nDeleting temporary PDF files..." -ForegroundColor Gray
foreach ($file in $pdfFiles) {
if (Test-Path $file) {
Remove-Item $file -Force
Write-Host " ✓ Deleted: $file" -ForegroundColor Green
$deletedCount++
} else {
Write-Host " ⚠ Not found: $file" -ForegroundColor DarkGray
}
}
# D) Old/Deprecated Scripts
$oldScripts = @(
"r_app/ci_extraction.R",
"r_app/interpolate_growth_model.R",
"r_app/mosaic_creation.R",
"r_app/installPackages.R",
"r_app/packages.R",
"generated_package_config.R"
)
Write-Host "`nDeleting old/deprecated scripts..." -ForegroundColor Gray
foreach ($file in $oldScripts) {
if (Test-Path $file) {
Remove-Item $file -Force
Write-Host " ✓ Deleted: $file" -ForegroundColor Green
$deletedCount++
} else {
Write-Host " ⚠ Not found: $file" -ForegroundColor DarkGray
}
}
# E) Generated Word Documents
$wordDocs = @(
"r_app/CI_report.docx",
"r_app/CI_report2.docx",
"r_app/CI_report_age_filtered.docx",
"r_app/CI_report_last_week.docx",
"r_app/CI_report_week38_corrected.docx",
"r_app/CI_report_with_kpis_aura.docx",
"r_app/CI_report_with_kpis_esa.docx",
"r_app/05_CI_report_dashboard_planet.docx",
"r_app/10_CI_report_with_kpis_simple.docx",
"r_app/script5_test.docx",
"r_app/test_kpi_grid.docx",
"r_app/output/aura/crop_analysis_AURA_w36vs35_20250916_1631.docx",
"r_app/output/reports/CI_report_with_kpis_simple_test.docx",
"r_app/output/CI_report_2x3_layout.docx",
"r_app/output/CI_report_consolidated.docx",
"r_app/output/CI_report_layout_test.docx",
"r_app/output/test_clean.docx",
"r_app/output/test_grid.docx",
"r_app/output/test_kables.docx",
"r_app/output/test_merged.docx"
)
Write-Host "`nDeleting generated Word documents (keeping word-styles-reference-var1.docx)..." -ForegroundColor Gray
foreach ($file in $wordDocs) {
if (Test-Path $file) {
Remove-Item $file -Force
Write-Host " ✓ Deleted: $file" -ForegroundColor Green
$deletedCount++
} else {
Write-Host " ⚠ Not found: $file" -ForegroundColor DarkGray
}
}
# ============================================================================
# PART 2: MOVE FILES TO EXPERIMENTS
# ============================================================================
Write-Host "`n`n📁 PART 2: Moving files to experiments..." -ForegroundColor Yellow
Write-Host ""
# Create destination directories
$destDirs = @(
"r_app/experiments/reports",
"r_app/experiments/legacy_package_management"
)
foreach ($dir in $destDirs) {
if (!(Test-Path $dir)) {
New-Item -ItemType Directory -Path $dir -Force | Out-Null
Write-Host " Created directory: $dir" -ForegroundColor Cyan
}
}
# Move experimental Rmd files
$rmdFiles = @(
@{Source="r_app/CI_report_dashboard_planet.Rmd"; Dest="r_app/experiments/reports/"},
@{Source="r_app/CI_report_dashboard_planet_enhanced.Rmd"; Dest="r_app/experiments/reports/"},
@{Source="r_app/CI_report_executive_summary.Rmd"; Dest="r_app/experiments/reports/"},
@{Source="r_app/simple_kpi_report.Rmd"; Dest="r_app/experiments/reports/"},
@{Source="r_app/test_kpi_grid.Rmd"; Dest="r_app/experiments/reports/"},
@{Source="r_app/test_minimal.Rmd"; Dest="r_app/experiments/reports/"}
)
Write-Host "Moving experimental Rmd files..." -ForegroundColor Gray
foreach ($file in $rmdFiles) {
if (Test-Path $file.Source) {
Move-Item $file.Source $file.Dest -Force
Write-Host " ✓ Moved: $($file.Source) → $($file.Dest)" -ForegroundColor Green
$movedCount++
} else {
Write-Host " ⚠ Not found: $($file.Source)" -ForegroundColor DarkGray
}
}
# Move legacy package management scripts
$legacyFiles = @(
@{Source="r_app/extract_current_versions.R"; Dest="r_app/experiments/legacy_package_management/"},
@{Source="r_app/package_manager.R"; Dest="r_app/experiments/legacy_package_management/"}
)
Write-Host "`nMoving legacy package management scripts..." -ForegroundColor Gray
foreach ($file in $legacyFiles) {
if (Test-Path $file.Source) {
Move-Item $file.Source $file.Dest -Force
Write-Host " ✓ Moved: $($file.Source) → $($file.Dest)" -ForegroundColor Green
$movedCount++
} else {
Write-Host " ⚠ Not found: $($file.Source)" -ForegroundColor DarkGray
}
}
# ============================================================================
# SUMMARY
# ============================================================================
Write-Host "`n`n📊 CLEANUP SUMMARY" -ForegroundColor Cyan
Write-Host "==================" -ForegroundColor Cyan
Write-Host "Files deleted: $deletedCount" -ForegroundColor Green
Write-Host "Files moved: $movedCount" -ForegroundColor Green
if ($errors.Count -gt 0) {
Write-Host "`n⚠️ Errors encountered: $($errors.Count)" -ForegroundColor Red
foreach ($err in $errors) {
Write-Host " $err" -ForegroundColor Red
}
}
Write-Host "`n✅ Cleanup completed!" -ForegroundColor Green
Write-Host "`nNext step: Update .gitignore (see instructions)" -ForegroundColor Yellow

15
examine_kpi_results.R Normal file
View file

@ -0,0 +1,15 @@
# Quick script to examine KPI results
field_details <- readRDS('laravel_app/storage/app/esa/reports/kpis/esa_field_details_week39.rds')
summary_tables <- readRDS('laravel_app/storage/app/esa/reports/kpis/esa_kpi_summary_tables_week39.rds')
cat("=== FIELD DETAILS ===\n")
print(head(field_details, 20))
cat("\nTotal rows:", nrow(field_details), "\n\n")
cat("=== TCH FORECASTED FIELD RESULTS ===\n")
tch_results <- readRDS('laravel_app/storage/app/esa/reports/kpis/field_level/tch_forecasted_field_results_week39.rds')
print(tch_results)
cat("\nNumber of predictions:", nrow(tch_results), "\n\n")
cat("=== SUMMARY TABLES ===\n")
print(summary_tables$tch_forecasted)

42
generated_package_config.R
View file

@ -1,42 +0,0 @@
# Package requirements with your current working versions
REQUIRED_PACKAGES <- list(
# Core data manipulation
"dplyr" = "1.1.4",
"here" = "1.0.1",
"lubridate" = "1.9.4",
"readr" = "2.1.5",
"readxl" = "1.4.5",
"stringr" = "1.5.1",
"tidyr" = "1.3.1",
# Spatial data
"exactextractr" = "0.10.0",
"raster" = "3.6.32",
"sf" = "1.0.19",
"terra" = "1.8.43", # CRITICAL: for raster processing
# Visualization
"ggplot2" = "3.5.1",
"tmap" = "4.0", # CRITICAL: for tm_scale_continuous() syntax
# Reporting
"knitr" = "1.50",
# Tidyverse
"purrr" = "1.0.2",
"tidyverse" = "2.0.0",
# Other packages
"caret" = "7.0.1",
"CAST" = "1.0.3",
"furrr" = "0.3.1",
"future" = "1.40.0",
"gridExtra" = "2.3",
"parallel" = "4.4.2",
"progressr" = "0.15.1",
"randomForest" = "4.7.1.2",
"reshape2" = "1.4.4",
"rsample" = "1.3.0",
"tools" = "4.4.2",
"zoo" = "1.8.13"
)

314
kpi_debug.out Normal file
View file

@ -0,0 +1,314 @@
R version 4.4.3 (2025-02-28 ucrt) -- "Trophy Case"
Copyright (C) 2025 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
Natural language support but running in an English locale
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
- Project 'C:/Users/timon/Resilience BV/4020 SCane ESA DEMO - Documenten/General/4020 SCDEMO Team/4020 TechnicalData/WP3/smartcane_v2/smartcane' loaded. [renv 1.1.4]
> # 09_CALCULATE_KPIS.R
> # ===================
> # This script calculates 6 Key Performance Indicators (KPIs) for sugarcane monitoring:
> # 1. Field Uniformity Summary
> # 2. Farm-wide Area Change Summary
> # 3. TCH Forecasted
> # 4. Growth Decline Index
> # 5. Weed Presence Score
> # 6. Gap Filling Score (placeholder)
> #
> # Usage: Rscript 09_calculate_kpis.R [end_date] [offset] [project_dir]
> # - end_date: End date for KPI calculation (YYYY-MM-DD format), default: today
> # - offset: Number of days to look back (not currently used for KPIs, but for consistency)
> # - project_dir: Project directory name (e.g., "aura", "esa")
>
> # 1. Load required libraries
> # -------------------------
> suppressPackageStartupMessages({
+ library(here)
+ library(sf)
+ library(terra)
+ library(dplyr)
+ library(tidyr)
+ library(lubridate)
+ library(readr)
+ library(caret)
+ library(CAST)
+ library(randomForest)
+ })
>
> # 2. Main function
> # --------------
> main <- function() {
+ # Process command line arguments
+ args <- commandArgs(trailingOnly = TRUE)
+
+ # Process end_date argument
+ if (length(args) >= 1 && !is.na(args[1])) {
+ end_date <- as.Date(args[1])
+ if (is.na(end_date)) {
+ warning("Invalid end_date provided. Using default (current date).")
+ end_date <- Sys.Date()
+ }
+ } else {
+ end_date <- Sys.Date()
+ }
+
+ # Process offset argument (for consistency with other scripts, not currently used)
+ if (length(args) >= 2 && !is.na(args[2])) {
+ offset <- as.numeric(args[2])
+ if (is.na(offset) || offset <= 0) {
+ warning("Invalid offset provided. Using default (7 days).")
+ offset <- 7
+ }
+ } else {
+ offset <- 7
+ }
+
+ # Process project_dir argument
+ if (length(args) >= 3 && !is.na(args[3])) {
+ project_dir <- as.character(args[3])
+ } else {
+ project_dir <- "esa" # Default project
+ }
+
+ # Make project_dir available globally so parameters_project.R can use it
+ assign("project_dir", project_dir, envir = .GlobalEnv)
+
+ # 3. Load utility functions and project configuration
+ # --------------------------------------------------
+
+ tryCatch({
+ source(here("r_app", "crop_messaging_utils.R"))
+ }, error = function(e) {
+ stop("Error loading crop_messaging_utils.R: ", e$message)
+ })
+
+ tryCatch({
+ source(here("r_app", "kpi_utils.R"))
+ }, error = function(e) {
+ stop("Error loading kpi_utils.R: ", e$message)
+ })
+
+ # Load project parameters (this sets up all directory paths and field boundaries)
+ tryCatch({
+ source(here("r_app", "parameters_project.R"))
+ }, error = function(e) {
+ stop("Error loading parameters_project.R: ", e$message)
+ })
+
+ # Load growth model utils if available (for yield prediction)
+ tryCatch({
+ source(here("r_app", "growth_model_utils.R"))
+ }, error = function(e) {
+ warning("growth_model_utils.R not found, yield prediction KPI will use placeholder data")
+ })
+
+ # Check if required variables exist
+ if (!exists("project_dir")) {
+ stop("project_dir must be set before running this script")
+ }
+
+ if (!exists("field_boundaries_sf") || is.null(field_boundaries_sf)) {
+ stop("Field boundaries not loaded. Check parameters_project.R initialization.")
+ }
+
+ # 4. Calculate all KPIs
+ # -------------------
+ output_dir <- file.path(reports_dir, "kpis")
+
+ kpi_results <- calculate_all_kpis(
+ report_date = end_date,
+ output_dir = output_dir,
+ field_boundaries_sf = field_boundaries_sf,
+ harvesting_data = harvesting_data,
+ cumulative_CI_vals_dir = cumulative_CI_vals_dir,
+ weekly_CI_mosaic = weekly_CI_mosaic,
+ reports_dir = reports_dir,
+ project_dir = project_dir
+ )
+
+ # 5. Print summary
+ # --------------
+ cat("\n=== KPI CALCULATION SUMMARY ===\n")
+ cat("Report Date:", as.character(kpi_results$metadata$report_date), "\n")
+ cat("Current Week:", kpi_results$metadata$current_week, "\n")
+ cat("Previous Week:", kpi_results$metadata$previous_week, "\n")
+ cat("Total Fields Analyzed:", kpi_results$metadata$total_fields, "\n")
+ cat("Calculation Time:", as.character(kpi_results$metadata$calculation_time), "\n")
+
+ cat("\nField Uniformity Summary:\n")
+ print(kpi_results$field_uniformity_summary)
+
+ cat("\nArea Change Summary:\n")
+ print(kpi_results$area_change)
+
+ cat("\nTCH Forecasted:\n")
+ print(kpi_results$tch_forecasted)
+
+ cat("\nGrowth Decline Index:\n")
+ print(kpi_results$growth_decline)
+
+ cat("\nWeed Presence Score:\n")
+ print(kpi_results$weed_presence)
+
+ cat("\nGap Filling Score:\n")
+ print(kpi_results$gap_filling)
+
+ cat("\n=== KPI CALCULATION COMPLETED ===\n")
+ }
>
> # 6. Script execution
> # -----------------
> if (sys.nframe() == 0) {
+ main()
+ }
[INFO] 2025-10-08 15:39:29 - Initializing project with directory: esa
[1] "model using cumulative_CI,DOY will be trained now..."
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
+ Fold1: mtry=2
- Fold1: mtry=2
+ Fold2: mtry=2
- Fold2: mtry=2
+ Fold3: mtry=2
- Fold3: mtry=2
+ Fold4: mtry=2
- Fold4: mtry=2
+ Fold5: mtry=2
- Fold5: mtry=2
Aggregating results
Fitting final model on full training set
[1] "maximum number of models that still need to be trained: 3"
[1] "model using cumulative_CI,CI_per_day will be trained now..."
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
+ Fold1: mtry=2
- Fold1: mtry=2
+ Fold2: mtry=2
- Fold2: mtry=2
+ Fold3: mtry=2
- Fold3: mtry=2
+ Fold4: mtry=2
- Fold4: mtry=2
+ Fold5: mtry=2
- Fold5: mtry=2
Aggregating results
Fitting final model on full training set
[1] "maximum number of models that still need to be trained: 2"
[1] "model using DOY,CI_per_day will be trained now..."
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .
+ Fold1: mtry=2
- Fold1: mtry=2
+ Fold2: mtry=2
- Fold2: mtry=2
+ Fold3: mtry=2
- Fold3: mtry=2
+ Fold4: mtry=2
- Fold4: mtry=2
+ Fold5: mtry=2
- Fold5: mtry=2
Aggregating results
Fitting final model on full training set
[1] "maximum number of models that still need to be trained: 1"
[1] "vars selected: cumulative_CI,DOY with RMSE 24.808"
[1] "model using additional variable CI_per_day will be trained now..."
note: only 2 unique complexity parameters in default grid. Truncating the grid to 2 .
+ Fold1: mtry=2
- Fold1: mtry=2
+ Fold1: mtry=3
- Fold1: mtry=3
+ Fold2: mtry=2
- Fold2: mtry=2
+ Fold2: mtry=3
- Fold2: mtry=3
+ Fold3: mtry=2
- Fold3: mtry=2
+ Fold3: mtry=3
- Fold3: mtry=3
+ Fold4: mtry=2
- Fold4: mtry=2
+ Fold4: mtry=3
- Fold4: mtry=3
+ Fold5: mtry=2
- Fold5: mtry=2
+ Fold5: mtry=3
- Fold5: mtry=3
Aggregating results
Selecting tuning parameters
Fitting mtry = 3 on full training set
[1] "maximum number of models that still need to be trained: 0"
[1] "vars selected: cumulative_CI,DOY with RMSE 24.808"
field_groups count value
75% Top 25% 3 96.2
50% Average 7 93.0
25% Lowest 25% 2 84.0
Total area forecasted 12 219.0
=== KPI CALCULATION SUMMARY ===
Report Date: 2025-10-08
Current Week: 40
Previous Week: 39
Total Fields Analyzed: 12
Calculation Time: 2025-10-08 15:39:34.583434
Field Uniformity Summary:
uniformity_level count percent
1 Excellent 0 0
2 Good 0 0
3 Moderate 0 0
4 Poor 0 0
Area Change Summary:
change_type hectares percent
1 Improving areas 0 0
2 Stable areas 0 0
3 Declining areas 0 0
4 Total area 0 100
TCH Forecasted:
field_groups count value
75% Top 25% 3 96.2
50% Average 7 93.0
25% Lowest 25% 2 84.0
Total area forecasted 12 219.0
Growth Decline Index:
risk_level count percent
1 High 0 0
2 Low 0 0
3 Moderate 0 0
4 Very-high 0 0
Weed Presence Score:
weed_risk_level field_count percent
1 Canopy closed - Low weed risk 4 33.3
2 High 0 0.0
3 Low 0 0.0
4 Moderate 0 0.0
Gap Filling Score:
# A tibble: 1 × 3
gap_level field_count percent
<chr> <int> <dbl>
1 <NA> 12 100
=== KPI CALCULATION COMPLETED ===
There were 50 or more warnings (use warnings() to see the first 50)
>
> proc.time()
user system elapsed
11.93 0.93 13.45

72
push_to_bitbucket.ps1 Normal file
View file

@ -0,0 +1,72 @@
# SmartCane - Git Push to Bitbucket
# Run this script to commit and push all changes
# Step 1: Check current status
Write-Host "=== Current Git Status ===" -ForegroundColor Cyan
git status
# Step 2: Add all new and modified files
Write-Host "`n=== Adding Files ===" -ForegroundColor Cyan
git add -A
# Step 3: Show what will be committed
Write-Host "`n=== Files to be committed ===" -ForegroundColor Cyan
git status
# Step 4: Commit with descriptive message
Write-Host "`n=== Committing Changes ===" -ForegroundColor Cyan
$commitMessage = @"
Add KPI reporting system and deployment documentation
Major Changes:
- NEW: Scripts 09 & 10 for KPI calculation and enhanced reporting
- NEW: Shell script wrappers (01-10) for easier execution
- NEW: R packages flextable and officer for enhanced Word reports
- NEW: DEPLOYMENT_README.md with complete deployment guide
- RENAMED: Numbered R scripts (02, 03, 04) for clarity
- REMOVED: Old package management scripts (using renv only)
- UPDATED: Workflow now uses scripts 09->10 instead of 05
Files Changed: 90+ files
New Packages: flextable, officer
New Scripts: 09_run_calculate_kpis.sh, 10_run_kpi_report.sh
Documentation: DEPLOYMENT_README.md, EMAIL_TO_ADMIN.txt
See DEPLOYMENT_README.md for full deployment instructions.
"@
git commit -m $commitMessage
# Step 5: Push to Bitbucket
Write-Host "`n=== Ready to Push ===" -ForegroundColor Yellow
Write-Host "Current branch: " -NoNewline
git branch --show-current
Write-Host "`nDo you want to push to Bitbucket? (Y/N): " -ForegroundColor Yellow -NoNewline
$confirmation = Read-Host
if ($confirmation -eq 'Y' -or $confirmation -eq 'y') {
Write-Host "`n=== Pushing to Bitbucket ===" -ForegroundColor Green
# Get current branch name
$branch = git branch --show-current
# Push to origin
git push origin $branch
Write-Host "`n[SUCCESS] Pushed to Bitbucket!" -ForegroundColor Green
Write-Host "`nNext steps:" -ForegroundColor Cyan
Write-Host "1. Send EMAIL_TO_ADMIN.txt to your administrator"
Write-Host "2. Ensure they have access to the Bitbucket repository"
Write-Host "3. Monitor deployment and test on Linux server"
Write-Host "4. Update Laravel UI with Script 10 parameters"
} else {
Write-Host "`n[CANCELLED] Push cancelled. Run 'git push origin $(git branch --show-current)' when ready." -ForegroundColor Yellow
}
Write-Host "`n=== Summary ===" -ForegroundColor Cyan
Write-Host "Deployment guide: DEPLOYMENT_README.md"
Write-Host "Admin email: EMAIL_TO_ADMIN.txt"
Write-Host "New scripts: 09_run_calculate_kpis.sh, 10_run_kpi_report.sh"
Write-Host "New packages: flextable, officer"

1520
python_app/01_planet_download.ipynb
View file

File diff suppressed because one or more lines are too long

122
r_app/02_ci_extraction.R
View file

@ -1,2 +1,120 @@
# Renamed for workflow clarity
# ...existing code from ci_extraction.R...
# CI_EXTRACTION.R
# ==============
# This script processes satellite imagery to extract Canopy Index (CI) values for agricultural fields.
# It handles image processing, masking, and extraction of statistics by field/sub-field.
#
# Usage: Rscript ci_extraction.R [end_date] [offset] [project_dir]
# - end_date: End date for processing (YYYY-MM-DD format)
# - offset: Number of days to look back from end_date
# - project_dir: Project directory name (e.g., "chemba")
#
# 1. Load required packages
# -----------------------
suppressPackageStartupMessages({
library(sf)
library(terra)
library(tidyverse)
library(lubridate)
library(exactextractr)
library(readxl)
library(here)
})
# 2. Process command line arguments
# ------------------------------
main <- function() {
# Capture command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Process end_date argument
if (length(args) >= 1 && !is.na(args[1])) {
end_date <- as.Date(args[1])
if (is.na(end_date)) {
warning("Invalid end_date provided. Using default (current date).")
end_date <- Sys.Date()
#end_date <- "2023-10-01"
}
} else {
end_date <- Sys.Date()
#end_date <- "2023-10-01"
}
# Process offset argument
if (length(args) >= 2 && !is.na(args[2])) {
offset <- as.numeric(args[2])
if (is.na(offset) || offset <= 0) {
warning("Invalid offset provided. Using default (7 days).")
offset <- 7
}
} else {
offset <- 7
}
# Process project_dir argument
if (length(args) >= 3 && !is.na(args[3])) {
project_dir <- as.character(args[3])
} else {
project_dir <- "esa" # Changed default from "aura" to "esa"
}
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# Set flag to use pivot_2.geojson for ESA (extra fields for yield prediction)
ci_extraction_script <- TRUE
assign("ci_extraction_script", ci_extraction_script, envir = .GlobalEnv)
# 3. Initialize project configuration
# --------------------------------
new_project_question <- TRUE
tryCatch({
source("parameters_project.R")
source("ci_extraction_utils.R")
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source("r_app/parameters_project.R")
source("r_app/ci_extraction_utils.R")
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
# 4. Generate date list for processing
# ---------------------------------
dates <- date_list(end_date, offset)
log_message(paste("Processing data for week", dates$week, "of", dates$year))
# 5. Find and filter raster files by date
# -----------------------------------
log_message("Searching for raster files")
tryCatch({
# Use the new utility function to find satellite images
existing_files <- find_satellite_images(planet_tif_folder, dates$days_filter)
log_message(paste("Found", length(existing_files), "raster files for processing"))
# 6. Process raster files and create VRT
# -----------------------------------
# Use the new utility function for batch processing
vrt_list <- process_satellite_images(existing_files, field_boundaries, merged_final, daily_vrt)
# 7. Process and combine CI values
# ------------------------------
# Call the process_ci_values function from utils with all required parameters
process_ci_values(dates, field_boundaries, merged_final,
field_boundaries_sf, daily_CI_vals_dir, cumulative_CI_vals_dir)
}, error = function(e) {
log_message(paste("Error in main processing:", e$message), level = "ERROR")
stop(e$message)
})
}
if (sys.nframe() == 0) {
main()
}

112
r_app/03_interpolate_growth_model.R
View file

@ -1,2 +1,110 @@
# Renamed for workflow clarity
# ...existing code from interpolate_growth_model.R...
# filepath: c:\Users\timon\Resilience BV\4020 SCane ESA DEMO - Documenten\General\4020 SCDEMO Team\4020 TechnicalData\WP3\smartcane\r_app\interpolate_growth_model.R
#
# INTERPOLATE_GROWTH_MODEL.R
# =========================
# This script interpolates CI (Chlorophyll Index) values between measurement dates
# to create a continuous growth model. It generates daily values and cumulative
# CI statistics for each field.
#
# Usage: Rscript interpolate_growth_model.R [project_dir]
# - project_dir: Project directory name (e.g., "chemba")
#
# 1. Load required packages
# -----------------------
suppressPackageStartupMessages({
library(tidyverse)
library(lubridate)
library(here)
})
# 2. Main function to handle interpolation
# -------------------------------------
main <- function() {
# Process command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Get project directory from arguments or use default
if (length(args) >= 1 && !is.na(args[1])) {
project_dir <- as.character(args[1])
} else {
project_dir <- "esa"
message("No project_dir provided. Using default:", project_dir)
}
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# Set flag to use pivot_2.geojson for ESA (extra fields for yield prediction)
ci_extraction_script <- TRUE
assign("ci_extraction_script", ci_extraction_script, envir = .GlobalEnv)
# Initialize project configuration and load utility functions
tryCatch({
source("parameters_project.R")
source("growth_model_utils.R")
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source(here::here("r_app", "parameters_project.R"))
source(here::here("r_app", "growth_model_utils.R"))
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
log_message("Starting CI growth model interpolation")
# Load and process the data
tryCatch({
# Load the combined CI data
CI_data <- load_combined_ci_data(cumulative_CI_vals_dir)
# Validate harvesting data
if (is.null(harvesting_data) || nrow(harvesting_data) == 0) {
stop("No harvesting data available")
}
# Get the years from harvesting data
years <- harvesting_data %>%
filter(!is.na(season_start)) %>%
distinct(year) %>%
pull(year)
log_message(paste("Processing data for years:", paste(years, collapse = ", ")))
# Generate interpolated CI data for each year and field
CI_all <- generate_interpolated_ci_data(years, harvesting_data, CI_data)
# CI_all <- CI_all %>%
# group_by(Date, field, season) %>%
# filter(!(field == "00F25" & season == 2023 & duplicated(DOY)))
# Calculate growth metrics and save the results
if (nrow(CI_all) > 0) {
# Add daily and cumulative metrics
CI_all_with_metrics <- calculate_growth_metrics(CI_all)
# Save the processed data
save_growth_model(
CI_all_with_metrics,
cumulative_CI_vals_dir,
"All_pivots_Cumulative_CI_quadrant_year_v2.rds"
)
} else {
log_message("No CI data was generated after interpolation", level = "WARNING")
}
log_message("Growth model interpolation completed successfully")
}, error = function(e) {
log_message(paste("Error in growth model interpolation:", e$message), level = "ERROR")
stop(e$message)
})
}
if (sys.nframe() == 0) {
main()
}

121
r_app/04_mosaic_creation.R
View file

@ -1,2 +1,119 @@
# Renamed for workflow clarity
# ...existing code from mosaic_creation.R...
# filepath: c:\Users\timon\Resilience BV\4020 SCane ESA DEMO - Documenten\General\4020 SCDEMO Team\4020 TechnicalData\WP3\smartcane\r_app\mosaic_creation.R
#
# MOSAIC_CREATION.R
# ===============
# This script creates weekly mosaics from daily satellite imagery.
# It handles command-line arguments and initiates the mosaic creation process.
#
# Usage: Rscript mosaic_creation.R [end_date] [offset] [project_dir] [file_name]
# - end_date: End date for processing (YYYY-MM-DD format)
# - offset: Number of days to look back from end_date
# - project_dir: Project directory name (e.g., "chemba")
# - file_name: Optional custom output file name
#
# 1. Load required packages
# -----------------------
suppressPackageStartupMessages({
library(sf)
library(terra)
library(tidyverse)
library(lubridate)
library(here)
})
# 2. Process command line arguments and run mosaic creation
# ------------------------------------------------------
main <- function() {
# Capture command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Process project_dir argument with default
if (length(args) >= 3 && !is.na(args[3])) {
project_dir <- as.character(args[3])
} else {
# Default project directory
project_dir <- "esa"
message("No project_dir provided. Using default:", project_dir)
}
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# Process end_date argument with default
if (length(args) >= 1 && !is.na(args[1])) {
end_date <- as.Date(args[1])
if (is.na(end_date)) {
message("Invalid end_date provided. Using current date.")
end_date <- Sys.Date()
#end_date <- "2025-07-22" # Default date for testing
}
} else {
# Default to current date if no argument is provided
end_date <- Sys.Date()
#end_date <- "2025-07-08" # Default date for testing
message("No end_date provided. Using current date: ", format(end_date))
}
# Process offset argument with default
if (length(args) >= 2 && !is.na(args[2])) {
offset <- as.numeric(args[2])
if (is.na(offset) || offset <= 0) {
message("Invalid offset provided. Using default (7 days).")
offset <- 7
}
} else {
# Default to 7 days if no argument is provided
offset <- 7
message("No offset provided. Using default:", offset, "days")
}
# 3. Initialize project configuration
# --------------------------------
tryCatch({
source("parameters_project.R")
source("mosaic_creation_utils.R")
safe_log(paste("Successfully sourced files from default directory."))
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source(here::here("r_app", "parameters_project.R"))
source(here::here("r_app", "mosaic_creation_utils.R"))
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
# 4. Generate date range for processing
# ---------------------------------
dates <- date_list(end_date, offset)
safe_log(paste("Processing data for week", dates$week, "of", dates$year))
# Create output filename
file_name_tif <- if (length(args) >= 4 && !is.na(args[4])) {
as.character(args[4])
} else {
paste0("week_", sprintf("%02d", dates$week), "_", dates$year, ".tif")
}
safe_log(paste("Output will be saved as:", file_name_tif))
# 5. Create weekly mosaic using the function from utils
# -------------------------------------------------
create_weekly_mosaic(
dates = dates,
field_boundaries = field_boundaries,
daily_vrt_dir = daily_vrt,
merged_final_dir = merged_final,
output_dir = weekly_CI_mosaic,
file_name_tif = file_name_tif,
create_plots = TRUE
)
}
if (sys.nframe() == 0) {
main()
}

164
r_app/05_CI_report_dashboard_planet.Rmd
View file

@ -2,8 +2,8 @@
params:
ref: "word-styles-reference-var1.docx"
output_file: CI_report.docx
report_date: "2024-06-20"
data_dir: "chemba"
report_date: "2025-09-24"
data_dir: "esa"
mail_day: "Wednesday"
borders: FALSE
ci_plot_type: "both" # options: "absolute", "cumulative", "both"
@ -367,156 +367,6 @@ Use these insights to identify areas that may need irrigation, fertilization, or
\newpage
# RGB Satellite Image - Current Week (if available)
```{r render_rgb_map, echo=FALSE, fig.height=7, fig.width=10, message=FALSE, warning=FALSE}
# Check if RGB bands are available and create RGB map
tryCatch({
# Load the full raster to check available bands
full_raster <- terra::rast(path_to_week_current)
available_bands <- names(full_raster)
# Check if RGB bands are available (look for red, green, blue or similar naming)
rgb_bands_available <- any(grepl("red|Red|RED", available_bands, ignore.case = TRUE)) &&
any(grepl("green|Green|GREEN", available_bands, ignore.case = TRUE)) &&
any(grepl("blue|Blue|BLUE", available_bands, ignore.case = TRUE))
# Alternative check for numbered bands that might be RGB (e.g., band_1, band_2, band_3)
if (!rgb_bands_available && length(available_bands) >= 3) {
# Check if we have at least 3 bands that could potentially be RGB
potential_rgb_bands <- grep("band_[1-3]|B[1-3]|[1-3]", available_bands, ignore.case = TRUE)
rgb_bands_available <- length(potential_rgb_bands) >= 3
}
if (rgb_bands_available) {
safe_log("RGB bands detected - creating RGB visualization")
# Try to extract RGB bands (prioritize named bands first)
red_band <- NULL
green_band <- NULL
blue_band <- NULL
# Look for named RGB bands first
red_candidates <- grep("red|Red|RED", available_bands, ignore.case = TRUE, value = TRUE)
green_candidates <- grep("green|Green|GREEN", available_bands, ignore.case = TRUE, value = TRUE)
blue_candidates <- grep("blue|Blue|BLUE", available_bands, ignore.case = TRUE, value = TRUE)
if (length(red_candidates) > 0) red_band <- red_candidates[1]
if (length(green_candidates) > 0) green_band <- green_candidates[1]
if (length(blue_candidates) > 0) blue_band <- blue_candidates[1]
# Fallback to numbered bands if named bands not found
if (is.null(red_band) || is.null(green_band) || is.null(blue_band)) {
if (length(available_bands) >= 3) {
# Assume first 3 bands are RGB (common convention)
red_band <- available_bands[1]
green_band <- available_bands[2]
blue_band <- available_bands[3]
}
}
if (!is.null(red_band) && !is.null(green_band) && !is.null(blue_band)) {
# Extract RGB bands
rgb_raster <- c(full_raster[[red_band]], full_raster[[green_band]], full_raster[[blue_band]])
names(rgb_raster) <- c("red", "green", "blue")
# Create RGB map
map <- tmap::tm_shape(rgb_raster, unit = "m") +
tmap::tm_rgb() +
tmap::tm_scalebar(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "white", lwd = 2) +
tmap::tm_text("sub_field", size = 0.6, col = "white") +
tmap::tm_layout(main.title = paste0("RGB Satellite Image - Week ", week),
main.title.size = 0.8,
main.title.color = "black")
# Print the map
print(map)
safe_log("RGB map created successfully")
} else {
safe_log("Could not identify RGB bands despite detection", "WARNING")
cat("RGB bands detected but could not be properly identified. Skipping RGB visualization.\n")
}
} else {
safe_log("No RGB bands available in the current week mosaic")
cat("**Note:** RGB satellite imagery is not available for this week. Only spectral index data is available.\n\n")
}
}, error = function(e) {
safe_log(paste("Error creating RGB map:", e$message), "ERROR")
cat("**Note:** Could not create RGB visualization for this week.\n\n")
})
```
# Chlorophyll Index (CI) Overview Map - Current Week
```{r render_ci_overview_map, echo=FALSE, fig.height=7, fig.width=10, message=FALSE, warning=FALSE}
# Create overview chlorophyll index map
tryCatch({
# Choose palette based on colorblind_friendly parameter
ci_palette <- if (colorblind_friendly) "viridis" else "brewer.rd_yl_gn"
# Base shape
map <- tmap::tm_shape(CI, unit = "m")
# Add raster layer with continuous spectrum (fixed scale 1-8 for consistent comparison)
map <- map + tmap::tm_raster(col.scale = tm_scale_continuous(values = ci_palette,
limits = c(1, 8)),
col.legend = tm_legend(title = "Chlorophyll Index (CI)",
orientation = "landscape",
position = tm_pos_out("center", "bottom")))
# Complete the map with layout and other elements
map <- map +
tmap::tm_scalebar(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "black") +
tmap::tm_text("sub_field", size = 0.6, col = "black")
# Print the map
print(map)
}, error = function(e) {
safe_log(paste("Error creating CI overview map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating CI overview map", cex=1.5)
})
```
# Weekly Chlorophyll Index Difference Map
```{r render_ci_difference_map, echo=FALSE, fig.height=7, fig.width=10, message=FALSE, warning=FALSE}
# Create chlorophyll index difference map
tryCatch({
# Choose palette based on colorblind_friendly parameter
diff_palette <- if (colorblind_friendly) "plasma" else "brewer.rd_yl_gn"
# Base shape
map <- tmap::tm_shape(last_week_dif_raster_abs, unit = "m")
# Add raster layer with continuous spectrum (centered at 0 for difference maps, fixed scale)
map <- map + tmap::tm_raster(col.scale = tm_scale_continuous(values = diff_palette,
midpoint = 0,
limits = c(-3, 3)),
col.legend = tm_legend(title = "Chlorophyll Index (CI) Change",
orientation = "landscape",
position = tm_pos_out("center", "bottom")))
# Complete the map with layout and other elements
map <- map +
tmap::tm_scalebar(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "black") +
tmap::tm_text("sub_field", size = 0.6, col = "black")
# Print the map
print(map)
}, error = function(e) {
safe_log(paste("Error creating CI difference map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating CI difference map", cex=1.5)
})
```
\newpage
```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=10, message=FALSE,echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
# Generate detailed visualizations for each field
@ -662,8 +512,8 @@ tryCatch({
# Prepare prediction dataset (fields without harvest data)
prediction_yields <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(is.na(tonnage_ha)) %>%
dplyr::filter(age > 300) # Only predict on fields older than 300 days
dplyr::filter(is.na(tonnage_ha))# #%>%
# dplyr::filter(Age_days > 300) # Only predict on fields older than 300 days
# Configure model training parameters
ctrl <- caret::trainControl(
@ -700,7 +550,7 @@ tryCatch({
predicted_Tcha = round(predicted_Tcha, 0),
season = newdata$season
) %>%
dplyr::select(field, sub_field, Age_days, total_CI, predicted_Tcha, season) %>%
dplyr::select(field, sub_field, Age_days, predicted_Tcha, season) %>%
dplyr::left_join(., newdata, by = c("field", "sub_field", "season"))
)
}
@ -711,7 +561,7 @@ tryCatch({
# Predict yields for the current season (focus on mature fields over 300 days)
pred_rf_current_season <- prepare_predictions(stats::predict(model_ffs_rf, newdata = prediction_yields), prediction_yields) %>%
dplyr::filter(Age_days > 1) %>%
dplyr::mutate(CI_per_day = round(total_CI / Age_days, 1))
select(c("field", "Age_days", "predicted_Tcha", "season"))
safe_log("Successfully completed yield prediction calculations")
@ -743,7 +593,7 @@ tryCatch({
# Plot predicted yields by age
ggplot2::ggplot(pred_rf_current_season, ggplot2::aes(x = Age_days, y = predicted_Tcha)) +
ggplot2::geom_point(size = 2, alpha = 0.6) +
ggplot2::labs(title = "Predicted Yields for Fields Over 300 Days \nOld Yet to Be Harvested",
ggplot2::labs(title = "Predicted Yields \n Yet to Be Harvested",
x = "Age (days)",
y = "Predicted tonnage/ha (Tcha)") +
ggplot2::scale_y_continuous(limits = c(0, 200)) +

293
r_app/06_crop_messaging Normal file
View file

@ -0,0 +1,293 @@
# 06_CROP_MESSAGING.R
# ===================
# This script analyzes weekly CI mosaics to detect changes and generate automated messages
# about crop conditions. It compares two weeks of data to assess:
# - Field uniformity (high vs low variation)
# - CI change trends (increase, stable, decrease)
# - Generates contextual messages based on analysis
# - Outputs results in multiple formats: WhatsApp/Word text, CSV, and .docx
#
# Usage: Rscript 06_crop_messaging.R [current_week] [previous_week] [estate_name]
# - current_week: Current week number (e.g., 30)
# - previous_week: Previous week number (e.g., 29)
# - estate_name: Estate name (e.g., "simba", "chemba")
#
# Examples:
# Rscript 06_crop_messaging.R 32 31 simba
# Rscript 06_crop_messaging.R 30 29 chemba
#
# The script automatically:
# 1. Loads the correct estate configuration
# 2. Analyzes weekly mosaics
# 3. Generates field-by-field analysis
# 4. Creates output files in multiple formats
# 5. Displays WhatsApp-ready text in console
#
# 1. Load required packages
# -----------------------
suppressPackageStartupMessages({
library(sf)
library(terra)
library(tidyverse)
library(lubridate)
library(here)
library(spdep) # For spatial statistics
})
# 2. Main function to handle messaging workflow
# ---------------------------------------------
main <- function() {
# Capture command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Process arguments with defaults
current_week <- if (length(args) >= 1 && !is.na(args[1])) {
as.numeric(args[1])
} else {
39 # Default for proof of concept
}
previous_week <- if (length(args) >= 2 && !is.na(args[2])) {
as.numeric(args[2])
} else {
38 # Default for proof of concept
}
estate_name <- if (length(args) >= 3 && !is.na(args[3])) {
as.character(args[3])
} else {
"aura" # Default estate
}
year <- 2025 # Current year - could be made dynamic
# Make estate_name available globally so parameters_project.R can use it
assign("project_dir", estate_name, envir = .GlobalEnv)
# Initialize project configuration and load utility functions
tryCatch({
source("parameters_project.R")
source("crop_messaging_utils.R")
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source(here::here("r_app", "parameters_project.R"))
source(here::here("r_app", "crop_messaging_utils.R"))
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
log_message("Starting crop messaging analysis")
# Run the modular analysis
analysis_results <- run_estate_analysis(estate_name, current_week, previous_week, year)
field_results <- analysis_results$field_results
# Display detailed field-by-field analysis
cat("=== FIELD-BY-FIELD ANALYSIS ===\n\n")
for (field_id in names(field_results)) {
field_info <- field_results[[field_id]]
current_field <- field_info$current_stats
previous_field <- field_info$previous_stats
ci_change <- field_info$ci_change
change_category <- field_info$change_category
change_percentages <- field_info$change_percentages
uniformity_category <- field_info$uniformity_category
message_result <- field_info$message_result
# Print enhanced field analysis
cat("FIELD:", current_field$field, "-", current_field$sub_field, "\n")
cat("- Field size:", round(current_field$field_area_ha, 1), "hectares\n")
cat("- Week", previous_week, "CI:", round(previous_field$mean_ci, 3), "\n")
cat("- Week", current_week, "CI:", round(current_field$mean_ci, 3), "\n")
cat("- Terra stats: Mean =", round(current_field$mean_ci, 3),
", CV =", round(current_field$cv, 3),
", Range = [", round(current_field$min_ci, 2), "-", round(current_field$max_ci, 2), "]\n")
cat("- Within acceptable range (±25% of mean):", round(current_field$acceptable_pct, 1), "%\n")
# Display primary uniformity metrics (CV and Entropy)
cat("- Field uniformity: CV =", round(current_field$cv, 3))
if (current_field$cv < 0.08) {
cat(" (excellent)")
} else if (current_field$cv < 0.15) {
cat(" (good)")
} else if (current_field$cv < 0.30) {
cat(" (moderate)")
} else if (current_field$cv < 0.50) {
cat(" (high variation)")
} else {
cat(" (very high variation)")
}
# Add entropy information
if (!is.na(current_field$entropy)) {
cat(", Entropy =", round(current_field$entropy, 3))
# Entropy interpretation (higher = more heterogeneous)
# Adjusted thresholds to better match CV patterns
if (current_field$entropy < 1.3) {
cat(" (very uniform)")
} else if (current_field$entropy < 1.5) {
cat(" (uniform)")
} else if (current_field$entropy < 1.7) {
cat(" (moderate heterogeneity)")
} else {
cat(" (high heterogeneity)")
}
}
cat("\n")
cat("- Change: Mean =", round(ci_change, 3), "(", change_category, ")")
if (!is.na(change_percentages$positive_pct)) {
# Calculate hectares for this field using field area from geojson
field_hectares <- current_field$field_area_ha
improving_hectares <- (change_percentages$positive_pct / 100) * field_hectares
declining_hectares <- (change_percentages$negative_pct / 100) * field_hectares
cat(", Areas: ", round(change_percentages$positive_pct, 1), "% (", round(improving_hectares, 1), " ha) improving, ",
round(change_percentages$negative_pct, 1), "% (", round(declining_hectares, 1), " ha) declining\n")
} else {
cat("\n")
}
cat("- Spatial Pattern:", uniformity_category, "\n")
# Add spatial details if available
if (!is.na(current_field$spatial_autocorr$morans_i)) {
cat("- Moran's I:", round(current_field$spatial_autocorr$morans_i, 3),
"(", current_field$spatial_autocorr$interpretation, ")")
# Add agricultural context explanation for Moran's I
moran_val <- current_field$spatial_autocorr$morans_i
if (moran_val >= 0.7 && moran_val < 0.85) {
cat(" - normal field continuity")
} else if (moran_val >= 0.85 && moran_val < 0.95) {
cat(" - strong spatial pattern")
} else if (moran_val >= 0.95) {
cat(" - very strong clustering, monitor for management issues")
} else if (moran_val < 0.7 && moran_val > 0.3) {
cat(" - moderate spatial pattern")
} else {
cat(" - unusual spatial pattern for crop field")
}
cat("\n")
}
if (!is.na(current_field$extreme_percentages$hotspot_pct)) {
cat("- Extreme areas: ", round(current_field$extreme_percentages$hotspot_pct, 1),
"% hotspots (high-performing), ", round(current_field$extreme_percentages$coldspot_pct, 1),
"% coldspots (underperforming)")
# Show method used for extreme detection
if (!is.null(current_field$extreme_percentages$method)) {
if (current_field$extreme_percentages$method == "getis_ord_gi_star") {
cat(" [Getis-Ord Gi*]")
} else if (current_field$extreme_percentages$method == "simple_sd") {
cat(" [Simple SD]")
}
}
cat("\n")
}
cat("- Message:", message_result$message, "\n")
cat("- Alert needed:", if(message_result$worth_sending) "YES 🚨" else "NO", "\n\n")
}
# Summary of alerts
alert_fields <- sapply(field_results, function(x) x$message_result$worth_sending)
total_alerts <- sum(alert_fields)
cat("=== SUMMARY ===\n")
cat("Total fields analyzed:", length(field_results), "\n")
cat("Fields requiring alerts:", total_alerts, "\n")
if (total_alerts > 0) {
cat("\nFields needing attention:\n")
for (field_id in names(field_results)[alert_fields]) {
field_info <- field_results[[field_id]]
cat("-", field_info$current_stats$field, "-", field_info$current_stats$sub_field,
":", field_info$message_result$message, "\n")
}
}
# Farm-wide analysis summary table
cat("\n=== FARM-WIDE ANALYSIS SUMMARY ===\n")
# Field uniformity statistics with detailed categories
excellent_fields <- sapply(field_results, function(x) x$current_stats$cv <= 0.08)
good_fields <- sapply(field_results, function(x) x$current_stats$cv > 0.08 & x$current_stats$cv <= 0.15)
moderate_fields <- sapply(field_results, function(x) x$current_stats$cv > 0.15 & x$current_stats$cv <= 0.30)
poor_fields <- sapply(field_results, function(x) x$current_stats$cv > 0.30)
n_excellent <- sum(excellent_fields)
n_good <- sum(good_fields)
n_moderate <- sum(moderate_fields)
n_poor <- sum(poor_fields)
n_uniform_total <- n_excellent + n_good # Total uniform fields (CV ≤ 0.20)
# Calculate farm-wide area statistics
total_hectares <- sum(sapply(field_results, function(x) x$current_stats$field_area_ha), na.rm = TRUE)
total_improving_hectares <- sum(sapply(field_results, function(x) {
if (!is.na(x$change_percentages$positive_pct)) {
(x$change_percentages$positive_pct / 100) * x$current_stats$field_area_ha
} else 0
}), na.rm = TRUE)
total_declining_hectares <- sum(sapply(field_results, function(x) {
if (!is.na(x$change_percentages$negative_pct)) {
(x$change_percentages$negative_pct / 100) * x$current_stats$field_area_ha
} else 0
}), na.rm = TRUE)
# Calculate farm-wide percentages
farm_improving_pct <- (total_improving_hectares / total_hectares) * 100
farm_declining_pct <- (total_declining_hectares / total_hectares) * 100
# Display summary table
cat("\nFIELD UNIFORMITY SUMMARY:\n")
cat("│ Uniformity Level │ Count │ Percent │\n")
cat(sprintf("│ Excellent (CV≤0.08) │ %5d │ %6.1f%% │\n", n_excellent, (n_excellent/length(field_results))*100))
cat(sprintf("│ Good (CV 0.08-0.15) │ %5d │ %6.1f%% │\n", n_good, (n_good/length(field_results))*100))
cat(sprintf("│ Moderate (CV 0.15-0.30) │ %5d │ %6.1f%% │\n", n_moderate, (n_moderate/length(field_results))*100))
cat(sprintf("│ Poor (CV>0.30) │ %5d │ %6.1f%% │\n", n_poor, (n_poor/length(field_results))*100))
cat(sprintf("│ Total fields │ %5d │ %6.1f%% │\n", length(field_results), 100.0))
cat("\nFARM-WIDE AREA CHANGE SUMMARY:\n")
cat("│ Change Type │ Hectares│ Percent │\n")
cat(sprintf("│ Improving areas │ %7.1f │ %6.1f%% │\n", total_improving_hectares, farm_improving_pct))
cat(sprintf("│ Declining areas │ %7.1f │ %6.1f%% │\n", total_declining_hectares, farm_declining_pct))
cat(sprintf("│ Total area │ %7.1f │ %6.1f%% │\n", total_hectares, 100.0))
# Additional insights
cat("\nKEY INSIGHTS:\n")
cat(sprintf("• %d%% of fields have good uniformity (CV ≤ 0.15)\n", round((n_uniform_total/length(field_results))*100)))
cat(sprintf("• %d%% of fields have excellent uniformity (CV ≤ 0.08)\n", round((n_excellent/length(field_results))*100)))
cat(sprintf("• %.1f hectares (%.1f%%) of farm area is improving week-over-week\n", total_improving_hectares, farm_improving_pct))
cat(sprintf("• %.1f hectares (%.1f%%) of farm area is declining week-over-week\n", total_declining_hectares, farm_declining_pct))
cat(sprintf("• Total farm area analyzed: %.1f hectares\n", total_hectares))
if (farm_improving_pct > farm_declining_pct) {
cat(sprintf("• Overall trend: POSITIVE (%.1f%% more area improving than declining)\n", farm_improving_pct - farm_declining_pct))
} else if (farm_declining_pct > farm_improving_pct) {
cat(sprintf("• Overall trend: NEGATIVE (%.1f%% more area declining than improving)\n", farm_declining_pct - farm_improving_pct))
} else {
cat("• Overall trend: BALANCED (equal improvement and decline)\n")
}
# Generate and save multiple output formats
saved_files <- save_analysis_outputs(analysis_results)
# Analysis complete
cat("\n=== ANALYSIS COMPLETE ===\n")
cat("All field analysis results, farm-wide summary, and output files created.\n")
# Return results for potential further processing
invisible(analysis_results)
}
if (sys.nframe() == 0) {
main()
}

156
r_app/09_calculate_kpis.R Normal file
View file

@ -0,0 +1,156 @@
# 09_CALCULATE_KPIS.R
# ===================
# This script calculates 6 Key Performance Indicators (KPIs) for sugarcane monitoring:
# 1. Field Uniformity Summary
# 2. Farm-wide Area Change Summary
# 3. TCH Forecasted
# 4. Growth Decline Index
# 5. Weed Presence Score
# 6. Gap Filling Score (placeholder)
#
# Usage: Rscript 09_calculate_kpis.R [end_date] [offset] [project_dir]
# - end_date: End date for KPI calculation (YYYY-MM-DD format), default: today
# - offset: Number of days to look back (not currently used for KPIs, but for consistency)
# - project_dir: Project directory name (e.g., "aura", "esa")
# 1. Load required libraries
# -------------------------
suppressPackageStartupMessages({
library(here)
library(sf)
library(terra)
library(dplyr)
library(tidyr)
library(lubridate)
library(readr)
library(caret)
library(CAST)
library(randomForest)
})
# 2. Main function
# --------------
main <- function() {
# Process command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Process end_date argument
if (length(args) >= 1 && !is.na(args[1])) {
end_date <- as.Date(args[1])
if (is.na(end_date)) {
warning("Invalid end_date provided. Using default (current date).")
end_date <- Sys.Date()
}
} else {
end_date <- Sys.Date()
}
# Process offset argument (for consistency with other scripts, not currently used)
if (length(args) >= 2 && !is.na(args[2])) {
offset <- as.numeric(args[2])
if (is.na(offset) || offset <= 0) {
warning("Invalid offset provided. Using default (7 days).")
offset <- 7
}
} else {
offset <- 7
}
# Process project_dir argument
if (length(args) >= 3 && !is.na(args[3])) {
project_dir <- as.character(args[3])
} else {
project_dir <- "esa" # Default project
}
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# 3. Load utility functions and project configuration
# --------------------------------------------------
tryCatch({
source(here("r_app", "crop_messaging_utils.R"))
}, error = function(e) {
stop("Error loading crop_messaging_utils.R: ", e$message)
})
tryCatch({
source(here("r_app", "kpi_utils.R"))
}, error = function(e) {
stop("Error loading kpi_utils.R: ", e$message)
})
# Load project parameters (this sets up all directory paths and field boundaries)
tryCatch({
source(here("r_app", "parameters_project.R"))
}, error = function(e) {
stop("Error loading parameters_project.R: ", e$message)
})
# Load growth model utils if available (for yield prediction)
tryCatch({
source(here("r_app", "growth_model_utils.R"))
}, error = function(e) {
warning("growth_model_utils.R not found, yield prediction KPI will use placeholder data")
})
# Check if required variables exist
if (!exists("project_dir")) {
stop("project_dir must be set before running this script")
}
if (!exists("field_boundaries_sf") || is.null(field_boundaries_sf)) {
stop("Field boundaries not loaded. Check parameters_project.R initialization.")
}
# 4. Calculate all KPIs
# -------------------
output_dir <- file.path(reports_dir, "kpis")
kpi_results <- calculate_all_kpis(
report_date = end_date,
output_dir = output_dir,
field_boundaries_sf = field_boundaries_sf,
harvesting_data = harvesting_data,
cumulative_CI_vals_dir = cumulative_CI_vals_dir,
weekly_CI_mosaic = weekly_CI_mosaic,
reports_dir = reports_dir,
project_dir = project_dir
)
# 5. Print summary
# --------------
cat("\n=== KPI CALCULATION SUMMARY ===\n")
cat("Report Date:", as.character(kpi_results$metadata$report_date), "\n")
cat("Current Week:", kpi_results$metadata$current_week, "\n")
cat("Previous Week:", kpi_results$metadata$previous_week, "\n")
cat("Total Fields Analyzed:", kpi_results$metadata$total_fields, "\n")
cat("Calculation Time:", as.character(kpi_results$metadata$calculation_time), "\n")
cat("\nField Uniformity Summary:\n")
print(kpi_results$field_uniformity_summary)
cat("\nArea Change Summary:\n")
print(kpi_results$area_change)
cat("\nTCH Forecasted:\n")
print(kpi_results$tch_forecasted)
cat("\nGrowth Decline Index:\n")
print(kpi_results$growth_decline)
cat("\nWeed Presence Score:\n")
print(kpi_results$weed_presence)
cat("\nGap Filling Score:\n")
print(kpi_results$gap_filling)
cat("\n=== KPI CALCULATION COMPLETED ===\n")
}
# 6. Script execution
# -----------------
if (sys.nframe() == 0) {
main()
}

1096
r_app/10_CI_report_with_kpis_simple.Rmd Normal file
View file

File diff suppressed because it is too large Load diff

BIN
r_app/CI_graph_example.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 350 KiB

739
r_app/CI_report_dashboard_planet.Rmd
View file

@ -1,739 +0,0 @@
---
params:
ref: "word-styles-reference-var1.docx"
output_file: CI_report.docx
report_date: "2024-07-18"
data_dir: "chemba"
mail_day: "Wednesday"
borders: TRUE
output:
# html_document:
# toc: yes
# df_print: paged
word_document:
reference_docx: !expr file.path("word-styles-reference-var1.docx")
toc: no
editor_options:
chunk_output_type: console
---
```{r setup_parameters, include=FALSE}
# Set up basic report parameters from input values
report_date <- params$report_date
mail_day <- params$mail_day
borders <- params$borders
# Environment setup notes (commented out)
# # Activeer de renv omgeving
# renv::activate()
# renv::deactivate()
# # Optioneel: Herstel de omgeving als dat nodig is
# # Je kunt dit commentaar geven als je het normaal niet wilt uitvoeren
# renv::restore()
```
```{r load_libraries, message=FALSE, warning=FALSE, include=FALSE}
# Configure knitr options
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
# Load all packages at once with suppressPackageStartupMessages
suppressPackageStartupMessages({
library(here)
library(sf)
library(terra)
library(exactextractr)
library(tidyverse)
library(tmap)
library(lubridate)
library(zoo)
library(rsample)
library(caret)
library(randomForest)
library(CAST)
})
# Load custom utility functions
tryCatch({
source("report_utils.R")
}, error = function(e) {
message(paste("Error loading report_utils.R:", e$message))
# Try alternative path if the first one fails
tryCatch({
source(here::here("r_app", "report_utils.R"))
}, error = function(e) {
stop("Could not load report_utils.R from either location: ", e$message)
})
})
```
```{r initialize_project_config, message=FALSE, warning=FALSE, include=FALSE}
# Set the project directory from parameters
project_dir <- params$data_dir
# Source project parameters with error handling
tryCatch({
source(here::here("r_app", "parameters_project.R"))
}, error = function(e) {
stop("Error loading parameters_project.R: ", e$message)
})
# Log initial configuration
safe_log("Starting the R Markdown script")
safe_log(paste("mail_day params:", params$mail_day))
safe_log(paste("report_date params:", params$report_date))
safe_log(paste("mail_day variable:", mail_day))
```
```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE}
# Set locale for consistent date formatting
Sys.setlocale("LC_TIME", "C")
# Initialize date variables from parameters
today <- as.character(report_date)
mail_day_as_character <- as.character(mail_day)
# Calculate week days
report_date_as_week_day <- weekdays(lubridate::ymd(today))
days_of_week <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
# Calculate initial week number
week <- lubridate::week(today)
safe_log(paste("Initial week calculation:", week, "today:", today))
# Calculate previous dates for comparisons
today_minus_1 <- as.character(lubridate::ymd(today) - 7)
today_minus_2 <- as.character(lubridate::ymd(today) - 14)
today_minus_3 <- as.character(lubridate::ymd(today) - 21)
# Log the weekday calculations for debugging
safe_log(paste("Report date weekday:", report_date_as_week_day))
safe_log(paste("Weekday index:", which(days_of_week == report_date_as_week_day)))
safe_log(paste("Mail day:", mail_day_as_character))
safe_log(paste("Mail day index:", which(days_of_week == mail_day_as_character)))
# Adjust week calculation based on mail day
if (which(days_of_week == report_date_as_week_day) > which(days_of_week == mail_day_as_character)) {
safe_log("Adjusting weeks because of mail day")
week <- lubridate::week(today) + 1
today_minus_1 <- as.character(lubridate::ymd(today))
today_minus_2 <- as.character(lubridate::ymd(today) - 7)
today_minus_3 <- as.character(lubridate::ymd(today) - 14)
}
# Calculate week numbers for previous weeks
week_minus_1 <- week - 1
week_minus_2 <- week - 2
week_minus_3 <- week - 3
# Format current week with leading zeros
week <- sprintf("%02d", week)
# Get years for each date
year <- lubridate::year(today)
year_1 <- lubridate::year(today_minus_1)
year_2 <- lubridate::year(today_minus_2)
year_3 <- lubridate::year(today_minus_3)
```
```{r data, message=TRUE, warning=TRUE, include=FALSE}
# Load CI index data with error handling
tryCatch({
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
safe_log("Successfully loaded CI quadrant data")
}, error = function(e) {
stop("Error loading CI quadrant data: ", e$message)
})
# Get file paths for different weeks using the utility function
tryCatch({
path_to_week_current = get_week_path(weekly_CI_mosaic, today, 0)
path_to_week_minus_1 = get_week_path(weekly_CI_mosaic, today, -1)
path_to_week_minus_2 = get_week_path(weekly_CI_mosaic, today, -2)
path_to_week_minus_3 = get_week_path(weekly_CI_mosaic, today, -3)
# Log the calculated paths
safe_log("Required mosaic paths:")
safe_log(paste("Path to current week:", path_to_week_current))
safe_log(paste("Path to week minus 1:", path_to_week_minus_1))
safe_log(paste("Path to week minus 2:", path_to_week_minus_2))
safe_log(paste("Path to week minus 3:", path_to_week_minus_3))
# Validate that files exist
if (!file.exists(path_to_week_current)) warning("Current week mosaic file does not exist: ", path_to_week_current)
if (!file.exists(path_to_week_minus_1)) warning("Week minus 1 mosaic file does not exist: ", path_to_week_minus_1)
if (!file.exists(path_to_week_minus_2)) warning("Week minus 2 mosaic file does not exist: ", path_to_week_minus_2)
if (!file.exists(path_to_week_minus_3)) warning("Week minus 3 mosaic file does not exist: ", path_to_week_minus_3)
# Load raster data with terra functions
CI <- terra::rast(path_to_week_current)$CI
CI_m1 <- terra::rast(path_to_week_minus_1)$CI
CI_m2 <- terra::rast(path_to_week_minus_2)$CI
CI_m3 <- terra::rast(path_to_week_minus_3)$CI
}, error = function(e) {
stop("Error loading raster data: ", e$message)
})
```
```{r calculate_difference_rasters, message=TRUE, warning=TRUE, include=FALSE}
# Calculate difference rasters for comparisons
tryCatch({
# Calculate weekly difference
last_week_dif_raster_abs <- (CI - CI_m1)
safe_log("Calculated weekly difference raster")
# Calculate three-week difference
three_week_dif_raster_abs <- (CI - CI_m3)
safe_log("Calculated three-week difference raster")
}, error = function(e) {
safe_log(paste("Error calculating difference rasters:", e$message), "ERROR")
# Create placeholder rasters if calculations fail
if (!exists("last_week_dif_raster_abs")) {
last_week_dif_raster_abs <- CI * 0
}
if (!exists("three_week_dif_raster_abs")) {
three_week_dif_raster_abs <- CI * 0
}
})
```
```{r load_field_boundaries, message=TRUE, warning=TRUE, include=FALSE}
# Load field boundaries from parameters
tryCatch({
AllPivots0 <- field_boundaries_sf %>%
dplyr::filter(!is.na(field), !is.na(sub_field)) # Filter out NA field names
safe_log("Successfully loaded field boundaries")
}, error = function(e) {
stop("Error loading field boundaries: ", e$message)
})
```
```{r create_front_page_variables, include=FALSE}
# Create variables for the front page
farm_name <- stringr::str_to_title(gsub("_", " ", project_dir))
# Format dates for display
report_date_formatted <- format(as.Date(report_date), "%B %d, %Y")
current_year <- format(Sys.Date(), "%Y")
# Get total field count and area if available
tryCatch({
total_fields <- length(unique(AllPivots0$field))
total_area_ha <- round(sum(sf::st_area(AllPivots0)) / 10000, 1) # Convert to hectares
}, error = function(e) {
total_fields <- "N/A"
total_area_ha <- "N/A"
})
```
---
title: ""
---
```{=openxml}
<w:p>
<w:pPr>
<w:jc w:val="center"/>
<w:spacing w:after="720"/>
</w:pPr>
<w:r>
<w:rPr>
<w:sz w:val="48"/>
<w:b/>
</w:rPr>
<w:t>SUGARCANE CROP MONITORING REPORT</w:t>
</w:r>
</w:p>
```
<div style="text-align: center; margin-top: 2cm; margin-bottom: 2cm;">
**`r farm_name`**
**Chlorophyll Index Analysis**
Report Date: **`r report_date_formatted`**
---
</div>
<div style="margin-top: 3cm; margin-bottom: 2cm;">
## Report Summary
**Farm Location:** `r farm_name`
**Report Period:** Week `r week` of `r current_year`
**Data Source:** Planet Labs Satellite Imagery
**Analysis Type:** Chlorophyll Index (CI) Monitoring
**Field Coverage:**
- Total Fields Monitored: `r total_fields`
- Total Area: `r total_area_ha` hectares
**Report Generated:** `r format(Sys.Date(), "%B %d, %Y")`
---
## About This Report
This automated report provides weekly analysis of sugarcane crop health using satellite-derived Chlorophyll Index (CI) measurements. The analysis helps identify:
- Field-level crop health variations
- Weekly changes in crop vigor
- Areas requiring agricultural attention
- 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
</div>
\newpage
<!-- Table of Contents -->
```{=openxml}
<w:p>
<w:pPr>
<w:jc w:val="center"/>
<w:spacing w:after="480"/>
</w:pPr>
<w:r>
<w:rPr>
<w:sz w:val="32"/>
<w:b/>
</w:rPr>
<w:t>TABLE OF CONTENTS</w:t>
</w:r>
</w:p>
```
```{=openxml}
<w:p>
<w:fldSimple w:instr=" TOC \o &quot;1-3&quot; \h \z \u ">
<w:r><w:t>Update this field to generate table of contents</w:t></w:r>
</w:fldSimple>
</w:p>
```
\newpage
<!-- Original content starts here -->
# Explanation of the Report
This report provides a detailed analysis of your sugarcane fields based on satellite imagery, helping 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.
## What You'll Find in This Report:
1. **Chlorophyll Index Overview Map**: A comprehensive view of all your fields showing current CI values. This helps identify which fields are performing well and which might need attention.
2. **Weekly Difference Map**: Shows changes in CI values over the past week. Positive values (green) indicate improving crop health, while negative values (red) may signal stress or decline.
3. **Field-by-Field Analysis**: Detailed maps for each field showing:
* CI values for the current week and two previous weeks
* Week-to-week changes in CI values
* Three-week change in CI values to track longer-term trends
4. **Growth Trend Graphs**: Time-series visualizations showing how CI values have changed throughout the growing season for each section of your fields.
5. **Yield Prediction**: For mature crops (over 300 days), we provide estimated yield predictions based on historical data and current CI measurements.
Use these insights to identify areas that may need irrigation, fertilization, or other interventions, and to track the effectiveness of your management practices over time.
\newpage
# RGB Satellite Image - Current Week (if available)
```{r render_rgb_map, echo=FALSE, fig.height=7, fig.width=10, message=FALSE, warning=FALSE}
# Check if RGB bands are available and create RGB map
tryCatch({
# Load the full raster to check available bands
full_raster <- terra::rast(path_to_week_current)
available_bands <- names(full_raster)
# Check if RGB bands are available (look for red, green, blue or similar naming)
rgb_bands_available <- any(grepl("red|Red|RED", available_bands, ignore.case = TRUE)) &&
any(grepl("green|Green|GREEN", available_bands, ignore.case = TRUE)) &&
any(grepl("blue|Blue|BLUE", available_bands, ignore.case = TRUE))
# Alternative check for numbered bands that might be RGB (e.g., band_1, band_2, band_3)
if (!rgb_bands_available && length(available_bands) >= 3) {
# Check if we have at least 3 bands that could potentially be RGB
potential_rgb_bands <- grep("band_[1-3]|B[1-3]|[1-3]", available_bands, ignore.case = TRUE)
rgb_bands_available <- length(potential_rgb_bands) >= 3
}
if (rgb_bands_available) {
safe_log("RGB bands detected - creating RGB visualization")
# Try to extract RGB bands (prioritize named bands first)
red_band <- NULL
green_band <- NULL
blue_band <- NULL
# Look for named RGB bands first
red_candidates <- grep("red|Red|RED", available_bands, ignore.case = TRUE, value = TRUE)
green_candidates <- grep("green|Green|GREEN", available_bands, ignore.case = TRUE, value = TRUE)
blue_candidates <- grep("blue|Blue|BLUE", available_bands, ignore.case = TRUE, value = TRUE)
if (length(red_candidates) > 0) red_band <- red_candidates[1]
if (length(green_candidates) > 0) green_band <- green_candidates[1]
if (length(blue_candidates) > 0) blue_band <- blue_candidates[1]
# Fallback to numbered bands if named bands not found
if (is.null(red_band) || is.null(green_band) || is.null(blue_band)) {
if (length(available_bands) >= 3) {
# Assume first 3 bands are RGB (common convention)
red_band <- available_bands[1]
green_band <- available_bands[2]
blue_band <- available_bands[3]
}
}
if (!is.null(red_band) && !is.null(green_band) && !is.null(blue_band)) {
# Extract RGB bands
rgb_raster <- c(full_raster[[red_band]], full_raster[[green_band]], full_raster[[blue_band]])
names(rgb_raster) <- c("red", "green", "blue")
# Create RGB map
map <- tmap::tm_shape(rgb_raster, unit = "m") +
tmap::tm_rgb() +
tmap::tm_scalebar(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "white", lwd = 2) +
tmap::tm_text("sub_field", size = 0.6, col = "white") +
tmap::tm_layout(main.title = paste0("RGB Satellite Image - Week ", week),
main.title.size = 0.8,
main.title.color = "black")
# Print the map
print(map)
safe_log("RGB map created successfully")
} else {
safe_log("Could not identify RGB bands despite detection", "WARNING")
cat("RGB bands detected but could not be properly identified. Skipping RGB visualization.\n")
}
} else {
safe_log("No RGB bands available in the current week mosaic")
cat("**Note:** RGB satellite imagery is not available for this week. Only spectral index data is available.\n\n")
}
}, error = function(e) {
safe_log(paste("Error creating RGB map:", e$message), "ERROR")
cat("**Note:** Could not create RGB visualization for this week.\n\n")
})
```
# Chlorophyll Index (CI) Overview Map - Current Week
```{r render_ci_overview_map, echo=FALSE, fig.height=7, fig.width=10, message=FALSE, warning=FALSE}
# Create overview chlorophyll index map
tryCatch({ # Base shape
map <- tmap::tm_shape(CI, unit = "m") # Add raster layer with continuous spectrum (fixed scale 1-8 for consistent comparison)
map <- map + tmap::tm_raster(col.scale = tm_scale_continuous(values = "brewer.rd_yl_gn",
limits = c(1, 8)), col.legend = tm_legend(title = "Chlorophyll Index (CI)",
orientation = "landscape",
position = tm_pos_out("center", "bottom")))
# Complete the map with layout and other elements
map <- map +
tmap::tm_scalebar(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "black") +
tmap::tm_text("sub_field", size = 0.6, col = "black")
# Print the map
print(map)
}, error = function(e) {
safe_log(paste("Error creating CI overview map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating CI overview map", cex=1.5)
})
```
# Weekly Chlorophyll Index Difference Map
```{r render_ci_difference_map, echo=FALSE, fig.height=7, fig.width=10, message=FALSE, warning=FALSE}
# Create chlorophyll index difference map
tryCatch({ # Base shape
map <- tmap::tm_shape(last_week_dif_raster_abs, unit = "m") # Add raster layer with continuous spectrum (centered at 0 for difference maps, fixed scale)
map <- map + tmap::tm_raster(col.scale = tm_scale_continuous(values = "brewer.rd_yl_gn",
midpoint = 0,
limits = c(-3, 3)), col.legend = tm_legend(title = "Chlorophyll Index (CI) Change",
orientation = "landscape",
position = tm_pos_out("center", "bottom")))
# Complete the map with layout and other elements
map <- map +
tmap::tm_scalebar(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
tmap::tm_shape(AllPivots0) +
tmap::tm_borders(col = "black") +
tmap::tm_text("sub_field", size = 0.6, col = "black")
# Print the map
print(map)
}, error = function(e) {
safe_log(paste("Error creating CI difference map:", e$message), "ERROR")
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating CI difference map", cex=1.5)
})
```
\newpage
```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=10, message=FALSE,echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
# Generate detailed visualizations for each field
tryCatch({
# Merge field polygons for processing and filter out NA field names
AllPivots_merged <- AllPivots0 %>%
dplyr::filter(!is.na(field), !is.na(sub_field)) %>% # Filter out NA fields
dplyr::group_by(field) %>%
dplyr::summarise(.groups = 'drop')
# Generate plots for each field
for(i in seq_along(AllPivots_merged$field)) {
field_name <- AllPivots_merged$field[i]
# Skip if field_name is still NA (double check)
if(is.na(field_name)) {
next
}
tryCatch({
# Add page break before each field (except the first one)
if(i > 1) {
cat("\\newpage\n\n")
}
# Call ci_plot with explicit parameters (ci_plot will generate its own header)
ci_plot(
pivotName = field_name,
field_boundaries = AllPivots0,
current_ci = CI,
ci_minus_1 = CI_m1,
ci_minus_2 = CI_m2,
last_week_diff = last_week_dif_raster_abs,
three_week_diff = three_week_dif_raster_abs,
harvesting_data = harvesting_data,
week = week,
week_minus_1 = week_minus_1,
week_minus_2 = week_minus_2,
week_minus_3 = week_minus_3,
borders = borders
)
cat("\n\n")
# Call cum_ci_plot with explicit parameters
cum_ci_plot(
pivotName = field_name,
ci_quadrant_data = CI_quadrant,
plot_type = "value",
facet_on = FALSE
)
cat("\n\n")
}, error = function(e) {
safe_log(paste("Error generating plots for field", field_name, ":", e$message), "ERROR")
cat("\\newpage\n\n")
cat("# Error generating plots for field ", field_name, "\n\n")
cat(e$message, "\n\n")
})
}
}, error = function(e) {
safe_log(paste("Error in field visualization section:", e$message), "ERROR")
cat("Error generating field plots. See log for details.\n\n")
})
```
```{r generate_subarea_visualizations, echo=FALSE, fig.height=3.8, fig.width=10, message=FALSE, warning=FALSE, results='asis', eval=FALSE}
# Alternative visualization grouped by sub-area (disabled by default)
tryCatch({
# Group pivots by sub-area
pivots_grouped <- AllPivots0
# Iterate over each subgroup
for (subgroup in unique(pivots_grouped$sub_area)) {
# Add subgroup heading
cat("\n")
cat("## Subgroup: ", subgroup, "\n")
# Filter data for current subgroup
subset_data <- dplyr::filter(pivots_grouped, sub_area == subgroup)
# Generate visualizations for each field in the subgroup
purrr::walk(subset_data$field, function(field_name) {
cat("\n")
ci_plot(field_name)
cat("\n")
cum_ci_plot(field_name)
cat("\n")
})
# Add page break after each subgroup
cat("\\newpage\n")
}
}, error = function(e) {
safe_log(paste("Error in subarea visualization section:", e$message), "ERROR")
cat("Error generating subarea plots. See log for details.\n")
})
```
# Yield prediction
The below table shows estimates of the biomass if you would harvest them now.
```{r yield_data_training, message=FALSE, warning=FALSE, include=FALSE}
# Load and prepare yield prediction data with error handling
tryCatch({
# Load CI quadrant data and fill missing values
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds")) %>%
dplyr::group_by(model) %>%
tidyr::fill(field, sub_field, .direction = "downup") %>%
dplyr::ungroup()
# Check if tonnage_ha is empty
if (all(is.na(harvesting_data$tonnage_ha))) {
safe_log("Lacking historic harvest data, please provide for yield prediction calculation", "WARNING")
knitr::knit_exit() # Exit the chunk if tonnage_ha is empty
}
# Rename year column to season for consistency
harvesting_data <- harvesting_data %>% dplyr::rename(season = year)
# Join CI and yield data
CI_and_yield <- dplyr::left_join(CI_quadrant, harvesting_data, by = c("field", "sub_field", "season")) %>%
dplyr::group_by(sub_field, season) %>%
dplyr::slice(which.max(DOY)) %>%
dplyr::select(field, sub_field, tonnage_ha, cumulative_CI, DOY, season, sub_area) %>%
dplyr::mutate(CI_per_day = cumulative_CI / DOY)
# Define predictors and response variables
predictors <- c("cumulative_CI", "DOY", "CI_per_day")
response <- "tonnage_ha"
# Prepare test and validation datasets
CI_and_yield_test <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(!is.na(tonnage_ha))
CI_and_yield_validation <- CI_and_yield_test
# Prepare prediction dataset (fields without harvest data)
prediction_yields <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(is.na(tonnage_ha)) %>%
dplyr::filter(age > 300) # Only predict on fields older than 300 days
# Configure model training parameters
ctrl <- caret::trainControl(
method = "cv",
savePredictions = TRUE,
allowParallel = TRUE,
number = 5,
verboseIter = TRUE
)
# Train the model with feature selection
set.seed(202) # For reproducibility
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,
na.rm = TRUE
)
# Function to prepare predictions with consistent naming and formatting
prepare_predictions <- function(predictions, newdata) {
return(predictions %>%
as.data.frame() %>%
dplyr::rename(predicted_Tcha = ".") %>%
dplyr::mutate(
sub_field = newdata$sub_field,
field = newdata$field,
Age_days = newdata$DOY,
total_CI = round(newdata$cumulative_CI, 0),
predicted_Tcha = round(predicted_Tcha, 0),
season = newdata$season
) %>%
dplyr::select(field, sub_field, Age_days, total_CI, predicted_Tcha, season) %>%
dplyr::left_join(., newdata, by = c("field", "sub_field", "season"))
)
}
# Predict yields for the validation dataset
pred_ffs_rf <- prepare_predictions(stats::predict(model_ffs_rf, newdata = CI_and_yield_validation), CI_and_yield_validation)
# Predict yields for the current season (focus on mature fields over 300 days)
pred_rf_current_season <- prepare_predictions(stats::predict(model_ffs_rf, newdata = prediction_yields), prediction_yields) %>%
dplyr::filter(Age_days > 1) %>%
dplyr::mutate(CI_per_day = round(total_CI / Age_days, 1))
safe_log("Successfully completed yield prediction calculations")
}, error = function(e) {
safe_log(paste("Error in yield prediction:", e$message), "ERROR")
# Create empty dataframes to prevent errors in subsequent chunks
pred_ffs_rf <- data.frame()
pred_rf_current_season <- data.frame()
})
```
```{r plotting_yield_data, echo=FALSE, fig.height=5, fig.width=8, message=FALSE, warning=FALSE}
# Display yield prediction visualizations with error handling
tryCatch({
if (nrow(pred_ffs_rf) > 0) {
# Plot model performance (predicted vs actual)
ggplot2::ggplot(pred_ffs_rf, ggplot2::aes(y = predicted_Tcha, x = tonnage_ha)) +
ggplot2::geom_point(size = 2, alpha = 0.6) +
ggplot2::geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "red") +
ggplot2::scale_x_continuous(limits = c(0, 200)) +
ggplot2::scale_y_continuous(limits = c(0, 200)) +
ggplot2::labs(title = "Model Performance: \nPredicted vs Actual Tonnage/ha",
x = "Actual tonnage/ha (Tcha)",
y = "Predicted tonnage/ha (Tcha)") +
ggplot2::theme_minimal()
}
if (nrow(pred_rf_current_season) > 0) {
# Plot predicted yields by age
ggplot2::ggplot(pred_rf_current_season, ggplot2::aes(x = Age_days, y = predicted_Tcha)) +
ggplot2::geom_point(size = 2, alpha = 0.6) +
ggplot2::labs(title = "Predicted Yields for Fields Over 300 Days \nOld Yet to Be Harvested",
x = "Age (days)",
y = "Predicted tonnage/ha (Tcha)") +
ggplot2::scale_y_continuous(limits = c(0, 200)) +
ggplot2::theme_minimal()
# Display prediction table
knitr::kable(pred_rf_current_season,
digits = 0,
caption = "Predicted Tonnage/ha for Fields Over 300 Days Old")
} else {
cat("No fields over 300 days old without harvest data available for yield prediction.")
}
}, error = function(e) {
safe_log(paste("Error in yield prediction visualization:", e$message), "ERROR")
cat("Error generating yield prediction visualizations. See log for details.")
})
```

1145
r_app/CI_report_dashboard_planet_enhanced.Rmd
View file

File diff suppressed because it is too large Load diff

721
r_app/CI_report_executive_summary.Rmd
View file

@ -1,721 +0,0 @@
---
params:
ref: "word-styles-reference-var1.docx"
output_file: CI_report.docx
report_date: "2025-06-16"
data_dir: "simba"
mail_day: "Wednesday"
borders: TRUE
use_breaks: FALSE
output:
# html_document:
# toc: yes
# df_print: paged
word_document:
reference_docx: !expr file.path("word-styles-reference-var1.docx")
toc: yes
editor_options:
chunk_output_type: console
---
```{r setup_parameters, include=FALSE}
# Set up basic report parameters from input values
report_date <- params$report_date
mail_day <- params$mail_day
borders <- params$borders
use_breaks <- params$use_breaks # Whether to use breaks or continuous spectrum in visualizations
# Environment setup notes (commented out)
# # Activeer de renv omgeving
# renv::activate()
# renv::deactivate()
# # Optioneel: Herstel de omgeving als dat nodig is
# # Je kunt dit commentaar geven als je het normaal niet wilt uitvoeren
# renv::restore()
```
```{r load_libraries, message=FALSE, warning=FALSE, include=FALSE}
# Configure knitr options
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
# Path management
library(here)
# Spatial data libraries
library(sf)
library(terra)
library(exactextractr)
# library(raster) - Removed as it's no longer maintained
# Data manipulation and visualization
library(tidyverse) # Includes dplyr, ggplot2, etc.
library(tmap)
library(lubridate)
library(zoo)
# Machine learning
library(rsample)
library(caret)
library(randomForest)
library(CAST)
# Load custom utility functions
# tryCatch({
# source("report_utils.R")
# }, error = function(e) {
# message(paste("Error loading report_utils.R:", e$message))
# # Try alternative path if the first one fails
# tryCatch({
source(here::here("r_app", "report_utils.R"))
# }, error = function(e) {
# stop("Could not load report_utils.R from either location: ", e$message)
# })
# })
# Load executive report utilities
# tryCatch({
# source("executive_report_utils.R")
# }, error = function(e) {
# message(paste("Error loading executive_report_utils.R:", e$message))
# # Try alternative path if the first one fails
# tryCatch({
source(here::here("r_app","exec_dashboard", "executive_report_utils.R"))
# }, error = function(e) {
# stop("Could not load executive_report_utils.R from either location: ", e$message)
# })
# })
safe_log("Successfully loaded utility functions")
```
```{r initialize_project_config, message=FALSE, warning=FALSE, include=FALSE}
# Set the project directory from parameters
project_dir <- params$data_dir
# Source project parameters with error handling
tryCatch({
source(here::here("r_app", "parameters_project.R"))
}, error = function(e) {
stop("Error loading parameters_project.R: ", e$message)
})
# Log initial configuration
safe_log("Starting the R Markdown script")
safe_log(paste("mail_day params:", params$mail_day))
safe_log(paste("report_date params:", params$report_date))
safe_log(paste("mail_day variable:", mail_day))
```
```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE}
# Set locale for consistent date formatting
Sys.setlocale("LC_TIME", "C")
# Initialize date variables from parameters
today <- as.character(report_date)
mail_day_as_character <- as.character(mail_day)
# Calculate week days
report_date_as_week_day <- weekdays(lubridate::ymd(today))
days_of_week <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
# Calculate initial week number
week <- lubridate::week(today)
safe_log(paste("Initial week calculation:", week, "today:", today))
# Calculate previous dates for comparisons
today_minus_1 <- as.character(lubridate::ymd(today) - 7)
today_minus_2 <- as.character(lubridate::ymd(today) - 14)
today_minus_3 <- as.character(lubridate::ymd(today) - 21)
# Log the weekday calculations for debugging
safe_log(paste("Report date weekday:", report_date_as_week_day))
safe_log(paste("Weekday index:", which(days_of_week == report_date_as_week_day)))
safe_log(paste("Mail day:", mail_day_as_character))
safe_log(paste("Mail day index:", which(days_of_week == mail_day_as_character)))
# Adjust week calculation based on mail day
if (which(days_of_week == report_date_as_week_day) > which(days_of_week == mail_day_as_character)) {
safe_log("Adjusting weeks because of mail day")
week <- lubridate::week(today) + 1
today_minus_1 <- as.character(lubridate::ymd(today))
today_minus_2 <- as.character(lubridate::ymd(today) - 7)
today_minus_3 <- as.character(lubridate::ymd(today) - 14)
}
# Generate subtitle for report
subtitle_var <- paste("Report generated on", Sys.Date())
# Calculate week numbers for previous weeks
week_minus_1 <- week - 1
week_minus_2 <- week - 2
week_minus_3 <- week - 3
# Format current week with leading zeros
week <- sprintf("%02d", week)
# Get years for each date
year <- lubridate::year(today)
year_1 <- lubridate::year(today_minus_1)
year_2 <- lubridate::year(today_minus_2)
year_3 <- lubridate::year(today_minus_3)
```
```{r data, message=TRUE, warning=TRUE, include=FALSE}
# Load CI index data with error handling
tryCatch({
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
safe_log("Successfully loaded CI quadrant data")
}, error = function(e) {
stop("Error loading CI quadrant data: ", e$message)
})
# Get file paths for different weeks using the utility function
tryCatch({
path_to_week_current = get_week_path(weekly_CI_mosaic, today, 0)
path_to_week_minus_1 = get_week_path(weekly_CI_mosaic, today, -1)
path_to_week_minus_2 = get_week_path(weekly_CI_mosaic, today, -2)
path_to_week_minus_3 = get_week_path(weekly_CI_mosaic, today, -3)
# Log the calculated paths
safe_log("Required mosaic paths:")
safe_log(paste("Path to current week:", path_to_week_current))
safe_log(paste("Path to week minus 1:", path_to_week_minus_1))
safe_log(paste("Path to week minus 2:", path_to_week_minus_2))
safe_log(paste("Path to week minus 3:", path_to_week_minus_3))
# Validate that files exist
if (!file.exists(path_to_week_current)) warning("Current week mosaic file does not exist: ", path_to_week_current)
if (!file.exists(path_to_week_minus_1)) warning("Week minus 1 mosaic file does not exist: ", path_to_week_minus_1)
if (!file.exists(path_to_week_minus_2)) warning("Week minus 2 mosaic file does not exist: ", path_to_week_minus_2)
if (!file.exists(path_to_week_minus_3)) warning("Week minus 3 mosaic file does not exist: ", path_to_week_minus_3)
# Load raster data with terra functions
CI <- terra::rast(path_to_week_current)$CI
CI_m1 <- terra::rast(path_to_week_minus_1)$CI
CI_m2 <- terra::rast(path_to_week_minus_2)$CI
CI_m3 <- terra::rast(path_to_week_minus_3)$CI
}, error = function(e) {
stop("Error loading raster data: ", e$message)
})
```
```{r calculate_difference_rasters, message=TRUE, warning=TRUE, include=FALSE}
# Calculate difference rasters for comparisons
tryCatch({
# Calculate weekly difference
last_week_dif_raster_abs <- (CI - CI_m1)
safe_log("Calculated weekly difference raster")
# Calculate three-week difference
three_week_dif_raster_abs <- (CI - CI_m3)
safe_log("Calculated three-week difference raster")
}, error = function(e) {
safe_log(paste("Error calculating difference rasters:", e$message), "ERROR")
# Create placeholder rasters if calculations fail
if (!exists("last_week_dif_raster_abs")) {
last_week_dif_raster_abs <- CI * 0
}
if (!exists("three_week_dif_raster_abs")) {
three_week_dif_raster_abs <- CI * 0
}
})
```
```{r load_field_boundaries, message=TRUE, warning=TRUE, include=FALSE}
# Load field boundaries from parameters
tryCatch({
AllPivots0 <- field_boundaries_sf
safe_log("Successfully loaded field boundaries")
}, error = function(e) {
stop("Error loading field boundaries: ", e$message)
})
```
```{r create_farm_health_data, message=FALSE, warning=FALSE, include=FALSE}
# Create farm health summary data from scratch
tryCatch({
# Ensure we have the required data
if (!exists("AllPivots0") || !exists("CI") || !exists("CI_m1") || !exists("harvesting_data")) {
stop("Required input data (field boundaries, CI data, or harvesting data) not available")
}
safe_log("Starting to calculate farm health data")
# Get unique field names
fields <- unique(AllPivots0$field)
safe_log(paste("Found", length(fields), "unique fields"))
# Initialize result dataframe
farm_health_data <- data.frame(
field = character(),
mean_ci = numeric(),
ci_change = numeric(),
ci_uniformity = numeric(),
status = character(),
anomaly_type = character(),
priority_level = numeric(),
age_weeks = numeric(),
harvest_readiness = character(),
stringsAsFactors = FALSE
)
# Process each field with robust error handling
for (field_name in fields) {
tryCatch({
safe_log(paste("Processing field:", field_name))
# Get field boundary
field_shape <- AllPivots0 %>% dplyr::filter(field == field_name)
# Skip if field shape is empty
if (nrow(field_shape) == 0) {
safe_log(paste("Empty field shape for", field_name), "WARNING")
next
}
# Get field age from harvesting data - use direct filtering to avoid dplyr errors
field_age_data <- NULL
if (exists("harvesting_data") && !is.null(harvesting_data) && nrow(harvesting_data) > 0) {
field_age_data <- harvesting_data[harvesting_data$field == field_name, ]
if (nrow(field_age_data) > 0) {
field_age_data <- field_age_data[order(field_age_data$season_start, decreasing = TRUE), ][1, ]
}
}
# Default age if not available
field_age_weeks <- if (!is.null(field_age_data) && nrow(field_age_data) > 0 && !is.na(field_age_data$age)) {
field_age_data$age
} else {
10 # Default age
}
# Extract CI values using terra's extract function which is more robust
ci_values <- terra::extract(CI, field_shape)
ci_prev_values <- terra::extract(CI_m1, field_shape)
# Check if we got valid data
if (nrow(ci_values) == 0 || nrow(ci_prev_values) == 0) {
safe_log(paste("No CI data extracted for field", field_name), "WARNING")
# Add a placeholder row with Unknown status
farm_health_data <- rbind(farm_health_data, data.frame(
field = field_name,
mean_ci = NA,
ci_change = NA,
ci_uniformity = NA,
status = "Unknown",
anomaly_type = "Unknown",
priority_level = 5, # Low priority
age_weeks = field_age_weeks,
harvest_readiness = "Unknown",
stringsAsFactors = FALSE
))
next
}
# Calculate metrics - Handle NA values properly
ci_column <- if ("CI" %in% names(ci_values)) "CI" else colnames(ci_values)[1]
ci_prev_column <- if ("CI" %in% names(ci_prev_values)) "CI" else colnames(ci_prev_values)[1]
mean_ci <- mean(ci_values[[ci_column]], na.rm=TRUE)
mean_ci_prev <- mean(ci_prev_values[[ci_prev_column]], na.rm=TRUE)
ci_change <- mean_ci - mean_ci_prev
ci_sd <- sd(ci_values[[ci_column]], na.rm=TRUE)
ci_uniformity <- ci_sd / max(0.1, mean_ci) # Avoid division by zero
# Handle NaN or Inf results
if (is.na(mean_ci) || is.na(ci_change) || is.na(ci_uniformity) ||
is.nan(mean_ci) || is.nan(ci_change) || is.nan(ci_uniformity) ||
is.infinite(mean_ci) || is.infinite(ci_change) || is.infinite(ci_uniformity)) {
safe_log(paste("Invalid calculation results for field", field_name), "WARNING")
# Add a placeholder row with Unknown status
farm_health_data <- rbind(farm_health_data, data.frame(
field = field_name,
mean_ci = NA,
ci_change = NA,
ci_uniformity = NA,
status = "Unknown",
anomaly_type = "Unknown",
priority_level = 5, # Low priority
age_weeks = field_age_weeks,
harvest_readiness = "Unknown",
stringsAsFactors = FALSE
))
next
}
# Determine field status
status <- dplyr::case_when(
mean_ci >= 5 ~ "Excellent",
mean_ci >= 3.5 ~ "Good",
mean_ci >= 2 ~ "Fair",
mean_ci >= 1 ~ "Poor",
TRUE ~ "Critical"
)
# Determine anomaly type
anomaly_type <- dplyr::case_when(
ci_change > 2 ~ "Potential Weed Growth",
ci_change < -2 ~ "Potential Weeding/Harvesting",
ci_uniformity > 0.5 ~ "High Variability",
mean_ci < 1 ~ "Low Vigor",
TRUE ~ "None"
)
# Calculate priority level (1-5, with 1 being highest priority)
priority_score <- dplyr::case_when(
mean_ci < 1 ~ 1, # Critical - highest priority
anomaly_type == "Potential Weed Growth" ~ 2,
anomaly_type == "High Variability" ~ 3,
ci_change < -1 ~ 4,
TRUE ~ 5 # No urgent issues
)
# Determine harvest readiness
harvest_readiness <- dplyr::case_when(
field_age_weeks >= 52 & mean_ci >= 4 ~ "Ready for harvest",
field_age_weeks >= 48 & mean_ci >= 3.5 ~ "Approaching harvest",
field_age_weeks >= 40 & mean_ci >= 3 ~ "Mid-maturity",
field_age_weeks >= 12 ~ "Growing",
TRUE ~ "Early stage"
)
# Add to summary data
farm_health_data <- rbind(farm_health_data, data.frame(
field = field_name,
mean_ci = round(mean_ci, 2),
ci_change = round(ci_change, 2),
ci_uniformity = round(ci_uniformity, 2),
status = status,
anomaly_type = anomaly_type,
priority_level = priority_score,
age_weeks = field_age_weeks,
harvest_readiness = harvest_readiness,
stringsAsFactors = FALSE
))
}, error = function(e) {
safe_log(paste("Error processing field", field_name, ":", e$message), "ERROR")
# Add a placeholder row with Error status
farm_health_data <<- rbind(farm_health_data, data.frame(
field = field_name,
mean_ci = NA,
ci_change = NA,
ci_uniformity = NA,
status = "Unknown",
anomaly_type = "Unknown",
priority_level = 5, # Low priority since we don't know the status
age_weeks = NA,
harvest_readiness = "Unknown",
stringsAsFactors = FALSE
))
})
}
# Make sure we have data for all fields
if (nrow(farm_health_data) == 0) {
safe_log("No farm health data was created", "ERROR")
stop("Failed to create farm health data")
}
# Sort by priority level
farm_health_data <- farm_health_data %>% dplyr::arrange(priority_level, field)
safe_log(paste("Successfully created farm health data for", nrow(farm_health_data), "fields"))
}, error = function(e) {
safe_log(paste("Error creating farm health data:", e$message), "ERROR")
# Create an empty dataframe that can be filled by the verification chunk
})
```
```{r verify_farm_health_data, message=FALSE, warning=FALSE, include=FALSE}
# Verify farm_health_data exists and has content
if (!exists("farm_health_data") || nrow(farm_health_data) == 0) {
safe_log("farm_health_data not found or empty, generating default data", "WARNING")
# Create minimal fallback data
tryCatch({
# Get fields from boundaries
fields <- unique(AllPivots0$field)
# Create basic data frame with just field names
farm_health_data <- data.frame(
field = fields,
mean_ci = rep(NA, length(fields)),
ci_change = rep(NA, length(fields)),
ci_uniformity = rep(NA, length(fields)),
status = rep("Unknown", length(fields)),
anomaly_type = rep("Unknown", length(fields)),
priority_level = rep(5, length(fields)), # Low priority
age_weeks = rep(NA, length(fields)),
harvest_readiness = rep("Unknown", length(fields)),
stringsAsFactors = FALSE
)
safe_log("Created fallback farm_health_data with basic field information")
}, error = function(e) {
safe_log(paste("Error creating fallback farm_health_data:", e$message), "ERROR")
farm_health_data <<- data.frame(
field = character(),
mean_ci = numeric(),
ci_change = numeric(),
ci_uniformity = numeric(),
status = character(),
anomaly_type = character(),
priority_level = numeric(),
age_weeks = numeric(),
harvest_readiness = character(),
stringsAsFactors = FALSE
)
})
}
```
```{r calculate_farm_health, message=FALSE, warning=FALSE, include=FALSE}
# Calculate farm health summary metrics
tryCatch({
# Generate farm health summary data
farm_health_data <- generate_farm_health_summary(
field_boundaries = AllPivots0,
ci_current = CI,
ci_previous = CI_m1,
harvesting_data = harvesting_data
)
# Log the summary data
safe_log(paste("Generated farm health summary with", nrow(farm_health_data), "fields"))
}, error = function(e) {
safe_log(paste("Error in farm health calculation:", e$message), "ERROR")
# Create empty dataframe if calculation failed
farm_health_data <- data.frame(
field = character(),
mean_ci = numeric(),
ci_change = numeric(),
ci_uniformity = numeric(),
status = character(),
anomaly_type = character(),
priority_level = numeric(),
age_weeks = numeric(),
harvest_readiness = character(),
stringsAsFactors = FALSE
)
})
```
```{r advanced_analytics_functions, message=FALSE, warning=FALSE, include=FALSE}
# ADVANCED ANALYTICS FUNCTIONS
# Note: These functions are now imported from executive_report_utils.R
# The utility file contains functions for velocity/acceleration indicators,
# anomaly timeline creation, age cohort mapping, and cohort performance charts
safe_log("Using analytics functions from executive_report_utils.R")
```
\pagebreak
# Advanced Analytics
## Field Health Velocity and Acceleration
This visualization shows the rate of change in field health (velocity) and whether that change is speeding up or slowing down (acceleration). These metrics help identify if farm conditions are improving, stable, or deteriorating.
**How to interpret:**
- **Velocity gauge:** Shows the average weekly change in CI values across all fields
- Positive values (green/right side): Farm health improving week-to-week
- Negative values (red/left side): Farm health declining week-to-week
- **Acceleration gauge:** Shows whether the rate of change is increasing or decreasing
- Positive values (green/right side): Change is accelerating or improving faster
- Negative values (red/left side): Change is decelerating or slowing down
- **4-Week Trend:** Shows the overall CI value trajectory for the past month
```{r render_velocity_acceleration, echo=FALSE, fig.height=8, fig.width=10, message=FALSE, warning=FALSE}
# Render the velocity and acceleration indicators
tryCatch({
# Create and display the indicators using the imported utility function
velocity_plot <- create_velocity_acceleration_indicator(
health_data = farm_health_data,
ci_current = CI,
ci_prev1 = CI_m1,
ci_prev2 = CI_m2,
ci_prev3 = CI_m3,
field_boundaries = AllPivots0
)
# Print the visualization
print(velocity_plot)
# Create a table of fields with significant velocity changes
field_ci_metrics <- list()
# Process each field to get metrics
fields <- unique(AllPivots0$field)
for (field_name in fields) {
tryCatch({
# Get field boundary
field_shape <- AllPivots0 %>% dplyr::filter(field == field_name)
if (nrow(field_shape) == 0) next
# Extract CI values
ci_curr_values <- terra::extract(CI, field_shape)
ci_prev1_values <- terra::extract(CI_m1, field_shape)
# Calculate metrics
mean_ci_curr <- mean(ci_curr_values$CI, na.rm = TRUE)
mean_ci_prev1 <- mean(ci_prev1_values$CI, na.rm = TRUE)
velocity <- mean_ci_curr - mean_ci_prev1
# Store in list
field_ci_metrics[[field_name]] <- list(
field = field_name,
ci_current = mean_ci_curr,
ci_prev1 = mean_ci_prev1,
velocity = velocity
)
}, error = function(e) {
safe_log(paste("Error processing field", field_name, "for velocity table:", e$message), "WARNING")
})
}
# Convert list to data frame
velocity_df <- do.call(rbind, lapply(field_ci_metrics, function(x) {
data.frame(
field = x$field,
ci_current = round(x$ci_current, 2),
ci_prev1 = round(x$ci_prev1, 2),
velocity = round(x$velocity, 2),
direction = ifelse(x$velocity >= 0, "Improving", "Declining")
)
}))
# Select top 5 positive and top 5 negative velocity fields
top_positive <- velocity_df %>%
dplyr::filter(velocity > 0) %>%
dplyr::arrange(desc(velocity)) %>%
dplyr::slice_head(n = 5)
top_negative <- velocity_df %>%
dplyr::filter(velocity < 0) %>%
dplyr::arrange(velocity) %>%
dplyr::slice_head(n = 5)
# Display the tables if we have data
if (nrow(top_positive) > 0) {
cat("<h4>Fields with Fastest Improvement</h4>")
knitr::kable(top_positive %>%
dplyr::select(Field = field,
`Current CI` = ci_current,
`Previous CI` = ci_prev1,
`Weekly Change` = velocity))
}
if (nrow(top_negative) > 0) {
cat("<h4>Fields with Fastest Decline</h4>")
knitr::kable(top_negative %>%
dplyr::select(Field = field,
`Current CI` = ci_current,
`Previous CI` = ci_prev1,
`Weekly Change` = velocity))
}
}, error = function(e) {
safe_log(paste("Error rendering velocity visualization:", e$message), "ERROR")
cat("<div class='alert alert-danger'>Error generating velocity visualization.</div>")
})
```
\pagebreak
## Field Anomaly Timeline
This visualization shows the history of detected anomalies in fields across the monitoring period. It helps identify persistent issues or improvements over time.
**How to interpret:**
- **X-axis**: Dates of satellite observations
- **Y-axis**: Fields grouped by similar characteristics
- **Colors**: Red indicates negative anomalies, green indicates positive anomalies
- **Size**: Larger markers indicate stronger anomalies
```{r anomaly_timeline, echo=FALSE, fig.height=8, fig.width=10, message=FALSE, warning=FALSE}
# Generate anomaly timeline visualization
tryCatch({
# Use the imported function to create the anomaly timeline
anomaly_timeline <- create_anomaly_timeline(
field_boundaries = AllPivots0,
ci_data = CI_quadrant,
days_to_include = 90 # Show last 90 days of data
)
# Display the timeline
print(anomaly_timeline)
}, error = function(e) {
safe_log(paste("Error generating anomaly timeline:", e$message), "ERROR")
cat("<div class='alert alert-danger'>Error generating anomaly timeline visualization.</div>")
})
```
\pagebreak
## Field Age Cohorts Map
This map shows fields grouped by their crop age (weeks since planting). Understanding the distribution of crop ages helps interpret performance metrics and plan harvest scheduling.
**How to interpret:**
- **Colors**: Different colors represent different age groups (in weeks since planting)
- **Labels**: Each field is labeled with its name for easy reference
- **Legend**: Shows the age ranges in weeks and their corresponding colors
```{r age_cohort_map, echo=FALSE, fig.height=8, fig.width=10, message=FALSE, warning=FALSE}
# Generate age cohort map
tryCatch({
# Use the imported function to create the age cohort map
age_cohort_map <- create_age_cohort_map(
field_boundaries = AllPivots0,
harvesting_data = harvesting_data
)
# Display the map
print(age_cohort_map)
}, error = function(e) {
safe_log(paste("Error generating age cohort map:", e$message), "ERROR")
cat("<div class='alert alert-danger'>Error generating age cohort map visualization.</div>")
})
```
\pagebreak
## Cohort Performance Comparison
This visualization compares chlorophyll index (CI) performance across different age groups of fields. This helps identify if certain age groups are performing better or worse than expected.
**How to interpret:**
- **X-axis**: Field age groups in weeks since planting
- **Y-axis**: Average CI value for fields in that age group
- **Box plots**: Show the distribution of CI values within each age group
- **Line**: Shows the expected CI trajectory based on historical data
```{r cohort_performance_chart, echo=FALSE, fig.height=8, fig.width=10, message=FALSE, warning=FALSE}
# Generate cohort performance comparison chart
tryCatch({
# Use the imported function to create the cohort performance chart
cohort_chart <- create_cohort_performance_chart(
field_boundaries = AllPivots0,
ci_current = CI,
harvesting_data = harvesting_data
)
# Display the chart
print(cohort_chart)
}, error = function(e) {
safe_log(paste("Error generating cohort performance chart:", e$message), "ERROR")
cat("<div class='alert alert-danger'>Error generating cohort performance visualization.</div>")
})
```

117
r_app/ci_extraction.R
View file

@ -1,117 +0,0 @@
# CI_EXTRACTION.R
# ==============
# This script processes satellite imagery to extract Canopy Index (CI) values for agricultural fields.
# It handles image processing, masking, and extraction of statistics by field/sub-field.
#
# Usage: Rscript ci_extraction.R [end_date] [offset] [project_dir]
# - end_date: End date for processing (YYYY-MM-DD format)
# - offset: Number of days to look back from end_date
# - project_dir: Project directory name (e.g., "chemba")
#
# 1. Load required packages
# -----------------------
suppressPackageStartupMessages({
library(sf)
library(terra)
library(tidyverse)
library(lubridate)
library(exactextractr)
library(readxl)
library(here)
})
# 2. Process command line arguments
# ------------------------------
main <- function() {
# Capture command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Process end_date argument
if (length(args) >= 1 && !is.na(args[1])) {
end_date <- as.Date(args[1])
if (is.na(end_date)) {
warning("Invalid end_date provided. Using default (current date).")
end_date <- Sys.Date()
#end_date <- "2023-10-01"
}
} else {
end_date <- Sys.Date()
#end_date <- "2023-10-01"
}
# Process offset argument
if (length(args) >= 2 && !is.na(args[2])) {
offset <- as.numeric(args[2])
if (is.na(offset) || offset <= 0) {
warning("Invalid offset provided. Using default (7 days).")
offset <- 1095
}
} else {
offset <- 1095
}
# Process project_dir argument
if (length(args) >= 3 && !is.na(args[3])) {
project_dir <- as.character(args[3])
} else {
project_dir <- "aura"
}
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# 3. Initialize project configuration
# --------------------------------
new_project_question <- TRUE
tryCatch({
source("parameters_project.R")
source("ci_extraction_utils.R")
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source(here::here("r_app", "parameters_project.R"))
source(here::here("r_app", "ci_extraction_utils.R"))
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
# 4. Generate date list for processing
# ---------------------------------
dates <- date_list(end_date, offset)
log_message(paste("Processing data for week", dates$week, "of", dates$year))
# 5. Find and filter raster files by date
# -----------------------------------
log_message("Searching for raster files")
tryCatch({
# Use the new utility function to find satellite images
existing_files <- find_satellite_images(planet_tif_folder, dates$days_filter)
log_message(paste("Found", length(existing_files), "raster files for processing"))
# 6. Process raster files and create VRT
# -----------------------------------
# Use the new utility function for batch processing
vrt_list <- process_satellite_images(existing_files, field_boundaries, merged_final, daily_vrt)
# 7. Process and combine CI values
# ------------------------------
# Call the process_ci_values function from utils with all required parameters
process_ci_values(dates, field_boundaries, merged_final,
field_boundaries_sf, daily_CI_vals_dir, cumulative_CI_vals_dir)
}, error = function(e) {
log_message(paste("Error in main processing:", e$message), level = "ERROR")
stop(e$message)
})
}
if (sys.nframe() == 0) {
main()
}

1909
r_app/crop_messaging_utils.R Normal file
View file

File diff suppressed because it is too large Load diff

400
r_app/experiments/10_CI_report_with_kpis.Rmd Normal file
View file

@ -0,0 +1,400 @@
---
params:
ref: "word-styles-reference-var1.docx"
output_file: CI_report_with_kpis.docx
report_date: "2025-09-18"
data_dir: "esa"
mail_day: "Wednesday"
borders: FALSE
ci_plot_type: "both" # options: "absolute", "cumulative", "both"
colorblind_friendly: TRUE # use colorblind-friendly palettes (viridis/plasma)
facet_by_season: FALSE # facet CI trend plots by season instead of overlaying
x_axis_unit: "days" # x-axis unit for trend plots: "days" or "weeks"
output:
# html_document:
# toc: yes
# df_print: paged
word_document:
reference_docx: !expr file.path("word-styles-reference-var1.docx")
toc: no
editor_options:
chunk_output_type: console
---
```{r setup_parameters, include=FALSE}
# Set up basic report parameters from input values
report_date <- params$report_date
mail_day <- params$mail_day
borders <- params$borders
ci_plot_type <- params$ci_plot_type
colorblind_friendly <- params$colorblind_friendly
facet_by_season <- params$facet_by_season
x_axis_unit <- params$x_axis_unit
```
```{r load_libraries, message=FALSE, warning=FALSE, include=FALSE}
# Configure knitr options
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
# Load all packages at once with suppressPackageStartupMessages
suppressPackageStartupMessages({
library(here)
library(sf)
library(terra)
library(exactextractr)
library(tidyverse)
library(tmap)
library(lubridate)
library(zoo)
library(rsample)
library(caret)
library(randomForest)
library(CAST)
library(knitr)
})
# Load custom utility functions
tryCatch({
source("report_utils.R")
}, error = function(e) {
message(paste("Error loading report_utils.R:", e$message))
# Try alternative path if the first one fails
tryCatch({
source(here::here("r_app", "report_utils.R"))
}, error = function(e) {
stop("Could not load report_utils.R from either location: ", e$message)
})
})
```
```{r initialize_project_config, message=FALSE, warning=FALSE, include=FALSE}
# Set the project directory from parameters
project_dir <- params$data_dir
# Source project parameters with error handling
tryCatch({
source(here::here("r_app", "parameters_project.R"))
}, error = function(e) {
stop("Error loading parameters_project.R: ", e$message)
})
# Log initial configuration
safe_log("Starting the R Markdown script with KPIs")
safe_log(paste("mail_day params:", params$mail_day))
safe_log(paste("report_date params:", params$report_date))
safe_log(paste("mail_day variable:", mail_day))
```
```{r load_kpi_data, message=FALSE, warning=FALSE, include=FALSE}
# SIMPLE KPI LOADING - just load the damn files!
kpi_data_dir <- file.path("..", "laravel_app", "storage", "app", project_dir, "reports", "kpis")
date_suffix <- format(as.Date(report_date), "%Y%m%d")
summary_file <- file.path(kpi_data_dir, paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"))
# Load the summary tables (this works!)
summary_tables <- readRDS(summary_file)
# Load field details too
field_details_file <- file.path(kpi_data_dir, paste0(project_dir, "_field_details_", date_suffix, ".rds"))
field_details_table <- readRDS(field_details_file)
# Set this for compatibility with rest of report
kpi_files_exist <- TRUE
safe_log("✓ KPI summary tables loaded successfully")
```
```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE}
# Set locale for consistent date formatting
Sys.setlocale("LC_TIME", "C")
# Initialize date variables from parameters
today <- as.character(report_date)
mail_day_as_character <- as.character(mail_day)
# Calculate report dates and weeks
report_date_obj <- as.Date(today)
current_week <- as.numeric(format(report_date_obj, "%U"))
year <- as.numeric(format(report_date_obj, "%Y"))
# Calculate dates for weekly analysis
week_start <- report_date_obj - ((as.numeric(format(report_date_obj, "%w")) + 1) %% 7)
week_end <- week_start + 6
safe_log(paste("Report week:", current_week, "Year:", year))
safe_log(paste("Week range:", week_start, "to", week_end))
```
# SmartCane Monitoring Report with KPIs
**Report Date:** `r format(as.Date(report_date), "%B %d, %Y")`
**Project:** `r toupper(project_dir)`
**Week:** `r current_week` of `r year`
---
## Executive Summary - Key Performance Indicators
This report provides a comprehensive analysis of sugarcane field performance using satellite-based monitoring.
### Field Uniformity
```{r field_uniformity_table, echo=FALSE}
kable(summary_tables$field_uniformity_summary,
caption = "Field Uniformity Summary",
col.names = c("Uniformity Level", "Count", "Percent"))
```
### TCH Forecasted
```{r tch_forecasted_table, echo=FALSE}
kable(summary_tables$tch_forecasted_summary,
caption = "TCH Forecasted Summary",
col.names = c("Field Groups", "Count", "Value"))
```
### Farm-wide Area Change
```{r area_change_table, echo=FALSE}
kable(summary_tables$area_change_summary,
caption = "Farm-wide Area Change Summary",
col.names = c("Change Type", "Hectares", "Percent"))
```
### Weed Presence Score
```{r weed_presence_table, echo=FALSE}
kable(summary_tables$weed_presence_summary,
caption = "Weed Presence Score Summary",
col.names = c("Weed Risk Level", "Field Count", "Percent"))
```
### Growth Decline Index
```{r growth_decline_table, echo=FALSE}
kable(summary_tables$growth_decline_summary,
caption = "Growth Decline Index Summary",
col.names = c("Risk Level", "Count", "Percent"))
```
### Gap Filling Assessment
```{r gap_filling_table, echo=FALSE}
kable(summary_tables$gap_filling_summary,
caption = "Gap Filling Assessment Summary",
col.names = c("Gap Level", "Field Count", "Percent"))
```
### Detailed KPI Breakdown
```{r kpi_detailed_breakdown, echo=FALSE}
# Show all 6 KPI tables in a more compact format
cat("**Field Uniformity**\n")
kable(summary_tables$field_uniformity_summary, col.names = c("Level", "Count", "%"))
cat("\n**TCH Forecasted**\n")
kable(summary_tables$tch_forecasted_summary, col.names = c("Groups", "Count", "Value"))
cat("\n**Area Change**\n")
kable(summary_tables$area_change_summary, col.names = c("Change", "Ha", "%"))
cat("\n**Weed Presence**\n")
kable(summary_tables$weed_presence_summary, col.names = c("Risk", "Count", "%"))
cat("\n**Growth Decline**\n")
kable(summary_tables$growth_decline_summary, col.names = c("Risk", "Count", "%"))
cat("\n**Gap Filling**\n")
kable(summary_tables$gap_filling_summary, col.names = c("Level", "Count", "%"))
```
## KPI Summary Charts
```{r kpi_charts, echo=FALSE, fig.width=10, fig.height=8}
# Load ggplot2 for creating charts
library(ggplot2)
library(gridExtra)
# Create charts for key KPIs using correct column names
# 1. Field Uniformity Chart
p1 <- ggplot(summary_tables$field_uniformity_summary, aes(x = reorder(`Uniformity Level`, -Count), y = Count)) +
geom_col(fill = "steelblue", alpha = 0.7) +
labs(title = "Field Uniformity Distribution", x = "Uniformity Level", y = "Field Count") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# 2. TCH Forecasted Chart
p2 <- ggplot(summary_tables$tch_forecasted_summary, aes(x = `Field Groups`, y = Value)) +
geom_col(fill = "darkgreen", alpha = 0.7) +
labs(title = "TCH Forecast by Field Groups", x = "Field Groups", y = "Value") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# 3. Growth Decline Risk Chart
p3 <- ggplot(summary_tables$growth_decline_summary, aes(x = reorder(`Risk Level`, -Count), y = Count)) +
geom_col(fill = "orange", alpha = 0.7) +
labs(title = "Growth Decline Risk Distribution", x = "Risk Level", y = "Field Count") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# 4. Weed Presence Risk Chart
p4 <- ggplot(summary_tables$weed_presence_summary, aes(x = reorder(`Weed Risk Level`, -`Field Count`), y = `Field Count`)) +
geom_col(fill = "red", alpha = 0.7) +
labs(title = "Weed Presence Risk Distribution", x = "Risk Level", y = "Field Count") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Arrange plots in a grid
grid.arrange(p1, p2, p3, p4, ncol = 2, nrow = 2)
```
---
\newpage
## Field-by-Field Analysis
The following sections provide detailed analysis for each monitored field, including spatial maps, temporal trends, and field-specific KPI summaries.
```{r load_field_data, message=FALSE, warning=FALSE, include=FALSE}
# Load field data and prepare for field-by-field analysis
# Load the spatial and temporal CI data needed for visualizations
# Check if the required data objects exist from parameters_project.R
required_objects <- c("AllPivots0", "CI", "CI_m1", "CI_m2", "CI_quadrant", "harvesting_data")
missing_objects <- required_objects[!sapply(required_objects, exists)]
if (length(missing_objects) > 0) {
safe_log(paste("Missing required objects for field analysis:", paste(missing_objects, collapse = ", ")), "WARNING")
field_analysis_possible <- FALSE
} else {
safe_log("All required data objects found for field analysis")
field_analysis_possible <- TRUE
# Prepare field list from the loaded boundaries
field_list <- AllPivots0 %>%
filter(!is.na(field), !is.na(sub_field)) %>%
group_by(field) %>%
summarise(.groups = 'drop') %>%
slice_head(n = 3) # Limit to first 3 fields for report length
}
```
```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=10, message=FALSE, echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
# Generate detailed visualizations for each field (copied from 05_CI_report_dashboard_planet.Rmd)
if (field_analysis_possible) {
tryCatch({
# Merge field polygons for processing and filter out NA field names
AllPivots_merged <- AllPivots0 %>%
dplyr::filter(!is.na(field), !is.na(sub_field)) %>% # Filter out NA fields
dplyr::group_by(field) %>%
dplyr::summarise(.groups = 'drop') %>%
slice_head(n = 3) # Limit to first 3 fields for report
# Generate plots for each field
for(i in seq_along(AllPivots_merged$field)) {
field_name <- AllPivots_merged$field[i]
# Skip if field_name is still NA (double check)
if(is.na(field_name)) {
next
}
tryCatch({
# Add page break before each field (except the first one)
if(i > 1) {
cat("\\newpage\n\n")
}
# Call ci_plot with explicit parameters (ci_plot will generate its own header)
ci_plot(
pivotName = field_name,
field_boundaries = AllPivots0,
current_ci = CI,
ci_minus_1 = CI_m1,
ci_minus_2 = CI_m2,
last_week_diff = last_week_dif_raster_abs,
three_week_diff = three_week_dif_raster_abs,
harvesting_data = harvesting_data,
week = week,
week_minus_1 = week_minus_1,
week_minus_2 = week_minus_2,
week_minus_3 = week_minus_3,
borders = borders,
colorblind_friendly = colorblind_friendly
)
cat("\n\n")
# Call cum_ci_plot with explicit parameters
cum_ci_plot(
pivotName = field_name,
ci_quadrant_data = CI_quadrant,
plot_type = ci_plot_type,
facet_on = facet_by_season,
x_unit = x_axis_unit,
colorblind_friendly = colorblind_friendly
)
cat("\n\n")
}, error = function(e) {
safe_log(paste("Error generating plots for field", field_name, ":", e$message), "ERROR")
cat("\\newpage\n\n")
cat("# Error generating plots for field ", field_name, "\n\n")
cat("Data not available for visualization\n\n")
})
}
}, error = function(e) {
safe_log(paste("Error in field visualization section:", e$message), "ERROR")
cat("Error generating field plots. See log for details.\n\n")
})
} else {
cat("Field visualization data not available. Required data objects are missing.\n\n")
cat("Please ensure scripts 02 (CI extraction) and 03 (growth model) have been run successfully.\n\n")
}
```
---
\newpage
## Detailed Field Summary Table
The following table provides a comprehensive overview of all monitored fields with their key performance metrics.
```{r detailed_field_table, echo=FALSE}
# Clean up the field details table - remove sub field column and round numeric values
field_details_clean <- field_details_table %>%
select(-`Sub Field`) %>% # Remove Sub Field column
mutate(
`Mean CI` = round(`Mean CI`, 2), # Round to 2 decimal places
`CV Value` = round(`CV Value`, 2) # Round to 2 decimal places
)
# Display the cleaned field table
kable(field_details_clean,
caption = "Detailed Field Performance Summary")
```
---
## Report Metadata
```{r report_metadata, echo=FALSE}
metadata_info <- data.frame(
Metric = c("Report Generated", "Data Source", "Analysis Period", "Total Fields",
"KPI Calculation", "Next Update"),
Value = c(
format(Sys.time(), "%Y-%m-%d %H:%M:%S"),
paste("Project", toupper(project_dir)),
paste("Week", current_week, "of", year),
ifelse(exists("field_boundaries_sf"), nrow(field_boundaries_sf), "Unknown"),
ifelse(kpi_files_exist, "✓ Current", "⚠ Needs Update"),
"Next Wednesday"
)
)
kable(metadata_info,
caption = "Report Metadata",
col.names = c("Metric", "Value"))
```
---
*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team.*

239
r_app/experiments/combine_esa_yield_data.R Normal file
View file

@ -0,0 +1,239 @@
# Combine ESA Yield Data from 5 tabs into Aura harvest format
# Script to create harvest.xlsx in ESA directory matching Aura structure
# Load required libraries
library(readxl)
library(writexl)
library(dplyr)
library(lubridate)
# Define file paths using absolute paths
base_path <- "C:/Users/timon/Resilience BV/4020 SCane ESA DEMO - Documenten/General/4020 SCDEMO Team/4020 TechnicalData/WP3/smartcane_v2/smartcane"
esa_file_path <- file.path(base_path, "laravel_app", "storage", "app", "esa", "Data", "esa_yield_data.xlsx")
output_file_path <- file.path(base_path, "laravel_app", "storage", "app", "esa", "Data", "harvest.xlsx")
# Check if ESA file exists
if (!file.exists(esa_file_path)) {
stop("ESA yield data file not found: ", esa_file_path)
}
# Get sheet names (should be: 2019-20, 2020-21, 2021-22, 2022-2023, 2023-24, 2024-25, etc.)
sheet_names <- excel_sheets(esa_file_path)
cat("Found sheets:", paste(sheet_names, collapse = ", "), "\n")
# Function to extract harvest year from sheet name
extract_year <- function(sheet_name) {
# Extract the second year from patterns like "2019-20" -> 2020
if (grepl("^\\d{4}-\\d{2}$", sheet_name)) {
# Format: 2019-20
year_part <- as.numeric(substr(sheet_name, 1, 4)) + 1
} else if (grepl("^\\d{4}-\\d{4}$", sheet_name)) {
# Format: 2022-2023
year_part <- as.numeric(substr(sheet_name, 6, 9))
} else {
# Fallback: try to extract first 4-digit number
year_match <- regmatches(sheet_name, regexpr("\\d{4}", sheet_name))
year_part <- if (length(year_match) > 0) as.numeric(year_match[1]) else NA
}
return(year_part)
}
# Initialize empty list to store data from all sheets
all_data <- list()
# Read data from each sheet
for (sheet in sheet_names) {
cat("Processing sheet:", sheet, "\n")
# Read the data
tryCatch({
data <- read_excel(esa_file_path, sheet = sheet)
# Add year column based on sheet name
data$harvest_year <- extract_year(sheet)
data$sheet_name <- sheet
# Store in list
all_data[[sheet]] <- data
cat(" - Loaded", nrow(data), "rows from sheet", sheet, "\n")
}, error = function(e) {
cat(" - Error reading sheet", sheet, ":", e$message, "\n")
})
}
# Combine all data
if (length(all_data) > 0) {
combined_data <- bind_rows(all_data)
cat("Combined data: ", nrow(combined_data), "total rows\n")
# Display column names to understand the structure
cat("Available columns:\n")
print(colnames(combined_data))
# Transform to SmartCane format
# Map ESA columns to SmartCane columns based on the sample data provided
harvest_data <- combined_data %>%
mutate(
# Convert dates using lubridate (original format is YYYY-MM-DD = ymd)
grow_start_date = ymd(Grow_Start),
harvest_date_date = ymd(Harvest_Date),
# Calculate age in weeks using lubridate
age = round(as.numeric(harvest_date_date - grow_start_date) / 7, 0),
# Format fields for output
field = Field,
sub_field = Field,
year = harvest_year,
season_start = grow_start_date, # Keep as Date object
season_end = harvest_date_date, # Keep as Date object
sub_area = NA, # Leave empty as requested - not actual area but section names
tonnage_ha = TCH
) %>%
select(field, sub_field, year, season_start, season_end, age, sub_area, tonnage_ha) %>%
arrange(field, year)
# Clean up incomplete future seasons that shouldn't exist
cat("\nCleaning up incomplete future seasons...\n")
before_cleanup <- nrow(harvest_data)
# For each field, find the last season with actual data (either completed or ongoing)
# Remove any future seasons beyond that
harvest_data <- harvest_data %>%
group_by(field, sub_field) %>%
arrange(year) %>%
mutate(
# Mark rows with actual data (has start date)
has_data = !is.na(season_start),
# Mark completely empty rows (both start and end are NA)
is_empty = is.na(season_start) & is.na(season_end)
) %>%
# For each field, find the maximum year with actual data
mutate(
max_data_year = ifelse(any(has_data), max(year[has_data], na.rm = TRUE), NA)
) %>%
# Keep only rows that:
# 1. Have actual data, OR
# 2. Are empty but within 1 year of the last data year (future season placeholder)
filter(
has_data |
(is_empty & !is.na(max_data_year) & year <= max_data_year + 1)
) %>%
# Clean up helper columns
select(-has_data, -is_empty, -max_data_year) %>%
ungroup() %>%
arrange(field, year)
after_cleanup <- nrow(harvest_data)
if (before_cleanup != after_cleanup) {
cat("Removed", before_cleanup - after_cleanup, "incomplete future season rows\n")
}
# Create next season rows for fields that have completed seasons
cat("\nCreating next season rows for completed fields...\n")
# For each field, find the latest completed season (has both start and end dates)
completed_seasons <- harvest_data %>%
filter(!is.na(season_start) & !is.na(season_end)) %>%
group_by(field, sub_field) %>%
arrange(desc(year)) %>%
slice(1) %>% # Get the most recent completed season for each field
ungroup() %>%
select(field, sub_field, year, season_end)
cat("Found", nrow(completed_seasons), "fields with completed seasons\n")
# For each completed season, check if there's already a next season row
next_season_rows <- list()
for (i in 1:nrow(completed_seasons)) {
field_name <- completed_seasons$field[i]
sub_field_name <- completed_seasons$sub_field[i]
last_completed_year <- completed_seasons$year[i]
last_harvest_date <- completed_seasons$season_end[i]
next_year <- last_completed_year + 1
# Check if next season already exists for this field
next_season_exists <- harvest_data %>%
filter(field == field_name, sub_field == sub_field_name, year == next_year) %>%
nrow() > 0
if (!next_season_exists) {
# Create next season row
next_season_row <- data.frame(
field = field_name,
sub_field = sub_field_name,
year = next_year,
season_start = as.Date(last_harvest_date) + 1, # Previous harvest + 1 day
season_end = as.Date(NA), # Not harvested yet
age = NA,
sub_area = NA,
tonnage_ha = NA,
stringsAsFactors = FALSE
)
next_season_rows[[paste(field_name, sub_field_name, next_year, sep = "_")]] <- next_season_row
cat("Creating", next_year, "season for field", field_name, "starting", format(as.Date(last_harvest_date) + 1, "%Y-%m-%d"), "\n")
} else {
cat("Next season", next_year, "already exists for field", field_name, "\n")
}
}
# Combine all next season rows and add to harvest_data
if (length(next_season_rows) > 0) {
next_season_data <- bind_rows(next_season_rows)
harvest_data <- bind_rows(harvest_data, next_season_data) %>%
arrange(field, year)
cat("Added", nrow(next_season_data), "new season rows\n")
} else {
cat("No new season rows needed\n")
}
# Display preview of final transformed data
cat("\nPreview of final transformed data (including next season):\n")
print(head(harvest_data, 15)) # Show more rows to see next season data
# Remove duplicates based on field, sub_field, year combination
cat("\nRemoving duplicate entries...\n")
before_dedup <- nrow(harvest_data)
harvest_data <- harvest_data %>%
distinct(field, sub_field, year, .keep_all = TRUE)
after_dedup <- nrow(harvest_data)
duplicates_removed <- before_dedup - after_dedup
cat("Removed", duplicates_removed, "duplicate entries\n")
cat("Final data has", after_dedup, "unique records\n")
# Remove rows with NA season_start to prevent age calculation issues in reports
cat("\nRemoving rows with NA season_start...\n")
before_na_removal <- nrow(harvest_data)
harvest_data <- harvest_data %>%
filter(!is.na(season_start))
after_na_removal <- nrow(harvest_data)
na_removed <- before_na_removal - after_na_removal
cat("Removed", na_removed, "rows with NA season_start\n")
cat("Final data has", after_na_removal, "valid records\n")
# Save to Excel file
tryCatch({
write_xlsx(harvest_data, output_file_path)
cat("\nSuccessfully saved harvest data to:", output_file_path, "\n")
cat("Total rows saved:", nrow(harvest_data), "\n")
}, error = function(e) {
cat("Error saving file:", e$message, "\n")
})
} else {
cat("No data was successfully loaded from any sheet.\n")
}
cat("\nScript completed.\n")

0
r_app/extract_current_versions.R → r_app/experiments/legacy_package_management/extract_current_versions.R
View file

0
r_app/package_manager.R → r_app/experiments/legacy_package_management/package_manager.R
View file

11
r_app/experiments/testing_projsetup.R Normal file
View file

@ -0,0 +1,11 @@
# Set working directory first
setwd("C:/Users/timon/Resilience BV/4020 SCane ESA DEMO - Documenten/General/4020 SCDEMO Team/4020 TechnicalData/WP3/smartcane_v2/smartcane")
# Set project directory
project_dir <- 'esa'
# Now call the function after it's defined
dirs <- setup_project_directories(project_dir)
# Check if paths are correct
dirs$data_dir

40
r_app/installPackages.R
View file

@ -1,40 +0,0 @@
# Install required packages for SmartCane project
# This script installs all packages needed to run the CI report dashboard
# List of required packages
required_packages <- c(
# Core packages
"here", "tidyverse", "sf", "terra", "tmap", "lubridate",
# Additional data manipulation
"zoo", "readxl", "knitr", "rmarkdown", "dplyr", "purrr", "stringr",
# Spatial analysis
"exactextractr",
# Machine learning and statistics
"rsample", "caret", "randomForest", "CAST"
)
# Function to install missing packages
install_if_missing <- function(pkg) {
if (!requireNamespace(pkg, quietly = TRUE)) {
message(paste("Installing package:", pkg))
install.packages(pkg, repos = "https://cloud.r-project.org")
} else {
message(paste("Package already installed:", pkg))
}
}
# Install missing packages
for (pkg in required_packages) {
install_if_missing(pkg)
}
# Load core packages to verify installation
library(here)
library(tidyverse)
library(sf)
library(terra)
message("All required packages have been installed!")

102
r_app/interpolate_growth_model.R
View file

@ -1,102 +0,0 @@
# filepath: c:\Users\timon\Resilience BV\4020 SCane ESA DEMO - Documenten\General\4020 SCDEMO Team\4020 TechnicalData\WP3\smartcane\r_app\interpolate_growth_model.R
#
# INTERPOLATE_GROWTH_MODEL.R
# =========================
# This script interpolates CI (Chlorophyll Index) values between measurement dates
# to create a continuous growth model. It generates daily values and cumulative
# CI statistics for each field.
#
# Usage: Rscript interpolate_growth_model.R [project_dir]
# - project_dir: Project directory name (e.g., "chemba")
#
# 1. Load required packages
# -----------------------
suppressPackageStartupMessages({
library(tidyverse)
library(lubridate)
library(here)
})
# 2. Main function to handle interpolation
# -------------------------------------
main <- function() {
# Process command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Get project directory from arguments or use default
if (length(args) >= 1 && !is.na(args[1])) {
project_dir <- as.character(args[1])
} else {
project_dir <- "chemba"
message("No project_dir provided. Using default:", project_dir)
}
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# Initialize project configuration and load utility functions
tryCatch({
source("parameters_project.R")
source("growth_model_utils.R")
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source(here::here("r_app", "parameters_project.R"))
source(here::here("r_app", "growth_model_utils.R"))
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
log_message("Starting CI growth model interpolation")
# Load and process the data
tryCatch({
# Load the combined CI data
CI_data <- load_combined_ci_data(cumulative_CI_vals_dir)
# Validate harvesting data
if (is.null(harvesting_data) || nrow(harvesting_data) == 0) {
stop("No harvesting data available")
}
# Get the years from harvesting data
years <- harvesting_data %>%
filter(!is.na(season_start)) %>%
distinct(year) %>%
pull(year)
log_message(paste("Processing data for years:", paste(years, collapse = ", ")))
# Generate interpolated CI data for each year and field
CI_all <- generate_interpolated_ci_data(years, harvesting_data, CI_data)
# Calculate growth metrics and save the results
if (nrow(CI_all) > 0) {
# Add daily and cumulative metrics
CI_all_with_metrics <- calculate_growth_metrics(CI_all)
# Save the processed data
save_growth_model(
CI_all_with_metrics,
cumulative_CI_vals_dir,
"All_pivots_Cumulative_CI_quadrant_year_v2.rds"
)
} else {
log_message("No CI data was generated after interpolation", level = "WARNING")
}
log_message("Growth model interpolation completed successfully")
}, error = function(e) {
log_message(paste("Error in growth model interpolation:", e$message), level = "ERROR")
stop(e$message)
})
}
if (sys.nframe() == 0) {
main()
}

1250
r_app/kpi_utils.R Normal file
View file

File diff suppressed because it is too large Load diff

119
r_app/mosaic_creation.R
View file

@ -1,119 +0,0 @@
# filepath: c:\Users\timon\Resilience BV\4020 SCane ESA DEMO - Documenten\General\4020 SCDEMO Team\4020 TechnicalData\WP3\smartcane\r_app\mosaic_creation.R
#
# MOSAIC_CREATION.R
# ===============
# This script creates weekly mosaics from daily satellite imagery.
# It handles command-line arguments and initiates the mosaic creation process.
#
# Usage: Rscript mosaic_creation.R [end_date] [offset] [project_dir] [file_name]
# - end_date: End date for processing (YYYY-MM-DD format)
# - offset: Number of days to look back from end_date
# - project_dir: Project directory name (e.g., "chemba")
# - file_name: Optional custom output file name
#
# 1. Load required packages
# -----------------------
suppressPackageStartupMessages({
library(sf)
library(terra)
library(tidyverse)
library(lubridate)
library(here)
})
# 2. Process command line arguments and run mosaic creation
# ------------------------------------------------------
main <- function() {
# Capture command line arguments
args <- commandArgs(trailingOnly = TRUE)
# Process project_dir argument with default
if (length(args) >= 3 && !is.na(args[3])) {
project_dir <- as.character(args[3])
} else {
# Default project directory
project_dir <- "simba"
message("No project_dir provided. Using default:", project_dir)
}
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# Process end_date argument with default
if (length(args) >= 1 && !is.na(args[1])) {
end_date <- as.Date(args[1])
if (is.na(end_date)) {
message("Invalid end_date provided. Using current date.")
end_date <- Sys.Date()
#end_date <- "2025-07-22" # Default date for testing
}
} else {
# Default to current date if no argument is provided
end_date <- Sys.Date()
#end_date <- "2025-07-08" # Default date for testing
message("No end_date provided. Using current date: ", format(end_date))
}
# Process offset argument with default
if (length(args) >= 2 && !is.na(args[2])) {
offset <- as.numeric(args[2])
if (is.na(offset) || offset <= 0) {
message("Invalid offset provided. Using default (7 days).")
offset <- 7
}
} else {
# Default to 7 days if no argument is provided
offset <- 7
message("No offset provided. Using default:", offset, "days")
}
# 3. Initialize project configuration
# --------------------------------
tryCatch({
source("parameters_project.R")
source("mosaic_creation_utils.R")
safe_log(paste("Successfully sourced files from default directory."))
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source(here::here("r_app", "parameters_project.R"))
source(here::here("r_app", "mosaic_creation_utils.R"))
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
# 4. Generate date range for processing
# ---------------------------------
dates <- date_list(end_date, offset)
safe_log(paste("Processing data for week", dates$week, "of", dates$year))
# Create output filename
file_name_tif <- if (length(args) >= 4 && !is.na(args[4])) {
as.character(args[4])
} else {
paste0("week_", sprintf("%02d", dates$week), "_", dates$year, ".tif")
}
safe_log(paste("Output will be saved as:", file_name_tif))
# 5. Create weekly mosaic using the function from utils
# -------------------------------------------------
create_weekly_mosaic(
dates = dates,
field_boundaries = field_boundaries,
daily_vrt_dir = daily_vrt,
merged_final_dir = merged_final,
output_dir = weekly_CI_mosaic,
file_name_tif = file_name_tif,
create_plots = TRUE
)
}
if (sys.nframe() == 0) {
main()
}

12
r_app/mosaic_creation_utils.R
View file

@ -45,8 +45,8 @@ date_list <- function(end_date, offset) {
start_date <- end_date - lubridate::days(offset)
# Extract week and year information
week <- lubridate::week(start_date)
year <- lubridate::year(start_date)
week <- lubridate::isoweek(end_date)
year <- lubridate::isoyear(end_date)
# Generate sequence of dates
days_filter <- seq(from = start_date, to = end_date, by = "day")
@ -95,7 +95,7 @@ create_weekly_mosaic <- function(dates, field_boundaries, daily_vrt_dir,
mosaic <- create_mosaic(vrt_list, missing_pixels_count, field_boundaries, raster_files_final)
} else {
safe_log("No VRT files available for the date range, creating empty mosaic", "WARNING")
safe_log("No VRT files available for the date range, creating empty mosaic with NA values", "WARNING")
# Create empty mosaic if no files are available
if (length(raster_files_final) == 0) {
@ -103,7 +103,7 @@ create_weekly_mosaic <- function(dates, field_boundaries, daily_vrt_dir,
}
mosaic <- terra::rast(raster_files_final[1]) %>%
terra::setValues(0) %>%
terra::setValues(NA) %>%
terra::crop(field_boundaries, mask = TRUE)
names(mosaic) <- c("Red", "Green", "Blue", "NIR", "CI")
@ -249,10 +249,10 @@ create_mosaic <- function(vrt_list, missing_pixels_count, field_boundaries = NUL
stop("No VRT files available and no fallback raster files or field boundaries provided")
}
safe_log("No images available for this period, creating empty mosaic", "WARNING")
safe_log("No images available for this period, creating empty mosaic with NA values", "WARNING")
x <- terra::rast(raster_files_final[1]) |>
terra::setValues(0) |>
terra::setValues(NA) |>
terra::crop(field_boundaries, mask = TRUE)
names(x) <- c("Red", "Green", "Blue", "NIR", "CI")

15
r_app/output/aura/crop_analysis_w34vs32_20250820_1414_table.md
View file

@ -1,15 +0,0 @@
# Crop Analysis Summary - AURA Estate
**Analysis Period:** Week 32 vs Week 34
| Field | Area (ha) | Current CI | Change | Uniformity | Alert | Message |
|-------|-----------|------------|--------|------------|-------|---------|
| kowawa-kowawa | 1.4 | 3.28 | stable | excellent uniformity | ✅ NO | ✅ Excellent: Optimal field uniformity and stability |
| Tamu-Tamu | 4.2 | 4.425 | stable | good uniformity | ✅ NO | ✅ Good: Stable field with good uniformity |
| MNARA-MNARA | 2 | 4.079 | stable | good uniformity | ✅ NO | ✅ Good: Stable field with good uniformity |
| Ayieyie Ruke-Ayieyie Ruke | 1.8 | 4.513 | stable | poor uniformity - urgent attention needed | 🚨 YES | 🚨 URGENT: Poor field uniformity detected - immediate management review required |
| Got Nyithindo_M-Got Nyithindo_M | 1.4 | 4.19 | stable | good uniformity | ✅ NO | ✅ Good: Stable field with good uniformity |
| Got Nyithindo-Got Nyithindo | 1.4 | 4.426 | stable | poor uniformity - urgent attention needed | 🚨 YES | 🚨 URGENT: Poor field uniformity detected - immediate management review required |
| Kabala Ruke-Kabala Ruke | 1.3 | 3.89 | stable | poor uniformity - urgent attention needed | 🚨 YES | 🚨 URGENT: Poor field uniformity detected - immediate management review required |
| Mutwala A-Mutwala A | 1.4 | 3.496 | stable | good uniformity | ✅ NO | ✅ Good: Stable field with good uniformity |
| Onenonam-Onenonam | 2 | 4.098 | decrease | good uniformity | 🚨 YES | ⚠️ Alert: Good uniformity but declining trend - early intervention recommended |
| NA-NA | 3.8 | 3.879 | stable | good uniformity | ✅ NO | ✅ Good: Stable field with good uniformity |

117
r_app/packages.R
View file

@ -1,117 +0,0 @@
# packages.R
#
# PACKAGE MANAGEMENT FOR SMARTCANE
# ===============================
# This script centralizes all package dependencies for the SmartCane project.
# It installs missing packages and loads all required libraries.
#
#' Check and install packages if needed
#'
#' @param pkg_list List of packages to check and install
#' @param install_missing Whether to install missing packages
#' @return Vector of packages that couldn't be installed (if any)
#'
check_and_install_packages <- function(pkg_list, install_missing = TRUE) {
# Check which packages are already installed
is_installed <- pkg_list %in% rownames(installed.packages())
missing_pkgs <- pkg_list[!is_installed]
# Install missing packages if requested
failed_pkgs <- character(0)
if (length(missing_pkgs) > 0) {
if (install_missing) {
message("Installing ", length(missing_pkgs), " missing packages...")
for (pkg in missing_pkgs) {
tryCatch({
install.packages(pkg, repos = "https://cran.rstudio.com/", dependencies = TRUE)
message(" Installed: ", pkg)
}, error = function(e) {
warning("Failed to install package: ", pkg)
warning("Error: ", e$message)
failed_pkgs <<- c(failed_pkgs, pkg)
})
}
} else {
message("The following packages are required but not installed:")
message(paste(missing_pkgs, collapse = ", "))
failed_pkgs <- missing_pkgs
}
} else {
message("All required packages are already installed.")
}
return(failed_pkgs)
}
#' Load all required packages for SmartCane project
#'
#' @param verbose Whether to show messages during loading
#' @return Logical indicating success (TRUE if all packages loaded)
#'
load_smartcane_packages <- function(verbose = FALSE) {
# Define all required packages
required_packages <- c(
# Geospatial packages
"sf", # Simple Features for spatial vector data
"terra", # Raster data processing
"exactextractr", # Fast extraction from rasters
"tmap", # Thematic mapping for spatial visualization
# Data manipulation
"tidyverse", # Collection of data manipulation packages
"lubridate", # Date manipulation
"readxl", # Excel file reading
"stringr", # String manipulation
"purrr", # Functional programming tools
"zoo", # Time series processing with rolling functions
# Visualization
"ggplot2", # Advanced plotting
"leaflet", # Interactive maps
"plotly", # Interactive plots
# Machine learning and statistics
"caret", # Classification and regression training
"rsample", # Data sampling for modeling
"randomForest", # Random forest implementation
"CAST", # Feature selection for spatial data
# Project management
"here", # Path handling
# Document generation
"knitr", # Dynamic report generation
"rmarkdown" # R Markdown processing
)
# Check and install missing packages
failed_pkgs <- check_and_install_packages(required_packages)
# Load all installed packages
success <- TRUE
for (pkg in setdiff(required_packages, failed_pkgs)) {
tryCatch({
if (verbose) message("Loading package: ", pkg)
suppressPackageStartupMessages(library(pkg, character.only = TRUE))
}, error = function(e) {
warning("Failed to load package: ", pkg)
warning("Error: ", e$message)
success <- FALSE
})
}
# Report any issues
if (length(failed_pkgs) > 0) {
warning("The following packages could not be installed: ",
paste(failed_pkgs, collapse = ", "))
success <- FALSE
}
return(success)
}
# Run the loading function if the script is sourced directly
if (!exists("skip_package_loading") || !skip_package_loading) {
load_smartcane_packages()
}

15
r_app/parameters_project.R
View file

@ -62,11 +62,22 @@ setup_project_directories <- function(project_dir) {
))
}
#set working dir.
# 3. Load field boundaries
# ----------------------
load_field_boundaries <- function(data_dir) {
field_boundaries_path <- here(data_dir, "pivot.geojson")
# Choose field boundaries file based on project and script type
# ESA project uses pivot_2.geojson ONLY for scripts 02-03 (CI extraction & growth model)
# All other scripts (including 04-mosaic, 09-KPIs, 10-reports) use pivot.geojson
use_pivot_2 <- exists("project_dir") && project_dir == "esa" &&
exists("ci_extraction_script") # ci_extraction_script flag set by scripts 02-03
if (use_pivot_2) {
field_boundaries_path <- here(data_dir, "pivot_2.geojson")
} else {
field_boundaries_path <- here(data_dir, "pivot.geojson")
}
if (!file.exists(field_boundaries_path)) {
stop(paste("Field boundaries file not found at path:", field_boundaries_path))
}

343
r_app/report_utils.R
View file

@ -35,7 +35,7 @@ subchunkify <- function(g, fig_height=7, fig_width=5) {
), collapse = '')
sub_chunk <- paste0("
`","``{r sub_chunk_", floor(runif(1) * 10000), ", fig.height=", fig_height, ", fig.width=", fig_width, ", echo=FALSE}",
`","``{r sub_chunk_", floor(runif(1) * 10000), ", fig.height=", fig_height, ", fig.width=", fig_width, ", dpi=300, dev='png', out.width='100%', echo=FALSE}",
"\n(",
g_deparsed
, ")()",
@ -81,16 +81,17 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
# Create the base map
map <- tm_shape(pivot_raster, unit = "m")
# Add raster with continuous spectrum (fixed scale 1-8 for consistent comparison)
# 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)),
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")
position = if(show_legend) tm_pos_out("left", "center") else c("left", "bottom"),
reverse = TRUE
))
# Add layout elements
map <- map + tm_layout(main.title = paste0("Max CI week ", week,"\n", age, " weeks old"),
map <- map + tm_layout(main.title = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"),
main.title.size = 0.7)
# Add borders if requested
@ -143,17 +144,18 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
# Create the base map
map <- tm_shape(pivot_raster, unit = "m")
# Add raster with continuous spectrum (centered at 0 for difference maps, fixed scale)
# 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")
position = if(show_legend) tm_pos_out("right", "center") else c("left", "bottom"),
reverse = TRUE
))
# Add layout elements
map <- map + tm_layout(main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks old"),
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)
# Add borders if requested
@ -287,7 +289,8 @@ ci_plot <- function(pivotName,
nrow = 1, widths = c(0.23, 0.18, 0.18, 0.18, 0.23))
# Output heading and map to R Markdown
cat(paste("## Field", pivotName, "-", age, "weeks after planting/harvest", "\n\n"))
age_months <- round(age / 4.348, 1)
cat(paste("## Field", pivotName, "-", age, "weeks/", age_months, "months after planting/harvest", "\n\n"))
print(tst)
}, error = function(e) {
@ -305,9 +308,12 @@ ci_plot <- function(pivotName,
#' @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 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)
#' @param benchmark_percentiles Vector of percentiles for benchmarks (default: c(10, 50, 90))
#' @return NULL (adds output directly to R Markdown document)
#'
cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "absolute", facet_on = FALSE, x_unit = "days", colorblind_friendly = FALSE) {
cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "absolute", facet_on = FALSE, x_unit = "days", colorblind_friendly = FALSE, show_benchmarks = FALSE, estate_name = NULL, benchmark_percentiles = c(10, 50, 90), benchmark_data = NULL) {
# Input validation
if (missing(pivotName) || is.null(pivotName) || pivotName == "") {
stop("pivotName is required")
@ -341,6 +347,33 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
data_ci2 <- data_ci2 %>% dplyr::mutate(season = as.factor(season))
# Compute benchmarks if requested and not provided
if (show_benchmarks && is.null(benchmark_data)) {
benchmark_data <- compute_ci_benchmarks(ci_quadrant_data, estate_name, benchmark_percentiles)
}
# Prepare benchmark data for plotting if available
if (!is.null(benchmark_data)) {
benchmark_data <- benchmark_data %>%
dplyr::mutate(
ci_type_label = case_when(
ci_type == "value" ~ "10-Day Rolling Mean CI",
ci_type == "cumulative_CI" ~ "Cumulative CI",
TRUE ~ ci_type
),
benchmark_label = paste0(percentile, "th Percentile")
)
safe_log("Benchmark data prepared for plotting", "INFO")
} else if (show_benchmarks) {
safe_log("No benchmark data available", "WARNING")
}
data_ci3 <- tidyr::pivot_longer(
data_ci2,
cols = c("mean_rolling_10_days", "cumulative_CI"),
names_to = "ci_type", # This column will say "mean_rolling_10_days" or "cumulative_CI"
values_to = "ci_value" # This column will have the numeric values
)
# Prepare date information by season
date_preparation_perfect_pivot <- data_ci2 %>%
dplyr::group_by(season) %>%
@ -351,8 +384,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Get the 3 most recent seasons
unique_seasons <- sort(unique(date_preparation_perfect_pivot$season), decreasing = TRUE)[1:3]
# Create plotting function
create_plot <- function(y_var, y_label, title_suffix) {
# Create plotting function that uses data_ci3 and filters by ci_type
create_plot <- function(ci_type_filter, y_label, title_suffix) {
# Filter data based on ci_type
plot_data <- data_ci3 %>%
dplyr::filter(season %in% unique_seasons, ci_type == ci_type_filter)
# Determine x-axis variable based on x_unit parameter
x_var <- if (x_unit == "days") {
if (facet_on) "Date" else "DOY"
@ -366,34 +403,83 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Create plot with either facets by season or overlay by DOY/week
if (facet_on) {
g <- ggplot2::ggplot(data = data_ci2 %>% dplyr::filter(season %in% unique_seasons)) +
g <- ggplot2::ggplot(data = plot_data) +
ggplot2::facet_wrap(~season, scales = "free_x") +
ggplot2::geom_line(ggplot2::aes_string(x = x_var, y = y_var, col = "sub_field", group = "sub_field")) +
ggplot2::labs(title = paste("Plot of", y_label, "for Field", pivotName, title_suffix),
ggplot2::geom_line(ggplot2::aes_string(x = x_var, y = "ci_value", col = "sub_field", group = "sub_field")) +
ggplot2::labs(title = paste("Plot of", y_label),
color = "Field Name",
y = y_label,
x = x_label) +
ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%m-%Y") +
ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%m-%Y",
sec.axis = ggplot2::sec_axis(~ ., name = "Age in Months",
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(angle = 60, hjust = 1),
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::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
} else {
g <- ggplot2::ggplot(data = data_ci2 %>% dplyr::filter(season %in% unique_seasons)) +
ggplot2::geom_line(ggplot2::aes_string(x = x_var, y = y_var, col = "season", group = "season")) +
# Choose color palette based on colorblind_friendly flag
color_scale <- if (colorblind_friendly) {
ggplot2::scale_color_brewer(type = "qual", palette = "Set2")
} else {
ggplot2::scale_color_discrete()
}
g <- ggplot2::ggplot(data = plot_data) +
# Add benchmark lines first (behind season lines)
{
if (!is.null(benchmark_data) && ci_type_filter %in% benchmark_data$ci_type) {
benchmark_subset <- benchmark_data %>%
dplyr::filter(ci_type == ci_type_filter) %>%
dplyr::mutate(
benchmark_x = if (x_var == "DOY") {
DOY
} else if (x_var == "week") {
DOY / 7 # Approximate conversion
} else {
DOY # For Date, use DOY 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::geom_line(ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season")) +
ggplot2::labs(title = paste("Plot of", y_label, "for Field", pivotName, title_suffix),
color = "Season",
y = y_label,
x = x_label) +
color_scale +
{
if (x_var == "DOY") {
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, 64, 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(angle = 60, hjust = 1),
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::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
}
# Add y-axis limits for absolute CI (10-day rolling mean) to fix scale at 0-8
if (ci_type_filter == "mean_rolling_10_days") {
g <- g + ggplot2::ylim(0, 8)
}
return(g)
}
@ -405,13 +491,133 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
g <- create_plot("cumulative_CI", "Cumulative CI", "")
subchunkify(g, 2.8, 10)
} else if (plot_type == "both") {
# Create both plots
g_absolute <- create_plot("mean_rolling_10_days", "10-Day Rolling Mean CI", "(Absolute)")
g_cumulative <- create_plot("cumulative_CI", "Cumulative CI", "(Cumulative)")
# Create faceted plot with both CI types using pivot_longer approach
plot_data_both <- data_ci3 %>%
dplyr::filter(season %in% unique_seasons) %>%
dplyr::mutate(ci_type_label = case_when(
ci_type == "mean_rolling_10_days" ~ "10-Day Rolling Mean CI",
ci_type == "cumulative_CI" ~ "Cumulative CI",
TRUE ~ ci_type
))
# Display both plots
subchunkify(g_absolute, 2.8, 4.95)
subchunkify(g_cumulative, 2.8, 4.95)
# Determine x-axis variable based on x_unit parameter
x_var <- if (x_unit == "days") {
if (facet_on) "Date" else "DOY"
} else {
"week"
}
x_label <- switch(x_unit,
"days" = if (facet_on) "Date" else "Age of Crop (Days)",
"weeks" = "Week Number")
# Choose color palette based on colorblind_friendly flag
color_scale <- if (colorblind_friendly) {
ggplot2::scale_color_brewer(type = "qual", palette = "Set2")
} else {
ggplot2::scale_color_discrete()
}
# Create faceted plot with both CI types using pivot_longer approach
plot_data_both <- data_ci3 %>%
dplyr::filter(season %in% unique_seasons) %>%
dplyr::mutate(ci_type_label = case_when(
ci_type == "mean_rolling_10_days" ~ "10-Day Rolling Mean CI",
ci_type == "cumulative_CI" ~ "Cumulative CI",
TRUE ~ ci_type
))
# Determine x-axis variable based on x_unit parameter
x_var <- if (x_unit == "days") {
if (facet_on) "Date" else "DOY"
} else {
"week"
}
x_label <- switch(x_unit,
"days" = if (facet_on) "Date" else "Age of Crop (Days)",
"weeks" = "Week Number")
# Choose color palette based on colorblind_friendly flag
color_scale <- if (colorblind_friendly) {
ggplot2::scale_color_brewer(type = "qual", palette = "Set2")
} else {
ggplot2::scale_color_discrete()
}
# Create the faceted plot
g_both <- ggplot2::ggplot(data = plot_data_both) +
# Add benchmark lines first (behind season lines)
{
if (!is.null(benchmark_data)) {
benchmark_subset <- benchmark_data %>%
dplyr::mutate(
benchmark_x = if (x_var == "DOY") {
DOY
} else if (x_var == "week") {
DOY / 7
} else {
DOY
},
ci_type_label = case_when(
ci_type == "value" ~ "10-Day Rolling Mean CI",
ci_type == "cumulative_CI" ~ "Cumulative CI",
TRUE ~ ci_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::facet_wrap(~ci_type_label, scales = "free_y") +
ggplot2::geom_line(ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season")) +
ggplot2::labs(title = paste("CI Analysis for Field", pivotName),
color = "Season",
y = "CI Value",
x = x_label) +
color_scale +
{
if (x_var == "DOY") {
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, 64, by = 4), sec.axis = ggplot2::sec_axis(~ . / 4.348, name = "Age in Months", breaks = seq(0, 14, by = 1)))
} else if (x_var == "Date") {
ggplot2::scale_x_date(breaks = "1 month", date_labels = "%b-%Y", sec.axis = ggplot2::sec_axis(~ ., name = "Age in Months", breaks = scales::breaks_pretty()))
}
} +
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::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
# For the rolling mean data, we want to set reasonable y-axis limits
# Since we're using free_y scales, each facet will have its own y-axis
# The rolling mean will automatically scale to its data range,
# but we can ensure it shows the 0-8 context by adding invisible points
# Add invisible points to set the y-axis range for rolling mean facet
dummy_data <- data.frame(
ci_type_label = "10-Day Rolling Mean CI",
ci_value = c(0, 8),
stringsAsFactors = FALSE
)
dummy_data[[x_var]] <- range(plot_data_both[[x_var]], na.rm = TRUE)
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
# Display the combined faceted plot
subchunkify(g_both, 2.8, 10)
}
}, error = function(e) {
@ -444,7 +650,7 @@ cum_ci_plot2 <- function(pivotName){
labs(title = paste("14 day rolling MEAN CI rate - Field ", pivotName),
x = "Date", y = "CI Rate") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 60, hjust = 1),
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)) +
@ -512,3 +718,86 @@ 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 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
#'
compute_ci_benchmarks <- function(ci_quadrant_data, estate_name, percentiles = c(10, 50, 90), min_seasons = 3) {
# Input validation
if (missing(ci_quadrant_data) || is.null(ci_quadrant_data)) {
stop("ci_quadrant_data is required")
}
if (missing(estate_name) || is.null(estate_name) || estate_name == "") {
stop("estate_name is required")
}
if (!all(percentiles >= 0 & percentiles <= 100)) {
stop("percentiles must be between 0 and 100")
}
tryCatch({
# Filter data for the specified estate (assuming estate is not directly in data, but we can infer from context)
# Since the data is per field, and fields are unique to estates, we'll use all data but could add estate filtering if available
data_filtered <- ci_quadrant_data
# Check if we have enough seasons
unique_seasons <- unique(data_filtered$season)
if (length(unique_seasons) < min_seasons) {
safe_log(paste("Insufficient historical seasons for estate", estate_name, ":", length(unique_seasons), "seasons found, need at least", min_seasons), "WARNING")
return(NULL)
}
# Prepare data for both CI types
data_prepared <- data_filtered %>%
dplyr::ungroup() %>% # Ensure no existing groupings
dplyr::select(DOY, value, cumulative_CI, season) %>%
tidyr::pivot_longer(
cols = c("value", "cumulative_CI"),
names_to = "ci_type",
values_to = "ci_value"
) %>%
dplyr::filter(!is.na(ci_value)) # Remove NA values
# Compute percentiles for each DOY and ci_type
benchmarks <- data_prepared %>%
dplyr::group_by(DOY, 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_),
p90 = tryCatch(quantile(ci_value, 0.9, na.rm = TRUE), error = function(e) NA_real_),
n_observations = n(),
.groups = 'drop'
) %>%
dplyr::filter(n_observations >= min_seasons) %>% # Only include DOYs with sufficient data
tidyr::pivot_longer(
cols = c(p10, p50, p90),
names_to = "percentile",
values_to = "benchmark_value"
) %>%
dplyr::mutate(
percentile = case_when(
percentile == "p10" ~ 10,
percentile == "p50" ~ 50,
percentile == "p90" ~ 90
)
) %>%
dplyr::filter(!is.na(benchmark_value)) # Remove any NA benchmarks
# Rename columns for clarity
benchmarks <- benchmarks %>%
dplyr::select(DOY, 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")
return(benchmarks)
}, error = function(e) {
safe_log(paste("Error computing CI benchmarks for estate", estate_name, ":", e$message), "ERROR")
print(paste("DEBUG: Error details:", e$message, "Call:", deparse(e$call)))
return(NULL)
})
}

521
renv.lock
View file

@ -1,6 +1,6 @@
{
"R": {
"Version": "4.4.2",
"Version": "4.4.3",
"Repositories": [
{
"Name": "CRAN",
@ -584,6 +584,33 @@
"Maintainer": "Kirill Müller <kirill@cynkra.com>",
"Repository": "CRAN"
},
"boot": {
"Package": "boot",
"Version": "1.3-31",
"Source": "Repository",
"Priority": "recommended",
"Date": "2024-08-28",
"Authors@R": "c(person(\"Angelo\", \"Canty\", role = \"aut\", email = \"cantya@mcmaster.ca\", comment = \"author of original code for S\"), person(\"Brian\", \"Ripley\", role = c(\"aut\", \"trl\"), email = \"ripley@stats.ox.ac.uk\", comment = \"conversion to R, maintainer 1999--2022, author of parallel support\"), person(\"Alessandra R.\", \"Brazzale\", role = c(\"ctb\", \"cre\"), email = \"brazzale@stat.unipd.it\", comment = \"minor bug fixes\"))",
"Maintainer": "Alessandra R. Brazzale <brazzale@stat.unipd.it>",
"Note": "Maintainers are not available to give advice on using a package they did not author.",
"Description": "Functions and datasets for bootstrapping from the book \"Bootstrap Methods and Their Application\" by A. C. Davison and D. V. Hinkley (1997, CUP), originally written by Angelo Canty for S.",
"Title": "Bootstrap Functions (Originally by Angelo Canty for S)",
"Depends": [
"R (>= 3.0.0)",
"graphics",
"stats"
],
"Suggests": [
"MASS",
"survival"
],
"LazyData": "yes",
"ByteCompile": "yes",
"License": "Unlimited",
"NeedsCompilation": "no",
"Author": "Angelo Canty [aut] (author of original code for S), Brian Ripley [aut, trl] (conversion to R, maintainer 1999--2022, author of parallel support), Alessandra R. Brazzale [ctb, cre] (minor bug fixes)",
"Repository": "CRAN"
},
"broom": {
"Package": "broom",
"Version": "1.0.8",
@ -995,10 +1022,10 @@
},
"cli": {
"Package": "cli",
"Version": "3.6.3",
"Version": "3.6.5",
"Source": "Repository",
"Title": "Helpers for Developing Command Line Interfaces",
"Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", role = \"ctb\"), person(\"Kirill\", \"Müller\", role = \"ctb\"), person(\"Salim\", \"Brüggemann\", , \"salim-b@pm.me\", role = \"ctb\", comment = c(ORCID = \"0000-0002-5329-5987\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
"Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"gabor@posit.co\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", role = \"ctb\"), person(\"Kirill\", \"Müller\", role = \"ctb\"), person(\"Salim\", \"Brüggemann\", , \"salim-b@pm.me\", role = \"ctb\", comment = c(ORCID = \"0000-0002-5329-5987\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
"Description": "A suite of tools to build attractive command line interfaces ('CLIs'), from semantic elements: headings, lists, alerts, paragraphs, etc. Supports custom themes via a 'CSS'-like language. It also contains a number of lower level 'CLI' elements: rules, boxes, trees, and 'Unicode' symbols with 'ASCII' alternatives. It support ANSI colors and text styles as well.",
"License": "MIT + file LICENSE",
"URL": "https://cli.r-lib.org, https://github.com/r-lib/cli",
@ -1020,14 +1047,13 @@
"htmlwidgets",
"knitr",
"methods",
"mockery",
"processx",
"ps (>= 1.3.4.9000)",
"rlang (>= 1.0.2.9003)",
"rmarkdown",
"rprojroot",
"rstudioapi",
"testthat",
"testthat (>= 3.2.0)",
"tibble",
"whoami",
"withr"
@ -1035,10 +1061,10 @@
"Config/Needs/website": "r-lib/asciicast, bench, brio, cpp11, decor, desc, fansi, prettyunits, sessioninfo, tidyverse/tidytemplate, usethis, vctrs",
"Config/testthat/edition": "3",
"Encoding": "UTF-8",
"RoxygenNote": "7.2.3",
"RoxygenNote": "7.3.2",
"NeedsCompilation": "yes",
"Author": "Gábor Csárdi [aut, cre], Hadley Wickham [ctb], Kirill Müller [ctb], Salim Brüggemann [ctb] (<https://orcid.org/0000-0002-5329-5987>), Posit Software, PBC [cph, fnd]",
"Maintainer": "Gábor Csárdi <csardi.gabor@gmail.com>",
"Maintainer": "Gábor Csárdi <gabor@posit.co>",
"Repository": "CRAN"
},
"clipr": {
@ -1533,6 +1559,31 @@
"Maintainer": "Hadley Wickham <hadley@posit.co>",
"Repository": "CRAN"
},
"deldir": {
"Package": "deldir",
"Version": "2.0-4",
"Source": "Repository",
"Date": "2024-02-27",
"Title": "Delaunay Triangulation and Dirichlet (Voronoi) Tessellation",
"Author": "Rolf Turner",
"Maintainer": "Rolf Turner <rolfturner@posteo.net>",
"Depends": [
"R (>= 3.5.0)"
],
"Suggests": [
"polyclip"
],
"Imports": [
"graphics",
"grDevices"
],
"Description": "Calculates the Delaunay triangulation and the Dirichlet or Voronoi tessellation (with respect to the entire plane) of a planar point set. Plots triangulations and tessellations in various ways. Clips tessellations to sub-windows. Calculates perimeters of tessellations. Summarises information about the tiles of the tessellation.\tCalculates the centroidal Voronoi (Dirichlet) tessellation using Lloyd's algorithm.",
"LazyData": "true",
"ByteCompile": "true",
"License": "GPL (>= 2)",
"NeedsCompilation": "yes",
"Repository": "CRAN"
},
"diagram": {
"Package": "diagram",
"Version": "1.6.5",
@ -1891,6 +1942,108 @@
"Maintainer": "Winston Chang <winston@posit.co>",
"Repository": "CRAN"
},
"flextable": {
"Package": "flextable",
"Version": "0.9.10",
"Source": "Repository",
"Type": "Package",
"Title": "Functions for Tabular Reporting",
"Authors@R": "c( person(\"David\", \"Gohel\", , \"david.gohel@ardata.fr\", role = c(\"aut\", \"cre\")), person(\"ArData\", role = \"cph\"), person(\"Clementine\", \"Jager\", role = \"ctb\"), person(\"Eli\", \"Daniels\", role = \"ctb\"), person(\"Panagiotis\", \"Skintzos\", , \"panagiotis.skintzos@ardata.fr\", role = \"aut\"), person(\"Quentin\", \"Fazilleau\", role = \"ctb\"), person(\"Maxim\", \"Nazarov\", role = \"ctb\"), person(\"Titouan\", \"Robert\", role = \"ctb\"), person(\"Michael\", \"Barrowman\", role = \"ctb\"), person(\"Atsushi\", \"Yasumoto\", role = \"ctb\"), person(\"Paul\", \"Julian\", role = \"ctb\"), person(\"Sean\", \"Browning\", role = \"ctb\"), person(\"Rémi\", \"Thériault\", role = \"ctb\", comment = c(ORCID = \"0000-0003-4315-6788\")), person(\"Samuel\", \"Jobert\", role = \"ctb\"), person(\"Keith\", \"Newman\", role = \"ctb\") )",
"Description": "Use a grammar for creating and customizing pretty tables. The following formats are supported: 'HTML', 'PDF', 'RTF', 'Microsoft Word', 'Microsoft PowerPoint' and R 'Grid Graphics'. 'R Markdown', 'Quarto' and the package 'officer' can be used to produce the result files. The syntax is the same for the user regardless of the type of output to be produced. A set of functions allows the creation, definition of cell arrangement, addition of headers or footers, formatting and definition of cell content with text and or images. The package also offers a set of high-level functions that allow tabular reporting of statistical models and the creation of complex cross tabulations.",
"License": "GPL-3",
"URL": "https://ardata-fr.github.io/flextable-book/, https://davidgohel.github.io/flextable/",
"BugReports": "https://github.com/davidgohel/flextable/issues",
"Imports": [
"data.table (>= 1.13.0)",
"gdtools (>= 0.4.0)",
"graphics",
"grDevices",
"grid",
"htmltools",
"knitr",
"officer (>= 0.6.10)",
"ragg",
"rlang",
"rmarkdown (>= 2.0)",
"stats",
"utils",
"uuid (>= 0.1-4)",
"xml2"
],
"Suggests": [
"bookdown (>= 0.40)",
"broom",
"broom.mixed",
"chromote",
"cluster",
"commonmark",
"doconv (>= 0.3.0)",
"equatags",
"ggplot2",
"lme4",
"magick",
"mgcv",
"nlme",
"officedown",
"pdftools",
"pkgdown (>= 2.0.0)",
"scales",
"svglite",
"tables (>= 0.9.17)",
"testthat (>= 3.0.0)",
"webshot2",
"withr",
"xtable"
],
"VignetteBuilder": "knitr",
"Config/testthat/edition": "3",
"Encoding": "UTF-8",
"RoxygenNote": "7.3.2",
"NeedsCompilation": "no",
"Author": "David Gohel [aut, cre], ArData [cph], Clementine Jager [ctb], Eli Daniels [ctb], Panagiotis Skintzos [aut], Quentin Fazilleau [ctb], Maxim Nazarov [ctb], Titouan Robert [ctb], Michael Barrowman [ctb], Atsushi Yasumoto [ctb], Paul Julian [ctb], Sean Browning [ctb], Rémi Thériault [ctb] (ORCID: <https://orcid.org/0000-0003-4315-6788>), Samuel Jobert [ctb], Keith Newman [ctb]",
"Maintainer": "David Gohel <david.gohel@ardata.fr>",
"Repository": "CRAN"
},
"fontBitstreamVera": {
"Package": "fontBitstreamVera",
"Version": "0.1.1",
"Source": "Repository",
"Title": "Fonts with 'Bitstream Vera Fonts' License",
"Authors@R": "c( person(\"Lionel\", \"Henry\", , \"lionel.hry@gmail.com\", c(\"cre\", \"aut\")), person(\"Bitstream\", role = \"cph\"))",
"Description": "Provides fonts licensed under the 'Bitstream Vera Fonts' license for the 'fontquiver' package.",
"Depends": [
"R (>= 3.0.0)"
],
"License": "file LICENCE",
"Encoding": "UTF-8",
"LazyData": "true",
"RoxygenNote": "5.0.1",
"NeedsCompilation": "no",
"Author": "Lionel Henry [cre, aut], Bitstream [cph]",
"Maintainer": "Lionel Henry <lionel.hry@gmail.com>",
"License_is_FOSS": "yes",
"Repository": "CRAN"
},
"fontLiberation": {
"Package": "fontLiberation",
"Version": "0.1.0",
"Source": "Repository",
"Title": "Liberation Fonts",
"Authors@R": "c( person(\"Lionel\", \"Henry\", , \"lionel@rstudio.com\", \"cre\"), person(\"Pravin Satpute\", role = \"aut\"), person(\"Steve Matteson\", role = \"aut\"), person(\"Red Hat, Inc\", role = \"cph\"), person(\"Google Corporation\", role = \"cph\"))",
"Description": "A placeholder for the Liberation fontset intended for the `fontquiver` package. This fontset covers the 12 combinations of families (sans, serif, mono) and faces (plain, bold, italic, bold italic) supported in R graphics devices.",
"Depends": [
"R (>= 3.0)"
],
"License": "file LICENSE",
"Encoding": "UTF-8",
"LazyData": "true",
"RoxygenNote": "5.0.1",
"NeedsCompilation": "no",
"Author": "Lionel Henry [cre], Pravin Satpute [aut], Steve Matteson [aut], Red Hat, Inc [cph], Google Corporation [cph]",
"Maintainer": "Lionel Henry <lionel@rstudio.com>",
"Repository": "CRAN",
"License_is_FOSS": "yes"
},
"fontawesome": {
"Package": "fontawesome",
"Version": "0.5.3",
@ -1926,6 +2079,34 @@
"Maintainer": "Richard Iannone <rich@posit.co>",
"Repository": "CRAN"
},
"fontquiver": {
"Package": "fontquiver",
"Version": "0.2.1",
"Source": "Repository",
"Title": "Set of Installed Fonts",
"Authors@R": "c( person(\"Lionel\", \"Henry\", , \"lionel@rstudio.com\", c(\"cre\", \"aut\")), person(\"RStudio\", role = \"cph\"), person(\"George Douros\", role = \"cph\", comment = \"Symbola font\"))",
"Description": "Provides a set of fonts with permissive licences. This is useful when you want to avoid system fonts to make sure your outputs are reproducible.",
"Depends": [
"R (>= 3.0.0)"
],
"Imports": [
"fontBitstreamVera (>= 0.1.0)",
"fontLiberation (>= 0.1.0)"
],
"Suggests": [
"testthat",
"htmltools"
],
"License": "GPL-3 | file LICENSE",
"Encoding": "UTF-8",
"LazyData": "true",
"RoxygenNote": "5.0.1",
"Collate": "'font-getters.R' 'fontset.R' 'fontset-bitstream-vera.R' 'fontset-dejavu.R' 'fontset-liberation.R' 'fontset-symbola.R' 'html-dependency.R' 'utils.R'",
"NeedsCompilation": "no",
"Author": "Lionel Henry [cre, aut], RStudio [cph], George Douros [cph] (Symbola font)",
"Maintainer": "Lionel Henry <lionel@rstudio.com>",
"Repository": "CRAN"
},
"forcats": {
"Package": "forcats",
"Version": "1.0.0",
@ -2208,6 +2389,43 @@
"Maintainer": "Jennifer Bryan <jenny@posit.co>",
"Repository": "CRAN"
},
"gdtools": {
"Package": "gdtools",
"Version": "0.4.3",
"Source": "Repository",
"Title": "Utilities for Graphical Rendering and Fonts Management",
"Authors@R": "c( person(\"David\", \"Gohel\", , \"david.gohel@ardata.fr\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", , \"hadley@rstudio.com\", role = \"aut\"), person(\"Lionel\", \"Henry\", , \"lionel@rstudio.com\", role = \"aut\"), person(\"Jeroen\", \"Ooms\", , \"jeroen@berkeley.edu\", role = \"aut\", comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"Yixuan\", \"Qiu\", role = \"ctb\"), person(\"R Core Team\", role = \"cph\", comment = \"Cairo code from X11 device\"), person(\"ArData\", role = \"cph\"), person(\"RStudio\", role = \"cph\") )",
"Description": "Tools are provided to compute metrics of formatted strings and to check the availability of a font. Another set of functions is provided to support the collection of fonts from 'Google Fonts' in a cache. Their use is simple within 'R Markdown' documents and 'shiny' applications but also with graphic productions generated with the 'ggiraph', 'ragg' and 'svglite' packages or with tabular productions from the 'flextable' package.",
"License": "GPL-3 | file LICENSE",
"URL": "https://davidgohel.github.io/gdtools/",
"BugReports": "https://github.com/davidgohel/gdtools/issues",
"Depends": [
"R (>= 4.0.0)"
],
"Imports": [
"fontquiver (>= 0.2.0)",
"htmltools",
"Rcpp (>= 0.12.12)",
"systemfonts (>= 1.1.0)",
"tools"
],
"Suggests": [
"curl",
"gfonts",
"methods",
"testthat"
],
"LinkingTo": [
"Rcpp"
],
"Encoding": "UTF-8",
"RoxygenNote": "7.3.2",
"SystemRequirements": "cairo, freetype2, fontconfig",
"NeedsCompilation": "yes",
"Author": "David Gohel [aut, cre], Hadley Wickham [aut], Lionel Henry [aut], Jeroen Ooms [aut] (ORCID: <https://orcid.org/0000-0002-4035-0289>), Yixuan Qiu [ctb], R Core Team [cph] (Cairo code from X11 device), ArData [cph], RStudio [cph]",
"Maintainer": "David Gohel <david.gohel@ardata.fr>",
"Repository": "CRAN"
},
"generics": {
"Package": "generics",
"Version": "0.1.3",
@ -4120,6 +4338,50 @@
"NeedsCompilation": "no",
"Repository": "CRAN"
},
"officer": {
"Package": "officer",
"Version": "0.7.0",
"Source": "Repository",
"Type": "Package",
"Title": "Manipulation of Microsoft Word and PowerPoint Documents",
"Authors@R": "c( person(\"David\", \"Gohel\", , \"david.gohel@ardata.fr\", role = c(\"aut\", \"cre\")), person(\"Stefan\", \"Moog\", , \"moogs@gmx.de\", role = \"aut\"), person(\"Mark\", \"Heckmann\", , \"heckmann.mark@gmail.com\", role = \"aut\", comment = c(ORCID = \"0000-0002-0736-7417\")), person(\"ArData\", role = \"cph\"), person(\"Frank\", \"Hangler\", , \"frank@plotandscatter.com\", role = \"ctb\", comment = \"function body_replace_all_text\"), person(\"Liz\", \"Sander\", , \"lsander@civisanalytics.com\", role = \"ctb\", comment = \"several documentation fixes\"), person(\"Anton\", \"Victorson\", , \"anton@victorson.se\", role = \"ctb\", comment = \"fixes xml structures\"), person(\"Jon\", \"Calder\", , \"jonmcalder@gmail.com\", role = \"ctb\", comment = \"update vignettes\"), person(\"John\", \"Harrold\", , \"john.m.harrold@gmail.com\", role = \"ctb\", comment = \"function annotate_base\"), person(\"John\", \"Muschelli\", , \"muschellij2@gmail.com\", role = \"ctb\", comment = \"google doc compatibility\"), person(\"Bill\", \"Denney\", , \"wdenney@humanpredictions.com\", role = \"ctb\", comment = c(ORCID = \"0000-0002-5759-428X\", \"function as.matrix.rpptx\")), person(\"Nikolai\", \"Beck\", , \"beck.nikolai@gmail.com\", role = \"ctb\", comment = \"set speaker notes for .pptx documents\"), person(\"Greg\", \"Leleu\", , \"gregoire.leleu@gmail.com\", role = \"ctb\", comment = \"fields functionality in ppt\"), person(\"Majid\", \"Eismann\", role = \"ctb\"), person(\"Hongyuan\", \"Jia\", , \"hongyuanjia@cqust.edu.cn\", role = \"ctb\", comment = c(ORCID = \"0000-0002-0075-8183\")), person(\"Michael\", \"Stackhouse\", , \"mike.stackhouse@atorusresearch.com\", role = \"ctb\") )",
"Description": "Access and manipulate 'Microsoft Word', 'RTF' and 'Microsoft PowerPoint' documents from R. The package focuses on tabular and graphical reporting from R; it also provides two functions that let users get document content into data objects. A set of functions lets add and remove images, tables and paragraphs of text in new or existing documents. The package does not require any installation of Microsoft products to be able to write Microsoft files.",
"License": "MIT + file LICENSE",
"URL": "https://ardata-fr.github.io/officeverse/, https://davidgohel.github.io/officer/",
"BugReports": "https://github.com/davidgohel/officer/issues",
"Imports": [
"cli",
"graphics",
"grDevices",
"openssl",
"R6",
"ragg",
"stats",
"utils",
"uuid",
"xml2 (>= 1.1.0)",
"zip (>= 2.1.0)"
],
"Suggests": [
"devEMF",
"doconv (>= 0.3.0)",
"gdtools",
"ggplot2",
"knitr",
"magick",
"rmarkdown",
"rsvg",
"testthat",
"withr"
],
"Encoding": "UTF-8",
"RoxygenNote": "7.3.2",
"Collate": "'core_properties.R' 'custom_properties.R' 'defunct.R' 'dev-utils.R' 'docx_add.R' 'docx_comments.R' 'docx_cursor.R' 'docx_part.R' 'docx_replace.R' 'docx_section.R' 'docx_settings.R' 'empty_content.R' 'formatting_properties.R' 'fortify_docx.R' 'fortify_pptx.R' 'knitr_utils.R' 'officer.R' 'ooxml.R' 'ooxml_block_objects.R' 'ooxml_run_objects.R' 'openxml_content_type.R' 'openxml_document.R' 'pack_folder.R' 'ph_location.R' 'post-proc.R' 'ppt_class_dir_collection.R' 'ppt_classes.R' 'ppt_notes.R' 'ppt_ph_dedupe_layout.R' 'ppt_ph_manipulate.R' 'ppt_ph_rename_layout.R' 'ppt_ph_with_methods.R' 'pptx_informations.R' 'pptx_layout_helper.R' 'pptx_matrix.R' 'utils.R' 'pptx_slide_manip.R' 'read_docx.R' 'read_docx_styles.R' 'read_pptx.R' 'read_xlsx.R' 'relationship.R' 'rtf.R' 'shape_properties.R' 'shorcuts.R' 'docx_append_context.R' 'utils-xml.R' 'deprecated.R' 'zzz.R'",
"NeedsCompilation": "no",
"Author": "David Gohel [aut, cre], Stefan Moog [aut], Mark Heckmann [aut] (ORCID: <https://orcid.org/0000-0002-0736-7417>), ArData [cph], Frank Hangler [ctb] (function body_replace_all_text), Liz Sander [ctb] (several documentation fixes), Anton Victorson [ctb] (fixes xml structures), Jon Calder [ctb] (update vignettes), John Harrold [ctb] (function annotate_base), John Muschelli [ctb] (google doc compatibility), Bill Denney [ctb] (ORCID: <https://orcid.org/0000-0002-5759-428X>, function as.matrix.rpptx), Nikolai Beck [ctb] (set speaker notes for .pptx documents), Greg Leleu [ctb] (fields functionality in ppt), Majid Eismann [ctb], Hongyuan Jia [ctb] (ORCID: <https://orcid.org/0000-0002-0075-8183>), Michael Stackhouse [ctb]",
"Maintainer": "David Gohel <david.gohel@ardata.fr>",
"Repository": "CRAN"
},
"openssl": {
"Package": "openssl",
"Version": "2.3.2",
@ -4223,6 +4485,50 @@
"Maintainer": "Henrik Bengtsson <henrikb@braju.com>",
"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 <thomasp85@gmail.com>",
"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: <https://orcid.org/0000-0002-5147-4711>)",
"Repository": "CRAN"
},
"pillar": {
"Package": "pillar",
"Version": "1.10.2",
@ -5966,6 +6272,38 @@
"Maintainer": "Edzer Pebesma <edzer.pebesma@uni-muenster.de>",
"Repository": "CRAN"
},
"spData": {
"Package": "spData",
"Version": "2.3.4",
"Source": "Repository",
"Title": "Datasets for Spatial Analysis",
"Authors@R": "c(person(\"Roger\", \"Bivand\", role = \"aut\", email=\"Roger.Bivand@nhh.no\", comment = c(ORCID = \"0000-0003-2392-6140\")), person(\"Jakub\", \"Nowosad\", role = c(\"aut\", \"cre\"), email=\"nowosad.jakub@gmail.com\", comment = c(ORCID = \"0000-0002-1057-3721\")), person(\"Robin\", \"Lovelace\", role = \"aut\", comment = c(ORCID = \"0000-0001-5679-6536\")), person(\"Angelos\", \"Mimis\", role = \"ctb\"), person(\"Mark\", \"Monmonier\", role = \"ctb\", comment = \"author of the state.vbm dataset\"), person(\"Greg\", \"Snow\", role = \"ctb\", comment = \"author of the state.vbm dataset\") )",
"Description": "Diverse spatial datasets for demonstrating, benchmarking and teaching spatial data analysis. It includes R data of class sf (defined by the package 'sf'), Spatial ('sp'), and nb ('spdep'). Unlike other spatial data packages such as 'rnaturalearth' and 'maps', it also contains data stored in a range of file formats including GeoJSON and GeoPackage, but from version 2.3.4, no longer ESRI Shapefile - use GeoPackage instead. Some of the datasets are designed to illustrate specific analysis techniques. cycle_hire() and cycle_hire_osm(), for example, is designed to illustrate point pattern analysis techniques.",
"Depends": [
"R (>= 3.3.0)"
],
"Imports": [
"sp"
],
"Suggests": [
"foreign",
"sf (>= 0.9-1)",
"spDataLarge (>= 0.4.0)",
"spdep",
"spatialreg"
],
"License": "CC0",
"RoxygenNote": "7.3.2",
"LazyData": "true",
"URL": "https://jakubnowosad.com/spData/",
"BugReports": "https://github.com/Nowosad/spData/issues",
"Additional_repositories": "https://jakubnowosad.com/drat",
"Encoding": "UTF-8",
"NeedsCompilation": "no",
"Author": "Roger Bivand [aut] (<https://orcid.org/0000-0003-2392-6140>), Jakub Nowosad [aut, cre] (<https://orcid.org/0000-0002-1057-3721>), Robin Lovelace [aut] (<https://orcid.org/0000-0001-5679-6536>), Angelos Mimis [ctb], Mark Monmonier [ctb] (author of the state.vbm dataset), Greg Snow [ctb] (author of the state.vbm dataset)",
"Maintainer": "Jakub Nowosad <nowosad.jakub@gmail.com>",
"Repository": "CRAN"
},
"spacesXYZ": {
"Package": "spacesXYZ",
"Version": "1.5-1",
@ -6037,6 +6375,66 @@
"Maintainer": "Emil Hvitfeldt <emil.hvitfeldt@posit.co>",
"Repository": "CRAN"
},
"spdep": {
"Package": "spdep",
"Version": "1.4-1",
"Source": "Repository",
"Date": "2025-08-25",
"Title": "Spatial Dependence: Weighting Schemes, Statistics",
"Encoding": "UTF-8",
"Authors@R": "c(person(\"Roger\", \"Bivand\", role = c(\"cre\", \"aut\"), email = \"Roger.Bivand@nhh.no\", comment=c(ORCID=\"0000-0003-2392-6140\")), person(\"Micah\", \"Altman\", role = \"ctb\"), person(\"Luc\", \"Anselin\", role = \"ctb\"), person(\"Renato\", \"Assunção\", role = \"ctb\"), person(\"Anil\", \"Bera\", role = \"ctb\"), person(\"Olaf\", \"Berke\", role = \"ctb\"), person(\"F. Guillaume\", \"Blanchet\", role = \"ctb\"), person(\"Marilia\", \"Carvalho\", role = \"ctb\"), person(\"Bjarke\", \"Christensen\", role = \"ctb\"), person(\"Yongwan\", \"Chun\", role = \"ctb\"), person(\"Carsten\", \"Dormann\", role = \"ctb\"), person(\"Stéphane\", \"Dray\", role = \"ctb\"), person(\"Dewey\", \"Dunnington\", role = c(\"ctb\"), comment = c(ORCID = \"0000-0002-9415-4582\")), person(\"Virgilio\", \"Gómez-Rubio\", role = \"ctb\"), person(\"Malabika\", \"Koley\", role = \"ctb\"), person(\"Tomasz\", \"Kossowski\", role = \"ctb\", comment = c(ORCID = \"0000-0002-9976-4398\")), person(\"Elias\", \"Krainski\", role = \"ctb\"), person(\"Pierre\", \"Legendre\", role = \"ctb\"), person(\"Nicholas\", \"Lewin-Koh\", role = \"ctb\"), person(\"Angela\", \"Li\", role = \"ctb\"), person(\"Giovanni\", \"Millo\", role = \"ctb\"), person(\"Werner\", \"Mueller\", role = \"ctb\"), person(\"Hisaji\", \"Ono\", role = \"ctb\"), person(\"Josiah\", \"Parry\", role = \"ctb\", comment = c(ORCID = \"0000-0001-9910-865X\")), person(\"Pedro\", \"Peres-Neto\", role = \"ctb\"), person(\"Michał\", \"Pietrzak\", role = \"ctb\", comment = c(ORCID = \"0000-0002-9263-4478\")), person(\"Gianfranco\", \"Piras\", role = \"ctb\"), person(\"Markus\", \"Reder\", role = \"ctb\"), person(\"Jeff\", \"Sauer\", role = \"ctb\"), person(\"Michael\", \"Tiefelsdorf\", role = \"ctb\"), person(\"René\", \"Westerholt\", role=\"ctb\"), person(\"Justyna\", \"Wilk\", role = \"ctb\", comment = c(ORCID = \"0000-0003-1495-2910\")), person(\"Levi\", \"Wolf\", role = \"ctb\"), person(\"Danlin\", \"Yu\", role = \"ctb\"))",
"Depends": [
"R (>= 3.3.0)",
"methods",
"spData (>= 2.3.1)",
"sf"
],
"Imports": [
"stats",
"deldir",
"boot (>= 1.3-1)",
"graphics",
"utils",
"grDevices",
"units",
"s2",
"e1071",
"sp (>= 1.0)"
],
"Suggests": [
"spatialreg (>= 1.2-1)",
"Matrix",
"parallel",
"dbscan",
"RColorBrewer",
"lattice",
"xtable",
"foreign",
"igraph",
"RSpectra",
"knitr",
"classInt",
"tmap",
"spam",
"ggplot2",
"rmarkdown",
"tinytest",
"rgeoda (>= 0.0.11.1)",
"mipfp",
"Guerry",
"codingMatrices"
],
"URL": "https://github.com/r-spatial/spdep/, https://r-spatial.github.io/spdep/",
"BugReports": "https://github.com/r-spatial/spdep/issues/",
"Description": "A collection of functions to create spatial weights matrix objects from polygon 'contiguities', from point patterns by distance and tessellations, for summarizing these objects, and for permitting their use in spatial data analysis, including regional aggregation by minimum spanning tree; a collection of tests for spatial 'autocorrelation', including global 'Morans I' and 'Gearys C' proposed by 'Cliff' and 'Ord' (1973, ISBN: 0850860369) and (1981, ISBN: 0850860814), 'Hubert/Mantel' general cross product statistic, Empirical Bayes estimates and 'Assunção/Reis' (1999) <doi:10.1002/(SICI)1097-0258(19990830)18:16%3C2147::AID-SIM179%3E3.0.CO;2-I> Index, 'Getis/Ord' G ('Getis' and 'Ord' 1992) <doi:10.1111/j.1538-4632.1992.tb00261.x> and multicoloured join count statistics, 'APLE' ('Li et al.' ) <doi:10.1111/j.1538-4632.2007.00708.x>, local 'Moran's I', 'Gearys C' ('Anselin' 1995) <doi:10.1111/j.1538-4632.1995.tb00338.x> and 'Getis/Ord' G ('Ord' and 'Getis' 1995) <doi:10.1111/j.1538-4632.1995.tb00912.x>, 'saddlepoint' approximations ('Tiefelsdorf' 2002) <doi:10.1111/j.1538-4632.2002.tb01084.x> and exact tests for global and local 'Moran's I' ('Bivand et al.' 2009) <doi:10.1016/j.csda.2008.07.021> and 'LOSH' local indicators of spatial heteroscedasticity ('Ord' and 'Getis') <doi:10.1007/s00168-011-0492-y>. The implementation of most of these measures is described in 'Bivand' and 'Wong' (2018) <doi:10.1007/s11749-018-0599-x>, with further extensions in 'Bivand' (2022) <doi:10.1111/gean.12319>. 'Lagrange' multiplier tests for spatial dependence in linear models are provided ('Anselin et al'. 1996) <doi:10.1016/0166-0462(95)02111-6>, as are 'Rao' score tests for hypothesised spatial 'Durbin' models based on linear models ('Koley' and 'Bera' 2023) <doi:10.1080/17421772.2023.2256810>. Additions in 2024 include Local Indicators for Categorical Data based on 'Carrer et al.' (2021) <doi:10.1016/j.jas.2020.105306> and 'Bivand et al.' (2017) <doi:10.1016/j.spasta.2017.03.003>; also Weighted Multivariate Spatial Autocorrelation Measures ('Bavaud' 2024) <doi:10.1111/gean.12390>. <doi:10.1080/17421772.2023.2256810>. A local indicators for categorical data (LICD) implementation based on 'Carrer et al.' (2021) <doi:10.1016/j.jas.2020.105306> and 'Bivand et al.' (2017) <doi:10.1016/j.spasta.2017.03.003> was added in 1.3-7. Multivariate 'spatialdelta' ('Bavaud' 2024) <doi:10.1111/gean.12390> was added in 1.3-13 ('Bivand' 2025 <doi:10.26034/la.cdclsl.2025.8343>. From 'spdep' and 'spatialreg' versions >= 1.2-1, the model fitting functions previously present in this package are defunct in 'spdep' and may be found in 'spatialreg'.",
"License": "GPL (>= 2)",
"VignetteBuilder": "knitr",
"RoxygenNote": "RoxygenNote: 6.1.1",
"NeedsCompilation": "yes",
"Author": "Roger Bivand [cre, aut] (ORCID: <https://orcid.org/0000-0003-2392-6140>), Micah Altman [ctb], Luc Anselin [ctb], Renato Assunção [ctb], Anil Bera [ctb], Olaf Berke [ctb], F. Guillaume Blanchet [ctb], Marilia Carvalho [ctb], Bjarke Christensen [ctb], Yongwan Chun [ctb], Carsten Dormann [ctb], Stéphane Dray [ctb], Dewey Dunnington [ctb] (ORCID: <https://orcid.org/0000-0002-9415-4582>), Virgilio Gómez-Rubio [ctb], Malabika Koley [ctb], Tomasz Kossowski [ctb] (ORCID: <https://orcid.org/0000-0002-9976-4398>), Elias Krainski [ctb], Pierre Legendre [ctb], Nicholas Lewin-Koh [ctb], Angela Li [ctb], Giovanni Millo [ctb], Werner Mueller [ctb], Hisaji Ono [ctb], Josiah Parry [ctb] (ORCID: <https://orcid.org/0000-0001-9910-865X>), Pedro Peres-Neto [ctb], Michał Pietrzak [ctb] (ORCID: <https://orcid.org/0000-0002-9263-4478>), Gianfranco Piras [ctb], Markus Reder [ctb], Jeff Sauer [ctb], Michael Tiefelsdorf [ctb], René Westerholt [ctb], Justyna Wilk [ctb] (ORCID: <https://orcid.org/0000-0003-1495-2910>), Levi Wolf [ctb], Danlin Yu [ctb]",
"Maintainer": "Roger Bivand <Roger.Bivand@nhh.no>",
"Repository": "CRAN"
},
"stars": {
"Package": "stars",
"Version": "0.6-8",
@ -6845,7 +7243,7 @@
},
"tzdb": {
"Package": "tzdb",
"Version": "0.4.0",
"Version": "0.5.0",
"Source": "Repository",
"Title": "Time Zone Database Information",
"Authors@R": "c( person(\"Davis\", \"Vaughan\", , \"davis@posit.co\", role = c(\"aut\", \"cre\")), person(\"Howard\", \"Hinnant\", role = \"cph\", comment = \"Author of the included date library\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )",
@ -6854,20 +7252,20 @@
"URL": "https://tzdb.r-lib.org, https://github.com/r-lib/tzdb",
"BugReports": "https://github.com/r-lib/tzdb/issues",
"Depends": [
"R (>= 3.5.0)"
"R (>= 4.0.0)"
],
"Suggests": [
"covr",
"testthat (>= 3.0.0)"
],
"LinkingTo": [
"cpp11 (>= 0.4.2)"
"cpp11 (>= 0.5.2)"
],
"Biarch": "yes",
"Config/Needs/website": "tidyverse/tidytemplate",
"Config/testthat/edition": "3",
"Encoding": "UTF-8",
"RoxygenNote": "7.2.3",
"RoxygenNote": "7.3.2",
"NeedsCompilation": "yes",
"Author": "Davis Vaughan [aut, cre], Howard Hinnant [cph] (Author of the included date library), Posit Software, PBC [cph, fnd]",
"Maintainer": "Davis Vaughan <davis@posit.co>",
@ -7012,6 +7410,52 @@
"Maintainer": "Davis Vaughan <davis@posit.co>",
"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 <garnier@njit.edu>",
"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 <https://cran.r-project.org/package=viridisLite>.",
"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",
@ -7205,6 +7649,33 @@
"Author": "Dewey Dunnington [aut, cre] (<https://orcid.org/0000-0002-9415-4582>), Edzer Pebesma [aut] (<https://orcid.org/0000-0001-8049-7069>), Anthony North [ctb]",
"Repository": "CRAN"
},
"writexl": {
"Package": "writexl",
"Version": "1.5.4",
"Source": "Repository",
"Type": "Package",
"Title": "Export Data Frames to Excel 'xlsx' Format",
"Authors@R": "c( person(\"Jeroen\", \"Ooms\", ,\"jeroenooms@gmail.com\", role = c(\"aut\", \"cre\"), comment = c(ORCID = \"0000-0002-4035-0289\")), person(\"John McNamara\", role = \"cph\", comment = \"Author of libxlsxwriter (see AUTHORS and COPYRIGHT files for details)\"))",
"Description": "Zero-dependency data frame to xlsx exporter based on 'libxlsxwriter' <https://libxlsxwriter.github.io>. Fast and no Java or Excel required.",
"License": "BSD_2_clause + file LICENSE",
"Encoding": "UTF-8",
"URL": "https://ropensci.r-universe.dev/writexl https://docs.ropensci.org/writexl/",
"BugReports": "https://github.com/ropensci/writexl/issues",
"RoxygenNote": "7.0.2",
"Suggests": [
"spelling",
"readxl",
"nycflights13",
"testthat",
"bit64"
],
"Language": "en-US",
"SystemRequirements": "zlib",
"NeedsCompilation": "yes",
"Author": "Jeroen Ooms [aut, cre] (<https://orcid.org/0000-0002-4035-0289>), John McNamara [cph] (Author of libxlsxwriter (see AUTHORS and COPYRIGHT files for details))",
"Maintainer": "Jeroen Ooms <jeroenooms@gmail.com>",
"Repository": "CRAN"
},
"xfun": {
"Package": "xfun",
"Version": "0.52",
@ -7340,6 +7811,34 @@
"NeedsCompilation": "yes",
"Repository": "CRAN"
},
"zip": {
"Package": "zip",
"Version": "2.3.3",
"Source": "Repository",
"Title": "Cross-Platform 'zip' Compression",
"Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"csardi.gabor@gmail.com\", role = c(\"aut\", \"cre\")), person(\"Kuba\", \"Podgórski\", role = \"ctb\"), person(\"Rich\", \"Geldreich\", role = \"ctb\"), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\"), comment = c(ROR = \"03wc8by49\")) )",
"Description": "Cross-Platform 'zip' Compression Library. A replacement for the 'zip' function, that does not require any additional external tools on any platform.",
"License": "MIT + file LICENSE",
"URL": "https://github.com/r-lib/zip, https://r-lib.github.io/zip/",
"BugReports": "https://github.com/r-lib/zip/issues",
"Suggests": [
"covr",
"pillar",
"processx",
"R6",
"testthat",
"withr"
],
"Config/Needs/website": "tidyverse/tidytemplate",
"Config/testthat/edition": "3",
"Config/usethis/last-upkeep": "2025-05-07",
"Encoding": "UTF-8",
"RoxygenNote": "7.3.2.9000",
"NeedsCompilation": "yes",
"Author": "Gábor Csárdi [aut, cre], Kuba Podgórski [ctb], Rich Geldreich [ctb], Posit Software, PBC [cph, fnd] (ROR: <https://ror.org/03wc8by49>)",
"Maintainer": "Gábor Csárdi <csardi.gabor@gmail.com>",
"Repository": "CRAN"
},
"zoo": {
"Package": "zoo",
"Version": "1.8-13",

3
run_kpi_calculation.R Normal file
View file

@ -0,0 +1,3 @@
# Wrapper script to set project_dir and run KPI calculation
project_dir <- "esa"
source("r_app/09_calculate_kpis.R")

0
run_report.R Normal file
View file