Merge branch 'code-improvements'
This commit is contained in:
Martin Folkerts
commit
cc6b9392d6
838
.Rhistory
838
.Rhistory
|
|
@ -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")
|
||||
|
|
|
|||
94
PACKAGE_MANAGEMENT.md
Normal file
94
PACKAGE_MANAGEMENT.md
Normal 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
42
generated_package_config.R
Normal 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
111
package_manager.log
Normal 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
|
||||
|
|
@ -270,7 +270,7 @@ Report Date: **`r report_date_formatted`**
|
|||
- 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")`
|
||||
|
||||
---
|
||||
|
||||
|
|
@ -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 "1-3" \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,7 +359,7 @@ 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
|
||||
|
|
@ -382,12 +409,11 @@ tryCatch({
|
|||
# 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 = c("right", "bottom"), text.color = "white") +
|
||||
tmap::tm_compass(position = c("right", "bottom"), text.color = "white") +
|
||||
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") +
|
||||
|
|
@ -413,22 +439,20 @@ 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)",
|
||||
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 = c("right", "bottom"), text.color = "black") +
|
||||
tmap::tm_compass(position = c("right", "bottom"), text.color = "black") +
|
||||
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")
|
||||
|
|
@ -440,25 +464,26 @@ 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",
|
||||
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 = c("right", "bottom"), text.color = "black") +
|
||||
tmap::tm_compass(position = c("right", "bottom"), text.color = "black") +
|
||||
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")
|
||||
|
|
@ -471,10 +496,11 @@ 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
|
||||
|
|
@ -483,7 +509,7 @@ tryCatch({
|
|||
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
|
||||
|
||||
|
|
@ -503,7 +529,7 @@ tryCatch({
|
|||
borders = borders
|
||||
)
|
||||
|
||||
cat("\n")
|
||||
# cat("\n")
|
||||
|
||||
# Call cum_ci_plot with explicit parameters
|
||||
cum_ci_plot(
|
||||
|
|
@ -550,7 +576,7 @@ tryCatch({
|
|||
})
|
||||
|
||||
# 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")
|
||||
|
|
@ -699,7 +725,3 @@ tryCatch({
|
|||
})
|
||||
```
|
||||
|
||||
|
||||
|
||||
\pagebreak
|
||||
|
||||
|
|
|
|||
200
r_app/extract_current_versions.R
Normal file
200
r_app/extract_current_versions.R
Normal 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
315
r_app/package_manager.R
Normal 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")
|
||||
}
|
||||
}
|
||||
|
|
@ -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",
|
||||
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)
|
||||
|
|
@ -266,9 +266,9 @@ ci_plot <- function(pivotName,
|
|||
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"))
|
||||
|
|
|
|||
7
renv/.gitignore
vendored
Normal file
7
renv/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
library/
|
||||
local/
|
||||
cellar/
|
||||
lock/
|
||||
python/
|
||||
sandbox/
|
||||
staging/
|
||||
1334
renv/activate.R
Normal file
1334
renv/activate.R
Normal file
File diff suppressed because it is too large
Load diff
19
renv/settings.json
Normal file
19
renv/settings.json
Normal 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
|
||||
}
|
||||
Loading…
Reference in a new issue