Skip to content

Commit c6d8254

Browse files
mrustlmrustl
authored
Merge pull request #18 from KWB-R/dev
Release v0.1.0
2 parents 1823e00 + 58f87b2 commit c6d8254

25 files changed

+804
-115
lines changed

‎.github/workflows/R-CMD-check.yaml

+4-3
Original file line numberDiff line numberDiff line change
@@ -22,13 +22,14 @@ jobs:
2222
fail-fast: false
2323
matrix:
2424
config:
25-
- {os: macOS-latest, r: 'release'}
26-
- {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
27-
- {os: windows-latest, r: 'devel'}
25+
- {os: macOS-latest, r: 'release'}
26+
- {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
27+
- {os: windows-latest, r: 'devel'}
2828
- {os: windows-latest, r: 'oldrel'}
2929
- {os: windows-latest, r: 'release'}
3030

3131
env:
32+
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
3233
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
3334
RSPM: ${{ matrix.config.rspm }}
3435

‎.gitignore

+1
Original file line numberDiff line numberDiff line change
@@ -3,3 +3,4 @@ sensitivity_analysis_models/tmp.out
33
docs
44
inst/doc
55
.Rhistory
6+
swmm_scenarios

‎DESCRIPTION

+4-2
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ Package: keys.lid
22
Title: R Package for Simulating the Impact of Different LIDs
33
under Varying Climate Boundary Conditions on Annual Volume Rainfall
44
Retention
5-
Version: 0.0.0.9000
5+
Version: 0.1.0
66
Authors@R:
77
c(person(given = "Michael",
88
family = "Rustler",
@@ -34,6 +34,7 @@ Imports:
3434
kwb.swmm,
3535
kwb.utils,
3636
plotly,
37+
openxlsx,
3738
scales,
3839
stringr,
3940
swmmr,
@@ -50,6 +51,7 @@ Suggests:
5051
car,
5152
covr,
5253
DT,
54+
forcats,
5355
fs,
5456
knitr,
5557
rmarkdown
@@ -63,4 +65,4 @@ Encoding: UTF-8
6365
LazyData: true
6466
LazyDataCompression: xz
6567
Roxygen: list(markdown = TRUE)
66-
RoxygenNote: 7.1.1
68+
RoxygenNote: 7.1.2

‎LICENSE

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
MIT License
22

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

55
Permission is hereby granted, free of charge, to any person obtaining a copy
66
of this software and associated documentation files (the "Software"), to deal

‎LICENSE.md

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
# MIT License
22

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

55
Permission is hereby granted, free of charge, to any person obtaining a copy
66
of this software and associated documentation files (the "Software"), to deal

‎NAMESPACE

+4
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,9 @@ export(boxplot_runoff_max)
55
export(boxplot_runoff_volume)
66
export(boxplot_vrr)
77
export(computeVol)
8+
export(export_performances)
89
export(extdata_file)
10+
export(get_event_percentiles)
911
export(lidconfig_to_swmm)
1012
export(makeRainfallRunoffEvents)
1113
export(monthlyPattern)
@@ -35,6 +37,7 @@ importFrom(kwb.utils,catAndRun)
3537
importFrom(kwb.utils,resolve)
3638
importFrom(lubridate,year)
3739
importFrom(magrittr,"%>%")
40+
importFrom(openxlsx,write.xlsx)
3841
importFrom(plotly,ggplotly)
3942
importFrom(plotly,layout)
4043
importFrom(plotly,plot_ly)
@@ -54,6 +57,7 @@ importFrom(swmmr,read_out)
5457
importFrom(swmmr,run_swmm)
5558
importFrom(swmmr,write_inp)
5659
importFrom(tibble,tibble)
60+
importFrom(tidyr,nest)
5761
importFrom(tidyr,pivot_longer)
5862
importFrom(tidyr,pivot_wider)
5963
importFrom(tidyr,unnest)

‎NEWS.md

+7
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,10 @@
1+
# [keys.lid 0.1.0](https://github.com/KWB-R/kwb.fakin/releases/tag/v0.3.0) <small>2022-05-18</small>
2+
3+
Workflow for assessing the hydraulic/hydrological performance of three low
4+
impact developments (bioretention cells, green roofs, permeable pavements),
5+
for details see [here](../articles/scenarios.html).
6+
7+
18
# keys.lid 0.0.0.9000
29

310
* Added a `NEWS.md` file to track changes to the package.

‎R/export_performances.R

+35
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
#' Title
2+
#'
3+
#' @param export_dir default: tempdir()
4+
#'
5+
#' @return write "performances" to "swmm_lid-performances.xlsx" in directory
6+
#' "export_dir" and return path to fike
7+
#' @export
8+
#'
9+
#' @importFrom stats setNames
10+
#' @importFrom tidyselect all_of
11+
#' @importFrom openxlsx write.xlsx
12+
#' @importFrom dplyr select
13+
#' @importFrom tidyr nest
14+
export_performances <- function(export_dir = tempdir()) {
15+
16+
path <- file.path(export_dir, "swmm_lid-performances.xlsx")
17+
18+
list_elements <- names(performances)[sapply(performances, is.list)]
19+
20+
21+
unnest_list_col <- function(list_element) {
22+
list_elements_to_remove <- list_elements[! list_elements %in% list_element]
23+
24+
performances %>%
25+
dplyr::select(!tidyselect::all_of(list_elements_to_remove)) %>%
26+
tidyr::unnest(tidyselect::all_of(list_element))
27+
}
28+
29+
export <- stats::setNames(lapply(list_elements, function(list_element) {
30+
unnest_list_col(list_element)}),
31+
list_elements)
32+
33+
openxlsx::write.xlsx(x = export, file = path)
34+
path
35+
}

‎R/get_event_percentiles.R

+86
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
#' Get Percentiles for Events
2+
#'
3+
#' @param performances nested tibble (default: \code{\link{performances}})
4+
#' @return list with percentiles for "event_sum" and "event_max"
5+
#' @export
6+
#' @importFrom tidyselect all_of
7+
#' @importFrom tidyr unnest
8+
#' @importFrom dplyr select group_by mutate summarise
9+
get_event_percentiles <- function(performances = keys.lid::performances) {
10+
11+
volume <- performances %>%
12+
tidyr::unnest(.data$events_sum)
13+
14+
sel_cols <- c("zone_id",
15+
"lid_name_tidy",
16+
"scenario_name",
17+
"lid_area_fraction",
18+
"runoff_cbm",
19+
"tBeg",
20+
"tEnd")
21+
22+
volume_stats <- volume %>%
23+
dplyr::select(tidyselect::all_of(sel_cols)) %>%
24+
dplyr::group_by(.data$zone_id,
25+
.data$lid_name_tidy,
26+
.data$scenario_name,
27+
.data$lid_area_fraction) %>%
28+
dplyr::mutate(runoff_LitrePerSqm = 1000 * .data$runoff_cbm) %>%
29+
dplyr::summarise(datetime_min = min(.data$tBeg),
30+
datetime_max = max(.data$tEnd),
31+
timeperiod_days = as.numeric(diff(c(datetime_min, datetime_max))),
32+
timeperiod_years = timeperiod_days/365,
33+
number_of_events = dplyr::n(),
34+
events_per_year = number_of_events / timeperiod_years,
35+
runoff_LitrePerSqm_q00 = quantile(.data$runoff_LitrePerSqm, probs = 0),
36+
runoff_LitrePerSqm_q01 = quantile(.data$runoff_LitrePerSqm, probs = 0.01),
37+
runoff_LitrePerSqm_q05 = quantile(.data$runoff_LitrePerSqm, probs = 0.05),
38+
runoff_LitrePerSqm_q10 = quantile(.data$runoff_LitrePerSqm, probs = 0.10),
39+
runoff_LitrePerSqm_q25 = quantile(.data$runoff_LitrePerSqm, probs = 0.25),
40+
runoff_LitrePerSqm_q50 = quantile(.data$runoff_LitrePerSqm, probs = 0.5),
41+
runoff_LitrePerSqm_q75 = quantile(.data$runoff_LitrePerSqm, probs = 0.75),
42+
runoff_LitrePerSqm_q90 = quantile(.data$runoff_LitrePerSqm, probs = 0.9),
43+
runoff_LitrePerSqm_q95 = quantile(.data$runoff_LitrePerSqm, probs = 0.95),
44+
runoff_LitrePerSqm_q99 = quantile(.data$runoff_LitrePerSqm, probs = 0.99),
45+
runoff_LitrePerSqm_q100 = quantile(.data$runoff_LitrePerSqm, probs = 1))
46+
47+
48+
peak <- performances %>%
49+
tidyr::unnest(.data$events_max)
50+
51+
sel_cols <- c("zone_id",
52+
"lid_name_tidy",
53+
"scenario_name",
54+
"lid_area_fraction",
55+
"max_total_runoff_mmPerHour",
56+
"tBeg",
57+
"tEnd")
58+
59+
peak_stats <- peak %>%
60+
dplyr::select(tidyselect::all_of(sel_cols)) %>%
61+
dplyr::group_by(.data$zone_id,
62+
.data$lid_name_tidy,
63+
.data$scenario_name,
64+
.data$lid_area_fraction) %>%
65+
dplyr::summarise(datetime_min = min(.data$tBeg),
66+
datetime_max = max(.data$tEnd),
67+
timeperiod_days = as.numeric(diff(c(datetime_min, datetime_max))),
68+
timeperiod_years = timeperiod_days/365,
69+
number_of_events = dplyr::n(),
70+
events_per_year = number_of_events / timeperiod_years,
71+
runoff_max_mmPerHour_q00 = quantile(.data$max_total_runoff_mmPerHour, probs = 0),
72+
runoff_max_mmPerHour_q01 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.01),
73+
runoff_max_mmPerHour_q05 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.05),
74+
runoff_max_mmPerHour_q10 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.10),
75+
runoff_max_mmPerHour_q25 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.25),
76+
runoff_max_mmPerHour_q50 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.5),
77+
runoff_max_mmPerHour_q75 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.75),
78+
runoff_max_mmPerHour_q90 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.9),
79+
runoff_max_mmPerHour_q95 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.95),
80+
runoff_max_mmPerHour_q99 = quantile(.data$max_total_runoff_mmPerHour, probs = 0.99),
81+
runoff_max_mmPerHour_q100 = quantile(.data$max_total_runoff_mmPerHour, probs = 1))
82+
83+
list(event_max_percentiles = peak_stats,
84+
event_sum_percentiles = volume_stats
85+
)
86+
}

