In WDNR-Water-Use/CSLSscenarios: CSLS MODFLOW Scenario Analysis
library(dplyr)
library(CSLSscenarios)
library(reshape2)
library(NISTunits)
library(ggplot2)
library(extrafont)
library(patchwork)
library(lubridate)
MODFLOW <- CSLSdata::MODFLOW %>%
filter(.data$scenario %in% c("no_irr", "cur_irr"),
year(.data$date) >= 1986) %>%
select(.data$lake, .data$scenario, .data$sim,
.data$date, .data$level_m)
MODFLOW_metrics <- CSLSscenarios::MODFLOW_metrics %>%
filter(.data$scenario %in% c("no_irr", "cur_irr")) %>%
mutate(value = ifelse(.data$metric == "area",
NISTsqrMeterTOacre(.data$value),
ifelse(.data$metric == "volume",
NISTcubMeterTOacreFt(.data$value),
.data$value)))
MODFLOW_diff <- dcast(MODFLOW_metrics,
lake+metric+variable+sim+series~scenario,
value.var = "value") %>%
mutate(value = .data$cur_irr - .data$no_irr)
compare_width <- 6.5
compare_height <- 6
diff_width <- 6.5
diff_height <- 5
plot_comparison <- function(df,
metric = data.frame(metric = "exceedance_level",
ylabel = "Lake Elevation (ft)",
mTOft = TRUE),
variables = data.frame(breaks = c("10", "25", "50",
"75", "90"),
labels = c("Infrequent\nHigh",
"Frequent\nHigh",
"Median",
"Frequent\nLow",
"Infrequent\nLow")),
series = "month",
colors = data.frame(breaks = c("no_irr", "cur_irr"),
labels = c("No Irrigation",
"Current Irrigation"),
values = c("darkblue",
"gold")),
text_size = 12,
legend_position = "top") {
# Manipulate data frame for plotting
df <- df %>%
filter(.data$metric == !!metric$metric,
.data$series == !!series,
.data$variable %in% variables$breaks)
df$scenario <- factor(df$scenario, levels = colors$breaks)
df$variable <- factor(df$variable, levels = variables$breaks)
if (metric$mTOft) {
df$value <- NISTmeterTOft(df$value)
}
# Plot
plot_obj <- ggplot(df) +
geom_boxplot(aes(x = as.factor(.data$variable),
y = .data$value,
fill = .data$scenario),
position = position_dodge()) +
scale_fill_manual(name = "",
breaks = colors$breaks,
labels = colors$labels,
values = colors$values) +
scale_x_discrete(breaks = variables$breaks,
labels = variables$labels) +
labs(x = "", y = metric$ylabel) +
facet_wrap(~lake, scales = "free_y", ncol = 1) +
theme_bw() +
theme(text = element_text(family = "Segoe UI Semilight",
size = text_size),
legend.position = legend_position)
return(plot_obj)
}
plot_diff <- function(df,
metric = data.frame(metric = "exceedance_level",
ylabel = "Lake Elevation (ft)",
mTOft = TRUE),
variables = data.frame(breaks = c("10", "25", "50",
"75", "90"),
labels = c("Infrequent\nHigh",
"Frequent\nHigh",
"Median",
"Frequent\nLow",
"Infrequent\nLow")),
series = "month",
colors = "grey40",
text_size = 12) {
# Manipulate data frame for plotting
df <- df %>%
filter(.data$metric == !!metric$metric,
.data$series == !!series,
.data$variable %in% variables$breaks)
df$variable <- factor(df$variable, levels = variables$breaks)
if (metric$mTOft) {
df$value <- NISTmeterTOft(df$value)
}
# Plot
plot_obj <- ggplot(df) +
geom_hline(yintercept = 0,
color = "black",
linetype = "dashed") +
geom_boxplot(aes(x = as.factor(.data$variable),
y = .data$value),
fill = colors) +
scale_x_discrete(breaks = variables$breaks,
labels = variables$labels) +
labs(x = "", y = metric$ylabel) +
facet_wrap(~lake, ncol = 1) +
theme_bw() +
theme(text = element_text(family = "Segoe UI Semilight",
size = text_size))
return(plot_obj)
}
Overview
This document compares the full suite of no-irrigated-agriculture simulations to
the current-irrigated-agriculture simulations. These Monte Carlo simulations
were run to capture the uncertainty in the Soil Water Balance parameterization,
and thus uncertainty in our estimation of recharge. Here, pairwise differences
indicate the difference between a no-irrigated-agriculture simulation and the
corresponding current-irrigated-agriculture simulation with the same SWB
parameterization (i.e., an apples to apples comparison).
Magnitude
Exceedance Probabilities
Comparison
plot_comparison(MODFLOW_metrics)
Pairwise Differences
plot_diff(MODFLOW_diff)
Exceedance Ranges
Comparison
metric <- data.frame(metric = "exceedance_range",
ylabel = "Range (ft)",
mTOft = TRUE)
variables<- data.frame(breaks = c("range_10_90",
"range_25_75"),
labels = c("Infrequent High -\nInfrequent Low",
"Frequent High -\nFrequent Low"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Max Lake Depth
Comparison
metric <- data.frame(metric = "max_depth",
ylabel = "Maximum Depth (ft)",
mTOft = TRUE)
variables<- data.frame(breaks = c("10", "25", "50",
"75", "90"),
labels = c("Infrequent\nHigh",
"Frequent\nHigh",
"Median",
"Frequent\nLow",
"Infrequent\nLow"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Mean Lake Depth
Comparison
metric <- data.frame(metric = "mean_depth",
ylabel = "Mean Depth (ft)",
mTOft = TRUE)
variables<- data.frame(breaks = c("10", "25", "50",
"75", "90"),
labels = c("Infrequent\nHigh",
"Frequent\nHigh",
"Median",
"Frequent\nLow",
"Infrequent\nLow"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Lake Area
Comparison
metric <- data.frame(metric = "area",
ylabel = "Lake Area (ac)",
mTOft = FALSE)
variables<- data.frame(breaks = c("10", "25", "50",
"75", "90"),
labels = c("Infrequent\nHigh",
"Frequent\nHigh",
"Median",
"Frequent\nLow",
"Infrequent\nLow"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Lake Volume
Comparison
metric <- data.frame(metric = "volume",
ylabel = "Lake Volume (ac-ft)",
mTOft = FALSE)
variables<- data.frame(breaks = c("10", "25", "50",
"75", "90"),
labels = c("Infrequent\nHigh",
"Frequent\nHigh",
"Median",
"Frequent\nLow",
"Infrequent\nLow"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Seasonal Medians
Comparison
metric <- data.frame(metric = "median_level",
ylabel = "Median Lake Elevation (ft)",
mTOft = TRUE)
variables <- data.frame(breaks = c("1", "4", "7", "10"),
labels = c("Winter", "Spring", "Summer", "Fall"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables,
series = "season")
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables,
series = "season")
Frequency
Long Lake - Is Lake & Paddle Sports
Comparison
metric <- data.frame(metric = "is_lake",
ylabel = "Percent of Time",
mTOft = FALSE)
variables <- data.frame(breaks = c("percent_epa_lake", "percent_lake_warm",
"percent_open_lake"),
labels = c("Is Lake", "Paddle Sport\nPossible", "Is Open\nLake"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Move Docks
Comparison
metric <- data.frame(metric = "dock",
ylabel = "Percent of Years",
mTOft = FALSE)
variables <- data.frame(breaks = c("percent_install",
"percent_no_move",
"percent_good_year"),
labels = c("Install Dock",
"No Move Dock",
"Good Dock"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Duration
Number of Times > 2 yrs
Both scenarios are evaluated relative to the "No Irrigation" median levels.
Comparison
metric <- data.frame(metric = "num_2yr",
ylabel = "Number of Times in 33 years",
mTOft = FALSE)
variables <- data.frame(breaks = c("a50",
"b50"),
labels = c("Above Median",
"Below Median"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Median Duration
Both scenarios are evaluated relative to the "No Irrigation" exceedance
probability levels.
Comparison
metric <- data.frame(metric = "median_dur",
ylabel = "Median Duration (months)",
mTOft = FALSE)
variables <- data.frame(breaks = c("10", "25", "a50", "b50", "75", "90"),
labels = c("Infrequent\nHigh",
"Frequent\nHigh",
"Above\nMedian",
"Below\nMedian",
"Frequent\nLow",
"Infrequent\nLow"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Rate of Change
Median Rise Rate
Comparison
metric <- data.frame(metric = "median_rise_rate",
ylabel = "Median Rise Rate (ft/time period)",
mTOft = TRUE)
variables <- data.frame(breaks = c("1", "3", "12"),
labels = c("1 Month",
"3 Months",
"12 Months"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Median Fall Rate
Comparison
metric <- data.frame(metric = "median_fall_rate",
ylabel = "Median Fall Rate (ft/time period)",
mTOft = TRUE)
variables <- data.frame(breaks = c("1", "3", "12"),
labels = c("1 Month",
"3 Months",
"12 Months"))
plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Timing
Good Spawning Years
Comparison
metric <- data.frame(metric = "good_spawning",
ylabel = "Good Spawning Years (%)",
mTOft = FALSE)
variables <- data.frame(breaks = c("high_spring",
"steady_summer",
"good_spawning"),
labels = c("High Spring",
"Steady Summer",
"Good Spawning"))
plot_comparison(filter(MODFLOW_metrics, .data$lake == "Pleasant"),
metric = metric, variables = variables)
Pairwise Differences
plot_diff(filter(MODFLOW_diff, .data$lake == "Pleasant"),
metric = metric, variables = variables)
WDNR-Water-Use/CSLSscenarios documentation built on Nov. 10, 2021, 4:14 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(dplyr) library(CSLSscenarios) library(reshape2) library(NISTunits) library(ggplot2) library(extrafont) library(patchwork) library(lubridate) MODFLOW <- CSLSdata::MODFLOW %>% filter(.data$scenario %in% c("no_irr", "cur_irr"), year(.data$date) >= 1986) %>% select(.data$lake, .data$scenario, .data$sim, .data$date, .data$level_m) MODFLOW_metrics <- CSLSscenarios::MODFLOW_metrics %>% filter(.data$scenario %in% c("no_irr", "cur_irr")) %>% mutate(value = ifelse(.data$metric == "area", NISTsqrMeterTOacre(.data$value), ifelse(.data$metric == "volume", NISTcubMeterTOacreFt(.data$value), .data$value))) MODFLOW_diff <- dcast(MODFLOW_metrics, lake+metric+variable+sim+series~scenario, value.var = "value") %>% mutate(value = .data$cur_irr - .data$no_irr) compare_width <- 6.5 compare_height <- 6 diff_width <- 6.5 diff_height <- 5
plot_comparison <- function(df, metric = data.frame(metric = "exceedance_level", ylabel = "Lake Elevation (ft)", mTOft = TRUE), variables = data.frame(breaks = c("10", "25", "50", "75", "90"), labels = c("Infrequent\nHigh", "Frequent\nHigh", "Median", "Frequent\nLow", "Infrequent\nLow")), series = "month", colors = data.frame(breaks = c("no_irr", "cur_irr"), labels = c("No Irrigation", "Current Irrigation"), values = c("darkblue", "gold")), text_size = 12, legend_position = "top") { # Manipulate data frame for plotting df <- df %>% filter(.data$metric == !!metric$metric, .data$series == !!series, .data$variable %in% variables$breaks) df$scenario <- factor(df$scenario, levels = colors$breaks) df$variable <- factor(df$variable, levels = variables$breaks) if (metric$mTOft) { df$value <- NISTmeterTOft(df$value) } # Plot plot_obj <- ggplot(df) + geom_boxplot(aes(x = as.factor(.data$variable), y = .data$value, fill = .data$scenario), position = position_dodge()) + scale_fill_manual(name = "", breaks = colors$breaks, labels = colors$labels, values = colors$values) + scale_x_discrete(breaks = variables$breaks, labels = variables$labels) + labs(x = "", y = metric$ylabel) + facet_wrap(~lake, scales = "free_y", ncol = 1) + theme_bw() + theme(text = element_text(family = "Segoe UI Semilight", size = text_size), legend.position = legend_position) return(plot_obj) }
plot_diff <- function(df, metric = data.frame(metric = "exceedance_level", ylabel = "Lake Elevation (ft)", mTOft = TRUE), variables = data.frame(breaks = c("10", "25", "50", "75", "90"), labels = c("Infrequent\nHigh", "Frequent\nHigh", "Median", "Frequent\nLow", "Infrequent\nLow")), series = "month", colors = "grey40", text_size = 12) { # Manipulate data frame for plotting df <- df %>% filter(.data$metric == !!metric$metric, .data$series == !!series, .data$variable %in% variables$breaks) df$variable <- factor(df$variable, levels = variables$breaks) if (metric$mTOft) { df$value <- NISTmeterTOft(df$value) } # Plot plot_obj <- ggplot(df) + geom_hline(yintercept = 0, color = "black", linetype = "dashed") + geom_boxplot(aes(x = as.factor(.data$variable), y = .data$value), fill = colors) + scale_x_discrete(breaks = variables$breaks, labels = variables$labels) + labs(x = "", y = metric$ylabel) + facet_wrap(~lake, ncol = 1) + theme_bw() + theme(text = element_text(family = "Segoe UI Semilight", size = text_size)) return(plot_obj) }
Overview
This document compares the full suite of no-irrigated-agriculture simulations to the current-irrigated-agriculture simulations. These Monte Carlo simulations were run to capture the uncertainty in the Soil Water Balance parameterization, and thus uncertainty in our estimation of recharge. Here, pairwise differences indicate the difference between a no-irrigated-agriculture simulation and the corresponding current-irrigated-agriculture simulation with the same SWB parameterization (i.e., an apples to apples comparison).
Magnitude
Exceedance Probabilities
Comparison
plot_comparison(MODFLOW_metrics)
Pairwise Differences
plot_diff(MODFLOW_diff)
Exceedance Ranges
Comparison
metric <- data.frame(metric = "exceedance_range", ylabel = "Range (ft)", mTOft = TRUE) variables<- data.frame(breaks = c("range_10_90", "range_25_75"), labels = c("Infrequent High -\nInfrequent Low", "Frequent High -\nFrequent Low")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Max Lake Depth
Comparison
metric <- data.frame(metric = "max_depth", ylabel = "Maximum Depth (ft)", mTOft = TRUE) variables<- data.frame(breaks = c("10", "25", "50", "75", "90"), labels = c("Infrequent\nHigh", "Frequent\nHigh", "Median", "Frequent\nLow", "Infrequent\nLow")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Mean Lake Depth
Comparison
metric <- data.frame(metric = "mean_depth", ylabel = "Mean Depth (ft)", mTOft = TRUE) variables<- data.frame(breaks = c("10", "25", "50", "75", "90"), labels = c("Infrequent\nHigh", "Frequent\nHigh", "Median", "Frequent\nLow", "Infrequent\nLow")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Lake Area
Comparison
metric <- data.frame(metric = "area", ylabel = "Lake Area (ac)", mTOft = FALSE) variables<- data.frame(breaks = c("10", "25", "50", "75", "90"), labels = c("Infrequent\nHigh", "Frequent\nHigh", "Median", "Frequent\nLow", "Infrequent\nLow")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Lake Volume
Comparison
metric <- data.frame(metric = "volume", ylabel = "Lake Volume (ac-ft)", mTOft = FALSE) variables<- data.frame(breaks = c("10", "25", "50", "75", "90"), labels = c("Infrequent\nHigh", "Frequent\nHigh", "Median", "Frequent\nLow", "Infrequent\nLow")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Seasonal Medians
Comparison
metric <- data.frame(metric = "median_level", ylabel = "Median Lake Elevation (ft)", mTOft = TRUE) variables <- data.frame(breaks = c("1", "4", "7", "10"), labels = c("Winter", "Spring", "Summer", "Fall")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables, series = "season")
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables, series = "season")
Frequency
Long Lake - Is Lake & Paddle Sports
Comparison
metric <- data.frame(metric = "is_lake", ylabel = "Percent of Time", mTOft = FALSE) variables <- data.frame(breaks = c("percent_epa_lake", "percent_lake_warm", "percent_open_lake"), labels = c("Is Lake", "Paddle Sport\nPossible", "Is Open\nLake")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Move Docks
Comparison
metric <- data.frame(metric = "dock", ylabel = "Percent of Years", mTOft = FALSE) variables <- data.frame(breaks = c("percent_install", "percent_no_move", "percent_good_year"), labels = c("Install Dock", "No Move Dock", "Good Dock")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Duration
Number of Times > 2 yrs
Both scenarios are evaluated relative to the "No Irrigation" median levels.
Comparison
metric <- data.frame(metric = "num_2yr", ylabel = "Number of Times in 33 years", mTOft = FALSE) variables <- data.frame(breaks = c("a50", "b50"), labels = c("Above Median", "Below Median")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Median Duration
Both scenarios are evaluated relative to the "No Irrigation" exceedance probability levels.
Comparison
metric <- data.frame(metric = "median_dur", ylabel = "Median Duration (months)", mTOft = FALSE) variables <- data.frame(breaks = c("10", "25", "a50", "b50", "75", "90"), labels = c("Infrequent\nHigh", "Frequent\nHigh", "Above\nMedian", "Below\nMedian", "Frequent\nLow", "Infrequent\nLow")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Rate of Change
Median Rise Rate
Comparison
metric <- data.frame(metric = "median_rise_rate", ylabel = "Median Rise Rate (ft/time period)", mTOft = TRUE) variables <- data.frame(breaks = c("1", "3", "12"), labels = c("1 Month", "3 Months", "12 Months")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Median Fall Rate
Comparison
metric <- data.frame(metric = "median_fall_rate", ylabel = "Median Fall Rate (ft/time period)", mTOft = TRUE) variables <- data.frame(breaks = c("1", "3", "12"), labels = c("1 Month", "3 Months", "12 Months")) plot_comparison(MODFLOW_metrics, metric = metric, variables = variables)
Pairwise Differences
plot_diff(MODFLOW_diff, metric = metric, variables = variables)
Timing
Good Spawning Years
Comparison
metric <- data.frame(metric = "good_spawning", ylabel = "Good Spawning Years (%)", mTOft = FALSE) variables <- data.frame(breaks = c("high_spring", "steady_summer", "good_spawning"), labels = c("High Spring", "Steady Summer", "Good Spawning")) plot_comparison(filter(MODFLOW_metrics, .data$lake == "Pleasant"), metric = metric, variables = variables)
Pairwise Differences
plot_diff(filter(MODFLOW_diff, .data$lake == "Pleasant"), metric = metric, variables = variables)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.