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

Merge branch 'code-improvements'

Browse source
This commit is contained in:
Martin Folkerts 2025-06-25 09:35:19 +02:00
parent a316b30afc b2fcd66d2b
commit cc6b9392d6
13 changed files with 10132 additions and 602 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

838
.Rhistory
View file

@ -1,210 +1,416 @@
})
# 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
)
})
ggplot2::labs(title = "Model Performance: \nPredicted vs Actual Tonnage/ha",
x = "Actual tonnage/ha (Tcha)",
y = "Predicted tonnage/ha (Tcha)") +
ggplot2::theme_minimal()
}
# 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
)
})
# 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))
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 rendering velocity visualization:", e$message), "ERROR")
cat("<div class='alert alert-danger'>Error generating velocity visualization.</div>")
safe_log(paste("Error in yield prediction visualization:", e$message), "ERROR")
cat("Error generating yield prediction visualizations. See log for details.")
})
# Generate anomaly timeline visualization
# Load and prepare yield prediction data with error handling
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>")
})
# 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
)
})
# 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
}
# 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")
# 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()
})
# 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()
})
# 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
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()
@ -215,23 +421,21 @@ use_breaks <- params$use_breaks # Whether to use breaks or continuous spectrum
# Chunk 2: load_libraries
# Configure knitr options
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
# Path management
# Load all packages at once with suppressPackageStartupMessages
suppressPackageStartupMessages({
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(tidyverse)
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")
@ -244,199 +448,21 @@ source(here::here("r_app", "report_utils.R"))
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", "executive_report_utils.R"))
}, error = function(e) {
stop("Could not load executive_report_utils.R from either location: ", e$message)
})
})
# 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
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()
# Chunk 2: load_libraries
# 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", "executive_report_utils.R"))
}, error = function(e) {
stop("Could not load executive_report_utils.R from either location: ", e$message)
})
})
# 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
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()
# Chunk 2: load_libraries
# 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", "executive_report_utils.R"))
# 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
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()
# Chunk 2: load_libraries
# 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)
# })
# })
# Chunk 3: initialize_project_config
# Set the project directory from parameters
project_dir <- params$data_dir
# Source project parameters with error handling
# tryCatch({
tryCatch({
source(here::here("r_app", "parameters_project.R"))
# }, error = function(e) {
# stop("Error loading parameters_project.R: ", e$message)
# })
}, 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))
# Chunk 4: calculate_dates_and_weeks
# Set locale for consistent date formatting
Sys.setlocale("LC_TIME", "C")
# Initialize date variables from parameters
@ -465,8 +491,6 @@ 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
@ -478,35 +502,11 @@ 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)
# 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)
})
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")

1
.Rprofile Normal file
View file

@ -0,0 +1 @@
source("renv/activate.R")

94
PACKAGE_MANAGEMENT.md Normal file
View file

