message("No project_dir provided. Using default:", project_dir)
}
# Make project_dir available globally so parameters_project.R can use it
assign("project_dir", project_dir, envir = .GlobalEnv)
# Initialize project configuration and load utility functions
tryCatch({
source("parameters_project.R")
source("growth_model_utils.R")
}, error = function(e) {
warning("Default source files not found. Attempting to source from 'r_app' directory.")
tryCatch({
source(here::here("r_app", "parameters_project.R"))
source(here::here("r_app", "growth_model_utils.R"))
warning(paste("Successfully sourced files from 'r_app' directory."))
}, error = function(e) {
stop("Failed to source required files from both default and 'r_app' directories.")
})
})
log_message("Starting CI growth model interpolation")
# Load and process the data
tryCatch({
# Load the combined CI data
CI_data <- load_combined_ci_data(cumulative_CI_vals_dir)
# Validate harvesting data
if (is.null(harvesting_data) || nrow(harvesting_data) == 0) {
stop("No harvesting data available")
}
# Get the years from harvesting data
years <- harvesting_data %>%
filter(!is.na(season_start)) %>%
distinct(year) %>%
pull(year)
log_message(paste("Processing data for years:", paste(years, collapse = ", ")))
# Generate interpolated CI data for each year and field
CI_all <- generate_interpolated_ci_data(years, harvesting_data, CI_data)
# Calculate growth metrics and save the results
if (nrow(CI_all) > 0) {
# Add daily and cumulative metrics
CI_all_with_metrics <- calculate_growth_metrics(CI_all)
# Save the processed data
save_growth_model(
CI_all_with_metrics,
cumulative_CI_vals_dir,
"All_pivots_Cumulative_CI_quadrant_year_v2.rds"
)
} else {
log_message("No CI data was generated after interpolation", level = "WARNING")
}
log_message("Growth model interpolation completed successfully")
}, error = function(e) {
log_message(paste("Error in growth model interpolation:", e$message), level = "ERROR")
stop(e$message)
})
View(CI_all_with_metrics)
View(CI_data)
# Get the years from harvesting data
years <- harvesting_data %>%
filter(!is.na(season_start)) %>%
distinct(year) %>%
pull(year)
years
View(CI_all)
View(CI_all_with_metrics)
years
harvesting_data
ci_data
ci_data = CI_data
# Process each year
result <- purrr::map_df(years, function(yr) {
safe_log(paste("Processing year:", yr))
# Get the fields harvested in this year with valid season start dates
sub_fields <- harvesting_data %>%
dplyr::filter(year == yr, !is.na(season_start)) %>%
dplyr::pull(sub_field)
if (length(sub_fields) == 0) {
safe_log(paste("No fields with valid season data for year:", yr), "WARNING")
return(data.frame())
}
# Filter sub_fields to only include those with value data in ci_data
valid_sub_fields <- sub_fields %>%
purrr::keep(~ any(ci_data$sub_field == .x))
if (length(valid_sub_fields) == 0) {
safe_log(paste("No fields with CI data for year:", yr), "WARNING")
return(data.frame())
}
# Extract and interpolate data for each valid field
safe_log(paste("Processing", length(valid_sub_fields), "fields for year:", yr))
result <- purrr::map(valid_sub_fields, ~ extract_CI_data(.x,
harvesting_data = harvesting_data,
field_CI_data = ci_data,
season = yr)) %>%
purrr::list_rbind()
safe_log(paste("Generated", nrow(result), "interpolated data points for year:", yr))
return(result)
})
CI_all_with_metrics
CI_all <- CI_all %>%
group_by(Date, field, season) %>%
filter(!(field == "00F25" & season == 2023 & duplicated(DOY)))
View(CI_all)
# Add daily and cumulative metrics
CI_all_with_metrics <- calculate_growth_metrics(CI_all)
# Save the processed data
save_growth_model(
CI_all_with_metrics,
cumulative_CI_vals_dir,
"All_pivots_Cumulative_CI_quadrant_year_v2.rds"
)
# Set up basic report parameters from input values
report_date <- params$report_date
mail_day <- params$mail_day
borders <- params$borders
ci_plot_type <- params$ci_plot_type
colorblind_friendly <- params$colorblind_friendly
facet_by_season <- params$facet_by_season
x_axis_unit <- params$x_axis_unit
# Configure knitr options
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
# Load all packages at once with suppressPackageStartupMessages
suppressPackageStartupMessages({
library(here)
library(sf)
library(terra)
library(exactextractr)
library(tidyverse)
library(tmap)
library(lubridate)
library(zoo)
library(rsample)
library(caret)
library(randomForest)
library(CAST)
library(knitr)
library(tidyr)
})
# 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)
})
})
# Set the project directory from parameters
project_dir <- params$data_dir
# Source project parameters with error handling
tryCatch({
source(here::here("r_app", "parameters_project.R"))
}, error = function(e) {
stop("Error loading parameters_project.R: ", e$message)
})
# Log initial configuration
safe_log("Starting the R Markdown script with KPIs")
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))
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path("laravel_app", "storage", "app", project_dir, "reports", "kpis")
date_suffix <- format(as.Date(report_date), "%Y%m%d")
# Candidate filenames we expect (exact and common variants)
expected_summary_names <- c(
paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
paste0(project_dir, "_kpi_summary_tables.rds"),
"kpi_summary_tables.rds",
paste0("kpi_summary_tables_", date_suffix, ".rds")
)
expected_field_details_names <- c(
paste0(project_dir, "_field_details_", date_suffix, ".rds"),
paste0(project_dir, "_field_details.rds"),
"field_details.rds"
)
# Helper to attempt loading a file from the directory or fallback to a workspace-wide search
try_load_from_dir <- function(dir, candidates) {
if (!dir.exists(dir)) return(NULL)
for (name in candidates) {
f <- file.path(dir, name)
if (file.exists(f)) return(f)
}
return(NULL)
}
# Try primary directory first
summary_file <- try_load_from_dir(kpi_data_dir, expected_summary_names)
field_details_file <- try_load_from_dir(kpi_data_dir, expected_field_details_names)
# If not found, perform a workspace-wide search (slower) limited to laravel_app storage
if (is.null(summary_file) || is.null(field_details_file)) {
safe_log(paste("KPI files not found in", kpi_data_dir, "—searching workspace for RDS files"))
# List rds files under laravel_app/storage/app recursively
files <- list.files(path = file.path("laravel_app", "storage", "app"), pattern = "\\.rds$", recursive = TRUE, full.names = TRUE)
# Try to match by expected names
if (is.null(summary_file)) {
matched <- files[basename(files) %in% expected_summary_names]
if (length(matched) > 0) summary_file <- matched[1]
}
if (is.null(field_details_file)) {
matched2 <- files[basename(files) %in% expected_field_details_names]
if (length(matched2) > 0) field_details_file <- matched2[1]
}
}
# Final checks and load with safe error messages
kpi_files_exist <- FALSE
if (!is.null(summary_file) && file.exists(summary_file)) {
safe_log(paste("Loading KPI summary from:", summary_file))
summary_tables <- tryCatch(readRDS(summary_file), error = function(e) { safe_log(paste("Failed to read summary RDS:", e$message), "ERROR"); NULL })
if (!is.null(summary_tables)) kpi_files_exist <- TRUE
} else {
safe_log(paste("KPI summary file not found. Searched:", paste(expected_summary_names, collapse=", ")), "WARNING")
}
if (!is.null(field_details_file) && file.exists(field_details_file)) {
safe_log(paste("Loading field details from:", field_details_file))
field_details_table <- tryCatch(readRDS(field_details_file), error = function(e) { safe_log(paste("Failed to read field details RDS:", e$message), "ERROR"); NULL })
if (!is.null(field_details_table)) kpi_files_exist <- kpi_files_exist && TRUE
} else {
safe_log(paste("Field details file not found. Searched:", paste(expected_field_details_names, collapse=", ")), "WARNING")
}
if (kpi_files_exist) {
safe_log("✓ KPI summary tables loaded successfully")
} else {
safe_log("KPI files could not be located or loaded. KPI sections will be skipped.", "WARNING")
}
# Set locale for consistent date formatting
Sys.setlocale("LC_TIME", "C")
# Initialize date variables from parameters
today <- as.character(report_date)
mail_day_as_character <- as.character(mail_day)
# Calculate report dates and weeks
report_date_obj <- as.Date(today)
current_week <- as.numeric(format(report_date_obj, "%U"))
year <- as.numeric(format(report_date_obj, "%Y"))
# Calculate dates for weekly analysis
week_start <- report_date_obj - ((as.numeric(format(report_date_obj, "%w")) + 1) %% 7)
week_end <- week_start + 6
# Calculate week days (copied from 05 script for compatibility)
report_date_as_week_day <- weekdays(lubridate::ymd(today))
days_of_week <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
# Calculate initial week number
week <- lubridate::week(today) - 1
safe_log(paste("Initial week calculation:", week, "today:", today))
# Calculate previous dates for comparisons
today_minus_1 <- as.character(lubridate::ymd(today) - 7)
today_minus_2 <- as.character(lubridate::ymd(today) - 14)
today_minus_3 <- as.character(lubridate::ymd(today) - 21)
# Adjust week calculation based on mail day
if (which(days_of_week == report_date_as_week_day) > which(days_of_week == mail_day_as_character)) {
safe_log("Adjusting weeks because of mail day")
week <- lubridate::week(today) + 1
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)
}
# Calculate week numbers for previous weeks
week_minus_1 <- week - 1
week_minus_2 <- week - 2
week_minus_3 <- week - 3
# Format current week with leading zeros
week <- sprintf("%02d", week)
safe_log(paste("Report week:", current_week, "Year:", year))
safe_log(paste("Week range:", week_start, "to", week_end))
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path("laravel_app", "storage", "app", project_dir, "reports", "kpis")
date_suffix <- format(as.Date(report_date), "%Y%m%d")
# Candidate filenames we expect (exact and common variants)
expected_summary_names <- c(
paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
paste0(project_dir, "_kpi_summary_tables.rds"),
"kpi_summary_tables.rds",
paste0("kpi_summary_tables_", date_suffix, ".rds")
)
expected_field_details_names <- c(
paste0(project_dir, "_field_details_", date_suffix, ".rds"),
paste0(project_dir, "_field_details.rds"),
"field_details.rds"
)
# Helper to attempt loading a file from the directory or fallback to a workspace-wide search
try_load_from_dir <- function(dir, candidates) {
if (!dir.exists(dir)) return(NULL)
for (name in candidates) {
f <- file.path(dir, name)
if (file.exists(f)) return(f)
}
return(NULL)
}
# Try primary directory first
summary_file <- try_load_from_dir(kpi_data_dir, expected_summary_names)
field_details_file <- try_load_from_dir(kpi_data_dir, expected_field_details_names)
# If not found, perform a workspace-wide search (slower) limited to laravel_app storage
if (is.null(summary_file) || is.null(field_details_file)) {
safe_log(paste("KPI files not found in", kpi_data_dir, "—searching workspace for RDS files"))
# List rds files under laravel_app/storage/app recursively
files <- list.files(path = file.path("laravel_app", "storage", "app"), pattern = "\\.rds$", recursive = TRUE, full.names = TRUE)
# Try to match by expected names
if (is.null(summary_file)) {
matched <- files[basename(files) %in% expected_summary_names]
if (length(matched) > 0) summary_file <- matched[1]
}
if (is.null(field_details_file)) {
matched2 <- files[basename(files) %in% expected_field_details_names]
if (length(matched2) > 0) field_details_file <- matched2[1]
}
}
# Final checks and load with safe error messages
kpi_files_exist <- FALSE
if (!is.null(summary_file) && file.exists(summary_file)) {
safe_log(paste("Loading KPI summary from:", summary_file))
summary_tables <- tryCatch(readRDS(summary_file), error = function(e) { safe_log(paste("Failed to read summary RDS:", e$message), "ERROR"); NULL })
if (!is.null(summary_tables)) kpi_files_exist <- TRUE
} else {
safe_log(paste("KPI summary file not found. Searched:", paste(expected_summary_names, collapse=", ")), "WARNING")
}
if (!is.null(field_details_file) && file.exists(field_details_file)) {
safe_log(paste("Loading field details from:", field_details_file))
field_details_table <- tryCatch(readRDS(field_details_file), error = function(e) { safe_log(paste("Failed to read field details RDS:", e$message), "ERROR"); NULL })
if (!is.null(field_details_table)) kpi_files_exist <- kpi_files_exist && TRUE
} else {
safe_log(paste("Field details file not found. Searched:", paste(expected_field_details_names, collapse=", ")), "WARNING")
}
if (kpi_files_exist) {
safe_log("✓ KPI summary tables loaded successfully")
} else {
safe_log("KPI files could not be located or loaded. KPI sections will be skipped.", "WARNING")
}
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path("laravel_app", "storage", "app", project_dir, "reports", "kpis")
kpi_data_dir
kpi_data_dir
## SIMPLE KPI LOADING - robust lookup with fallbacks
# Primary expected directory inside the laravel storage
kpi_data_dir <- file.path(here("laravel_app", "storage", "app", project_dir, "reports", "kpis"))
kpi_data_dir
# Candidate filenames we expect (exact and common variants)
expected_summary_names <- c(
paste0(project_dir, "_kpi_summary_tables_", date_suffix, ".rds"),
paste0(project_dir, "_kpi_summary_tables.rds"),
"kpi_summary_tables.rds",
paste0("kpi_summary_tables_", date_suffix, ".rds")
)
expected_field_details_names <- c(
paste0(project_dir, "_field_details_", date_suffix, ".rds"),
paste0(project_dir, "_field_details.rds"),
"field_details.rds"
)
# Helper to attempt loading a file from the directory or fallback to a workspace-wide search
try_load_from_dir <- function(dir, candidates) {
if (!dir.exists(dir)) return(NULL)
for (name in candidates) {
f <- file.path(dir, name)
if (file.exists(f)) return(f)
}
return(NULL)
}
# Try primary directory first
summary_file <- try_load_from_dir(kpi_data_dir, expected_summary_names)
field_details_file <- try_load_from_dir(kpi_data_dir, expected_field_details_names)
# If not found, perform a workspace-wide search (slower) limited to laravel_app storage
if (is.null(summary_file) || is.null(field_details_file)) {
safe_log(paste("KPI files not found in", kpi_data_dir, "—searching workspace for RDS files"))
# List rds files under laravel_app/storage/app recursively
files <- list.files(path = file.path("laravel_app", "storage", "app"), pattern = "\\.rds$", recursive = TRUE, full.names = TRUE)
# Try to match by expected names
if (is.null(summary_file)) {
matched <- files[basename(files) %in% expected_summary_names]
if (length(matched) > 0) summary_file <- matched[1]
}
if (is.null(field_details_file)) {
matched2 <- files[basename(files) %in% expected_field_details_names]
if (length(matched2) > 0) field_details_file <- matched2[1]
}
}
# Final checks and load with safe error messages
kpi_files_exist <- FALSE
if (!is.null(summary_file) && file.exists(summary_file)) {
safe_log(paste("Loading KPI summary from:", summary_file))
summary_tables <- tryCatch(readRDS(summary_file), error = function(e) { safe_log(paste("Failed to read summary RDS:", e$message), "ERROR"); NULL })
if (!is.null(summary_tables)) kpi_files_exist <- TRUE
} else {
safe_log(paste("KPI summary file not found. Searched:", paste(expected_summary_names, collapse=", ")), "WARNING")
}
summary_file
kpi_data_dir
library(officer)
library(flextable)
# Data setup
summary_tables <- list()
summary_tables$field_uniformity_summary <- data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)
summary_tables$weed_presence_summary <- data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
doc <- body_add_par(doc, "Executive Summary - Key Performance Indicators", style = "heading 2")
doc <- body_add_par(doc, "This section demonstrates just two KPI tables side by side.", style = "Normal")
doc <- body_add_section(doc, prop_section(
section_type = "continuous",
columns = columns(widths = c(4.25, 4.25))
))
doc <- body_add_flextable(doc, flextable(summary_tables$field_uniformity_summary) %>% set_caption("Field Uniformity Summary"))
doc <- body_add_break(doc, "column")
doc <- body_add_flextable(doc, flextable(summary_tables$weed_presence_summary) %>% set_caption("Weed Presence Score Summary"))
doc <- body_add_section(doc, prop_section(
section_type = "continuous",
columns = columns(widths = c(8.5))
))
doc <- body_add_par(doc, "This is a test report to verify the KPI grid layout.", style = "Normal")
print(doc, target = "tables_side_by_side.docx")
here()
getwd()
print(doc, target = "tables_side_by_side.docx")
doc
print(doc, target = "tables_side_by_side.docx")
print(doc, target = "r_app/tables_side_by_side.docx")
library(officer)
library(flextable)
# Create example data
summary_tables <- list()
summary_tables$field_uniformity_summary <- data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)
summary_tables$weed_presence_summary <- data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)
# Create document
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
doc <- body_add_par(doc, "Executive Summary - Key Performance Indicators", style = "heading 2")
doc <- body_add_par(doc, "This section demonstrates just two KPI tables side by side.", style = "Normal")
# Two-column section
doc <- body_add_section(doc, prop_section(
section_type = "continuous",
columns = columns(widths = c(4.25, 4.25))
))
library(officer)
library(flextable)
# Create example data
summary_tables <- list()
summary_tables$field_uniformity_summary <- data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)
summary_tables$weed_presence_summary <- data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)
# Create document
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
doc <- body_add_par(doc, "Executive Summary - Key Performance Indicators", style = "heading 2")
doc <- body_add_par(doc, "This section demonstrates just two KPI tables side by side.", style = "Normal")
# Two-column section
doc <- body_add_section(doc, prop_section(
section_type = "continuous",
columns = columns(widths = c(4.25, 4.25))
))
packageVersion("officer")
??body_add_section
library(officer)
?body_add_section
library(officer)
library(flextable)
# Create example data
ft1 <- flextable(data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)) %>% set_caption("Field Uniformity Summary")
ft2 <- flextable(data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)) %>% set_caption("Weed Presence Score Summary")
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
library(dplyr)
# Create example data
ft1 <- flextable(data.frame(
"Uniformity Level" = c("Excellent", "Good", "Poor"),
"Count" = c(15, 8, 3),
"Percent" = c("62.5%", "33.3%", "12.5%")
)) %>% set_caption("Field Uniformity Summary")
ft2 <- flextable(data.frame(
"Weed Risk Level" = c("Low", "Moderate", "High"),
"Field Count" = c(18, 6, 2),
"Percent" = c("75.0%", "25.0%", "8.3%")
)) %>% set_caption("Weed Presence Score Summary")
doc <- read_docx()
doc <- body_add_par(doc, "KPI Grid Test Report", style = "heading 1")
doc <- body_add_par(doc, "Executive Summary - Key Performance Indicators", style = "heading 2")
doc <- body_add_par(doc, "This section demonstrates two KPI tables side by side.", style = "Normal")
# Create a Word table (1 row, 2 columns)
doc <- body_add_table(doc, value = data.frame(A = "", B = ""), style = "Table Grid")
# Move cursor to first cell, insert first flextable
doc <- cursor_forward(doc)
doc <- slip_in_flextable(doc, ft1, pos = "on")
# Move cursor to second cell, insert second flextable
doc <- cursor_forward(doc)