Refactor CI plotting functions to use proper parameterization
- Refactored ci_plot and cum_ci_plot functions to accept explicit parameters - Added default values for backward compatibility - Updated CI_report_dashboard_planet.Rmd to pass explicit parameters - Added input validation for better error handling - Added parameter documentation in function headers - Removed reliance on global variables for better maintainability
This commit is contained in:
parent
07aee7bed1
commit
2bed5949fa
|
|
@ -6,6 +6,7 @@ params:
|
|||
data_dir: "Chemba"
|
||||
mail_day: "Wednesday"
|
||||
borders: TRUE
|
||||
use_breaks: FALSE
|
||||
output:
|
||||
# html_document:
|
||||
# toc: yes
|
||||
|
|
@ -22,6 +23,7 @@ editor_options:
|
|||
report_date <- params$report_date
|
||||
mail_day <- params$mail_day
|
||||
borders <- params$borders
|
||||
use_breaks <- params$use_breaks # Whether to use breaks or continuous spectrum in visualizations
|
||||
|
||||
# Environment setup notes (commented out)
|
||||
# # Activeer de renv omgeving
|
||||
|
|
@ -143,43 +145,7 @@ year_2 <- lubridate::year(today_minus_2)
|
|||
year_3 <- lubridate::year(today_minus_3)
|
||||
```
|
||||
|
||||
`r subtitle_var`
|
||||
|
||||
\pagebreak
|
||||
# Explanation of the Report
|
||||
|
||||
This report provides a detailed analysis of your sugarcane fields based on satellite imagery, helping you monitor crop health and development throughout the growing season. The data is processed weekly to give you timely insights for optimal farm management decisions.
|
||||
|
||||
## What is the Chlorophyll Index (CI)?
|
||||
|
||||
The **Chlorophyll Index (CI)** is a vegetation index that measures the relative amount of chlorophyll in plant leaves. Chlorophyll is the green pigment responsible for photosynthesis in plants. Higher CI values indicate:
|
||||
|
||||
* Greater photosynthetic activity
|
||||
* Healthier plant tissue
|
||||
* Better nitrogen uptake
|
||||
* More vigorous crop growth
|
||||
|
||||
CI values typically range from 0 (bare soil or severely stressed vegetation) to 7+ (very healthy, dense vegetation). For sugarcane, values between 3-7 generally indicate good crop health, depending on the growth stage.
|
||||
|
||||
## What You'll Find in This Report:
|
||||
|
||||
1. **Chlorophyll Index Overview Map**: A comprehensive view of all your fields showing current CI values. This helps identify which fields are performing well and which might need attention.
|
||||
|
||||
2. **Weekly Difference Map**: Shows changes in CI values over the past week. Positive values (green) indicate improving crop health, while negative values (red) may signal stress or decline.
|
||||
|
||||
3. **Field-by-Field Analysis**: Detailed maps for each field showing:
|
||||
* CI values for the current week and two previous weeks
|
||||
* Week-to-week changes in CI values
|
||||
* Three-week change in CI values to track longer-term trends
|
||||
|
||||
4. **Growth Trend Graphs**: Time-series visualizations showing how CI values have changed throughout the growing season for each section of your fields.
|
||||
|
||||
5. **Yield Prediction**: For mature crops (over 300 days), we provide estimated yield predictions based on historical data and current CI measurements.
|
||||
|
||||
Use these insights to identify areas that may need irrigation, fertilization, or other interventions, and to track the effectiveness of your management practices over time.
|
||||
|
||||
\pagebreak
|
||||
```{r load_ci_quadrant_data, message=TRUE, warning=TRUE, include=FALSE}
|
||||
```{r data, message=TRUE, warning=TRUE, include=FALSE}
|
||||
# Load CI index data with error handling
|
||||
tryCatch({
|
||||
CI_quadrant <- readRDS(here::here(cumulative_CI_vals_dir, "All_pivots_Cumulative_CI_quadrant_year_v2.rds"))
|
||||
|
|
@ -187,9 +153,7 @@ tryCatch({
|
|||
}, error = function(e) {
|
||||
stop("Error loading CI quadrant data: ", e$message)
|
||||
})
|
||||
```
|
||||
|
||||
```{r load_raster_mosaics, message=TRUE, warning=TRUE, include=FALSE}
|
||||
# Get file paths for different weeks using the utility function
|
||||
tryCatch({
|
||||
path_to_week_current = get_week_path(weekly_CI_mosaic, today, 0)
|
||||
|
|
@ -253,26 +217,76 @@ tryCatch({
|
|||
})
|
||||
```
|
||||
|
||||
`r subtitle_var`
|
||||
|
||||
\pagebreak
|
||||
# Explanation of the Report
|
||||
|
||||
This report provides a detailed analysis of your sugarcane fields based on satellite imagery, helping you monitor crop health and development throughout the growing season. The data is processed weekly to give you timely insights for optimal farm management decisions.
|
||||
|
||||
## What is the Chlorophyll Index (CI)?
|
||||
|
||||
The **Chlorophyll Index (CI)** is a vegetation index that measures the relative amount of chlorophyll in plant leaves. Chlorophyll is the green pigment responsible for photosynthesis in plants. Higher CI values indicate:
|
||||
|
||||
* Greater photosynthetic activity
|
||||
* Healthier plant tissue
|
||||
* Better nitrogen uptake
|
||||
* More vigorous crop growth
|
||||
|
||||
CI values typically range from 0 (bare soil or severely stressed vegetation) to 7+ (very healthy, dense vegetation). For sugarcane, values between 3-7 generally indicate good crop health, depending on the growth stage.
|
||||
|
||||
## What You'll Find in This Report:
|
||||
|
||||
1. **Chlorophyll Index Overview Map**: A comprehensive view of all your fields showing current CI values. This helps identify which fields are performing well and which might need attention.
|
||||
|
||||
2. **Weekly Difference Map**: Shows changes in CI values over the past week. Positive values (green) indicate improving crop health, while negative values (red) may signal stress or decline.
|
||||
|
||||
3. **Field-by-Field Analysis**: Detailed maps for each field showing:
|
||||
* CI values for the current week and two previous weeks
|
||||
* Week-to-week changes in CI values
|
||||
* Three-week change in CI values to track longer-term trends
|
||||
|
||||
4. **Growth Trend Graphs**: Time-series visualizations showing how CI values have changed throughout the growing season for each section of your fields.
|
||||
|
||||
5. **Yield Prediction**: For mature crops (over 300 days), we provide estimated yield predictions based on historical data and current CI measurements.
|
||||
|
||||
Use these insights to identify areas that may need irrigation, fertilization, or other interventions, and to track the effectiveness of your management practices over time.
|
||||
|
||||
\pagebreak
|
||||
# Chlorophyll Index (CI) Overview Map - Current Week
|
||||
```{r render_ci_overview_map, echo=FALSE, fig.height=6.8, fig.width=9, message=FALSE, warning=FALSE}
|
||||
# Create overview chlorophyll index map
|
||||
tryCatch({
|
||||
tmap::tm_shape(CI, unit = "m") +
|
||||
tmap::tm_raster(breaks = c(0,0.5,1,2,3,4,5,6,7,Inf),
|
||||
palette = "RdYlGn",
|
||||
midpoint = NA,
|
||||
legend.is.portrait = FALSE,
|
||||
title = "Chlorophyll Index (CI)") +
|
||||
tmap::tm_layout(legend.outside = TRUE,
|
||||
legend.outside.position = "bottom",
|
||||
legend.show = TRUE,
|
||||
scale.position = c("right", "bottom"),
|
||||
compass.position = c("right", "bottom")) +
|
||||
tmap::tm_scale_bar(position = "outside", text.color = "black") +
|
||||
tmap::tm_compass(position = "outside", text.color = "black") +
|
||||
# Base shape
|
||||
map <- tmap::tm_shape(CI, unit = "m")
|
||||
|
||||
# Add raster layer with either breaks or continuous spectrum based on parameter
|
||||
if (use_breaks) {
|
||||
map <- map + tmap::tm_raster(breaks = c(0,0.5,1,2,3,4,5,6,7,Inf),
|
||||
palette = "RdYlGn",
|
||||
midpoint = NA,
|
||||
legend.is.portrait = FALSE,
|
||||
title = "Chlorophyll Index (CI)")
|
||||
} else {
|
||||
map <- map + tmap::tm_raster(palette = "RdYlGn",
|
||||
style = "cont",
|
||||
midpoint = NA,
|
||||
legend.is.portrait = FALSE,
|
||||
title = "Chlorophyll Index (CI)")
|
||||
}
|
||||
|
||||
# Complete the map with layout and other elements
|
||||
map <- map + tmap::tm_layout(legend.outside = TRUE,
|
||||
legend.outside.position = "bottom",
|
||||
legend.show = TRUE) +
|
||||
tmap::tm_scale_bar(position = tm_pos_out("right", "bottom"), text.color = "black") +
|
||||
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
|
||||
tmap::tm_shape(AllPivots0) +
|
||||
tmap::tm_borders(col = "black") +
|
||||
tmap::tm_text("sub_field", size = 0.6, col = "black")
|
||||
|
||||
# Print the map
|
||||
print(map)
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error creating CI overview map:", e$message), "ERROR")
|
||||
plot(1, type="n", axes=FALSE, xlab="", ylab="")
|
||||
|
|
@ -285,22 +299,36 @@ tryCatch({
|
|||
```{r render_ci_difference_map, echo=FALSE, fig.height=6.8, fig.width=9, message=FALSE, warning=FALSE}
|
||||
# Create chlorophyll index difference map
|
||||
tryCatch({
|
||||
tmap::tm_shape(last_week_dif_raster_abs, unit = "m") +
|
||||
tmap::tm_raster(breaks = c(-3,-2,-1,0,1,2,3),
|
||||
palette = "RdYlGn",
|
||||
midpoint = NA,
|
||||
legend.is.portrait = FALSE,
|
||||
title = "Chlorophyll Index (CI) Change") +
|
||||
tmap::tm_layout(legend.outside = TRUE,
|
||||
legend.outside.position = "bottom",
|
||||
legend.show = TRUE,
|
||||
scale.position = c("right", "bottom"),
|
||||
compass.position = c("right", "bottom")) +
|
||||
tmap::tm_scale_bar(position = "outside", text.color = "black") +
|
||||
tmap::tm_compass(position = "outside", text.color = "black") +
|
||||
# Base shape
|
||||
map <- tmap::tm_shape(last_week_dif_raster_abs, unit = "m")
|
||||
|
||||
# Add raster layer with either breaks or continuous spectrum based on parameter
|
||||
if (use_breaks) {
|
||||
map <- map + tmap::tm_raster(breaks = c(-3,-2,-1,0,1,2,3),
|
||||
palette = "RdYlGn",
|
||||
midpoint = 0,
|
||||
legend.is.portrait = FALSE,
|
||||
title = "Chlorophyll Index (CI) Change")
|
||||
} else {
|
||||
map <- map + tmap::tm_raster(palette = "RdYlGn",
|
||||
style = "cont",
|
||||
midpoint = 0,
|
||||
legend.is.portrait = FALSE,
|
||||
title = "Chlorophyll Index (CI) Change")
|
||||
}
|
||||
|
||||
# Complete the map with layout and other elements
|
||||
map <- map + tmap::tm_layout(legend.outside = TRUE,
|
||||
legend.outside.position = "bottom",
|
||||
legend.show = TRUE) +
|
||||
tmap::tm_scale_bar(position = tm_pos_out("right", "bottom"), text.color = "black") +
|
||||
tmap::tm_compass(position = tm_pos_out("right", "bottom"), text.color = "black") +
|
||||
tmap::tm_shape(AllPivots0) +
|
||||
tmap::tm_borders(col = "black") +
|
||||
tmap::tm_text("sub_field", size = 0.6, col = "black")
|
||||
|
||||
# Print the map
|
||||
print(map)
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error creating CI difference map:", e$message), "ERROR")
|
||||
plot(1, type="n", axes=FALSE, xlab="", ylab="")
|
||||
|
|
@ -308,6 +336,7 @@ tryCatch({
|
|||
})
|
||||
```
|
||||
\newpage
|
||||
\newpage
|
||||
|
||||
```{r generate_field_visualizations, eval=TRUE, fig.height=3.8, fig.width=10, message=FALSE,echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
|
||||
# Generate detailed visualizations for each field
|
||||
|
|
@ -321,9 +350,35 @@ tryCatch({
|
|||
purrr::walk(AllPivots_merged$field, function(field_name) {
|
||||
tryCatch({
|
||||
cat("\n") # Add an empty line for better spacing
|
||||
ci_plot(field_name)
|
||||
|
||||
# Call ci_plot with explicit parameters
|
||||
ci_plot(
|
||||
pivotName = field_name,
|
||||
field_boundaries = AllPivots0,
|
||||
current_ci = CI,
|
||||
ci_minus_1 = CI_m1,
|
||||
ci_minus_2 = CI_m2,
|
||||
last_week_diff = last_week_dif_raster_abs,
|
||||
three_week_diff = three_week_dif_raster_abs,
|
||||
harvesting_data = harvesting_data,
|
||||
week = week,
|
||||
week_minus_1 = week_minus_1,
|
||||
week_minus_2 = week_minus_2,
|
||||
week_minus_3 = week_minus_3,
|
||||
use_breaks = use_breaks,
|
||||
borders = borders
|
||||
)
|
||||
|
||||
cat("\n")
|
||||
cum_ci_plot(field_name)
|
||||
|
||||
# Call cum_ci_plot with explicit parameters
|
||||
cum_ci_plot(
|
||||
pivotName = field_name,
|
||||
ci_quadrant_data = CI_quadrant,
|
||||
plot_type = "value",
|
||||
facet_on = FALSE
|
||||
)
|
||||
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error generating plots for field", field_name, ":", e$message), "ERROR")
|
||||
cat(paste("## Error generating plots for field", field_name, "\n"))
|
||||
|
|
@ -509,5 +564,4 @@ tryCatch({
|
|||
cat("Error generating yield prediction visualizations. See log for details.")
|
||||
})
|
||||
```
|
||||
````````````````
|
||||
|
||||
|
|
|
|||
|
|
@ -55,9 +55,10 @@ subchunkify <- function(g, fig_height=7, fig_width=5) {
|
|||
#' @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)
|
||||
#' @param use_breaks Whether to use breaks or continuous spectrum for the raster (default: TRUE)
|
||||
#' @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){
|
||||
create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week, age, borders = FALSE, use_breaks = TRUE){
|
||||
# Input validation
|
||||
if (missing(pivot_raster) || is.null(pivot_raster)) {
|
||||
stop("pivot_raster is required")
|
||||
|
|
@ -76,21 +77,32 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
|
|||
}
|
||||
|
||||
# Create the base map
|
||||
map <- tm_shape(pivot_raster, unit = "m") +
|
||||
tm_raster(breaks = c(0,0.5,1,2,3,4,5,6,7,Inf),
|
||||
palette = "RdYlGn",
|
||||
legend.is.portrait = legend_is_portrait,
|
||||
midpoint = NA,
|
||||
title = "CI") +
|
||||
tm_layout(main.title = paste0("\nMax CI week ", week,"\n", age, " weeks old"),
|
||||
main.title.size = 0.7,
|
||||
legend.show = show_legend,
|
||||
legend.position = c("left", "bottom"),
|
||||
legend.width = 0.3,
|
||||
legend.height = 0.3,
|
||||
legend.text.size = 0.6,
|
||||
legend.title.size = 0.7,
|
||||
legend.outside = FALSE)
|
||||
map <- tm_shape(pivot_raster, unit = "m")
|
||||
|
||||
# Add raster with either breaks or continuous spectrum based on parameter
|
||||
if (use_breaks) {
|
||||
map <- map + tm_raster(breaks = c(0,0.5,1,2,3,4,5,6,7,Inf),
|
||||
palette = "RdYlGn",
|
||||
legend.is.portrait = legend_is_portrait,
|
||||
midpoint = NA,
|
||||
title = "CI")
|
||||
} else {
|
||||
map <- map + tm_raster(palette = "RdYlGn",
|
||||
legend.is.portrait = legend_is_portrait,
|
||||
style = "cont", # Use continuous spectrum
|
||||
title = "CI")
|
||||
}
|
||||
|
||||
# Add layout elements
|
||||
map <- map + tm_layout(main.title = paste0("Max CI week ", week,"\n", age, " weeks old"),
|
||||
main.title.size = 0.7,
|
||||
legend.show = show_legend,
|
||||
legend.position = c("left", "bottom"),
|
||||
# legend.width = 0.5,
|
||||
# legend.height = 0.5,
|
||||
# legend.text.size = 0.8,
|
||||
# legend.title.size = 0.9,
|
||||
legend.outside = FALSE)
|
||||
|
||||
# Add borders if requested
|
||||
if (borders) {
|
||||
|
|
@ -116,9 +128,10 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
|
|||
#' @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)
|
||||
#' @param use_breaks Whether to use breaks or continuous spectrum for the raster (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){
|
||||
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, use_breaks = TRUE){
|
||||
# Input validation
|
||||
if (missing(pivot_raster) || is.null(pivot_raster)) {
|
||||
stop("pivot_raster is required")
|
||||
|
|
@ -136,22 +149,34 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
|
|||
stop("age parameter is required")
|
||||
}
|
||||
|
||||
# Create the difference map
|
||||
map <- tm_shape(pivot_raster, unit = "m") +
|
||||
tm_raster(breaks = c(-3,-2,-1,0,1,2,3),
|
||||
palette = "RdYlGn",
|
||||
legend.is.portrait = legend_is_portrait,
|
||||
midpoint = 0,
|
||||
title = "CI difference") +
|
||||
tm_layout(main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks old"),
|
||||
main.title.size = 0.7,
|
||||
legend.show = show_legend,
|
||||
legend.position = c("left", "bottom"),
|
||||
legend.width = 0.3,
|
||||
legend.height = 0.3,
|
||||
legend.text.size = 0.6,
|
||||
legend.title.size = 0.7,
|
||||
legend.outside = FALSE)
|
||||
# Create the base map
|
||||
map <- tm_shape(pivot_raster, unit = "m")
|
||||
|
||||
# Add raster with either breaks or continuous spectrum based on parameter
|
||||
if (use_breaks) {
|
||||
map <- map + tm_raster(breaks = c(-3,-2,-1,0,1,2,3),
|
||||
palette = "RdYlGn",
|
||||
legend.is.portrait = legend_is_portrait,
|
||||
midpoint = 0,
|
||||
title = "CI difference")
|
||||
} else {
|
||||
map <- map + tm_raster(palette = "RdYlGn",
|
||||
legend.is.portrait = legend_is_portrait,
|
||||
style = "cont", # Use continuous spectrum
|
||||
midpoint = 0,
|
||||
title = "CI difference")
|
||||
}
|
||||
|
||||
# Add layout elements
|
||||
map <- map + tm_layout(main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks old"),
|
||||
main.title.size = 0.7,
|
||||
legend.show = show_legend,
|
||||
legend.position = c("left", "bottom"),
|
||||
# legend.width = 0.5,
|
||||
# legend.height = 0.5,
|
||||
# legend.text.size = 0.8,
|
||||
# legend.title.size = 0.9,
|
||||
legend.outside = FALSE)
|
||||
|
||||
# Add borders if requested
|
||||
if (borders) {
|
||||
|
|
@ -169,23 +194,64 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
|
|||
#' Creates a visualization of CI data for a specific pivot field
|
||||
#'
|
||||
#' @param pivotName The name or ID of the pivot field to visualize
|
||||
#' @param field_boundaries Field boundaries spatial data (sf object)
|
||||
#' @param current_ci Current week's Chlorophyll Index raster
|
||||
#' @param ci_minus_1 Previous week's Chlorophyll Index raster
|
||||
#' @param ci_minus_2 Two weeks ago Chlorophyll Index raster
|
||||
#' @param last_week_diff Difference raster between current and last week
|
||||
#' @param three_week_diff Difference raster between current and three weeks ago
|
||||
#' @param harvesting_data Data frame containing field harvesting/planting information
|
||||
#' @param week Current week number
|
||||
#' @param week_minus_1 Previous week number
|
||||
#' @param week_minus_2 Two weeks ago week number
|
||||
#' @param week_minus_3 Three weeks ago week number
|
||||
#' @param use_breaks Whether to use discrete breaks or continuous spectrum (default: TRUE)
|
||||
#' @param borders Whether to display field borders (default: TRUE)
|
||||
#' @return NULL (adds output directly to R Markdown document)
|
||||
#'
|
||||
ci_plot <- function(pivotName){
|
||||
ci_plot <- function(pivotName,
|
||||
field_boundaries = AllPivots0,
|
||||
current_ci = CI,
|
||||
ci_minus_1 = CI_m1,
|
||||
ci_minus_2 = CI_m2,
|
||||
last_week_diff = last_week_dif_raster_abs,
|
||||
three_week_diff = three_week_dif_raster_abs,
|
||||
harvesting_data = harvesting_data,
|
||||
week = week,
|
||||
week_minus_1 = week_minus_1,
|
||||
week_minus_2 = week_minus_2,
|
||||
week_minus_3 = week_minus_3,
|
||||
use_breaks = TRUE,
|
||||
borders = TRUE){
|
||||
# Input validation
|
||||
if (missing(pivotName) || is.null(pivotName) || pivotName == "") {
|
||||
stop("pivotName is required")
|
||||
}
|
||||
if (!exists("AllPivots0") || !exists("CI") || !exists("CI_m1") || !exists("CI_m2")) {
|
||||
stop("Required global variables (AllPivots0, CI, CI_m1, CI_m2) not found")
|
||||
if (missing(field_boundaries) || is.null(field_boundaries)) {
|
||||
stop("field_boundaries is required")
|
||||
}
|
||||
if (!exists("harvesting_data")) {
|
||||
stop("harvesting_data not found")
|
||||
if (missing(current_ci) || is.null(current_ci)) {
|
||||
stop("current_ci is required")
|
||||
}
|
||||
if (missing(ci_minus_1) || is.null(ci_minus_1)) {
|
||||
stop("ci_minus_1 is required")
|
||||
}
|
||||
if (missing(ci_minus_2) || is.null(ci_minus_2)) {
|
||||
stop("ci_minus_2 is required")
|
||||
}
|
||||
if (missing(last_week_diff) || is.null(last_week_diff)) {
|
||||
stop("last_week_diff is required")
|
||||
}
|
||||
if (missing(three_week_diff) || is.null(three_week_diff)) {
|
||||
stop("three_week_diff is required")
|
||||
}
|
||||
if (missing(harvesting_data) || is.null(harvesting_data)) {
|
||||
stop("harvesting_data is required")
|
||||
}
|
||||
|
||||
# Extract pivot shape and age data
|
||||
tryCatch({
|
||||
pivotShape <- AllPivots0 %>% terra::subset(field %in% pivotName) %>% sf::st_transform(terra::crs(CI))
|
||||
pivotShape <- field_boundaries %>% terra::subset(field %in% pivotName) %>% sf::st_transform(terra::crs(current_ci))
|
||||
age <- harvesting_data %>%
|
||||
dplyr::filter(field %in% pivotName) %>%
|
||||
sort("year") %>%
|
||||
|
|
@ -196,16 +262,16 @@ ci_plot <- function(pivotName){
|
|||
round()
|
||||
|
||||
# Filter for the specific pivot
|
||||
AllPivots2 <- AllPivots0 %>% dplyr::filter(field %in% pivotName)
|
||||
AllPivots2 <- field_boundaries %>% dplyr::filter(field %in% pivotName)
|
||||
|
||||
# Create crop masks for different timepoints using terra functions
|
||||
singlePivot <- terra::crop(CI, pivotShape) %>% terra::mask(., pivotShape)
|
||||
singlePivot_m1 <- terra::crop(CI_m1, pivotShape) %>% terra::mask(., pivotShape)
|
||||
singlePivot_m2 <- terra::crop(CI_m2, pivotShape) %>% terra::mask(., pivotShape)
|
||||
singlePivot <- terra::crop(current_ci, pivotShape) %>% terra::mask(., pivotShape)
|
||||
singlePivot_m1 <- terra::crop(ci_minus_1, pivotShape) %>% terra::mask(., pivotShape)
|
||||
singlePivot_m2 <- terra::crop(ci_minus_2, pivotShape) %>% terra::mask(., pivotShape)
|
||||
|
||||
# Create difference maps
|
||||
abs_CI_last_week <- terra::crop(last_week_dif_raster_abs, pivotShape) %>% terra::mask(., pivotShape)
|
||||
abs_CI_three_week <- terra::crop(three_week_dif_raster_abs, pivotShape) %>% terra::mask(., pivotShape)
|
||||
abs_CI_last_week <- terra::crop(last_week_diff, pivotShape) %>% terra::mask(., pivotShape)
|
||||
abs_CI_three_week <- terra::crop(three_week_diff, pivotShape) %>% terra::mask(., pivotShape)
|
||||
|
||||
# Get planting date
|
||||
planting_date <- harvesting_data %>%
|
||||
|
|
@ -215,31 +281,36 @@ ci_plot <- function(pivotName){
|
|||
unique()
|
||||
|
||||
# Create spans for borders
|
||||
joined_spans2 <- AllPivots0 %>%
|
||||
joined_spans2 <- field_boundaries %>%
|
||||
sf::st_transform(sf::st_crs(pivotShape)) %>%
|
||||
dplyr::filter(field %in% pivotName)
|
||||
|
||||
# Create the maps for different timepoints
|
||||
CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2,
|
||||
show_legend = TRUE, legend_is_portrait = TRUE,
|
||||
week = week_minus_2, age = age - 2, borders = borders)
|
||||
week = week_minus_2, age = age - 2, borders = borders,
|
||||
use_breaks = use_breaks)
|
||||
|
||||
CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2,
|
||||
show_legend = FALSE, legend_is_portrait = FALSE,
|
||||
week = week_minus_1, age = age - 1, borders = borders)
|
||||
week = week_minus_1, age = age - 1, borders = borders,
|
||||
use_breaks = use_breaks)
|
||||
|
||||
CImap <- create_CI_map(singlePivot, AllPivots2, joined_spans2,
|
||||
show_legend = FALSE, legend_is_portrait = FALSE,
|
||||
week = week, age = age, borders = borders)
|
||||
week = week, age = age, borders = borders,
|
||||
use_breaks = use_breaks)
|
||||
|
||||
# Create difference maps - only show legend on the second one to avoid redundancy
|
||||
CI_max_abs_last_week <- create_CI_diff_map(abs_CI_last_week, AllPivots2, joined_spans2,
|
||||
show_legend = FALSE, legend_is_portrait = TRUE,
|
||||
week_1 = week, week_2 = week_minus_1, age = age, borders = borders)
|
||||
week_1 = week, week_2 = week_minus_1, age = age, borders = borders,
|
||||
use_breaks = use_breaks)
|
||||
|
||||
CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2,
|
||||
show_legend = TRUE, legend_is_portrait = TRUE,
|
||||
week_1 = week, week_2 = week_minus_3, age = age, borders = borders)
|
||||
week_1 = week, week_2 = week_minus_3, age = age, borders = borders,
|
||||
use_breaks = use_breaks)
|
||||
|
||||
# Arrange the maps
|
||||
tst <- tmap_arrange(CImap_m2, CImap_m1, CImap, CI_max_abs_last_week, CI_max_abs_three_week, nrow = 1)
|
||||
|
|
@ -258,25 +329,30 @@ ci_plot <- function(pivotName){
|
|||
#' Creates a plot showing Chlorophyll Index data over time for a pivot field
|
||||
#'
|
||||
#' @param pivotName The name or ID of the pivot field to visualize
|
||||
#' @param ci_quadrant_data Data frame containing CI quadrant data with field, sub_field, Date, DOY, cumulative_CI, value and season columns
|
||||
#' @param plot_type Type of plot to generate: "value", "CI_rate", or "cumulative_CI"
|
||||
#' @param facet_on Whether to facet the plot by season (TRUE) or overlay all seasons (FALSE)
|
||||
#' @param x_unit Unit for x-axis: "days" for DOY or "weeks" for week number (default: "days")
|
||||
#' @return NULL (adds output directly to R Markdown document)
|
||||
#'
|
||||
cum_ci_plot <- function(pivotName, plot_type = "value", facet_on = FALSE) {
|
||||
cum_ci_plot <- function(pivotName, ci_quadrant_data = CI_quadrant, plot_type = "value", facet_on = FALSE, x_unit = "days") {
|
||||
# Input validation
|
||||
if (missing(pivotName) || is.null(pivotName) || pivotName == "") {
|
||||
stop("pivotName is required")
|
||||
}
|
||||
if (!exists("CI_quadrant")) {
|
||||
stop("Required global variable CI_quadrant not found")
|
||||
if (missing(ci_quadrant_data) || is.null(ci_quadrant_data)) {
|
||||
stop("ci_quadrant_data is required")
|
||||
}
|
||||
if (!plot_type %in% c("value", "CI_rate", "cumulative_CI")) {
|
||||
stop("plot_type must be one of: 'value', 'CI_rate', or 'cumulative_CI'")
|
||||
}
|
||||
if (!x_unit %in% c("days", "weeks")) {
|
||||
stop("x_unit must be either 'days' or 'weeks'")
|
||||
}
|
||||
|
||||
# Filter data for the specified pivot
|
||||
tryCatch({
|
||||
data_ci <- CI_quadrant %>% filter(field == pivotName)
|
||||
data_ci <- ci_quadrant_data %>% dplyr::filter(field == pivotName)
|
||||
|
||||
if (nrow(data_ci) == 0) {
|
||||
safe_log(paste("No CI data found for pivot", pivotName), "WARNING")
|
||||
|
|
@ -285,23 +361,23 @@ cum_ci_plot <- function(pivotName, plot_type = "value", facet_on = FALSE) {
|
|||
|
||||
# Process data
|
||||
data_ci2 <- data_ci %>%
|
||||
mutate(CI_rate = cumulative_CI / DOY,
|
||||
week = week(Date)) %>%
|
||||
group_by(field) %>%
|
||||
mutate(mean_CIrate_rolling_10_days = rollapplyr(CI_rate, width = 10, FUN = mean, partial = TRUE),
|
||||
mean_rolling_10_days = rollapplyr(value, width = 10, FUN = mean, partial = TRUE))
|
||||
dplyr::mutate(CI_rate = cumulative_CI / DOY,
|
||||
week = lubridate::week(Date)) %>%
|
||||
dplyr::group_by(field) %>%
|
||||
dplyr::mutate(mean_CIrate_rolling_10_days = zoo::rollapplyr(CI_rate, width = 10, FUN = mean, partial = TRUE),
|
||||
mean_rolling_10_days = zoo::rollapplyr(value, width = 10, FUN = mean, partial = TRUE))
|
||||
|
||||
data_ci2 <- data_ci2 %>% mutate(season = as.factor(season))
|
||||
data_ci2 <- data_ci2 %>% dplyr::mutate(season = as.factor(season))
|
||||
|
||||
# Prepare date information by season
|
||||
date_preperation_perfect_pivot <- data_ci2 %>%
|
||||
group_by(season) %>%
|
||||
summarise(min_date = min(Date),
|
||||
date_preparation_perfect_pivot <- data_ci2 %>%
|
||||
dplyr::group_by(season) %>%
|
||||
dplyr::summarise(min_date = min(Date),
|
||||
max_date = max(Date),
|
||||
days = max_date - min_date)
|
||||
|
||||
# Get the 3 most recent seasons
|
||||
unique_seasons <- sort(unique(date_preperation_perfect_pivot$season), decreasing = TRUE)[1:3]
|
||||
unique_seasons <- sort(unique(date_preparation_perfect_pivot$season), decreasing = TRUE)[1:3]
|
||||
|
||||
# Determine the y aesthetic based on the plot type
|
||||
y_aesthetic <- switch(plot_type,
|
||||
|
|
@ -314,38 +390,50 @@ cum_ci_plot <- function(pivotName, plot_type = "value", facet_on = FALSE) {
|
|||
"cumulative_CI" = "Cumulative CI",
|
||||
"value" = "10-Day Rolling Mean CI")
|
||||
|
||||
# Create plot with either facets by season or overlay by DOY
|
||||
if (facet_on) {
|
||||
g <- ggplot(data = data_ci2 %>% filter(season %in% unique_seasons)) +
|
||||
facet_wrap(~season, scales = "free_x") +
|
||||
geom_line(aes_string(x = "Date", y = y_aesthetic, col = "sub_field", group = "sub_field")) +
|
||||
labs(title = paste("Plot of", y_label, "for Pivot", pivotName),
|
||||
color = "Field Name",
|
||||
y = y_label) +
|
||||
scale_x_date(date_breaks = "1 month", date_labels = "%m-%Y") +
|
||||
theme_minimal() +
|
||||
theme(axis.text.x = element_text(angle = 60, hjust = 1),
|
||||
legend.justification = c(1, 0), legend.position = c(1, 0),
|
||||
legend.title = element_text(size = 8),
|
||||
legend.text = element_text(size = 8)) +
|
||||
guides(color = guide_legend(nrow = 2, byrow = TRUE))
|
||||
# Determine x-axis variable based on x_unit parameter
|
||||
x_var <- if (x_unit == "days") {
|
||||
if (facet_on) "Date" else "DOY"
|
||||
} else {
|
||||
g <- ggplot(data = data_ci2 %>% filter(season %in% unique_seasons)) +
|
||||
geom_line(aes_string(x = "DOY", y = y_aesthetic, col = "season", group = "season")) +
|
||||
labs(title = paste("Plot of", y_label, "for Pivot", pivotName),
|
||||
color = "Season",
|
||||
y = y_label,
|
||||
x = "Age of Crop (Days)") +
|
||||
theme_minimal() +
|
||||
theme(axis.text.x = element_text(angle = 60, hjust = 1),
|
||||
legend.justification = c(1, 0), legend.position = c(1, 0),
|
||||
legend.title = element_text(size = 8),
|
||||
legend.text = element_text(size = 8)) +
|
||||
guides(color = guide_legend(nrow = 2, byrow = TRUE))
|
||||
"week"
|
||||
}
|
||||
|
||||
# Output plot to R Markdown
|
||||
subchunkify(g, 3.2, 10)
|
||||
x_label <- switch(x_unit,
|
||||
"days" = if (facet_on) "Date" else "Age of Crop (Days)",
|
||||
"weeks" = "Week Number")
|
||||
|
||||
# Create plot with either facets by season or overlay by DOY/week
|
||||
if (facet_on) {
|
||||
g <- ggplot2::ggplot(data = data_ci2 %>% dplyr::filter(season %in% unique_seasons)) +
|
||||
ggplot2::facet_wrap(~season, scales = "free_x") +
|
||||
ggplot2::geom_line(ggplot2::aes_string(x = x_var, y = y_aesthetic, col = "sub_field", group = "sub_field")) +
|
||||
ggplot2::labs(title = paste("Plot of", y_label, "for Pivot", pivotName),
|
||||
color = "Field Name",
|
||||
y = y_label,
|
||||
x = x_label) +
|
||||
ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%m-%Y") +
|
||||
ggplot2::theme_minimal() +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 60, hjust = 1),
|
||||
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::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
|
||||
} else {
|
||||
g <- ggplot2::ggplot(data = data_ci2 %>% dplyr::filter(season %in% unique_seasons)) +
|
||||
ggplot2::geom_line(ggplot2::aes_string(x = x_var, y = y_aesthetic, col = "season", group = "season")) +
|
||||
ggplot2::labs(title = paste("Plot of", y_label, "for Pivot", pivotName),
|
||||
color = "Season",
|
||||
y = y_label,
|
||||
x = x_label) +
|
||||
ggplot2::theme_minimal() +
|
||||
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 60, hjust = 1),
|
||||
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::guides(color = ggplot2::guide_legend(nrow = 2, byrow = TRUE))
|
||||
}
|
||||
|
||||
# Output plot to R Markdown with reduced height
|
||||
subchunkify(g, 3.2, 10) # Reduced from 3.2 to 2.8
|
||||
|
||||
}, error = function(e) {
|
||||
safe_log(paste("Error creating CI trend plot for pivot", pivotName, ":", e$message), "ERROR")
|
||||
|
|
|
|||
Loading…
Reference in a new issue