Skip to content

Commit

Permalink
Merge pull request #18 from KWB-R/dev
Browse files Browse the repository at this point in the history
Release v0.1.0
  • Loading branch information
mrustl authored May 18, 2022
2 parents 1823e00 + 58f87b2 commit c6d8254
Show file tree
Hide file tree
Showing 25 changed files with 804 additions and 115 deletions.
7 changes: 4 additions & 3 deletions .github/workflows/R-CMD-check.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -22,13 +22,14 @@ jobs:
fail-fast: false
matrix:
config:
- {os: macOS-latest, r: 'release'}
- {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
- {os: windows-latest, r: 'devel'}
- {os: macOS-latest, r: 'release'}
- {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
- {os: windows-latest, r: 'devel'}
- {os: windows-latest, r: 'oldrel'}
- {os: windows-latest, r: 'release'}

env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
RSPM: ${{ matrix.config.rspm }}

Expand Down
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -3,3 +3,4 @@ sensitivity_analysis_models/tmp.out
docs
inst/doc
.Rhistory
swmm_scenarios
6 changes: 4 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ Package: keys.lid
Title: R Package for Simulating the Impact of Different LIDs
under Varying Climate Boundary Conditions on Annual Volume Rainfall
Retention
Version: 0.0.0.9000
Version: 0.1.0
Authors@R:
c(person(given = "Michael",
family = "Rustler",
Expand Down Expand Up @@ -34,6 +34,7 @@ Imports:
kwb.swmm,
kwb.utils,
plotly,
openxlsx,
scales,
stringr,
swmmr,
Expand All @@ -50,6 +51,7 @@ Suggests:
car,
covr,
DT,
forcats,
fs,
knitr,
rmarkdown
Expand All @@ -63,4 +65,4 @@ Encoding: UTF-8
LazyData: true
LazyDataCompression: xz
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.1.1
RoxygenNote: 7.1.2
2 changes: 1 addition & 1 deletion LICENSE
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
MIT License

Copyright (c) 2020-2021 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
Copyright (c) 2020-2022 Kompetenzzentrum Wasser Berlin gGmbH (KWB)

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
Expand Down
2 changes: 1 addition & 1 deletion LICENSE.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
# MIT License

Copyright (c) 2020-2021 Kompetenzzentrum Wasser Berlin gGmbH (KWB)
Copyright (c) 2020-2022 Kompetenzzentrum Wasser Berlin gGmbH (KWB)

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
Expand Down
4 changes: 4 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,9 @@ export(boxplot_runoff_max)
export(boxplot_runoff_volume)
export(boxplot_vrr)
export(computeVol)
export(export_performances)
export(extdata_file)
export(get_event_percentiles)
export(lidconfig_to_swmm)
export(makeRainfallRunoffEvents)
export(monthlyPattern)
Expand Down Expand Up @@ -35,6 +37,7 @@ importFrom(kwb.utils,catAndRun)
importFrom(kwb.utils,resolve)
importFrom(lubridate,year)
importFrom(magrittr,"%>%")
importFrom(openxlsx,write.xlsx)
importFrom(plotly,ggplotly)
importFrom(plotly,layout)
importFrom(plotly,plot_ly)
Expand All @@ -54,6 +57,7 @@ importFrom(swmmr,read_out)
importFrom(swmmr,run_swmm)
importFrom(swmmr,write_inp)
importFrom(tibble,tibble)
importFrom(tidyr,nest)
importFrom(tidyr,pivot_longer)
importFrom(tidyr,pivot_wider)
importFrom(tidyr,unnest)
Expand Down
7 changes: 7 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,10 @@
# [keys.lid 0.1.0](https://github.com/KWB-R/kwb.fakin/releases/tag/v0.3.0) <small>2022-05-18</small>

Workflow for assessing the hydraulic/hydrological performance of three low
impact developments (bioretention cells, green roofs, permeable pavements),
for details see [here](../articles/scenarios.html).


# keys.lid 0.0.0.9000

* Added a `NEWS.md` file to track changes to the package.
Expand Down
35 changes: 35 additions & 0 deletions R/export_performances.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,35 @@
#' Title
#'
#' @param export_dir default: tempdir()
#'
#' @return write "performances" to "swmm_lid-performances.xlsx" in directory
#' "export_dir" and return path to fike
#' @export
#'
#' @importFrom stats setNames
#' @importFrom tidyselect all_of
#' @importFrom openxlsx write.xlsx
#' @importFrom dplyr select
#' @importFrom tidyr nest
export_performances <- function(export_dir = tempdir()) {

path <- file.path(export_dir, "swmm_lid-performances.xlsx")

list_elements <- names(performances)[sapply(performances, is.list)]


unnest_list_col <- function(list_element) {
list_elements_to_remove <- list_elements[! list_elements %in% list_element]

performances %>%
dplyr::select(!tidyselect::all_of(list_elements_to_remove)) %>%
tidyr::unnest(tidyselect::all_of(list_element))
}

export <- stats::setNames(lapply(list_elements, function(list_element) {
unnest_list_col(list_element)}),
list_elements)

openxlsx::write.xlsx(x = export, file = path)
path
}
86 changes: 86 additions & 0 deletions R/get_event_percentiles.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,86 @@
#' Get Percentiles for Events
#'
#' @param performances nested tibble (default: \code{\link{performances}})
#' @return list with percentiles for "event_sum" and "event_max"
#' @export
#' @importFrom tidyselect all_of
#' @importFrom tidyr unnest
#' @importFrom dplyr select group_by mutate summarise
get_event_percentiles <- function(performances = keys.lid::performances) {

volume <- performances %>%
tidyr::unnest(.data$events_sum)

sel_cols <- c("zone_id",
"lid_name_tidy",
"scenario_name",
"lid_area_fraction",
"runoff_cbm",
"tBeg",
"tEnd")

volume_stats <- volume %>%
dplyr::select(tidyselect::all_of(sel_cols)) %>%
dplyr::group_by(.data$zone_id,
.data$lid_name_tidy,
.data$scenario_name,
.data$lid_area_fraction) %>%
dplyr::mutate(runoff_LitrePerSqm = 1000 * .data$runoff_cbm) %>%
dplyr::summarise(datetime_min = min(.data$tBeg),
datetime_max = max(.data$tEnd),
timeperiod_days = as.numeric(diff(c(datetime_min, datetime_max))),
timeperiod_years = timeperiod_days/365,
number_of_events = dplyr::n(),
events_per_year = number_of_events / timeperiod_years,
runoff_LitrePerSqm_q00 = quantile(.data$runoff_LitrePerSqm, probs = 0),
runoff_LitrePerSqm_q01 = quantile(.data$runoff_LitrePerSqm, probs = 0.01),
runoff_LitrePerSqm_q05 = quantile(.data$runoff_LitrePerSqm, probs = 0.05),
runoff_LitrePerSqm_q10 = quantile(.data$runoff_LitrePerSqm, probs = 0.10),
runoff_LitrePerSqm_q25 = quantile(.data$runoff_LitrePerSqm, probs = 0.25),
runoff_LitrePerSqm_q50 = quantile(.data$runoff_LitrePerSqm, probs = 0.5),
runoff_LitrePerSqm_q75 = quantile(.data$runoff_LitrePerSqm, probs = 0.75),
runoff_LitrePerSqm_q90 = quantile(.data$runoff_LitrePerSqm, probs = 0.9),
runoff_LitrePerSqm_q95 = quantile(.data$runoff_LitrePerSqm, probs = 0.95),
runoff_LitrePerSqm_q99 = quantile(.data$runoff_LitrePerSqm, probs = 0.99),
runoff_LitrePerSqm_q100 = quantile(.data$runoff_LitrePerSqm, probs = 1))


peak <- performances %>%
tidyr::unnest(.data$events_max)

sel_cols <- c("zone_id",
"lid_name_tidy",
"scenario_name",
"lid_area_fraction",
"max_total_runoff_mmPerHour",
"tBeg",
"tEnd")

peak_stats <- peak %>%
dplyr::select(tidyselect::all_of(sel_cols)) %>%
dplyr::group_by(.data$zone_id,
.data$lid_name_tidy,
.data$scenario_name,
.data$lid_area_fraction) %>%
dplyr::summarise(datetime_min = min(.data$tBeg),
datetime_max = max(.data$tEnd),
timeperiod_days = as.numeric(diff(c(datetime_min, datetime_max))),
timeperiod_years = timeperiod_days/365,
number_of_events = dplyr::n(),
events_per_year = number_of_events / timeperiod_years,
runoff_max_mmPerHour_q00 = quantile(.data$max_total_runoff_mmPerHour, probs = 0),
runoff_max_mmPerHour_q01 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.01),
runoff_max_mmPerHour_q05 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.05),
runoff_max_mmPerHour_q10 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.10),
runoff_max_mmPerHour_q25 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.25),
runoff_max_mmPerHour_q50 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.5),
runoff_max_mmPerHour_q75 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.75),
runoff_max_mmPerHour_q90 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.9),
runoff_max_mmPerHour_q95 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.95),
runoff_max_mmPerHour_q99 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.99),
runoff_max_mmPerHour_q100 = quantile(.data$max_total_runoff_mmPerHour, probs = 1))