@ -0,0 +1,94 @@
# SmartCane Project - Package Management
## Quick Start
### For New Team Members
1. Open R/RStudio
2. Set working directory to the project root: `setwd("path/to/smartcane")`
3. Run: `source("r_app/package_manager.R")`
4. Type `y` when prompted
5. Wait for completion ✅
### For Existing Team Members (After Git Pull)
Same steps as above - the script will check for updates automatically.
## What This Script Does
1. **Initializes renv** - Creates isolated package environment
2. **Checks package versions** - Compares installed vs required
3. **Installs/Updates packages** - Only if needed
4. **Creates lockfile** - `renv.lock` for exact reproducibility
5. **Generates reports** - Console output + `package_manager.log`
## Key Features
- ✅ **Minimum version requirements** (allows patch updates)
- ✅ **Critical package locking** (tmap v4 for new syntax)
- ✅ **Automatic installation** of missing packages
- ✅ **Console + Log output** for debugging
- ✅ **Cross-platform compatibility**
## Required Packages & Versions
| Package | Min Version | Purpose |
|---------|-------------|---------|
| tmap | 4.0.0 | **CRITICAL** - New syntax used |
| tidyverse | 2.0.0 | Data manipulation |
| sf | 1.0.0 | Spatial data |
| terra | 1.7.0 | Raster processing |
| rmarkdown | 2.21.0 | Report generation |
## Workflow
### Development Workflow
```
1. 👨‍💻 Developer: Make changes → run package_manager.R → test → commit + push
2. 👥 Teammate: Pull → run package_manager.R → test
3. 🚀 Production: Pull → run package_manager.R → deploy
```
### Files Created
- `renv.lock` - Exact package versions (commit this!)
- `package_manager.log` - Installation log (don't commit)
- `renv/` folder - Package cache (don't commit)
## Troubleshooting
### "Package failed to install"
- Check internet connection
- Update R to latest version
- Install system dependencies (varies by OS)
### "Version conflicts"
- Delete `renv/` folder
- Run script again for clean install
### "renv not working"
- Install manually: `install.packages("renv")`
- Restart R session
- Run script again
## Team Guidelines
1. **Always run** `package_manager.R` after pulling changes
2. **Commit** `renv.lock` to git (not `renv/` folder)
3. **Don't modify** package versions in scripts - use this manager
4. **Report issues** in the log file to team
## Advanced Usage
### Restore from lockfile only:
```r
renv::restore()
```
### Add new package requirement:
1. Edit `REQUIRED_PACKAGES` in `package_manager.R`
2. Run the script
3. Commit updated `renv.lock`
### Check status without changes:
```r
source("r_app/package_manager.R")
# Then just read the log or run generate_package_report()
```

42
generated_package_config.R Normal file
View file

@ -0,0 +1,42 @@
# 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"
)

111
package_manager.log Normal file
View file

@ -0,0 +1,111 @@
[INFO] 2025-06-24 14:49:29 - SmartCane Project - Package Manager Started
[INFO] 2025-06-24 14:49:29 - Working directory: C:/Users/timon/Resilience BV/4020 SCane ESA DEMO - Documenten/General/4020 SCDEMO Team/4020 TechnicalData/WP3/smartcane
[INFO] 2025-06-24 14:49:29 - Checking renv initialization...
[INFO] 2025-06-24 14:49:29 - ✓ renv already initialized
[INFO] 2025-06-24 14:49:29 - ✓ renv already active
[INFO] 2025-06-24 14:49:29 -
=== INITIAL STATE ===
[INFO] 2025-06-24 14:49:29 - === PACKAGE REPORT ===
[INFO] 2025-06-24 14:49:29 - dplyr | Required: >= 1.1.4 | Installed: 1.1.4 | ✅ OK
[INFO] 2025-06-24 14:49:29 - here | Required: >= 1.0.1 | Installed: 1.0.1 | ✅ OK
[INFO] 2025-06-24 14:49:29 - lubridate | Required: >= 1.9.4 | Installed: 1.9.4 | ✅ OK
[INFO] 2025-06-24 14:49:29 - readr | Required: >= 2.1.5 | Installed: 2.1.5 | ✅ OK
[INFO] 2025-06-24 14:49:29 - readxl | Required: >= 1.4.5 | Installed: 1.4.5 | ✅ OK
[INFO] 2025-06-24 14:49:29 - stringr | Required: >= 1.5.1 | Installed: 1.5.1 | ✅ OK
[INFO] 2025-06-24 14:49:29 - tidyr | Required: >= 1.3.1 | Installed: 1.3.1 | ✅ OK
[INFO] 2025-06-24 14:49:29 - purrr | Required: >= 1.0.2 | Installed: 1.0.2 | ✅ OK
[INFO] 2025-06-24 14:49:29 - magrittr | Required: >= 2.0.0 | Installed: 2.0.3 | ✅ OK
[INFO] 2025-06-24 14:49:29 - exactextractr | Required: >= 0.10.0 | Installed: 0.10.0 | ✅ OK
[INFO] 2025-06-24 14:49:29 - raster | Required: >= 3.6.32 | Installed: 3.6.32 | ✅ OK
[INFO] 2025-06-24 14:49:29 - sf | Required: >= 1.0.19 | Installed: 1.0.19 | ✅ OK
[INFO] 2025-06-24 14:49:29 - terra | Required: >= 1.8.43 | Installed: 1.8.43 | ✅ OK
[INFO] 2025-06-24 14:49:29 - ggplot2 | Required: >= 3.5.1 | Installed: 3.5.1 | ✅ OK
[INFO] 2025-06-24 14:49:29 - tmap | Required: >= 4.0 | Installed: 4.0 | ✅ OK
[INFO] 2025-06-24 14:49:29 - gridExtra | Required: >= 2.3 | Installed: 2.3 | ✅ OK
[INFO] 2025-06-24 14:49:29 - knitr | Required: >= 1.50 | Installed: 1.50 | ✅ OK
[INFO] 2025-06-24 14:49:29 - rmarkdown | Required: >= 2.21.0 | Installed: 2.29 | ✅ OK
[INFO] 2025-06-24 14:49:29 - tidyverse | Required: >= 2.0.0 | Installed: 2.0.0 | ✅ OK
[INFO] 2025-06-24 14:49:29 - caret | Required: >= 7.0.1 | Installed: 7.0.1 | ✅ OK
[INFO] 2025-06-24 14:49:29 - CAST | Required: >= 1.0.3 | Installed: 1.0.3 | ✅ OK
[INFO] 2025-06-24 14:49:29 - randomForest | Required: >= 4.7.1.2 | Installed: 4.7.1.2 | ✅ OK
[INFO] 2025-06-24 14:49:29 - rsample | Required: >= 1.3.0 | Installed: 1.3.0 | ✅ OK
[INFO] 2025-06-24 14:49:29 - furrr | Required: >= 0.3.1 | Installed: 0.3.1 | ✅ OK
[INFO] 2025-06-24 14:49:29 - future | Required: >= 1.40.0 | Installed: 1.40.0 | ✅ OK
[INFO] 2025-06-24 14:49:29 - progressr | Required: >= 0.15.1 | Installed: 0.15.1 | ✅ OK
[INFO] 2025-06-24 14:49:29 - reshape2 | Required: >= 1.4.4 | Installed: 1.4.4 | ✅ OK
[INFO] 2025-06-24 14:49:29 - zoo | Required: >= 1.8.13 | Installed: 1.8.13 | ✅ OK
[INFO] 2025-06-24 14:49:29 - === END PACKAGE REPORT ===
[INFO] 2025-06-24 14:49:29 -
=== PACKAGE INSTALLATION/UPDATES ===
[INFO] 2025-06-24 14:49:29 - === PACKAGE MANAGEMENT STARTED ===
[INFO] 2025-06-24 14:49:29 - R version: R version 4.4.2 (2024-10-31 ucrt)
[INFO] 2025-06-24 14:49:29 - ✓ dplyr version 1.1.4 meets requirement (>= 1.1.4)
[INFO] 2025-06-24 14:49:29 - ✓ here version 1.0.1 meets requirement (>= 1.0.1)
[INFO] 2025-06-24 14:49:29 - ✓ lubridate version 1.9.4 meets requirement (>= 1.9.4)
[INFO] 2025-06-24 14:49:29 - ✓ readr version 2.1.5 meets requirement (>= 2.1.5)
[INFO] 2025-06-24 14:49:29 - ✓ readxl version 1.4.5 meets requirement (>= 1.4.5)
[INFO] 2025-06-24 14:49:29 - ✓ stringr version 1.5.1 meets requirement (>= 1.5.1)
[INFO] 2025-06-24 14:49:29 - ✓ tidyr version 1.3.1 meets requirement (>= 1.3.1)
[INFO] 2025-06-24 14:49:29 - ✓ purrr version 1.0.2 meets requirement (>= 1.0.2)
[INFO] 2025-06-24 14:49:29 - ✓ magrittr version 2.0.3 meets requirement (>= 2.0.0)
[INFO] 2025-06-24 14:49:29 - ✓ exactextractr version 0.10.0 meets requirement (>= 0.10.0)
[INFO] 2025-06-24 14:49:29 - ✓ raster version 3.6.32 meets requirement (>= 3.6.32)
[INFO] 2025-06-24 14:49:29 - ✓ sf version 1.0.19 meets requirement (>= 1.0.19)
[INFO] 2025-06-24 14:49:29 - ✓ terra version 1.8.43 meets requirement (>= 1.8.43)
[INFO] 2025-06-24 14:49:29 - ✓ ggplot2 version 3.5.1 meets requirement (>= 3.5.1)
[INFO] 2025-06-24 14:49:29 - ✓ tmap version 4.0 meets requirement (>= 4.0)
[INFO] 2025-06-24 14:49:29 - ✓ gridExtra version 2.3 meets requirement (>= 2.3)
[INFO] 2025-06-24 14:49:29 - ✓ knitr version 1.50 meets requirement (>= 1.50)
[INFO] 2025-06-24 14:49:29 - ✓ rmarkdown version 2.29 meets requirement (>= 2.21.0)
[INFO] 2025-06-24 14:49:29 - ✓ tidyverse version 2.0.0 meets requirement (>= 2.0.0)
[INFO] 2025-06-24 14:49:29 - ✓ caret version 7.0.1 meets requirement (>= 7.0.1)
[INFO] 2025-06-24 14:49:29 - ✓ CAST version 1.0.3 meets requirement (>= 1.0.3)
[INFO] 2025-06-24 14:49:29 - ✓ randomForest version 4.7.1.2 meets requirement (>= 4.7.1.2)
[INFO] 2025-06-24 14:49:29 - ✓ rsample version 1.3.0 meets requirement (>= 1.3.0)
[INFO] 2025-06-24 14:49:29 - ✓ furrr version 0.3.1 meets requirement (>= 0.3.1)
[INFO] 2025-06-24 14:49:29 - ✓ future version 1.40.0 meets requirement (>= 1.40.0)
[INFO] 2025-06-24 14:49:29 - ✓ progressr version 0.15.1 meets requirement (>= 0.15.1)
[INFO] 2025-06-24 14:49:29 - ✓ reshape2 version 1.4.4 meets requirement (>= 1.4.4)
[INFO] 2025-06-24 14:49:29 - ✓ zoo version 1.8.13 meets requirement (>= 1.8.13)
[INFO] 2025-06-24 14:49:29 - Package management complete: 28 success, 0 failures
[INFO] 2025-06-24 14:49:29 - Updating renv lockfile...
[ERROR] 2025-06-24 14:49:33 - ✗ Failed to update lockfile: aborting snapshot due to pre-flight validation failure
[INFO] 2025-06-24 14:49:33 -
=== FINAL STATE ===
[INFO] 2025-06-24 14:49:33 - === PACKAGE REPORT ===
[INFO] 2025-06-24 14:49:33 - dplyr | Required: >= 1.1.4 | Installed: 1.1.4 | ✅ OK
[INFO] 2025-06-24 14:49:33 - here | Required: >= 1.0.1 | Installed: 1.0.1 | ✅ OK
[INFO] 2025-06-24 14:49:33 - lubridate | Required: >= 1.9.4 | Installed: 1.9.4 | ✅ OK
[INFO] 2025-06-24 14:49:33 - readr | Required: >= 2.1.5 | Installed: 2.1.5 | ✅ OK
[INFO] 2025-06-24 14:49:33 - readxl | Required: >= 1.4.5 | Installed: 1.4.5 | ✅ OK
[INFO] 2025-06-24 14:49:33 - stringr | Required: >= 1.5.1 | Installed: 1.5.1 | ✅ OK
[INFO] 2025-06-24 14:49:33 - tidyr | Required: >= 1.3.1 | Installed: 1.3.1 | ✅ OK
[INFO] 2025-06-24 14:49:33 - purrr | Required: >= 1.0.2 | Installed: 1.0.2 | ✅ OK
[INFO] 2025-06-24 14:49:33 - magrittr | Required: >= 2.0.0 | Installed: 2.0.3 | ✅ OK
[INFO] 2025-06-24 14:49:33 - exactextractr | Required: >= 0.10.0 | Installed: 0.10.0 | ✅ OK
[INFO] 2025-06-24 14:49:33 - raster | Required: >= 3.6.32 | Installed: 3.6.32 | ✅ OK
[INFO] 2025-06-24 14:49:33 - sf | Required: >= 1.0.19 | Installed: 1.0.19 | ✅ OK
[INFO] 2025-06-24 14:49:33 - terra | Required: >= 1.8.43 | Installed: 1.8.43 | ✅ OK
[INFO] 2025-06-24 14:49:33 - ggplot2 | Required: >= 3.5.1 | Installed: 3.5.1 | ✅ OK
[INFO] 2025-06-24 14:49:33 - tmap | Required: >= 4.0 | Installed: 4.0 | ✅ OK
[INFO] 2025-06-24 14:49:33 - gridExtra | Required: >= 2.3 | Installed: 2.3 | ✅ OK
[INFO] 2025-06-24 14:49:33 - knitr | Required: >= 1.50 | Installed: 1.50 | ✅ OK
[INFO] 2025-06-24 14:49:33 - rmarkdown | Required: >= 2.21.0 | Installed: 2.29 | ✅ OK
[INFO] 2025-06-24 14:49:33 - tidyverse | Required: >= 2.0.0 | Installed: 2.0.0 | ✅ OK
[INFO] 2025-06-24 14:49:33 - caret | Required: >= 7.0.1 | Installed: 7.0.1 | ✅ OK
[INFO] 2025-06-24 14:49:33 - CAST | Required: >= 1.0.3 | Installed: 1.0.3 | ✅ OK
[INFO] 2025-06-24 14:49:33 - randomForest | Required: >= 4.7.1.2 | Installed: 4.7.1.2 | ✅ OK
[INFO] 2025-06-24 14:49:33 - rsample | Required: >= 1.3.0 | Installed: 1.3.0 | ✅ OK
[INFO] 2025-06-24 14:49:33 - furrr | Required: >= 0.3.1 | Installed: 0.3.1 | ✅ OK
[INFO] 2025-06-24 14:49:33 - future | Required: >= 1.40.0 | Installed: 1.40.0 | ✅ OK
[INFO] 2025-06-24 14:49:33 - progressr | Required: >= 0.15.1 | Installed: 0.15.1 | ✅ OK
[INFO] 2025-06-24 14:49:33 - reshape2 | Required: >= 1.4.4 | Installed: 1.4.4 | ✅ OK
[INFO] 2025-06-24 14:49:33 - zoo | Required: >= 1.8.13 | Installed: 1.8.13 | ✅ OK
[INFO] 2025-06-24 14:49:33 - === END PACKAGE REPORT ===
[INFO] 2025-06-24 14:49:33 - Package management completed in 7.72 seconds
[INFO] 2025-06-24 14:49:33 - Log saved to: C:/Users/timon/Resilience BV/4020 SCane ESA DEMO - Documenten/General/4020 SCDEMO Team/4020 TechnicalData/WP3/smartcane/package_manager.log
[SUCCESS] 2025-06-24 14:49:33 - 🎉 All packages successfully managed!
[INFO] 2025-06-24 14:49:33 - 📋 Next steps:
[INFO] 2025-06-24 14:49:33 - 1. Test your R scripts to ensure everything works
[INFO] 2025-06-24 14:49:33 - 2. Commit renv.lock to version control
[INFO] 2025-06-24 14:49:33 - 3. Share this script with your team

226
r_app/CI_report_dashboard_planet.Rmd
View file

@ -10,7 +10,7 @@ output:
# html_document:
# toc: yes
# df_print: paged
word_document:
word_document:
reference_docx: !expr file.path("word-styles-reference-var1.docx")
toc: no
editor_options:
@ -157,19 +157,19 @@ tryCatch({
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)
})
@ -181,7 +181,7 @@ 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")
@ -261,16 +261,16 @@ Report Date: **`r report_date_formatted`**
## 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
**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
**Field Coverage:**
- Total Fields Monitored: `r total_fields`
- Total Area: `r total_area_ha` hectares
**Report Generated:** `r format(Sys.Date(), "%B %d, %Y at %H:%M")`
**Report Generated:** `r format(Sys.Date(), "%B %d, %Y")`
---
@ -279,7 +279,7 @@ Report Date: **`r report_date_formatted`**
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
- Weekly changes in crop vigor
- Areas requiring agricultural attention
- Growth patterns across different field sections
@ -291,13 +291,40 @@ This automated report provides weekly analysis of sugarcane crop health using sa
</div>
\pagebreak
\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 -->
\pagebreak
\newpage
# 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.
@ -332,72 +359,71 @@ Use these insights to identify areas that may need irrigation, fertilization, or
\pagebreak
# RGB Satellite Image - Current Week (if available)
```{r render_rgb_map, echo=FALSE, fig.height=6.9, fig.width=9, message=FALSE, warning=FALSE}
```{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)) &&
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
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]
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
# Create RGB map
map <- tmap::tm_shape(rgb_raster, unit = "m") +
tmap::tm_rgb() +
tmap::tm_scalebar(position = c("right", "bottom"), text.color = "white") +
tmap::tm_compass(position = c("right", "bottom"), text.color = "white") +
tmap::tm_shape(AllPivots0) +
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")
@ -413,26 +439,24 @@ tryCatch({
})
```
\pagebreak
\newpage
# Chlorophyll Index (CI) Overview Map - Current Week
```{r render_ci_overview_map, echo=FALSE, fig.height=6.9, fig.width=9, message=FALSE, warning=FALSE}
```{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",
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
# 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_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) {
@ -440,29 +464,30 @@ tryCatch({ # Base shape
plot(1, type="n", axes=FALSE, xlab="", ylab="")
text(1, 1, "Error creating CI overview map", cex=1.5)
})
```
\newpage
\pagebreak
# Weekly Chlorophyll Index Difference Map
```{r render_ci_difference_map, echo=FALSE, fig.height=6.9, fig.width=9, message=FALSE, warning=FALSE}
```{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",
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
# 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_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) {
@ -471,22 +496,23 @@ tryCatch({ # Base shape
text(1, 1, "Error creating CI difference map", cex=1.5)
})
```
\newpage
\pagebreak
```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=10, message=FALSE,echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
```{r generate_field_visualizations, eval=TRUE, fig.height=4.5, fig.width=12, message=FALSE,echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
# Generate detailed visualizations for each field
tryCatch({
# Merge field polygons for processing
AllPivots_merged <- AllPivots0 %>%
dplyr::group_by(field) %>%
AllPivots_merged <- AllPivots0 %>%
dplyr::group_by(field) %>%
dplyr::summarise(.groups = 'drop')
# Generate plots for each field
purrr::walk(AllPivots_merged$field[1:5], function(field_name) {
purrr::walk(AllPivots_merged$field, function(field_name) {
tryCatch({
cat("\n") # Add an empty line for better spacing
# Call ci_plot with explicit parameters
ci_plot(
pivotName = field_name,
@ -502,9 +528,9 @@ tryCatch({
week_minus_3 = week_minus_3,
borders = borders
)
cat("\n")
# cat("\n")
# Call cum_ci_plot with explicit parameters
cum_ci_plot(
pivotName = field_name,
@ -512,7 +538,7 @@ tryCatch({
plot_type = "value",
facet_on = FALSE
)
}, error = function(e) {
safe_log(paste("Error generating plots for field", field_name, ":", e$message), "ERROR")
cat(paste("## Error generating plots for field", field_name, "\n"))
@ -529,17 +555,17 @@ tryCatch({
# Alternative visualization grouped by sub-area (disabled by default)
tryCatch({
# Group pivots by sub-area
pivots_grouped <- AllPivots0
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")
@ -548,9 +574,9 @@ tryCatch({
cum_ci_plot(field_name)
cat("\n")
})
# Add page break after each subgroup
cat("\\pagebreak\n")
cat("\\newpage\n")
}
}, error = function(e) {
safe_log(paste("Error in subarea visualization section:", e$message), "ERROR")
@ -569,39 +595,39 @@ tryCatch({
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::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() %>%
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() %>%
prediction_yields <- CI_and_yield %>%
as.data.frame() %>%
dplyr::filter(is.na(tonnage_ha))
# Configure model training parameters
ctrl <- caret::trainControl(
method = "cv",
@ -610,7 +636,7 @@ tryCatch({
number = 5,
verboseIter = TRUE
)
# Train the model with feature selection
set.seed(202) # For reproducibility
model_ffs_rf <- CAST::ffs(
@ -623,7 +649,7 @@ tryCatch({
tuneLength = 5,
na.rm = TRUE
)
# Function to prepare predictions with consistent naming and formatting
prepare_predictions <- function(predictions, newdata) {
return(predictions %>%
@ -641,17 +667,17 @@ tryCatch({
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
@ -671,23 +697,23 @@ tryCatch({
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)",
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)",
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,
knitr::kable(pred_rf_current_season,
digits = 0,
caption = "Predicted Tonnage/ha for Fields Over 300 Days Old")
} else {
@ -699,7 +725,3 @@ tryCatch({
})
```
\pagebreak

200
r_app/extract_current_versions.R Normal file
View file

@ -0,0 +1,200 @@
#' Version Extractor for SmartCane Project
#'
#' This script scans your R scripts to find all used packages and extracts
#' the currently installed versions. Use this to populate the package_manager.R
#' with your actual working versions.
#'
#' Usage:
#' source("extract_current_versions.R")
#'
#' Author: SmartCane Team
#' Date: 2025-06-24
# =============================================================================
# PACKAGE DISCOVERY
# =============================================================================
#' Extract packages from R scripts
extract_packages_from_scripts <- function(script_dir = ".") {
# Find all R files
r_files <- list.files(script_dir, pattern = "\\.(R|Rmd)$", recursive = TRUE, full.names = TRUE)
packages <- c()
for (file in r_files) {
cat("Scanning:", file, "\n")
tryCatch({
content <- readLines(file, warn = FALSE)
# Find library() calls
library_matches <- regmatches(content, regexpr('library\\(["\']?([^"\'\\)]+)["\']?\\)', content))
library_packages <- gsub('library\\(["\']?([^"\'\\)]+)["\']?\\)', '\\1', library_matches)
library_packages <- library_packages[library_packages != ""]
# Find require() calls
require_matches <- regmatches(content, regexpr('require\\(["\']?([^"\'\\)]+)["\']?\\)', content))
require_packages <- gsub('require\\(["\']?([^"\'\\)]+)["\']?\\)', '\\1', require_matches)
require_packages <- require_packages[require_packages != ""]
# Find package::function calls
namespace_matches <- regmatches(content, gregexpr('[a-zA-Z][a-zA-Z0-9.]*::', content))
namespace_packages <- unique(unlist(lapply(namespace_matches, function(x) gsub('::', '', x))))
namespace_packages <- namespace_packages[namespace_packages != ""]
packages <- c(packages, library_packages, require_packages, namespace_packages)
}, error = function(e) {
cat("Error reading", file, ":", e$message, "\n")
})
}
# Clean and deduplicate
packages <- unique(packages)
packages <- packages[!packages %in% c("", "base", "stats", "utils", "graphics", "grDevices")]
return(sort(packages))
}
#' Get current version of installed packages
get_current_versions <- function(packages) {
versions <- list()
cat("\nChecking installed versions...\n")
cat("===============================\n")
for (pkg in packages) {
if (pkg %in% rownames(installed.packages())) {
version <- as.character(packageVersion(pkg))
versions[[pkg]] <- version
cat(sprintf("✓ %-20s %s\n", pkg, version))
} else {
cat(sprintf("✗ %-20s NOT INSTALLED\n", pkg))
}
}
return(versions)
}
#' Generate package manager configuration
generate_package_config <- function(versions) {
cat("\n\nGenerating REQUIRED_PACKAGES configuration...\n")
cat("=============================================\n\n")
config_lines <- c(
"# Package requirements with your current working versions",
"REQUIRED_PACKAGES <- list("
)
# Group packages by category
categories <- list(
"Core data manipulation" = c("here", "dplyr", "tidyr", "readr", "readxl", "magrittr", "lubridate", "stringr"),
"Spatial data" = c("sf", "terra", "exactextractr", "raster", "sp", "sf", "rgdal", "rgeos"),
"Visualization" = c("tmap", "ggplot2", "RColorBrewer", "viridis", "scales"),
"Statistical analysis" = c("lme4", "nlme", "mgcv", "survival", "cluster"),
"Reporting" = c("knitr", "rmarkdown", "officedown", "officer", "flextable"),
"Tidyverse" = c("tidyverse", "purrr", "forcats", "tibble"),
"Other packages" = c()
)
# Categorize packages
categorized <- list()
uncategorized <- names(versions)
for (category in names(categories)) {
cat_packages <- intersect(names(versions), categories[[category]])
if (length(cat_packages) > 0) {
categorized[[category]] <- cat_packages
uncategorized <- setdiff(uncategorized, cat_packages)
}
}
# Add uncategorized packages
if (length(uncategorized) > 0) {
categorized[["Other packages"]] <- uncategorized
}
# Generate config
for (category in names(categorized)) {
config_lines <- c(config_lines, paste0(" # ", category))
packages_in_cat <- categorized[[category]]
for (i in seq_along(packages_in_cat)) {
pkg <- packages_in_cat[i]
version <- versions[[pkg]]
comma <- if (i == length(packages_in_cat) && category == names(categorized)[length(categorized)]) "" else ","
# Add special comment for critical packages
comment <- ""
if (pkg == "tmap") comment <- " # CRITICAL: for tm_scale_continuous() syntax"
if (pkg == "terra") comment <- " # CRITICAL: for raster processing"
config_lines <- c(config_lines, sprintf(' "%s" = "%s"%s%s', pkg, version, comma, comment))
}
if (category != names(categorized)[length(categorized)]) {
config_lines <- c(config_lines, "")
}
}
config_lines <- c(config_lines, ")")
# Print to console
cat(paste(config_lines, collapse = "\n"))
# Save to file
writeLines(config_lines, "generated_package_config.R")
cat("\n\n📁 Configuration saved to: generated_package_config.R\n")
return(config_lines)
}
# =============================================================================
# MAIN EXECUTION
# =============================================================================
main <- function() {
cat("🔍 SmartCane Package Version Extractor\n")
cat("======================================\n\n")
# Step 1: Find all packages used in scripts
cat("Step 1: Scanning R scripts for package usage...\n")
packages <- extract_packages_from_scripts()
cat("\nFound packages:\n")
cat(paste(packages, collapse = ", "), "\n")
cat("\nTotal packages found:", length(packages), "\n")
# Step 2: Get current versions
cat("\nStep 2: Checking installed versions...\n")
versions <- get_current_versions(packages)
installed_count <- length(versions)
missing_count <- length(packages) - installed_count
cat(sprintf("\n📊 Summary: %d installed, %d missing\n", installed_count, missing_count))
if (missing_count > 0) {
missing_packages <- setdiff(packages, names(versions))
cat("\n⚠️ Missing packages:\n")
cat(paste(missing_packages, collapse = ", "), "\n")
cat("\nYou may want to install these first, then re-run this script.\n")
}
# Step 3: Generate configuration
if (length(versions) > 0) {
cat("\nStep 3: Generating package manager configuration...\n")
config <- generate_package_config(versions)
cat("\n✅ Next steps:\n")
cat("1. Review generated_package_config.R\n")
cat("2. Copy the REQUIRED_PACKAGES list to package_manager.R\n")
cat("3. Adjust any versions as needed\n")
cat("4. Run package_manager.R\n")
} else {
cat("\n❌ No installed packages found. Install packages first.\n")
}
}
# Run the extraction
main()

315
r_app/package_manager.R Normal file
View file

@ -0,0 +1,315 @@
#' Package Manager for SmartCane Project
#'
#' This script manages R package versions across development, testing, and production environments.
#' It uses renv for reproducible environments and ensures consistent package versions.
#'
#' Usage:
#' source("package_manager.R")
#'
#' Author: SmartCane Team
#' Date: 2025-06-24
# =============================================================================
# CONFIGURATION
# =============================================================================
# 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",
"purrr" = "1.0.2",
"magrittr" = "2.0.0", # Adding this as it's commonly used
# Spatial data
"exactextractr" = "0.10.0",
"raster" = "3.6.32",
"sf" = "1.0.19",
"terra" = "1.8.43", # CRITICAL: for raster processing
# Visualization - CRITICAL: tmap v4 for new syntax
"ggplot2" = "3.5.1",
"tmap" = "4.0", # CRITICAL: for tm_scale_continuous() syntax
"gridExtra" = "2.3",
# Reporting
"knitr" = "1.50",
"rmarkdown" = "2.21.0", # Adding this as it's needed for reports
# Tidyverse meta-package
"tidyverse" = "2.0.0",
# Machine Learning & Statistics
"caret" = "7.0.1",
"CAST" = "1.0.3",
"randomForest" = "4.7.1.2",
"rsample" = "1.3.0",
# Parallel processing
"furrr" = "0.3.1",
"future" = "1.40.0",
"progressr" = "0.15.1",
# Other utilities
"reshape2" = "1.4.4",
"zoo" = "1.8.13"
)
# Log file setup
LOG_FILE <- file.path(getwd(), "package_manager.log")
START_TIME <- Sys.time()
# =============================================================================
# UTILITY FUNCTIONS
# =============================================================================
#' Log message to both console and file
log_message <- function(message, level = "INFO") {
timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S")
formatted_msg <- sprintf("[%s] %s - %s", level, timestamp, message)
# Print to console
cat(formatted_msg, "\n")
# Write to log file
cat(formatted_msg, "\n", file = LOG_FILE, append = TRUE)
}
#' Check if package is installed
is_package_installed <- function(package) {
package %in% rownames(installed.packages())
}
#' Get installed package version
get_package_version <- function(package) {
if (is_package_installed(package)) {
as.character(packageVersion(package))
} else {
NULL
}
}
#' Compare version strings (returns TRUE if installed >= required)
version_meets_requirement <- function(installed, required) {
if (is.null(installed)) return(FALSE)
utils::compareVersion(installed, required) >= 0
}
#' Install or update package to minimum version
install_or_update_package <- function(package, required_version) {
current_version <- get_package_version(package)
if (is.null(current_version)) {
log_message(sprintf("Installing %s (required: >= %s)", package, required_version))
tryCatch({
install.packages(package, dependencies = TRUE, quiet = TRUE)
new_version <- get_package_version(package)
log_message(sprintf("✓ Installed %s version %s", package, new_version), "SUCCESS")
return(TRUE)
}, error = function(e) {
log_message(sprintf("✗ Failed to install %s: %s", package, e$message), "ERROR")
return(FALSE)
})
} else if (!version_meets_requirement(current_version, required_version)) {
log_message(sprintf("Updating %s from %s to >= %s", package, current_version, required_version))
tryCatch({
install.packages(package, dependencies = TRUE, quiet = TRUE)
new_version <- get_package_version(package)
if (version_meets_requirement(new_version, required_version)) {
log_message(sprintf("✓ Updated %s to version %s", package, new_version), "SUCCESS")
return(TRUE)
} else {
log_message(sprintf("⚠ %s updated to %s but still below required %s", package, new_version, required_version), "WARNING")
return(FALSE)
}
}, error = function(e) {
log_message(sprintf("✗ Failed to update %s: %s", package, e$message), "ERROR")
return(FALSE)
})
} else {
log_message(sprintf("✓ %s version %s meets requirement (>= %s)", package, current_version, required_version))
return(TRUE)
}
}
# =============================================================================
# MAIN PACKAGE MANAGEMENT FUNCTIONS
# =============================================================================
#' Initialize renv if not already initialized
initialize_renv <- function() {
log_message("Checking renv initialization...")
if (!file.exists("renv.lock")) {
log_message("Initializing renv for the first time...")
if (!requireNamespace("renv", quietly = TRUE)) {
log_message("Installing renv...")
install.packages("renv")
}
renv::init()
log_message("✓ renv initialized", "SUCCESS")
} else {
log_message("✓ renv already initialized")
# Check if renv is already active by looking at the library path
if (!requireNamespace("renv", quietly = TRUE)) {
install.packages("renv")
}
# Check if we're already using the renv project library
lib_paths <- .libPaths()
if (!any(grepl("renv", lib_paths))) {
log_message("Activating renv...")
renv::activate()
log_message("✓ renv activated")
} else {
log_message("✓ renv already active")
}
}
}
#' Check and install all required packages
manage_packages <- function() {
log_message("=== PACKAGE MANAGEMENT STARTED ===")
log_message(sprintf("R version: %s", R.version.string))
success_count <- 0
failure_count <- 0
for (package in names(REQUIRED_PACKAGES)) {
required_version <- REQUIRED_PACKAGES[[package]]
if (install_or_update_package(package, required_version)) {
success_count <- success_count + 1
} else {
failure_count <- failure_count + 1
}
}
log_message(sprintf("Package management complete: %d success, %d failures", success_count, failure_count))
if (failure_count > 0) {
log_message("Some packages failed to install/update. Check log for details.", "WARNING")
}
return(failure_count == 0)
}
#' Update renv lockfile with current package versions
update_lockfile <- function() {
log_message("Updating renv lockfile...")
tryCatch({
renv::snapshot(prompt = FALSE)
log_message("✓ renv lockfile updated", "SUCCESS")
}, error = function(e) {
log_message(sprintf("✗ Failed to update lockfile: %s", e$message), "ERROR")
})
}
#' Generate package report
generate_package_report <- function() {
log_message("=== PACKAGE REPORT ===")
# Check each required package
for (package in names(REQUIRED_PACKAGES)) {
required_version <- REQUIRED_PACKAGES[[package]]
current_version <- get_package_version(package)
if (is.null(current_version)) {
status <- "❌ NOT INSTALLED"
} else if (version_meets_requirement(current_version, required_version)) {
status <- "✅ OK"
} else {
status <- "⚠️ VERSION TOO OLD"
}
log_message(sprintf("%-20s | Required: >= %-8s | Installed: %-8s | %s",
package, required_version,
ifelse(is.null(current_version), "NONE", current_version),
status))
}
log_message("=== END PACKAGE REPORT ===")
}
#' Main function to run complete package management
run_package_manager <- function() {
# Initialize log
cat("", file = LOG_FILE) # Clear log file
log_message("SmartCane Project - Package Manager Started")
log_message(sprintf("Working directory: %s", getwd()))
# Step 1: Initialize renv
initialize_renv()
# Step 2: Generate initial report
log_message("\n=== INITIAL STATE ===")
generate_package_report()
# Step 3: Manage packages
log_message("\n=== PACKAGE INSTALLATION/UPDATES ===")
success <- manage_packages()
# Step 4: Update lockfile if successful
if (success) {
update_lockfile()
}
# Step 5: Generate final report
log_message("\n=== FINAL STATE ===")
generate_package_report()
# Summary
end_time <- Sys.time()
duration <- round(as.numeric(difftime(end_time, START_TIME, units = "secs")), 2)
log_message(sprintf("Package management completed in %s seconds", duration))
log_message(sprintf("Log saved to: %s", LOG_FILE))
if (success) {
log_message("🎉 All packages successfully managed!", "SUCCESS")
log_message("📋 Next steps:")
log_message(" 1. Test your R scripts to ensure everything works")
log_message(" 2. Commit renv.lock to version control")
log_message(" 3. Share this script with your team")
} else {
log_message("⚠️ Some issues occurred. Check the log for details.", "WARNING")
log_message("💡 You may need to:")
log_message(" 1. Update R to a newer version")
log_message(" 2. Install system dependencies")
log_message(" 3. Check your internet connection")
}
return(success)
}
# =============================================================================
# EXECUTION
# =============================================================================
# Only run if script is sourced directly (not when loaded as module)
if (!exists("PACKAGE_MANAGER_LOADED")) {
PACKAGE_MANAGER_LOADED <- TRUE
cat("🚀 SmartCane Package Manager\n")
cat("============================\n")
cat("This will check and install/update all required R packages.\n")
cat("Log file:", LOG_FILE, "\n\n")
# Ask for confirmation
response <- readline("Continue? (y/N): ")
if (tolower(substr(response, 1, 1)) == "y") {
result <- run_package_manager()
if (result) {
cat("\n✅ Package management completed successfully!\n")
} else {
cat("\n❌ Package management completed with errors. Check the log.\n")
}
} else {
cat("❌ Package management cancelled.\n")
}
}

