Update CI report parameters and improve map legend configurations
- Changed report date in CI report for cane supply to "2026-02-04". - Updated output file naming convention for agronomic support report to reflect new report date. - Enhanced map creation functions to allow customizable legend positions and improved layout settings. - Adjusted widths for map arrangements to ensure better visual representation. - Fixed minor issues in ggplot aesthetics for clearer legend positioning and improved readability. - Corrected field size unit from hectares to acres in KPI summary generation.
This commit is contained in:
parent
2e683d0c6d
commit
e4e19df0c7
1
python_app/.gitignore
vendored
1
python_app/.gitignore
vendored
|
|
@ -39,7 +39,6 @@ dist/
|
|||
*.bak
|
||||
*.swp
|
||||
*.swo
|
||||
*.swp
|
||||
|
||||
*.png
|
||||
|
||||
|
|
|
|||
|
|
@ -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 %>%
|
||||
|
|
|
|||
|
|
@ -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) {
|
|||
}
|
||||
```
|
||||
|
||||
<!-- Dynamic cover page -->
|
||||
::: {custom-style="Cover_title" style="text-align:center; margin-top:120px;"}
|
||||
<span style="font-size:100pt; line-height:1.0; font-weight:700;">Satellite Based Field Reporting</span>
|
||||
:::
|
||||
|
||||
::: {custom-style="Cover_subtitle" style="text-align:center; margin-top:18px;"}
|
||||
<span style="font-size:20pt; font-weight:600;">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') }`)</span>
|
||||
:::
|
||||
|
||||
## 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.*
|
||||
*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team at info@smartcane.ag.*
|
||||
|
|
@ -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.*
|
||||
*This report was automatically generated by the SmartCane monitoring system. For questions or additional analysis, please contact the technical team at info@smartcane.ag.*
|
||||
|
|
@ -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"
|
||||
)
|
||||
#
|
||||
|
|
|
|||
|
|
@ -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),
|
||||
|
|
|
|||
Loading…
Reference in a new issue