# Plotting helper functions -----------------------------------------------
plot_train_test <- (x, scales){
smoothed_data <- (x)
preds <- (x)$pred
response <- ((x))
smoothed_data_with_preds <- smoothed_data %>%
dplyr::mutate(predicted = preds,
color = (.data$train_test, "TRAIN", "TEST"))
# TRAIN / TEST pairs plot
sspm_discrete_plot <-
ggplot2::ggplot( = smoothed_data_with_preds) +
ggplot2::geom_point(ggplot2::aes(y = (.data[response]]),
x = .data$predicted,
= .data$color)) +
ggplot2::theme_light() +
ggplot2::labs(y = "observed", x = "predicted") +
ggplot2::scale_color_viridis_d("Set") +
ggplot2::facet_wrap(~.data[spm_boundary(x)]],
scales = scales) +
ggplot2::geom_abline(slope = 1, intercept = 0,
lty = 2, linewidth = 0.2)
(sspm_discrete_plot)
}
# -------------------------------------------------------------------------
plot_productivity <- (x, , interval, use_sf, , , ,
, scales, point_size, line_size,
show_PI, show_CI){
boundary_col <- (x)
resp <- ((x))
prod_preds <- (x, = ,
interval = interval) %>%
dplyr::mutate(color = "Predictions")
actual <- (x) %>%
dplyr::mutate(pred = (.data[resp]])) %>%
dplyr::mutate(color = "Actual")
prod_preds <- prod_preds %>%
dplyr::bind_rows(actual)
time_col <- (x)
color_profile <- ("Predictions" = "red",
"Actual" = "black")
sspm_discrete_plot <-
spm_plot_routine(smoothed_data = prod_preds, = "pred",
use_sf = use_sf, = , = ,
= , time_col = time_col, = ,
scales = scales, color_profile = color_profile,
= , interval = interval,
boundary_col = boundary_col, point_size = point_size,
line_size = line_size,
show_PI = show_PI, show_CI = show_CI )
}
plot_biomass <- (x, biomass, biomass_origin, , interval,
use_sf, , , , , scales,
next_ts, smoothed_biomass, point_size, line_size,
show_PI, show_CI){
# Check that biomass is a character
checkmate::assert_character(biomass)
# Start up color profile info vector
color_profile <- ("Predictions" = "red")
# Collect info
boundary_col <- (x)
patch_area_col <- ((x))
time_col <- (x)
boundary_col <- (x)
# Start with predicting biomass
biomass_preds <- (x, biomass = biomass,
= ,
interval = interval) %>%
dplyr::mutate(color = "Predictions")
if (smoothed_biomass){
# Prepare biomass_actual data
biomass_actual <- process_actual_biomass(x, biomass_origin, biomass,
patch_area_col, boundary_col,
time_col, )
# Put actual and predictions together
biomass_preds <- biomass_preds %>%
dplyr::bind_rows(biomass_actual)
color_profile <-
(color_profile, "Smoothed" = "black")
}
if (next_ts) {
next_ts_label <- "Prediction (1 step \n ahead, NO CATCH)"
next_ts_preds <- process_next_ts(x, biomass, interval, ,
next_ts_label, boundary_col, time_col,
biomass_preds)
biomass_preds <- biomass_preds %>%
dplyr::bind_rows(next_ts_preds)
color_profile <-
(color_profile, "Prediction (1 step \n ahead, NO CATCH)" =
"firebrick")
}
sspm_discrete_plot <-
spm_plot_routine(smoothed_data = biomass_preds, = "biomass",
use_sf = use_sf, = , = ,
= , time_col = time_col, = ,
scales = scales, color_profile = color_profile,
= , interval = interval,
boundary_col = boundary_col, point_size = point_size,
line_size = line_size,
show_PI = show_PI, show_CI = show_CI)
}
# -------------------------------------------------------------------------
process_next_ts <- (x, biomass, interval, , next_ts_label,
boundary_col, time_col, biomass_preds){
next_ts_preds <- (x, biomass = biomass,
next_ts = ,
interval = interval,
= ) %>%
dplyr::mutate(color = next_ts_label)
next_ts_timestep <- ((next_ts_preds[time_col]]))-1
biomass_preds_previous <- biomass_preds %>%
dplyr::(.data[time_col]] == next_ts_timestep) %>%
dplyr::mutate(color = next_ts_label) %>%
tidyr::drop_na()
next_ts_preds <- next_ts_preds %>%
dplyr::bind_rows(biomass_preds_previous)
(next_ts_preds)
}
process_actual_biomass <- (x, biomass_origin, biomass, patch_area_col,
boundary_col, time_col, ){
if ((biomass_origin)){
assert_column((x), biomass)
biomass_origin <- biomass
} {
assert_column(biomass_origin, (x))
}
biomass_actual <- (x) %>%
dplyr::mutate(biomass = .data[biomass_origin]] *
.data[patch_area_col]])
if (){
biomass_actual <- biomass_actual %>%
dplyr::group_by(.data[boundary_col]], .data[time_col]]) %>%
dplyr::summarise(biomass = (.data$biomass)) %>%
dplyr::ungroup()
}
biomass_actual <- biomass_actual %>%
dplyr::mutate(color = "Smoothed")
(biomass_actual)
}
# Subroutine --------------------------------------------------------------
spm_plot_routine <- (smoothed_data, , use_sf, , , ,
time_col, , scales, color_profile,
= , interval = ,
boundary_col = , line_size, point_size,
show_PI = , show_CI = ) {
smoothed_data <- ::drop_units(smoothed_data) %>%
dplyr::mutate(linesize = line_size, pointsize = point_size)
if () {
smoothed_data[var]] <- (smoothed_data[var]])
the_title <- (, " (log)")
} {
the_title <-
}
if (use_sf){
base_plot <- ggplot2::ggplot( = smoothed_data) +
ggplot2::geom_sf(ggplot2::aes(fill = .data[var]])) +
ggplot2::scale_fill_viridis_c() +
ggplot2::labs(fill = the_title) +
ggplot2::theme_light()
facet_by <- time_col
} {
base_plot <- ggplot2::ggplot( = smoothed_data) +
ggplot2::geom_line(ggplot2::aes(x = .data[time_col]],
y = .data[var]],
color = .data$color),
linewidth = smoothed_data$linesize) +
ggplot2::geom_point(ggplot2::aes(x = .data[time_col]],
y = .data[var]],
color = .data$color),
cex = smoothed_data$pointsize) +
ggplot2::labs(y = the_title) +
ggplot2::theme_light() +
ggplot2::scale_color_manual(values = color_profile) +
ggplot2::labs(color = "Type",
x = "Timestep")
if (){
facet_by <- boundary_col
facet_col_levels <- ((smoothed_data[facet_by]]))
if (facet_col_levels == 1) {
<- <- 1
}
} {
facet_by <- "patch_id"
}
if (interval) {
if () {
CI_lower_name <- (, "_CI_log_lower")
CI_upper_name <- (, "_CI_log_upper")
PI_lower_name <- (, "_PI_log_lower")
PI_upper_name <- (, "_PI_log_upper")
} {
CI_lower_name <- (, "_CI_lower")
CI_upper_name <- (, "_CI_upper")
PI_lower_name <- (, "_PI_lower")
PI_upper_name <- (, "_PI_upper")
}
(show_CI){
base_plot <- base_plot +
ggplot2::geom_ribbon(
ggplot2::aes(x = .data[time_col]],
ymin = .data[CI_lower_name]],
ymax = .data[CI_upper_name]],
fill = .data$color), alpha = 0.5) +
ggplot2::scale_fill_manual(values = color_profile) +
ggplot2::labs(fill = "Type")
}
if (PI_lower_name %in% (smoothed_data) &
PI_upper_name %in% (smoothed_data) &
show_PI){
base_plot <- base_plot +
ggplot2::geom_ribbon(
ggplot2::aes(x = .data[time_col]],
ymin = .data[PI_lower_name]],
ymax = .data[PI_upper_name]],
fill = .data$color), alpha = 0.3)
}
}
}
# Manage faceting + pagination
if (()) {
if ( == "all") {
n_per_page <- *
n_pages <- facet_col_levels %/% (n_per_page) +
(facet_col_levels %% n_per_page >= 1)
sspm_discrete_plot <- ()
for (page_nb (length.out = n_pages)) {
sspm_discrete_plot[page_nb]] <- base_plot +
ggforce::facet_wrap_paginate(~ .data[facet_by]],
= , = ,
= page_nb, scales = scales)
}
} {
sspm_discrete_plot <- base_plot +
ggforce::facet_wrap_paginate(~ .data[facet_by]],
= , = ,
= 1, scales = scales)
}
} if (()) {
sspm_discrete_plot <- base_plot +
ggforce::facet_wrap_paginate(~ .data[facet_by]],
= , = ,
= , scales = scales)
}
(sspm_discrete_plot)
}