162
r_app/report_utils.R
View file

@ -73,15 +73,15 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
}
if (missing(age) || is.null(age)) {
stop("age parameter is required")
}
# Create the base map
} # Create the base map
map <- tm_shape(pivot_raster, unit = "m") # Add raster with continuous spectrum (fixed scale 1-8 for consistent comparison)
map <- map + tm_raster(col.scale = tm_scale_continuous(values = "brewer.rd_yl_gn",
limits = c(1, 8)),
col.legend = tm_legend(title = "CI",
orientation = if(legend_is_portrait) "portrait" else "landscape",
orientation = if(legend_is_portrait) "portrait" else "landscape",
show = show_legend,
position = c("left", "bottom")))
position = if(show_legend) tm_pos_out("left", "center") else c("left", "bottom")
))
# Add layout elements
map <- map + tm_layout(main.title = paste0("Max CI week ", week,"\n", age, " weeks old"),
main.title.size = 0.7)
@ -128,16 +128,16 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
}
if (missing(age) || is.null(age)) {
stop("age parameter is required")
}
# Create the base map
} # Create the base map
map <- tm_shape(pivot_raster, unit = "m") # Add raster with continuous spectrum (centered at 0 for difference maps, fixed scale)
map <- map + tm_raster(col.scale = tm_scale_continuous(values = "brewer.rd_yl_gn",
midpoint = 0,
limits = c(-3, 3)),
col.legend = tm_legend(title = "CI difference",
col.legend = tm_legend(title = "CI diff.",
orientation = if(legend_is_portrait) "portrait" else "landscape",
show = show_legend,
position = c("left", "bottom")))
position = if(show_legend) tm_pos_out("right", "center") else c("left", "bottom")
))
# Add layout elements
map <- map + tm_layout(main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks old"),
main.title.size = 0.7)
@ -159,7 +159,7 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
#'
#' @param pivotName The name or ID of the pivot field to visualize
#' @param field_boundaries Field boundaries spatial data (sf object)
#' @param current_ci Current week's Chlorophyll Index raster
#' @param current_ci Current week's Chlorophyll Index raster
#' @param ci_minus_1 Previous week's Chlorophyll Index raster
#' @param ci_minus_2 Two weeks ago Chlorophyll Index raster
#' @param last_week_diff Difference raster between current and last week
@ -172,13 +172,13 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
#' @param borders Whether to display field borders (default: TRUE)
#' @return NULL (adds output directly to R Markdown document)
#'
ci_plot <- function(pivotName,
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,
ci_plot <- function(pivotName,
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,
@ -214,66 +214,66 @@ ci_plot <- function(pivotName,
# Extract pivot shape and age data
tryCatch({
pivotShape <- field_boundaries %>% terra::subset(field %in% pivotName) %>% sf::st_transform(terra::crs(current_ci))
age <- harvesting_data %>%
dplyr::filter(field %in% pivotName) %>%
sort("year") %>%
tail(., 1) %>%
dplyr::select(age) %>%
unique() %>%
pull() %>%
age <- harvesting_data %>%
dplyr::filter(field %in% pivotName) %>%
sort("year") %>%
tail(., 1) %>%
dplyr::select(age) %>%
unique() %>%
pull() %>%
round()
# Filter for the specific pivot
AllPivots2 <- field_boundaries %>% dplyr::filter(field %in% pivotName)
# Create crop masks for different timepoints using terra functions
singlePivot <- terra::crop(current_ci, pivotShape) %>% terra::mask(., pivotShape)
singlePivot_m1 <- terra::crop(ci_minus_1, pivotShape) %>% terra::mask(., pivotShape)
singlePivot_m2 <- terra::crop(ci_minus_2, pivotShape) %>% terra::mask(., pivotShape)
# Create difference maps
abs_CI_last_week <- terra::crop(last_week_diff, pivotShape) %>% terra::mask(., pivotShape)
abs_CI_three_week <- terra::crop(three_week_diff, pivotShape) %>% terra::mask(., pivotShape)
# Get planting date
planting_date <- harvesting_data %>%
dplyr::filter(field %in% pivotName) %>%
ungroup() %>%
dplyr::select(season_start) %>%
planting_date <- harvesting_data %>%
dplyr::filter(field %in% pivotName) %>%
ungroup() %>%
dplyr::select(season_start) %>%
unique()
# Create spans for borders
joined_spans2 <- field_boundaries %>%
joined_spans2 <- field_boundaries %>%
sf::st_transform(sf::st_crs(pivotShape)) %>% dplyr::filter(field %in% pivotName)
# Create the maps for different timepoints
CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2,
show_legend = TRUE, legend_is_portrait = TRUE,
CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2,
show_legend = TRUE, legend_is_portrait = TRUE,
week = week_minus_2, age = age - 2, borders = borders)
CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2,
show_legend = FALSE, legend_is_portrait = FALSE,
CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2,
show_legend = FALSE, legend_is_portrait = FALSE,
week = week_minus_1, age = age - 1, borders = borders)
CImap <- create_CI_map(singlePivot, AllPivots2, joined_spans2,
show_legend = FALSE, legend_is_portrait = FALSE,
CImap <- create_CI_map(singlePivot, AllPivots2, joined_spans2,
show_legend = FALSE, legend_is_portrait = FALSE,
week = week, age = age, borders = borders)
# Create difference maps - only show legend on the second one to avoid redundancy
CI_max_abs_last_week <- create_CI_diff_map(abs_CI_last_week, AllPivots2, joined_spans2,
show_legend = FALSE, legend_is_portrait = FALSE,
CI_max_abs_last_week <- create_CI_diff_map(abs_CI_last_week, AllPivots2, joined_spans2,
show_legend = FALSE, legend_is_portrait = FALSE,
week_1 = week, week_2 = week_minus_1, age = age, borders = borders)
CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2,
show_legend = TRUE, legend_is_portrait = TRUE,
CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2,
show_legend = TRUE, legend_is_portrait = TRUE,
week_1 = week, week_2 = week_minus_3, age = age, borders = borders)
# Arrange the maps
tst <- tmap_arrange(CImap_m2, CImap_m1, CImap, CI_max_abs_last_week, CI_max_abs_three_week, nrow = 1)
# Arrange the maps with equal widths
tst <- tmap_arrange(CImap_m2, CImap_m1, CImap, CI_max_abs_last_week, CI_max_abs_three_week,
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"))
print(tst)
}, error = function(e) {
safe_log(paste("Error creating CI plot for pivot", pivotName, ":", e$message), "ERROR")
cat(paste("## Field", pivotName, "- Error creating visualization", "\n"))
@ -308,54 +308,54 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
# Filter data for the specified pivot
tryCatch({
data_ci <- ci_quadrant_data %>% dplyr::filter(field == pivotName)
if (nrow(data_ci) == 0) {
safe_log(paste("No CI data found for pivot", pivotName), "WARNING")
return(cum_ci_plot2(pivotName)) # Use fallback function when no data is available
}
# Process data
data_ci2 <- data_ci %>%
data_ci2 <- data_ci %>%
dplyr::mutate(CI_rate = cumulative_CI / DOY,
week = lubridate::week(Date)) %>%
week = lubridate::week(Date)) %>%
dplyr::group_by(field) %>%
dplyr::mutate(mean_CIrate_rolling_10_days = zoo::rollapplyr(CI_rate, width = 10, FUN = mean, partial = TRUE),
mean_rolling_10_days = zoo::rollapplyr(value, width = 10, FUN = mean, partial = TRUE))
data_ci2 <- data_ci2 %>% dplyr::mutate(season = as.factor(season))
# Prepare date information by season
date_preparation_perfect_pivot <- data_ci2 %>%
dplyr::group_by(season) %>%
date_preparation_perfect_pivot <- data_ci2 %>%
dplyr::group_by(season) %>%
dplyr::summarise(min_date = min(Date),
max_date = max(Date),
days = max_date - min_date)
# Get the 3 most recent seasons
unique_seasons <- sort(unique(date_preparation_perfect_pivot$season), decreasing = TRUE)[1:3]
# Determine the y aesthetic based on the plot type
y_aesthetic <- switch(plot_type,
"CI_rate" = "mean_CIrate_rolling_10_days",
"cumulative_CI" = "cumulative_CI",
"value" = "mean_rolling_10_days")
y_label <- switch(plot_type,
"CI_rate" = "10-Day Rolling Mean CI Rate (cumulative CI / age)",
"cumulative_CI" = "Cumulative CI",
"value" = "10-Day Rolling Mean CI")
# 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")
# 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)) +
@ -386,10 +386,10 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "
legend.text = ggplot2::element_text(size = 8)) +
ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
}
# Output plot to R Markdown with reduced height
subchunkify(g, 3.2, 10) # Reduced from 3.2 to 2.8
}, error = function(e) {
safe_log(paste("Error creating CI trend plot for pivot", pivotName, ":", e$message), "ERROR")
cum_ci_plot2(pivotName) # Use fallback function in case of error
@ -406,14 +406,14 @@ cum_ci_plot2 <- function(pivotName){
if (missing(pivotName) || is.null(pivotName) || pivotName == "") {
stop("pivotName is required")
}
# Create a simple plot showing "No data available"
tryCatch({
end_date <- Sys.Date()
start_date <- end_date %m-% months(11) # 11 months ago from end_date
date_seq <- seq.Date(from = start_date, to = end_date, by = "month")
midpoint_date <- start_date + (end_date - start_date) / 2
g <- ggplot() +
scale_x_date(limits = c(start_date, end_date), date_breaks = "1 month", date_labels = "%m-%Y") +
scale_y_continuous(limits = c(0, 4)) +
@ -425,9 +425,9 @@ cum_ci_plot2 <- function(pivotName){
legend.title = element_text(size = 8),
legend.text = element_text(size = 8)) +
annotate("text", x = midpoint_date, y = 2, label = "No data available", size = 6, hjust = 0.5)
subchunkify(g, 3.2, 10)
}, error = function(e) {
safe_log(paste("Error creating fallback CI plot for pivot", pivotName, ":", e$message), "ERROR")
cat(paste("No data available for field", pivotName, "\n"))
@ -449,39 +449,39 @@ get_week_path <- function(mosaic_path, input_date, week_offset) {
if (missing(input_date)) {
stop("input_date is required")
}
tryCatch({
# Convert input_date to Date object (in case it's a string)
input_date <- as.Date(input_date)
if (is.na(input_date)) {
stop("Invalid input_date. Expected a Date object or a string convertible to Date.")
}
# Validate week_offset
week_offset <- as.integer(week_offset)
if (is.na(week_offset)) {
stop("Invalid week_offset. Expected an integer value.")
}
# Get the start of the week for the input date (adjust to Monday as the start of the week)
start_of_week <- lubridate::floor_date(input_date, unit = "week", week_start = 1)
# Calculate the new date after applying the week offset
target_date <- start_of_week + lubridate::weeks(week_offset)
# Get the week number and year of the target date
target_week <- sprintf("%02d", lubridate::isoweek(target_date)) # Left-pad week number with a zero if needed
target_year <- lubridate::isoyear(target_date)
# Generate the file path for the target week
path_to_week <- here::here(mosaic_path, paste0("week_", target_week, "_", target_year, ".tif"))
# Log the path calculation
safe_log(paste("Calculated path for week", target_week, "of year", target_year, ":", path_to_week), "INFO")
# Return the path
return(path_to_week)
}, error = function(e) {
safe_log(paste("Error calculating week path:", e$message), "ERROR")
stop(e$message)

7385
renv.lock Normal file
View file

File diff suppressed because one or more lines are too long

7
renv/.gitignore vendored Normal file
View file

@ -0,0 +1,7 @@
library/
local/
cellar/
lock/
python/
sandbox/
staging/

1334
renv/activate.R Normal file
View file

File diff suppressed because it is too large Load diff

19
renv/settings.json Normal file
View file

@ -0,0 +1,19 @@
{
"bioconductor.version": null,
"external.libraries": [],
"ignored.packages": [],
"package.dependency.fields": [
"Imports",
"Depends",
"LinkingTo"
],
"ppm.enabled": null,
"ppm.ignored.urls": [],
"r.version": null,
"snapshot.type": "implicit",
"use.cache": true,
"vcs.ignore.cellar": true,
"vcs.ignore.library": true,
"vcs.ignore.local": true,
"vcs.manage.ignores": true
}