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

Refactor KPI reporting functions; update directory parameters for historical data loading and fix historical data for four weeks trend

Browse source
This commit is contained in:
DimitraVeropoulou 2026-02-23 13:38:41 +01:00
parent 55d67ef503
commit d4553693e6
3 changed files with 68 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

98
r_app/80_utils_agronomic_support.R
View file

@ -793,10 +793,14 @@ calculate_all_field_analysis_agronomic_support <- function(
# Safely identify immediate child directories (not including root)
# Use list.files + dir.exists filter instead of list.dirs for robustness
all_entries <- list.files(current_mosaic_dir, full.names = FALSE)
field_dirs <- all_entries[sapply(
file.path(current_mosaic_dir, all_entries),
dir.exists
)]
# Validate input and coerce-safe checks
if (is.null(current_mosaic_dir) || !is.character(current_mosaic_dir) || length(current_mosaic_dir) != 1) {
stop("current_mosaic_dir must be a single path string")
}
paths <- file.path(current_mosaic_dir, all_entries)
# Use vapply to guarantee a logical vector (avoid sapply returning a list)
is_dir <- vapply(paths, dir.exists, logical(1))
field_dirs <- all_entries[is_dir]
is_per_field <- length(field_dirs) > 0 &&
file.exists(file.path(current_mosaic_dir, field_dirs[1], week_file))
@ -942,12 +946,10 @@ calculate_all_field_analysis_agronomic_support <- function(
# Load historical field statistics to build weekly mean CI time series per field
# (growth_decline_kpi expects temporal series, not spatial pixel arrays)
weekly_mean_ci_by_field <- list()
# Build list of weekly mean CI values for each field (4-week lookback)
for (field_idx in seq_len(nrow(field_boundaries_sf))) {
weekly_ci_values <- c()
}
# Initialize list with one element per field (empty numeric vectors)
n_fields <- nrow(field_boundaries_sf)
weekly_mean_ci_by_field <- vector("list", n_fields)
for (fi in seq_len(n_fields)) weekly_mean_ci_by_field[[fi]] <- numeric(0)
# Try to load historical data for trend calculation
if (!is.null(output_dir) && !is.null(project_dir)) {
@ -956,7 +958,7 @@ calculate_all_field_analysis_agronomic_support <- function(
project_dir = project_dir,
current_week = current_week,
current_year = current_year,
reports_dir = output_dir,
kpi_reports_dir = output_dir,
num_weeks = 4,
auto_generate = FALSE,
field_boundaries_sf = field_boundaries_sf
@ -965,35 +967,61 @@ calculate_all_field_analysis_agronomic_support <- function(
if (!is.null(historical_data) && length(historical_data) > 0) {
message(" Building weekly mean CI time series from historical data...")
# Initialize list with empty vectors for each field
for (field_idx in seq_len(nrow(field_boundaries_sf))) {
weekly_mean_ci_by_field[[field_idx]] <- c()
}
# Extract Mean_CI from each historical week (reverse order to go chronologically)
possible_mean_cols <- c("Mean_CI", "mean_ci", "MeanCI", "meanCI", "mean.ci")
possible_id_cols <- c("Field_id", "field_id", "Field", "field", "Field_name", "field_name")
for (hist_idx in rev(seq_along(historical_data))) {
hist_week <- historical_data[[hist_idx]]
hist_data <- hist_week$data
# Extract Mean_CI column if available
if ("Mean_CI" %in% names(hist_data)) {
# Match fields between historical data and field_boundaries
for (field_idx in seq_len(nrow(field_boundaries_sf))) {
field_name <- field_boundaries_sf$field[field_idx]
# Find matching row in historical data by field name/ID
field_row <- which(
(hist_data$Field_id == field_name | hist_data$Field_name == field_name) &
!is.na(hist_data$Mean_CI)
)
if (length(field_row) > 0) {
mean_ci_val <- as.numeric(hist_data$Mean_CI[field_row[1]])
if (!is.na(mean_ci_val)) {
weekly_mean_ci_by_field[[field_idx]] <- c(weekly_mean_ci_by_field[[field_idx]], mean_ci_val)
}
# Skip empty week data
if (is.null(hist_data) || length(hist_data) == 0) next
# Coerce to data.frame if needed
if (!is.data.frame(hist_data)) {
hist_data <- tryCatch(as.data.frame(hist_data, stringsAsFactors = FALSE), error = function(e) NULL)
}
if (is.null(hist_data) || !is.data.frame(hist_data)) next
mean_col <- intersect(possible_mean_cols, names(hist_data))
if (length(mean_col) == 0) {
message(paste0(" Warning: historical week ", hist_week$week, "_", hist_week$year, " missing Mean_CI column - skipping"))
next
}
mean_col <- mean_col[1]
id_col <- intersect(possible_id_cols, names(hist_data))
use_row_order <- FALSE
if (length(id_col) == 0) {
if (nrow(hist_data) == n_fields) {
use_row_order <- TRUE
} else {
message(paste0(" Warning: historical week ", hist_week$week, "_", hist_week$year, " has no id/name column and rowcount != n_fields - skipping"))
next
}
} else {
id_col <- id_col[1]
}
# Normalize to character columns for matching
hist_df <- as.data.frame(hist_data, stringsAsFactors = FALSE)
hist_df[[mean_col]] <- as.character(hist_df[[mean_col]])
if (!use_row_order) hist_df[[id_col]] <- as.character(hist_df[[id_col]])
for (field_idx in seq_len(n_fields)) {
mean_ci_val <- NA_real_
if (use_row_order) {
if (field_idx <= nrow(hist_df)) {
mean_ci_val <- suppressWarnings(as.numeric(hist_df[[mean_col]][field_idx]))
}
} else {
fid <- as.character(field_boundaries_sf$field[field_idx])
matches <- which(!is.na(hist_df[[id_col]]) & hist_df[[id_col]] == fid)
if (length(matches) > 0) {
mean_ci_val <- suppressWarnings(as.numeric(hist_df[[mean_col]][matches[1]]))
}
}
if (!is.na(mean_ci_val)) weekly_mean_ci_by_field[[field_idx]] <- c(weekly_mean_ci_by_field[[field_idx]], mean_ci_val)
}
}
@ -1138,7 +1166,7 @@ calculate_all_field_analysis_agronomic_support <- function(
project_dir = project_dir
)
message(paste("\n✓ AURA KPI calculation complete. Week", current_week, current_year))
message(paste("\n✓ KPI calculation complete. Week", current_week, current_year))
return(list(
field_analysis_df = field_detail_df,

4
r_app/80_utils_common.R
View file

@ -1066,7 +1066,7 @@ load_or_calculate_weekly_stats <- function(week_num, year, project_dir, field_bo
}
#' Load historical field data from CSV (4-week lookback)
load_historical_field_data <- function(project_dir, current_week, current_year, reports_dir, num_weeks = 4, auto_generate = TRUE, field_boundaries_sf = NULL, daily_vals_dir = NULL) {
load_historical_field_data <- function(project_dir, current_week, current_year, kpi_reports_dir, num_weeks = 4, auto_generate = TRUE, field_boundaries_sf = NULL, daily_vals_dir = NULL) {
historical_data <- list()
loaded_weeks <- c()
@ -1078,7 +1078,7 @@ load_historical_field_data <- function(project_dir, current_week, current_year,
target_year <- target$year
csv_filename <- paste0(project_dir, "_field_analysis_week", sprintf("%02d_%d", target_week, target_year), ".csv")
csv_path <- file.path(reports_dir, "field_analysis", csv_filename)
csv_path <- file.path(kpi_reports_dir, csv_filename)
if (file.exists(csv_path)) {
tryCatch({

5
r_app/parameters_project.R
View file

@ -52,7 +52,8 @@ CLIENT_TYPE_MAP <- list(
"simba" = "agronomic_support",
"john" = "agronomic_support",
"huss" = "agronomic_support",
"aura" = "agronomic_support"
"aura" = "agronomic_support",
"tpc" = "agronomic_support"
)
#' Get client type for a project
@ -186,7 +187,7 @@ setup_project_directories <- function(project_dir, data_source = "merged_tif") {
extracted_ci_base_dir, daily_ci_vals_dir, cumulative_ci_vals_dir, ci_for_python_dir,
growth_model_interpolated_dir,
weekly_mosaic_dir, weekly_tile_max_dir,
reports_dir, kpi_reports_dir, kpi_field_stats_dir, kpi_field_analysis_dir,
reports_dir, kpi_reports_dir,
data_dir, vrt_dir, harvest_dir, log_dir
)