diff --git a/python_app/.gitignore b/python_app/.gitignore index 5199317..4fca4c8 100644 --- a/python_app/.gitignore +++ b/python_app/.gitignore @@ -39,7 +39,6 @@ dist/ *.bak *.swp *.swo -*.swp *.png diff --git a/r_app/80_utils_cane_supply.R b/r_app/80_utils_cane_supply.R index 2d3a7a7..ad2cdf5 100644 --- a/r_app/80_utils_cane_supply.R +++ b/r_app/80_utils_cane_supply.R @@ -49,14 +49,14 @@ calculate_field_acreages <- function(field_boundaries_sf) { ) # Calculate area for valid geometries - for (idx in which(lookup_df$geometry_valid)) { + valid_indices <- which(lookup_df$geometry_valid) + areas_ha <- vapply(valid_indices, function(idx) { tryCatch({ area_m2 <- as.numeric(sf::st_area(field_boundaries_sf[idx, ])) - lookup_df$area_ha[idx] <- area_m2 / 10000 - }, error = function(e) { - lookup_df$area_ha[idx] <<- NA_real_ - }) - } + area_m2 / 10000 + }, error = function(e) NA_real_) + }, numeric(1)) + lookup_df$area_ha[valid_indices] <- areas_ha # Convert hectares to acres lookup_df %>% diff --git a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd index 7411e33..0aa02f7 100644 --- a/r_app/90_CI_report_with_kpis_agronomic_support.Rmd +++ b/r_app/90_CI_report_with_kpis_agronomic_support.Rmd @@ -3,7 +3,7 @@ params: ref: "word-styles-reference-var1.docx" output_file: "CI_report.docx" report_date: !r Sys.Date() - data_dir: "angata" + data_dir: "aura" mail_day: "Wednesday" borders: FALSE ci_plot_type: "both" @@ -61,6 +61,10 @@ suppressPackageStartupMessages({ library(officer) # For Word document manipulation (custom formatting, headers, footers) }) +# Configure tmap for static plotting (required for legend.outside to work) +tmap_mode("plot") # CRITICAL: Must be "plot" mode for legends outside to render properly +tmap_options(component.autoscale = FALSE) + # Load custom utility functions tryCatch({ source("report_utils.R") @@ -271,6 +275,8 @@ if (exists("summary_tables") && !is.null(summary_tables)) { } else { safe_log("WARNING: summary_tables is NULL or does not exist", "WARNING") } + +# summary_tables # Uncomment for debugging ``` ```{r calculate_dates_and_weeks, message=FALSE, warning=FALSE, include=FALSE} @@ -388,6 +394,15 @@ if (!is.null(CI_quadrant) && nrow(CI_quadrant) > 0) { } ``` + +::: {custom-style="Cover_title" style="text-align:center; margin-top:120px;"} +Satellite Based Field Reporting +::: + +::: {custom-style="Cover_subtitle" style="text-align:center; margin-top:18px;"} +Chlorophyll Index (CI) Monitoring Report — `r toupper(params$data_dir)` Farm (Week `r { rd <- params$report_date; rd <- if (inherits(rd, "Date")) rd else suppressWarnings(as.Date(rd)); if (is.na(rd)) rd <- Sys.Date(); if (!is.null(params$week)) params$week else format(rd, '%V') }`, `r { rd <- params$report_date; rd <- if (inherits(rd, "Date")) rd else suppressWarnings(as.Date(rd)); if (is.na(rd)) rd <- Sys.Date(); format(rd, '%Y') }`) +::: + ## Report Summary **Farm Location:** `r toupper(project_dir)` Estate @@ -404,7 +419,7 @@ if (!is.null(CI_quadrant) && nrow(CI_quadrant) > 0) { ## Key Insights -```{r key_insights, echo=TRUE, message=TRUE, warning=TRUE, results='asis'} +```{r key_insights, echo=FALSE, results='asis'} # Calculate key insights from KPI data if (exists("summary_tables") && !is.null(summary_tables) && length(summary_tables) > 0) { @@ -414,8 +429,7 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table if (!is.null(summary_tables$uniformity) && nrow(summary_tables$uniformity) > 0) { cat("**Field Uniformity:**\n") uniformity_counts <- summary_tables$uniformity %>% - group_by(interpretation) %>% - summarise(count = n(), .groups = 'drop') + dplyr::select(interpretation, count = field_count) for (i in seq_len(nrow(uniformity_counts))) { status <- uniformity_counts$interpretation[i] @@ -430,8 +444,7 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table if (!is.null(summary_tables$area_change) && nrow(summary_tables$area_change) > 0) { cat("\n**Area Change Status:**\n") area_counts <- summary_tables$area_change %>% - group_by(interpretation) %>% - summarise(count = n(), .groups = 'drop') + dplyr::select(interpretation, count = field_count) for (i in seq_len(nrow(area_counts))) { status <- area_counts$interpretation[i] @@ -446,10 +459,9 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table if (!is.null(summary_tables$growth_decline) && nrow(summary_tables$growth_decline) > 0) { cat("\n**Growth Trends (4-Week):**\n") growth_counts <- summary_tables$growth_decline %>% - group_by(trend_interpretation) %>% - summarise(count = n(), .groups = 'drop') + dplyr::select(trend_interpretation, count = field_count) - for (i in 1:nrow(growth_counts)) { + for (i in seq_len(nrow(growth_counts))) { trend <- growth_counts$trend_interpretation[i] count <- growth_counts$count[i] if (!is.na(trend) && !is.na(count) && count > 0) { @@ -462,8 +474,7 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table if (!is.null(summary_tables$weed_pressure) && nrow(summary_tables$weed_pressure) > 0) { cat("\n**Weed/Pest Pressure Risk:**\n") weed_counts <- summary_tables$weed_pressure %>% - group_by(weed_pressure_risk) %>% - summarise(count = n(), .groups = 'drop') + dplyr::select(weed_pressure_risk, count = field_count) for (i in seq_len(nrow(weed_counts))) { risk <- weed_counts$weed_pressure_risk[i] @@ -475,7 +486,7 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table } # 5. Total fields analyzed - total_fields <- nrow(summary_tables$uniformity) + total_fields <- sum(summary_tables$uniformity$field_count, na.rm = TRUE) cat("\n**Total Fields Analyzed:** ", total_fields, "\n", sep="") } else { @@ -515,11 +526,11 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table dplyr::transmute( Level = as.character(.data[[level_col]]), Count = as.integer(round(as.numeric(.data[[count_col]]))), - Percent = dplyr::if_else( - is.na(total), - NA_real_, + Percent = if (is.na(total)) { + NA_real_ + } else { round(Count / total * 100, 1) - ) + } ) } @@ -554,21 +565,22 @@ if (exists("summary_tables") && !is.null(summary_tables) && length(summary_table if (nrow(combined_df) > 0) { combined_df <- combined_df %>% + dplyr::mutate(KPI_group = KPI) %>% dplyr::group_by(KPI) %>% dplyr::mutate( KPI_display = if_else(dplyr::row_number() == 1, KPI, "") ) %>% - dplyr::ungroup() %>% + dplyr::ungroup() + + kpi_group_sizes <- rle(combined_df$KPI_group)$lengths + + display_df <- combined_df %>% dplyr::select(KPI = KPI_display, Level, Count, Percent) - ft <- flextable(combined_df) %>% + ft <- flextable(display_df) %>% merge_v(j = "KPI") %>% autofit() - kpi_group_sizes <- combined_df %>% - dplyr::group_by(KPI) %>% - dplyr::tally() %>% - dplyr::pull(n) cum_rows <- cumsum(kpi_group_sizes) for (i in seq_along(cum_rows)) { if (i < length(cum_rows)) { @@ -603,7 +615,7 @@ generate_field_alerts <- function(field_details_table) { } # Check for required columns - required_cols <- c("Field", "Field Size (ha)", "Growth Uniformity", "Yield Forecast (t/ha)", + required_cols <- c("Field", "Field Size (acres)", "Growth Uniformity", "Yield Forecast (t/ha)", "Gap Score", "Decline Risk", "Weed Risk", "Mean CI", "CV Value", "Moran's I") missing_cols <- setdiff(required_cols, colnames(field_details_table)) @@ -623,7 +635,7 @@ generate_field_alerts <- function(field_details_table) { # Aggregate data for the field field_summary <- field_data %>% summarise( - field_size = sum(`Field Size (ha)`, na.rm = TRUE), + field_size = sum(`Field Size (acres)`, na.rm = TRUE), uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"), avg_yield_forecast = mean(`Yield Forecast (t/ha)`, na.rm = TRUE), max_gap_score = max(`Gap Score`, na.rm = TRUE), @@ -765,7 +777,7 @@ if (!exists("field_details_table") || is.null(field_details_table)) { # Try to calculate field sizes (area) from geometry if available field_sizes <- if (!is.null(sf::st_geometry(AllPivots0)) && !all(sf::st_is_empty(sf::st_geometry(AllPivots0)))) { - sf::st_area(sf::st_geometry(AllPivots0)) / 10000 # Convert m² to hectares + sf::st_area(sf::st_geometry(AllPivots0)) / 4046.86 # Convert m² to acres (1 acre = 4046.86 m²) } else { rep(NA_real_, length(field_names)) } @@ -773,7 +785,7 @@ if (!exists("field_details_table") || is.null(field_details_table)) { # Create minimal field details table with actual data we have + NAs for missing KPI columns field_details_table <- tibble::tibble( Field = field_names, - `Field Size (ha)` = as.numeric(field_sizes), + `Field Size (acres)` = as.numeric(field_sizes), `Growth Uniformity` = NA_character_, `Yield Forecast (t/ha)` = NA_real_, `Gap Score` = NA_real_, @@ -791,8 +803,6 @@ if (!exists("field_details_table") || is.null(field_details_table)) { } ``` -## Farm-Level Overview Maps - ```{r aggregate_farm_level_rasters, message=FALSE, warning=FALSE, include=FALSE} # Aggregate per-field weekly mosaics into single farm-level rasters for visualization # This creates on-the-fly mosaics for current week and historical weeks without saving intermediate files @@ -939,9 +949,8 @@ tryCatch({ ``` \newpage -### Chlorophyll Index (CI) Overview Map - Current Week -```{r render_farm_ci_map, echo=FALSE, message=FALSE, warning=FALSE, fig.height=5.5, fig.width=6.5, dpi=150, dev='png', message=FALSE, warning=FALSE} +```{r render_farm_ci_map, echo=FALSE, message=FALSE, warning=FALSE, fig.height=6.8, fig.width=8.5, dpi=150, dev='png'} # Create farm-level chlorophyll index map with OpenStreetMap basemap tryCatch({ if (!is.null(farm_ci_current_ll)) { @@ -1015,13 +1024,13 @@ tryCatch({ map <- map + # Add scale bar and theme ggspatial::annotation_scale( - location = "br", + location = "tr", width_hint = 0.25 ) + ggplot2::theme_void() + ggplot2::theme( - legend.position = "bottom", - legend.direction = "horizontal", + legend.position = "right", + legend.direction = "vertical", legend.title = ggplot2::element_text(size = 10), legend.text = ggplot2::element_text(size = 9), plot.title = ggplot2::element_text(hjust = 0.5, size = 12, face = "bold"), @@ -1047,10 +1056,7 @@ tryCatch({ }) ``` -\newpage -### Weekly Chlorophyll Index Difference Map - -```{r render_farm_ci_diff_map, echo=FALSE, fig.height=5.5, fig.width=6.5, dpi=150, dev='png', message=FALSE, warning=FALSE} +```{r render_farm_ci_diff_map, echo=FALSE, message=FALSE, warning=FALSE, fig.height=6.8, fig.width=8.5, dpi=150, dev='png'} # Create farm-level CI difference map (week-over-week change) tryCatch({ if (!is.null(farm_ci_diff_week_ll)) { @@ -1125,13 +1131,13 @@ tryCatch({ map <- map + # Add scale bar and theme ggspatial::annotation_scale( - location = "br", + location = "tr", width_hint = 0.25 ) + ggplot2::theme_void() + ggplot2::theme( - legend.position = "bottom", - legend.direction = "horizontal", + legend.position = "right", + legend.direction = "vertical", legend.title = ggplot2::element_text(size = 10), legend.text = ggplot2::element_text(size = 9), plot.title = ggplot2::element_text(hjust = 0.5, size = 12, face = "bold"), @@ -1157,8 +1163,6 @@ tryCatch({ }) ``` -\newpage - # Section 2: Field-by-Field Analysis ## Overview of Field-Level Insights @@ -1174,33 +1178,10 @@ This section provides detailed, field-specific analyses including chlorophyll in \newpage -```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=6.5, dpi=150, dev='png', message=TRUE, echo=FALSE, warning=TRUE, include=TRUE, results='asis'} +```{r generate_field_visualizations, echo=FALSE, fig.height=3.8, fig.width=10, dev='png', dpi=150, results='asis'} # Generate detailed visualizations for each field using purrr::walk -# DIAGNOSTIC MODE - Remove this after debugging -cat("\n## DIAGNOSTIC: Starting field visualization processing\n\n") tryCatch({ - # Check prerequisites - cat("- Fields to process:", nrow(AllPivots_merged), "\n") - cat("- Field names:", paste(AllPivots_merged$field, collapse = ", "), "\n") - cat("- Weekly mosaic directory:", weekly_CI_mosaic, "\n") - cat("- CI quadrant data available:", !is.null(CI_quadrant), "\n") - cat("- Harvesting data available:", !is.null(harvesting_data), "\n\n") - - # Check if ci_plot function exists - if (!exists("ci_plot")) { - cat("**ERROR: ci_plot() function not found!**\n\n") - stop("ci_plot function missing") - } - - if (!exists("cum_ci_plot")) { - cat("**ERROR: cum_ci_plot() function not found!**\n\n") - stop("cum_ci_plot function missing") - } - - cat("- ci_plot() function:", "FOUND", "\n") - cat("- cum_ci_plot() function:", "FOUND", "\n\n") - # Prepare merged field list and week/year info AllPivots_merged <- AllPivots0 %>% dplyr::filter(!is.na(field), !is.na(sub_field)) %>% @@ -1227,9 +1208,7 @@ tryCatch({ # Helper function to safely load per-field mosaic if it exists load_per_field_mosaic <- function(base_dir, field_name, week, year) { path <- file.path(base_dir, field_name, paste0("week_", sprintf("%02d", week), "_", year, ".tif")) - cat(paste(" [DEBUG] Field:", field_name, "trying path:", path, "\n")) if (file.exists(path)) { - cat(paste(" ✓ File found\n")) tryCatch({ rast_obj <- terra::rast(path) # Extract CI band if present, otherwise first band @@ -1242,8 +1221,6 @@ tryCatch({ message(paste("Warning: Could not load", path, ":", e$message)) return(NULL) }) - } else { - cat(paste(" ✗ File NOT found\n")) } return(NULL) } @@ -1254,7 +1231,7 @@ tryCatch({ tryCatch({ # Add page break before each field (except first) if (!is_first_field) { - cat("\\newpage\n\n") + cat("\\newpage\n") } is_first_field <<- FALSE @@ -1301,7 +1278,7 @@ tryCatch({ borders = borders, colorblind_friendly = colorblind_friendly ) - cat("\n\n") + #cat("\n\n") } else { message(paste("Warning: No raster data found for field", field_name)) } @@ -1332,20 +1309,51 @@ tryCatch({ benchmark_percentiles = c(10, 50, 90), benchmark_data = benchmarks ) - cat("\n\n") + #cat("\n") } # Add field-specific KPI summary if available - # NOTE: generate_field_kpi_summary function not yet implemented - # Skipping field-level KPI text for now; KPI tables are available in Section 1 - if (FALSE) { # Disabled pending function implementation - # if (exists("field_details_table") && !is.null(field_details_table) && nrow(field_details_table) > 0) { - # kpi_summary <- generate_field_kpi_summary(field_name, field_details_table, CI_quadrant) - # if (!is.null(kpi_summary)) { - # cat(kpi_summary) - # cat("\n\n") - # } - # } + if (exists("field_details_table") && !is.null(field_details_table) && nrow(field_details_table) > 0) { + field_kpi <- field_details_table %>% + dplyr::filter(Field_id == field_name) + + if (nrow(field_kpi) > 0) { + # Format KPIs as compact single line (no interpretations, just values) + kpi_parts <- c( + sprintf("**CV:** %.2f", field_kpi$CV), + sprintf("**Mean CI:** %.2f", field_kpi$Mean_CI) + ) + + # Add Weekly_CI_Change if available (note: capital C and I) + if (!is.null(field_kpi$Weekly_CI_Change) && !is.na(field_kpi$Weekly_CI_Change)) { + change_sign <- ifelse(field_kpi$Weekly_CI_Change >= 0, "+", "") + kpi_parts <- c(kpi_parts, sprintf("**Δ CI:** %s%.2f", change_sign, field_kpi$Weekly_CI_Change)) + } + + # Compact trend display with symbols + trend_compact <- case_when( + grepl("Strong growth", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↑↑", + grepl("Growth|Increasing", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↑", + grepl("Stable|No growth", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "→", + grepl("Slight decline", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↓", + grepl("Strong decline|Severe", field_kpi$Trend_Interpretation, ignore.case = TRUE) ~ "↓↓", + TRUE ~ field_kpi$Trend_Interpretation + ) + kpi_parts <- c(kpi_parts, sprintf("**Trend:** %s", trend_compact)) + + if (!is.na(field_kpi$TCH_Forecasted) && field_kpi$TCH_Forecasted > 0) { + kpi_parts <- c(kpi_parts, sprintf("**Yield:** %.1f t/ha", field_kpi$TCH_Forecasted)) + } + + kpi_parts <- c( + kpi_parts, + sprintf("**Gap:** %.0f", field_kpi$Gap_Score), + sprintf("**Weed:** %s", field_kpi$Weed_Pressure_Risk), + sprintf("**Decline:** %s", field_kpi$Decline_Severity) + ) + + cat(paste(kpi_parts, collapse = " | "), "\n") + } } }, error = function(e) { @@ -1396,90 +1404,96 @@ tryCatch({ ``` \newpage -## KPI Summary by Field - -## Detailed Field Performance Summary +## Detailed Field Performance Summary by Field The following table provides a comprehensive overview of all monitored fields with their key performance metrics from the KPI analysis. ```{r detailed_field_table, echo=FALSE, results='asis'} # Detailed field performance table -report_date_obj <- as.Date(report_date) -# Initialize empty dataframe for field_ages if CI_quadrant is unavailable -field_ages <- data.frame(Field = character(), Age_days = numeric()) - -# Try to get field ages from CI quadrant if available -if (!is.null(CI_quadrant) && nrow(CI_quadrant) > 0) { - tryCatch({ - # Identify the current season for each field based on report_date - current_seasons <- CI_quadrant %>% - filter(Date <= report_date_obj) %>% - group_by(field, season) %>% - summarise( - season_start = min(Date), - season_end = max(Date), - .groups = 'drop' - ) %>% - group_by(field) %>% - filter(season == max(season)) %>% - select(field, season) - - # Get current field ages (most recent DOY for each field in their CURRENT SEASON only) - field_ages <- CI_quadrant %>% - inner_join(current_seasons, by = c("field", "season")) %>% - group_by(field) %>% - filter(DOY == max(DOY)) %>% - select(field, DOY) %>% - rename(Field = field, Age_days = DOY) - }, error = function(e) { - safe_log(paste("Error extracting field ages:", e$message), "WARNING") - }) -} else { - safe_log("CI quadrant data unavailable - field ages will not be included in detailed table", "WARNING") -} - -# Transform field_details_table to display format with proper column names if (!exists("field_details_table") || is.null(field_details_table) || nrow(field_details_table) == 0) { safe_log("No field details available for table", "WARNING") cat("No field-level KPI data available for this report period.\n") } else { - # Map raw KPI columns to display names - field_details_clean <- field_details_table %>% + # Calculate field sizes from boundaries (convert to acres) + field_sizes_source <- if (exists("AllPivots_merged") && inherits(AllPivots_merged, "sf")) AllPivots_merged else AllPivots0 + field_sizes_df <- field_sizes_source %>% mutate( - Field = Field_id, - `Field Size (ha)` = NA_real_, # Not available in KPI output, would need to come from boundaries - `Growth Uniformity` = Uniformity_Interpretation, - `Yield Forecast (t/ha)` = TCH_Forecasted, - `Gap Score` = Gap_Score, - `Decline Risk` = Decline_Severity, - `Weed Risk` = Weed_Pressure_Risk, - `Mean CI` = Mean_CI, - `CV Value` = CV + field_size_acres = as.numeric(sf::st_area(geometry) / 4046.86) # m² to acres ) %>% - left_join(field_ages, by = "Field") %>% + sf::st_drop_geometry() %>% + select(field, field_size_acres) + + # Get field ages from CI quadrant if available + field_ages_df <- if (!is.null(CI_quadrant) && nrow(CI_quadrant) > 0) { + tryCatch({ + # Get current season and age for each field + CI_quadrant %>% + filter(Date <= as.Date(report_date)) %>% + group_by(field, season) %>% + summarise(last_date = max(Date), last_doy = max(DOY), .groups = 'drop') %>% + group_by(field) %>% + filter(season == max(season)) %>% + select(field, Age_days = last_doy) + }, error = function(e) { + data.frame(field = character(), Age_days = numeric()) + }) + } else { + data.frame(field = character(), Age_days = numeric()) + } + + # Join field sizes and ages to KPI data, simplified column selection + field_details_clean <- field_details_table %>% + left_join(field_sizes_df, by = c("Field_id" = "field")) %>% + left_join(field_ages_df, by = c("Field_id" = "field")) %>% mutate( # Only show yield forecast for fields >= 240 days old - `Yield Forecast (t/ha)` = if_else(is.na(Age_days) | Age_days < 240, - NA_real_, - `Yield Forecast (t/ha)`), + TCH_Forecasted = if_else(is.na(Age_days) | Age_days < 240, NA_real_, TCH_Forecasted), # Round numeric columns - `Mean CI` = round(`Mean CI`, 2), - `CV Value` = round(`CV Value`, 2), - `Gap Score` = round(`Gap Score`, 0), - `Yield Forecast (t/ha)` = round(`Yield Forecast (t/ha)`, 1) - ) %>% - select(Field, `Field Size (ha)`, `Growth Uniformity`, `Yield Forecast (t/ha)`, - `Gap Score`, `Decline Risk`, `Weed Risk`, `Mean CI`, `CV Value`) + field_size_acres = round(field_size_acres, 1), + Mean_CI = round(Mean_CI, 2), + CV = round(CV, 2), + Gap_Score = round(Gap_Score, 0), + TCH_Forecasted = round(TCH_Forecasted, 1) + ) - # Display the cleaned field table with flextable - col_widths <- c(0.97, 0.73, 0.80, 0.80, 0.65, 0.73, 0.65, 0.56, 0.48) + # Add Weekly_CI_Change if it exists in the data (note: capital C and I) + if ("Weekly_CI_Change" %in% names(field_details_clean)) { + field_details_clean <- field_details_clean %>% + mutate(Weekly_CI_Change = round(Weekly_CI_Change, 2)) %>% + select( + Field = Field_id, + `Field Size (acres)` = field_size_acres, + `Growth Uniformity` = Uniformity_Interpretation, + `Mean CI` = Mean_CI, + `Weekly CI Change` = Weekly_CI_Change, + `Yield Forecast (t/ha)` = TCH_Forecasted, + `Gap Score` = Gap_Score, + `Decline Risk` = Decline_Severity, + `Weed Risk` = Weed_Pressure_Risk, + `CV Value` = CV + ) + } else { + field_details_clean <- field_details_clean %>% + select( + Field = Field_id, + `Field Size (acres)` = field_size_acres, + `Growth Uniformity` = Uniformity_Interpretation, + `Mean CI` = Mean_CI, + `Yield Forecast (t/ha)` = TCH_Forecasted, + `Gap Score` = Gap_Score, + `Decline Risk` = Decline_Severity, + `Weed Risk` = Weed_Pressure_Risk, + `CV Value` = CV + ) + } + # Display the cleaned field table with flextable (fit to page width) ft <- flextable(field_details_clean) %>% set_caption("Detailed Field Performance Summary") %>% - width(width = col_widths) %>% - theme_booktabs() + theme_booktabs() %>% + set_table_properties(width = 1, layout = "autofit") # Fit to 100% page width with auto-adjust knit_print(ft) } @@ -1595,4 +1609,4 @@ ft <- flextable(metadata_info) %>% ft ``` -*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team.* \ No newline at end of file +*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team at info@smartcane.ag.* \ No newline at end of file diff --git a/r_app/91_CI_report_with_kpis_cane_supply.Rmd b/r_app/91_CI_report_with_kpis_cane_supply.Rmd index 085476d..3536556 100644 --- a/r_app/91_CI_report_with_kpis_cane_supply.Rmd +++ b/r_app/91_CI_report_with_kpis_cane_supply.Rmd @@ -2,7 +2,7 @@ params: ref: "word-styles-reference-var1.docx" output_file: CI_report.docx - report_date: "2025-09-30" + report_date: "2026-02-04" data_dir: "angata" mail_day: "Wednesday" borders: FALSE @@ -61,6 +61,10 @@ suppressPackageStartupMessages({ library(flextable) # For formatted tables in Word output (professional table styling) }) +# Configure tmap for static plotting (required for legend.outside to work) +tmap_mode("plot") # CRITICAL: Must be "plot" mode for legends outside to render properly +tmap_options(component.autoscale = FALSE) + # Load custom utility functions tryCatch({ source("r_app/report_utils.R") @@ -1043,4 +1047,4 @@ ft <- flextable(metadata_info) %>% ft ``` -*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team.* \ No newline at end of file +*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team at info@smartcane.ag.* \ No newline at end of file diff --git a/r_app/MANUAL_PIPELINE_RUNNER.R b/r_app/MANUAL_PIPELINE_RUNNER.R index b2c20db..7ea203e 100644 --- a/r_app/MANUAL_PIPELINE_RUNNER.R +++ b/r_app/MANUAL_PIPELINE_RUNNER.R @@ -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("2022-12-08")), - output_file = "SmartCane_Report_agronomic_support_aura_2022-12-08.docx", + params = list(data_dir = "aura", report_date = as.Date("2026-02-04")), + output_file = "SmartCane_Report_agronomic_support_aura_2026-02-04.docx", output_dir = "laravel_app/storage/app/aura/reports" ) # @@ -450,7 +450,7 @@ rmarkdown::render( rmarkdown::render( "r_app/91_CI_report_with_kpis_cane_supply.Rmd", params = list(data_dir = "angata", report_date = as.Date("2026-02-04")), - output_file = "SmartCane_Report_basemap_test.docx", + output_file = "SmartCane_Report_cane_supply_angata_2026-02-04.docx", output_dir = "laravel_app/storage/app/angata/reports" ) # diff --git a/r_app/report_utils.R b/r_app/report_utils.R index 855d78c..f4346a6 100644 --- a/r_app/report_utils.R +++ b/r_app/report_utils.R @@ -24,7 +24,7 @@ subchunkify <- function(g, fig_height=7, fig_width=5) { "\n`","`` ") - cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE)) + cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE)) } #' Creates a Chlorophyll Index map for a pivot @@ -34,12 +34,13 @@ subchunkify <- function(g, fig_height=7, fig_width=5) { #' @param pivot_spans Additional boundary data for the field #' @param show_legend Whether to show the legend (default: FALSE) #' @param legend_is_portrait Whether to show the legend in portrait orientation (default: FALSE) +#' @param legend_position Position for the legend when shown: "left", "right", "top", "bottom" (default: "bottom") #' @param week Week number to display in the title #' @param age Age of the crop in weeks #' @param borders Whether to display field borders (default: FALSE) #' @return A tmap object with the CI map #' -create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week, age, borders = FALSE, colorblind = FALSE){ +create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, legend_position = "bottom", week, age, borders = FALSE, colorblind = FALSE){ # Input validation if (missing(pivot_raster) || is.null(pivot_raster)) { stop("pivot_raster is required") @@ -64,26 +65,29 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = map <- tm_shape(pivot_raster, unit = "m") # Add raster with continuous spectrum (fixed scale 8-1 for consistent comparison, reversed) - map <- map + tm_raster("CI", - col_scale = tm_scale_continuous(values = palette, - limits = c(1,8)), - col_legend = tm_legend(title = "CI", - orientation = if(legend_is_portrait) "portrait" else "landscape", - show = show_legend, - position = if(show_legend) tm_pos_out("left", "center") else c("left", "bottom"), - reverse = TRUE - )) + map <- map + tm_raster( + "CI", + col.scale = tm_scale_continuous( + values = palette, + limits = c(1, 8), + ticks = seq(1, 8, by = 1), + outliers.trunc = c(TRUE, TRUE) + ), + col.legend = tm_legend( + title = "CI", + orientation = if (legend_is_portrait) "portrait" else "landscape", + show = show_legend, + position = if (show_legend) tm_pos_out(legend_position, "center") else c("left", "bottom"), + reverse = TRUE + ) + ) # Add layout elements - map <- map + tm_title(text = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"), - size = 0.7) - # Add layout configuration to prevent legend rescaling - map <- map + tm_layout(legend.position = c("left", "bottom"), - legend.outside = FALSE, - inner.margins = 0.05, - asp = 1) # Force 1:1 aspect ratio for consistent sizing - - # Add bounds/view settings for fixed aspect ratio - map <- map + tm_view(asp = 1) + map <- map + tm_layout( + main.title = paste0("Max CI week ", week,"\n", age, " weeks (", age * 7, " days) old"), + main.title.size = 0.7, + #legend.height = 0.85, # Constrain vertical legend height to not exceed map + asp = 1 # Fixed aspect ratio + ) # Add borders if requested if (borders) { @@ -105,13 +109,14 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = #' @param pivot_spans Additional boundary data for the field #' @param show_legend Whether to show the legend (default: FALSE) #' @param legend_is_portrait Whether to show the legend in portrait orientation (default: FALSE) +#' @param legend_position Position for the legend when shown: "left", "right", "top", "bottom" (default: "bottom") #' @param week_1 First week number for comparison #' @param week_2 Second week number for comparison #' @param age Age of the crop in weeks #' @param borders Whether to display field borders (default: TRUE) #' @return A tmap object with the CI difference map #' -create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week_1, week_2, age, borders = TRUE, colorblind = FALSE){ +create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, legend_position = "bottom", week_1, week_2, age, borders = TRUE, colorblind = FALSE){ # Input validation if (missing(pivot_raster) || is.null(pivot_raster)) { stop("pivot_raster is required") @@ -136,27 +141,30 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege map <- tm_shape(pivot_raster, unit = "m") # Add raster with continuous spectrum (centered at 0 for difference maps, fixed scale, reversed) - map <- map + tm_raster("CI", - col_scale = tm_scale_continuous(values = palette, - midpoint = 0, - limits = c(-3, 3)), - col_legend = tm_legend(title = "CI diff.", - orientation = if(legend_is_portrait) "portrait" else "landscape", - show = show_legend, - position = if(show_legend) tm_pos_out("right", "center") else c("left", "bottom"), - reverse = TRUE - )) + map <- map + tm_raster( + "CI", + col.scale = tm_scale_continuous( + values = palette, + limits = c(-3, 3), + ticks = seq(-3, 3, by = 1), + midpoint = 0, + outliers.trunc = c(TRUE, TRUE) + ), + col.legend = tm_legend( + title = "CI diff.", + orientation = if (legend_is_portrait) "portrait" else "landscape", + show = show_legend, + position = if (show_legend) tm_pos_out(legend_position, "center") else c("left", "bottom"), + reverse = TRUE + ) + ) # Add layout elements - map <- map + tm_title(text = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks (", age * 7, " days) old"), - size = 0.7) - # Add layout configuration to prevent legend rescaling - map <- map + tm_layout(legend.position = c("right", "bottom"), - legend.outside = FALSE, - inner.margins = 0.05, - asp = 1) # Force 1:1 aspect ratio for consistent sizing - - # Add bounds/view settings for fixed aspect ratio - map <- map + tm_view(asp = 1) + map <- map + tm_layout( + main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks (", age * 7, " days) old"), + main.title.size = 0.7, + #legend.height = 0.85, # Constrain vertical legend height to not exceed map + asp = 1 # Fixed aspect ratio + ) # Add borders if requested if (borders) { @@ -271,18 +279,16 @@ ci_plot <- function(pivotName, # Create historical maps only if data is available # Build list with all available maps - order matches original: [m2, m1, current, diff_1w, diff_3w] - # Widths match original hardcoded: c(0.23, 0.18, 0.18, 0.18, 0.23) maps_to_arrange <- list() - widths_to_use <- c() field_heading_note <- "" # Try to create 2-week ago map (legend on left) if (!is.null(singlePivot_m2)) { CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2, show_legend = TRUE, legend_is_portrait = TRUE, + legend_position = "left", week = week_minus_2, age = age - 2, borders = borders, colorblind = colorblind_friendly) maps_to_arrange <- c(maps_to_arrange, list(CImap_m2)) - widths_to_use <- c(widths_to_use, 0.24) } # Try to create 1-week ago map @@ -291,12 +297,10 @@ ci_plot <- function(pivotName, show_legend = FALSE, legend_is_portrait = FALSE, week = week_minus_1, age = age - 1, borders = borders, colorblind = colorblind_friendly) maps_to_arrange <- c(maps_to_arrange, list(CImap_m1)) - widths_to_use <- c(widths_to_use, 0.17) } # Always add current week map (center position) maps_to_arrange <- c(maps_to_arrange, list(CImap)) - widths_to_use <- c(widths_to_use, 0.17) # Try to create 1-week difference map if (!is.null(abs_CI_last_week)) { @@ -304,21 +308,17 @@ ci_plot <- function(pivotName, show_legend = FALSE, legend_is_portrait = FALSE, week_1 = week, week_2 = week_minus_1, age = age, borders = borders, colorblind = colorblind_friendly) maps_to_arrange <- c(maps_to_arrange, list(CI_max_abs_last_week)) - widths_to_use <- c(widths_to_use, 0.17) } # Try to create 3-week difference map (legend on right) if (!is.null(abs_CI_three_week)) { CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2, show_legend = TRUE, legend_is_portrait = TRUE, + legend_position = "right", week_1 = week, week_2 = week_minus_3, age = age, borders = borders, colorblind = colorblind_friendly) maps_to_arrange <- c(maps_to_arrange, list(CI_max_abs_three_week)) - widths_to_use <- c(widths_to_use, 0.24) } - # Normalize widths to sum to 1 - widths_to_use <- widths_to_use / sum(widths_to_use) - # Add note if historical data is limited if (length(maps_to_arrange) == 1) { field_heading_note <- " (Current week only - historical data not yet available)" @@ -326,8 +326,21 @@ ci_plot <- function(pivotName, field_heading_note <- " (Limited historical data)" } - # Arrange the maps with normalized widths - tst <- do.call(tmap_arrange, c(maps_to_arrange, list(nrow = 1, widths = widths_to_use))) + # Arrange the maps in a row with more width for first and last (for legends) + # Give maps with legends (1st and 5th) more space: 23%, middle maps get 18% each + widths <- if (length(maps_to_arrange) == 5) { + c(0.23, 0.18, 0.18, 0.18, 0.23) + } else if (length(maps_to_arrange) == 4) { + c(0.25, 0.25, 0.25, 0.25) # Equal if only 4 maps + } else if (length(maps_to_arrange) == 3) { + c(0.33, 0.33, 0.34) # Equal if only 3 maps + } else if (length(maps_to_arrange) == 2) { + c(0.5, 0.5) # Equal if only 2 maps + } else { + NULL # Single map or other cases + } + + tst <- do.call(tmap_arrange, c(maps_to_arrange, list(nrow = 1, widths = widths))) # Output heading and map to R Markdown age_months <- round(age / 4.348, 1) @@ -448,7 +461,14 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " if (facet_on) { g <- ggplot2::ggplot(data = plot_data) + ggplot2::facet_wrap(~season, scales = "free_x") + - ggplot2::geom_line(ggplot2::aes_string(x = x_var, y = "ci_value", col = "sub_field", group = "sub_field")) + + ggplot2::geom_line( + ggplot2::aes( + x = .data[[x_var]], + y = .data[["ci_value"]], + col = .data[["sub_field"]], + group = .data[["sub_field"]] + ) + ) + ggplot2::labs(title = paste("Plot of", y_label), color = "Field Name", y = y_label, @@ -458,10 +478,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " breaks = scales::breaks_pretty(), labels = function(x) round(as.numeric(x - min(x)) / 30.44, 1))) + ggplot2::theme_minimal() + - ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5), + ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5), axis.text.x.top = ggplot2::element_text(hjust = 0.5), axis.title.x.top = ggplot2::element_text(size = 8), - legend.justification = c(1, 0), legend.position = c(1, 0), + legend.justification = c(1, 0), + legend.position = "inside", + legend.position.inside = c(1, 0), legend.title = ggplot2::element_text(size = 8), legend.text = ggplot2::element_text(size = 8)) + ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE)) @@ -490,22 +512,36 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " ) ggplot2::geom_smooth( data = benchmark_subset, - ggplot2::aes_string(x = "benchmark_x", y = "benchmark_value", group = "factor(percentile)"), - color = "gray70", size = 0.5, se = FALSE, inherit.aes = FALSE + ggplot2::aes( + x = .data[["benchmark_x"]], + y = .data[["benchmark_value"]], + group = factor(.data[["percentile"]]) + ), + color = "gray70", linewidth = 0.5, se = FALSE, inherit.aes = FALSE ) } } + # Plot older seasons with lighter lines ggplot2::geom_line( data = plot_data %>% dplyr::filter(!is_latest), - ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season"), - size = 0.7, alpha = 0.4 + ggplot2::aes( + x = .data[[x_var]], + y = .data[["ci_value"]], + col = .data[["season"]], + group = .data[["season"]] + ), + linewidth = 0.7, alpha = 0.4 ) + # Plot latest season with thicker, more prominent line ggplot2::geom_line( data = plot_data %>% dplyr::filter(is_latest), - ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season"), - size = 1.5, alpha = 1 + ggplot2::aes( + x = .data[[x_var]], + y = .data[["ci_value"]], + col = .data[["season"]], + group = .data[["season"]] + ), + linewidth = 1.5, alpha = 1 ) + ggplot2::labs(title = paste("Plot of", y_label, "for Field", pivotName, title_suffix), color = "Season", @@ -520,10 +556,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " } } + ggplot2::theme_minimal() + - ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5), + ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5), axis.text.x.top = ggplot2::element_text(hjust = 0.5), axis.title.x.top = ggplot2::element_text(size = 8), - legend.justification = c(1, 0), legend.position = c(1, 0), + legend.justification = c(1, 0), + legend.position = "inside", + legend.position.inside = c(1, 0), legend.title = ggplot2::element_text(size = 8), legend.text = ggplot2::element_text(size = 8)) + ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE)) @@ -597,8 +635,12 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " ) ggplot2::geom_smooth( data = benchmark_subset, - ggplot2::aes_string(x = "benchmark_x", y = "benchmark_value", group = "factor(percentile)"), - color = "gray70", size = 0.5, se = FALSE, inherit.aes = FALSE + ggplot2::aes( + x = .data[["benchmark_x"]], + y = .data[["benchmark_value"]], + group = factor(.data[["percentile"]]) + ), + color = "gray70", linewidth = 0.5, se = FALSE, inherit.aes = FALSE ) } } + @@ -606,14 +648,24 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " # Plot older seasons with lighter lines ggplot2::geom_line( data = plot_data_both %>% dplyr::filter(!is_latest), - ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season"), - size = 0.7, alpha = 0.4 + ggplot2::aes( + x = .data[[x_var]], + y = .data[["ci_value"]], + col = .data[["season"]], + group = .data[["season"]] + ), + linewidth = 0.7, alpha = 0.4 ) + # Plot latest season with thicker, more prominent line ggplot2::geom_line( data = plot_data_both %>% dplyr::filter(is_latest), - ggplot2::aes_string(x = x_var, y = "ci_value", col = "season", group = "season"), - size = 1.5, alpha = 1 + ggplot2::aes( + x = .data[[x_var]], + y = .data[["ci_value"]], + col = .data[["season"]], + group = .data[["season"]] + ), + linewidth = 1.5, alpha = 1 ) + ggplot2::labs(title = paste("CI Analysis for Field", pivotName), color = "Season", @@ -630,12 +682,14 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " } } + ggplot2::theme_minimal() + - ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5), - axis.text.x.top = ggplot2::element_text(hjust = 0.5), - axis.title.x.top = ggplot2::element_text(size = 8), - legend.justification = c(1, 0), legend.position = c(1, 0), - legend.title = ggplot2::element_text(size = 8), - legend.text = ggplot2::element_text(size = 8)) + + ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5), + axis.text.x.top = ggplot2::element_text(hjust = 0.5), + axis.title.x.top = ggplot2::element_text(size = 8), + legend.justification = c(1, 0), + legend.position = "inside", + legend.position.inside = c(1, 0), + legend.title = ggplot2::element_text(size = 8), + legend.text = ggplot2::element_text(size = 8)) + ggplot2::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE)) # For the rolling mean data, we want to set reasonable y-axis limits @@ -653,9 +707,11 @@ cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = " dummy_data[["season"]] <- factor("dummy", levels = levels(plot_data_both[["season"]])) g_both <- g_both + - ggplot2::geom_point(data = dummy_data, - ggplot2::aes_string(x = x_var, y = "ci_value"), - alpha = 0, size = 0) # Invisible points to set scale + ggplot2::geom_point( + data = dummy_data, + ggplot2::aes(x = .data[[x_var]], y = .data[["ci_value"]]), + alpha = 0, size = 0 + ) # Invisible points to set scale # Display the combined faceted plot subchunkify(g_both, 2.8, 10) @@ -692,9 +748,11 @@ cum_ci_plot2 <- function(pivotName){ x = "Date", y = "CI Rate") + theme_minimal() + theme(axis.text.x = element_text(hjust = 0.5), - legend.justification = c(1, 0), legend.position = c(1, 0), - legend.title = element_text(size = 8), - legend.text = element_text(size = 8)) + + legend.justification = c(1, 0), + legend.position = "inside", + legend.position.inside = c(1, 0), + legend.title = element_text(size = 8), + legend.text = element_text(size = 8)) + annotate("text", x = midpoint_date, y = 2, label = "No data available", size = 6, hjust = 0.5) subchunkify(g, 3.2, 10) @@ -1076,7 +1134,7 @@ generate_field_kpi_summary <- function(field_name, field_details_table, CI_quadr # For categorical data, take the most common value or highest risk level field_summary <- field_data %>% summarise( - field_size = sum(`Field Size (ha)`, na.rm = TRUE), + field_size = sum(`Field Size (acres)`, na.rm = TRUE), uniformity_levels = paste(unique(`Growth Uniformity`), collapse = "/"), avg_yield_forecast = ifelse(is.na(`Yield Forecast (t/ha)`[1]), NA, mean(`Yield Forecast (t/ha)`, na.rm = TRUE)), max_gap_score = max(`Gap Score`, na.rm = TRUE),