‎R/performances.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
#' A dataset containing the performance of LIDs for different climate conditions
44
#' created with R script in /data-raw/performances.R
55
#'
6-
#' @format A nested tibble with 290 rows and 16 variables:
6+
#' @format A nested tibble with 575 rows and 16 variables:
77
#' \describe{
88
#' \item{zone_id}{climate zone id}
99
#' \item{lid_name_tidy}{tidy LID name}

‎R/plot.R

+21-11
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ plot_vrr_median <- function(lid = "bioretention_cell",
3030
.data$lid_name_tidy,
3131
.data$scenario_name,
3232
.data$lid_area_fraction) %>%
33-
dplyr::summarise(vrr_median = stats::median(.data$vrr)) %>%
33+
dplyr::summarise(vrr_median = stats::median(.data$vrr), .groups = "drop") %>%
3434
dplyr::ungroup() %>%
3535
ggplot2::ggplot(ggplot2::aes_string(x = "lid_area_fraction",
3636
y = "vrr_median",
@@ -41,15 +41,22 @@ plot_vrr_median <- function(lid = "bioretention_cell",
4141
ggplot2::labs(title = sprintf("%s (catchment area: %d m2)",
4242
lid,
4343
catchment_area_m2),
44-
y = "Median Volume Rainfall Retended per Year (%)") +
44+
y = "",
45+
x = "") +
4546
ggplot2::coord_cartesian(ylim = c(0,1)) +
47+
ggplot2::scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
4648
ggplot2::scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
4749
ggplot2::theme_bw() +
4850
ggplot2::theme(legend.position = "bottom")
4951

5052
plotly::ggplotly(g) %>%
5153
plotly::layout(legend = list(orientation = "h", x = 0, y = -0.1 ),
52-
ylab = list(orientation = "v", x = 0, y = -0.4 ))
54+
xaxis = list(title=list(text="LID area fraction (%)",
55+
standoff = 0)),
56+
yaxis = list(title=list(text=paste("Median Volume Rainfall Retended per Year (%)",
57+
" ."),
58+
automargin = TRUE))
59+
)
5360
}
5461

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