list(event_max_percentiles = peak_stats,
event_sum_percentiles = volume_stats
)
}
2 changes: 1 addition & 1 deletion R/performances.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#' A dataset containing the performance of LIDs for different climate conditions
#' created with R script in /data-raw/performances.R
#'
#' @format A nested tibble with 290 rows and 16 variables:
#' @format A nested tibble with 575 rows and 16 variables:
#' \describe{
#' \item{zone_id}{climate zone id}
#' \item{lid_name_tidy}{tidy LID name}
Expand Down
32 changes: 21 additions & 11 deletions R/plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ plot_vrr_median <- function(lid = "bioretention_cell",
.data$lid_name_tidy,
.data$scenario_name,
.data$lid_area_fraction) %>%
dplyr::summarise(vrr_median = stats::median(.data$vrr)) %>%
dplyr::summarise(vrr_median = stats::median(.data$vrr), .groups = "drop") %>%
dplyr::ungroup() %>%
ggplot2::ggplot(ggplot2::aes_string(x = "lid_area_fraction",
y = "vrr_median",
Expand All @@ -41,15 +41,22 @@ plot_vrr_median <- function(lid = "bioretention_cell",
ggplot2::labs(title = sprintf("%s (catchment area: %d m2)",
lid,
catchment_area_m2),
y = "Median Volume Rainfall Retended per Year (%)") +
y = "",
x = "") +
ggplot2::coord_cartesian(ylim = c(0,1)) +
ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
ggplot2::theme_bw() +
ggplot2::theme(legend.position = "bottom")

plotly::ggplotly(g) %>%
plotly::layout(legend = list(orientation = "h", x = 0, y = -0.1 ),
ylab = list(orientation = "v", x = 0, y = -0.4 ))
xaxis = list(title=list(text="LID area fraction (%)",
standoff = 0)),
yaxis = list(title=list(text=paste("Median Volume Rainfall Retended per Year (%)",
" ."),
automargin = TRUE))
)
}

