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

Merge pull request #13 from TimonWeitkamp:operational_run

Browse source 
Enhance trend calculation with historical data and linear regression
This commit is contained in:
Timon Weitkamp 2026-02-19 08:30:52 +01:00 committed by GitHub
parent aaea7f62c7 d4078fbffd
commit 5d462dad63
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
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)
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) {
field_name <- field_boundaries_sf$field[field_idx]
matching_row <- which(
(current_stats$Field_id == field_name | current_stats$Field_name == field_name) &
!is.na(current_stats$Mean_CI)
)
if (length(matching_row) > 0) {
weekly_mean_ci_by_field[[field_idx]] <- c(as.numeric(current_stats$Mean_CI[matching_row[1]]))
} else {
weekly_mean_ci_by_field[[field_idx]] <- NA_real_
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"
)
#