8289
perf_selected %>%
83-
dplyr::mutate(lid_area_fraction = as.factor(.data$lid_area_fraction),
90+
dplyr::mutate(lid_area_fraction = as.factor(.data$lid_area_fraction*100),
8491
scenario_name = as.factor(.data$scenario_name),
8592
label = sprintf("%s (%d m2)", .data$scenario_name, .data$lid_area_m2)) %>%
8693
tidyr::unnest(.data$annual) %>%
@@ -97,7 +104,8 @@ boxplot_vrr <- function(lid = "bioretention_cell",
97104
zone_id,
98105
lid,
99106
catchment_area_m2),
100-
xaxis = list(title='LID area fraction'),
107+
xaxis = list(title='LID area fraction (%)',
108+
standoff = 0),
101109
yaxis = list(title='Volume Rainfall Retended (%)',
102110
range = c(0, 100)),
103111
legend = list(orientation = "h", x = 0, y = -0.1 ))
@@ -134,7 +142,7 @@ boxplot_runoff_max <- function(lid = "bioretention_cell",
134142
catchment_area_m2 <- unique(perf_selected$catchment_area_m2)
135143

136144
perf_selected %>%
137-
dplyr::mutate(lid_area_fraction = as.factor(lid_area_fraction),
145+
dplyr::mutate(lid_area_fraction = as.factor(lid_area_fraction*100),
138146
scenario_name = as.factor(.data$scenario_name),
139147
label = sprintf("%s (%d m2)", .data$scenario_name, .data$lid_area_m2)) %>%
140148
tidyr::unnest(.data$events_max) %>%
@@ -151,7 +159,8 @@ boxplot_runoff_max <- function(lid = "bioretention_cell",
151159
zone_id,
152160
lid,
153161
catchment_area_m2),
154-
xaxis = list(title='LID area fraction'),
162+
xaxis = list(title='LID area fraction (%)',
163+
standoff = 0),
155164
yaxis = list(title='Maximum total runoff (mm/h per event)'),
156165
legend = list(orientation = "h", x = 0, y = -0.1 ))
157166

@@ -194,18 +203,19 @@ boxplot_runoff_volume <- function(lid = "bioretention_cell",
194203
.data$lid_name_tidy,
195204
.data$scenario_name,
196205
.data$lid_area_fraction) %>%
197-
dplyr::mutate(sum_total_runoff_cbm = .data$dur * .data$sum_total_runoff / 1000 / catchment_area_m2) %>%
206+
dplyr::mutate(runoff_LitrePerSqm = .data$runoff_cbm * 1000) %>%
198207
plotly::plot_ly(x = ~lid_area_fraction,
199-
y = ~sum_total_runoff_cbm,
208+
y = ~runoff_LitrePerSqm,
200209
color = ~scenario_name,
201210
type = "box") %>%
202211
plotly::layout(boxmode = "group",
203212
title = sprintf("zone %d: %s (catchment area: %s m2)",
204213
zone_id,
205214
lid,
206215
catchment_area_m2),
207-
xaxis = list(title='LID area fraction'),
208-
yaxis = list(title='Total Runoff Volume (m3 per m2 per event)'),
216+
xaxis = list(title="LID area fraction (%)",
217+
standoff = 0),
218+
yaxis = list(title="Total Runoff Volume (litre per m2 per event)"),
209219
legend = list(orientation = "h", x = 0, y = -0.1 ))
210220

211221

‎R/simulate_performance.R

+14-10
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,6 @@
33
#' @param lid_selected tibble with a selected LID as retrieved by \code{\link{read_scenarios}}
44
#' @param lid_area_fraction fraction of LID in subcatchment (default: 0)
55
#' @param catchment_area_m2 catchment area (default: 1000 m2)
6-
#' @param col_eventsep SWMM output column used for event separation (default:
7-
#' "total_rainfall")
86
#' @param swmm_base_inp path to SWMM model to be used as template for modification
97
#' (default: keys.lid::extdata_file("scenarios/models/model_template.inp"))
108
#' @param swmm_climate_dir directory with climate data
@@ -42,7 +40,6 @@ simulate_performance <- function(
4240
lid_selected,
4341
lid_area_fraction = 0,
4442
catchment_area_m2 = 1000,
45-
col_eventsep = "total_rainfall",
4643
swmm_base_inp = keys.lid::extdata_file("scenarios/models/model_template.inp"),
4744
swmm_climate_dir = keys.lid::extdata_file("rawdata/weather_sponge_regions"),
4845
swmm_exe = NULL,
@@ -145,23 +142,30 @@ simulate_performance <- function(
145142

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

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

155+
col_eventsep <- "total_rainfall_mmPerHour"
155156

156-
rainevent_stats_sum <- kwb.swmm::calculate_rainevent_stats(results_system,
157+
rainevent_stats_mean <- kwb.swmm::calculate_rainevent_stats(results_system,
157158
col_eventsep = col_eventsep,
158-
aggregation_function = "sum") %>%
159-
dplyr::arrange(dplyr::desc(.data$sum_total_rainfall))
159+
aggregation_function = "mean") %>%
160+
dplyr::mutate(rainfall_cbm = .data$dur * .data$mean_total_rainfall_mmPerHour/3600/1000,
161+
runoff_cbm = .data$dur * .data$mean_total_runoff_mmPerHour/3600/1000,
162+
vrr = 1 - runoff_cbm / rainfall_cbm) %>%
163+
dplyr::arrange(dplyr::desc(.data$mean_total_rainfall_mmPerHour))
160164

161165
rainevent_stats_max <- kwb.swmm::calculate_rainevent_stats(results_system,
162166
col_eventsep = col_eventsep,
163167
aggregation_function = "max") %>%
164-
dplyr::arrange(dplyr::desc(.data$max_total_rainfall))
168+
dplyr::arrange(dplyr::desc(.data$max_total_rainfall_mmPerHour))
165169

166170

167171
tibble::tibble(lid_name_tidy = unique(lid_selected$lid_name_tidy),
@@ -173,7 +177,7 @@ simulate_performance <- function(
173177
lid_controls = list(lid_controls),
174178
subcatchment = list(subcatchment),
175179
annual = list(results_vrr),
176-
events_sum = list(rainevent_stats_sum),
180+
events_sum = list(rainevent_stats_mean),
177181
events_max = list(rainevent_stats_max),
178182
col_eventsep = col_eventsep,
179183
model_inp = path_inp_file,

0 commit comments

Comments
 (0)