#' Boxplot Volume Rainfall Retended per Year
Expand Down Expand Up @@ -80,7 +87,7 @@ boxplot_vrr <- function(lid = "bioretention_cell",
catchment_area_m2 <- unique(perf_selected$catchment_area_m2)

perf_selected %>%
dplyr::mutate(lid_area_fraction = as.factor(.data$lid_area_fraction),
dplyr::mutate(lid_area_fraction = as.factor(.data$lid_area_fraction*100),
scenario_name = as.factor(.data$scenario_name),
label = sprintf("%s (%d m2)", .data$scenario_name, .data$lid_area_m2)) %>%
tidyr::unnest(.data$annual) %>%
Expand All @@ -97,7 +104,8 @@ boxplot_vrr <- function(lid = "bioretention_cell",
zone_id,
lid,
catchment_area_m2),
xaxis = list(title='LID area fraction'),
xaxis = list(title='LID area fraction (%)',
standoff = 0),
yaxis = list(title='Volume Rainfall Retended (%)',
range = c(0, 100)),
legend = list(orientation = "h", x = 0, y = -0.1 ))
Expand Down Expand Up @@ -134,7 +142,7 @@ boxplot_runoff_max <- function(lid = "bioretention_cell",
catchment_area_m2 <- unique(perf_selected$catchment_area_m2)

perf_selected %>%
dplyr::mutate(lid_area_fraction = as.factor(lid_area_fraction),
dplyr::mutate(lid_area_fraction = as.factor(lid_area_fraction*100),
scenario_name = as.factor(.data$scenario_name),
label = sprintf("%s (%d m2)", .data$scenario_name, .data$lid_area_m2)) %>%
tidyr::unnest(.data$events_max) %>%
Expand All @@ -151,7 +159,8 @@ boxplot_runoff_max <- function(lid = "bioretention_cell",
zone_id,
lid,
catchment_area_m2),
xaxis = list(title='LID area fraction'),
xaxis = list(title='LID area fraction (%)',
standoff = 0),
yaxis = list(title='Maximum total runoff (mm/h per event)'),
legend = list(orientation = "h", x = 0, y = -0.1 ))

Expand Down Expand Up @@ -194,18 +203,19 @@ boxplot_runoff_volume <- function(lid = "bioretention_cell",
.data$lid_name_tidy,
.data$scenario_name,
.data$lid_area_fraction) %>%
dplyr::mutate(sum_total_runoff_cbm = .data$dur * .data$sum_total_runoff / 1000 / catchment_area_m2) %>%
dplyr::mutate(runoff_LitrePerSqm = .data$runoff_cbm * 1000) %>%
plotly::plot_ly(x = ~lid_area_fraction,
y = ~sum_total_runoff_cbm,
y = ~runoff_LitrePerSqm,
color = ~scenario_name,
type = "box") %>%
plotly::layout(boxmode = "group",
title = sprintf("zone %d: %s (catchment area: %s m2)",
zone_id,
lid,
catchment_area_m2),
xaxis = list(title='LID area fraction'),
yaxis = list(title='Total Runoff Volume (m3 per m2 per event)'),
xaxis = list(title="LID area fraction (%)",
standoff = 0),
yaxis = list(title="Total Runoff Volume (litre per m2 per event)"),
legend = list(orientation = "h", x = 0, y = -0.1 ))


Expand Down
24 changes: 14 additions & 10 deletions R/simulate_performance.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,8 +3,6 @@
#' @param lid_selected tibble with a selected LID as retrieved by \code{\link{read_scenarios}}
#' @param lid_area_fraction fraction of LID in subcatchment (default: 0)
#' @param catchment_area_m2 catchment area (default: 1000 m2)
#' @param col_eventsep SWMM output column used for event separation (default:
#' "total_rainfall")
#' @param swmm_base_inp path to SWMM model to be used as template for modification
#' (default: keys.lid::extdata_file("scenarios/models/model_template.inp"))
#' @param swmm_climate_dir directory with climate data
Expand Down Expand Up @@ -42,7 +40,6 @@ simulate_performance <- function(
lid_selected,
lid_area_fraction = 0,
catchment_area_m2 = 1000,
col_eventsep = "total_rainfall",
swmm_base_inp = keys.lid::extdata_file("scenarios/models/model_template.inp"),
swmm_climate_dir = keys.lid::extdata_file("rawdata/weather_sponge_regions"),
swmm_exe = NULL,
Expand Down Expand Up @@ -145,23 +142,30 @@ simulate_performance <- function(

results_system <- kwb.swmm::get_results(path_out = path_out_file,
vIndex = c(1,4)) %>%
dplyr::mutate(total_runoff_mmPerHour = lps_to_mmPerHour(.data$total_runoff))
dplyr::rename(total_rainfall_mmPerHour = .data$total_rainfall,
total_runoff_litrePerSecond = .data$total_runoff) %>%
dplyr::mutate(total_runoff_mmPerHour = lps_to_mmPerHour(.data$total_runoff_litrePerSecond)) %>%
dplyr::select(- .data$total_runoff_litrePerSecond)

results_vrr <- results_system %>%
dplyr::mutate(year = lubridate::year(.data$datetime)) %>%
dplyr::group_by(.data$year) %>%
dplyr::summarise(vrr = 1 - (sum(.data$total_runoff_mmPerHour) / sum(.data$total_rainfall)))
dplyr::summarise(vrr = 1 - (sum(.data$total_runoff_mmPerHour) / sum(.data$total_rainfall_mmPerHour)))

col_eventsep <- "total_rainfall_mmPerHour"

rainevent_stats_sum <- kwb.swmm::calculate_rainevent_stats(results_system,
rainevent_stats_mean <- kwb.swmm::calculate_rainevent_stats(results_system,
col_eventsep = col_eventsep,
aggregation_function = "sum") %>%
dplyr::arrange(dplyr::desc(.data$sum_total_rainfall))
aggregation_function = "mean") %>%
dplyr::mutate(rainfall_cbm = .data$dur * .data$mean_total_rainfall_mmPerHour/3600/1000,
runoff_cbm = .data$dur * .data$mean_total_runoff_mmPerHour/3600/1000,
vrr = 1 - runoff_cbm / rainfall_cbm) %>%
dplyr::arrange(dplyr::desc(.data$mean_total_rainfall_mmPerHour))

rainevent_stats_max <- kwb.swmm::calculate_rainevent_stats(results_system,
col_eventsep = col_eventsep,
aggregation_function = "max") %>%
dplyr::arrange(dplyr::desc(.data$max_total_rainfall))
dplyr::arrange(dplyr::desc(.data$max_total_rainfall_mmPerHour))


tibble::tibble(lid_name_tidy = unique(lid_selected$lid_name_tidy),
Expand All @@ -173,7 +177,7 @@ simulate_performance <- function(
lid_controls = list(lid_controls),
subcatchment = list(subcatchment),
annual = list(results_vrr),
events_sum = list(rainevent_stats_sum),
events_sum = list(rainevent_stats_mean),
events_max = list(rainevent_stats_max),
col_eventsep = col_eventsep,
model_inp = path_inp_file,
Expand Down
Loading

0 comments on commit c6d8254

Please sign in to comment.