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

Enhance trend calculation by loading historical data from RDS cache and using linear regression for slope determination

Browse source
This commit is contained in:
Timon 2026-02-18 17:04:05 +01:00
parent aaea7f62c7
commit d4078fbffd
3 changed files with 107 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

80
r_app/80_utils_agronomic_support.R
View file

@ -1006,24 +1006,90 @@ calculate_all_field_analysis_agronomic_support <- function(
# If no historical data available, create empty vectors (will result in "Insufficient data")
if (length(weekly_mean_ci_by_field) == 0 || all(sapply(weekly_mean_ci_by_field, length) == 0)) {
message(" Warning: No historical weekly CI data available - using current week only")
message(" Warning: No historical weekly CI data available - attempting to load from RDS cache...")
# LOAD HISTORICAL WEEKS FOR TREND CALCULATION (4-week and 8-week analysis)
# Try to load previous weeks from cache (same as cane_supply workflow)
ci_values_4week_per_field <- list()
for (field_idx in seq_len(nrow(field_boundaries_sf))) {
# Use current week mean CI as single-point series (insufficient for trend)
if (!is.null(current_stats) && nrow(current_stats) > 0) {
ci_values_4week <- numeric()
field_name <- field_boundaries_sf$field[field_idx]
# Load up to 4 previous weeks
for (lookback in 3:0) {
target_week <- current_week - lookback
target_year <- current_year
if (target_week < 1) {
target_week <- target_week + 52
target_year <- target_year - 1
}
# Try to load from cached RDS files
if (!is.null(output_dir)) {
rds_filename <- sprintf("%s_field_analysis_week%02d_%d.rds", project_dir, target_week, target_year)
rds_path <- file.path(output_dir, rds_filename)
# Normalize path safely (for cases where file may not exist yet)
rds_path_normalized <- tryCatch(
normalizePath(rds_path, winslash = "/"),
error = function(e) rds_path # Fall back to original path if normalizePath fails
)
message(paste(" Trying to load:", rds_path_normalized))
if (file.exists(rds_path_normalized)) {
tryCatch({
rds_content <- readRDS(rds_path_normalized)
# RDS files are saved as lists with 'field_analysis' key (not 'field_data')
if (is.list(rds_content) && "field_analysis" %in% names(rds_content)) {
cached_data <- rds_content$field_analysis
} else if (is.list(rds_content) && "field_data" %in% names(rds_content)) {
# Fallback for older RDS format
cached_data <- rds_content$field_data
} else if (is.data.frame(rds_content)) {
cached_data <- rds_content
} else {
cached_data <- NULL
}
if (!is.null(cached_data) && is.data.frame(cached_data) && "Mean_CI" %in% names(cached_data)) {
matching_row <- which(cached_data$Field_id == field_name | cached_data$Field_name == field_name)
if (length(matching_row) > 0 && !is.na(cached_data$Mean_CI[matching_row[1]])) {
ci_val <- as.numeric(cached_data$Mean_CI[matching_row[1]])
message(paste(" ✓ Loaded week", target_week, "CI =", ci_val))
ci_values_4week <- c(ci_values_4week, ci_val)
}
}
}, error = function(e) {
message(paste(" Error loading:", e$message))
})
}
}
}
# Add current week CI
if (!is.null(current_stats) && nrow(current_stats) > 0) {
matching_row <- which(
(current_stats$Field_id == field_name | current_stats$Field_name == field_name) &
!is.na(current_stats$Mean_CI)
)
if (length(matching_row) > 0) {
weekly_mean_ci_by_field[[field_idx]] <- c(as.numeric(current_stats$Mean_CI[matching_row[1]]))
} else {
weekly_mean_ci_by_field[[field_idx]] <- NA_real_
ci_val <- as.numeric(current_stats$Mean_CI[matching_row[1]])
message(paste(" ✓ Loaded current week CI =", ci_val))
ci_values_4week <- c(ci_values_4week, ci_val)
}
} else {
}
ci_values_4week_per_field[[field_idx]] <- ci_values_4week
}
# Use 4-week CI series for trend calculation (or current week if unavailable)
for (field_idx in seq_len(nrow(field_boundaries_sf))) {
weekly_mean_ci_by_field[[field_idx]] <- ci_values_4week_per_field[[field_idx]]
if (length(weekly_mean_ci_by_field[[field_idx]]) == 0) {
weekly_mean_ci_by_field[[field_idx]] <- NA_real_
}
}
message(paste(" ✓ Loaded trend data for", sum(sapply(weekly_mean_ci_by_field, length) > 0), "fields"))
}
# Calculate growth decline using weekly time series (not spatial pixel arrays)

40
r_app/80_utils_common.R
View file

@ -332,8 +332,12 @@ calculate_four_week_trend <- function(mean_ci_values) {
return(NA_real_)
}
trend <- ci_clean[length(ci_clean)] - ci_clean[1]
return(round(trend, 2))
# Use linear regression slope (like agronomic_support workflow) instead of simple difference
weeks <- seq_along(ci_clean)
lm_fit <- lm(ci_clean ~ weeks)
slope <- coef(lm_fit)["weeks"]
return(round(as.numeric(slope), 3))
}
#' Categorize CV slope (8-week regression) into field uniformity interpretation
@ -1166,12 +1170,22 @@ calculate_kpi_trends <- function(current_stats, prev_stats = NULL,
target_year <- target_year - 1
}
rds_filename <- sprintf("%s_field_stats_week%02d_%d.rds", project_dir, target_week, target_year)
rds_path <- file.path(reports_dir, "field_stats", rds_filename)
rds_filename <- sprintf("%s_field_analysis_week%02d_%d.rds", project_dir, target_week, target_year)
rds_path <- file.path(reports_dir, rds_filename)
if (file.exists(rds_path)) {
tryCatch({
stats_data <- readRDS(rds_path)
rds_content <- readRDS(rds_path)
# RDS files are saved as lists with 'field_analysis' key (or 'field_data' for legacy formats)
if (is.list(rds_content) && "field_analysis" %in% names(rds_content)) {
stats_data <- rds_content$field_analysis
} else if (is.list(rds_content) && "field_data" %in% names(rds_content)) {
stats_data <- rds_content$field_data
} else if (is.data.frame(rds_content)) {
stats_data <- rds_content
} else {
stop("Unexpected RDS structure")
}
historical_4weeks[[length(historical_4weeks) + 1]] <- list(week = target_week, stats = stats_data)
}, error = function(e) {
message(paste(" Warning: Could not load week", target_week, ":", e$message))
@ -1187,12 +1201,22 @@ calculate_kpi_trends <- function(current_stats, prev_stats = NULL,
target_year <- target_year - 1
}
rds_filename <- sprintf("%s_field_stats_week%02d_%d.rds", project_dir, target_week, target_year)
rds_path <- file.path(reports_dir, "field_stats", rds_filename)
rds_filename <- sprintf("%s_field_analysis_week%02d_%d.rds", project_dir, target_week, target_year)
rds_path <- file.path(reports_dir, rds_filename)
if (file.exists(rds_path)) {
tryCatch({
stats_data <- readRDS(rds_path)
rds_content <- readRDS(rds_path)
# RDS files are saved as lists with 'field_analysis' key (or 'field_data' for legacy formats)
if (is.list(rds_content) && "field_analysis" %in% names(rds_content)) {
stats_data <- rds_content$field_analysis
} else if (is.list(rds_content) && "field_data" %in% names(rds_content)) {
stats_data <- rds_content$field_data
} else if (is.data.frame(rds_content)) {
stats_data <- rds_content
} else {
stop("Unexpected RDS structure")
}
historical_8weeks[[length(historical_8weeks) + 1]] <- list(week = target_week, stats = stats_data)
}, error = function(e) {
# Silently skip

4
r_app/MANUAL_PIPELINE_RUNNER.R
View file

@ -438,8 +438,8 @@
# rmarkdown::render(
rmarkdown::render(
"r_app/90_CI_report_with_kpis_agronomic_support.Rmd",
params = list(data_dir = "aura", report_date = as.Date("2026-02-04")),
output_file = "SmartCane_Report_agronomic_support_aura_2026-02-04.docx",
params = list(data_dir = "aura", report_date = as.Date("2026-02-18")),
output_file = "SmartCane_Report_agronomic_support_aura_2026-02-18.docx",
output_dir = "laravel_app/storage/app/aura/reports"
)
#