Merge pull request #14 from TimonWeitkamp/review_perField_code
Growth trend
This commit is contained in:
GitHub
commit
29c1e77d06
|
|
@ -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))
|
||||
|
|
@ -906,12 +910,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)) {
|
||||
|
|
@ -920,7 +922,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
|
||||
|
|
@ -929,35 +931,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)
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1168,7 +1196,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,
|
||||
|
|
|
|||
|
|
@ -1063,7 +1063,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()
|
||||
|
|
@ -1075,7 +1075,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({
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue