diff --git a/.Rbuildignore b/.Rbuildignore
index 906e453..16df298 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -8,3 +8,9 @@
^codecov\.yml$
^index\.md$
^README\.md$
+^vignettes/monotonicity_analysis$
+^vignettes/optimiser_vs_bruteforce$
+^\.positai$
+^\.claude$
+^CITATION\.cff$
+^\.zenodo\.json$
diff --git a/.github/workflows/claude.yaml b/.github/workflows/claude.yaml
index 2da55d5..2813c65 100644
--- a/.github/workflows/claude.yaml
+++ b/.github/workflows/claude.yaml
@@ -35,4 +35,4 @@ jobs:
uses: anthropics/claude-code-action@v1
with:
claude_code_oauth_token: ${{ secrets.CLAUDE_CODE_OAUTH_TOKEN }}
- claude_args: '--model claude-opus-4-7'
+ claude_args: '--model claude-opus-4-8'
diff --git a/.gitignore b/.gitignore
index 0d7f03b..1567446 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,23 @@
.Ruserdata
docs
inst/doc
+.positai
+
+# Von den Vignetten erzeugte Ergebnisdateien (simulation_results_*).
+# Reproduzierbar durch erneutes Rendern -> nicht einchecken. HTML- und
+# R-Dateien unter vignettes/ ignoriert bereits vignettes/.gitignore
+# (*.html, *.R).
+vignettes/*.csv
+vignettes/*.pdf
+vignettes/figure/
+Rplots.pdf
+
+# Deploy-Ordner der Monotonie-Analyse: komplett unversioniert. Achtung:
+# Das betrifft auch den handgeschriebenen Ergebnisbericht index.html
+# (liegt lokal, als claude.ai-Artefakt und deployt auf dem Server).
+vignettes/monotonicity_analysis/
+
+# Deploy-Ordner der Vergleichs-Praesentation Optimierer vs. Brute-Force
+# (handgeschriebenes index.html, liegt auch als claude.ai-Artefakt vor)
+vignettes/optimiser_vs_bruteforce/
+tests/testthat/testthat-problems.rds
diff --git a/.zenodo.json b/.zenodo.json
new file mode 100644
index 0000000..cd307a7
--- /dev/null
+++ b/.zenodo.json
@@ -0,0 +1,31 @@
+{
+ "title": "kwb.raindrop: R Package for Optimisation Simulations for Rainwater Management",
+ "description": "R interface and control unit for the RAINDROP hydrodynamic planning tool: long-term simulation of blue-green infrastructure (swale-trench elements) driven by real climate series, plus two cost optimisers that find the cost-minimal design per allowed overflow frequency — a deterministic bisection-based coordinate descent whose search order is derived from the construction cost rates, and an assumption-free simultaneous search (penalised Nelder-Mead, differential evolution and Halton sampling) as cross-check.
The proprietary calculation engine ("Regenwasserbewirtschaftung", © Tandler.com GmbH) is not part of this archive; it is downloaded on demand from the companion repository kwb.raindrop.binaries.
",
+ "upload_type": "software",
+ "access_right": "open",
+ "license": "MIT",
+ "creators": [
+ {
+ "name": "Rustler, Michael",
+ "orcid": "0000-0003-0647-7726",
+ "affiliation": "Kompetenzzentrum Wasser Berlin gGmbH (KWB)"
+ }
+ ],
+ "keywords": [
+ "blue-green infrastructure",
+ "sponge city",
+ "stormwater management",
+ "long-term simulation",
+ "cost optimisation",
+ "infiltration swale",
+ "R package"
+ ],
+ "related_identifiers": [
+ {
+ "relation": "isSupplementTo",
+ "identifier": "https://github.com/KWB-R/kwb.raindrop",
+ "scheme": "url"
+ }
+ ],
+ "notes": "Developed within the project RAINDROP (Rainwater Drainage Optimization, GZ C300428), funded by the Austrian Federal Ministry of Agriculture, Forestry, Regions and Water Management."
+}
diff --git a/CITATION.cff b/CITATION.cff
new file mode 100644
index 0000000..f906950
--- /dev/null
+++ b/CITATION.cff
@@ -0,0 +1,37 @@
+cff-version: 1.2.0
+message: "If you use this software, please cite it using the metadata below."
+type: software
+title: "kwb.raindrop: R Package for Optimisation Simulations for Rainwater Management"
+version: 0.1.0
+date-released: "2026-08-07"
+license: MIT
+repository-code: "https://github.com/KWB-R/kwb.raindrop"
+url: "https://kwb-r.github.io/kwb.raindrop"
+authors:
+ - family-names: Rustler
+ given-names: Michael
+ orcid: "https://orcid.org/0000-0003-0647-7726"
+ affiliation: "Kompetenzzentrum Wasser Berlin gGmbH (KWB)"
+keywords:
+ - blue-green infrastructure
+ - sponge city
+ - stormwater management
+ - long-term simulation
+ - cost optimisation
+ - infiltration swale
+ - R package
+abstract: >-
+ R interface and control unit for the RAINDROP hydrodynamic planning
+ tool: long-term simulation of blue-green infrastructure (swale-trench
+ elements) driven by real climate series, plus two cost optimisers
+ that find the cost-minimal design per allowed overflow frequency - a
+ deterministic bisection-based coordinate descent whose search order
+ is derived from the construction cost rates, and an
+ assumption-free simultaneous search (penalised Nelder-Mead,
+ differential evolution and Halton sampling) as cross-check. The
+ proprietary calculation engine ("Regenwasserbewirtschaftung",
+ (c) Tandler.com GmbH) is not part of this package; it is downloaded
+ on demand from the companion repository kwb.raindrop.binaries.
+ Developed within the project RAINDROP (Rainwater Drainage
+ Optimization, GZ C300428), funded by the Austrian Federal Ministry
+ of Agriculture, Forestry, Regions and Water Management.
diff --git a/DESCRIPTION b/DESCRIPTION
index 9482d3b..e3ce958 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: kwb.raindrop
Title: R Package for Optimisation Simulations for Rainwater Management
Simulations Performed with Calculation Engine Provided by Tandler
-Version: 0.0.0.9000
+Version: 0.1.0
Authors@R: c(
person("Michael", "Rustler", , "michael.rustler@kompetenz-wasser.de", role = c("aut", "cre"),
comment = c(ORCID = "0000-0003-0647-7726")),
@@ -41,12 +41,14 @@ Suggests:
plotly,
readr,
rmarkdown,
+ testthat (>= 3.0.0),
writexl
-VignetteBuilder:
+VignetteBuilder:
knitr
+Config/testthat/edition: 3
Remotes:
github::kwb-r/kwb.event,
github::kwb-r/kwb.utils
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+Config/roxygen2/version: 8.1.0
diff --git a/NAMESPACE b/NAMESPACE
index 6df2600..d76aeb1 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -3,9 +3,14 @@
export("%>%")
export(add_overflow_events_and_waterbalance)
export(compute_costs)
+export(cost_rates_caption)
export(default_canonical_wb_variables)
export(default_cost_rates)
+export(default_param_labels)
+export(default_storage_spec)
+export(default_storage_types)
export(download_engine)
+export(find_min_feasible)
export(find_single_param_variations)
export(get_simulation_results_all)
export(get_simulation_results_optim)
@@ -16,91 +21,133 @@ export(h5_read_values)
export(h5_validate_write)
export(h5_write_values)
export(list_h5_datasets)
+export(make_swale_runner)
+export(optimise_swale_design)
+export(optimise_swale_design_simultaneous)
+export(plot_cost_overflow_boxplot)
+export(plot_cost_vs_evaporation)
+export(plot_cost_vs_overflow_volume)
export(plot_hpond_vs_ref)
export(plot_main_effects)
export(plot_valid_design_space)
export(plot_wb_tradeoff_overflows)
+export(plotly_add_caption)
+export(plotly_split_legend)
export(read_hdf5_connections)
export(read_hdf5_scalars)
export(read_hdf5_timeseries)
export(read_raindrop_errors)
+export(read_site_timeseries)
export(run_model)
export(run_scenarios)
-importFrom(dplyr,"%>%")
-importFrom(dplyr,across)
-importFrom(dplyr,all_of)
-importFrom(dplyr,arrange)
-importFrom(dplyr,bind_cols)
-importFrom(dplyr,bind_rows)
-importFrom(dplyr,case_when)
-importFrom(dplyr,everything)
-importFrom(dplyr,filter)
-importFrom(dplyr,group_by)
-importFrom(dplyr,if_else)
-importFrom(dplyr,left_join)
-importFrom(dplyr,mutate)
-importFrom(dplyr,n)
-importFrom(dplyr,n_distinct)
-importFrom(dplyr,pull)
-importFrom(dplyr,relocate)
-importFrom(dplyr,select)
-importFrom(dplyr,summarise)
-importFrom(dplyr,transmute)
-importFrom(dplyr,ungroup)
+export(sickerbox_level_presets)
+export(stack_levels)
+importFrom(dplyr,
+ "%>%",
+ across,
+ all_of,
+ arrange,
+ bind_cols,
+ bind_rows,
+ case_when,
+ coalesce,
+ desc,
+ everything,
+ filter,
+ group_by,
+ if_else,
+ left_join,
+ mutate,
+ n,
+ n_distinct,
+ pull,
+ relocate,
+ select,
+ slice,
+ summarise,
+ transmute,
+ ungroup
+)
importFrom(forcats,fct_reorder)
-importFrom(fs,dir_create)
-importFrom(fs,file_copy)
-importFrom(fs,file_exists)
-importFrom(fs,path_abs)
-importFrom(future,multisession)
-importFrom(future,plan)
-importFrom(future,sequential)
+importFrom(fs,
+ dir_create,
+ file_copy,
+ file_exists,
+ path_abs
+)
+importFrom(future,
+ multisession,
+ plan,
+ sequential
+)
importFrom(future.apply,future_lapply)
-importFrom(ggplot2,aes)
-importFrom(ggplot2,coord_cartesian)
-importFrom(ggplot2,element_text)
-importFrom(ggplot2,facet_wrap)
-importFrom(ggplot2,geom_boxplot)
-importFrom(ggplot2,geom_jitter)
-importFrom(ggplot2,geom_point)
-importFrom(ggplot2,geom_violin)
-importFrom(ggplot2,ggplot)
-importFrom(ggplot2,guide_legend)
-importFrom(ggplot2,guides)
-importFrom(ggplot2,labs)
-importFrom(ggplot2,position_identity)
-importFrom(ggplot2,position_jitter)
-importFrom(ggplot2,scale_alpha_identity)
-importFrom(ggplot2,scale_color_manual)
-importFrom(ggplot2,scale_colour_manual)
-importFrom(ggplot2,scale_x_continuous)
-importFrom(ggplot2,scale_x_discrete)
-importFrom(ggplot2,scale_y_continuous)
-importFrom(ggplot2,scale_y_discrete)
-importFrom(ggplot2,theme)
-importFrom(ggplot2,theme_bw)
-importFrom(ggplot2,theme_minimal)
+importFrom(ggplot2,
+ aes,
+ coord_cartesian,
+ element_text,
+ facet_grid,
+ facet_wrap,
+ geom_boxplot,
+ geom_jitter,
+ geom_line,
+ geom_point,
+ geom_text,
+ geom_violin,
+ ggplot,
+ guide_legend,
+ guides,
+ labs,
+ position_identity,
+ position_jitter,
+ position_nudge,
+ scale_alpha_identity,
+ scale_color_manual,
+ scale_colour_manual,
+ scale_fill_manual,
+ scale_shape_manual,
+ scale_size,
+ scale_x_continuous,
+ scale_x_discrete,
+ scale_y_continuous,
+ scale_y_discrete,
+ theme,
+ theme_bw,
+ vars
+)
importFrom(grDevices,colorRampPalette)
importFrom(hdf5r,H5File)
importFrom(kwb.event,hsEvents)
-importFrom(kwb.utils,catAndRun)
-importFrom(kwb.utils,resolve)
+importFrom(kwb.utils,
+ catAndRun,
+ resolve
+)
importFrom(lubridate,as_datetime)
importFrom(magrittr,"%>%")
importFrom(parallel,detectCores)
-importFrom(progressr,handler_cli)
-importFrom(progressr,handler_rstudio)
-importFrom(progressr,handler_txtprogressbar)
-importFrom(progressr,handlers)
-importFrom(progressr,progressor)
-importFrom(progressr,with_progress)
-importFrom(purrr,map_chr)
-importFrom(purrr,map_dfr)
+importFrom(progressr,
+ handler_cli,
+ handler_rstudio,
+ handler_txtprogressbar,
+ handlers,
+ progressor,
+ with_progress
+)
+importFrom(purrr,
+ map_chr,
+ map_dfr
+)
importFrom(rlang,.data)
-importFrom(stats,median)
-importFrom(stats,setNames)
+importFrom(stats,
+ median,
+ setNames
+)
importFrom(stringr,str_c)
-importFrom(tibble,as_tibble)
-importFrom(tibble,tibble)
-importFrom(tidyr,pivot_longer)
-importFrom(tidyr,pivot_wider)
+importFrom(tibble,
+ as_tibble,
+ tibble
+)
+importFrom(tidyr,
+ pivot_longer,
+ pivot_wider
+)
+importFrom(utils,modifyList)
diff --git a/NEWS.md b/NEWS.md
index 3038ce8..f71f353 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,16 +1,439 @@
-# kwb.raindrop (development version)
+# kwb.raindrop 0.1.0 (2026-08-07)
+
+## New features
+
+* New **swale-design optimiser** — finds the cost-minimal design per
+ overflow target (`n_overflows <= x`) with roughly ten engine runs per
+ (storage type, target) cell instead of a full factorial sweep, at finer
+ resolution (2 m² / 10 mm instead of 25 m² / 100 mm grid steps):
+ - `find_min_feasible()` — the single primitive everything is built
+ from: bisection for the smallest feasible value of one design
+ parameter, over continuous bounds (`lower`/`upper`/`tol`) or discrete
+ stack `levels` (binary search). Evaluations are memoised and two
+ safety rules from the monotonicity analysis are built in: an **edge
+ guard** for the +1 event-counting wobble of the 4-h event separation
+ (a descending ladder below an "infeasible by exactly one event" upper
+ edge, so the Bad Aussee 175-m²-feasible/200-m²-infeasible pattern
+ cannot eat a solution) and a **volume referee** that warns — and
+ flags the result — iff the overflow count *and* the overflow volume
+ increase together (real non-monotonicity; never observed in the
+ 5 112 validation comparisons). An optional `split_jitter` randomises
+ the bisection split point — a Monte-Carlo of the search path
+ (repeated runs with different seeds must agree within `tol`).
+ - `optimise_swale_design()` — coordinate descent whose **search order
+ is derived from `cost_rates`** via a specific-cost proxy (EUR per
+ mm of storage capacity, capacity model V ≈ area × (mulde_height +
+ porosity × storage_height); porosity from `default_storage_spec()`):
+ maximising `mulde_height` first is provably optimal for any rates
+ under this cost model, and the starting storage level is the
+ cheapest level per mm of capacity — the smallest under the default
+ rates, a high level when e.g. the storage material is cheap (with
+ box material at 5 EUR/m³ this finds the 63 m²/1200 mm corner for
+ 12.7k EUR in 15 runs, where the fixed legacy order returned 155 m²/
+ 300 mm for 20.8k EUR; regression-tested against the simultaneous
+ optimiser). Specs without a `porosity` entry keep the legacy order;
+ the proxy assumes capacity-additive levers, so parameters with
+ nonlinear hydraulic effects remain the domain of
+ `optimise_swale_design_simultaneous()`. Within a cell the descent
+ then runs: minimal feasible `mulde_area` at maximal `mulde_height`
+ on the chosen storage level, storage escalated only when the area
+ is stuck at its upper bound, `mulde_height` shrunk last. One shared
+ evaluation cache spans all `x_targets` and both storage types (a run
+ classifies itself for every target at once), warm-start brackets are
+ derived from prior brute-force results (CSV schema of the
+ workflows), `max_total_depth` adds an analytic depth constraint
+ (DWA-A 138 groundwater clearance / cover requirements) that costs no
+ simulation runs, and "infeasible within bounds" is a regular result
+ status, not an error. Costs are attached via `compute_costs()`; all
+ evaluated designs ship as attribute `"evaluations"`.
+ - `optimise_swale_design_simultaneous()` — alternative optimiser that
+ searches **all design parameters at once** (`mulde_area`,
+ `mulde_height`, `storage_height`) instead of per-parameter
+ bisection: infeasible designs are not excluded but penalised (any
+ infeasible design is worse than any feasible one; excess overflow
+ events grade the penalty and steer the search back towards the
+ feasibility boundary, where the optimum lives), so the search can
+ trade the parameters against each other in a single step and does
+ not rely on the per-parameter monotonicity the bisection exploits.
+ Three search `method`s share this penalised objective, the
+ tolerance snapping (the shared cache absorbs repeats across all
+ `x_targets`) and a final **multi-valley lattice polish**
+ (accelerated 8/4/2/1-tolerance pattern descent from the cheapest
+ feasible design of every storage level visited, capped at the 6
+ cheapest levels for the continuous gravel trench — the storage axis
+ separates cost valleys that single coordinate steps cannot cross;
+ each round also proposes a *boundary slide* — area down with
+ `mulde_height` at its maximum, the two-coordinate trade towards the
+ cheap end of the feasibility boundary — and a `mulde_height` *floor
+ probe* that jumps over +1 counting-wobble bands, both plain
+ evaluated candidates without any monotonicity assumption):
+ `"nelder_mead"` (default; deterministic multistart via
+ `stats::optim()` — prior warm start, previous-target optimum, one
+ anchor start per storage level, space-filling points; every start
+ gets an equal slice of the `max_evals` run budget),
+ `"diff_evolution"` (compact DE/rand/1/bin for comparison;
+ deterministic via an internal Park-Miller generator seeded with
+ `seed` — R's global RNG stays untouched) and `"halton_search"`
+ (quasi-random space-filling baseline). Same interface and result
+ schema as `optimise_swale_design()` (incl. `max_total_depth`, warm
+ start and the `"evaluations"` attribute) plus a `method` column; a
+ pairwise dominance check per cell (a strictly larger design with
+ more overflows *and* more overflow volume) replaces the bisection's
+ volume referee. Needs considerably more engine runs per cell
+ (typically 60–120 instead of ~15) but serves as an independent
+ cross-check that coordinate descent did not miss a cheaper corner
+ of the design space.
+ - `make_swale_runner()` — package-level refactoring of the `run_one()`
+ function previously duplicated across the three case-study
+ vignettes: one closure factory covering both variants (Eisenstadt:
+ `base.h5` rain curve scaled by `rain_factor`; Wien / Bad Aussee: own
+ rain + ET0 series in mm/h incl. the Growth/Shading end-time fix).
+ Returns the thinned one-row optimisation result augmented with
+ `overflow_volume_m3` (= `sum_overflows` [mm] × `mulde_area` / 1000).
+ **Behaviour note — files are deleted by default:** with
+ `cleanup = TRUE` (the default) each scenario's input copy *and its
+ output HDF5s* (`Mulde_Rigole.h5`, `Dach.h5`, `Fehlerprotokoll.h5`,
+ …) are removed right after the one-row result has been read — only
+ the returned tibble survives a run. Pass `cleanup = FALSE` if you
+ need the raw scenario files (failed runs always keep theirs for
+ debugging). Rationale: without the cleanup, long searches (hundreds
+ of engine runs per task, each with its own `base.h5` copy plus
+ output HDF5s) fill the temp drive and the engine dies with HDF5
+ `errno = 28` ("No space left on device"). Prepares a **site master file** once
+ (base.h5 + calculation settings + ET/rain series) and writes only
+ the ~15 small parameter datasets per run instead of reading and
+ rewriting *every* dataset each time — that full HDF5 round trip
+ (plus process spawn and virus-scanner latency on new files) was the
+ dominant per-run cost of the optimisation searches, several times
+ the ~2 s engine time of the Eisenstadt model.
+ - `stack_levels()`, `sickerbox_level_presets()`,
+ `default_storage_spec()`, `default_storage_types()` — storage-layer
+ search spaces: achievable stack heights from module heights (incl.
+ mixed combinations such as Rigofill full + half block), manufacturer
+ presets (GRAF, Fränkische, ACO, Wavin; verify against data sheets
+ before productive runs) with the brute-force grid levels
+ 300/600/900/1200 mm as the default, and the gravel-trench range
+ coupled at 3 × the box range (usable-porosity ratio 0.95 / 0.3).
+
+* New conditional vignette `monotonicity_analysis` — validates the
+ optimiser's core assumption on the three brute-force result sets
+ (5 112 neighbour comparisons): `n_overflows` is quasi-monotone in
+ every design parameter (13 violations, all +1 counting artefacts of
+ the 4-h event separation), the overflow volume (in m³) is monotone
+ without exception, ET depends on `mulde_area` only, and the filter
+ conductivity is a cost-free dominant lever (fix at maximum). Renders
+ after the three workflow vignettes into
+ `vignettes/monotonicity_analysis/` (deploy unit with the plain-language
+ report `index.html` and the exported `mono_*` detail tables as CSV +
+ interactive HTML).
+
+* New conditional vignette `workflow_optimisation` — runs the optimiser
+ for all three sites (Eisenstadt 2005, Wien, Bad Aussee), **parallelised
+ over site × storage type** (6 independent tasks via
+ `future`/`future.apply`; wall time = longest single task, ~15–20 min
+ instead of ~65 min sequential — bisection within a search is inherently
+ sequential and the x-targets of one storage type share the evaluation
+ cache, but box and trench never share a single engine run). Exposes the
+ search space and the cost rates as explicit, adjustable code (defaults
+ used), warm-starts from the grid CSVs, renders the combined optimum
+ table, per-site cost-effectiveness curves, total-runtime reporting
+ (per task, per section and for the whole document) and a
+ **Monte-Carlo section** (`n_mc = 10`) evaluating the robustness of the
+ *search itself*: every bisection split point is randomly displaced
+ (`split_jitter = 0.3`) while rain, cost rates and all other inputs
+ stay fixed; the repetitions with different seeds must agree on the
+ storage level, keep the area within 2 × `area_tol` and the cost within
+ a few percent — the swale depth may scatter somewhat more because it
+ is hydraulically coupled to the found area (x = 1; the full pool of
+ 3 sites × 2 storage types × 10 repetitions runs as 60 parallel tasks,
+ one full re-optimisation each).
+
+* New conditional vignette `workflow_optimisation_simultaneous` — the
+ simultaneous counterpart of `workflow_optimisation` (which stays
+ bisection-only and now points here): runs the Nelder-Mead sweep for
+ all three sites in parallel (site × storage type), compares the
+ optima cell by cell against the bisection CSV export when present
+ (`delta_pct` table), and benchmarks the three search methods
+ (Nelder-Mead / differential evolution / Halton baseline) on the same
+ x = 1 cell across all sites and storage types — 12 parallel tasks —
+ to show what the structured searches contribute over naive sampling.
+ Both compute chunks report live progress across the worker boundary
+ (one \pkg{progressr} tick per engine run — a multi-hour sweep no
+ longer looks frozen), the site list has a quick-test switch
+ (Eisenstadt only) and `max_evals` is exposed as the runtime lever.
+
+* New exported helper `read_site_timeseries()` — the rain/ET0 time-series
+ preparation previously duplicated in the Wien and Bad Aussee vignettes
+ (hours since start, series-end alignment, engine mm/h convention);
+ selects strictly `time` + `value`, tolerating extra raw-data columns
+ (Bad Aussee ships a `substation` column that Wien does not have).
+
+* **testthat suite added** (edition 3; `tests/testthat/`): unit tests for
+ the bisection primitive (threshold accuracy, run counts, wobble guard,
+ volume referee, discrete levels) and end-to-end optimiser tests
+ against a synthetic monotone hydraulic model, verified against a fine
+ brute-force reference (cost within 5 %, monotone cost-effectiveness
+ curve, storage escalation, infeasibility handling, warm-start
+ savings, `max_total_depth`).
+
+* New exported plot `plot_cost_vs_evaporation()` — third cost view:
+ scatters `cost_total` (EUR, x) against the element evapotranspiration
+ share (`element.WB_Evapotranspiration_`, %, y). Points share the
+ overflow-count palette of the sibling plots and are **shaped by the
+ storage type** (filled square = infiltration box / Sickerbox, filled
+ triangle = gravel trench / Schotterrigol); identical tooltip. Rendered
+ as `*_cost-vs-evaporation.html` in the three case-study vignettes and
+ linked from `vignettes/index.Rmd` under "Kosten vs. Evapotranspiration".
+
+* `plot_cost_overflow_boxplot()` gains `y_var = "cost_per_evap_pct"`
+ (y-axis = total cost per percentage point of evapotranspiration
+ **above the reference minimum** — the lowest evapotranspiration among
+ the scenarios satisfying the validity criterion (`n_overflows <= x`;
+ fallback: complete run) —, EUR/%; the reference (minimum share,
+ criterion and scenario id) is named on a second title line, and
+ `label_best = TRUE` annotates the evapotranspiration gain
+ `"(+NN % Evapotranspiration)"` after the price; titles, y-label
+ and the `min_cost` objective/label follow) and
+ `facet_storage_type = TRUE` (two stacked storage-type panels —
+ infiltration box on top, gravel trench below — each with its own
+ best-per-box markers and frontier line; `plotly::ggplotly()` keeps
+ the split as stacked subplots). When both storage types share one
+ panel (no faceting) the overlaid points are shaped by the storage
+ type like the scatter siblings; faceted panels keep plain circles
+ for readability. The vignettes render
+ the three existing boxplot variants with storage-type panels plus the
+ new `*_cost-per-evap-boxplot.html` (cheapest EUR/% per class,
+ point size = evapotranspiration), linked from `vignettes/index.Rmd`
+ under "Boxplot – Kosten je Prozent Evapotranspiration".
+
+* `plot_cost_vs_overflow_volume()` points are now also **shaped by the
+ storage type** (square/triangle, own legend under the colour legend).
+
+* The shared cost tooltip gains a derived **"Kosten je % Evapotranspiration
+ (über Min. von X %) [€/%]"** line right below the total cost: the
+ total cost per percentage point of element evapotranspiration
+ **above the reference minimum** (the lowest evapotranspiration among
+ the scenarios satisfying the validity criterion `n_overflows <= x`;
+ fallback: complete run) — the baseline comes "for free", only the
+ gain is paid for. The reference value is named in the line; "-" at or
+ below the minimum. Shown consistently in both cost scatters and all
+ cost boxplot variants. German labels consistently say
+ **"Evapotranspiration"** instead of "Verdunstung" throughout.
+
+* New **usable storage volume** of the storage layer:
+ `storage_volume_m3 = mulde_area * storage_height/1000 *
+ (thetaS - thetaFC)` (usable porosity 0.95 infiltration box / 0.3
+ gravel trench). The vignettes add the column to the parameter grid
+ (grid datatable + results CSV) and the tooltips of **all** scenario
+ plots show it as "Nutzbares Speichervolumen [m³]" — the cost scatters
+ and boxplots (right below the storage type), the water-balance
+ trade-off plot and the design-space plots (there sourced from
+ `sim_results`, since the plotting grid drops the helper columns) —
+ computed on the fly from the `storage_theta*` columns for existing
+ result sets without the column. In the "Variierende Parameter" block the raw
+ storage_type values are now translated too
+ (`Speichertyp=Schotterrigol` instead of `=gravel_trench`; shared
+ value labels with the `plot_main_effects()` storage-type panel).
+
+* The boxplots' point-size legend keys match the plotted markers: with
+ storage-type shapes in use (no faceting) they are drawn with the grey
+ square/triangle instead of the default circle; the faceted variants
+ use circular points and matching circular keys.
+
+* Storage-type names in legends and facet strips are now the **short,
+ language-specific** ones ("Sickerbox" / "Schotterrigol" for `lang =
+ "de"`, "Infiltration box" / "Gravel trench" for `"en"`); only the
+ bold tooltip line keeps the long bilingual form.
+
+* All cost plots now carry a **caption naming the unit-cost rates**
+ they were computed with (new exported `cost_rates_caption()`, built
+ from [`default_cost_rates()`]: Aushub 70 €/m³ · Profilierung +
+ Begrünung 10 €/m² · Bodenfilter 200 €/m³ · Sickerbox 350 €/m³ ·
+ Schotterrigol 50 €/m³, incl. installation). ggplot renders it at the
+ bottom of the PDFs (`caption` argument, `""` to drop); since
+ `plotly::ggplotly()` drops captions, the new exported
+ `plotly_add_caption()` re-adds it as a bottom annotation in the
+ interactive HTMLs (wired up in all three vignettes).
+
+* New exported helper `plotly_split_legend()` — cleans up the
+ interactive legends: `plotly::ggplotly()` flattens colour + shape
+ into unreadable `"(0,Sickerbox / Infiltration box)"` tuple entries.
+ The helper rebuilds the legend from legend-only keys with
+ unambiguous glyphs: one **neutral circle per overflow class in the
+ class colour** (clicking toggles both storage types of the class)
+ plus two **neutral grey** square/triangle keys under a
+ "Speichertyp" / "Storage type" group title (skippable via
+ `add_shape_legend = FALSE` for faceted plots) — a coloured
+ square/triangle key would wrongly suggest one specific
+ (colour, type) combination. The storage-type keys are **individually
+ clickable** (a JavaScript handler toggles all traces with that marker
+ symbol, since the traces' only legend group is taken by the overflow
+ class); the overlapping combined legend title is
+ removed and the legend moves to a vertical layout on the right.
+ Applied in all three vignettes to the cost-vs-overflow,
+ cost-vs-evaporation, water-balance and design-space HTMLs.
+
+* `plot_wb_tradeoff_overflows()` no longer crashes with "Can't combine
+ `mulde_area` and `storage_type` " on two-type
+ grids: its inline copy of the varying-parameter tooltip block was
+ replaced by the shared `build_varying_param_html()` helper (the
+ tooltip parameter names are now translated via
+ `default_param_labels()`, as in the cost plots). When the results
+ carry a `storage_type` column, its points are shaped by the storage
+ type (square/triangle) and the tooltip names the type; single-type
+ result sets plot as before.
+
+* `plot_valid_design_space()` gains `facet_storage_type` — two stacked
+ storage-type panels with **free y-scales**, so disjoint per-type
+ levels (storage_height: 300–1200 mm boxes vs. 900–3600 mm trenches)
+ fill their own panel; duplicate-based alpha is then counted per
+ panel and the points stay plain circles (the strips name the type).
+ Without faceting, points are shaped by the storage type whenever
+ `storage_type` varies. The vignettes facet both design-space blocks.
+
+* `plot_main_effects()` now supports character parameters (the pivot
+ previously failed on mixed types), keeps numeric level ordering
+ ("500" no longer sorts after "1000"), and renders `storage_type` as
+ its own panel with display names (Sickerbox/Schotterrigol or
+ Infiltration box/Gravel trench). The vignettes add `storage_type` to
+ the main-effects parameter set.
+
+* Fixed `build_varying_param_html()` (the shared tooltip helper): it
+ errored with "Can't combine `storage_height` and
+ `storage_type` " as soon as the character column
+ `storage_type` varied across scenarios — i.e. for every grid sweeping
+ both storage types (`values_transform = as.character` in the pivot).
+ Numbers in the varying-parameters tooltip block are now formatted
+ element-wise, so one decimal-valued parameter no longer forces
+ trailing ".00" onto every other value. The vignettes additionally
+ drop the storage_theta* helper columns (fully determined by
+ `storage_type`) from the plotting `param_grid`, keeping tooltips
+ lean.
+
+* New exported plot `plot_cost_vs_overflow_volume()` — companion to
+ `plot_wb_tradeoff_overflows()` for cost-aware optimisation.
+ Scatters `cost_total` (EUR) against overflow volume (m³, computed
+ from `sum_overflows` [mm] and `mulde_area` [m²]), points coloured
+ discretely by `n_overflows` with the same `0..x / ">x"` palette
+ and top legend as the water-balance plot. Both cost plots report the
+ **share of scenarios meeting the validity criterion** (`n_overflows`
+ ≤ `x`) in the plot title (e.g. `(39 % mit ≤ 5 Überläufen)`), since
+ ggplotly drops ggplot subtitles. The plotly tooltip
+ carries the element water balance (evapotranspiration, infiltration,
+ overflow — all in %), the chosen storage type on its own bold line
+ (bilingual, `Sickerbox / Infiltration box` or
+ `Schotterrigol / Gravel trench`), the full cost breakdown (excavation,
+ profiling, filter, storage, total) plus the varying `param_grid`
+ entries (translated via `default_param_labels()`). Rendered
+ as HTML (`*_cost-vs-overflow-volume.html`) in the three case-study
+ vignettes and linked from `vignettes/index.Rmd` under a new
+ "Kosten vs. Überlaufvolumen" section.
+
+* New exported plot `plot_cost_overflow_boxplot()` — boxplot of the
+ total construction cost (EUR, y) per number of overflow events (x),
+ with the individual scenarios overlaid as jittered points whose
+ **size scales with the overflow volume** (m³; the size scale is
+ calibrated to the valid region so the many-overflow outliers do not
+ shrink the valid-region points away, and a minimum size keeps every
+ point visible). Counts up to the
+ threshold `x` (= `max_n_overflows`, as in the sibling plots) each get
+ their own box; higher counts collapse into a single `">x"` catch-all
+ box (furthest right, red), keeping the axis readable for the long-tailed
+ 15-year runs (Wien / Bad Aussee reach several hundred overflow events);
+ the `">x"` box highlights the scenario with the fewest overflow events
+ above `x`. One best scenario per box is highlighted with a black-outlined
+ diamond
+ in that box's group colour (so its tooltip inherits the group colour),
+ and the best scenarios of **all** boxes are joined by a frontier line
+ (`mark_best` / `connect_best`). The point tooltip is identical to
+ `plot_cost_vs_overflow_volume()`. `best_by` picks the objective (cost
+ as tie-breaker) — `"min_cost"` (cheapest), `"min_overflow"` (smallest
+ overflow volume) or `"max_evapotranspiration"` (highest
+ evapotranspiration) — so the three variants trace three different
+ frontier lines; `label_best` annotates the marker (overflow volume +
+ share `"NN m³ / NN %"`, or evapotranspiration `"NN %"`);
+ `size_by` scales the points by overflow volume (default) or
+ evapotranspiration. The three case-study vignettes render all three
+ variants (`*_cost-by-overflows-boxplot-cheapest.html`,
+ `*-min-overflow.html`, `*-max-evap.html`), each linked from
+ `vignettes/index.Rmd` under the grouped "Kosten" section.
+
+* New exported helper `default_param_labels()` — German / English,
+ unit-carrying labels for the parameter-grid columns. The
+ "varying parameters" block of both cost-plot tooltips now shows e.g.
+ `Muldenfläche [m²]=125` instead of the raw `mulde_area=125`; pass
+ `param_labels =` to the plot functions to override.
+
+## Documentation website
+
+* The two deploy-only articles `vignettes/index.Rmd` (brute-force link
+ hub) and `vignettes/monotonicity_analysis.Rmd` are removed from the
+ repository (they remain in the git history). Their relative links only
+ worked in the deploy structure on
+ and their result files never
+ exist on GitHub Actions, so the pkgdown-built copies were link-dead
+ shells. The complete rendered pages live on that server; the pkgdown
+ navbar instead gains a "More results" menu linking them (brute force,
+ monotonicity analysis, optimiser vs. brute force), and the two
+ optimisation vignettes link the monotonicity analysis there too.
+
+## Consistency
+
+* Non-ASCII characters in R code are now unicode-escaped: all string literals
+ in `plot_cost_vs_overflow_volume()` and in the vignette code chunks use
+ `\uxxxx` escapes (rendered labels unchanged), and the few non-ASCII code
+ comments were rewritten in plain ASCII. Markdown prose keeps UTF-8 (escapes
+ are not interpreted there).
+
+* Eisenstadt 2005 (`workflow_eisenstadt-2005.Rmd` and
+ `workflow_eisenstadt-2005_neu.Rmd`) now pins
+ `//Massnahmenelemente/Mulde_Rigole/Parameter_Evapotranspiration/LAI_LeafAreaIndex = 3.9`
+ (Hörnschemeyer grass value) so all four case-study vignettes
+ operate on the same LAI baseline. Wien uses it as one of the
+ sweep levels (`c(3.9, 8.5)`), Bad Aussee identical to Wien.
## Bug fixes
-* `vignettes/example_wien_minimal.Rmd` now converts ET0 from mm/day to mm/h
+* `vignettes/workflow_eisenstadt-2005.Rmd` now pipes the joined optimisation
+ results through `kwb.raindrop::compute_costs()` like the Wien and Bad Aussee
+ workflows already did. Without it the vignette's
+ `plot_cost_vs_overflow_volume()` call aborted with "missing column(s):
+ cost_excavation, ..." — the cost-vs-overflow-volume PDF/HTML was never
+ produced and the exported CSV lacked the cost columns.
+
+* `get_simulation_results_optim()` now treats a result HDF5 that exists but
+ cannot be opened/read (e.g. the engine crashed mid-write for a scenario, or a
+ file briefly locked just after the run) like a missing file: it `warning()`s,
+ names the scenario, and returns `NULL` instead of throwing. Because the Wien /
+ Bad Aussee / Eisenstadt workflows now read results per run inside `run_one()`,
+ a single unreadable file used to abort the entire `future_lapply` batch (seen
+ as an `H5File.open()` "unable to open file" error mid-render); the run now
+ completes with NA rows for the affected scenarios.
+
+* `vignettes/example_wien_minimal.Rmd`, `vignettes/workflow_wien.Rmd` and
+ `vignettes/workflow_badaussee.Rmd` now convert ET0 from mm/day to mm/h
(`value / period_et`) before writing `//Kurven/ET0`, mirroring the existing
rain conversion. The engine reads the ET0 curve as a mm/h rate, so the
unconverted daily values were integrated 24× too high — the cause of the
- implausibly large modelled ET share. The timeseries-info summary now labels
- ET0 as mm/h and recovers its total via `value * period_h`.
+ implausibly large modelled ET share. The minimal vignette's timeseries-info
+ summary now labels ET0 as mm/h and recovers its total via `value * period_h`.
## New features
+* The Wien and Bad Aussee workflows now thin each run to its optimisation row
+ **inside** `run_one()` (via `get_simulation_results_optim(..., lean = TRUE)`
+ + `add_overflow_events_and_waterbalance()`) and `run_scenarios()` returns
+ those one-row tibbles for a final `dplyr::bind_rows()`. This replaces the
+ previous "run everything, then read every run's full results into memory at
+ once" pass (`get_simulation_results_optim_parallel()`), drastically cutting
+ peak RAM for large parameter grids.
+
+* `get_simulation_results_optim()` gains a `lean` argument. When `TRUE` it
+ reads only the fields consumed downstream (`element$rates`,
+ `element$water_balance`, `connected_area$water_balance`) and leaves the
+ unused `meta`/`states` and `connected_area$rates` as `NULL`, minimising
+ per-run memory and I/O. Its intro message is now gated behind `debug`.
+
* `inst/scripts/prepare_eisenstadt_swmm_timeseries.R` extracts the rain
(`/Kurven/Regen`) and ET0 (`/Kurven/ET0`) curves from an engine HDF5 and
writes SWMM-5 external time-series files. It converts **out** of the
@@ -46,7 +469,7 @@
* New vignette `example_wien_minimal`: a self-contained smoke test of
the full input → engine → results loop on Wien. Now extended into
an ET-diagnostics grid that sweeps three engine switches —
- `keineVerdunstungBeiRegen`, `Hoernschemeyer_aktiv` and the
+ `keineEvapotranspirationBeiRegen`, `Hoernschemeyer_aktiv` and the
`ET0ref_GrasReferenzverdunstung` factor (`0`, `1`, `100`) — at
Daniel's reference geometry (12 scenarios total). Daniel's three
XLSX-review corrections (`Dach/Evapotranspiration_aktiv = 0`,
diff --git a/R/compute_costs.R b/R/compute_costs.R
index 75d810b..6651673 100644
--- a/R/compute_costs.R
+++ b/R/compute_costs.R
@@ -27,6 +27,58 @@ default_cost_rates <- function() {
)
}
+#' Caption line naming the unit-cost rates behind the cost plots
+#'
+#' Formats the unit-cost rates (EUR per m2 / m3, see [default_cost_rates()])
+#' as a single-line caption for the cost plots, so every figure names the
+#' rates its EUR values were computed with. Used as the default `caption` of
+#' [plot_cost_vs_overflow_volume()], [plot_cost_vs_evaporation()] and
+#' [plot_cost_overflow_boxplot()] (rendered by ggplot at the bottom of the
+#' PDFs) and passed to [plotly_add_caption()] for the interactive HTMLs
+#' (`plotly::ggplotly()` drops ggplot captions).
+#'
+#' If the costs were computed with non-default rates, pass the same
+#' `cost_rates` list here so the caption matches the numbers.
+#'
+#' @param lang Character. `"de"` or `"en"`.
+#' @param cost_rates `list` of unit costs as returned by
+#' [default_cost_rates()].
+#'
+#' @return `character(1)`, a single line.
+#'
+#' @examples
+#' cost_rates_caption("de")
+#'
+#' @export
+cost_rates_caption <- function(lang = c("de", "en"),
+ cost_rates = default_cost_rates()) {
+ lang <- match.arg(lang)
+ f <- function(v) format(v, trim = TRUE, big.mark = " ", scientific = FALSE)
+ switch(
+ lang,
+ de = paste0(
+ "Kostens\u00e4tze (inkl. Einbau): Aushub ",
+ f(cost_rates$excavation_eur_per_m3), " \u20ac/m\u00b3 \u00b7 ",
+ "Profilierung + Begr\u00fcnung ",
+ f(cost_rates$profiling_eur_per_m2), " \u20ac/m\u00b2 \u00b7 ",
+ "Bodenfilter ", f(cost_rates$filter_eur_per_m3), " \u20ac/m\u00b3 \u00b7 ",
+ "Sickerbox ",
+ f(cost_rates$infiltration_box_eur_per_m3), " \u20ac/m\u00b3 \u00b7 ",
+ "Schotterrigol ", f(cost_rates$gravel_trench_eur_per_m3), " \u20ac/m\u00b3"
+ ),
+ en = paste0(
+ "Cost rates (incl. installation): excavation ",
+ f(cost_rates$excavation_eur_per_m3), " \u20ac/m\u00b3 \u00b7 ",
+ "profiling + greening ",
+ f(cost_rates$profiling_eur_per_m2), " \u20ac/m\u00b2 \u00b7 ",
+ "soil filter ", f(cost_rates$filter_eur_per_m3), " \u20ac/m\u00b3 \u00b7 ",
+ "infiltration box ",
+ f(cost_rates$infiltration_box_eur_per_m3), " \u20ac/m\u00b3 \u00b7 ",
+ "gravel trench ", f(cost_rates$gravel_trench_eur_per_m3), " \u20ac/m\u00b3"
+ )
+ )
+}
+
#' Compute construction costs for an infiltration-swale parameter grid
#'
#' Given a parameter grid that drives the simulation, attach a per-scenario
diff --git a/R/cost_tooltip.R b/R/cost_tooltip.R
new file mode 100644
index 0000000..00de3da
--- /dev/null
+++ b/R/cost_tooltip.R
@@ -0,0 +1,352 @@
+#' German / English labels for optimisation parameter-grid columns
+#'
+#' Maps the raw `param_grid` column names produced by the case-study workflows
+#' to human-readable, unit-carrying labels. Used to translate the
+#' "varying parameters" block in the interactive tooltips of
+#' [plot_cost_vs_overflow_volume()] and [plot_cost_overflow_boxplot()], so a
+#' hovered point shows e.g. `Muldenflaeche [m2]=125` instead of the raw
+#' `mulde_area=125`.
+#'
+#' Unknown columns fall back to their raw name, so a grid gaining a new column
+#' still renders (just untranslated). Override individual entries or pass your
+#' own named vector via the `param_labels` argument of the plot functions.
+#'
+#' @param lang Character. `"de"` or `"en"`.
+#'
+#' @return A named `character` vector: names are `param_grid` column names,
+#' values are the display labels.
+#'
+#' @export
+#'
+#' @examples
+#' default_param_labels("de")[["mulde_area"]]
+#' default_param_labels("en")[["storage_height"]]
+default_param_labels <- function(lang = c("de", "en")) {
+ lang <- match.arg(lang)
+ switch(
+ lang,
+ de = c(
+ connected_area = "Angeschlossene Fl\u00e4che [m\u00b2]",
+ mulde_area = "Muldenfl\u00e4che [m\u00b2]",
+ mulde_height = "Muldenh\u00f6he [mm]",
+ filter_hydraulicconductivity = "Filter-Leitf\u00e4higkeit kf [mm/h]",
+ filter_height = "Filterh\u00f6he [mm]",
+ storage_height = "Speicherh\u00f6he [mm]",
+ bottom_hydraulicconductivity = "Sohl-Leitf\u00e4higkeit kf [mm/h]",
+ rain_factor = "Regenfaktor [-]",
+ lai = "Blattfl\u00e4chenindex LAI [-]",
+ storage_type = "Speichertyp",
+ storage_volume_m3 = "Nutzbares Speichervolumen [m\u00b3]"
+ ),
+ en = c(
+ connected_area = "Connected area [m\u00b2]",
+ mulde_area = "Swale area [m\u00b2]",
+ mulde_height = "Swale depth [mm]",
+ filter_hydraulicconductivity = "Filter conductivity kf [mm/h]",
+ filter_height = "Filter thickness [mm]",
+ storage_height = "Storage thickness [mm]",
+ bottom_hydraulicconductivity = "Subsoil conductivity kf [mm/h]",
+ rain_factor = "Rain factor [-]",
+ lai = "Leaf area index LAI [-]",
+ storage_type = "Storage type",
+ storage_volume_m3 = "Usable storage volume [m\u00b3]"
+ )
+ )
+}
+
+#' Short, language-specific display names for the storage_type values
+#'
+#' Used wherever the raw `storage_type` values appear as compact text: the
+#' "varying parameters" tooltip block (`Speichertyp=Schotterrigol` instead of
+#' `Speichertyp=gravel_trench`) and the x-axis of the `plot_main_effects()`
+#' storage-type panel. The bold storage-type tooltip line keeps the longer
+#' bilingual names from `cost_tooltip_labels()`.
+#'
+#' @param lang Character. `"de"` or `"en"`.
+#' @return Named character vector (names = raw values).
+#' @noRd
+storage_type_value_labels <- function(lang = c("de", "en")) {
+ lang <- match.arg(lang)
+ switch(
+ lang,
+ de = c(infiltration_box = "Sickerbox",
+ gravel_trench = "Schotterrigol"),
+ en = c(infiltration_box = "Infiltration box",
+ gravel_trench = "Gravel trench")
+ )
+}
+
+#' Per-scenario HTML of the varying parameter-grid entries (translated)
+#'
+#' Detects the `param_grid` columns that vary across scenarios (excluding
+#' `scenario_name`), formats their values, translates the parameter names via
+#' `param_labels`, and collapses them into one `
`-separated HTML string per
+#' scenario for use in a plotly tooltip.
+#'
+#' @param param_grid Data frame with a `scenario_name` column.
+#' @param lang Character. `"de"` or `"en"`.
+#' @param param_labels Named character vector mapping columns to labels, or
+#' `NULL` to use [default_param_labels()].
+#' @param digits_params Integer. Rounding for numeric parameter values.
+#'
+#' @return A tibble with columns `scenario_name` and `params_html`.
+#'
+#' @importFrom dplyr %>% select summarise across everything n_distinct filter
+#' @importFrom dplyr pull mutate group_by all_of coalesce
+#' @importFrom tidyr pivot_longer
+#' @importFrom purrr map_chr
+#' @importFrom rlang .data
+#' @noRd
+build_varying_param_html <- function(param_grid, lang = c("de", "en"),
+ param_labels = NULL, digits_params = 4L) {
+ lang <- match.arg(lang)
+ if (is.null(param_labels)) param_labels <- default_param_labels(lang)
+
+ varying_params <- param_grid %>%
+ dplyr::select(-"scenario_name") %>%
+ dplyr::summarise(dplyr::across(dplyr::everything(),
+ ~ dplyr::n_distinct(.) > 1)) %>%
+ tidyr::pivot_longer(dplyr::everything(),
+ names_to = "param",
+ values_to = "vary") %>%
+ dplyr::filter(.data$vary) %>%
+ dplyr::pull("param")
+
+ if (length(varying_params) == 0) {
+ return(
+ param_grid %>%
+ dplyr::select("scenario_name") %>%
+ dplyr::mutate(params_html = "")
+ )
+ }
+
+ param_grid %>%
+ dplyr::select("scenario_name", dplyr::all_of(varying_params)) %>%
+ # values_transform: numeric and character parameters (e.g. storage_type)
+ # cannot share one `val` column otherwise.
+ tidyr::pivot_longer(-"scenario_name",
+ names_to = "param",
+ values_to = "val",
+ values_transform = list(val = as.character)) %>%
+ dplyr::mutate(
+ val_chr = purrr::map_chr(.data$val, ~ paste(.x, collapse = ",")),
+ val_num = suppressWarnings(as.numeric(.data$val_chr)),
+ # format element-wise: a vectorised format() would pad every parameter
+ # to the maximum number of decimals in the column (e.g. "100.00"
+ # because another parameter has value 0.95).
+ val_fmt = ifelse(
+ is.na(.data$val_num),
+ .data$val_chr,
+ vapply(.data$val_num,
+ function(v) format(round(v, digits_params), trim = TRUE,
+ scientific = FALSE),
+ character(1))
+ ),
+ # storage_type values get their short display names
+ # (Speichertyp=Schotterrigol instead of =gravel_trench)
+ val_fmt = ifelse(
+ .data$param == "storage_type" &
+ .data$val_chr %in% names(storage_type_value_labels(lang)),
+ unname(storage_type_value_labels(lang)[.data$val_chr]),
+ .data$val_fmt
+ ),
+ param_label = dplyr::coalesce(unname(param_labels[.data$param]),
+ .data$param),
+ kv = paste0(.data$param_label, "=", .data$val_fmt)
+ ) %>%
+ dplyr::group_by(.data$scenario_name) %>%
+ dplyr::summarise(params_html = paste(.data$kv, collapse = "
"),
+ .groups = "drop")
+}
+
+#' Shared tooltip labels for the cost plots
+#'
+#' The `tt_*` label set used to assemble the (identical) plotly tooltip of
+#' [plot_cost_vs_overflow_volume()] and [plot_cost_overflow_boxplot()].
+#'
+#' @param lang Character. `"de"` or `"en"`.
+#' @return Named list of label strings.
+#' @noRd
+cost_tooltip_labels <- function(lang = c("de", "en")) {
+ lang <- match.arg(lang)
+ switch(
+ lang,
+ de = list(
+ tt_scenario = "Szenario",
+ tt_n_overflows = "Anzahl \u00dcberlaufereignisse",
+ tt_sum_overflows_mm = "Summe \u00dcberl\u00e4ufe [mm]",
+ tt_overflow_volume = "\u00dcberlaufvolumen [m\u00b3]",
+ tt_wb_header = "Wasserhaushalt [%]",
+ tt_wb_evap = "Evapotranspiration",
+ tt_wb_infil = "Versickerung",
+ tt_wb_overflow = "\u00dcberlauf",
+ tt_cost_total = "Gesamtkosten",
+ tt_cost_per_evap = "Kosten je % Evapotranspiration",
+ tt_above_min = "\u00fcber Min. von",
+ tt_cost_excavation = "Aushub",
+ tt_cost_profiling = "Profilierung + Begr\u00fcnung",
+ tt_cost_filter = "Bodenfilter",
+ tt_cost_storage = "Speicherschicht",
+ tt_storage_type = "Speichertyp",
+ tt_storage_volume = "Nutzbares Speichervolumen [m\u00b3]",
+ st_infiltration_box = "Sickerbox / Infiltration box",
+ st_gravel_trench = "Schotterrigol / Gravel trench",
+ tt_costs_header = "Kostenaufteilung [\u20ac]",
+ tt_params = "Variierende Parameter"
+ ),
+ en = list(
+ tt_scenario = "Scenario",
+ tt_n_overflows = "Number of overflow events",
+ tt_sum_overflows_mm = "Sum of overflows [mm]",
+ tt_overflow_volume = "Overflow volume [m\u00b3]",
+ tt_wb_header = "Water balance [%]",
+ tt_wb_evap = "Evapotranspiration",
+ tt_wb_infil = "Infiltration",
+ tt_wb_overflow = "Overflow",
+ tt_cost_total = "Total cost",
+ tt_cost_per_evap = "Cost per % evapotranspiration",
+ tt_above_min = "above min. of",
+ tt_cost_excavation = "Excavation",
+ tt_cost_profiling = "Profiling + greening",
+ tt_cost_filter = "Soil filter",
+ tt_cost_storage = "Storage layer",
+ tt_storage_type = "Storage type",
+ tt_storage_volume = "Usable storage volume [m\u00b3]",
+ st_infiltration_box = "Infiltration box / Sickerbox",
+ st_gravel_trench = "Gravel trench / Schotterrigol",
+ tt_costs_header = "Cost breakdown [\u20ac]",
+ tt_params = "Varying parameters"
+ )
+ )
+}
+
+#' Storage-type display factor and marker shapes for the cost plots
+#'
+#' Maps the raw `storage_type` values to their **short, language-specific**
+#' display names (from `storage_type_value_labels()`; e.g. "Sickerbox" /
+#' "Schotterrigol" for `lang = "de"`) and to the fixed marker shapes shared
+#' by all cost plots: **filled square (15) = infiltration box**, **filled
+#' triangle (17) = gravel trench**. Used for legends and facet strips; the
+#' tooltip's bold storage-type line keeps the longer bilingual names from
+#' `cost_tooltip_labels()`. Values that are `NA` or unknown fall back to the
+#' infiltration box, mirroring `cost_tooltip_text()`.
+#'
+#' @param storage_type Character vector of raw values
+#' (`"infiltration_box"` / `"gravel_trench"`).
+#' @param lang Character. `"de"` or `"en"`.
+#' @return List with `display` (factor, infiltration box level first) and
+#' `shape_values` (named vector for `ggplot2::scale_shape_manual()`).
+#' @noRd
+storage_type_shapes <- function(storage_type, lang = c("de", "en")) {
+ lang <- match.arg(lang)
+ labels <- storage_type_value_labels(lang)
+ raw <- as.character(storage_type)
+ disp <- ifelse(!is.na(raw) & raw == "gravel_trench",
+ labels[["gravel_trench"]], labels[["infiltration_box"]])
+ lvls <- unname(labels[c("infiltration_box", "gravel_trench")])
+ list(
+ display = factor(disp, levels = lvls),
+ shape_values = stats::setNames(c(15, 17), lvls)
+ )
+}
+
+#' Usable storage volume of the storage layer (m3) per row
+#'
+#' Area x height x usable porosity (thetaS - thetaFC) of the storage type.
+#' Taken from a precomputed `storage_volume_m3` column when available,
+#' otherwise derived from the `storage_theta*` columns; `NULL` when neither
+#' is present (old result sets), so callers can omit their tooltip line.
+#'
+#' @param df Data frame (results or parameter grid).
+#' @return Numeric vector or `NULL`.
+#' @noRd
+storage_volume_from_df <- function(df) {
+ if ("storage_volume_m3" %in% names(df)) {
+ df$storage_volume_m3
+ } else if (all(c("mulde_area", "storage_height", "storage_thetaS",
+ "storage_thetaFC") %in% names(df))) {
+ df$mulde_area * df$storage_height / 1000 *
+ (df$storage_thetaS - df$storage_thetaFC)
+ } else {
+ NULL
+ }
+}
+
+#' Assemble the shared cost-plot tooltip HTML for each row of `df`
+#'
+#' `df` must carry `scenario_name`, `n_overflows`, `sum_overflows`,
+#' `overflow_volume_m3`, the three `element.WB_*` shares, the five `cost_*`
+#' columns, `storage_type` and `params_html`. Returns one HTML string per row.
+#' Both cost plots call this so their tooltips are byte-identical.
+#'
+#' @param df Data frame with the columns listed above.
+#' @param tt Label list from `cost_tooltip_labels()`.
+#' @param digits Integer. Rounding for the numeric tooltip values.
+#' @param evap_min Numeric. Minimum element evapotranspiration share (%) of
+#' the complete model run — the reference for the cost-per-percent line.
+#' `NULL` falls back to the minimum within `df` (identical as long as `df`
+#' is unfiltered).
+#' @return Character vector, length `nrow(df)`.
+#' @noRd
+cost_tooltip_text <- function(df, tt, digits = 2L, evap_min = NULL) {
+ st_raw <- if ("storage_type" %in% names(df)) {
+ as.character(df$storage_type)
+ } else {
+ rep(NA_character_, nrow(df))
+ }
+ st_disp <- ifelse(!is.na(st_raw) & st_raw == "gravel_trench",
+ tt$st_gravel_trench, tt$st_infiltration_box)
+ # Derived cost efficiency: total cost per percentage point of element
+ # evapotranspiration ABOVE the run minimum [EUR/%] -- the baseline
+ # evapotranspiration comes "for free", only the gain beyond the worst
+ # scenario is paid for. Undefined ("-") at or below the minimum (the
+ # minimum scenario itself has no defined marginal cost).
+ evap <- df[["element.WB_Evapotranspiration_"]]
+ if (is.null(evap_min)) {
+ evap_min <- suppressWarnings(min(evap, na.rm = TRUE))
+ }
+ evap_delta <- evap - evap_min
+ cpe <- ifelse(!is.na(df$cost_total) & !is.na(evap_delta) & evap_delta > 0,
+ df$cost_total / evap_delta, NA_real_)
+ cpe_fmt <- vapply(cpe, function(v) {
+ if (is.na(v)) "-" else format(round(v, 0), big.mark = " ", trim = TRUE)
+ }, character(1))
+ cpe_label <- paste0(tt$tt_cost_per_evap, " (", tt$tt_above_min, " ",
+ round(evap_min, digits), " %) [\u20ac/%]")
+ # Usable storage volume line; omitted for result sets where it is not
+ # derivable (see storage_volume_from_df()).
+ storage_volume <- storage_volume_from_df(df)
+ storage_volume_line <- if (is.null(storage_volume)) {
+ ""
+ } else {
+ paste0("
", tt$tt_storage_volume, ": ", round(storage_volume, digits))
+ }
+ paste0(
+ tt$tt_scenario, ": ", df$scenario_name,
+ "
", tt$tt_n_overflows, ": ", df$n_overflows,
+ "
", tt$tt_sum_overflows_mm, ": ", round(df$sum_overflows, digits),
+ "
", tt$tt_overflow_volume, ": ", round(df$overflow_volume_m3, digits),
+ "
", tt$tt_wb_header, "",
+ "
", tt$tt_wb_evap, ": ",
+ round(df[["element.WB_Evapotranspiration_"]], digits),
+ "
", tt$tt_wb_infil, ": ",
+ round(df[["element.WB_InfiltrationNetto_"]], digits),
+ "
", tt$tt_wb_overflow, ": ",
+ round(df[["element.WB_Oberflaechenablauf_Ueberlauf_"]], digits),
+ "
", tt$tt_storage_type, ": ", st_disp, "",
+ storage_volume_line,
+ "
", tt$tt_costs_header, "",
+ "
", tt$tt_cost_excavation, ": ",
+ format(round(df$cost_excavation, 0), big.mark = " ", trim = TRUE),
+ "
", tt$tt_cost_profiling, ": ",
+ format(round(df$cost_profiling, 0), big.mark = " ", trim = TRUE),
+ "
", tt$tt_cost_filter, ": ",
+ format(round(df$cost_filter, 0), big.mark = " ", trim = TRUE),
+ "
", tt$tt_cost_storage, ": ",
+ format(round(df$cost_storage, 0), big.mark = " ", trim = TRUE),
+ "
", tt$tt_cost_total, ": ",
+ format(round(df$cost_total, 0), big.mark = " ", trim = TRUE), "",
+ "
", cpe_label, ": ", cpe_fmt,
+ "
", tt$tt_params, "
", df$params_html
+ )
+}
diff --git a/R/find_min_feasible.R b/R/find_min_feasible.R
new file mode 100644
index 0000000..0347431
--- /dev/null
+++ b/R/find_min_feasible.R
@@ -0,0 +1,216 @@
+#' Smallest feasible parameter value via bisection (monotone threshold search)
+#'
+#' Core building block of the swale-design optimiser: finds the smallest
+#' value of one design parameter for which the overflow target is met
+#' (`n_overflows <= x_max`), assuming quasi-monotone feasibility (larger
+#' value = never more overflows; verified for the RAINDROP model in the
+#' monotonicity analysis,
+#' ).
+#' Each evaluation halves the search interval, so
+#' `ceiling(log2(range / tol))` evaluations suffice.
+#'
+#' Two safety rules from the monotonicity analysis are built in:
+#' \itemize{
+#' \item \strong{Edge guard}: if the upper bound is infeasible by no more
+#' than `wobble` events (the +1 counting artefact of the 4-h event
+#' separation), a descending ladder below the edge searches for a
+#' feasible anchor before the branch is declared infeasible.
+#' \item \strong{Volume referee}: whenever `n_overflows` increases with
+#' the parameter (a counting flip), the overflow volume must have
+#' decreased; if the volume increased as well, a warning is emitted and
+#' `monotonicity_violation` is set (real non-monotonicity -- never
+#' observed at the three validation sites).
+#' }
+#'
+#' @param evaluate `function(value)` returning a list / one-row data.frame
+#' with at least `n_overflows`; if it also contains `volume_column`, the
+#' volume referee is active. Evaluations are memoised per value.
+#' @param x_max Feasibility target: feasible iff `n_overflows <= x_max`.
+#' @param lower,upper Numeric search bounds (continuous mode).
+#' @param tol Resolution of the continuous search (same unit as the value).
+#' @param levels Sorted numeric vector of discrete candidate values
+#' (discrete mode, e.g. Sickerbox stack heights). If given, `lower`,
+#' `upper` and `tol` are ignored and a binary search over the levels is
+#' performed.
+#' @param wobble Maximum counting-artefact size tolerated by the edge guard
+#' (default 1, matching the observed +1 flips).
+#' @param split_jitter Numeric in `[0, 0.45]`, default 0. With 0 the
+#' interval is split exactly in half (deterministic). A positive value
+#' draws the split fraction uniformly from `0.5 +- split_jitter` --
+#' a Monte-Carlo of the *search path*: repeated runs with different
+#' seeds take different routes to the threshold and must agree within
+#' `tol` if the result is a property of the problem, not of the path.
+#' @param volume_column Name of the volume element in the `evaluate` result
+#' used by the volume referee (default `"overflow_volume_m3"`).
+#' @param verbose Print one line per evaluation.
+#'
+#' @return List with
+#' \describe{
+#' \item{value}{smallest feasible value, or `NA` if infeasible}
+#' \item{n_overflows}{overflow count at `value`}
+#' \item{status}{`"ok"`, `"at_lower_bound"` (already feasible at the lower
+#' end -- caller may widen the bracket) or `"infeasible"`}
+#' \item{evaluations}{tibble of all evaluated values (value, n_overflows,
+#' volume), sorted by value}
+#' \item{n_evaluations}{number of distinct evaluations}
+#' \item{monotonicity_violation}{`TRUE` if the volume referee fired}
+#' }
+#'
+#' @examples
+#' # synthetic monotone step function: feasible from 137.4 m2 on
+#' f <- function(v) list(n_overflows = if (v >= 137.4) 0L else 10L)
+#' find_min_feasible(f, x_max = 0, lower = 25, upper = 200, tol = 2)$value
+#'
+#' @export
+find_min_feasible <- function(evaluate,
+ x_max,
+ lower = NULL,
+ upper = NULL,
+ tol = 1,
+ levels = NULL,
+ wobble = 1L,
+ split_jitter = 0,
+ volume_column = "overflow_volume_m3",
+ verbose = FALSE) {
+
+ stopifnot(split_jitter >= 0, split_jitter <= 0.45)
+
+ discrete <- !is.null(levels)
+ if (discrete) {
+ grid <- sort(unique(levels))
+ axis_lo <- 0 # virtual: below the smallest level
+ axis_hi <- length(grid)
+ axis_tol <- 1
+ to_value <- function(i) grid[[i]]
+ } else {
+ stopifnot(is.numeric(lower), is.numeric(upper), upper > lower, tol > 0)
+ axis_lo <- lower
+ axis_hi <- upper
+ axis_tol <- tol
+ to_value <- identity
+ }
+
+ evals <- new.env(parent = emptyenv())
+ eval_at <- function(axis_pos) {
+ v <- to_value(axis_pos)
+ key <- format(v, digits = 15)
+ if (!is.null(evals[[key]])) return(evals[[key]])
+ res <- as.list(evaluate(v))
+ if (!"n_overflows" %in% names(res)) {
+ stop("find_min_feasible(): evaluate() must return an element 'n_overflows'")
+ }
+ row <- list(
+ value = v,
+ n_overflows = as.numeric(res$n_overflows),
+ volume = if (volume_column %in% names(res)) {
+ as.numeric(res[[volume_column]])
+ } else {
+ NA_real_
+ }
+ )
+ assign(key, row, envir = evals)
+ if (isTRUE(verbose)) {
+ message(sprintf(" eval %s -> n_overflows = %s",
+ format(v), format(row$n_overflows)))
+ }
+ row
+ }
+ feasible <- function(axis_pos) {
+ n <- eval_at(axis_pos)$n_overflows
+ !is.na(n) && n <= x_max
+ }
+
+ status <- "ok"
+
+ # 1) Upper edge: with monotone feasibility the whole range is infeasible
+ # if the upper edge is -- unless the edge is a +1 counting wobble, in
+ # which case a descending ladder looks for a feasible anchor below.
+ if (!feasible(axis_hi)) {
+ n_hi <- eval_at(axis_hi)$n_overflows
+ anchor <- NA_real_
+ if (!is.na(n_hi) && n_hi <= x_max + wobble) {
+ offset <- axis_tol
+ repeat {
+ p <- axis_hi - offset
+ if (discrete) p <- ceiling(p)
+ if (p <= axis_lo) break
+ if (feasible(p)) {
+ anchor <- p
+ break
+ }
+ offset <- offset * 2
+ }
+ }
+ if (is.na(anchor)) {
+ status <- "infeasible"
+ } else {
+ axis_hi <- anchor
+ }
+ }
+
+ # 2) Bisection: invariant lo infeasible (or virtual/edge), hi feasible.
+ best <- NA_real_
+ if (!identical(status, "infeasible")) {
+ lo <- axis_lo
+ hi <- axis_hi
+ if (!discrete && feasible(lo)) {
+ hi <- lo # optimum at (or below) the lower end
+ }
+ while ((hi - lo) > axis_tol) {
+ frac <- if (split_jitter > 0) {
+ stats::runif(1, 0.5 - split_jitter, 0.5 + split_jitter)
+ } else {
+ 0.5
+ }
+ mid <- lo + frac * (hi - lo)
+ if (discrete) {
+ mid <- floor(mid)
+ if (mid <= lo) mid <- lo + 1
+ if (mid >= hi) mid <- hi - 1
+ }
+ if (mid <= lo || mid >= hi) break
+ if (feasible(mid)) hi <- mid else lo <- mid
+ }
+ best <- hi
+ at_lower <- if (discrete) best <= 1 else best <= axis_lo
+ if (at_lower) status <- "at_lower_bound"
+ }
+
+ # 3) Volume referee over all evaluations of this search
+ ev <- do.call(rbind, lapply(ls(evals), function(k) {
+ e <- get(k, envir = evals)
+ data.frame(value = e$value, n_overflows = e$n_overflows,
+ volume = e$volume)
+ }))
+ ev <- ev[order(ev$value), , drop = FALSE]
+ rownames(ev) <- NULL
+ monotonicity_violation <- FALSE
+ if (nrow(ev) >= 2) {
+ dn <- diff(ev$n_overflows)
+ dv <- diff(ev$volume)
+ flips <- which(!is.na(dn) & dn > 0)
+ real <- flips[!is.na(dv[flips]) & dv[flips] > 1e-9]
+ if (length(real) > 0) {
+ monotonicity_violation <- TRUE
+ warning(sprintf(
+ paste0("find_min_feasible(): n_overflows AND overflow volume ",
+ "increase between value %s and %s -- real non-monotonicity, ",
+ "bisection result unreliable for this branch."),
+ format(ev$value[real[1]]), format(ev$value[real[1] + 1])
+ ), call. = FALSE)
+ }
+ }
+
+ list(
+ value = if (identical(status, "infeasible")) NA_real_ else to_value(best),
+ n_overflows = if (identical(status, "infeasible")) {
+ NA_real_
+ } else {
+ eval_at(best)$n_overflows
+ },
+ status = status,
+ evaluations = tibble::as_tibble(ev),
+ n_evaluations = nrow(ev),
+ monotonicity_violation = monotonicity_violation
+ )
+}
diff --git a/R/get_simulation_results_optim.R b/R/get_simulation_results_optim.R
index 0540e13..311315e 100644
--- a/R/get_simulation_results_optim.R
+++ b/R/get_simulation_results_optim.R
@@ -26,6 +26,13 @@
#' @param simulation_names Character vector of simulation run identifiers
#' (e.g. \code{c("s00001", "s00002")}).
#' @param debug print debug messages (default: TRUE)
+#' @param lean Logical. If \code{TRUE}, read only the fields consumed by
+#' \code{\link{add_overflow_events_and_waterbalance}} -- \code{element$rates},
+#' \code{element$water_balance} and \code{connected_area$water_balance} -- and
+#' leave \code{meta}/\code{states} (both sides) and \code{connected_area$rates}
+#' as \code{NULL}. This keeps per-run memory and I/O minimal when each run is
+#' thinned to its optimisation row immediately instead of collecting every
+#' run's full results first. Defaults to \code{FALSE} (read everything).
#' @return A named list with one entry per \code{simulation_names}. Each entry is
#' either \code{NULL} (element HDF5 missing) or a nested list:
#' \describe{
@@ -53,13 +60,16 @@
#' @importFrom stats setNames
#' @importFrom hdf5r H5File
get_simulation_results_optim <- function(paths,
- path_list,
+ path_list,
simulation_names,
- debug = TRUE) {
-
- message(sprintf("Reading results files ('%s') for %d model runs",
- paste0(c(paths$file_results_hdf5_element, paths$file_results_hdf5_flaeche), collapse = "|"),
- length(simulation_names)))
+ debug = TRUE,
+ lean = FALSE) {
+
+ if (isTRUE(debug)) {
+ message(sprintf("Reading results files ('%s') for %d model runs",
+ paste0(c(paths$file_results_hdf5_element, paths$file_results_hdf5_flaeche), collapse = "|"),
+ length(simulation_names)))
+ }
stats::setNames(lapply(simulation_names, function(s_name) {
paths <- kwb.utils::resolve(path_list, dir_target = s_name)
@@ -82,56 +92,70 @@ get_simulation_results_optim <- function(paths,
return(NULL)
}
- # Open H5 handles outside catAndRun so on.exit binds to *this* lambda's
- # frame, not catAndRun's internal frame. Handles are guaranteed to close
- # whichever way the iteration unwinds.
- res_hdf5_element <- hdf5r::H5File$new(paths$path_results_hdf5_element, mode = "r")
- on.exit(try(res_hdf5_element$close_all(), silent = TRUE), add = TRUE)
+ # Open + read in an inner function so its on.exit() handle-closing binds to
+ # *its own* frame and always fires (even on error) before we decide what to
+ # return. The surrounding tryCatch makes a result file that exists but is
+ # unreadable -- e.g. the engine crashed mid-write for that scenario --
+ # behave like a missing file (NULL + warning) instead of aborting the whole
+ # (possibly parallel) batch. Downstream add_overflow_events_and_waterbalance()
+ # then emits an NA row for the scenario.
+ read_result <- function() {
+ res_hdf5_element <- hdf5r::H5File$new(paths$path_results_hdf5_element, mode = "r")
+ on.exit(try(res_hdf5_element$close_all(), silent = TRUE), add = TRUE)
- res_hdf5_flaeche <- if (has_flaeche) {
- h <- hdf5r::H5File$new(paths$path_results_hdf5_flaeche, mode = "r")
- on.exit(try(h$close_all(), silent = TRUE), add = TRUE)
- h
- } else {
- if (isTRUE(debug)) {
- message(sprintf(
- "No connected_area H5 for %s ('%s') -> connected_area = NULL",
- s_name, paths$path_results_hdf5_flaeche
- ))
+ res_hdf5_flaeche <- if (has_flaeche) {
+ h <- hdf5r::H5File$new(paths$path_results_hdf5_flaeche, mode = "r")
+ on.exit(try(h$close_all(), silent = TRUE), add = TRUE)
+ h
+ } else {
+ if (isTRUE(debug)) {
+ message(sprintf(
+ "No connected_area H5 for %s ('%s') -> connected_area = NULL",
+ s_name, paths$path_results_hdf5_flaeche
+ ))
+ }
+ NULL
}
- NULL
- }
- kwb.utils::catAndRun(
- messageText = sprintf("(%d/%d)) Reading results files for model run %s",
- which(simulation_names == s_name),
- length(simulation_names),
- paths$dir_target_output),
- expr = {
- element <- list(
- meta = kwb.raindrop::read_hdf5_scalars(res_hdf5_element[["Metainfo"]],
- numeric_only = FALSE),
- rates = kwb.raindrop::read_hdf5_timeseries(res_hdf5_element[["Raten"]]),
- water_balance = kwb.raindrop::read_hdf5_scalars(res_hdf5_element[["Wasserbilanz"]]),
- states = kwb.raindrop::read_hdf5_timeseries(res_hdf5_element[["Zustandsvariablen"]])
- )
-
- connected_area <- if (!is.null(res_hdf5_flaeche)) {
- list(
- meta = kwb.raindrop::read_hdf5_scalars(res_hdf5_flaeche[["Metainfo"]],
+ kwb.utils::catAndRun(
+ messageText = sprintf("(%d/%d)) Reading results files for model run %s",
+ which(simulation_names == s_name),
+ length(simulation_names),
+ paths$dir_target_output),
+ expr = {
+ element <- list(
+ meta = if (lean) NULL else kwb.raindrop::read_hdf5_scalars(res_hdf5_element[["Metainfo"]],
numeric_only = FALSE),
- rates = kwb.raindrop::read_hdf5_timeseries(res_hdf5_flaeche[["Raten"]]),
- water_balance = kwb.raindrop::read_hdf5_scalars(res_hdf5_flaeche[["Wasserbilanz"]]),
- states = kwb.raindrop::read_hdf5_timeseries(res_hdf5_flaeche[["Zustandsvariablen"]])
+ rates = kwb.raindrop::read_hdf5_timeseries(res_hdf5_element[["Raten"]]),
+ water_balance = kwb.raindrop::read_hdf5_scalars(res_hdf5_element[["Wasserbilanz"]]),
+ states = if (lean) NULL else kwb.raindrop::read_hdf5_timeseries(res_hdf5_element[["Zustandsvariablen"]])
)
- } else {
- NULL
- }
- list(element = element, connected_area = connected_area)
- },
- dbg = debug
- )
+ connected_area <- if (!is.null(res_hdf5_flaeche)) {
+ list(
+ meta = if (lean) NULL else kwb.raindrop::read_hdf5_scalars(res_hdf5_flaeche[["Metainfo"]],
+ numeric_only = FALSE),
+ rates = if (lean) NULL else kwb.raindrop::read_hdf5_timeseries(res_hdf5_flaeche[["Raten"]]),
+ water_balance = kwb.raindrop::read_hdf5_scalars(res_hdf5_flaeche[["Wasserbilanz"]]),
+ states = if (lean) NULL else kwb.raindrop::read_hdf5_timeseries(res_hdf5_flaeche[["Zustandsvariablen"]])
+ )
+ } else {
+ NULL
+ }
+
+ list(element = element, connected_area = connected_area)
+ },
+ dbg = debug
+ )
+ }
+
+ tryCatch(read_result(), error = function(e) {
+ warning(sprintf(
+ "Scenario '%s': result HDF5 unreadable ('%s'): %s -- treating as missing (NULL).",
+ s_name, paths$path_results_hdf5_element, conditionMessage(e)
+ ), call. = FALSE)
+ NULL
+ })
}), nm = simulation_names)
}
diff --git a/R/make_swale_runner.R b/R/make_swale_runner.R
new file mode 100644
index 0000000..abe4e6a
--- /dev/null
+++ b/R/make_swale_runner.R
@@ -0,0 +1,270 @@
+#' Capillary suction from hydraulic conductivity (Rawls fit)
+#'
+#' Suction head Psi_s in mm as a function of the saturated hydraulic
+#' conductivity in mm/h, as used by the workflow vignettes.
+#'
+#' @param kf_mmh Saturated hydraulic conductivity in mm/h.
+#' @return Suction head in mm.
+#' @keywords internal
+#' @noRd
+psi_s_mm <- function(kf_mmh) {
+ (3.237 * (kf_mmh / 25.4)^(-0.328)) * 25.4
+}
+
+#' Create a site-specific single-scenario runner for the optimiser
+#'
+#' Factors the `run_one()` function that was duplicated across the three
+#' workflow vignettes (Eisenstadt 2005, Wien, Bad Aussee) into one
+#' package-level closure factory. The returned function runs the RAINDROP
+#' engine for one parameter set and returns the thinned one-row
+#' optimisation result (overflow events + water balance), augmented with
+#' the input parameters and the overflow volume in m3.
+#'
+#' Site differences are covered by the arguments: Eisenstadt scales the
+#' rain curve shipped in `base.h5` by `rain_factor` (leave
+#' `timeseries_rain` = `NULL`), Wien and Bad Aussee replace the rain and
+#' ET0 curves entirely (`timeseries_rain` / `timeseries_et`, values in
+#' mm/h as written by the vignettes).
+#'
+#' On the first call the runner prepares a **site master file** once:
+#' `base.h5` plus everything identical for every run (calculation
+#' settings, ET/rain time series). Each run then copies the master and
+#' writes only its ~15 small parameter datasets. Compared to the
+#' previous full read/rewrite of *all* datasets per run this removes
+#' the dominant per-run overhead of the optimisation searches
+#' (hundreds of runs; for Wien / Bad Aussee it skips rewriting the
+#' 15-year rain series on every single engine run).
+#'
+#' @param path_list Path definition list as used by the workflow vignettes
+#' (resolvable with `kwb.utils::resolve()`, must contain `path_base`,
+#' `path_exe`, `dir_input`, `dir_output`, `dir_target_output`,
+#' `path_target_input`, `path_results_hdf5_element`,
+#' `path_results_hdf5_flaeche`, `file_target`).
+#' @param timestep_hours Engine time step in hours (default 0.1).
+#' @param timeseries_rain Optional data.frame `time`/`value` (mm/h) written
+#' to `//Kurven/Regen` (the dataset must exist in `base.h5`); when
+#' given, the `//Kurven/Growth_1` and `//Kurven/Shading_1` end times
+#' are extended to the rain series end (skipped for templates without
+#' these curves) and `rain_factor` is ignored. Without
+#' `timeseries_rain`, a per-run `rain_factor != 1` requires
+#' `//Kurven/Regen` to exist as a time series in `base.h5` -- a clear
+#' error is thrown otherwise.
+#' @param timeseries_et Optional data.frame `time`/`value` (mm/h) written
+#' to `//Kurven/ET0`.
+#' @param storage_types Soil presets of the storage layer per storage type,
+#' see [default_storage_types()].
+#' @param event_separation_hours Event separation for overflow counting
+#' (default 4, as in the vignettes and the monotonicity analysis).
+#' @param scenario_prefix Prefix for generated scenario names (default
+#' `"o"` -> `o00001`, `o00002`, ... -- distinct from the grid runs
+#' `s00001` ...).
+#' @param cleanup Delete each scenario's copied input file and output
+#' directory right after the thinned one-row result has been read
+#' (default `TRUE`). The optimisers only need that row; without the
+#' cleanup an optimisation run (hundreds of engine runs per task, each
+#' with its own copy of `base.h5` plus all output HDF5s) fills the
+#' temp drive and the engine aborts with HDF5 `errno = 28` ("No space
+#' left on device"). Set `FALSE` to keep all scenario files for
+#' debugging. Files of a *failed* run are always kept.
+#' @param debug Passed on to the engine/reader helpers.
+#'
+#' @return `function(params)` where `params` is a named list (or one-row
+#' data.frame) with `mulde_area`, `mulde_height` (mm), `storage_type`,
+#' `storage_height` (mm), `connected_area` (m2), `filter_height` (mm),
+#' `filter_hydraulicconductivity` (mm/h), `bottom_hydraulicconductivity`
+#' (mm/h) and optionally `rain_factor` (default 1) and `lai`
+#' (default 3.9). It returns a one-row tibble with the parameters, the
+#' scenario name and the optimisation metrics (`n_overflows`,
+#' `sum_overflows` in mm, `overflow_volume_m3`, water-balance shares).
+#'
+#' @seealso [optimise_swale_design()], [find_min_feasible()]
+#' @export
+make_swale_runner <- function(path_list,
+ timestep_hours = 0.1,
+ timeseries_rain = NULL,
+ timeseries_et = NULL,
+ storage_types = default_storage_types(),
+ event_separation_hours = 4,
+ scenario_prefix = "o",
+ cleanup = TRUE,
+ debug = FALSE) {
+
+ counter <- 0L
+ master_path <- NULL
+ template_rain <- NULL
+
+ # One-time site master: base.h5 plus everything that is identical for
+ # every run (calculation settings, ET/rain time series). Each run then
+ # copies the master and writes only its ~15 small parameter datasets --
+ # the full read/write cycle of all datasets (incl. multi-year curves)
+ # per engine run dominated the runtime of the optimisation searches.
+ prepare_master <- function(paths) {
+ mp <- file.path(paths$dir_input,
+ sprintf("%s_master.h5", scenario_prefix))
+ fs::dir_create(paths$dir_input, recurse = TRUE)
+ fs::file_copy(path = paths$path_base, new_path = mp, overwrite = TRUE)
+
+ h5m <- hdf5r::H5File$new(mp, mode = "a")
+ on.exit(try(h5m$close_all(), silent = TRUE), add = TRUE)
+
+ static_vals <- list(
+ `//Berechnungsparameter/Zeitschritt_Infiltration` = timestep_hours,
+ `//Berechnungsparameter/Zeitschritt_ET` = timestep_hours,
+ `//Berechnungsparameter/Zeitschritt_Verschaltungen` = timestep_hours,
+ `//Berechnungsparameter/R-Plots` = 0,
+ `//Berechnungsparameter/Ausgabemodus` = "Optimierung",
+ `//Berechnungsparameter/Evapotranspiration_aktiv` = 1,
+ `//Massnahmenelemente/Dach/Berechnungsparameter/Evapotranspiration_aktiv` = 1,
+ `//Massnahmenelemente/Mulde_Rigole/Berechnungsparameter/Evapotranspiration_aktiv` = 1,
+ `//Massnahmenelemente/Mulde_Rigole/Allgemein/Regen-Skalierungsfaktor` = 1
+ )
+ if (!is.null(timeseries_et)) {
+ static_vals$`//Kurven/ET0` <- timeseries_et
+ }
+ # base.h5 templates differ in which curves they ship -- only touch
+ # datasets that actually exist (missing Growth/Shading just skips
+ # the end-time fix; a missing rain curve only matters if a run
+ # later asks for rain_factor != 1, which then errors clearly)
+ existing <- list_h5_datasets(h5m)$path
+ if (!is.null(timeseries_rain)) {
+ if (!"//Kurven/Regen" %in% existing) {
+ stop("make_swale_runner(): base.h5 has no dataset //Kurven/Regen ",
+ "to replace with timeseries_rain: ", paths$path_base)
+ }
+ static_vals$`//Kurven/Regen` <- timeseries_rain
+ for (curve in c("//Kurven/Growth_1", "//Kurven/Shading_1")) {
+ if (!curve %in% existing) next
+ cv <- h5_read_values(h5m, paths = curve)[[curve]]
+ if (is.data.frame(cv) && length(cv$time) >= 2) {
+ cv$time[2] <- max(timeseries_rain$time)
+ static_vals[[curve]] <- cv
+ }
+ }
+ } else if ("//Kurven/Regen" %in% existing) {
+ # kept for per-run rain_factor scaling (Eisenstadt variant)
+ template_rain <<- h5_read_values(
+ h5m, paths = "//Kurven/Regen"
+ )[["//Kurven/Regen"]]
+ }
+
+ h5_write_values(h5m, static_vals, resize = TRUE,
+ scalar_strategy = "error", verbose = FALSE)
+ h5m$close_all()
+ master_path <<- mp
+ }
+
+ function(params) {
+ params <- as.list(params)
+ required <- c("mulde_area", "mulde_height", "storage_type",
+ "storage_height", "connected_area", "filter_height",
+ "filter_hydraulicconductivity",
+ "bottom_hydraulicconductivity")
+ missing <- setdiff(required, names(params))
+ if (length(missing) > 0) {
+ stop("make_swale_runner(): params is missing: ",
+ paste(missing, collapse = ", "))
+ }
+ st <- storage_types[[params$storage_type]]
+ if (is.null(st)) {
+ stop("make_swale_runner(): unknown storage_type '",
+ params$storage_type, "'")
+ }
+ rain_factor <- if (is.null(params$rain_factor)) 1 else params$rain_factor
+ lai <- if (is.null(params$lai)) 3.9 else params$lai
+
+ counter <<- counter + 1L
+ s_name <- sprintf("%s%05d", scenario_prefix, counter)
+ paths <- kwb.utils::resolve(path_list, dir_target = s_name)
+
+ if (is.null(master_path)) prepare_master(paths)
+
+ fs::dir_create(paths$dir_input, recurse = TRUE)
+ fs::dir_create(paths$dir_output, recurse = TRUE)
+ fs::dir_create(paths$dir_target_output, recurse = TRUE)
+
+ fs::file_copy(path = master_path,
+ new_path = paths$path_target_input,
+ overwrite = TRUE)
+
+ h5 <- hdf5r::H5File$new(paths$path_target_input, mode = "a")
+ on.exit(try(h5$close_all(), silent = TRUE), add = TRUE)
+
+ new_path <- stringr::str_c(
+ normalizePath(fs::path_abs(paths$dir_target_output)), "\\"
+ )
+
+ vals <- list(
+ `//Berechnungsparameter/Ergebnispfad` = new_path,
+ `//Massnahmenelemente/Dach/Allgemein/Flaeche` = params$connected_area,
+ `//Massnahmenelemente/Mulde_Rigole/Allgemein/Flaeche` = params$mulde_area,
+ `//Massnahmenelemente/Mulde_Rigole/Eigenschaften_Oberflaeche/Ueberlaufhoehe` = params$mulde_height,
+ `//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Startwerte_theta_ActualSoilMoisture` =
+ c(0.3, st$Startwerte_theta_ActualSoilMoisture),
+ `//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Schichtdicken` =
+ c(params$filter_height, params$storage_height),
+ `//Bodenarten/Speicher/thetaWP_MoistureAtWiltingPoint` = st$thetaWP_MoistureAtWiltingPoint,
+ `//Bodenarten/Speicher/thetaFC_MoistureAtFieldCapacity` = st$thetaFC_MoistureAtFieldCapacity,
+ `//Bodenarten/Speicher/thetaS_MoistureAtSaturation` = st$thetaS_MoistureAtSaturation,
+ `//Massnahmenelemente/Mulde_Rigole/Allgemein/Endversickerungsrate` =
+ params$bottom_hydraulicconductivity,
+ `//Massnahmenelemente/Mulde_Rigole/Parameter_Evapotranspiration/LAI_LeafAreaIndex` = lai,
+ `//Bodenarten/Bodenfilter/Ks_HydraulicConductivity` =
+ params$filter_hydraulicconductivity,
+ `//Bodenarten/Bodenfilter/Psi_Saugspannung_CapillarySuction` =
+ psi_s_mm(params$filter_hydraulicconductivity)
+ )
+ # rain_factor is documented to be ignored when own rain series are
+ # written (timeseries_rain); it scales the base.h5 curve otherwise
+ if (is.null(timeseries_rain) && rain_factor != 1) {
+ if (!is.data.frame(template_rain)) {
+ stop("make_swale_runner(): rain_factor != 1 requires base.h5 to ",
+ "contain //Kurven/Regen as a time series (time/value)")
+ }
+ scaled <- template_rain
+ scaled$value <- scaled$value * rain_factor
+ vals$`//Kurven/Regen` <- scaled
+ }
+
+ h5_write_values(h5, vals, resize = TRUE,
+ scalar_strategy = "error", verbose = FALSE)
+ h5$close_all()
+
+ run_model(path_exe = paths$path_exe,
+ path_input = paths$path_target_input,
+ debug = debug)
+
+ # Thin immediately (lean read), exactly like the vignettes' run_one()
+ sim_one <- get_simulation_results_optim(
+ paths = paths,
+ path_list = path_list,
+ simulation_names = s_name,
+ debug = debug,
+ lean = TRUE
+ )
+
+ row <- add_overflow_events_and_waterbalance(
+ simulation_results = sim_one,
+ event_separation_hours = event_separation_hours,
+ canonical_variables = default_canonical_wb_variables()
+ )
+
+ # the thinned row is all the optimiser needs -- drop the scenario's
+ # input copy and output directory so long searches (hundreds of
+ # engine runs) do not fill the temp drive. Reached only on success:
+ # a failed run errors above and keeps its files for debugging.
+ if (isTRUE(cleanup)) {
+ try(fs::file_delete(paths$path_target_input), silent = TRUE)
+ try(fs::dir_delete(paths$dir_target_output), silent = TRUE)
+ }
+
+ dplyr::bind_cols(
+ tibble::as_tibble(params[required]),
+ tibble::tibble(rain_factor = rain_factor, lai = lai),
+ row
+ ) %>%
+ dplyr::mutate(
+ # sum_overflows is mm water column over the swale area
+ overflow_volume_m3 = .data$sum_overflows * .data$mulde_area / 1000
+ )
+ }
+}
diff --git a/R/optimise_swale_design.R b/R/optimise_swale_design.R
new file mode 100644
index 0000000..a4359fe
--- /dev/null
+++ b/R/optimise_swale_design.R
@@ -0,0 +1,352 @@
+#' Warm-start area bracket from prior (brute-force) results
+#'
+#' Narrows the mulde_area search interval to one grid step around the
+#' cheapest feasible grid cell of the matching branch, if prior results
+#' contain it. Falls back to the full bounds otherwise.
+#'
+#' @keywords internal
+#' @noRd
+area_bracket_from_prior <- function(prior, type, h_s, h_m, x, bounds) {
+ needed <- c("storage_type", "storage_height", "mulde_height", "mulde_area",
+ "n_overflows", "filter_hydraulicconductivity")
+ if (is.null(prior) || !all(needed %in% names(prior))) return(bounds)
+ kf_max <- suppressWarnings(
+ max(prior$filter_hydraulicconductivity, na.rm = TRUE)
+ )
+ d <- prior[prior$storage_type == type &
+ prior$filter_hydraulicconductivity == kf_max &
+ prior$storage_height == h_s &
+ prior$mulde_height == h_m, , drop = FALSE]
+ if (nrow(d) < 2) return(bounds)
+ ok <- d$mulde_area[!is.na(d$n_overflows) & d$n_overflows <= x]
+ if (length(ok) == 0) return(bounds)
+ first_ok <- min(ok)
+ areas <- sort(unique(d$mulde_area))
+ step <- if (length(areas) > 1) min(diff(areas)) else diff(bounds)
+ lo <- max(bounds[1], first_ok - step)
+ hi <- min(bounds[2], first_ok)
+ if (hi <= lo) bounds else c(lo, hi)
+}
+
+#' Find the cost-optimal swale design per overflow target
+#'
+#' Coordinate-descent optimiser built from a single primitive
+#' ([find_min_feasible()], bisection over one parameter): shrink the
+#' expensive lever first (`mulde_area`), then the cheap one
+#' (`mulde_height`); the storage layer starts at its smallest level and is
+#' only escalated when the area is stuck at its upper bound. The filter
+#' conductivity is expected to be fixed at the maximum via `fixed` (it is
+#' cost-free and dominant, see the monotonicity analysis,
+#' ).
+#' Every engine run is cached, so the sweep over all `x_targets` and both
+#' storage types shares evaluations.
+#'
+#' **The search order is derived from `cost_rates`** via a
+#' specific-cost proxy (EUR per mm of storage capacity, capacity model
+#' `V ~ area * (mulde_height + porosity * storage_height)`; the layer
+#' porosity comes from `storage_spec`, see [default_storage_spec()]):
+#' maximising `mulde_height` first is optimal for *any* rates under
+#' this cost model (it costs only excavation, while area pays every
+#' component), and the starting storage level is chosen as the
+#' cheapest level per mm of capacity -- the smallest level under the
+#' default rates, a high level when e.g. the storage material is cheap.
+#' Without a `porosity` entry in `storage_spec` the legacy order
+#' (smallest level first) is used. The proxy is a first-order
+#' heuristic: it assumes capacity-additive levers and cannot rank
+#' parameters with nonlinear hydraulic effects (e.g. a variable filter
+#' conductivity) -- for those, and as the assumption-free cross-check,
+#' use [optimise_swale_design_simultaneous()], which carries
+#' `cost_rates` directly inside its objective.
+#'
+#' @param run_fn `function(params)` running one scenario and returning at
+#' least `n_overflows` plus `sum_overflows` (mm) or `overflow_volume_m3`;
+#' typically created with [make_swale_runner()]. `params` is a named list
+#' of `mulde_area`, `mulde_height`, `storage_type`, `storage_height` plus
+#' everything in `fixed`.
+#' @param x_targets Integer vector of overflow targets (feasible :<=>
+#' `n_overflows <= x`), default `0:5`.
+#' @param area_bounds,area_tol Search range (m2) and resolution for
+#' `mulde_area`. The found area sits up to one `area_tol` above the
+#' exact feasibility boundary (worst-case cost overshoot roughly
+#' `area_tol` x specific cost per m2, i.e. a few percent at the
+#' default 2 m2); thanks to the bisection, every *halving* of
+#' `area_tol` costs only one additional engine run per area search --
+#' the cheapest precision lever of this optimiser. It also shrinks
+#' the tolerance-artefact part of the final `mulde_height` trim (the
+#' values just below the height maximum at low `x_targets`).
+#' @param height_bounds,height_tol Search range (mm) and resolution for
+#' `mulde_height`.
+#' @param storage_spec Storage search space per type, see
+#' [default_storage_spec()]: discrete `levels` (infiltration box) or
+#' continuous `bounds` + `tol` (gravel trench).
+#' @param fixed Named list of parameters passed unchanged to `run_fn`
+#' (connected area, filter geometry, kf at maximum, ...). Must contain
+#' `filter_height` for the cost model.
+#' @param prior_results Optional data.frame with prior (grid) results in
+#' the workflow CSV schema, used as warm start (narrows the first area
+#' bracket to one grid step).
+#' @param split_jitter Passed to [find_min_feasible()]: 0 (default) =
+#' deterministic halving; > 0 randomises every bisection split point
+#' (Monte-Carlo of the search path -- repeated runs with different
+#' seeds must agree within the search tolerances).
+#' @param max_total_depth Optional analytic depth constraint in mm:
+#' `mulde_height + filter_height + storage_height <= max_total_depth`
+#' (e.g. from DWA-A 138 groundwater clearance or cover requirements).
+#' Enforced without any simulation runs.
+#' @param cost_rates Unit costs, see [default_cost_rates()].
+#' @param verbose Print one progress line per solved cell.
+#'
+#' @return Tibble with one row per (storage type, x): the optimal design
+#' (`mulde_area`, `mulde_height`, `storage_height`), its metrics
+#' (`n_overflows`, `overflow_volume_m3`, `et_pct`), cost columns from
+#' [compute_costs()], a `status` (`"ok"` or `"infeasible_within_bounds"`),
+#' `monotonicity_warning` (volume referee) and `n_runs_new` (fresh engine
+#' runs spent on this cell). All evaluated designs are attached as
+#' attribute `"evaluations"`.
+#'
+#' @seealso [optimise_swale_design_simultaneous()] (alternative: all
+#' parameters at once via penalised Nelder-Mead, as an independent
+#' cross-check of the coordinate descent), [find_min_feasible()],
+#' [make_swale_runner()], [default_storage_spec()]
+#' @export
+optimise_swale_design <- function(run_fn,
+ x_targets = 0:5,
+ area_bounds = c(25, 200),
+ area_tol = 2,
+ height_bounds = c(100, 300),
+ height_tol = 10,
+ storage_spec = default_storage_spec(),
+ fixed = list(
+ connected_area = 1000,
+ filter_height = 300,
+ filter_hydraulicconductivity = 360,
+ bottom_hydraulicconductivity = 12
+ ),
+ prior_results = NULL,
+ split_jitter = 0,
+ max_total_depth = NULL,
+ cost_rates = default_cost_rates(),
+ verbose = TRUE) {
+
+ stopifnot(is.function(run_fn), !is.null(fixed$filter_height))
+ filter_height <- fixed$filter_height
+
+ # --- shared evaluation cache (one engine run per distinct design) -------
+ cache <- new.env(parent = emptyenv())
+ runs_executed <- 0L
+
+ eval_design <- function(type, area, h_m, h_s) {
+ key <- paste(type, format(area, digits = 10), format(h_m, digits = 10),
+ format(h_s, digits = 10), sep = "|")
+ hit <- cache[[key]]
+ if (!is.null(hit)) return(hit)
+ params <- c(list(mulde_area = area, mulde_height = h_m,
+ storage_type = type, storage_height = h_s), fixed)
+ res <- as.list(run_fn(params))
+ if (!"n_overflows" %in% names(res)) {
+ stop("optimise_swale_design(): run_fn() must return 'n_overflows'")
+ }
+ vol <- res[["overflow_volume_m3"]]
+ if (is.null(vol) && !is.null(res[["sum_overflows"]])) {
+ vol <- res[["sum_overflows"]] * area / 1000 # mm x m2 / 1000 = m3
+ }
+ et <- res[["element.WB_Evapotranspiration_"]]
+ out <- list(storage_type = type, mulde_area = area, mulde_height = h_m,
+ storage_height = h_s,
+ n_overflows = as.numeric(res$n_overflows),
+ overflow_volume_m3 = if (is.null(vol)) NA_real_ else as.numeric(vol),
+ et_pct = if (is.null(et)) NA_real_ else as.numeric(et))
+ runs_executed <<- runs_executed + 1L
+ assign(key, out, envir = cache)
+ out
+ }
+
+ # --- analytic depth constraint ------------------------------------------
+ hm_upper <- function(h_s) {
+ up <- rep(height_bounds[2], length(h_s))
+ if (!is.null(max_total_depth)) {
+ up <- pmin(up, max_total_depth - filter_height - h_s)
+ }
+ up
+ }
+
+ # area search with warm-start bracket; widens the bracket when the
+ # optimum turns out to lie below it
+ search_area <- function(eval_a, x, bracket) {
+ res <- find_min_feasible(eval_a, x_max = x,
+ lower = bracket[1], upper = bracket[2],
+ tol = area_tol, split_jitter = split_jitter)
+ if (identical(res$status, "at_lower_bound") &&
+ bracket[1] > area_bounds[1]) {
+ res <- find_min_feasible(eval_a, x_max = x,
+ lower = area_bounds[1], upper = bracket[1],
+ tol = area_tol, split_jitter = split_jitter)
+ }
+ if (identical(res$status, "infeasible") &&
+ bracket[2] < area_bounds[2]) {
+ # warm start was too optimistic -> retry up to the full upper bound
+ res <- find_min_feasible(eval_a, x_max = x,
+ lower = bracket[1], upper = area_bounds[2],
+ tol = area_tol, split_jitter = split_jitter)
+ }
+ res
+ }
+
+ # --- solve one (storage type, x) cell ------------------------------------
+ solve_cell <- function(type, x) {
+ runs_before <- runs_executed
+ spec <- storage_spec[[type]]
+ if (is.null(spec)) {
+ stop("optimise_swale_design(): storage_spec has no entry '", type, "'")
+ }
+ discrete <- !is.null(spec$levels)
+ mono_warn <- FALSE
+
+ infeasible_row <- function() tibble::tibble(
+ x = x, storage_type = type, status = "infeasible_within_bounds",
+ mulde_area = NA_real_, mulde_height = NA_real_,
+ storage_height = NA_real_, n_overflows = NA_real_,
+ overflow_volume_m3 = NA_real_, et_pct = NA_real_,
+ monotonicity_warning = mono_warn,
+ n_runs_new = runs_executed - runs_before
+ )
+
+ # start storage level: derived from the cost rates when the spec
+ # carries the layer porosity -- the cheapest level per mm of storage
+ # capacity (capacity model V ~ area * (h_m + porosity * h_s), all
+ # cost terms ~ area, so the area cancels out of the comparison).
+ # Under the default rates this picks the smallest level (storage is
+ # the expensive lever); under e.g. cheap storage material it starts
+ # high where coordinate descent would otherwise never look. Without
+ # a porosity entry: legacy order (smallest level first).
+ choose_start_hs <- function(candidates) {
+ p <- spec$porosity
+ storage_rate <- switch(
+ type,
+ infiltration_box = cost_rates$infiltration_box_eur_per_m3,
+ gravel_trench = cost_rates$gravel_trench_eur_per_m3
+ )
+ if (is.null(p) || is.null(storage_rate)) return(min(candidates))
+ sc <- vapply(candidates, function(s) {
+ hm <- hm_upper(s)
+ if (hm < height_bounds[1]) return(Inf)
+ f <- cost_rates$excavation_eur_per_m3 *
+ (hm + filter_height + s) / 1000 +
+ cost_rates$profiling_eur_per_m2 +
+ cost_rates$filter_eur_per_m3 * filter_height / 1000 +
+ storage_rate * s / 1000
+ f / (hm + p * s)
+ }, numeric(1))
+ candidates[which.min(sc)]
+ }
+
+ if (discrete) {
+ levels_all <- sort(spec$levels)
+ levels_all <- levels_all[hm_upper(levels_all) >= height_bounds[1]]
+ if (length(levels_all) == 0) return(infeasible_row())
+ h_s <- choose_start_hs(levels_all)
+ } else {
+ gb <- spec$bounds
+ if (!is.null(max_total_depth)) {
+ gb[2] <- min(gb[2], max_total_depth - filter_height - height_bounds[1])
+ }
+ # gb[2] == gb[1] is a degenerate but valid axis (exactly one
+ # admissible storage height), only gb[2] < gb[1] is infeasible
+ if (gb[2] < gb[1]) return(infeasible_row())
+ gravel_tol <- if (is.null(spec$tol)) 25 else spec$tol
+ # linear-fractional in h_s -> the proxy optimum is at an endpoint
+ h_s <- choose_start_hs(c(gb[1], gb[2]))
+ }
+
+ a_star <- NA_real_
+ repeat {
+ h_m_up <- hm_upper(h_s)
+ eval_a <- function(a) eval_design(type, a, h_m_up, h_s)
+ bracket <- area_bracket_from_prior(prior_results, type, h_s, h_m_up,
+ x, area_bounds)
+ res_a <- search_area(eval_a, x, bracket)
+ mono_warn <- mono_warn || res_a$monotonicity_violation
+ if (!identical(res_a$status, "infeasible")) {
+ a_star <- res_a$value
+ break
+ }
+ # area stuck at the upper bound -> escalate the storage layer
+ eval_s <- function(h) eval_design(type, area_bounds[2], hm_upper(h), h)
+ if (discrete) {
+ rest <- levels_all[levels_all > h_s]
+ if (length(rest) == 0) return(infeasible_row())
+ res_s <- find_min_feasible(eval_s, x_max = x, levels = rest,
+ split_jitter = split_jitter)
+ } else {
+ if (h_s >= gb[2]) return(infeasible_row())
+ res_s <- find_min_feasible(eval_s, x_max = x,
+ lower = h_s, upper = gb[2],
+ tol = gravel_tol,
+ split_jitter = split_jitter)
+ }
+ mono_warn <- mono_warn || res_s$monotonicity_violation
+ if (identical(res_s$status, "infeasible")) return(infeasible_row())
+ h_s <- res_s$value
+ }
+
+ # shrink the cheap lever last: mulde_height at fixed (a*, h_s).
+ # A second area pass is provably redundant: a smaller mulde_height
+ # only weakens the hydraulics, so the minimal feasible area cannot
+ # decrease any further.
+ h_m_up <- hm_upper(h_s)
+ h_m_star <- h_m_up
+ if (h_m_up > height_bounds[1]) {
+ res_h <- find_min_feasible(
+ function(h) eval_design(type, a_star, h, h_s),
+ x_max = x, lower = height_bounds[1], upper = h_m_up,
+ tol = height_tol, split_jitter = split_jitter
+ )
+ mono_warn <- mono_warn || res_h$monotonicity_violation
+ if (!identical(res_h$status, "infeasible")) h_m_star <- res_h$value
+ }
+
+ final <- eval_design(type, a_star, h_m_star, h_s)
+ if (isTRUE(verbose)) {
+ message(sprintf(
+ "[%s | x = %d] area %s m2, height %s mm, storage %s mm (%d neue Laeufe)",
+ type, x, format(a_star), format(h_m_star), format(h_s),
+ runs_executed - runs_before
+ ))
+ }
+ tibble::tibble(
+ x = x, storage_type = type, status = "ok",
+ mulde_area = a_star, mulde_height = h_m_star, storage_height = h_s,
+ n_overflows = final$n_overflows,
+ overflow_volume_m3 = final$overflow_volume_m3,
+ et_pct = final$et_pct,
+ monotonicity_warning = mono_warn,
+ n_runs_new = runs_executed - runs_before
+ )
+ }
+
+ # --- sweep all cells (shared cache makes repeats cheap) ------------------
+ cells <- expand.grid(type = names(storage_spec),
+ x = sort(unique(as.integer(x_targets))),
+ stringsAsFactors = FALSE)
+ out <- dplyr::bind_rows(
+ lapply(seq_len(nrow(cells)),
+ function(i) solve_cell(cells$type[i], cells$x[i]))
+ )
+
+ out$filter_height <- filter_height
+ out <- compute_costs(out, cost_rates = cost_rates)
+ out <- dplyr::arrange(out, .data$storage_type, .data$x)
+
+ evaluations <- dplyr::bind_rows(
+ lapply(ls(cache), function(k) tibble::as_tibble(get(k, envir = cache)))
+ )
+ if (nrow(evaluations) > 0) {
+ # empty when every cell is analytically infeasible (no engine run)
+ evaluations <- dplyr::arrange(
+ evaluations, .data$storage_type, .data$mulde_area
+ )
+ }
+ attr(out, "evaluations") <- evaluations
+ attr(out, "n_runs_total") <- runs_executed
+ out
+}
diff --git a/R/optimise_swale_design_simultaneous.R b/R/optimise_swale_design_simultaneous.R
new file mode 100644
index 0000000..1bdf3dd
--- /dev/null
+++ b/R/optimise_swale_design_simultaneous.R
@@ -0,0 +1,720 @@
+#' Cheapest feasible prior design as warm start for the simultaneous search
+#'
+#' Picks the cheapest feasible grid cell of the matching branch from prior
+#' (brute-force) results in the workflow CSV schema. Returns a one-row
+#' data.frame with `mulde_area`, `mulde_height`, `storage_height`, or
+#' `NULL` if the prior does not contain a feasible cell for this branch.
+#'
+#' @keywords internal
+#' @noRd
+prior_start_design <- function(prior, type, x, filter_height, cost_rates) {
+ needed <- c("storage_type", "storage_height", "mulde_height", "mulde_area",
+ "n_overflows", "filter_hydraulicconductivity")
+ if (is.null(prior) || !all(needed %in% names(prior))) return(NULL)
+ kf_max <- suppressWarnings(
+ max(prior$filter_hydraulicconductivity, na.rm = TRUE)
+ )
+ keep <- !is.na(prior$storage_type) & prior$storage_type == type &
+ !is.na(prior$filter_hydraulicconductivity) &
+ prior$filter_hydraulicconductivity == kf_max &
+ !is.na(prior$n_overflows) & prior$n_overflows <= x
+ d <- prior[keep, , drop = FALSE]
+ if (nrow(d) == 0) return(NULL)
+ if (!"filter_height" %in% names(d)) d$filter_height <- filter_height
+ d <- compute_costs(d, cost_rates = cost_rates)
+ best_i <- which.min(d$cost_total) # integer(0) if all costs are NA
+ if (length(best_i) == 0) return(NULL)
+ out <- d[best_i, c("mulde_area", "mulde_height", "storage_height"),
+ drop = FALSE]
+ if (anyNA(out)) return(NULL)
+ out
+}
+
+#' Radical-inverse (van der Corput) sequence element
+#' @keywords internal
+#' @noRd
+halton_1d <- function(i, base) {
+ f <- 1
+ r <- 0
+ while (i > 0) {
+ f <- f / base
+ r <- r + f * (i %% base)
+ i <- i %/% base
+ }
+ r
+}
+
+#' i-th point of the 3-dimensional Halton sequence (bases 2, 3, 5)
+#' @keywords internal
+#' @noRd
+halton_point <- function(i) {
+ c(halton_1d(i, 2), halton_1d(i, 3), halton_1d(i, 5))
+}
+
+#' Minimal deterministic uniform generator (Park-Miller LCG)
+#'
+#' Self-contained pseudo-random stream for the differential-evolution
+#' method: fully reproducible from `seed` and independent of R's global
+#' RNG (`.Random.seed` is neither read nor written).
+#'
+#' @keywords internal
+#' @noRd
+make_lcg <- function(seed) {
+ state <- (abs(as.double(seed)) %% 2147483646) + 1
+ function() {
+ # 16807 * state < 2^53, exact in double arithmetic
+ state <<- (16807 * state) %% 2147483647
+ state / 2147483647
+ }
+}
+
+#' Find the cost-optimal swale design by simultaneous parameter search
+#'
+#' Alternative to the coordinate-descent optimiser
+#' ([optimise_swale_design()], bisection per parameter): all design
+#' parameters -- `mulde_area`, `mulde_height` and `storage_height` -- are
+#' optimised **simultaneously**. Infeasible designs (`n_overflows > x`)
+#' are not excluded but penalised (any infeasible design is worse than any
+#' feasible one; the number of excess events grades the penalty, steering
+#' the search back towards feasibility), so the search moves freely
+#' through the full parameter space and can trade the parameters against
+#' each other in a single step -- it does not rely on the per-parameter
+#' monotonicity that the bisection exploits.
+#'
+#' Three search `method`s share this penalised objective (plus cache,
+#' tolerance snapping and final lattice polish) and differ only in how
+#' they propose candidates:
+#' \itemize{
+#' \item `"nelder_mead"` (default): multistart Nelder-Mead simplex via
+#' `stats::optim()` -- the recommended method.
+#' \item `"diff_evolution"`: a compact differential evolution
+#' (DE/rand/1/bin, population 12, F = 0.7, CR = 0.9), included for
+#' comparison. Deterministic: it draws from an internal Park-Miller
+#' generator seeded with `seed` and leaves R's global RNG
+#' (`.Random.seed`) untouched.
+#' \item `"halton_search"`: quasi-random space-filling sampling
+#' (Halton sequence, bases 2/3/5) -- a deliberately simple baseline
+#' showing what the structured searches must beat.
+#' }
+#'
+#' Three ingredients keep the number of engine runs in check:
+#' \itemize{
+#' \item \strong{Snapping}: every candidate is snapped to the search
+#' tolerances (`area_tol`, `height_tol`, storage `tol` / discrete
+#' `levels`) before evaluation, so the shared cache absorbs repeated
+#' visits and the sweep over all `x_targets` reuses runs.
+#' \item \strong{Multistart}: `n_starts` deterministic starting points
+#' (prior warm start and the optimum of the previous overflow target
+#' first, then a *storage ladder* -- one anchor start per storage
+#' level, smallest level first -- then fixed space-filling points)
+#' guard against the simplex stalling on the plateaus that the
+#' snapping and the integer overflow count create, and make sure every
+#' storage level competes: along the feasibility boundary the cost
+#' valley is flat, so the cheapest (usually smallest) storage level is
+#' easily missed from a single start. Different starts take different
+#' search paths -- the counterpart of `split_jitter` in the bisection
+#' optimiser. Every start receives an equal slice of the remaining
+#' `max_evals` budget (unused runs roll over).
+#' \item \strong{Lattice polish}: an accelerated pattern descent
+#' (steps of 8/4/2/1 tolerances downwards, cheaper by construction)
+#' runs from the cheapest feasible design of every storage level
+#' visited -- capped at the 6 cheapest levels, which only bites for
+#' the continuous gravel trench (the discrete box has at most a
+#' handful) -- because the storage axis separates cost valleys that
+#' single coordinate steps cannot cross. Besides the per-axis down
+#' steps each round proposes a \emph{boundary slide} (area down with
+#' `mulde_height` at its maximum -- the two-coordinate trade towards
+#' the cheap end of the feasibility boundary) and a
+#' \emph{mulde_height floor probe} (at large `x` the overflow count
+#' saturates, so the whole lower height range can be feasible even
+#' when a +1 counting wobble blocks every single step). All are just
+#' evaluated candidates -- no monotonicity assumption enters. The
+#' result is locally optimal on the tolerance lattice, whatever the
+#' search method delivered.
+#' }
+#'
+#' The discrete infiltration-box levels are mapped onto a continuous
+#' latent axis (each level owns an equal share of `[0, 1]`), the gravel
+#' trench is searched continuously. The filter conductivity is expected to
+#' be fixed at the maximum via `fixed` (cost-free and dominant, see the
+#' monotonicity analysis,
+#' ).
+#' `max_total_depth` is enforced by
+#' construction (the `mulde_height` axis is compressed to the remaining
+#' depth), so no simulation runs are spent on depth-invalid designs.
+#'
+#' Compared to [optimise_swale_design()] this needs considerably more
+#' engine runs per cell (typically 60-120 instead of ~15; search phase
+#' plus multi-valley polish) but serves as an independent cross-check: it
+#' can discover cheaper corners of the design space that coordinate
+#' descent would miss if the parameter interaction were stronger than the
+#' monotonicity analysis suggests.
+#'
+#' @param run_fn `function(params)` running one scenario and returning at
+#' least `n_overflows` plus `sum_overflows` (mm) or `overflow_volume_m3`;
+#' typically created with [make_swale_runner()]. `params` is a named list
+#' of `mulde_area`, `mulde_height`, `storage_type`, `storage_height` plus
+#' everything in `fixed`.
+#' @param x_targets Integer vector of overflow targets (feasible :<=>
+#' `n_overflows <= x`), default `0:5`.
+#' @param area_bounds,area_tol Search range (m2) and resolution for
+#' `mulde_area`.
+#' @param height_bounds,height_tol Search range (mm) and resolution for
+#' `mulde_height`.
+#' @param storage_spec Storage search space per type, see
+#' [default_storage_spec()]: discrete `levels` (infiltration box) or
+#' continuous `bounds` + `tol` (gravel trench).
+#' @param fixed Named list of parameters passed unchanged to `run_fn`
+#' (connected area, filter geometry, kf at maximum, ...). Must contain
+#' `filter_height` for the cost model.
+#' @param prior_results Optional data.frame with prior (grid) results in
+#' the workflow CSV schema, used as warm start (the cheapest feasible
+#' grid cell of the branch becomes the first start / seeds the
+#' population).
+#' @param method Search method, see Details: `"nelder_mead"` (default),
+#' `"diff_evolution"` or `"halton_search"` (the latter two mainly for
+#' comparison).
+#' @param n_starts Number of Nelder-Mead starts per (storage type, x)
+#' cell (default 4; only used by `method = "nelder_mead"`). Warm starts
+#' (prior, previous target) count towards this number, then the
+#' storage-ladder anchors, then the space-filling points.
+#' @param seed Integer seed of the internal deterministic generator used
+#' by `method = "diff_evolution"` (ignored by the other methods). R's
+#' global RNG state is not touched.
+#' @param max_evals Soft cap on fresh engine runs per cell for the search
+#' phase: once reached, the search winds down (already cached designs
+#' remain free). The final multi-valley lattice polish adds its own
+#' runs on top (typically 20-50 per cell). Default 80 -- thanks to the
+#' shared cache the later `x_targets` of a storage type stay cheaper.
+#' @param wobble Maximum counting-artefact size tolerated at the upper
+#' corner (default 1, matching the +1 event-counting wobble): only if
+#' the maximal design overflows by more than `wobble` events is the
+#' cell declared infeasible without a search.
+#' @param max_total_depth Optional analytic depth constraint in mm:
+#' `mulde_height + filter_height + storage_height <= max_total_depth`
+#' (e.g. from DWA-A 138 groundwater clearance or cover requirements).
+#' Enforced without any simulation runs.
+#' @param cost_rates Unit costs, see [default_cost_rates()].
+#' @param verbose Print one progress line per solved cell.
+#'
+#' @return Tibble with one row per (storage type, x), same schema as
+#' [optimise_swale_design()] plus a `method` column: the optimal design
+#' (`mulde_area`, `mulde_height`, `storage_height`), its metrics
+#' (`n_overflows`, `overflow_volume_m3`, `et_pct`), cost columns from
+#' [compute_costs()], a `status` (`"ok"` or
+#' `"infeasible_within_bounds"`), `monotonicity_warning` (`TRUE` if a
+#' strictly larger design produced more overflows *and* more overflow
+#' volume among the cell's evaluations) and `n_runs_new` (fresh engine
+#' runs spent on this cell). All evaluated designs are attached as
+#' attribute `"evaluations"`.
+#'
+#' @examples
+#' # synthetic monotone model: overflows fall with retention capacity
+#' run <- function(params) {
+#' cap <- params$mulde_area *
+#' (params$mulde_height + 0.95 * params$storage_height)
+#' list(n_overflows = max(0, floor(3.6e5 / cap) - 3),
+#' sum_overflows = 800 * max(0, 3.6e5 / cap - 3))
+#' }
+#' opt <- optimise_swale_design_simultaneous(
+#' run, x_targets = 1,
+#' storage_spec = default_storage_spec()["infiltration_box"],
+#' verbose = FALSE
+#' )
+#' opt[, c("x", "mulde_area", "mulde_height", "storage_height", "cost_total")]
+#'
+#' @seealso [optimise_swale_design()] (coordinate descent / bisection),
+#' [make_swale_runner()], [default_storage_spec()]
+#' @export
+optimise_swale_design_simultaneous <- function(run_fn,
+ x_targets = 0:5,
+ area_bounds = c(25, 200),
+ area_tol = 2,
+ height_bounds = c(100, 300),
+ height_tol = 10,
+ storage_spec = default_storage_spec(),
+ fixed = list(
+ connected_area = 1000,
+ filter_height = 300,
+ filter_hydraulicconductivity = 360,
+ bottom_hydraulicconductivity = 12
+ ),
+ prior_results = NULL,
+ method = c("nelder_mead",
+ "diff_evolution",
+ "halton_search"),
+ n_starts = 4,
+ max_evals = 80,
+ seed = 1,
+ wobble = 1L,
+ max_total_depth = NULL,
+ cost_rates = default_cost_rates(),
+ verbose = TRUE) {
+
+ method <- match.arg(method)
+ stopifnot(is.function(run_fn), !is.null(fixed$filter_height),
+ n_starts >= 1, max_evals >= 10)
+ filter_height <- fixed$filter_height
+
+ # --- shared evaluation cache (one engine run per distinct design) -------
+ cache <- new.env(parent = emptyenv())
+ runs_executed <- 0L
+
+ cache_key <- function(type, area, h_m, h_s) {
+ paste(type, format(area, digits = 10), format(h_m, digits = 10),
+ format(h_s, digits = 10), sep = "|")
+ }
+
+ eval_design <- function(type, area, h_m, h_s) {
+ key <- cache_key(type, area, h_m, h_s)
+ hit <- cache[[key]]
+ if (!is.null(hit)) return(hit)
+ params <- c(list(mulde_area = area, mulde_height = h_m,
+ storage_type = type, storage_height = h_s), fixed)
+ res <- as.list(run_fn(params))
+ if (!"n_overflows" %in% names(res)) {
+ stop("optimise_swale_design_simultaneous(): ",
+ "run_fn() must return 'n_overflows'")
+ }
+ vol <- res[["overflow_volume_m3"]]
+ if (is.null(vol) && !is.null(res[["sum_overflows"]])) {
+ vol <- res[["sum_overflows"]] * area / 1000 # mm x m2 / 1000 = m3
+ }
+ et <- res[["element.WB_Evapotranspiration_"]]
+ out <- list(storage_type = type, mulde_area = area, mulde_height = h_m,
+ storage_height = h_s,
+ n_overflows = as.numeric(res$n_overflows),
+ overflow_volume_m3 = if (is.null(vol)) NA_real_ else as.numeric(vol),
+ et_pct = if (is.null(et)) NA_real_ else as.numeric(et))
+ runs_executed <<- runs_executed + 1L
+ assign(key, out, envir = cache)
+ out
+ }
+
+ cost_total_of <- function(type, area, h_m, h_s) {
+ compute_costs(
+ tibble::tibble(mulde_area = area, mulde_height = h_m,
+ filter_height = filter_height, storage_height = h_s,
+ storage_type = type),
+ cost_rates = cost_rates
+ )$cost_total
+ }
+
+ # --- analytic depth constraint ------------------------------------------
+ hm_upper <- function(h_s) {
+ up <- rep(height_bounds[2], length(h_s))
+ if (!is.null(max_total_depth)) {
+ up <- pmin(up, max_total_depth - filter_height - h_s)
+ }
+ up
+ }
+
+ snap_to <- function(v, origin, step) {
+ origin + round((v - origin) / step) * step
+ }
+
+ # fixed space-filling starts in the unit cube (area, height, storage);
+ # deterministic on purpose -- repeated calls give identical results
+ default_starts <- list(
+ c(0.70, 0.85, 0.25), c(0.35, 0.50, 0.65), c(0.15, 0.95, 0.85),
+ c(0.55, 0.25, 0.45), c(0.80, 0.35, 0.75), c(0.25, 0.70, 0.15)
+ )
+
+ # --- pairwise dominance check over the evaluations of one cell ----------
+ # violation :<=> a strictly larger design (all three parameters >=, at
+ # least one >) has MORE overflows AND MORE overflow volume -- the
+ # simultaneous analogue of the bisection's volume referee
+ dominance_violation <- function(evs) {
+ if (length(evs) < 2) return(FALSE)
+ m <- do.call(rbind, lapply(evs, function(e) {
+ c(e$area, e$h_m, e$h_s, e$n, e$vol)
+ }))
+ for (i in seq_len(nrow(m) - 1)) {
+ for (j in (i + 1):nrow(m)) {
+ if (any(is.na(m[i, 4:5])) || any(is.na(m[j, 4:5]))) next
+ d <- m[i, 1:3] - m[j, 1:3]
+ big <- if (all(d >= 0) && any(d > 0)) i
+ else if (all(d <= 0) && any(d < 0)) j
+ else next
+ small <- if (big == i) j else i
+ if (m[big, 4] > m[small, 4] && m[big, 5] > m[small, 5] + 1e-9) {
+ return(TRUE)
+ }
+ }
+ }
+ FALSE
+ }
+
+ # --- solve one (storage type, x) cell ------------------------------------
+ # returns list(row = tibble, best_u = unit-cube position of the optimum,
+ # used as warm start for the next overflow target of the same type)
+ solve_cell <- function(type, x, extra_start = NULL) {
+ runs_before <- runs_executed
+ spec <- storage_spec[[type]]
+ if (is.null(spec)) {
+ stop("optimise_swale_design_simultaneous(): ",
+ "storage_spec has no entry '", type, "'")
+ }
+ discrete <- !is.null(spec$levels)
+ mono_warn <- FALSE
+ cell_evals <- list()
+
+ infeasible_row <- function() list(
+ row = tibble::tibble(
+ x = x, storage_type = type, method = method,
+ status = "infeasible_within_bounds",
+ mulde_area = NA_real_, mulde_height = NA_real_,
+ storage_height = NA_real_, n_overflows = NA_real_,
+ overflow_volume_m3 = NA_real_, et_pct = NA_real_,
+ monotonicity_warning = mono_warn,
+ n_runs_new = runs_executed - runs_before
+ ),
+ best_u = NULL
+ )
+
+ if (discrete) {
+ levels_all <- sort(spec$levels)
+ levels_all <- levels_all[hm_upper(levels_all) >= height_bounds[1]]
+ if (length(levels_all) == 0) return(infeasible_row())
+ hs_max <- levels_all[length(levels_all)]
+ } else {
+ gb <- spec$bounds
+ if (!is.null(max_total_depth)) {
+ gb[2] <- min(gb[2], max_total_depth - filter_height - height_bounds[1])
+ }
+ # gb[2] == gb[1] is a degenerate but valid axis (exactly one
+ # admissible storage height), only gb[2] < gb[1] is infeasible
+ if (gb[2] < gb[1]) return(infeasible_row())
+ s_tol <- if (is.null(spec$tol)) 25 else spec$tol
+ hs_max <- gb[2]
+ }
+
+ # unit cube [0,1]^3 -> snapped physical design (depth-valid by
+ # construction: the mulde_height axis is compressed to hm_upper(h_s))
+ decode <- function(u) {
+ u <- pmin(1, pmax(0, u))
+ a <- snap_to(area_bounds[1] + u[1] * diff(area_bounds),
+ area_bounds[1], area_tol)
+ a <- min(max(a, area_bounds[1]), area_bounds[2])
+ h_s <- if (discrete) {
+ levels_all[min(length(levels_all),
+ 1L + as.integer(floor(u[3] * length(levels_all))))]
+ } else {
+ s <- snap_to(gb[1] + u[3] * (gb[2] - gb[1]), gb[1], s_tol)
+ min(max(s, gb[1]), gb[2])
+ }
+ up <- hm_upper(h_s)
+ h_m <- snap_to(height_bounds[1] + u[2] * (up - height_bounds[1]),
+ height_bounds[1], height_tol)
+ h_m <- min(max(h_m, height_bounds[1]), up)
+ list(area = a, h_m = h_m, h_s = h_s)
+ }
+
+ encode <- function(area, h_m, h_s) {
+ u3 <- if (discrete) {
+ i <- which.min(abs(levels_all - h_s))
+ (i - 0.5) / length(levels_all)
+ } else if (gb[2] > gb[1]) {
+ (h_s - gb[1]) / (gb[2] - gb[1])
+ } else {
+ 0 # degenerate axis: exactly one admissible storage height
+ }
+ up <- hm_upper(h_s)
+ u2 <- if (up > height_bounds[1]) {
+ (h_m - height_bounds[1]) / (up - height_bounds[1])
+ } else {
+ 0
+ }
+ u1 <- (area - area_bounds[1]) / diff(area_bounds)
+ pmin(1, pmax(0, c(u1, u2, u3)))
+ }
+
+ # any infeasible design must be worse than any feasible one
+ cost_cap <- cost_total_of(type, area_bounds[2], height_bounds[2], hs_max)
+ best <- NULL
+
+ consider <- function(area, h_m, h_s) {
+ ev <- eval_design(type, area, h_m, h_s)
+ cell_evals[[cache_key(type, area, h_m, h_s)]] <<- list(
+ area = area, h_m = h_m, h_s = h_s,
+ n = ev$n_overflows, vol = ev$overflow_volume_m3
+ )
+ cost <- cost_total_of(type, area, h_m, h_s)
+ feasible <- !is.na(ev$n_overflows) && ev$n_overflows <= x
+ if (feasible && (is.null(best) || cost < best$cost)) {
+ best <<- list(area = area, h_m = h_m, h_s = h_s, cost = cost)
+ }
+ list(ev = ev, cost = cost, feasible = feasible)
+ }
+
+ # fast path: if even the maximal design is infeasible beyond the
+ # counting wobble, the whole cell is (monotonicity) -- no search
+ top <- consider(area_bounds[2], hm_upper(hs_max), hs_max)
+ if (!top$feasible &&
+ (is.na(top$ev$n_overflows) || top$ev$n_overflows > x + wobble)) {
+ mono_warn <- dominance_violation(cell_evals)
+ return(infeasible_row())
+ }
+
+ start_cap <- max_evals
+ budget_hit <- function() runs_executed - runs_before >= start_cap
+
+ objective <- function(u) {
+ p <- decode(u)
+ if (budget_hit() &&
+ is.null(cache[[cache_key(type, p$area, p$h_m, p$h_s)]])) {
+ return(4 * cost_cap) # budget spent: only cached designs are free
+ }
+ r <- consider(p$area, p$h_m, p$h_s)
+ n <- r$ev$n_overflows
+ if (is.na(n)) return(4 * cost_cap)
+ if (n <= x) {
+ r$cost
+ } else {
+ cost_cap + r$cost + 0.05 * cost_cap * (n - x)
+ }
+ }
+
+ # --- starts: prior warm start / previous target first, then one
+ # anchor per storage level (min storage first -- the storage ladder
+ # guards the flat cost valley along the feasibility boundary), then
+ # fixed space-filling points --------------------------------------------
+ starts_all <- list()
+ ps <- prior_start_design(prior_results, type, x, filter_height,
+ cost_rates)
+ if (!is.null(ps)) {
+ starts_all <- c(starts_all, list(encode(ps$mulde_area, ps$mulde_height,
+ ps$storage_height)))
+ }
+ if (!is.null(extra_start)) starts_all <- c(starts_all, list(extra_start))
+ ladder_u3 <- if (discrete) {
+ (seq_along(levels_all) - 0.5) / length(levels_all)
+ } else {
+ c(0.02, 0.30, 0.60, 0.90)
+ }
+ ladder <- lapply(seq_along(ladder_u3), function(i) {
+ c(if (i %% 2 == 1) 0.85 else 0.45, 0.90, ladder_u3[[i]])
+ })
+ starts_all <- c(starts_all, ladder, default_starts)
+
+ if (method == "nelder_mead") {
+ # every start gets a slice of the remaining run budget, unused
+ # runs roll over to the following starts
+ starts <- starts_all[seq_len(min(length(starts_all), n_starts))]
+ for (si in seq_along(starts)) {
+ used <- runs_executed - runs_before
+ if (max_evals - used <= 2) break
+ start_cap <- used + ceiling((max_evals - used) /
+ (length(starts) - si + 1))
+ stats::optim(starts[[si]], objective, method = "Nelder-Mead",
+ control = list(maxit = 200, reltol = 1e-4,
+ warn.1d.NelderMead = FALSE))
+ }
+ } else if (method == "diff_evolution") {
+ # DE/rand/1/bin on the unit cube; deterministic via internal LCG
+ start_cap <- max_evals
+ rng <- make_lcg(seed)
+ n_pop <- 12
+ pop <- lapply(seq_len(n_pop), function(i) {
+ if (i <= length(starts_all)) starts_all[[i]] else halton_point(i)
+ })
+ fit <- vapply(pop, objective, numeric(1))
+ # i, r1, r2, r3 pairwise distinct, as DE/rand/1/bin requires
+ pick_distinct <- function(i) {
+ chosen <- integer(0)
+ while (length(chosen) < 3) {
+ r <- 1L + as.integer(floor(rng() * n_pop))
+ if (r != i && r <= n_pop && !(r %in% chosen)) {
+ chosen <- c(chosen, r)
+ }
+ }
+ chosen
+ }
+ gen <- 0
+ while (!budget_hit() && gen < 60) {
+ gen <- gen + 1
+ for (i in seq_len(n_pop)) {
+ if (budget_hit()) break
+ r <- pick_distinct(i)
+ mutant <- pop[[r[1]]] + 0.7 * (pop[[r[2]]] - pop[[r[3]]])
+ trial <- pop[[i]]
+ j_rand <- 1L + as.integer(floor(rng() * 3))
+ for (j in 1:3) {
+ if (j == j_rand || rng() < 0.9) trial[j] <- mutant[j]
+ }
+ trial <- pmin(1, pmax(0, trial))
+ f_trial <- objective(trial)
+ if (f_trial <= fit[i]) {
+ pop[[i]] <- trial
+ fit[i] <- f_trial
+ }
+ }
+ }
+ } else { # halton_search
+ # quasi-random space-filling baseline: warm starts first, then the
+ # Halton sequence until the run budget is spent
+ start_cap <- max_evals
+ for (u0 in starts_all) {
+ if (budget_hit()) break
+ objective(u0)
+ }
+ i <- 0
+ while (!budget_hit() && i < 50 * max_evals) {
+ i <- i + 1
+ objective(halton_point(i))
+ }
+ }
+
+ if (is.null(best)) {
+ mono_warn <- dominance_violation(cell_evals)
+ return(infeasible_row())
+ }
+
+ # --- lattice polish: accelerated pattern descent ---------------------
+ # (any reduction is cheaper by construction; step 8/4/2/1 tolerances
+ # downwards, halving the step whenever nothing improves -> locally
+ # optimal on the tolerance lattice, whatever the search delivered)
+ polish_from <- function(b0) {
+ cur <- b0
+ scale <- 8
+ rounds <- 0
+ while (scale >= 1 && rounds < 80) {
+ rounds <- rounds + 1
+ candidates <- list()
+ a_down <- max(area_bounds[1], cur$area - scale * area_tol)
+ if (a_down < cur$area - 1e-9) {
+ candidates <- c(candidates, list(
+ list(area = a_down, h_m = cur$h_m, h_s = cur$h_s)
+ ))
+ }
+ hm_down <- max(height_bounds[1], cur$h_m - scale * height_tol)
+ if (hm_down < cur$h_m - 1e-9) {
+ candidates <- c(candidates, list(
+ list(area = cur$area, h_m = hm_down, h_s = cur$h_s)
+ ))
+ }
+ h_s_down <- if (discrete) {
+ lower <- levels_all[levels_all < cur$h_s]
+ if (length(lower)) max(lower) else NA_real_
+ } else {
+ s_down <- max(gb[1], cur$h_s - scale * s_tol)
+ if (s_down < cur$h_s - 1e-9) s_down else NA_real_
+ }
+ if (!is.na(h_s_down)) {
+ candidates <- c(candidates, list(
+ list(area = cur$area, h_m = cur$h_m, h_s = h_s_down)
+ ))
+ }
+ # slide along the feasibility boundary: trade the expensive
+ # lever (area) down against the cheap one (mulde_height) at its
+ # maximum -- a two-coordinate move the axis steps cannot make
+ hm_up <- hm_upper(cur$h_s)
+ if (a_down < cur$area - 1e-9 && hm_up > cur$h_m + 1e-9) {
+ candidates <- c(candidates, list(
+ list(area = a_down, h_m = hm_up, h_s = cur$h_s)
+ ))
+ }
+ # floor probe: at large x the overflow count saturates, so the
+ # whole lower mulde_height range can be feasible even when a +1
+ # counting wobble blocks every single step below the current
+ # value (cached after the first evaluation)
+ if (cur$h_m > height_bounds[1] + 1e-9) {
+ candidates <- c(candidates, list(
+ list(area = cur$area, h_m = height_bounds[1], h_s = cur$h_s)
+ ))
+ }
+ improved <- FALSE
+ for (p in candidates) {
+ r <- consider(p$area, p$h_m, p$h_s)
+ if (r$feasible && r$cost < cur$cost - 1e-9) {
+ cur <- list(area = p$area, h_m = p$h_m, h_s = p$h_s,
+ cost = r$cost)
+ improved <- TRUE
+ }
+ }
+ if (!improved) scale <- scale / 2
+ }
+ }
+
+ # the storage axis separates cost valleys that single coordinate
+ # steps cannot cross (dropping the storage level breaks feasibility
+ # on the boundary) -> polish the cheapest feasible design of every
+ # storage level visited, not only the single global best
+ seeds <- list()
+ for (e in cell_evals) {
+ if (is.na(e$n) || e$n > x) next
+ key <- format(e$h_s, digits = 10)
+ cost <- cost_total_of(type, e$area, e$h_m, e$h_s)
+ if (is.null(seeds[[key]]) || cost < seeds[[key]]$cost) {
+ seeds[[key]] <- list(area = e$area, h_m = e$h_m, h_s = e$h_s,
+ cost = cost)
+ }
+ }
+ seeds <- seeds[order(vapply(seeds, function(s) s$cost, numeric(1)))]
+ for (s in seeds[seq_len(min(length(seeds), 6))]) polish_from(s)
+
+ mono_warn <- dominance_violation(cell_evals)
+ if (mono_warn) {
+ warning(sprintf(
+ paste0("optimise_swale_design_simultaneous(): a larger design ",
+ "produced more overflows AND more overflow volume ",
+ "(%s, x = %d) -- real non-monotonicity, result may be ",
+ "unreliable for this cell."),
+ type, x
+ ), call. = FALSE)
+ }
+
+ final <- eval_design(type, best$area, best$h_m, best$h_s)
+ if (isTRUE(verbose)) {
+ message(sprintf(
+ "[%s | x = %d | %s] area %s m2, height %s mm, storage %s mm (%d neue Laeufe)",
+ type, x, method, format(best$area), format(best$h_m),
+ format(best$h_s), runs_executed - runs_before
+ ))
+ }
+ list(
+ row = tibble::tibble(
+ x = x, storage_type = type, method = method, status = "ok",
+ mulde_area = best$area, mulde_height = best$h_m,
+ storage_height = best$h_s,
+ n_overflows = final$n_overflows,
+ overflow_volume_m3 = final$overflow_volume_m3,
+ et_pct = final$et_pct,
+ monotonicity_warning = mono_warn,
+ n_runs_new = runs_executed - runs_before
+ ),
+ best_u = encode(best$area, best$h_m, best$h_s)
+ )
+ }
+
+ # --- sweep: per storage type in ascending x (the optimum of x - 1 is
+ # feasible for x too and seeds the next search) --------------------------
+ xs <- sort(unique(as.integer(x_targets)))
+ rows <- list()
+ for (type in names(storage_spec)) {
+ last_u <- NULL
+ for (x in xs) {
+ solved <- solve_cell(type, x, extra_start = last_u)
+ rows[[length(rows) + 1L]] <- solved$row
+ if (!is.null(solved$best_u)) last_u <- solved$best_u
+ }
+ }
+ out <- dplyr::bind_rows(rows)
+
+ out$filter_height <- filter_height
+ out <- compute_costs(out, cost_rates = cost_rates)
+ out <- dplyr::arrange(out, .data$storage_type, .data$x)
+
+ evaluations <- dplyr::bind_rows(
+ lapply(ls(cache), function(k) tibble::as_tibble(get(k, envir = cache)))
+ )
+ if (nrow(evaluations) > 0) {
+ # empty when every cell is analytically infeasible (no engine run)
+ evaluations <- dplyr::arrange(
+ evaluations, .data$storage_type, .data$mulde_area
+ )
+ }
+ attr(out, "evaluations") <- evaluations
+ attr(out, "n_runs_total") <- runs_executed
+ out
+}
diff --git a/R/plot_cost_overflow_boxplot.R b/R/plot_cost_overflow_boxplot.R
new file mode 100644
index 0000000..99305b4
--- /dev/null
+++ b/R/plot_cost_overflow_boxplot.R
@@ -0,0 +1,542 @@
+#' Cost boxplot per overflow-event count, points sized by overflow volume
+#'
+#' Companion to [plot_cost_vs_overflow_volume()]. For every number of overflow
+#' events (x-axis) it draws a boxplot of the total construction cost (y-axis,
+#' EUR) across all scenarios with that count, overlaid with the individual
+#' scenarios as jittered points whose **size scales with `size_by`** --
+#' the overflow volume (`m3`, `sum_overflows` (`mm`) * `mulde_area` (`m2`) /
+#' 1000; the default) or the element evapotranspiration share (%). One best
+#' scenario per box is highlighted; `best_by` selects its objective -- cheapest,
+#' smallest overflow volume, or highest evapotranspiration (cost as
+#' tie-breaker) -- so the three variants trace three different frontier lines.
+#' `label_best` annotates the marker.
+#'
+#' Overflow counts greater than `x` are collapsed into a single `">x"`
+#' catch-all box (furthest right, coloured red), keeping the axis readable for
+#' the long-tailed 15-year runs (Wien / Bad Aussee reach several hundred
+#' overflow events). Its highlighted scenario is the one with the **fewest**
+#' overflow events above `x` (closest to the valid region). Set `x` high to
+#' resolve more counts individually, or to `max(n_overflows)` to give every
+#' count its own box.
+#'
+#' The point tooltip is **identical** to [plot_cost_vs_overflow_volume()]:
+#' scenario, overflow count / sum (`mm`) / volume (`m3`), the element water
+#' balance (evapotranspiration / infiltration / overflow, %), the cost breakdown
+#' (EUR)
+#' and the varying `param_grid` parameters translated via `param_labels`.
+#' Points and boxes are coloured with the same green (low counts) to red
+#' (`">x"`) palette as the sibling plots; because the colour merely echoes the
+#' x-axis it carries no separate legend. When both storage types share one
+#' panel, the overlaid points are additionally **shaped by the storage type**
+#' (filled square = infiltration box / Sickerbox, filled triangle = gravel
+#' trench / Schotterrigol), matching the scatter siblings, and a storage-type
+#' legend is shown next to the point-size legend. With `facet_storage_type =
+#' TRUE` the plot splits into two stacked storage-type panels instead; the
+#' facet strips then carry that information and the points stay **plain
+#' circles** for readability. `y_var = "cost_per_evap_pct"` switches the
+#' y-axis to the cost per percentage point of evapotranspiration (EUR/%).
+#'
+#' The point-size scale is calibrated to the valid region (`0..x`): the extreme
+#' overflow volumes of the `">x"` catch-all are capped and a minimum size keeps
+#' even zero-volume points (the `0`-overflow box) visible, so the many-overflow
+#' outliers no longer shrink every valid-region point to an invisible dot.
+#' When the storage-type shapes are in use (no faceting), its legend keys are
+#' drawn with the storage-type marker (grey; the single present shape, or the
+#' square when both types are shown) instead of the default circle; the
+#' faceted variant uses circular points and matching circular keys.
+#'
+#' @inheritParams plot_cost_vs_overflow_volume
+#' @param x Numeric threshold. Counts `0..x` each get their own box; counts
+#' `> x` collapse into a single `">x"` box.
+#' @param filter_n_gtx Logical. If `TRUE`, scenarios with `n_overflows > x`
+#' are dropped (removing the `">x"` box) before plotting.
+#' @param use_jitter Logical. If `TRUE`, points are horizontally jittered.
+#' @param jitter_width Numeric. Horizontal jitter half-width.
+#' @param jitter_seed Integer. Seed for reproducible jitter.
+#' @param max_point_size Numeric. Point size for the largest (valid-region)
+#' `size_by` value; the smallest maps to a fixed minimum so no point vanishes.
+#' @param box_alpha,point_alpha Numeric in `[0, 1]`. Box-fill / point opacity.
+#' @param lab_size Optional character override for the size-legend title.
+#' @param size_by Character. Which variable drives the point area (and its
+#' legend): `"overflow_volume"` (default, m3) or `"evapotranspiration"` (the
+#' element evapotranspiration share in %, from `element.WB_Evapotranspiration_`
+#' -- larger points then mean *more* evapotranspiration, which is desirable).
+#' @param best_by Character. Objective for the highlighted best scenario per
+#' box, with cost as the tie-breaker: `"min_cost"` (default; cheapest, ties
+#' broken by `scenario_name`), `"min_overflow"` (smallest overflow volume) or
+#' `"max_evapotranspiration"` (highest evapotranspiration). In the `">x"` box
+#' the fewest-overflow scenario is picked first, `best_by` then breaking ties.
+#' "Cost" always refers to the active `y_var`, so with
+#' `y_var = "cost_per_evap_pct"` the `"min_cost"` objective picks the
+#' scenario with the lowest cost per percentage point of evapotranspiration.
+#' @param y_var Character. Which cost measure the y-axis (boxes, points, best
+#' markers, frontier) shows: `"cost_total"` (default; total construction
+#' cost, EUR) or `"cost_per_evap_pct"` (total cost divided by the element
+#' evapotranspiration share **above the reference minimum**, EUR per
+#' percentage point -- the marginal cost efficiency of evapotranspiration;
+#' the baseline comes "for free"). The reference is the **lowest
+#' evapotranspiration among the scenarios that satisfy the validity
+#' criterion** (`n_overflows <= x`; fallback: the complete run when none
+#' does) and is named -- share, criterion and scenario id -- on a second
+#' title line. Scenarios at or below the reference (including the reference
+#' scenario itself) have no defined marginal cost and are dropped from the
+#' `"cost_per_evap_pct"` variant; `label_best = TRUE` additionally
+#' annotates the evapotranspiration gain (`"(+NN % Evapotranspiration)"`)
+#' after the price. Titles and the y-axis label switch accordingly.
+#' @param facet_storage_type Logical. If `TRUE`, the plot is split by
+#' `storage_type` into two stacked panels (infiltration box on top, gravel
+#' trench below, via `ggplot2::facet_grid()`), each with its own boxes,
+#' best-per-box markers and frontier line; the overlaid points then stay
+#' plain circles (the strips already name the type).
+#' `plotly::ggplotly()` keeps the panel split as stacked subplots.
+#' Default `FALSE`.
+#' @param label_best Logical. If `TRUE`, the best scenario per box is annotated
+#' next to it: overflow volume plus overflow share (`"NN m3 / NN %"`) for
+#' `min_overflow`, the evapotranspiration share (`"NN %"`) for
+#' `max_evapotranspiration`, or the active `y_var` value for `min_cost` --
+#' the total cost (`"NN EUR"`) by default, the cost per percentage point of
+#' evapotranspiration (`"NN EUR/%"`) with `y_var = "cost_per_evap_pct"`.
+#' Default `FALSE`.
+#' @param legend_position Character. Legend position, default `"right"`.
+#' @param mark_best Logical. If `TRUE` (default), the best scenario per box
+#' (see `best_by`) is highlighted with a black-outlined diamond filled in
+#' that box's group colour, so its plotly tooltip inherits the group colour.
+#' @param connect_best Logical. If `TRUE` (default), the highlighted best
+#' scenarios of **all** boxes (overflow counts `0..x` plus the `">x"`
+#' catch-all) are connected by a line -- the best-per-overflow-level frontier.
+#'
+#' @return A `ggplot` object. Convert to interactive via
+#' `plotly::ggplotly(p, tooltip = "text")`.
+#'
+#' @seealso [plot_cost_vs_overflow_volume()]
+#'
+#' @export
+#'
+#' @importFrom dplyr %>% filter mutate left_join case_when group_by arrange desc slice ungroup if_else
+#' @importFrom ggplot2 ggplot aes geom_boxplot geom_jitter geom_line geom_point geom_text position_jitter position_nudge scale_size scale_color_manual scale_fill_manual scale_shape_manual scale_x_discrete facet_grid vars guides guide_legend labs theme_bw theme element_text
+#' @importFrom grDevices colorRampPalette
+#' @importFrom utils modifyList
+#' @importFrom rlang .data
+plot_cost_overflow_boxplot <- function(simulation_results_optimisation,
+ param_grid,
+ x = 5,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ jitter_width = 0.2,
+ jitter_seed = 1L,
+ max_point_size = 6,
+ box_alpha = 0.35,
+ point_alpha = 0.6,
+ digits = 2L,
+ digits_params = 4L,
+ lang = c("de", "en"),
+ param_labels = NULL,
+ size_by = c("overflow_volume",
+ "evapotranspiration"),
+ best_by = c("min_cost",
+ "min_overflow",
+ "max_evapotranspiration"),
+ y_var = c("cost_total",
+ "cost_per_evap_pct"),
+ facet_storage_type = FALSE,
+ label_best = FALSE,
+ title = NULL,
+ lab_x = NULL,
+ lab_y = NULL,
+ caption = NULL,
+ lab_size = NULL,
+ mark_best = TRUE,
+ connect_best = TRUE,
+ legend_position = "right") {
+
+ lang <- match.arg(lang)
+ size_by <- match.arg(size_by)
+ best_by <- match.arg(best_by)
+ y_var <- match.arg(y_var)
+ if (is.null(param_labels)) param_labels <- default_param_labels(lang)
+
+ size_col <- if (size_by == "evapotranspiration") {
+ "element.WB_Evapotranspiration_"
+ } else {
+ "overflow_volume_m3"
+ }
+
+ txt <- switch(
+ lang,
+ de = list(
+ x = "Anzahl \u00dcberlaufereignisse",
+ y = "Gesamtkosten [\u20ac]",
+ title_cheapest = "Kosten je \u00dcberlaufanzahl \u2014 g\u00fcnstigste je Kategorie",
+ title_min_overflow = "Kosten je \u00dcberlaufanzahl \u2014 geringstes \u00dcberlaufvolumen je Kategorie",
+ title_max_evap = "Kosten je \u00dcberlaufanzahl \u2014 h\u00f6chste Evapotranspiration je Kategorie",
+ size_volume = "\u00dcberlaufvolumen [m\u00b3]",
+ size_evap = "Evapotranspiration [%]",
+ best_cheapest = "G\u00fcnstigste L\u00f6sung",
+ best_min_overflow = "Geringstes \u00dcberlaufvolumen",
+ best_max_evap = "H\u00f6chste Evapotranspiration"
+ ),
+ en = list(
+ x = "Number of overflow events",
+ y = "Total cost [\u20ac]",
+ title_cheapest = "Cost by overflow count \u2014 cheapest per class",
+ title_min_overflow = "Cost by overflow count \u2014 lowest overflow volume per class",
+ title_max_evap = "Cost by overflow count \u2014 highest evapotranspiration per class",
+ size_volume = "Overflow volume [m\u00b3]",
+ size_evap = "Evapotranspiration [%]",
+ best_cheapest = "Cheapest solution",
+ best_min_overflow = "Lowest overflow volume",
+ best_max_evap = "Highest evapotranspiration"
+ )
+ )
+ txt <- c(txt, cost_tooltip_labels(lang))
+
+ # Cost-efficiency variant: y = total cost per percentage point of element
+ # evapotranspiration [EUR/%] instead of the plain total cost. Only the
+ # y-dependent labels change; palette / boxes / tooltip stay identical.
+ y_col <- if (y_var == "cost_per_evap_pct") "cost_per_evap_pct" else "cost_total"
+ if (y_var == "cost_per_evap_pct") {
+ txt$y <- switch(lang,
+ de = "Kosten je Prozent Evapotranspiration \u00fcber Minimum [\u20ac/%]",
+ en = "Cost per percent evapotranspiration above minimum [\u20ac/%]")
+ evap_prefix <- switch(lang,
+ de = "Kosten je % Evapotranspiration",
+ en = "Cost per % evapotranspiration")
+ txt$title_cheapest <- paste0(evap_prefix, switch(lang,
+ de = " \u2014 g\u00fcnstigste je Kategorie",
+ en = " \u2014 cheapest per class"))
+ txt$title_min_overflow <- paste0(evap_prefix, switch(lang,
+ de = " \u2014 geringstes \u00dcberlaufvolumen je Kategorie",
+ en = " \u2014 lowest overflow volume per class"))
+ txt$title_max_evap <- paste0(evap_prefix, switch(lang,
+ de = " \u2014 h\u00f6chste Evapotranspiration je Kategorie",
+ en = " \u2014 highest evapotranspiration per class"))
+ }
+
+ def_title <- switch(best_by,
+ min_cost = txt$title_cheapest,
+ min_overflow = txt$title_min_overflow,
+ max_evapotranspiration = txt$title_max_evap)
+ def_size <- if (size_by == "evapotranspiration") txt$size_evap else txt$size_volume
+ best_lab <- switch(best_by,
+ min_cost = txt$best_cheapest,
+ min_overflow = txt$best_min_overflow,
+ max_evapotranspiration = txt$best_max_evap)
+
+ if (is.null(lab_x)) lab_x <- txt$x
+ if (is.null(lab_y)) lab_y <- txt$y
+ if (is.null(lab_size)) lab_size <- def_size
+
+ req_grid <- c("scenario_name")
+ req_res <- c(
+ "scenario_name", "n_overflows", "sum_overflows", "mulde_area",
+ "element.WB_Evapotranspiration_", "element.WB_InfiltrationNetto_",
+ "element.WB_Oberflaechenablauf_Ueberlauf_",
+ "cost_excavation", "cost_profiling", "cost_filter",
+ "cost_storage", "cost_total", "storage_type"
+ )
+
+ miss_grid <- setdiff(req_grid, names(param_grid))
+ miss_res <- setdiff(req_res, names(simulation_results_optimisation))
+
+ if (length(miss_grid) > 0) {
+ stop("param_grid is missing column(s): ", paste(miss_grid, collapse = ", "))
+ }
+ if (length(miss_res) > 0) {
+ stop("simulation_results_optimisation is missing column(s): ",
+ paste(miss_res, collapse = ", "))
+ }
+ if (!is.numeric(x) || length(x) != 1 || is.na(x) || x < 0) {
+ stop("x must be a single non-negative numeric value.")
+ }
+
+ x_int <- as.integer(round(x))
+ if (!isTRUE(all.equal(x, x_int))) {
+ warning("x is not an integer; using x_int = ", x_int,
+ " for discrete axis/palette.")
+ }
+
+ # Reference for the cost-per-percent-evapotranspiration measure: the
+ # minimum evapotranspiration among the scenarios that SATISFY the validity
+ # criterion (n_overflows <= x); computed before any filtering, falls back
+ # to the complete run when no scenario is valid. The matching scenario id
+ # is named in the title.
+ evap_all <- simulation_results_optimisation[["element.WB_Evapotranspiration_"]]
+ valid_mask <- !is.na(simulation_results_optimisation$n_overflows) &
+ simulation_results_optimisation$n_overflows <= x_int & !is.na(evap_all)
+ ref_idx <- if (any(valid_mask)) which(valid_mask) else seq_along(evap_all)
+ evap_min <- suppressWarnings(min(evap_all[ref_idx], na.rm = TRUE))
+ evap_min_scenario <- simulation_results_optimisation$scenario_name[
+ ref_idx[which.min(evap_all[ref_idx])]]
+
+ # Share of scenarios meeting the validity criterion (n_overflows <= x),
+ # appended to the auto-generated title (a plotly-safe place -- ggplotly
+ # drops ggplot subtitles).
+ valid_pct <- round(100 * mean(
+ simulation_results_optimisation$n_overflows <= x_int, na.rm = TRUE))
+ share_txt <- switch(lang,
+ de = paste0(valid_pct, " % mit <= ", x_int, " \u00dcberl\u00e4ufen"),
+ en = paste0(valid_pct, " % with <= ", x_int, " overflows"))
+ if (is.null(title)) {
+ title <- paste0(def_title, " (", share_txt, ")")
+ if (y_var == "cost_per_evap_pct") {
+ # name the reference of the marginal measure in the title
+ title <- paste0(title, "\n", switch(lang,
+ de = paste0("Referenz: minimale Evapotranspiration der g\u00fcltigen ",
+ "Szenarien (<= ", x_int, " \u00dcberl\u00e4ufe): ",
+ round(evap_min, 1), " % (Szenario ",
+ evap_min_scenario, ")"),
+ en = paste0("Reference: minimum evapotranspiration of the valid ",
+ "scenarios (<= ", x_int, " overflows): ",
+ round(evap_min, 1), " % (scenario ",
+ evap_min_scenario, ")")))
+ }
+ }
+ if (is.null(caption)) caption <- cost_rates_caption(lang)
+
+ param_tooltip <- build_varying_param_html(param_grid, lang, param_labels,
+ digits_params)
+
+ # Counts greater than x collapse into a single ">x" catch-all box, shown
+ # furthest right and coloured red. Its highlighted scenario is the one with
+ # the fewest overflow events (closest to the valid region); see the best
+ # selection below.
+ hi_lab <- paste0(">", x_int)
+ base_levels <- as.character(0:x_int)
+ levs <- c(base_levels, hi_lab)
+
+ df <- simulation_results_optimisation %>%
+ dplyr::left_join(param_tooltip, by = "scenario_name") %>%
+ dplyr::filter(!isTRUE(filter_n_gtx) |
+ is.na(.data$n_overflows) |
+ .data$n_overflows <= x_int) %>%
+ dplyr::mutate(
+ overflow_volume_m3 = .data$sum_overflows * .data$mulde_area / 1000,
+ overflow_cat = dplyr::case_when(
+ is.na(.data$n_overflows) ~ NA_character_,
+ .data$n_overflows > x_int ~ hi_lab,
+ TRUE ~ as.character(.data$n_overflows)
+ ),
+ overflow_cat = factor(.data$overflow_cat, levels = levs)
+ )
+
+ # Cost per percentage point of evapotranspiration ABOVE the run minimum
+ # [EUR/%]: the baseline evapotranspiration comes "for free", only the gain
+ # beyond the worst scenario is paid for. Scenarios at the minimum (incl.
+ # the reference scenario itself) have no defined marginal cost and are
+ # dropped from the cost_per_evap_pct variant (the active y column must not
+ # be NA).
+ df <- df %>%
+ dplyr::mutate(
+ cost_per_evap_pct = dplyr::if_else(
+ .data[["element.WB_Evapotranspiration_"]] - evap_min > 0,
+ .data$cost_total /
+ (.data[["element.WB_Evapotranspiration_"]] - evap_min),
+ NA_real_
+ )
+ ) %>%
+ dplyr::filter(!is.na(.data[[y_col]]))
+
+ # Storage type: display factor for the facet strips and the point shapes
+ # (filled square = infiltration box, filled triangle = gravel trench).
+ st <- storage_type_shapes(df$storage_type, lang)
+ df$storage_type_disp <- st$display
+
+ df$tooltip_html <- cost_tooltip_text(df, txt, digits, evap_min = evap_min)
+
+ # Point size: calibrate the scale to the valid region (0..x) and cap the
+ # extreme ">x" values, otherwise the many-overflow outliers (overflow
+ # volumes of several thousand m3) shrink every valid-region point to an
+ # invisible dot. pmin() caps; scale_size() below adds a minimum size so even
+ # zero-volume points (the 0-overflow box) stay visible.
+ valid_size <- df[[size_col]][!is.na(df$n_overflows) & df$n_overflows <= x_int]
+ size_cap <- suppressWarnings(max(valid_size[is.finite(valid_size)]))
+ if (!is.finite(size_cap) || size_cap <= 0) {
+ size_cap <- suppressWarnings(max(df[[size_col]], na.rm = TRUE))
+ }
+ if (!is.finite(size_cap) || size_cap <= 0) size_cap <- 1
+ df$size_plot <- pmin(df[[size_col]], size_cap)
+
+ # Best scenario per box. n_overflows is the first sort key, so the ">x"
+ # catch-all box highlights the scenario with the fewest overflow events
+ # (closest to the valid region); the objective (best_by) then breaks ties,
+ # with cost as the final tie-breaker:
+ # min_cost -> cheapest
+ # min_overflow -> smallest overflow volume
+ # max_evapotranspiration -> highest evapotranspiration
+ # For the single-count boxes 0..x, n_overflows is constant, so only the
+ # objective matters there. The frontier line runs through the best of every
+ # box, so the three objectives yield three different lines.
+ best_grp <- df %>%
+ dplyr::filter(!is.na(.data$overflow_cat), !is.na(.data[[y_col]]))
+ # With storage-type facets every panel gets its own best-per-box marker and
+ # frontier line, so the two technologies stay comparable.
+ best_grp <- if (isTRUE(facet_storage_type)) {
+ best_grp %>% dplyr::group_by(.data$storage_type_disp, .data$overflow_cat)
+ } else {
+ best_grp %>% dplyr::group_by(.data$overflow_cat)
+ }
+ best <- switch(best_by,
+ max_evapotranspiration = best_grp %>%
+ dplyr::arrange(.data$n_overflows,
+ dplyr::desc(.data[["element.WB_Evapotranspiration_"]]),
+ .data[[y_col]], .data$scenario_name, .by_group = TRUE),
+ min_overflow = best_grp %>%
+ dplyr::arrange(.data$n_overflows, .data$overflow_volume_m3,
+ .data[[y_col]], .data$scenario_name, .by_group = TRUE),
+ min_cost = best_grp %>%
+ dplyr::arrange(.data$n_overflows, .data[[y_col]],
+ .data$scenario_name, .by_group = TRUE)
+ )
+ best <- best %>% dplyr::slice(1L) %>% dplyr::ungroup()
+ best$tooltip_best <- paste0("", best_lab, "
", best$tooltip_html)
+ if (isTRUE(label_best)) {
+ best$label_text <- switch(best_by,
+ min_overflow = paste0(
+ format(round(best$overflow_volume_m3, 1), trim = TRUE), " m\u00b3 / ",
+ format(round(best[["element.WB_Oberflaechenablauf_Ueberlauf_"]], 1),
+ trim = TRUE), " %"),
+ max_evapotranspiration = paste0(
+ format(round(best[["element.WB_Evapotranspiration_"]], 1),
+ trim = TRUE), " %"),
+ min_cost = paste0(
+ format(round(best[[y_col]], 0), big.mark = " ", trim = TRUE),
+ if (y_var == "cost_per_evap_pct") {
+ # ... and the evapotranspiration gain over the reference minimum
+ # that this price buys
+ paste0(" \u20ac/% (+",
+ format(round(best[["element.WB_Evapotranspiration_"]] -
+ evap_min, 1), trim = TRUE),
+ " % ", switch(lang, de = "Evapotranspiration",
+ en = "evapotranspiration"), ")")
+ } else {
+ " \u20ac"
+ })
+ )
+ }
+
+ if (x_int == 0L) {
+ pal <- stats::setNames(c("orange", "red"), c("0", hi_lab))
+ } else if (x_int == 1L) {
+ pal <- stats::setNames(c("darkgreen", "orange", "red"),
+ c("0", "1", hi_lab))
+ } else {
+ pal_green <- grDevices::colorRampPalette(c("darkgreen", "yellowgreen"))(x_int)
+ pal <- stats::setNames(c(pal_green, "orange", "red"),
+ c(base_levels, hi_lab))
+ }
+
+ pos <- if (isTRUE(use_jitter)) {
+ ggplot2::position_jitter(width = jitter_width, height = 0,
+ seed = jitter_seed)
+ } else {
+ "identity"
+ }
+
+ # Storage-type shapes only when both types share one panel: in the faceted
+ # layout the strips already name the type, so the points stay plain circles
+ # (better readable with the size scaling).
+ use_shapes <- !isTRUE(facet_storage_type)
+ jitter_mapping <- ggplot2::aes(size = .data$size_plot,
+ colour = .data$overflow_cat,
+ text = .data$tooltip_html)
+ if (use_shapes) {
+ jitter_mapping <- utils::modifyList(
+ jitter_mapping,
+ ggplot2::aes(shape = .data$storage_type_disp)
+ )
+ }
+ # With shapes in use, the size-legend keys would default to circles, which
+ # then never occur in the plot; draw them with the storage-type marker
+ # instead (neutral grey) -- the single present shape, or the square when
+ # both types are shown.
+ present_types <- unique(as.character(df$storage_type_disp))
+ size_key_shape <- if (length(present_types) == 1L) {
+ unname(st$shape_values[present_types])
+ } else {
+ 15
+ }
+
+ p <- ggplot2::ggplot(df, ggplot2::aes(x = .data$overflow_cat,
+ y = .data[[y_col]])) +
+ ggplot2::geom_boxplot(
+ ggplot2::aes(fill = .data$overflow_cat),
+ alpha = box_alpha, outlier.shape = NA, colour = "grey40"
+ ) +
+ ggplot2::geom_jitter(
+ jitter_mapping,
+ position = pos, alpha = point_alpha
+ ) +
+ ggplot2::scale_size(range = c(1.5, max_point_size), name = lab_size) +
+ ggplot2::scale_fill_manual(values = pal, limits = levs, drop = FALSE,
+ guide = "none") +
+ ggplot2::scale_color_manual(values = pal, limits = levs, drop = FALSE,
+ guide = "none") +
+ ggplot2::scale_x_discrete(drop = FALSE) +
+ ggplot2::labs(title = title, x = lab_x, y = lab_y,
+ caption = if (nzchar(caption)) caption else NULL) +
+ ggplot2::theme_bw() +
+ ggplot2::theme(
+ legend.position = legend_position,
+ plot.title = ggplot2::element_text(size = 11)
+ )
+
+ # Square = infiltration box, triangle = gravel trench -- only when both
+ # types share one panel. The size-legend keys are then drawn with the same
+ # marker, so no circle appears in the legend that is absent from the plot.
+ if (use_shapes) {
+ p <- p +
+ ggplot2::scale_shape_manual(
+ values = st$shape_values, drop = FALSE,
+ name = txt$tt_storage_type
+ ) +
+ ggplot2::guides(
+ size = ggplot2::guide_legend(
+ override.aes = list(shape = size_key_shape, colour = "grey30",
+ alpha = 1)
+ )
+ )
+ }
+
+ # Two stacked panels (infiltration box on top, gravel trench below).
+ # plotly::ggplotly() converts the facets to stacked subplots, so the
+ # interactive HTML keeps the panel split.
+ if (isTRUE(facet_storage_type)) {
+ p <- p + ggplot2::facet_grid(
+ rows = ggplot2::vars(.data$storage_type_disp)
+ )
+ }
+
+ # Frontier line across the best of every box (all classes; per panel when
+ # faceting -- facet_grid subsets `best` by storage type), then the
+ # group-coloured best-marker on top of everything.
+ if (isTRUE(connect_best) && nrow(best) > 1L) {
+ p <- p + ggplot2::geom_line(
+ data = best,
+ ggplot2::aes(x = .data$overflow_cat, y = .data[[y_col]], group = 1L),
+ colour = "black", linewidth = 0.7, na.rm = TRUE
+ )
+ }
+ if (isTRUE(mark_best) && nrow(best) > 0L) {
+ p <- p + ggplot2::geom_point(
+ data = best,
+ ggplot2::aes(x = .data$overflow_cat, y = .data[[y_col]],
+ fill = .data$overflow_cat,
+ text = .data$tooltip_best),
+ shape = 23, size = 3.2, colour = "black", stroke = 1.2, na.rm = TRUE
+ )
+ }
+ if (isTRUE(label_best) && "label_text" %in% names(best) && nrow(best) > 0L) {
+ # place the label just above the marker (centred), so long labels such as
+ # "3515 m3 / 35 %" never run off the right edge of the last box.
+ lab_nudge_y <- 0.045 * diff(range(df[[y_col]], na.rm = TRUE))
+ p <- p + ggplot2::geom_text(
+ data = best,
+ ggplot2::aes(x = .data$overflow_cat, y = .data[[y_col]],
+ label = .data$label_text),
+ position = ggplot2::position_nudge(y = lab_nudge_y),
+ hjust = 0.5, vjust = 0, size = 2.8, colour = "black", na.rm = TRUE
+ )
+ }
+
+ p
+}
diff --git a/R/plot_cost_vs_evaporation.R b/R/plot_cost_vs_evaporation.R
new file mode 100644
index 0000000..3e70d9a
--- /dev/null
+++ b/R/plot_cost_vs_evaporation.R
@@ -0,0 +1,253 @@
+#' Cost vs. evapotranspiration scatter with storage-type shapes
+#'
+#' Second companion to \code{\link{plot_cost_vs_overflow_volume}} for
+#' cost-aware optimisation. Plots the per-scenario **total construction cost**
+#' (EUR) on the x-axis against the element **evapotranspiration share** (% of
+#' the total water input, from `element.WB_Evapotranspiration_`) on the
+#' y-axis. Points are coloured discretely by the **number** of overflow events
+#' (same 0..x / >x palette used by the sibling plots, legend at the top) and
+#' **shaped by the storage type**: filled square = infiltration box
+#' (Sickerbox), filled triangle = gravel trench (Schotterrigol).
+#'
+#' The tooltip is identical to [plot_cost_vs_overflow_volume()]: scenario,
+#' overflow count / sum (mm) / volume (m3), the element water balance
+#' (`element.WB_Evapotranspiration_`, `element.WB_InfiltrationNetto_`,
+#' `element.WB_Oberflaechenablauf_Ueberlauf_`, all as % of the total water
+#' input), the storage type, the usable storage volume of the storage layer
+#' (m3), the cost breakdown (`cost_excavation`,
+#' `cost_profiling`, `cost_filter`, `cost_storage`, `cost_total`), the derived
+#' **cost per percentage point of evapotranspiration** (EUR/%) plus the
+#' varying parameters from `param_grid` (excluding `scenario_name`).
+#'
+#' The plot language can be switched via `lang = "de"` or `lang = "en"`.
+#' Titles / axis labels / legend / tooltip labels follow the choice unless
+#' explicit overrides are supplied.
+#'
+#' @inheritParams plot_cost_vs_overflow_volume
+#'
+#' @return A `ggplot` object. Convert to interactive via
+#' `plotly::ggplotly(p, tooltip = "text")`.
+#'
+#' @seealso [plot_cost_vs_overflow_volume()] for cost vs. overflow volume and
+#' [plot_cost_overflow_boxplot()] for the boxplot views (including
+#' `y_var = "cost_per_evap_pct"`, the cost per percentage point of
+#' evapotranspiration).
+#'
+#' @export
+#'
+#' @importFrom dplyr %>% filter mutate left_join case_when
+#' @importFrom ggplot2 ggplot aes geom_point scale_color_manual scale_shape_manual labs theme_bw position_jitter theme guides guide_legend
+#' @importFrom grDevices colorRampPalette
+#' @importFrom rlang .data
+plot_cost_vs_evaporation <- function(simulation_results_optimisation,
+ param_grid,
+ x = 1,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ jitter_width = 0.15,
+ jitter_height = 0.15,
+ jitter_seed = 1L,
+ digits = 2L,
+ digits_params = 4L,
+ lang = c("de", "en"),
+ param_labels = NULL,
+ title = NULL,
+ lab_x = NULL,
+ lab_y = NULL,
+ caption = NULL,
+ legend_position = "top") {
+
+ lang <- match.arg(lang)
+ if (is.null(param_labels)) param_labels <- default_param_labels(lang)
+
+ txt <- switch(
+ lang,
+ de = list(
+ title = "Kosten vs. Evapotranspiration",
+ x = "Gesamtkosten [\u20ac]",
+ y = "Evapotranspiration [%]",
+ legend = "Anzahl \u00dcberlaufereignisse"
+ ),
+ en = list(
+ title = "Cost vs. evapotranspiration",
+ x = "Total cost [\u20ac]",
+ y = "Evapotranspiration [%]",
+ legend = "Number of overflow events"
+ )
+ )
+ txt <- c(txt, cost_tooltip_labels(lang))
+
+ if (is.null(lab_x)) lab_x <- txt$x
+ if (is.null(lab_y)) lab_y <- txt$y
+
+ req_grid <- c("scenario_name")
+ req_res <- c(
+ "scenario_name", "n_overflows", "sum_overflows", "mulde_area",
+ "element.WB_Evapotranspiration_", "element.WB_InfiltrationNetto_",
+ "element.WB_Oberflaechenablauf_Ueberlauf_",
+ "cost_excavation", "cost_profiling", "cost_filter",
+ "cost_storage", "cost_total", "storage_type"
+ )
+
+ miss_grid <- setdiff(req_grid, names(param_grid))
+ miss_res <- setdiff(req_res, names(simulation_results_optimisation))
+
+ if (length(miss_grid) > 0) {
+ stop("param_grid is missing column(s): ", paste(miss_grid, collapse = ", "))
+ }
+ if (length(miss_res) > 0) {
+ stop(
+ "simulation_results_optimisation is missing column(s): ",
+ paste(miss_res, collapse = ", ")
+ )
+ }
+ if (!is.numeric(x) || length(x) != 1 || is.na(x) || x < 0) {
+ stop("x must be a single non-negative numeric value.")
+ }
+
+ x_int <- as.integer(round(x))
+ if (!isTRUE(all.equal(x, x_int))) {
+ warning("x is not an integer; using x_int = ", x_int,
+ " for discrete palette/legend.")
+ }
+
+ # Append the share of scenarios meeting the validity criterion
+ # (n_overflows <= x) to the auto title (ggplotly drops ggplot subtitles).
+ valid_pct <- round(100 * mean(
+ simulation_results_optimisation$n_overflows <= x_int, na.rm = TRUE))
+ share_txt <- switch(lang,
+ de = paste0(valid_pct, " % mit <= ", x_int, " \u00dcberl\u00e4ufen"),
+ en = paste0(valid_pct, " % with <= ", x_int, " overflows"))
+ if (is.null(title)) title <- paste0(txt$title, " (", share_txt, ")")
+ if (is.null(caption)) caption <- cost_rates_caption(lang)
+
+ param_tooltip <- build_varying_param_html(param_grid, lang, param_labels,
+ digits_params)
+
+ df <- simulation_results_optimisation %>%
+ dplyr::left_join(param_tooltip, by = "scenario_name") %>%
+ dplyr::filter(!isTRUE(filter_n_gtx) |
+ is.na(.data$n_overflows) |
+ .data$n_overflows <= x_int) %>%
+ dplyr::mutate(
+ overflow_volume_m3 = .data$sum_overflows * .data$mulde_area / 1000
+ )
+
+ hi_lab <- paste0(">", x_int)
+ df <- df %>%
+ dplyr::mutate(
+ overflow_cat = dplyr::case_when(
+ is.na(.data$n_overflows) ~ NA_character_,
+ .data$n_overflows > x_int ~ hi_lab,
+ TRUE ~ as.character(.data$n_overflows)
+ )
+ )
+
+ base_levels <- as.character(0:x_int)
+ levs <- c(base_levels, hi_lab)
+
+ df <- df %>%
+ dplyr::mutate(
+ overflow_cat = factor(.data$overflow_cat, levels = levs)
+ )
+
+ # Storage type drives the marker shape (square = infiltration box,
+ # triangle = gravel trench); shared with the sibling cost plots.
+ st <- storage_type_shapes(df$storage_type, lang)
+ df$storage_type_disp <- st$display
+
+ # Reference for the tooltip's cost-per-percent-evapotranspiration line:
+ # minimum evapotranspiration among the scenarios that satisfy the validity
+ # criterion (n_overflows <= x); computed before any filtering, falls back
+ # to the complete run when no scenario is valid.
+ evap_all <- simulation_results_optimisation[["element.WB_Evapotranspiration_"]]
+ valid_mask <- !is.na(simulation_results_optimisation$n_overflows) &
+ simulation_results_optimisation$n_overflows <= x_int & !is.na(evap_all)
+ evap_min <- suppressWarnings(min(
+ if (any(valid_mask)) evap_all[valid_mask] else evap_all, na.rm = TRUE))
+ df$tooltip_html <- cost_tooltip_text(df, txt, digits, evap_min = evap_min)
+
+ if (x_int == 0L) {
+ pal <- c("0" = "orange", ">0" = "red")
+ } else if (x_int == 1L) {
+ pal <- c("0" = "darkgreen", "1" = "orange", ">1" = "red")
+ } else {
+ pal_green <- grDevices::colorRampPalette(c("darkgreen", "yellowgreen"))(x_int)
+ pal_vals <- c(pal_green, "orange", "red")
+ pal_names <- c(base_levels, hi_lab)
+ pal <- stats::setNames(pal_vals, pal_names)
+ }
+
+ legend_breaks <- levs
+
+ pos <- if (isTRUE(use_jitter)) {
+ ggplot2::position_jitter(
+ width = jitter_width,
+ height = jitter_height,
+ seed = jitter_seed
+ )
+ } else {
+ "identity"
+ }
+
+ legend_direction <- if (legend_position %in% c("top", "bottom")) {
+ "horizontal"
+ } else {
+ "vertical"
+ }
+
+ legend_nrow <- if (legend_direction == "horizontal") 1 else NULL
+ legend_ncol <- if (legend_direction == "vertical") 1 else NULL
+
+ p <- ggplot2::ggplot(df, ggplot2::aes(
+ x = .data$cost_total,
+ y = .data[["element.WB_Evapotranspiration_"]],
+ color = .data$overflow_cat,
+ shape = .data$storage_type_disp,
+ text = .data$tooltip_html
+ )) +
+ ggplot2::geom_point(alpha = 0.7, position = pos) +
+ ggplot2::scale_color_manual(
+ values = pal,
+ breaks = legend_breaks,
+ limits = levs,
+ drop = FALSE,
+ name = txt$legend
+ ) +
+ ggplot2::scale_shape_manual(
+ values = st$shape_values,
+ drop = FALSE,
+ name = txt$tt_storage_type
+ ) +
+ ggplot2::guides(
+ colour = ggplot2::guide_legend(
+ direction = legend_direction,
+ nrow = legend_nrow,
+ ncol = legend_ncol,
+ byrow = TRUE,
+ order = 1
+ ),
+ shape = ggplot2::guide_legend(
+ direction = legend_direction,
+ nrow = legend_nrow,
+ ncol = legend_ncol,
+ byrow = TRUE,
+ order = 2
+ )
+ ) +
+ ggplot2::labs(
+ title = title,
+ x = lab_x,
+ y = lab_y,
+ caption = if (nzchar(caption)) caption else NULL
+ ) +
+ ggplot2::theme_bw() +
+ ggplot2::theme(
+ legend.position = legend_position,
+ legend.direction = legend_direction,
+ # stack the colour and shape legends so both fit at the top
+ legend.box = if (legend_direction == "horizontal") "vertical" else "horizontal"
+ )
+
+ p
+}
diff --git a/R/plot_cost_vs_overflow_volume.R b/R/plot_cost_vs_overflow_volume.R
new file mode 100644
index 0000000..97dd2c2
--- /dev/null
+++ b/R/plot_cost_vs_overflow_volume.R
@@ -0,0 +1,287 @@
+#' Cost vs. overflow-volume scatter with n_overflows-coloured points
+#'
+#' Companion to \code{\link{plot_wb_tradeoff_overflows}} for cost-aware
+#' optimisation. Plots the per-scenario **total construction cost** (EUR) on
+#' the x-axis against the **overflow volume** (m3) on the y-axis, with the
+#' points coloured discretely by the **number** of overflow events (same
+#' 0..x / >x palette used by `plot_wb_tradeoff_overflows`, legend at the top)
+#' and **shaped by the storage type**: filled square = infiltration box
+#' (Sickerbox), filled triangle = gravel trench (Schotterrigol).
+#'
+#' Overflow volume is computed from `sum_overflows` (in mm on the swale
+#' surface, as returned by [`add_overflow_events_and_waterbalance()`])
+#' multiplied by `mulde_area` (m2) and converted to m3:
+#' `overflow_volume_m3 = sum_overflows * mulde_area / 1000`.
+#'
+#' The tooltip carries the element water balance
+#' (`element.WB_Evapotranspiration_`, `element.WB_InfiltrationNetto_`,
+#' `element.WB_Oberflaechenablauf_Ueberlauf_`, all as % of the total water
+#' input) and the cost breakdown (`cost_excavation`, `cost_profiling`,
+#' `cost_filter`, `cost_storage`, `cost_total`), the derived **cost per
+#' percentage point of evapotranspiration** (EUR/%), the **usable storage
+#' volume** of the storage layer (m3; area x height x usable porosity
+#' `thetaS - thetaFC`, from a `storage_volume_m3` column or derived from the
+#' `storage_theta*` columns) plus the varying parameters from `param_grid`
+#' (excluding `scenario_name`), so the user can hover over a scatter point
+#' and see exactly why it landed where it did.
+#'
+#' The plot language can be switched via `lang = "de"` or `lang = "en"`.
+#' Titles / axis labels / legend / tooltip labels follow the choice unless
+#' explicit overrides are supplied.
+#'
+#' @param simulation_results_optimisation Data frame with the columns
+#' `scenario_name`, `n_overflows`, `sum_overflows`, `mulde_area`,
+#' `element.WB_Evapotranspiration_`, `element.WB_InfiltrationNetto_`,
+#' `element.WB_Oberflaechenablauf_Ueberlauf_`, `cost_excavation`,
+#' `cost_profiling`, `cost_filter`, `cost_storage`, `cost_total`,
+#' `storage_type`. Typically the joined output of
+#' [`add_overflow_events_and_waterbalance()`] and [`compute_costs()`].
+#' @param param_grid Data frame with parameter grid. Must contain
+#' `scenario_name`.
+#' @param x Numeric threshold for the overflow-count colour bucket. Values
+#' greater than `x` are pushed into the red `">x"` category.
+#' @param filter_n_gtx Logical. If `TRUE`, scenarios with `n_overflows > x`
+#' are dropped before plotting.
+#' @param use_jitter,jitter_width,jitter_height,jitter_seed As in
+#' [`plot_wb_tradeoff_overflows()`].
+#' @param digits Integer. Rounding for numeric values in the tooltip.
+#' @param digits_params Integer. Rounding for parameter values in the
+#' tooltip.
+#' @param lang Character. Plot language: `"de"` or `"en"`.
+#' @param param_labels Named character vector translating `param_grid` columns
+#' to tooltip labels, or `NULL` to use [default_param_labels()] for `lang`.
+#' @param title,lab_x,lab_y Optional character overrides for the default
+#' language-specific title / axis labels.
+#' @param caption Character or `NULL`. Caption below the plot naming the
+#' unit-cost rates the EUR values were computed with. `NULL` (default)
+#' uses [cost_rates_caption()] with the [default_cost_rates()]; pass your
+#' own string if the costs were computed with different rates, or `""` to
+#' drop the caption. Note that `plotly::ggplotly()` drops ggplot captions
+#' -- re-add it to the interactive version via [plotly_add_caption()].
+#' @param legend_position Character. Legend position, default `"top"`.
+#'
+#' @return A `ggplot` object. Convert to interactive via
+#' `plotly::ggplotly(p, tooltip = "text")`.
+#'
+#' @seealso [plot_cost_overflow_boxplot()] for the same data / tooltip shown as
+#' a cost-by-overflow-count boxplot and [plot_cost_vs_evaporation()] for
+#' cost vs. the element evapotranspiration share.
+#'
+#' @export
+#'
+#' @importFrom dplyr %>% filter mutate left_join case_when
+#' @importFrom ggplot2 ggplot aes geom_point scale_color_manual scale_shape_manual labs theme_bw position_jitter theme guides guide_legend
+#' @importFrom grDevices colorRampPalette
+#' @importFrom rlang .data
+plot_cost_vs_overflow_volume <- function(simulation_results_optimisation,
+ param_grid,
+ x = 1,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ jitter_width = 0.15,
+ jitter_height = 0.15,
+ jitter_seed = 1L,
+ digits = 2L,
+ digits_params = 4L,
+ lang = c("de", "en"),
+ param_labels = NULL,
+ title = NULL,
+ lab_x = NULL,
+ lab_y = NULL,
+ caption = NULL,
+ legend_position = "top") {
+
+ lang <- match.arg(lang)
+ if (is.null(param_labels)) param_labels <- default_param_labels(lang)
+
+ txt <- switch(
+ lang,
+ de = list(
+ title = "Kosten vs. \u00dcberlaufvolumen",
+ x = "Gesamtkosten [\u20ac]",
+ y = "\u00dcberlaufvolumen [m\u00b3]",
+ legend = "Anzahl \u00dcberlaufereignisse"
+ ),
+ en = list(
+ title = "Cost vs. overflow volume",
+ x = "Total cost [\u20ac]",
+ y = "Overflow volume [m\u00b3]",
+ legend = "Number of overflow events"
+ )
+ )
+ txt <- c(txt, cost_tooltip_labels(lang))
+
+ if (is.null(lab_x)) lab_x <- txt$x
+ if (is.null(lab_y)) lab_y <- txt$y
+
+ req_grid <- c("scenario_name")
+ req_res <- c(
+ "scenario_name", "n_overflows", "sum_overflows", "mulde_area",
+ "element.WB_Evapotranspiration_", "element.WB_InfiltrationNetto_",
+ "element.WB_Oberflaechenablauf_Ueberlauf_",
+ "cost_excavation", "cost_profiling", "cost_filter",
+ "cost_storage", "cost_total", "storage_type"
+ )
+
+ miss_grid <- setdiff(req_grid, names(param_grid))
+ miss_res <- setdiff(req_res, names(simulation_results_optimisation))
+
+ if (length(miss_grid) > 0) {
+ stop("param_grid is missing column(s): ", paste(miss_grid, collapse = ", "))
+ }
+ if (length(miss_res) > 0) {
+ stop(
+ "simulation_results_optimisation is missing column(s): ",
+ paste(miss_res, collapse = ", ")
+ )
+ }
+ if (!is.numeric(x) || length(x) != 1 || is.na(x) || x < 0) {
+ stop("x must be a single non-negative numeric value.")
+ }
+
+ x_int <- as.integer(round(x))
+ if (!isTRUE(all.equal(x, x_int))) {
+ warning("x is not an integer; using x_int = ", x_int,
+ " for discrete palette/legend.")
+ }
+
+ # Append the share of scenarios meeting the validity criterion
+ # (n_overflows <= x) to the auto title (ggplotly drops ggplot subtitles).
+ valid_pct <- round(100 * mean(
+ simulation_results_optimisation$n_overflows <= x_int, na.rm = TRUE))
+ share_txt <- switch(lang,
+ de = paste0(valid_pct, " % mit <= ", x_int, " \u00dcberl\u00e4ufen"),
+ en = paste0(valid_pct, " % with <= ", x_int, " overflows"))
+ if (is.null(title)) title <- paste0(txt$title, " (", share_txt, ")")
+ if (is.null(caption)) caption <- cost_rates_caption(lang)
+
+ param_tooltip <- build_varying_param_html(param_grid, lang, param_labels,
+ digits_params)
+
+ df <- simulation_results_optimisation %>%
+ dplyr::left_join(param_tooltip, by = "scenario_name") %>%
+ dplyr::filter(!isTRUE(filter_n_gtx) |
+ is.na(.data$n_overflows) |
+ .data$n_overflows <= x_int) %>%
+ dplyr::mutate(
+ overflow_volume_m3 = .data$sum_overflows * .data$mulde_area / 1000
+ )
+
+ hi_lab <- paste0(">", x_int)
+ df <- df %>%
+ dplyr::mutate(
+ overflow_cat = dplyr::case_when(
+ is.na(.data$n_overflows) ~ NA_character_,
+ .data$n_overflows > x_int ~ hi_lab,
+ TRUE ~ as.character(.data$n_overflows)
+ )
+ )
+
+ base_levels <- as.character(0:x_int)
+ levs <- c(base_levels, hi_lab)
+
+ df <- df %>%
+ dplyr::mutate(
+ overflow_cat = factor(.data$overflow_cat, levels = levs)
+ )
+
+ # Storage type drives the marker shape (filled square = infiltration box,
+ # filled triangle = gravel trench); shared with the sibling cost plots.
+ st <- storage_type_shapes(df$storage_type, lang)
+ df$storage_type_disp <- st$display
+
+ # Reference for the tooltip's cost-per-percent-evapotranspiration line:
+ # minimum evapotranspiration among the scenarios that satisfy the validity
+ # criterion (n_overflows <= x); computed before any filtering, falls back
+ # to the complete run when no scenario is valid.
+ evap_all <- simulation_results_optimisation[["element.WB_Evapotranspiration_"]]
+ valid_mask <- !is.na(simulation_results_optimisation$n_overflows) &
+ simulation_results_optimisation$n_overflows <= x_int & !is.na(evap_all)
+ evap_min <- suppressWarnings(min(
+ if (any(valid_mask)) evap_all[valid_mask] else evap_all, na.rm = TRUE))
+ df$tooltip_html <- cost_tooltip_text(df, txt, digits, evap_min = evap_min)
+
+ if (x_int == 0L) {
+ pal <- c("0" = "orange", ">0" = "red")
+ } else if (x_int == 1L) {
+ pal <- c("0" = "darkgreen", "1" = "orange", ">1" = "red")
+ } else {
+ pal_green <- grDevices::colorRampPalette(c("darkgreen", "yellowgreen"))(x_int)
+ pal_vals <- c(pal_green, "orange", "red")
+ pal_names <- c(base_levels, hi_lab)
+ pal <- stats::setNames(pal_vals, pal_names)
+ }
+
+ legend_breaks <- levs
+
+ pos <- if (isTRUE(use_jitter)) {
+ ggplot2::position_jitter(
+ width = jitter_width,
+ height = jitter_height,
+ seed = jitter_seed
+ )
+ } else {
+ "identity"
+ }
+
+ legend_direction <- if (legend_position %in% c("top", "bottom")) {
+ "horizontal"
+ } else {
+ "vertical"
+ }
+
+ legend_nrow <- if (legend_direction == "horizontal") 1 else NULL
+ legend_ncol <- if (legend_direction == "vertical") 1 else NULL
+
+ p <- ggplot2::ggplot(df, ggplot2::aes(
+ x = .data$cost_total,
+ y = .data$overflow_volume_m3,
+ color = .data$overflow_cat,
+ shape = .data$storage_type_disp,
+ text = .data$tooltip_html
+ )) +
+ ggplot2::geom_point(alpha = 0.7, position = pos) +
+ ggplot2::scale_color_manual(
+ values = pal,
+ breaks = legend_breaks,
+ limits = levs,
+ drop = FALSE,
+ name = txt$legend
+ ) +
+ ggplot2::scale_shape_manual(
+ values = st$shape_values,
+ drop = FALSE,
+ name = txt$tt_storage_type
+ ) +
+ ggplot2::guides(
+ colour = ggplot2::guide_legend(
+ direction = legend_direction,
+ nrow = legend_nrow,
+ ncol = legend_ncol,
+ byrow = TRUE,
+ order = 1
+ ),
+ shape = ggplot2::guide_legend(
+ direction = legend_direction,
+ nrow = legend_nrow,
+ ncol = legend_ncol,
+ byrow = TRUE,
+ order = 2
+ )
+ ) +
+ ggplot2::labs(
+ title = title,
+ x = lab_x,
+ y = lab_y,
+ caption = if (nzchar(caption)) caption else NULL
+ ) +
+ ggplot2::theme_bw() +
+ ggplot2::theme(
+ legend.position = legend_position,
+ legend.direction = legend_direction,
+ # stack the colour and shape legends so both fit at the top
+ legend.box = if (legend_direction == "horizontal") "vertical" else "horizontal"
+ )
+
+ p
+}
diff --git a/R/plot_main_effects.R b/R/plot_main_effects.R
index 5e98e8c..45a3d97 100644
--- a/R/plot_main_effects.R
+++ b/R/plot_main_effects.R
@@ -8,6 +8,11 @@
#' The function is intended for optimisation or sensitivity grids with many
#' parameters, where a single 2D scatter plot is not informative.
#'
+#' Both numeric and character parameters are supported; a character parameter
+#' such as \code{storage_type} gets its own facet panel (its levels are shown
+#' as \code{Sickerbox} / \code{Schotterrigol} for \code{lang = "de"},
+#' \code{Infiltration box} / \code{Gravel trench} for \code{lang = "en"}).
+#'
#' The plot language can be switched via \code{lang = "de"} or
#' \code{lang = "en"}. This affects the title, y-axis label, and selected
#' parameter labels.
@@ -29,8 +34,7 @@
#' @export
#' @importFrom dplyr %>% select all_of group_by summarise left_join mutate n_distinct
#' @importFrom tidyr pivot_longer
-#' @importFrom ggplot2 ggplot aes geom_violin geom_boxplot geom_jitter facet_wrap
-#' theme_bw theme labs element_text coord_cartesian
+#' @importFrom ggplot2 ggplot aes geom_violin geom_boxplot geom_jitter facet_wrap theme_bw theme labs element_text coord_cartesian
#' @importFrom forcats fct_reorder
#' @importFrom stats median
#' @importFrom rlang .data
@@ -72,8 +76,13 @@ plot_main_effects <- function(df,
"filter_height" = "Filterh\u00f6he [mm]",
"bottom_hydraulicconductivity" = "hydr. Leitf\u00e4higkeit des Untergrunds [mm/h]",
"rain_factor" = "Regenfaktor",
- "lai" = "Blattfl\u00e4chenindex (Mulde-Rigole) [m\u00b2/m\u00b2]"
+ "lai" = "Blattfl\u00e4chenindex (Mulde-Rigole) [m\u00b2/m\u00b2]",
+ "storage_type" = "Speichertyp"
)
+
+ # Display names for the storage_type levels on the x-axis of its panel
+ # (shared with the tooltips, see cost_tooltip.R).
+ storage_value_labels <- storage_type_value_labels(lang)
translate_param <- function(x) {
if (lang == "de" && x %in% names(param_labels_de)) {
@@ -92,13 +101,33 @@ plot_main_effects <- function(df,
dl <- df %>%
dplyr::select(dplyr::all_of(c(y, params_use))) %>%
+ # values_transform: numeric and character parameters (e.g. storage_type)
+ # cannot share one `value` column otherwise.
tidyr::pivot_longer(
cols = dplyr::all_of(params_use),
names_to = "parameter",
- values_to = "value"
+ values_to = "value",
+ values_transform = list(value = as.character)
) %>%
dplyr::mutate(
- value = as.factor(.data$value)
+ value = ifelse(
+ .data$parameter == "storage_type" &
+ .data$value %in% names(storage_value_labels),
+ storage_value_labels[.data$value],
+ .data$value
+ )
+ )
+
+ # Order the shared factor levels numerically where possible (a plain
+ # as.factor on characters would sort "1000" before "500"); non-numeric
+ # levels (e.g. the storage types) come last, alphabetically.
+ val_u <- unique(dl$value)
+ val_n <- suppressWarnings(as.numeric(val_u))
+ value_levels <- c(val_u[!is.na(val_n)][order(val_n[!is.na(val_n)])],
+ sort(val_u[is.na(val_n)]))
+ dl <- dl %>%
+ dplyr::mutate(
+ value = factor(.data$value, levels = value_levels)
)
eff <- dl %>%
@@ -140,4 +169,4 @@ plot_main_effects <- function(df,
}
p
-}
\ No newline at end of file
+}
diff --git a/R/plot_valid_design_space.R b/R/plot_valid_design_space.R
index 4b027a2..849074b 100644
--- a/R/plot_valid_design_space.R
+++ b/R/plot_valid_design_space.R
@@ -73,6 +73,16 @@
#' \code{drop_overflow_gt_valid_max = TRUE}, the x/y axis limits are fixed to
#' the full range or full set of levels found in \code{param_grid}, so the
#' design-space axes do not shrink after filtering. Default \code{TRUE}.
+#' @param facet_storage_type Logical. If \code{TRUE}, the design space is
+#' split by \code{storage_type} into two stacked panels (infiltration box on
+#' top, gravel trench below) with free y-scales, so disjoint per-type levels
+#' (e.g. \code{storage_height}: 300-1200 mm boxes vs. 900-3600 mm trenches)
+#' fill their own panel; duplicate counting for \code{alpha_mode =
+#' "duplicates"} then happens per panel and the points stay plain circles
+#' (the strips already name the type). Requires a \code{storage_type}
+#' column in \code{param_grid}. Without faceting, points are shaped by the
+#' storage type (filled square = infiltration box, filled triangle = gravel
+#' trench) whenever \code{storage_type} varies. Default \code{FALSE}.
#' @param lang Character. Plot language: \code{"de"} or \code{"en"}.
#' @param title Character or \code{NULL}. Plot title. If \code{NULL}, a
#' language-specific default title is used.
@@ -88,7 +98,9 @@
#' @importFrom ggplot2 position_identity scale_alpha_identity coord_cartesian
#' @importFrom ggplot2 scale_x_discrete scale_y_discrete scale_colour_manual
#' @importFrom ggplot2 guides guide_legend theme scale_x_continuous scale_y_continuous
+#' @importFrom ggplot2 scale_shape_manual facet_grid vars
#' @importFrom rlang .data
+#' @importFrom utils modifyList
#' @importFrom grDevices colorRampPalette
#' @export
plot_valid_design_space <- function(param_grid,
@@ -111,6 +123,7 @@ plot_valid_design_space <- function(param_grid,
alpha_min = 0.20,
alpha_max = 1.00,
keep_param_grid_limits = TRUE,
+ facet_storage_type = FALSE,
lang = c("de", "en"),
title = NULL,
subtitle = NULL,
@@ -132,10 +145,12 @@ plot_valid_design_space <- function(param_grid,
txt <- switch(
lang,
de = list(
+ # two lines: the composed title (threshold + both axis labels) is too
+ # long for one line in the 9-inch PDFs and the interactive HTMLs
title = paste0(
- "G\u00fcltige L\u00f6sungen (Anzahl \u00dcberlaufereignisse \u2264 ",
+ "G\u00fcltige L\u00f6sungen (Anzahl \u00dcberlaufereignisse <= ",
valid_max,
- ") im Designraum: ",
+ ")\nim Designraum: ",
lab_x,
" \u00d7 ",
lab_y
@@ -148,9 +163,9 @@ plot_valid_design_space <- function(param_grid,
),
en = list(
title = paste0(
- "Valid solutions (Number of overflow events \u2264 ",
+ "Valid solutions (Number of overflow events <= ",
valid_max,
- ") in design space: ",
+ ")\nin design space: ",
x,
" \u00d7 ",
y
@@ -194,14 +209,29 @@ plot_valid_design_space <- function(param_grid,
stop("Missing columns in sim_results: ", paste(miss_res, collapse = ", "))
}
+ if (isTRUE(facet_storage_type) && !"storage_type" %in% names(param_grid)) {
+ stop("facet_storage_type = TRUE requires a 'storage_type' column in param_grid.")
+ }
+
cand <- setdiff(names(param_grid), id_col)
lvl <- vapply(param_grid[cand], function(v) dplyr::n_distinct(v, na.rm = TRUE), numeric(1))
varied_params <- cand[lvl > 1 & lvl <= max_levels]
-
- keep_pg <- unique(c(id_col, x, y, varied_params))
+
+ keep_pg <- unique(c(id_col, x, y, varied_params,
+ if (isTRUE(facet_storage_type)) "storage_type"))
+
+ # Usable storage volume [m3] for the tooltip, taken from the results side
+ # (precomputed storage_volume_m3 column or derived from the storage_theta*
+ # columns there) unless param_grid already carries the column itself.
+ sim_sel <- dplyr::select(sim_results, dplyr::all_of(c(id_col, overflow_col)))
+ if (!"storage_volume_m3" %in% keep_pg) {
+ sim_volume <- storage_volume_from_df(sim_results)
+ if (!is.null(sim_volume)) sim_sel$storage_volume_m3 <- sim_volume
+ }
+
d <- dplyr::left_join(
dplyr::select(param_grid, dplyr::all_of(keep_pg)),
- dplyr::select(sim_results, dplyr::all_of(c(id_col, overflow_col))),
+ sim_sel,
by = id_col
)
@@ -213,8 +243,29 @@ plot_valid_design_space <- function(param_grid,
if (isTRUE(drop_overflow_gt_valid_max)) {
d <- dplyr::filter(d, .data[[overflow_col]] <= valid_max_int)
}
-
- other_params <- setdiff(varied_params, c(x, y))
+
+ # Storage-type tagging (filled square = infiltration box, filled triangle =
+ # gravel trench, as in the cost plots): active whenever storage_type is one
+ # of the varied parameters -- except in the faceted layout, where the strips
+ # already name the type and the points stay plain circles for readability.
+ st_labels <- cost_tooltip_labels(lang)
+ has_storage_type <- "storage_type" %in% names(d)
+ if (has_storage_type) {
+ st <- storage_type_shapes(d$storage_type, lang)
+ d$storage_type_disp <- st$display
+ }
+ use_shapes <- has_storage_type && !isTRUE(facet_storage_type)
+ add_shape <- function(mapping) {
+ if (use_shapes) {
+ utils::modifyList(mapping, ggplot2::aes(shape = .data$storage_type_disp))
+ } else {
+ mapping
+ }
+ }
+
+ # storage_volume_m3 gets its own dedicated tooltip line below, so keep it
+ # out of the generic "other parameters" block.
+ other_params <- setdiff(varied_params, c(x, y, "storage_volume_m3"))
fmt <- function(v) {
if (is.numeric(v)) {
@@ -233,11 +284,19 @@ plot_valid_design_space <- function(param_grid,
""
}
+ vol_line <- if ("storage_volume_m3" %in% names(d)) {
+ paste0("
", st_labels$tt_storage_volume, ": ",
+ fmt(d$storage_volume_m3))
+ } else {
+ ""
+ }
+
d$hover <- paste0(
"", txt$tt_id, ": ", d[[id_col]],
"
", txt$tt_overflow, ": ", fmt(d[[overflow_col]]),
"
", lab_x, ": ", fmt(d[[x]]),
"
", lab_y, ": ", fmt(d[[y]]),
+ vol_line,
other_block
)
@@ -274,8 +333,14 @@ plot_valid_design_space <- function(param_grid,
legend_breaks <- levs
if (alpha_mode == "duplicates") {
+ # With storage-type facets, identical x/y coordinates only overplot within
+ # the same panel, so duplicates are counted per storage type.
+ d <- if (isTRUE(facet_storage_type) && has_storage_type) {
+ d %>% dplyr::group_by(.data$storage_type_disp, .data[[x]], .data[[y]])
+ } else {
+ d %>% dplyr::group_by(.data[[x]], .data[[y]])
+ }
d <- d %>%
- dplyr::group_by(.data[[x]], .data[[y]]) %>%
dplyr::mutate(dup_n = dplyr::n()) %>%
dplyr::ungroup()
@@ -320,11 +385,11 @@ plot_valid_design_space <- function(param_grid,
if (isTRUE(drop_overflow_gt_valid_max)) {
p <- ggplot2::ggplot(d, ggplot2::aes(x = .data[[x]], y = .data[[y]])) +
ggplot2::geom_point(
- ggplot2::aes(
+ add_shape(ggplot2::aes(
colour = .data$overflow_cat,
text = .data$hover,
alpha = .data$alpha_valid
- ),
+ )),
size = size + 0.6,
position = pos
) +
@@ -359,21 +424,21 @@ plot_valid_design_space <- function(param_grid,
p <- ggplot2::ggplot(d, ggplot2::aes(x = .data[[x]], y = .data[[y]])) +
ggplot2::geom_point(
data = dplyr::filter(d, !.data$valid),
- ggplot2::aes(
+ add_shape(ggplot2::aes(
colour = .data$overflow_cat,
text = .data$hover,
alpha = .data$alpha_invalid
- ),
+ )),
size = size,
position = pos
) +
ggplot2::geom_point(
data = dplyr::filter(d, .data$valid),
- ggplot2::aes(
+ add_shape(ggplot2::aes(
colour = .data$overflow_cat,
text = .data$hover,
alpha = .data$alpha_valid
- ),
+ )),
size = size + 0.8,
position = pos
) +
@@ -406,6 +471,30 @@ plot_valid_design_space <- function(param_grid,
)
}
+ if (use_shapes) {
+ p <- p +
+ # Square = infiltration box, triangle = gravel trench.
+ ggplot2::scale_shape_manual(
+ values = st$shape_values,
+ drop = FALSE,
+ name = st_labels$tt_storage_type
+ ) +
+ # stack the colour and shape legends so both fit at the top
+ ggplot2::theme(
+ legend.box = if (legend_direction == "horizontal") "vertical" else "horizontal"
+ )
+ }
+ if (isTRUE(facet_storage_type)) {
+ # Two stacked panels (infiltration box on top, gravel trench below);
+ # free y-scales let disjoint per-type levels (e.g. storage_height:
+ # 300-1200 mm boxes vs. 900-3600 mm trenches) fill their own panel.
+ # plotly::ggplotly() keeps the split as stacked subplots.
+ p <- p + ggplot2::facet_grid(
+ rows = ggplot2::vars(.data$storage_type_disp),
+ scales = "free_y"
+ )
+ }
+
if (isTRUE(keep_param_grid_limits)) {
if (is.numeric(param_grid[[x]]) && is.numeric(param_grid[[y]])) {
x_vals <- sort(unique(param_grid[[x]]))
@@ -418,7 +507,8 @@ plot_valid_design_space <- function(param_grid,
if (isTRUE(drop_overflow_gt_valid_max)) {
p <- p + ggplot2::coord_cartesian(
xlim = range(x_vals),
- ylim = range(y_vals)
+ # a fixed ylim would override the per-panel free y-scales
+ ylim = if (isTRUE(facet_storage_type)) NULL else range(y_vals)
)
}
} else {
diff --git a/R/plot_wb_tradeoff_overflows.R b/R/plot_wb_tradeoff_overflows.R
index 71c0339..9da99e1 100644
--- a/R/plot_wb_tradeoff_overflows.R
+++ b/R/plot_wb_tradeoff_overflows.R
@@ -18,7 +18,15 @@
#' tooltip labels unless custom labels are supplied explicitly.
#'
#' Tooltip text additionally includes all parameters from \code{param_grid} that
-#' vary across scenarios, excluding \code{scenario_name}.
+#' vary across scenarios, excluding \code{scenario_name} (translated via
+#' \code{\link{default_param_labels}}; mixed numeric / character parameters
+#' such as \code{storage_type} are supported).
+#'
+#' If \code{simulation_results_optimisation} carries a \code{storage_type}
+#' column, the points are additionally **shaped by the storage type** (filled
+#' square = infiltration box / Sickerbox, filled triangle = gravel trench /
+#' Schotterrigol, as in the cost plots) and the tooltip names the storage
+#' type; older single-type result sets plot exactly as before.
#'
#' @param simulation_results_optimisation Data frame with simulation results.
#' Required columns are \code{scenario_name}, \code{n_overflows},
@@ -55,12 +63,10 @@
#'
#' @export
#'
-#' @importFrom dplyr %>% select summarise across everything n_distinct
-#' @importFrom dplyr filter pull mutate group_by left_join
-#' @importFrom tidyr pivot_longer
-#' @importFrom purrr map_chr
-#' @importFrom ggplot2 ggplot aes geom_point scale_color_manual labs theme_minimal position_jitter theme
+#' @importFrom dplyr %>% filter mutate left_join case_when
+#' @importFrom ggplot2 ggplot aes geom_point scale_color_manual scale_shape_manual labs theme_bw position_jitter theme guides guide_legend
#' @importFrom grDevices colorRampPalette
+#' @importFrom utils modifyList
#' @importFrom rlang .data
plot_wb_tradeoff_overflows <- function(simulation_results_optimisation,
param_grid,
@@ -84,7 +90,7 @@ plot_wb_tradeoff_overflows <- function(simulation_results_optimisation,
lang,
de = list(
title = paste0(
- "Wasserbilanz vs. \u00DCberlaufereignisse (Anzahl \u2264 ",
+ "Wasserbilanz vs. \u00DCberlaufereignisse (Anzahl <= ",
x,
")"
),
@@ -101,7 +107,7 @@ plot_wb_tradeoff_overflows <- function(simulation_results_optimisation,
),
en = list(
title = paste0(
- "Water balance vs. overflow events (number \u2264 ",
+ "Water balance vs. overflow events (number <= ",
x,
")"
),
@@ -157,35 +163,13 @@ plot_wb_tradeoff_overflows <- function(simulation_results_optimisation,
warning("x is not an integer; using x_int = ", x_int, " for discrete palette/legend.")
}
- varying_params <- param_grid %>%
- dplyr::select(-scenario_name) %>%
- dplyr::summarise(dplyr::across(dplyr::everything(), ~ dplyr::n_distinct(.) > 1)) %>%
- tidyr::pivot_longer(dplyr::everything(), names_to = "param", values_to = "vary") %>%
- dplyr::filter(vary) %>%
- dplyr::pull(param)
-
- if (length(varying_params) == 0) {
- param_tooltip <- param_grid %>%
- dplyr::select(scenario_name) %>%
- dplyr::mutate(params_html = "")
- } else {
- param_tooltip <- param_grid %>%
- dplyr::select(scenario_name, dplyr::all_of(varying_params)) %>%
- tidyr::pivot_longer(-scenario_name, names_to = "param", values_to = "val") %>%
- dplyr::mutate(
- val_chr = purrr::map_chr(val, ~ paste(.x, collapse = ",")),
- val_num = suppressWarnings(as.numeric(val_chr)),
- val_fmt = ifelse(
- is.na(val_num),
- val_chr,
- format(round(val_num, digits_params), trim = TRUE)
- ),
- kv = paste0(param, "=", val_fmt)
- ) %>%
- dplyr::group_by(scenario_name) %>%
- dplyr::summarise(params_html = paste(kv, collapse = "
"), .groups = "drop")
- }
-
+ # Shared helper (same as the cost plots): handles mixed numeric / character
+ # parameter columns (e.g. storage_type) and translates the parameter names
+ # via default_param_labels().
+ param_tooltip <- build_varying_param_html(param_grid, lang,
+ param_labels = NULL,
+ digits_params = digits_params)
+
df <- simulation_results_optimisation %>%
dplyr::left_join(param_tooltip, by = "scenario_name") %>%
dplyr::filter(!isTRUE(filter_n_gtx) | is.na(.data$n_overflows) | .data$n_overflows <= x_int)
@@ -207,7 +191,52 @@ plot_wb_tradeoff_overflows <- function(simulation_results_optimisation,
dplyr::mutate(
overflow_cat = factor(.data$overflow_cat, levels = levs)
)
-
+
+ # Optional storage-type tagging (filled square = infiltration box, filled
+ # triangle = gravel trench, as in the cost plots): active when the results
+ # carry a storage_type column; older single-type result sets plot as before.
+ st_labels <- cost_tooltip_labels(lang)
+ has_storage_type <- "storage_type" %in% names(df)
+ if (has_storage_type) {
+ # short language-specific names for the legend keys ...
+ st <- storage_type_shapes(df$storage_type, lang)
+ df$storage_type_disp <- st$display
+ # ... but the bilingual names for the tooltip line, matching the cost
+ # plots' tooltips
+ st_raw <- as.character(df$storage_type)
+ df$storage_type_tooltip <- ifelse(
+ !is.na(st_raw) & st_raw == "gravel_trench",
+ st_labels$st_gravel_trench, st_labels$st_infiltration_box)
+ }
+ # Usable storage volume of the storage layer [m3] (precomputed column or
+ # derived from the storage_theta* columns); line omitted if not derivable.
+ storage_volume <- storage_volume_from_df(df)
+
+ df$tooltip_html <- paste0(
+ txt$tt_scenario, ": ", df$scenario_name,
+ "
", txt$tt_n_overflows, ": ", df$n_overflows,
+ "
", txt$tt_infil, ": ",
+ round(df[["element.WB_InfiltrationNetto_"]], digits),
+ "
", txt$tt_evap, ": ",
+ round(df[["element.WB_Evapotranspiration_"]], digits),
+ "
", txt$tt_overflow, ": ",
+ round(df[["element.WB_Oberflaechenablauf_Ueberlauf_"]], digits),
+ "
", txt$tt_sum_overflows, ": ", df$sum_overflows,
+ if (has_storage_type) {
+ paste0("
", st_labels$tt_storage_type, ": ",
+ df$storage_type_tooltip, "")
+ } else {
+ ""
+ },
+ if (!is.null(storage_volume)) {
+ paste0("
", st_labels$tt_storage_volume, ": ",
+ round(storage_volume, digits))
+ } else {
+ ""
+ },
+ "
", txt$tt_params, "
", df$params_html
+ )
+
if (x_int == 0L) {
pal <- c("0" = "orange", ">0" = "red")
} else if (x_int == 1L) {
@@ -240,20 +269,20 @@ plot_wb_tradeoff_overflows <- function(simulation_results_optimisation,
legend_nrow <- if (legend_direction == "horizontal") 1 else NULL
legend_ncol <- if (legend_direction == "vertical") 1 else NULL
- p <- ggplot2::ggplot(df, ggplot2::aes(
- x = element.WB_InfiltrationNetto_,
- y = element.WB_Evapotranspiration_,
- color = overflow_cat,
- text = paste0(
- txt$tt_scenario, ": ", scenario_name,
- "
", txt$tt_n_overflows, ": ", n_overflows,
- "
", txt$tt_infil, ": ", round(element.WB_InfiltrationNetto_, digits),
- "
", txt$tt_evap, ": ", round(element.WB_Evapotranspiration_, digits),
- "
", txt$tt_overflow, ": ", round(element.WB_Oberflaechenablauf_Ueberlauf_, digits),
- "
", txt$tt_sum_overflows, ": ", sum_overflows,
- "
", txt$tt_params, "
", params_html
+ mapping <- ggplot2::aes(
+ x = .data[["element.WB_InfiltrationNetto_"]],
+ y = .data[["element.WB_Evapotranspiration_"]],
+ color = .data$overflow_cat,
+ text = .data$tooltip_html
+ )
+ if (has_storage_type) {
+ mapping <- utils::modifyList(
+ mapping,
+ ggplot2::aes(shape = .data$storage_type_disp)
)
- )) +
+ }
+
+ p <- ggplot2::ggplot(df, mapping) +
ggplot2::geom_point(alpha = 0.7, position = pos) +
ggplot2::scale_color_manual(
values = pal,
@@ -267,7 +296,8 @@ plot_wb_tradeoff_overflows <- function(simulation_results_optimisation,
direction = legend_direction,
nrow = legend_nrow,
ncol = legend_ncol,
- byrow = TRUE
+ byrow = TRUE,
+ order = 1
)
) +
ggplot2::labs(
@@ -278,8 +308,28 @@ plot_wb_tradeoff_overflows <- function(simulation_results_optimisation,
ggplot2::theme_bw() +
ggplot2::theme(
legend.position = legend_position,
- legend.direction = legend_direction
+ legend.direction = legend_direction,
+ # stack the colour and shape legends so both fit at the top
+ legend.box = if (legend_direction == "horizontal") "vertical" else "horizontal"
)
-
+
+ if (has_storage_type) {
+ p <- p +
+ ggplot2::scale_shape_manual(
+ values = st$shape_values,
+ drop = FALSE,
+ name = st_labels$tt_storage_type
+ ) +
+ ggplot2::guides(
+ shape = ggplot2::guide_legend(
+ direction = legend_direction,
+ nrow = legend_nrow,
+ ncol = legend_ncol,
+ byrow = TRUE,
+ order = 2
+ )
+ )
+ }
+
p
-}
\ No newline at end of file
+}
diff --git a/R/plotly_split_legend.R b/R/plotly_split_legend.R
new file mode 100644
index 0000000..e4d9519
--- /dev/null
+++ b/R/plotly_split_legend.R
@@ -0,0 +1,310 @@
+#' Split the combined (colour, shape) ggplotly legend into two clean legends
+#'
+#' `plotly::ggplotly()` flattens a ggplot with both a colour and a shape
+#' aesthetic into one trace per (colour, shape) combination and names the
+#' legend entries as tuples such as `"(0,Sickerbox / Infiltration box)"` --
+#' with two storage types and the 0..x / ">x" overflow palette that yields an
+#' unreadable legend. This helper post-processes the plotly object:
+#'
+#' * the real traces lose their legend entries; instead every overflow class
+#' gets one legend-only key drawn as a **neutral circle in the class
+#' colour** (a coloured square or triangle would wrongly suggest one
+#' specific storage type). The key shares its legend group with the real
+#' traces of that class, so clicking it toggles **both** storage types of
+#' the class together;
+#' * two legend-only keys (**neutral grey** filled square = infiltration box,
+#' filled triangle = gravel trench) are appended under their own
+#' **storage-type group title**, so the shape encoding is explained
+#' separately from the colours -- set `add_shape_legend = FALSE` to skip
+#' them (e.g. for storage-type-faceted plots whose strips already label the
+#' panels). The keys are **clickable**: since a plotly trace can only carry
+#' one legend group (taken by the overflow class), a small JavaScript
+#' handler (via `htmlwidgets::onRender()`) toggles all traces drawn with
+#' that marker symbol, so each storage type can be shown or hidden
+#' individually; the key greys out to reflect the state;
+#' * the combined `"colour,shape"` legend-title annotation that ggplotly
+#' draws over the plot title is removed; group titles take its place and
+#' the legend moves to a vertical layout on the right, where the groups
+#' stack cleanly.
+#'
+#' Traces whose name is not a `"(colour,shape)"` tuple (frontier lines, best
+#' markers, single-aesthetic plots) are left untouched, so the helper is safe
+#' to apply to any of the package's interactive plots.
+#'
+#' @param pl A plotly object as returned by
+#' `plotly::ggplotly(p, tooltip = "text")`.
+#' @param lang Character. `"de"` or `"en"`; sets the default legend group
+#' titles.
+#' @param colour_title Character or `NULL`. Title of the colour legend group.
+#' Defaults to the language-specific "Number of overflow events".
+#' @param shape_title Character or `NULL`. Title of the storage-type legend
+#' group. Defaults to the language-specific "Storage type".
+#' @param add_shape_legend Logical. If `TRUE` (default), append the two
+#' legend-only storage-type entries.
+#'
+#' @return The modified plotly object.
+#'
+#' @examples
+#' \dontrun{
+#' p <- plot_cost_vs_evaporation(sim_results, param_grid, x = 5, lang = "de")
+#' pl <- plotly::ggplotly(p, tooltip = "text")
+#' pl <- plotly_split_legend(pl, lang = "de")
+#' }
+#'
+#' @export
+plotly_split_legend <- function(pl,
+ lang = c("de", "en"),
+ colour_title = NULL,
+ shape_title = NULL,
+ add_shape_legend = TRUE) {
+
+ lang <- match.arg(lang)
+ tt <- cost_tooltip_labels(lang)
+ if (is.null(colour_title)) {
+ colour_title <- switch(lang,
+ de = "Anzahl \u00dcberlaufereignisse",
+ en = "Number of overflow events")
+ }
+ if (is.null(shape_title)) shape_title <- tt$tt_storage_type
+
+ traces <- pl$x$data
+ tuple_re <- "^\\((.+?),(.+)\\)$"
+ seen_colour <- character(0)
+ colour_swatch <- list()
+ shape_symbols <- list()
+ found_tuples <- FALSE
+
+ # Every real (colour, shape) trace loses its legend entry; the legend is
+ # rebuilt from legend-only dummy traces below, so the colour keys can be
+ # neutral circles and the storage-type keys neutral grey shapes -- a
+ # coloured square/triangle key would wrongly suggest one specific
+ # (colour, type) combination.
+ for (i in seq_along(traces)) {
+ nm <- traces[[i]]$name
+ if (is.null(nm) || length(nm) != 1) next
+ m <- regmatches(as.character(nm), regexec(tuple_re, as.character(nm)))[[1]]
+ if (length(m) != 3) next
+ found_tuples <- TRUE
+
+ colour_lab <- trimws(m[2])
+ shape_lab <- trimws(m[3])
+
+ sym <- traces[[i]]$marker$symbol
+ if (!is.null(sym) && length(sym) >= 1 && !shape_lab %in% names(shape_symbols)) {
+ shape_symbols[[shape_lab]] <- sym[[1]]
+ }
+ col <- traces[[i]]$marker$color
+ if (!is.null(col) && length(col) >= 1 && !colour_lab %in% names(colour_swatch)) {
+ colour_swatch[[colour_lab]] <- col[[1]]
+ }
+ if (!colour_lab %in% seen_colour) seen_colour <- c(seen_colour, colour_lab)
+
+ traces[[i]]$name <- colour_lab
+ traces[[i]]$legendgroup <- colour_lab
+ traces[[i]]$showlegend <- FALSE
+ }
+
+ # Layout clean-up shared by both cases: strip the legend-title annotation
+ # that ggplotly draws over the plot title, convert two-line ggplot titles
+ # ("\n") to plotly's "
", and move the legend to a vertical layout on
+ # the right where nothing collides with the title.
+ fix_layout <- function(pl) {
+ ann <- pl$x$layout$annotations
+ if (length(ann) > 0) {
+ keep <- vapply(ann, function(a) {
+ txt <- if (is.null(a$text)) "" else gsub("<[^>]+>", "", as.character(a$text))
+ !(grepl(colour_title, txt, fixed = TRUE) ||
+ grepl(shape_title, txt, fixed = TRUE))
+ }, logical(1))
+ pl$x$layout$annotations <- ann[keep]
+ }
+ if (!is.null(pl$x$layout$title$text)) {
+ pl$x$layout$title$text <- gsub("\n", "
",
+ pl$x$layout$title$text, fixed = TRUE)
+ }
+ pl$x$layout$showlegend <- TRUE
+ pl$x$layout$legend$orientation <- "v"
+ pl$x$layout$legend$x <- 1.02
+ pl$x$layout$legend$xanchor <- "left"
+ pl$x$layout$legend$y <- 1.0
+ pl$x$layout$legend$yanchor <- "top"
+ pl
+ }
+
+ # No combined-legend traces (single-aesthetic plot, e.g. the faceted design
+ # space): keep the existing colour entries, but give the legend its title
+ # (instead of the removed annotation) and order the classes numerically
+ # with the ">x" catch-all last.
+ if (!found_tuples) {
+ for (i in seq_along(traces)) {
+ nm <- traces[[i]]$name
+ nm <- if (is.null(nm)) "" else as.character(nm)
+ if (grepl("^[0-9]+$", nm)) {
+ traces[[i]]$legendrank <- 100 + as.numeric(nm)
+ } else if (grepl("^>", nm)) {
+ traces[[i]]$legendrank <- 800
+ }
+ }
+ pl$x$data <- traces
+ pl$x$layout$legend$title <- list(text = colour_title)
+ return(fix_layout(pl))
+ }
+
+ # Colour classes ordered numerically, the ">x" catch-all after them.
+ colour_num <- suppressWarnings(as.numeric(seen_colour))
+ colour_sorted <- c(seen_colour[!is.na(colour_num)][order(colour_num[!is.na(colour_num)])],
+ sort(seen_colour[is.na(colour_num)]))
+
+ # Legend-only colour keys: neutral circles in the class colour. They share
+ # the legendgroup with the real traces of that class, so clicking a key
+ # still toggles both storage types of the class together.
+ # Legend-only traces need one null data point (x/y = NA -> [null] in the
+ # JSON): plotly.js does not create legend entries for traces whose data
+ # arrays are completely empty.
+ first_colour <- TRUE
+ for (lab in colour_sorted) {
+ tr <- list(
+ x = NA_real_, y = NA_real_,
+ type = "scatter", mode = "markers",
+ marker = list(symbol = "circle",
+ color = colour_swatch[[lab]],
+ size = 10),
+ name = lab,
+ legendgroup = lab,
+ legendrank = 100 + match(lab, colour_sorted),
+ showlegend = TRUE,
+ hoverinfo = "none"
+ )
+ if (first_colour) {
+ tr$legendgrouptitle <- list(text = colour_title)
+ first_colour <- FALSE
+ }
+ traces[[length(traces) + 1]] <- tr
+ }
+
+ # Legend-only storage-type keys: neutral grey square / triangle.
+ has_shape_keys <- isTRUE(add_shape_legend) && length(shape_symbols) > 0
+ if (has_shape_keys) {
+ first_shape <- TRUE
+ for (lab in names(shape_symbols)) {
+ tr <- list(
+ x = NA_real_, y = NA_real_,
+ type = "scatter", mode = "markers",
+ # "#666666" = R "grey40"; R colour names are not valid CSS for
+ # plotly.js
+ marker = list(symbol = shape_symbols[[lab]], color = "#666666",
+ size = 10),
+ name = lab,
+ legendgroup = "storage_type_legend",
+ legendrank = 900 + match(lab, names(shape_symbols)),
+ showlegend = TRUE,
+ hoverinfo = "none"
+ )
+ if (first_shape) {
+ tr$legendgrouptitle <- list(text = shape_title)
+ first_shape <- FALSE
+ }
+ traces[[length(traces) + 1]] <- tr
+ }
+ }
+
+ pl$x$data <- traces
+
+ # Group titles replace the legend title in the rebuilt legend.
+ pl$x$layout$legend$title <- list(text = "")
+
+ pl <- fix_layout(pl)
+
+ # Make the storage-type keys interactive: a trace can only belong to one
+ # legend group (taken by the overflow class), so clicking a square/triangle
+ # key toggles all real traces with that marker symbol via a small
+ # plotly_legendclick handler; the key itself greys out to show the state.
+ if (has_shape_keys && requireNamespace("htmlwidgets", quietly = TRUE)) {
+ js_toggle <- paste0(
+ "function(el, x) {",
+ " el.on('plotly_legendclick', function(d) {",
+ " var tr = el.data[d.curveNumber];",
+ " if (!tr || tr.legendgroup !== 'storage_type_legend') return true;",
+ " var sym = tr.marker.symbol;",
+ " var idx = [];",
+ " var target = null;",
+ " el.data.forEach(function(t, i) {",
+ " var isKey = t.legendgroup === 'storage_type_legend';",
+ " var symMatch = t.marker && t.marker.symbol === sym;",
+ " if (symMatch && (!isKey || i === d.curveNumber)) {",
+ " idx.push(i);",
+ " if (!isKey && target === null) {",
+ " target = (t.visible === undefined || t.visible === true) ?",
+ " 'legendonly' : true;",
+ " }",
+ " }",
+ " });",
+ " if (target === null) return true;",
+ " Plotly.restyle(el, {visible: target}, idx);",
+ " return false;",
+ " });",
+ "}"
+ )
+ pl <- htmlwidgets::onRender(pl, js_toggle)
+ }
+
+ pl
+}
+
+#' Add a caption annotation to a ggplotly object
+#'
+#' `plotly::ggplotly()` drops ggplot captions (and subtitles). This helper
+#' re-adds the caption as a small grey annotation below the plot area (bottom
+#' left, under the x-axis title) and widens the bottom margin accordingly.
+#' `\n` line breaks are converted to `
`.
+#'
+#' Used by the vignettes together with [cost_rates_caption()] so the
+#' interactive cost plots name the unit-cost rates they were computed with.
+#'
+#' @param pl A plotly object as returned by `plotly::ggplotly()`.
+#' @param caption Character. The caption text; `NULL` or `""` returns `pl`
+#' unchanged.
+#' @param font_size Numeric. Caption font size in px. Default 10.
+#'
+#' @return The modified plotly object.
+#'
+#' @examples
+#' \dontrun{
+#' pl <- plotly::ggplotly(p, tooltip = "text")
+#' pl <- plotly_add_caption(pl, cost_rates_caption("de"))
+#' }
+#'
+#' @export
+plotly_add_caption <- function(pl, caption, font_size = 10) {
+ if (is.null(caption) || !nzchar(caption)) return(pl)
+ # Two-line ggplot titles ("\n") need "
" in plotly and a little more
+ # headroom (relevant for plots that do not pass plotly_split_legend(),
+ # e.g. the cost boxplots with their reference line in the title).
+ if (!is.null(pl$x$layout$title$text)) {
+ pl$x$layout$title$text <- gsub("\n", "
",
+ pl$x$layout$title$text, fixed = TRUE)
+ if (grepl("
", pl$x$layout$title$text, fixed = TRUE) &&
+ (is.null(pl$x$layout$margin$t) || pl$x$layout$margin$t < 75)) {
+ pl$x$layout$margin$t <- 75
+ }
+ }
+ # Anchored to the bottom of the plot area with a fixed PIXEL offset
+ # (yshift): a paper-coordinate offset would scale with the plot height and
+ # push the caption out of the margin on tall (e.g. faceted) plots.
+ ann <- list(
+ text = gsub("\n", "
", caption, fixed = TRUE),
+ x = 0, y = 0,
+ xref = "paper", yref = "paper",
+ xanchor = "left", yanchor = "top",
+ yshift = -58,
+ showarrow = FALSE,
+ align = "left",
+ font = list(size = font_size, color = "#666666")
+ )
+ pl$x$layout$annotations <- c(pl$x$layout$annotations, list(ann))
+ # room below the x-axis tick labels and title for the caption line
+ if (is.null(pl$x$layout$margin$b) || pl$x$layout$margin$b < 85) {
+ pl$x$layout$margin$b <- 85
+ }
+ pl
+}
diff --git a/R/read_site_timeseries.R b/R/read_site_timeseries.R
new file mode 100644
index 0000000..266abf2
--- /dev/null
+++ b/R/read_site_timeseries.R
@@ -0,0 +1,83 @@
+#' Read and prepare site rain/ET0 time series for the engine (mm/h)
+#'
+#' Factors the time-series preparation duplicated in the Wien and Bad
+#' Aussee workflow vignettes into one helper: reads the shipped GeoSphere
+#' rain series (`rain.csv.gz`: columns `time` (datetime), `rr` (mm per
+#' interval), `station`, further columns tolerated) and reference ET0
+#' series (`et.csv`:
+#' `date;value` with `dd.mm.yyyy`, mm per day), converts both to hours
+#' since series start, aligns the series ends (the shorter series is
+#' extended to the longer one's end, repeating its last value) and
+#' converts the values to the engine's **mm/h** rate convention (rain:
+#' mm per interval / interval hours; ET0: mm per day / 24).
+#'
+#' @param path_rain Path to the rain CSV (may be gzipped).
+#' @param path_et Path to the ET0 CSV (semicolon separated).
+#' @param verbose Print alignment messages (default TRUE).
+#'
+#' @return List with data.frames `rain` and `et` (columns `time` = hours
+#' since start, `value` = mm/h) ready for
+#' `make_swale_runner(timeseries_rain = , timeseries_et = )`.
+#'
+#' @seealso [make_swale_runner()]
+#' @export
+read_site_timeseries <- function(path_rain, path_et, verbose = TRUE) {
+
+ if (!requireNamespace("readr", quietly = TRUE)) {
+ stop("read_site_timeseries() requires the 'readr' package")
+ }
+
+ timeseries_et <- readr::read_delim(path_et, delim = ";",
+ col_types = "cd") %>%
+ dplyr::mutate(
+ date = lubridate::dmy(.data$date),
+ time = as.integer(difftime(.data$date, min(.data$date),
+ units = "hours"))
+ ) %>%
+ dplyr::select(-"date") %>%
+ dplyr::filter(!is.na(.data$value)) %>%
+ dplyr::relocate("time", .before = "value")
+ timeseries_et$time[nrow(timeseries_et)] <-
+ ceiling(timeseries_et$time[nrow(timeseries_et)])
+
+ timeseries_rain <- readr::read_csv(path_rain, show_col_types = FALSE) %>%
+ dplyr::rename(datetime = "time", value = "rr") %>%
+ dplyr::mutate(
+ time = as.double(difftime(.data$datetime, min(.data$datetime),
+ units = "secs")) / 3600
+ ) %>%
+ dplyr::filter(!is.na(.data$value)) %>%
+ # robust gegen zusaetzliche Spalten (Bad Aussee hat z.B. "substation"):
+ # die Engine erwartet exakt time + value
+ dplyr::select("time", "value")
+ timeseries_rain$time[nrow(timeseries_rain)] <-
+ ceiling(timeseries_rain$time[nrow(timeseries_rain)])
+
+ # Serien-Enden angleichen: die kuerzere Serie wird mit ihrem letzten
+ # Wert bis zum Ende der laengeren verlaengert (wie in den Vignetten).
+ extend_to <- function(df, t_end, label) {
+ if (t_end <= max(df$time)) return(df)
+ if (isTRUE(verbose)) {
+ message(sprintf(
+ "%s series extended by %.1f hours to %.0f h (last value %.4f)",
+ label, t_end - max(df$time), t_end, df$value[nrow(df)]
+ ))
+ }
+ dplyr::bind_rows(df, tibble::tibble(time = t_end,
+ value = df$value[nrow(df)]))
+ }
+ t_end <- max(max(timeseries_rain$time), max(timeseries_et$time))
+ timeseries_et <- extend_to(timeseries_et, t_end, "ET0")
+ timeseries_rain <- extend_to(timeseries_rain, t_end, "Rain")
+
+ # mm je Intervall -> mm/h (Engine liest beide Kurven als mm/h-Rate;
+ # ET0-Tageswerte ohne /24 wuerden 24x zu hoch integriert)
+ period_rain <- c(diff(timeseries_rain$time),
+ mean(diff(timeseries_rain$time)))
+ timeseries_rain$value <- timeseries_rain$value / period_rain
+ period_et <- c(diff(timeseries_et$time), mean(diff(timeseries_et$time)))
+ timeseries_et$value <- timeseries_et$value / period_et
+
+ list(rain = as.data.frame(timeseries_rain),
+ et = as.data.frame(timeseries_et))
+}
diff --git a/R/stack_levels.R b/R/stack_levels.R
new file mode 100644
index 0000000..de0698b
--- /dev/null
+++ b/R/stack_levels.R
@@ -0,0 +1,125 @@
+#' Achievable storage-layer stack heights from module heights
+#'
+#' Enumerates all storage-layer heights that can be built by stacking
+#' (and mixing) the given module heights, e.g. full blocks combined with
+#' at most one half block.
+#'
+#' @param modules Numeric vector of module heights in mm (e.g. `c(660, 350)`
+#' for a full block plus a half block).
+#' @param max_count Integer vector (recycled to `length(modules)`): maximum
+#' number of modules of each type in one stack. Defaults to 7 for every
+#' module (cf. GRAF EcoBloc smart, stackable up to 7 layers).
+#' @param max_height Maximum total stack height in mm (default 2600).
+#'
+#' @return Sorted numeric vector of achievable stack heights in mm.
+#'
+#' @examples
+#' stack_levels(360) # 360, 720, ..., 2520
+#' stack_levels(c(660, 350), max_count = c(7, 1)) # Rigofill full + half block
+#'
+#' @export
+stack_levels <- function(modules,
+ max_count = rep(7L, length(modules)),
+ max_height = 2600) {
+ stopifnot(is.numeric(modules), all(modules > 0))
+ max_count <- rep_len(as.integer(max_count), length(modules))
+ counts <- Map(function(m, k) 0:min(k, floor(max_height / m)),
+ modules, max_count)
+ grid <- do.call(expand.grid, counts)
+ h <- as.vector(as.matrix(grid) %*% modules)
+ sort(unique(h[h > 0 & h <= max_height]))
+}
+
+#' Sickerbox storage-height presets (brute force default + manufacturers)
+#'
+#' Named list of storage-height level vectors (mm) for the infiltration-box
+#' storage layer. `brute_force` is the default used by the workflow
+#' vignettes (300/600/900/1200 mm -- itself a combination of several box
+#' types). The manufacturer presets are generated with [stack_levels()]
+#' from typical module heights of commercial block systems; verify against
+#' the current data sheets before productive optimisation runs.
+#'
+#' @param max_height Maximum total stack height in mm passed to
+#' [stack_levels()] (default 2600).
+#'
+#' @return Named list of sorted numeric vectors (mm).
+#'
+#' @export
+sickerbox_level_presets <- function(max_height = 2600) {
+ list(
+ brute_force = c(300, 600, 900, 1200),
+ graf_ecobloc_smart = stack_levels(360, max_height = max_height),
+ graf_ecobloc_420 = stack_levels(660, max_height = max_height),
+ fraenkische_rigofill = stack_levels(c(660, 350), max_count = c(7L, 1L),
+ max_height = max_height),
+ aco_stormbrixx_hd = stack_levels(614, max_height = max_height),
+ aco_stormbrixx_sd = stack_levels(342, max_height = max_height),
+ wavin_aquacell = stack_levels(400, max_height = max_height)
+ )
+}
+
+#' Default storage specification for the swale-design optimiser
+#'
+#' Storage-layer search space per storage type: the infiltration box uses
+#' discrete stack levels (default: the brute-force grid levels), the gravel
+#' trench is continuous with bounds coupled to the box level range by
+#' `coupling_factor` (default 3, approximating the usable-porosity ratio
+#' 0.95 / 0.3).
+#'
+#' Each entry also carries the **usable porosity** of the storage layer
+#' (box 0.95, trench 0.3, matching [default_storage_types()]). The
+#' bisection optimiser uses it to *derive* its search order from the
+#' cost rates (cost per mm of storage capacity); without a `porosity`
+#' entry it falls back to the default-rate hierarchy (smallest storage
+#' level first).
+#'
+#' @param levels Numeric vector of infiltration-box stack heights in mm.
+#' @param coupling_factor Factor between gravel-trench bounds and the box
+#' level range.
+#' @param gravel_tol Bisection tolerance for the continuous gravel-trench
+#' height in mm.
+#'
+#' @return Named list with entries `infiltration_box` (with `levels` and
+#' `porosity`) and `gravel_trench` (with `bounds`, `tol` and
+#' `porosity`).
+#'
+#' @export
+default_storage_spec <- function(levels = sickerbox_level_presets()$brute_force,
+ coupling_factor = 3,
+ gravel_tol = 25) {
+ list(
+ infiltration_box = list(levels = sort(unique(levels)),
+ porosity = 0.95),
+ gravel_trench = list(bounds = coupling_factor * range(levels),
+ tol = gravel_tol,
+ porosity = 0.3)
+ )
+}
+
+#' Default storage-type soil presets (Speicher layer)
+#'
+#' Soil parameters of the storage (2nd Bodenschichtung) layer per storage
+#' type, as used by the workflow vignettes: infiltration box ("Sickerbox",
+#' thetaS 0.95) and gravel trench ("Schotterrigol", thetaS 0.3).
+#'
+#' @return Named list (per storage type) of lists with
+#' `Startwerte_theta_ActualSoilMoisture`, `thetaWP_MoistureAtWiltingPoint`,
+#' `thetaFC_MoistureAtFieldCapacity`, `thetaS_MoistureAtSaturation`.
+#'
+#' @export
+default_storage_types <- function() {
+ list(
+ infiltration_box = list(
+ Startwerte_theta_ActualSoilMoisture = 0,
+ thetaWP_MoistureAtWiltingPoint = 0,
+ thetaFC_MoistureAtFieldCapacity = 0,
+ thetaS_MoistureAtSaturation = 0.95
+ ),
+ gravel_trench = list(
+ Startwerte_theta_ActualSoilMoisture = 0,
+ thetaWP_MoistureAtWiltingPoint = 0,
+ thetaFC_MoistureAtFieldCapacity = 0,
+ thetaS_MoistureAtSaturation = 0.3
+ )
+ )
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 41550e7..016636d 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -4,8 +4,8 @@ authors:
href: https://www.kompetenz-wasser.de/en/ueber-uns/team/michael-rustler
RAINDROP:
href: https://www.kompetenz-wasser.de/en/forschung/projekte/raindrop
- # html: 
+ html: 
Kompetenzzentrum Wasser Berlin gGmbH (KWB):
href: http://www.kompetenz-wasser.de
html: 
_} and \verb{connectedarea._} \code{NA}-filled stub columns to
-such rows so the rendered datatable still exposes the expected column
-structure. Defaults to \code{NULL} (no canonical fallback).}
+without the trailing \verb{_}), e.g. \code{default_canonical_wb_variables()}.
+This is a \strong{per-scenario} fallback: for any scenario whose
+\code{wb_element} and \code{wb_connectedarea} are both empty after the regular
+pivot / mirror logic (including scenarios that are entirely \code{NULL}),
+the function attaches \verb{element._} and \verb{connectedarea._}
+\code{NA}-filled stub columns built from this list. This guarantees the
+output tibble keeps the expected water-balance column structure even
+when no scenario contributes real data — \code{dplyr::bind_rows()} would
+otherwise drop columns that no row supplies. Defaults to \code{NULL} (no
+canonical fallback).}
}
\value{
A tibble with one row per scenario containing:
diff --git a/man/cost_rates_caption.Rd b/man/cost_rates_caption.Rd
new file mode 100644
index 0000000..4001158
--- /dev/null
+++ b/man/cost_rates_caption.Rd
@@ -0,0 +1,34 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/compute_costs.R
+\name{cost_rates_caption}
+\alias{cost_rates_caption}
+\title{Caption line naming the unit-cost rates behind the cost plots}
+\usage{
+cost_rates_caption(lang = c("de", "en"), cost_rates = default_cost_rates())
+}
+\arguments{
+\item{lang}{Character. \code{"de"} or \code{"en"}.}
+
+\item{cost_rates}{\code{list} of unit costs as returned by
+\code{\link[=default_cost_rates]{default_cost_rates()}}.}
+}
+\value{
+\code{character(1)}, a single line.
+}
+\description{
+Formats the unit-cost rates (EUR per m2 / m3, see \code{\link[=default_cost_rates]{default_cost_rates()}})
+as a single-line caption for the cost plots, so every figure names the
+rates its EUR values were computed with. Used as the default \code{caption} of
+\code{\link[=plot_cost_vs_overflow_volume]{plot_cost_vs_overflow_volume()}}, \code{\link[=plot_cost_vs_evaporation]{plot_cost_vs_evaporation()}} and
+\code{\link[=plot_cost_overflow_boxplot]{plot_cost_overflow_boxplot()}} (rendered by ggplot at the bottom of the
+PDFs) and passed to \code{\link[=plotly_add_caption]{plotly_add_caption()}} for the interactive HTMLs
+(\code{plotly::ggplotly()} drops ggplot captions).
+}
+\details{
+If the costs were computed with non-default rates, pass the same
+\code{cost_rates} list here so the caption matches the numbers.
+}
+\examples{
+cost_rates_caption("de")
+
+}
diff --git a/man/default_param_labels.Rd b/man/default_param_labels.Rd
new file mode 100644
index 0000000..b79e588
--- /dev/null
+++ b/man/default_param_labels.Rd
@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/cost_tooltip.R
+\name{default_param_labels}
+\alias{default_param_labels}
+\title{German / English labels for optimisation parameter-grid columns}
+\usage{
+default_param_labels(lang = c("de", "en"))
+}
+\arguments{
+\item{lang}{Character. \code{"de"} or \code{"en"}.}
+}
+\value{
+A named \code{character} vector: names are \code{param_grid} column names,
+values are the display labels.
+}
+\description{
+Maps the raw \code{param_grid} column names produced by the case-study workflows
+to human-readable, unit-carrying labels. Used to translate the
+"varying parameters" block in the interactive tooltips of
+\code{\link[=plot_cost_vs_overflow_volume]{plot_cost_vs_overflow_volume()}} and \code{\link[=plot_cost_overflow_boxplot]{plot_cost_overflow_boxplot()}}, so a
+hovered point shows e.g. \code{Muldenflaeche [m2]=125} instead of the raw
+\code{mulde_area=125}.
+}
+\details{
+Unknown columns fall back to their raw name, so a grid gaining a new column
+still renders (just untranslated). Override individual entries or pass your
+own named vector via the \code{param_labels} argument of the plot functions.
+}
+\examples{
+default_param_labels("de")[["mulde_area"]]
+default_param_labels("en")[["storage_height"]]
+}
diff --git a/man/default_storage_spec.Rd b/man/default_storage_spec.Rd
new file mode 100644
index 0000000..4f26657
--- /dev/null
+++ b/man/default_storage_spec.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/stack_levels.R
+\name{default_storage_spec}
+\alias{default_storage_spec}
+\title{Default storage specification for the swale-design optimiser}
+\usage{
+default_storage_spec(
+ levels = sickerbox_level_presets()$brute_force,
+ coupling_factor = 3,
+ gravel_tol = 25
+)
+}
+\arguments{
+\item{levels}{Numeric vector of infiltration-box stack heights in mm.}
+
+\item{coupling_factor}{Factor between gravel-trench bounds and the box
+level range.}
+
+\item{gravel_tol}{Bisection tolerance for the continuous gravel-trench
+height in mm.}
+}
+\value{
+Named list with entries \code{infiltration_box} (with \code{levels} and
+\code{porosity}) and \code{gravel_trench} (with \code{bounds}, \code{tol} and
+\code{porosity}).
+}
+\description{
+Storage-layer search space per storage type: the infiltration box uses
+discrete stack levels (default: the brute-force grid levels), the gravel
+trench is continuous with bounds coupled to the box level range by
+\code{coupling_factor} (default 3, approximating the usable-porosity ratio
+0.95 / 0.3).
+}
+\details{
+Each entry also carries the \strong{usable porosity} of the storage layer
+(box 0.95, trench 0.3, matching \code{\link[=default_storage_types]{default_storage_types()}}). The
+bisection optimiser uses it to \emph{derive} its search order from the
+cost rates (cost per mm of storage capacity); without a \code{porosity}
+entry it falls back to the default-rate hierarchy (smallest storage
+level first).
+}
diff --git a/man/default_storage_types.Rd b/man/default_storage_types.Rd
new file mode 100644
index 0000000..7e951c0
--- /dev/null
+++ b/man/default_storage_types.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/stack_levels.R
+\name{default_storage_types}
+\alias{default_storage_types}
+\title{Default storage-type soil presets (Speicher layer)}
+\usage{
+default_storage_types()
+}
+\value{
+Named list (per storage type) of lists with
+\code{Startwerte_theta_ActualSoilMoisture}, \code{thetaWP_MoistureAtWiltingPoint},
+\code{thetaFC_MoistureAtFieldCapacity}, \code{thetaS_MoistureAtSaturation}.
+}
+\description{
+Soil parameters of the storage (2nd Bodenschichtung) layer per storage
+type, as used by the workflow vignettes: infiltration box ("Sickerbox",
+thetaS 0.95) and gravel trench ("Schotterrigol", thetaS 0.3).
+}
diff --git a/man/download_engine.Rd b/man/download_engine.Rd
index d4969d5..d131caa 100644
--- a/man/download_engine.Rd
+++ b/man/download_engine.Rd
@@ -12,14 +12,14 @@ download_engine(
}
\arguments{
\item{version}{\code{character(1)}
-Engine release version, matching the part after \code{engine-} in the
-\code{KWB-R/kwb.raindrop.binaries} Release tag. Defaults to the
-package's pinned version.}
+Engine release version, matching the part after \verb{engine-} in the
+\code{KWB-R/kwb.raindrop.binaries} Release tag. Defaults to the package's
+pinned version.}
\item{cache_dir}{\code{character(1)}
Directory where engine binaries are cached. A sub-directory named after
\code{version} is used so multiple versions can coexist. Defaults to
-\code{\link[tools:R_user_dir]{tools::R_user_dir}}\code{("kwb.raindrop", "cache")}.}
+\code{\link[tools:R_user_dir]{tools::R_user_dir}}\verb{("kwb.raindrop", "cache")}.}
\item{force}{\code{logical(1)}
If \code{TRUE}, re-download even if the executable already exists in the
@@ -36,9 +36,9 @@ are no-ops once the file is present.
}
\details{
Releases in \code{KWB-R/kwb.raindrop.binaries} follow the tag scheme
-\code{engine-} and contain a single asset named
-\code{Regenwasserbewirtschaftung.exe} (the version is encoded in the
-tag, not in the filename, so multiple engine versions can coexist
+\verb{engine-} and contain a single asset named
+\code{Regenwasserbewirtschaftung.exe} (the version is encoded in the tag,
+not in the filename, so multiple engine versions can coexist
side-by-side in the cache).
The executable is a Windows binary; on non-Windows platforms the file is
diff --git a/man/find_min_feasible.Rd b/man/find_min_feasible.Rd
new file mode 100644
index 0000000..5ab26cc
--- /dev/null
+++ b/man/find_min_feasible.Rd
@@ -0,0 +1,93 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/find_min_feasible.R
+\name{find_min_feasible}
+\alias{find_min_feasible}
+\title{Smallest feasible parameter value via bisection (monotone threshold search)}
+\usage{
+find_min_feasible(
+ evaluate,
+ x_max,
+ lower = NULL,
+ upper = NULL,
+ tol = 1,
+ levels = NULL,
+ wobble = 1L,
+ split_jitter = 0,
+ volume_column = "overflow_volume_m3",
+ verbose = FALSE
+)
+}
+\arguments{
+\item{evaluate}{\verb{function(value)} returning a list / one-row data.frame
+with at least \code{n_overflows}; if it also contains \code{volume_column}, the
+volume referee is active. Evaluations are memoised per value.}
+
+\item{x_max}{Feasibility target: feasible iff \code{n_overflows <= x_max}.}
+
+\item{lower, upper}{Numeric search bounds (continuous mode).}
+
+\item{tol}{Resolution of the continuous search (same unit as the value).}
+
+\item{levels}{Sorted numeric vector of discrete candidate values
+(discrete mode, e.g. Sickerbox stack heights). If given, \code{lower},
+\code{upper} and \code{tol} are ignored and a binary search over the levels is
+performed.}
+
+\item{wobble}{Maximum counting-artefact size tolerated by the edge guard
+(default 1, matching the observed +1 flips).}
+
+\item{split_jitter}{Numeric in \verb{[0, 0.45]}, default 0. With 0 the
+interval is split exactly in half (deterministic). A positive value
+draws the split fraction uniformly from \code{0.5 +- split_jitter} --
+a Monte-Carlo of the \emph{search path}: repeated runs with different
+seeds take different routes to the threshold and must agree within
+\code{tol} if the result is a property of the problem, not of the path.}
+
+\item{volume_column}{Name of the volume element in the \code{evaluate} result
+used by the volume referee (default \code{"overflow_volume_m3"}).}
+
+\item{verbose}{Print one line per evaluation.}
+}
+\value{
+List with
+\describe{
+\item{value}{smallest feasible value, or \code{NA} if infeasible}
+\item{n_overflows}{overflow count at \code{value}}
+\item{status}{\code{"ok"}, \code{"at_lower_bound"} (already feasible at the lower
+end -- caller may widen the bracket) or \code{"infeasible"}}
+\item{evaluations}{tibble of all evaluated values (value, n_overflows,
+volume), sorted by value}
+\item{n_evaluations}{number of distinct evaluations}
+\item{monotonicity_violation}{\code{TRUE} if the volume referee fired}
+}
+}
+\description{
+Core building block of the swale-design optimiser: finds the smallest
+value of one design parameter for which the overflow target is met
+(\code{n_overflows <= x_max}), assuming quasi-monotone feasibility (larger
+value = never more overflows; verified for the RAINDROP model in the
+monotonicity analysis,
+\url{https://raindrop.kompetenz-wasser.io/optimisation/monotonicity_analysis/}).
+Each evaluation halves the search interval, so
+\code{ceiling(log2(range / tol))} evaluations suffice.
+}
+\details{
+Two safety rules from the monotonicity analysis are built in:
+\itemize{
+\item \strong{Edge guard}: if the upper bound is infeasible by no more
+than \code{wobble} events (the +1 counting artefact of the 4-h event
+separation), a descending ladder below the edge searches for a
+feasible anchor before the branch is declared infeasible.
+\item \strong{Volume referee}: whenever \code{n_overflows} increases with
+the parameter (a counting flip), the overflow volume must have
+decreased; if the volume increased as well, a warning is emitted and
+\code{monotonicity_violation} is set (real non-monotonicity -- never
+observed at the three validation sites).
+}
+}
+\examples{
+# synthetic monotone step function: feasible from 137.4 m2 on
+f <- function(v) list(n_overflows = if (v >= 137.4) 0L else 10L)
+find_min_feasible(f, x_max = 0, lower = 25, upper = 200, tol = 2)$value
+
+}
diff --git a/man/get_simulation_results_optim.Rd b/man/get_simulation_results_optim.Rd
index 1c7d586..1a1c68b 100644
--- a/man/get_simulation_results_optim.Rd
+++ b/man/get_simulation_results_optim.Rd
@@ -4,7 +4,13 @@
\alias{get_simulation_results_optim}
\title{Read Raindrop optimisation simulation results from HDF5}
\usage{
-get_simulation_results_optim(paths, path_list, simulation_names, debug = TRUE)
+get_simulation_results_optim(
+ paths,
+ path_list,
+ simulation_names,
+ debug = TRUE,
+ lean = FALSE
+)
}
\arguments{
\item{paths}{A list of path definitions. Used for messaging and expected to
@@ -20,6 +26,14 @@ run-specific paths (must yield \code{path_results_hdf5_element},
(e.g. \code{c("s00001", "s00002")}).}
\item{debug}{print debug messages (default: TRUE)}
+
+\item{lean}{Logical. If \code{TRUE}, read only the fields consumed by
+\code{\link{add_overflow_events_and_waterbalance}} -- \code{element$rates},
+\code{element$water_balance} and \code{connected_area$water_balance} -- and
+leave \code{meta}/\code{states} (both sides) and \code{connected_area$rates}
+as \code{NULL}. This keeps per-run memory and I/O minimal when each run is
+thinned to its optimisation row immediately instead of collecting every
+run's full results first. Defaults to \code{FALSE} (read everything).}
}
\value{
A named list with one entry per \code{simulation_names}. Each entry is
diff --git a/man/make_swale_runner.Rd b/man/make_swale_runner.Rd
new file mode 100644
index 0000000..b42c579
--- /dev/null
+++ b/man/make_swale_runner.Rd
@@ -0,0 +1,97 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/make_swale_runner.R
+\name{make_swale_runner}
+\alias{make_swale_runner}
+\title{Create a site-specific single-scenario runner for the optimiser}
+\usage{
+make_swale_runner(
+ path_list,
+ timestep_hours = 0.1,
+ timeseries_rain = NULL,
+ timeseries_et = NULL,
+ storage_types = default_storage_types(),
+ event_separation_hours = 4,
+ scenario_prefix = "o",
+ cleanup = TRUE,
+ debug = FALSE
+)
+}
+\arguments{
+\item{path_list}{Path definition list as used by the workflow vignettes
+(resolvable with \code{kwb.utils::resolve()}, must contain \code{path_base},
+\code{path_exe}, \code{dir_input}, \code{dir_output}, \code{dir_target_output},
+\code{path_target_input}, \code{path_results_hdf5_element},
+\code{path_results_hdf5_flaeche}, \code{file_target}).}
+
+\item{timestep_hours}{Engine time step in hours (default 0.1).}
+
+\item{timeseries_rain}{Optional data.frame \code{time}/\code{value} (mm/h) written
+to \verb{//Kurven/Regen} (the dataset must exist in \code{base.h5}); when
+given, the \verb{//Kurven/Growth_1} and \verb{//Kurven/Shading_1} end times
+are extended to the rain series end (skipped for templates without
+these curves) and \code{rain_factor} is ignored. Without
+\code{timeseries_rain}, a per-run \code{rain_factor != 1} requires
+\verb{//Kurven/Regen} to exist as a time series in \code{base.h5} -- a clear
+error is thrown otherwise.}
+
+\item{timeseries_et}{Optional data.frame \code{time}/\code{value} (mm/h) written
+to \verb{//Kurven/ET0}.}
+
+\item{storage_types}{Soil presets of the storage layer per storage type,
+see \code{\link[=default_storage_types]{default_storage_types()}}.}
+
+\item{event_separation_hours}{Event separation for overflow counting
+(default 4, as in the vignettes and the monotonicity analysis).}
+
+\item{scenario_prefix}{Prefix for generated scenario names (default
+\code{"o"} -> \code{o00001}, \code{o00002}, ... -- distinct from the grid runs
+\code{s00001} ...).}
+
+\item{cleanup}{Delete each scenario's copied input file and output
+directory right after the thinned one-row result has been read
+(default \code{TRUE}). The optimisers only need that row; without the
+cleanup an optimisation run (hundreds of engine runs per task, each
+with its own copy of \code{base.h5} plus all output HDF5s) fills the
+temp drive and the engine aborts with HDF5 \code{errno = 28} ("No space
+left on device"). Set \code{FALSE} to keep all scenario files for
+debugging. Files of a \emph{failed} run are always kept.}
+
+\item{debug}{Passed on to the engine/reader helpers.}
+}
+\value{
+\verb{function(params)} where \code{params} is a named list (or one-row
+data.frame) with \code{mulde_area}, \code{mulde_height} (mm), \code{storage_type},
+\code{storage_height} (mm), \code{connected_area} (m2), \code{filter_height} (mm),
+\code{filter_hydraulicconductivity} (mm/h), \code{bottom_hydraulicconductivity}
+(mm/h) and optionally \code{rain_factor} (default 1) and \code{lai}
+(default 3.9). It returns a one-row tibble with the parameters, the
+scenario name and the optimisation metrics (\code{n_overflows},
+\code{sum_overflows} in mm, \code{overflow_volume_m3}, water-balance shares).
+}
+\description{
+Factors the \code{run_one()} function that was duplicated across the three
+workflow vignettes (Eisenstadt 2005, Wien, Bad Aussee) into one
+package-level closure factory. The returned function runs the RAINDROP
+engine for one parameter set and returns the thinned one-row
+optimisation result (overflow events + water balance), augmented with
+the input parameters and the overflow volume in m3.
+}
+\details{
+Site differences are covered by the arguments: Eisenstadt scales the
+rain curve shipped in \code{base.h5} by \code{rain_factor} (leave
+\code{timeseries_rain} = \code{NULL}), Wien and Bad Aussee replace the rain and
+ET0 curves entirely (\code{timeseries_rain} / \code{timeseries_et}, values in
+mm/h as written by the vignettes).
+
+On the first call the runner prepares a \strong{site master file} once:
+\code{base.h5} plus everything identical for every run (calculation
+settings, ET/rain time series). Each run then copies the master and
+writes only its ~15 small parameter datasets. Compared to the
+previous full read/rewrite of \emph{all} datasets per run this removes
+the dominant per-run overhead of the optimisation searches
+(hundreds of runs; for Wien / Bad Aussee it skips rewriting the
+15-year rain series on every single engine run).
+}
+\seealso{
+\code{\link[=optimise_swale_design]{optimise_swale_design()}}, \code{\link[=find_min_feasible]{find_min_feasible()}}
+}
diff --git a/man/optimise_swale_design.Rd b/man/optimise_swale_design.Rd
new file mode 100644
index 0000000..c181baf
--- /dev/null
+++ b/man/optimise_swale_design.Rd
@@ -0,0 +1,117 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/optimise_swale_design.R
+\name{optimise_swale_design}
+\alias{optimise_swale_design}
+\title{Find the cost-optimal swale design per overflow target}
+\usage{
+optimise_swale_design(
+ run_fn,
+ x_targets = 0:5,
+ area_bounds = c(25, 200),
+ area_tol = 2,
+ height_bounds = c(100, 300),
+ height_tol = 10,
+ storage_spec = default_storage_spec(),
+ fixed = list(connected_area = 1000, filter_height = 300, filter_hydraulicconductivity =
+ 360, bottom_hydraulicconductivity = 12),
+ prior_results = NULL,
+ split_jitter = 0,
+ max_total_depth = NULL,
+ cost_rates = default_cost_rates(),
+ verbose = TRUE
+)
+}
+\arguments{
+\item{run_fn}{\verb{function(params)} running one scenario and returning at
+least \code{n_overflows} plus \code{sum_overflows} (mm) or \code{overflow_volume_m3};
+typically created with \code{\link[=make_swale_runner]{make_swale_runner()}}. \code{params} is a named list
+of \code{mulde_area}, \code{mulde_height}, \code{storage_type}, \code{storage_height} plus
+everything in \code{fixed}.}
+
+\item{x_targets}{Integer vector of overflow targets (feasible :<=>
+\code{n_overflows <= x}), default \code{0:5}.}
+
+\item{area_bounds, area_tol}{Search range (m2) and resolution for
+\code{mulde_area}. The found area sits up to one \code{area_tol} above the
+exact feasibility boundary (worst-case cost overshoot roughly
+\code{area_tol} x specific cost per m2, i.e. a few percent at the
+default 2 m2); thanks to the bisection, every \emph{halving} of
+\code{area_tol} costs only one additional engine run per area search --
+the cheapest precision lever of this optimiser. It also shrinks
+the tolerance-artefact part of the final \code{mulde_height} trim (the
+values just below the height maximum at low \code{x_targets}).}
+
+\item{height_bounds, height_tol}{Search range (mm) and resolution for
+\code{mulde_height}.}
+
+\item{storage_spec}{Storage search space per type, see
+\code{\link[=default_storage_spec]{default_storage_spec()}}: discrete \code{levels} (infiltration box) or
+continuous \code{bounds} + \code{tol} (gravel trench).}
+
+\item{fixed}{Named list of parameters passed unchanged to \code{run_fn}
+(connected area, filter geometry, kf at maximum, ...). Must contain
+\code{filter_height} for the cost model.}
+
+\item{prior_results}{Optional data.frame with prior (grid) results in
+the workflow CSV schema, used as warm start (narrows the first area
+bracket to one grid step).}
+
+\item{split_jitter}{Passed to \code{\link[=find_min_feasible]{find_min_feasible()}}: 0 (default) =
+deterministic halving; > 0 randomises every bisection split point
+(Monte-Carlo of the search path -- repeated runs with different
+seeds must agree within the search tolerances).}
+
+\item{max_total_depth}{Optional analytic depth constraint in mm:
+\code{mulde_height + filter_height + storage_height <= max_total_depth}
+(e.g. from DWA-A 138 groundwater clearance or cover requirements).
+Enforced without any simulation runs.}
+
+\item{cost_rates}{Unit costs, see \code{\link[=default_cost_rates]{default_cost_rates()}}.}
+
+\item{verbose}{Print one progress line per solved cell.}
+}
+\value{
+Tibble with one row per (storage type, x): the optimal design
+(\code{mulde_area}, \code{mulde_height}, \code{storage_height}), its metrics
+(\code{n_overflows}, \code{overflow_volume_m3}, \code{et_pct}), cost columns from
+\code{\link[=compute_costs]{compute_costs()}}, a \code{status} (\code{"ok"} or \code{"infeasible_within_bounds"}),
+\code{monotonicity_warning} (volume referee) and \code{n_runs_new} (fresh engine
+runs spent on this cell). All evaluated designs are attached as
+attribute \code{"evaluations"}.
+}
+\description{
+Coordinate-descent optimiser built from a single primitive
+(\code{\link[=find_min_feasible]{find_min_feasible()}}, bisection over one parameter): shrink the
+expensive lever first (\code{mulde_area}), then the cheap one
+(\code{mulde_height}); the storage layer starts at its smallest level and is
+only escalated when the area is stuck at its upper bound. The filter
+conductivity is expected to be fixed at the maximum via \code{fixed} (it is
+cost-free and dominant, see the monotonicity analysis,
+\url{https://raindrop.kompetenz-wasser.io/optimisation/monotonicity_analysis/}).
+Every engine run is cached, so the sweep over all \code{x_targets} and both
+storage types shares evaluations.
+}
+\details{
+\strong{The search order is derived from \code{cost_rates}} via a
+specific-cost proxy (EUR per mm of storage capacity, capacity model
+\code{V ~ area * (mulde_height + porosity * storage_height)}; the layer
+porosity comes from \code{storage_spec}, see \code{\link[=default_storage_spec]{default_storage_spec()}}):
+maximising \code{mulde_height} first is optimal for \emph{any} rates under
+this cost model (it costs only excavation, while area pays every
+component), and the starting storage level is chosen as the
+cheapest level per mm of capacity -- the smallest level under the
+default rates, a high level when e.g. the storage material is cheap.
+Without a \code{porosity} entry in \code{storage_spec} the legacy order
+(smallest level first) is used. The proxy is a first-order
+heuristic: it assumes capacity-additive levers and cannot rank
+parameters with nonlinear hydraulic effects (e.g. a variable filter
+conductivity) -- for those, and as the assumption-free cross-check,
+use \code{\link[=optimise_swale_design_simultaneous]{optimise_swale_design_simultaneous()}}, which carries
+\code{cost_rates} directly inside its objective.
+}
+\seealso{
+\code{\link[=optimise_swale_design_simultaneous]{optimise_swale_design_simultaneous()}} (alternative: all
+parameters at once via penalised Nelder-Mead, as an independent
+cross-check of the coordinate descent), \code{\link[=find_min_feasible]{find_min_feasible()}},
+\code{\link[=make_swale_runner]{make_swale_runner()}}, \code{\link[=default_storage_spec]{default_storage_spec()}}
+}
diff --git a/man/optimise_swale_design_simultaneous.Rd b/man/optimise_swale_design_simultaneous.Rd
new file mode 100644
index 0000000..6e80ae4
--- /dev/null
+++ b/man/optimise_swale_design_simultaneous.Rd
@@ -0,0 +1,203 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/optimise_swale_design_simultaneous.R
+\name{optimise_swale_design_simultaneous}
+\alias{optimise_swale_design_simultaneous}
+\title{Find the cost-optimal swale design by simultaneous parameter search}
+\usage{
+optimise_swale_design_simultaneous(
+ run_fn,
+ x_targets = 0:5,
+ area_bounds = c(25, 200),
+ area_tol = 2,
+ height_bounds = c(100, 300),
+ height_tol = 10,
+ storage_spec = default_storage_spec(),
+ fixed = list(connected_area = 1000, filter_height = 300, filter_hydraulicconductivity =
+ 360, bottom_hydraulicconductivity = 12),
+ prior_results = NULL,
+ method = c("nelder_mead", "diff_evolution", "halton_search"),
+ n_starts = 4,
+ max_evals = 80,
+ seed = 1,
+ wobble = 1L,
+ max_total_depth = NULL,
+ cost_rates = default_cost_rates(),
+ verbose = TRUE
+)
+}
+\arguments{
+\item{run_fn}{\verb{function(params)} running one scenario and returning at
+least \code{n_overflows} plus \code{sum_overflows} (mm) or \code{overflow_volume_m3};
+typically created with \code{\link[=make_swale_runner]{make_swale_runner()}}. \code{params} is a named list
+of \code{mulde_area}, \code{mulde_height}, \code{storage_type}, \code{storage_height} plus
+everything in \code{fixed}.}
+
+\item{x_targets}{Integer vector of overflow targets (feasible :<=>
+\code{n_overflows <= x}), default \code{0:5}.}
+
+\item{area_bounds, area_tol}{Search range (m2) and resolution for
+\code{mulde_area}.}
+
+\item{height_bounds, height_tol}{Search range (mm) and resolution for
+\code{mulde_height}.}
+
+\item{storage_spec}{Storage search space per type, see
+\code{\link[=default_storage_spec]{default_storage_spec()}}: discrete \code{levels} (infiltration box) or
+continuous \code{bounds} + \code{tol} (gravel trench).}
+
+\item{fixed}{Named list of parameters passed unchanged to \code{run_fn}
+(connected area, filter geometry, kf at maximum, ...). Must contain
+\code{filter_height} for the cost model.}
+
+\item{prior_results}{Optional data.frame with prior (grid) results in
+the workflow CSV schema, used as warm start (the cheapest feasible
+grid cell of the branch becomes the first start / seeds the
+population).}
+
+\item{method}{Search method, see Details: \code{"nelder_mead"} (default),
+\code{"diff_evolution"} or \code{"halton_search"} (the latter two mainly for
+comparison).}
+
+\item{n_starts}{Number of Nelder-Mead starts per (storage type, x)
+cell (default 4; only used by \code{method = "nelder_mead"}). Warm starts
+(prior, previous target) count towards this number, then the
+storage-ladder anchors, then the space-filling points.}
+
+\item{max_evals}{Soft cap on fresh engine runs per cell for the search
+phase: once reached, the search winds down (already cached designs
+remain free). The final multi-valley lattice polish adds its own
+runs on top (typically 20-50 per cell). Default 80 -- thanks to the
+shared cache the later \code{x_targets} of a storage type stay cheaper.}
+
+\item{seed}{Integer seed of the internal deterministic generator used
+by \code{method = "diff_evolution"} (ignored by the other methods). R's
+global RNG state is not touched.}
+
+\item{wobble}{Maximum counting-artefact size tolerated at the upper
+corner (default 1, matching the +1 event-counting wobble): only if
+the maximal design overflows by more than \code{wobble} events is the
+cell declared infeasible without a search.}
+
+\item{max_total_depth}{Optional analytic depth constraint in mm:
+\code{mulde_height + filter_height + storage_height <= max_total_depth}
+(e.g. from DWA-A 138 groundwater clearance or cover requirements).
+Enforced without any simulation runs.}
+
+\item{cost_rates}{Unit costs, see \code{\link[=default_cost_rates]{default_cost_rates()}}.}
+
+\item{verbose}{Print one progress line per solved cell.}
+}
+\value{
+Tibble with one row per (storage type, x), same schema as
+\code{\link[=optimise_swale_design]{optimise_swale_design()}} plus a \code{method} column: the optimal design
+(\code{mulde_area}, \code{mulde_height}, \code{storage_height}), its metrics
+(\code{n_overflows}, \code{overflow_volume_m3}, \code{et_pct}), cost columns from
+\code{\link[=compute_costs]{compute_costs()}}, a \code{status} (\code{"ok"} or
+\code{"infeasible_within_bounds"}), \code{monotonicity_warning} (\code{TRUE} if a
+strictly larger design produced more overflows \emph{and} more overflow
+volume among the cell's evaluations) and \code{n_runs_new} (fresh engine
+runs spent on this cell). All evaluated designs are attached as
+attribute \code{"evaluations"}.
+}
+\description{
+Alternative to the coordinate-descent optimiser
+(\code{\link[=optimise_swale_design]{optimise_swale_design()}}, bisection per parameter): all design
+parameters -- \code{mulde_area}, \code{mulde_height} and \code{storage_height} -- are
+optimised \strong{simultaneously}. Infeasible designs (\code{n_overflows > x})
+are not excluded but penalised (any infeasible design is worse than any
+feasible one; the number of excess events grades the penalty, steering
+the search back towards feasibility), so the search moves freely
+through the full parameter space and can trade the parameters against
+each other in a single step -- it does not rely on the per-parameter
+monotonicity that the bisection exploits.
+}
+\details{
+Three search \code{method}s share this penalised objective (plus cache,
+tolerance snapping and final lattice polish) and differ only in how
+they propose candidates:
+\itemize{
+\item \code{"nelder_mead"} (default): multistart Nelder-Mead simplex via
+\code{stats::optim()} -- the recommended method.
+\item \code{"diff_evolution"}: a compact differential evolution
+(DE/rand/1/bin, population 12, F = 0.7, CR = 0.9), included for
+comparison. Deterministic: it draws from an internal Park-Miller
+generator seeded with \code{seed} and leaves R's global RNG
+(\code{.Random.seed}) untouched.
+\item \code{"halton_search"}: quasi-random space-filling sampling
+(Halton sequence, bases 2/3/5) -- a deliberately simple baseline
+showing what the structured searches must beat.
+}
+
+Three ingredients keep the number of engine runs in check:
+\itemize{
+\item \strong{Snapping}: every candidate is snapped to the search
+tolerances (\code{area_tol}, \code{height_tol}, storage \code{tol} / discrete
+\code{levels}) before evaluation, so the shared cache absorbs repeated
+visits and the sweep over all \code{x_targets} reuses runs.
+\item \strong{Multistart}: \code{n_starts} deterministic starting points
+(prior warm start and the optimum of the previous overflow target
+first, then a \emph{storage ladder} -- one anchor start per storage
+level, smallest level first -- then fixed space-filling points)
+guard against the simplex stalling on the plateaus that the
+snapping and the integer overflow count create, and make sure every
+storage level competes: along the feasibility boundary the cost
+valley is flat, so the cheapest (usually smallest) storage level is
+easily missed from a single start. Different starts take different
+search paths -- the counterpart of \code{split_jitter} in the bisection
+optimiser. Every start receives an equal slice of the remaining
+\code{max_evals} budget (unused runs roll over).
+\item \strong{Lattice polish}: an accelerated pattern descent
+(steps of 8/4/2/1 tolerances downwards, cheaper by construction)
+runs from the cheapest feasible design of every storage level
+visited -- capped at the 6 cheapest levels, which only bites for
+the continuous gravel trench (the discrete box has at most a
+handful) -- because the storage axis separates cost valleys that
+single coordinate steps cannot cross. Besides the per-axis down
+steps each round proposes a \emph{boundary slide} (area down with
+\code{mulde_height} at its maximum -- the two-coordinate trade towards
+the cheap end of the feasibility boundary) and a
+\emph{mulde_height floor probe} (at large \code{x} the overflow count
+saturates, so the whole lower height range can be feasible even
+when a +1 counting wobble blocks every single step). All are just
+evaluated candidates -- no monotonicity assumption enters. The
+result is locally optimal on the tolerance lattice, whatever the
+search method delivered.
+}
+
+The discrete infiltration-box levels are mapped onto a continuous
+latent axis (each level owns an equal share of \verb{[0, 1]}), the gravel
+trench is searched continuously. The filter conductivity is expected to
+be fixed at the maximum via \code{fixed} (cost-free and dominant, see the
+monotonicity analysis,
+\url{https://raindrop.kompetenz-wasser.io/optimisation/monotonicity_analysis/}).
+\code{max_total_depth} is enforced by
+construction (the \code{mulde_height} axis is compressed to the remaining
+depth), so no simulation runs are spent on depth-invalid designs.
+
+Compared to \code{\link[=optimise_swale_design]{optimise_swale_design()}} this needs considerably more
+engine runs per cell (typically 60-120 instead of ~15; search phase
+plus multi-valley polish) but serves as an independent cross-check: it
+can discover cheaper corners of the design space that coordinate
+descent would miss if the parameter interaction were stronger than the
+monotonicity analysis suggests.
+}
+\examples{
+# synthetic monotone model: overflows fall with retention capacity
+run <- function(params) {
+ cap <- params$mulde_area *
+ (params$mulde_height + 0.95 * params$storage_height)
+ list(n_overflows = max(0, floor(3.6e5 / cap) - 3),
+ sum_overflows = 800 * max(0, 3.6e5 / cap - 3))
+}
+opt <- optimise_swale_design_simultaneous(
+ run, x_targets = 1,
+ storage_spec = default_storage_spec()["infiltration_box"],
+ verbose = FALSE
+)
+opt[, c("x", "mulde_area", "mulde_height", "storage_height", "cost_total")]
+
+}
+\seealso{
+\code{\link[=optimise_swale_design]{optimise_swale_design()}} (coordinate descent / bisection),
+\code{\link[=make_swale_runner]{make_swale_runner()}}, \code{\link[=default_storage_spec]{default_storage_spec()}}
+}
diff --git a/man/plot_cost_overflow_boxplot.Rd b/man/plot_cost_overflow_boxplot.Rd
new file mode 100644
index 0000000..8432989
--- /dev/null
+++ b/man/plot_cost_overflow_boxplot.Rd
@@ -0,0 +1,195 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot_cost_overflow_boxplot.R
+\name{plot_cost_overflow_boxplot}
+\alias{plot_cost_overflow_boxplot}
+\title{Cost boxplot per overflow-event count, points sized by overflow volume}
+\usage{
+plot_cost_overflow_boxplot(
+ simulation_results_optimisation,
+ param_grid,
+ x = 5,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ jitter_width = 0.2,
+ jitter_seed = 1L,
+ max_point_size = 6,
+ box_alpha = 0.35,
+ point_alpha = 0.6,
+ digits = 2L,
+ digits_params = 4L,
+ lang = c("de", "en"),
+ param_labels = NULL,
+ size_by = c("overflow_volume", "evapotranspiration"),
+ best_by = c("min_cost", "min_overflow", "max_evapotranspiration"),
+ y_var = c("cost_total", "cost_per_evap_pct"),
+ facet_storage_type = FALSE,
+ label_best = FALSE,
+ title = NULL,
+ lab_x = NULL,
+ lab_y = NULL,
+ caption = NULL,
+ lab_size = NULL,
+ mark_best = TRUE,
+ connect_best = TRUE,
+ legend_position = "right"
+)
+}
+\arguments{
+\item{simulation_results_optimisation}{Data frame with the columns
+\code{scenario_name}, \code{n_overflows}, \code{sum_overflows}, \code{mulde_area},
+\code{element.WB_Evapotranspiration_}, \code{element.WB_InfiltrationNetto_},
+\code{element.WB_Oberflaechenablauf_Ueberlauf_}, \code{cost_excavation},
+\code{cost_profiling}, \code{cost_filter}, \code{cost_storage}, \code{cost_total},
+\code{storage_type}. Typically the joined output of
+\code{\link[=add_overflow_events_and_waterbalance]{add_overflow_events_and_waterbalance()}} and \code{\link[=compute_costs]{compute_costs()}}.}
+
+\item{param_grid}{Data frame with parameter grid. Must contain
+\code{scenario_name}.}
+
+\item{x}{Numeric threshold. Counts \verb{0..x} each get their own box; counts
+\verb{> x} collapse into a single \code{">x"} box.}
+
+\item{filter_n_gtx}{Logical. If \code{TRUE}, scenarios with \code{n_overflows > x}
+are dropped (removing the \code{">x"} box) before plotting.}
+
+\item{use_jitter}{Logical. If \code{TRUE}, points are horizontally jittered.}
+
+\item{jitter_width}{Numeric. Horizontal jitter half-width.}
+
+\item{jitter_seed}{Integer. Seed for reproducible jitter.}
+
+\item{max_point_size}{Numeric. Point size for the largest (valid-region)
+\code{size_by} value; the smallest maps to a fixed minimum so no point vanishes.}
+
+\item{box_alpha, point_alpha}{Numeric in \verb{[0, 1]}. Box-fill / point opacity.}
+
+\item{digits}{Integer. Rounding for numeric values in the tooltip.}
+
+\item{digits_params}{Integer. Rounding for parameter values in the
+tooltip.}
+
+\item{lang}{Character. Plot language: \code{"de"} or \code{"en"}.}
+
+\item{param_labels}{Named character vector translating \code{param_grid} columns
+to tooltip labels, or \code{NULL} to use \code{\link[=default_param_labels]{default_param_labels()}} for \code{lang}.}
+
+\item{size_by}{Character. Which variable drives the point area (and its
+legend): \code{"overflow_volume"} (default, m3) or \code{"evapotranspiration"} (the
+element evapotranspiration share in \%, from \code{element.WB_Evapotranspiration_}
+-- larger points then mean \emph{more} evapotranspiration, which is desirable).}
+
+\item{best_by}{Character. Objective for the highlighted best scenario per
+box, with cost as the tie-breaker: \code{"min_cost"} (default; cheapest, ties
+broken by \code{scenario_name}), \code{"min_overflow"} (smallest overflow volume) or
+\code{"max_evapotranspiration"} (highest evapotranspiration). In the \code{">x"} box
+the fewest-overflow scenario is picked first, \code{best_by} then breaking ties.
+"Cost" always refers to the active \code{y_var}, so with
+\code{y_var = "cost_per_evap_pct"} the \code{"min_cost"} objective picks the
+scenario with the lowest cost per percentage point of evapotranspiration.}
+
+\item{y_var}{Character. Which cost measure the y-axis (boxes, points, best
+markers, frontier) shows: \code{"cost_total"} (default; total construction
+cost, EUR) or \code{"cost_per_evap_pct"} (total cost divided by the element
+evapotranspiration share \strong{above the reference minimum}, EUR per
+percentage point -- the marginal cost efficiency of evapotranspiration;
+the baseline comes "for free"). The reference is the \strong{lowest
+evapotranspiration among the scenarios that satisfy the validity
+criterion} (\code{n_overflows <= x}; fallback: the complete run when none
+does) and is named -- share, criterion and scenario id -- on a second
+title line. Scenarios at or below the reference (including the reference
+scenario itself) have no defined marginal cost and are dropped from the
+\code{"cost_per_evap_pct"} variant; \code{label_best = TRUE} additionally
+annotates the evapotranspiration gain (\code{"(+NN \% Evapotranspiration)"})
+after the price. Titles and the y-axis label switch accordingly.}
+
+\item{facet_storage_type}{Logical. If \code{TRUE}, the plot is split by
+\code{storage_type} into two stacked panels (infiltration box on top, gravel
+trench below, via \code{ggplot2::facet_grid()}), each with its own boxes,
+best-per-box markers and frontier line; the overlaid points then stay
+plain circles (the strips already name the type).
+\code{plotly::ggplotly()} keeps the panel split as stacked subplots.
+Default \code{FALSE}.}
+
+\item{label_best}{Logical. If \code{TRUE}, the best scenario per box is annotated
+next to it: overflow volume plus overflow share (\code{"NN m3 / NN \%"}) for
+\code{min_overflow}, the evapotranspiration share (\code{"NN \%"}) for
+\code{max_evapotranspiration}, or the active \code{y_var} value for \code{min_cost} --
+the total cost (\code{"NN EUR"}) by default, the cost per percentage point of
+evapotranspiration (\code{"NN EUR/\%"}) with \code{y_var = "cost_per_evap_pct"}.
+Default \code{FALSE}.}
+
+\item{title, lab_x, lab_y}{Optional character overrides for the default
+language-specific title / axis labels.}
+
+\item{caption}{Character or \code{NULL}. Caption below the plot naming the
+unit-cost rates the EUR values were computed with. \code{NULL} (default)
+uses \code{\link[=cost_rates_caption]{cost_rates_caption()}} with the \code{\link[=default_cost_rates]{default_cost_rates()}}; pass your
+own string if the costs were computed with different rates, or \code{""} to
+drop the caption. Note that \code{plotly::ggplotly()} drops ggplot captions
+-- re-add it to the interactive version via \code{\link[=plotly_add_caption]{plotly_add_caption()}}.}
+
+\item{lab_size}{Optional character override for the size-legend title.}
+
+\item{mark_best}{Logical. If \code{TRUE} (default), the best scenario per box
+(see \code{best_by}) is highlighted with a black-outlined diamond filled in
+that box's group colour, so its plotly tooltip inherits the group colour.}
+
+\item{connect_best}{Logical. If \code{TRUE} (default), the highlighted best
+scenarios of \strong{all} boxes (overflow counts \verb{0..x} plus the \code{">x"}
+catch-all) are connected by a line -- the best-per-overflow-level frontier.}
+
+\item{legend_position}{Character. Legend position, default \code{"right"}.}
+}
+\value{
+A \code{ggplot} object. Convert to interactive via
+\code{plotly::ggplotly(p, tooltip = "text")}.
+}
+\description{
+Companion to \code{\link[=plot_cost_vs_overflow_volume]{plot_cost_vs_overflow_volume()}}. For every number of overflow
+events (x-axis) it draws a boxplot of the total construction cost (y-axis,
+EUR) across all scenarios with that count, overlaid with the individual
+scenarios as jittered points whose \strong{size scales with \code{size_by}} --
+the overflow volume (\code{m3}, \code{sum_overflows} (\code{mm}) * \code{mulde_area} (\code{m2}) /
+1000; the default) or the element evapotranspiration share (\%). One best
+scenario per box is highlighted; \code{best_by} selects its objective -- cheapest,
+smallest overflow volume, or highest evapotranspiration (cost as
+tie-breaker) -- so the three variants trace three different frontier lines.
+\code{label_best} annotates the marker.
+}
+\details{
+Overflow counts greater than \code{x} are collapsed into a single \code{">x"}
+catch-all box (furthest right, coloured red), keeping the axis readable for
+the long-tailed 15-year runs (Wien / Bad Aussee reach several hundred
+overflow events). Its highlighted scenario is the one with the \strong{fewest}
+overflow events above \code{x} (closest to the valid region). Set \code{x} high to
+resolve more counts individually, or to \code{max(n_overflows)} to give every
+count its own box.
+
+The point tooltip is \strong{identical} to \code{\link[=plot_cost_vs_overflow_volume]{plot_cost_vs_overflow_volume()}}:
+scenario, overflow count / sum (\code{mm}) / volume (\code{m3}), the element water
+balance (evapotranspiration / infiltration / overflow, \%), the cost breakdown
+(EUR)
+and the varying \code{param_grid} parameters translated via \code{param_labels}.
+Points and boxes are coloured with the same green (low counts) to red
+(\code{">x"}) palette as the sibling plots; because the colour merely echoes the
+x-axis it carries no separate legend. When both storage types share one
+panel, the overlaid points are additionally \strong{shaped by the storage type}
+(filled square = infiltration box / Sickerbox, filled triangle = gravel
+trench / Schotterrigol), matching the scatter siblings, and a storage-type
+legend is shown next to the point-size legend. With \code{facet_storage_type = TRUE} the plot splits into two stacked storage-type panels instead; the
+facet strips then carry that information and the points stay \strong{plain
+circles} for readability. \code{y_var = "cost_per_evap_pct"} switches the
+y-axis to the cost per percentage point of evapotranspiration (EUR/\%).
+
+The point-size scale is calibrated to the valid region (\verb{0..x}): the extreme
+overflow volumes of the \code{">x"} catch-all are capped and a minimum size keeps
+even zero-volume points (the \code{0}-overflow box) visible, so the many-overflow
+outliers no longer shrink every valid-region point to an invisible dot.
+When the storage-type shapes are in use (no faceting), its legend keys are
+drawn with the storage-type marker (grey; the single present shape, or the
+square when both types are shown) instead of the default circle; the
+faceted variant uses circular points and matching circular keys.
+}
+\seealso{
+\code{\link[=plot_cost_vs_overflow_volume]{plot_cost_vs_overflow_volume()}}
+}
diff --git a/man/plot_cost_vs_evaporation.Rd b/man/plot_cost_vs_evaporation.Rd
new file mode 100644
index 0000000..9296a30
--- /dev/null
+++ b/man/plot_cost_vs_evaporation.Rd
@@ -0,0 +1,104 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot_cost_vs_evaporation.R
+\name{plot_cost_vs_evaporation}
+\alias{plot_cost_vs_evaporation}
+\title{Cost vs. evapotranspiration scatter with storage-type shapes}
+\usage{
+plot_cost_vs_evaporation(
+ simulation_results_optimisation,
+ param_grid,
+ x = 1,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ jitter_width = 0.15,
+ jitter_height = 0.15,
+ jitter_seed = 1L,
+ digits = 2L,
+ digits_params = 4L,
+ lang = c("de", "en"),
+ param_labels = NULL,
+ title = NULL,
+ lab_x = NULL,
+ lab_y = NULL,
+ caption = NULL,
+ legend_position = "top"
+)
+}
+\arguments{
+\item{simulation_results_optimisation}{Data frame with the columns
+\code{scenario_name}, \code{n_overflows}, \code{sum_overflows}, \code{mulde_area},
+\code{element.WB_Evapotranspiration_}, \code{element.WB_InfiltrationNetto_},
+\code{element.WB_Oberflaechenablauf_Ueberlauf_}, \code{cost_excavation},
+\code{cost_profiling}, \code{cost_filter}, \code{cost_storage}, \code{cost_total},
+\code{storage_type}. Typically the joined output of
+\code{\link[=add_overflow_events_and_waterbalance]{add_overflow_events_and_waterbalance()}} and \code{\link[=compute_costs]{compute_costs()}}.}
+
+\item{param_grid}{Data frame with parameter grid. Must contain
+\code{scenario_name}.}
+
+\item{x}{Numeric threshold for the overflow-count colour bucket. Values
+greater than \code{x} are pushed into the red \code{">x"} category.}
+
+\item{filter_n_gtx}{Logical. If \code{TRUE}, scenarios with \code{n_overflows > x}
+are dropped before plotting.}
+
+\item{use_jitter, jitter_width, jitter_height, jitter_seed}{As in
+\code{\link[=plot_wb_tradeoff_overflows]{plot_wb_tradeoff_overflows()}}.}
+
+\item{digits}{Integer. Rounding for numeric values in the tooltip.}
+
+\item{digits_params}{Integer. Rounding for parameter values in the
+tooltip.}
+
+\item{lang}{Character. Plot language: \code{"de"} or \code{"en"}.}
+
+\item{param_labels}{Named character vector translating \code{param_grid} columns
+to tooltip labels, or \code{NULL} to use \code{\link[=default_param_labels]{default_param_labels()}} for \code{lang}.}
+
+\item{title, lab_x, lab_y}{Optional character overrides for the default
+language-specific title / axis labels.}
+
+\item{caption}{Character or \code{NULL}. Caption below the plot naming the
+unit-cost rates the EUR values were computed with. \code{NULL} (default)
+uses \code{\link[=cost_rates_caption]{cost_rates_caption()}} with the \code{\link[=default_cost_rates]{default_cost_rates()}}; pass your
+own string if the costs were computed with different rates, or \code{""} to
+drop the caption. Note that \code{plotly::ggplotly()} drops ggplot captions
+-- re-add it to the interactive version via \code{\link[=plotly_add_caption]{plotly_add_caption()}}.}
+
+\item{legend_position}{Character. Legend position, default \code{"top"}.}
+}
+\value{
+A \code{ggplot} object. Convert to interactive via
+\code{plotly::ggplotly(p, tooltip = "text")}.
+}
+\description{
+Second companion to \code{\link{plot_cost_vs_overflow_volume}} for
+cost-aware optimisation. Plots the per-scenario \strong{total construction cost}
+(EUR) on the x-axis against the element \strong{evapotranspiration share} (\% of
+the total water input, from \code{element.WB_Evapotranspiration_}) on the
+y-axis. Points are coloured discretely by the \strong{number} of overflow events
+(same 0..x / >x palette used by the sibling plots, legend at the top) and
+\strong{shaped by the storage type}: filled square = infiltration box
+(Sickerbox), filled triangle = gravel trench (Schotterrigol).
+}
+\details{
+The tooltip is identical to \code{\link[=plot_cost_vs_overflow_volume]{plot_cost_vs_overflow_volume()}}: scenario,
+overflow count / sum (mm) / volume (m3), the element water balance
+(\code{element.WB_Evapotranspiration_}, \code{element.WB_InfiltrationNetto_},
+\code{element.WB_Oberflaechenablauf_Ueberlauf_}, all as \% of the total water
+input), the storage type, the usable storage volume of the storage layer
+(m3), the cost breakdown (\code{cost_excavation},
+\code{cost_profiling}, \code{cost_filter}, \code{cost_storage}, \code{cost_total}), the derived
+\strong{cost per percentage point of evapotranspiration} (EUR/\%) plus the
+varying parameters from \code{param_grid} (excluding \code{scenario_name}).
+
+The plot language can be switched via \code{lang = "de"} or \code{lang = "en"}.
+Titles / axis labels / legend / tooltip labels follow the choice unless
+explicit overrides are supplied.
+}
+\seealso{
+\code{\link[=plot_cost_vs_overflow_volume]{plot_cost_vs_overflow_volume()}} for cost vs. overflow volume and
+\code{\link[=plot_cost_overflow_boxplot]{plot_cost_overflow_boxplot()}} for the boxplot views (including
+\code{y_var = "cost_per_evap_pct"}, the cost per percentage point of
+evapotranspiration).
+}
diff --git a/man/plot_cost_vs_overflow_volume.Rd b/man/plot_cost_vs_overflow_volume.Rd
new file mode 100644
index 0000000..7599e76
--- /dev/null
+++ b/man/plot_cost_vs_overflow_volume.Rd
@@ -0,0 +1,109 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot_cost_vs_overflow_volume.R
+\name{plot_cost_vs_overflow_volume}
+\alias{plot_cost_vs_overflow_volume}
+\title{Cost vs. overflow-volume scatter with n_overflows-coloured points}
+\usage{
+plot_cost_vs_overflow_volume(
+ simulation_results_optimisation,
+ param_grid,
+ x = 1,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ jitter_width = 0.15,
+ jitter_height = 0.15,
+ jitter_seed = 1L,
+ digits = 2L,
+ digits_params = 4L,
+ lang = c("de", "en"),
+ param_labels = NULL,
+ title = NULL,
+ lab_x = NULL,
+ lab_y = NULL,
+ caption = NULL,
+ legend_position = "top"
+)
+}
+\arguments{
+\item{simulation_results_optimisation}{Data frame with the columns
+\code{scenario_name}, \code{n_overflows}, \code{sum_overflows}, \code{mulde_area},
+\code{element.WB_Evapotranspiration_}, \code{element.WB_InfiltrationNetto_},
+\code{element.WB_Oberflaechenablauf_Ueberlauf_}, \code{cost_excavation},
+\code{cost_profiling}, \code{cost_filter}, \code{cost_storage}, \code{cost_total},
+\code{storage_type}. Typically the joined output of
+\code{\link[=add_overflow_events_and_waterbalance]{add_overflow_events_and_waterbalance()}} and \code{\link[=compute_costs]{compute_costs()}}.}
+
+\item{param_grid}{Data frame with parameter grid. Must contain
+\code{scenario_name}.}
+
+\item{x}{Numeric threshold for the overflow-count colour bucket. Values
+greater than \code{x} are pushed into the red \code{">x"} category.}
+
+\item{filter_n_gtx}{Logical. If \code{TRUE}, scenarios with \code{n_overflows > x}
+are dropped before plotting.}
+
+\item{use_jitter, jitter_width, jitter_height, jitter_seed}{As in
+\code{\link[=plot_wb_tradeoff_overflows]{plot_wb_tradeoff_overflows()}}.}
+
+\item{digits}{Integer. Rounding for numeric values in the tooltip.}
+
+\item{digits_params}{Integer. Rounding for parameter values in the
+tooltip.}
+
+\item{lang}{Character. Plot language: \code{"de"} or \code{"en"}.}
+
+\item{param_labels}{Named character vector translating \code{param_grid} columns
+to tooltip labels, or \code{NULL} to use \code{\link[=default_param_labels]{default_param_labels()}} for \code{lang}.}
+
+\item{title, lab_x, lab_y}{Optional character overrides for the default
+language-specific title / axis labels.}
+
+\item{caption}{Character or \code{NULL}. Caption below the plot naming the
+unit-cost rates the EUR values were computed with. \code{NULL} (default)
+uses \code{\link[=cost_rates_caption]{cost_rates_caption()}} with the \code{\link[=default_cost_rates]{default_cost_rates()}}; pass your
+own string if the costs were computed with different rates, or \code{""} to
+drop the caption. Note that \code{plotly::ggplotly()} drops ggplot captions
+-- re-add it to the interactive version via \code{\link[=plotly_add_caption]{plotly_add_caption()}}.}
+
+\item{legend_position}{Character. Legend position, default \code{"top"}.}
+}
+\value{
+A \code{ggplot} object. Convert to interactive via
+\code{plotly::ggplotly(p, tooltip = "text")}.
+}
+\description{
+Companion to \code{\link{plot_wb_tradeoff_overflows}} for cost-aware
+optimisation. Plots the per-scenario \strong{total construction cost} (EUR) on
+the x-axis against the \strong{overflow volume} (m3) on the y-axis, with the
+points coloured discretely by the \strong{number} of overflow events (same
+0..x / >x palette used by \code{plot_wb_tradeoff_overflows}, legend at the top)
+and \strong{shaped by the storage type}: filled square = infiltration box
+(Sickerbox), filled triangle = gravel trench (Schotterrigol).
+}
+\details{
+Overflow volume is computed from \code{sum_overflows} (in mm on the swale
+surface, as returned by \code{\link[=add_overflow_events_and_waterbalance]{add_overflow_events_and_waterbalance()}})
+multiplied by \code{mulde_area} (m2) and converted to m3:
+\code{overflow_volume_m3 = sum_overflows * mulde_area / 1000}.
+
+The tooltip carries the element water balance
+(\code{element.WB_Evapotranspiration_}, \code{element.WB_InfiltrationNetto_},
+\code{element.WB_Oberflaechenablauf_Ueberlauf_}, all as \% of the total water
+input) and the cost breakdown (\code{cost_excavation}, \code{cost_profiling},
+\code{cost_filter}, \code{cost_storage}, \code{cost_total}), the derived \strong{cost per
+percentage point of evapotranspiration} (EUR/\%), the \strong{usable storage
+volume} of the storage layer (m3; area x height x usable porosity
+\code{thetaS - thetaFC}, from a \code{storage_volume_m3} column or derived from the
+\verb{storage_theta*} columns) plus the varying parameters from \code{param_grid}
+(excluding \code{scenario_name}), so the user can hover over a scatter point
+and see exactly why it landed where it did.
+
+The plot language can be switched via \code{lang = "de"} or \code{lang = "en"}.
+Titles / axis labels / legend / tooltip labels follow the choice unless
+explicit overrides are supplied.
+}
+\seealso{
+\code{\link[=plot_cost_overflow_boxplot]{plot_cost_overflow_boxplot()}} for the same data / tooltip shown as
+a cost-by-overflow-count boxplot and \code{\link[=plot_cost_vs_evaporation]{plot_cost_vs_evaporation()}} for
+cost vs. the element evapotranspiration share.
+}
diff --git a/man/plot_main_effects.Rd b/man/plot_main_effects.Rd
index be88794..b0e8778 100644
--- a/man/plot_main_effects.Rd
+++ b/man/plot_main_effects.Rd
@@ -45,6 +45,11 @@ median outcome values across parameter levels.
The function is intended for optimisation or sensitivity grids with many
parameters, where a single 2D scatter plot is not informative.
+Both numeric and character parameters are supported; a character parameter
+such as \code{storage_type} gets its own facet panel (its levels are shown
+as \code{Sickerbox} / \code{Schotterrigol} for \code{lang = "de"},
+\code{Infiltration box} / \code{Gravel trench} for \code{lang = "en"}).
+
The plot language can be switched via \code{lang = "de"} or
\code{lang = "en"}. This affects the title, y-axis label, and selected
parameter labels.
diff --git a/man/plot_valid_design_space.Rd b/man/plot_valid_design_space.Rd
index 98da154..f40f2e6 100644
--- a/man/plot_valid_design_space.Rd
+++ b/man/plot_valid_design_space.Rd
@@ -25,6 +25,7 @@ plot_valid_design_space(
alpha_min = 0.2,
alpha_max = 1,
keep_param_grid_limits = TRUE,
+ facet_storage_type = FALSE,
lang = c("de", "en"),
title = NULL,
subtitle = NULL,
@@ -96,6 +97,17 @@ same x/y. Default \code{"none"}.}
the full range or full set of levels found in \code{param_grid}, so the
design-space axes do not shrink after filtering. Default \code{TRUE}.}
+\item{facet_storage_type}{Logical. If \code{TRUE}, the design space is
+split by \code{storage_type} into two stacked panels (infiltration box on
+top, gravel trench below) with free y-scales, so disjoint per-type levels
+(e.g. \code{storage_height}: 300-1200 mm boxes vs. 900-3600 mm trenches)
+fill their own panel; duplicate counting for \code{alpha_mode =
+"duplicates"} then happens per panel and the points stay plain circles
+(the strips already name the type). Requires a \code{storage_type}
+column in \code{param_grid}. Without faceting, points are shaped by the
+storage type (filled square = infiltration box, filled triangle = gravel
+trench) whenever \code{storage_type} varies. Default \code{FALSE}.}
+
\item{lang}{Character. Plot language: \code{"de"} or \code{"en"}.}
\item{title}{Character or \code{NULL}. Plot title. If \code{NULL}, a
diff --git a/man/plot_wb_tradeoff_overflows.Rd b/man/plot_wb_tradeoff_overflows.Rd
index 5ef1d63..887ca09 100644
--- a/man/plot_wb_tradeoff_overflows.Rd
+++ b/man/plot_wb_tradeoff_overflows.Rd
@@ -90,5 +90,13 @@ The plot language can be switched via \code{lang = "de"} or
tooltip labels unless custom labels are supplied explicitly.
Tooltip text additionally includes all parameters from \code{param_grid} that
-vary across scenarios, excluding \code{scenario_name}.
+vary across scenarios, excluding \code{scenario_name} (translated via
+\code{\link{default_param_labels}}; mixed numeric / character parameters
+such as \code{storage_type} are supported).
+
+If \code{simulation_results_optimisation} carries a \code{storage_type}
+column, the points are additionally \strong{shaped by the storage type} (filled
+square = infiltration box / Sickerbox, filled triangle = gravel trench /
+Schotterrigol, as in the cost plots) and the tooltip names the storage
+type; older single-type result sets plot exactly as before.
}
diff --git a/man/plotly_add_caption.Rd b/man/plotly_add_caption.Rd
new file mode 100644
index 0000000..d7424bd
--- /dev/null
+++ b/man/plotly_add_caption.Rd
@@ -0,0 +1,36 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plotly_split_legend.R
+\name{plotly_add_caption}
+\alias{plotly_add_caption}
+\title{Add a caption annotation to a ggplotly object}
+\usage{
+plotly_add_caption(pl, caption, font_size = 10)
+}
+\arguments{
+\item{pl}{A plotly object as returned by \code{plotly::ggplotly()}.}
+
+\item{caption}{Character. The caption text; \code{NULL} or \code{""} returns \code{pl}
+unchanged.}
+
+\item{font_size}{Numeric. Caption font size in px. Default 10.}
+}
+\value{
+The modified plotly object.
+}
+\description{
+\code{plotly::ggplotly()} drops ggplot captions (and subtitles). This helper
+re-adds the caption as a small grey annotation below the plot area (bottom
+left, under the x-axis title) and widens the bottom margin accordingly.
+\verb{\\n} line breaks are converted to \verb{
}.
+}
+\details{
+Used by the vignettes together with \code{\link[=cost_rates_caption]{cost_rates_caption()}} so the
+interactive cost plots name the unit-cost rates they were computed with.
+}
+\examples{
+\dontrun{
+pl <- plotly::ggplotly(p, tooltip = "text")
+pl <- plotly_add_caption(pl, cost_rates_caption("de"))
+}
+
+}
diff --git a/man/plotly_split_legend.Rd b/man/plotly_split_legend.Rd
new file mode 100644
index 0000000..6307cf1
--- /dev/null
+++ b/man/plotly_split_legend.Rd
@@ -0,0 +1,76 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plotly_split_legend.R
+\name{plotly_split_legend}
+\alias{plotly_split_legend}
+\title{Split the combined (colour, shape) ggplotly legend into two clean legends}
+\usage{
+plotly_split_legend(
+ pl,
+ lang = c("de", "en"),
+ colour_title = NULL,
+ shape_title = NULL,
+ add_shape_legend = TRUE
+)
+}
+\arguments{
+\item{pl}{A plotly object as returned by
+\code{plotly::ggplotly(p, tooltip = "text")}.}
+
+\item{lang}{Character. \code{"de"} or \code{"en"}; sets the default legend group
+titles.}
+
+\item{colour_title}{Character or \code{NULL}. Title of the colour legend group.
+Defaults to the language-specific "Number of overflow events".}
+
+\item{shape_title}{Character or \code{NULL}. Title of the storage-type legend
+group. Defaults to the language-specific "Storage type".}
+
+\item{add_shape_legend}{Logical. If \code{TRUE} (default), append the two
+legend-only storage-type entries.}
+}
+\value{
+The modified plotly object.
+}
+\description{
+\code{plotly::ggplotly()} flattens a ggplot with both a colour and a shape
+aesthetic into one trace per (colour, shape) combination and names the
+legend entries as tuples such as \code{"(0,Sickerbox / Infiltration box)"} --
+with two storage types and the 0..x / ">x" overflow palette that yields an
+unreadable legend. This helper post-processes the plotly object:
+}
+\details{
+\itemize{
+\item the real traces lose their legend entries; instead every overflow class
+gets one legend-only key drawn as a \strong{neutral circle in the class
+colour} (a coloured square or triangle would wrongly suggest one
+specific storage type). The key shares its legend group with the real
+traces of that class, so clicking it toggles \strong{both} storage types of
+the class together;
+\item two legend-only keys (\strong{neutral grey} filled square = infiltration box,
+filled triangle = gravel trench) are appended under their own
+\strong{storage-type group title}, so the shape encoding is explained
+separately from the colours -- set \code{add_shape_legend = FALSE} to skip
+them (e.g. for storage-type-faceted plots whose strips already label the
+panels). The keys are \strong{clickable}: since a plotly trace can only carry
+one legend group (taken by the overflow class), a small JavaScript
+handler (via \code{htmlwidgets::onRender()}) toggles all traces drawn with
+that marker symbol, so each storage type can be shown or hidden
+individually; the key greys out to reflect the state;
+\item the combined \code{"colour,shape"} legend-title annotation that ggplotly
+draws over the plot title is removed; group titles take its place and
+the legend moves to a vertical layout on the right, where the groups
+stack cleanly.
+}
+
+Traces whose name is not a \code{"(colour,shape)"} tuple (frontier lines, best
+markers, single-aesthetic plots) are left untouched, so the helper is safe
+to apply to any of the package's interactive plots.
+}
+\examples{
+\dontrun{
+p <- plot_cost_vs_evaporation(sim_results, param_grid, x = 5, lang = "de")
+pl <- plotly::ggplotly(p, tooltip = "text")
+pl <- plotly_split_legend(pl, lang = "de")
+}
+
+}
diff --git a/man/read_hdf5_connections.Rd b/man/read_hdf5_connections.Rd
index 200f92a..08a7794 100644
--- a/man/read_hdf5_connections.Rd
+++ b/man/read_hdf5_connections.Rd
@@ -7,7 +7,7 @@
read_hdf5_connections(file)
}
\arguments{
-\item{file}{An \code{\link[hdf5r:H5File-class]{hdf5r::H5File}} object pointing to a \verb{*_Verschaltungen.h5} file,
+\item{file}{An \code{\link[hdf5r:H5File]{hdf5r::H5File}} object pointing to a \verb{*_Verschaltungen.h5} file,
already opened in read mode.}
}
\value{
diff --git a/man/read_hdf5_scalars.Rd b/man/read_hdf5_scalars.Rd
index 4eb7a1f..15c6aac 100644
--- a/man/read_hdf5_scalars.Rd
+++ b/man/read_hdf5_scalars.Rd
@@ -7,7 +7,7 @@
read_hdf5_scalars(group, numeric_only = TRUE)
}
\arguments{
-\item{group}{An \code{\link[hdf5r:H5Group-class]{hdf5r::H5Group}} object. Direct children of this group are expected
+\item{group}{An \code{\link[hdf5r:H5Group]{hdf5r::H5Group}} object. Direct children of this group are expected
to be scalar datasets (i.e. \code{dataset.dims == 0}).}
\item{numeric_only}{Logical (default: \code{TRUE}). If \code{TRUE}, only numeric / integer scalars are
diff --git a/man/read_hdf5_timeseries.Rd b/man/read_hdf5_timeseries.Rd
index 30d5f05..3b7e21d 100644
--- a/man/read_hdf5_timeseries.Rd
+++ b/man/read_hdf5_timeseries.Rd
@@ -24,8 +24,8 @@ columns: variable, time, value.
\details{
Supported dataset layouts:
\itemize{
-\item k x N (rows): \code{[1, ]} = time, \code{[2..k, ]} = values (series)
-\item N x k (cols): \code{[, 1]} = time, \code{[, 2..k]} = values (series)
+\item k x N (rows): \verb{[1, ]} = time, \verb{[2..k, ]} = values (series)
+\item N x k (cols): \verb{[, 1]} = time, \verb{[, 2..k]} = values (series)
}
Special handling for names containing "deeperLayers"/"deeper_layers":
diff --git a/man/read_site_timeseries.Rd b/man/read_site_timeseries.Rd
new file mode 100644
index 0000000..d80aebb
--- /dev/null
+++ b/man/read_site_timeseries.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read_site_timeseries.R
+\name{read_site_timeseries}
+\alias{read_site_timeseries}
+\title{Read and prepare site rain/ET0 time series for the engine (mm/h)}
+\usage{
+read_site_timeseries(path_rain, path_et, verbose = TRUE)
+}
+\arguments{
+\item{path_rain}{Path to the rain CSV (may be gzipped).}
+
+\item{path_et}{Path to the ET0 CSV (semicolon separated).}
+
+\item{verbose}{Print alignment messages (default TRUE).}
+}
+\value{
+List with data.frames \code{rain} and \code{et} (columns \code{time} = hours
+since start, \code{value} = mm/h) ready for
+\code{make_swale_runner(timeseries_rain = , timeseries_et = )}.
+}
+\description{
+Factors the time-series preparation duplicated in the Wien and Bad
+Aussee workflow vignettes into one helper: reads the shipped GeoSphere
+rain series (\code{rain.csv.gz}: columns \code{time} (datetime), \code{rr} (mm per
+interval), \code{station}, further columns tolerated) and reference ET0
+series (\code{et.csv}:
+\verb{date;value} with \code{dd.mm.yyyy}, mm per day), converts both to hours
+since series start, aligns the series ends (the shorter series is
+extended to the longer one's end, repeating its last value) and
+converts the values to the engine's \strong{mm/h} rate convention (rain:
+mm per interval / interval hours; ET0: mm per day / 24).
+}
+\seealso{
+\code{\link[=make_swale_runner]{make_swale_runner()}}
+}
diff --git a/man/run_model.Rd b/man/run_model.Rd
index 6e8c74e..2a349ee 100644
--- a/man/run_model.Rd
+++ b/man/run_model.Rd
@@ -39,7 +39,7 @@ command output are wrapped with \code{\link[kwb.utils:catAndRun]{kwb.utils::catA
}
\details{
Both \code{path_exe} and \code{path_input} are converted to absolute, normalised
-paths via \code{\link[fs:path_math]{fs::path_abs()}} and \code{\link[base:normalizePath]{base::normalizePath()}}. The command is
+paths via \code{\link[fs:path_abs]{fs::path_abs()}} and \code{\link[base:normalizePath]{base::normalizePath()}}. The command is
executed with \code{\link[base:shell]{base::shell()}}, which on Windows invokes the system shell.
On non-Windows platforms, prefer \code{\link[base:system]{base::system()}} if you need full POSIX semantics.
}
@@ -64,5 +64,5 @@ status <- run_model(exe, input, print_output = TRUE)
}
\seealso{
-\code{\link[base:shell]{base::shell()}}, \code{\link[fs:path_math]{fs::path_abs()}}, \code{\link[kwb.utils:catAndRun]{kwb.utils::catAndRun()}}
+\code{\link[base:shell]{base::shell()}}, \code{\link[fs:path_abs]{fs::path_abs()}}, \code{\link[kwb.utils:catAndRun]{kwb.utils::catAndRun()}}
}
diff --git a/man/sickerbox_level_presets.Rd b/man/sickerbox_level_presets.Rd
new file mode 100644
index 0000000..43eafdb
--- /dev/null
+++ b/man/sickerbox_level_presets.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/stack_levels.R
+\name{sickerbox_level_presets}
+\alias{sickerbox_level_presets}
+\title{Sickerbox storage-height presets (brute force default + manufacturers)}
+\usage{
+sickerbox_level_presets(max_height = 2600)
+}
+\arguments{
+\item{max_height}{Maximum total stack height in mm passed to
+\code{\link[=stack_levels]{stack_levels()}} (default 2600).}
+}
+\value{
+Named list of sorted numeric vectors (mm).
+}
+\description{
+Named list of storage-height level vectors (mm) for the infiltration-box
+storage layer. \code{brute_force} is the default used by the workflow
+vignettes (300/600/900/1200 mm -- itself a combination of several box
+types). The manufacturer presets are generated with \code{\link[=stack_levels]{stack_levels()}}
+from typical module heights of commercial block systems; verify against
+the current data sheets before productive optimisation runs.
+}
diff --git a/man/stack_levels.Rd b/man/stack_levels.Rd
new file mode 100644
index 0000000..82c00fa
--- /dev/null
+++ b/man/stack_levels.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/stack_levels.R
+\name{stack_levels}
+\alias{stack_levels}
+\title{Achievable storage-layer stack heights from module heights}
+\usage{
+stack_levels(modules, max_count = rep(7L, length(modules)), max_height = 2600)
+}
+\arguments{
+\item{modules}{Numeric vector of module heights in mm (e.g. \code{c(660, 350)}
+for a full block plus a half block).}
+
+\item{max_count}{Integer vector (recycled to \code{length(modules)}): maximum
+number of modules of each type in one stack. Defaults to 7 for every
+module (cf. GRAF EcoBloc smart, stackable up to 7 layers).}
+
+\item{max_height}{Maximum total stack height in mm (default 2600).}
+}
+\value{
+Sorted numeric vector of achievable stack heights in mm.
+}
+\description{
+Enumerates all storage-layer heights that can be built by stacking
+(and mixing) the given module heights, e.g. full blocks combined with
+at most one half block.
+}
+\examples{
+stack_levels(360) # 360, 720, ..., 2520
+stack_levels(c(660, 350), max_count = c(7, 1)) # Rigofill full + half block
+
+}
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..3dc1a40
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(kwb.raindrop)
+
+test_check("kwb.raindrop")
diff --git a/tests/testthat/test-find_min_feasible.R b/tests/testthat/test-find_min_feasible.R
new file mode 100644
index 0000000..e2d3a79
--- /dev/null
+++ b/tests/testthat/test-find_min_feasible.R
@@ -0,0 +1,108 @@
+test_that("kontinuierliche Bisektion findet die Schwelle innerhalb der Toleranz", {
+ calls <- 0L
+ f <- function(v) {
+ calls <<- calls + 1L
+ list(n_overflows = if (v >= 137.4) 0L else 10L)
+ }
+ res <- find_min_feasible(f, x_max = 0, lower = 25, upper = 200, tol = 2)
+ expect_identical(res$status, "ok")
+ expect_gte(res$value, 137.4)
+ expect_lte(res$value, 137.4 + 2)
+ # log2(175 / 2) ~ 6.5 -> hoechstens ~9 Laeufe inkl. Randtests
+ expect_lte(res$n_evaluations, 9)
+ # Memoisierung: jede Stelle nur einmal evaluiert
+ expect_equal(calls, res$n_evaluations)
+ expect_false(res$monotonicity_violation)
+})
+
+test_that("unterer Rand zulaessig -> at_lower_bound", {
+ f <- function(v) list(n_overflows = if (v >= 10) 0L else 10L)
+ res <- find_min_feasible(f, x_max = 0, lower = 25, upper = 200, tol = 2)
+ expect_identical(res$status, "at_lower_bound")
+ expect_equal(res$value, 25)
+})
+
+test_that("tief unzulaessiger Rand -> sofort infeasible (1 Lauf)", {
+ f <- function(v) list(n_overflows = 99L)
+ res <- find_min_feasible(f, x_max = 0, lower = 25, upper = 200, tol = 2)
+ expect_identical(res$status, "infeasible")
+ expect_true(is.na(res$value))
+ expect_equal(res$n_evaluations, 1L)
+})
+
+test_that("Rand-Guard: +1-Zaehl-Wobble am oberen Rand frisst keine Loesung", {
+ # zulaessig in [100, 180), am oberen Rand springt der Zaehler auf x+1
+ n_fun <- function(v) if (v >= 180) 2L else if (v >= 100) 1L else 50L
+ f <- function(v) list(n_overflows = n_fun(v))
+ res <- find_min_feasible(f, x_max = 1, lower = 25, upper = 200, tol = 2)
+ expect_identical(res$status, "ok")
+ expect_gte(res$value, 100)
+ expect_lte(res$value, 102)
+})
+
+test_that("Volumen-Schiedsrichter: Warnung nur bei echter Nicht-Monotonie", {
+ # Zaehler springt bei 150 von 1 auf 2 -- Volumen steigt MIT: echte Verletzung
+ f_bad <- function(v) list(
+ n_overflows = if (v >= 150) 2L else if (v >= 100) 1L else 9L,
+ overflow_volume_m3 = if (v >= 150) 200 else if (v >= 100) 100 else 5000
+ )
+ expect_warning(
+ res_bad <- find_min_feasible(f_bad, x_max = 1, lower = 25, upper = 200,
+ tol = 2),
+ "non-monotonicity"
+ )
+ expect_true(res_bad$monotonicity_violation)
+
+ # gleicher Zaehler-Sprung, aber Volumen faellt weiter: harmloser Wobble
+ f_ok <- function(v) list(
+ n_overflows = if (v >= 150) 2L else if (v >= 100) 1L else 9L,
+ overflow_volume_m3 = 5000 - 20 * v
+ )
+ expect_no_warning(
+ res_ok <- find_min_feasible(f_ok, x_max = 1, lower = 25, upper = 200,
+ tol = 2)
+ )
+ expect_false(res_ok$monotonicity_violation)
+})
+
+test_that("split_jitter: zufaellige Suchpfade treffen dieselbe Schwelle", {
+ f <- function(v) list(n_overflows = if (v >= 137.4) 0L else 10L)
+ vals <- vapply(1:5, function(s) {
+ set.seed(s)
+ find_min_feasible(f, x_max = 0, lower = 25, upper = 200, tol = 2,
+ split_jitter = 0.3)$value
+ }, numeric(1))
+ expect_true(all(vals >= 137.4 & vals <= 137.4 + 2))
+ # verschiedene Seeds -> verschiedene Pfade (fast sicher versch. Werte)
+ expect_gt(length(unique(round(vals, 6))), 1)
+
+ # diskrete Levels mit Jitter: identisches Ergebnis wie deterministisch
+ lv <- c(300, 600, 900, 1200)
+ g <- function(v) list(n_overflows = if (v >= 900) 0L else 7L)
+ set.seed(99)
+ expect_equal(
+ find_min_feasible(g, x_max = 0, levels = lv, split_jitter = 0.3)$value,
+ 900
+ )
+})
+
+test_that("diskrete Levels: Binaersuche ueber Stufen", {
+ lv <- c(300, 600, 900, 1200)
+ f <- function(v) list(n_overflows = if (v >= 900) 0L else 7L)
+ res <- find_min_feasible(f, x_max = 0, levels = lv)
+ expect_identical(res$status, "ok")
+ expect_equal(res$value, 900)
+ expect_lte(res$n_evaluations, 3)
+
+ # schon die kleinste Stufe reicht
+ f2 <- function(v) list(n_overflows = 0L)
+ res2 <- find_min_feasible(f2, x_max = 0, levels = lv)
+ expect_identical(res2$status, "at_lower_bound")
+ expect_equal(res2$value, 300)
+
+ # keine Stufe reicht (tief unzulaessig)
+ f3 <- function(v) list(n_overflows = 9L)
+ res3 <- find_min_feasible(f3, x_max = 0, levels = lv)
+ expect_identical(res3$status, "infeasible")
+ expect_equal(res3$n_evaluations, 1L)
+})
diff --git a/tests/testthat/test-optimise_swale_design.R b/tests/testthat/test-optimise_swale_design.R
new file mode 100644
index 0000000..76e7944
--- /dev/null
+++ b/tests/testthat/test-optimise_swale_design.R
@@ -0,0 +1,145 @@
+# Synthetisches, monotones Hydraulikmodell: Ueberlaeufe fallen mit der
+# Rueckhaltekapazitaet cap = Flaeche x (Muldentiefe + Porositaet x
+# Speicherhoehe). Kein Engine-Aufruf noetig -> der Optimierer laesst sich
+# gegen eine Brute-Force-Referenz auf feinem Raster verifizieren.
+synthetic_run_factory <- function(demand) {
+ porosity <- c(infiltration_box = 0.95, gravel_trench = 0.3)
+ function(params) {
+ cap <- params$mulde_area *
+ (params$mulde_height +
+ porosity[[params$storage_type]] * params$storage_height)
+ ratio <- demand / cap
+ list(
+ n_overflows = max(0, floor(ratio) - 3),
+ sum_overflows = 800 * max(0, ratio - 3),
+ element.WB_Evapotranspiration_ = 0.1 * params$mulde_area
+ )
+ }
+}
+
+test_fixed <- list(connected_area = 1000, filter_height = 300,
+ filter_hydraulicconductivity = 360,
+ bottom_hydraulicconductivity = 12)
+
+# Brute-Force-Referenz: guenstigstes zulaessiges Design auf feinem Raster
+reference_optimum <- function(run, type, x, storage_values) {
+ grid <- expand.grid(
+ mulde_area = seq(25, 200, by = 0.5),
+ mulde_height = seq(100, 300, by = 5),
+ storage_height = storage_values,
+ stringsAsFactors = FALSE
+ )
+ grid$storage_type <- type
+ porosity <- c(infiltration_box = 0.95, gravel_trench = 0.3)
+ cap <- grid$mulde_area *
+ (grid$mulde_height + porosity[[type]] * grid$storage_height)
+ grid$n <- pmax(0, floor(environment(run)$demand / cap) - 3)
+ grid <- grid[grid$n <= x, , drop = FALSE]
+ if (nrow(grid) == 0) return(NULL)
+ grid$filter_height <- 300
+ costs <- compute_costs(grid)
+ costs[which.min(costs$cost_total), , drop = FALSE]
+}
+
+test_that("Optimierer findet das Kostenminimum (Vergleich mit Brute-Force)", {
+ run <- synthetic_run_factory(demand = 3.6e5)
+ out <- optimise_swale_design(run, x_targets = 0:3,
+ fixed = test_fixed, verbose = FALSE)
+
+ expect_true(all(out$status == "ok"))
+ expect_false(any(out$monotonicity_warning))
+ # Zulaessigkeit: Ueberlaufziel eingehalten
+ expect_true(all(out$n_overflows <= out$x))
+
+ for (i in seq_len(nrow(out))) {
+ type <- out$storage_type[i]
+ stor <- if (type == "infiltration_box") c(300, 600, 900, 1200)
+ else seq(900, 3600, by = 25)
+ ref <- reference_optimum(run, type, out$x[i], stor)
+ expect_false(is.null(ref))
+ # innerhalb 5 % des (quasi-kontinuierlichen) Brute-Force-Optimums
+ expect_lte(out$cost_total[i], ref$cost_total * 1.05)
+ }
+
+ # Kosten-Wirksamkeits-Kurve: lockereres Ziel ist nie teurer
+ for (type in unique(out$storage_type)) {
+ cc <- out$cost_total[out$storage_type == type][order(out$x[out$storage_type == type])]
+ expect_true(all(diff(cc) <= 1e-9))
+ }
+
+ # Laufbudget: alle 8 Zellen zusammen deutlich unter Brute-Force-Groesse
+ expect_lte(attr(out, "n_runs_total"), 200)
+})
+
+test_that("Speicher-Eskalation greift, wenn die Flaeche am Anschlag klemmt", {
+ run <- synthetic_run_factory(demand = 8e5)
+ out <- optimise_swale_design(run, x_targets = 0,
+ fixed = test_fixed, verbose = FALSE)
+ box <- out[out$storage_type == "infiltration_box", ]
+ expect_identical(box$status, "ok")
+ # bei Minimal-Speicher 300 ist selbst 200 m2 unzulaessig -> Eskalation
+ expect_gt(box$storage_height, 300)
+ expect_lte(box$n_overflows, 0)
+})
+
+test_that("unloesbar innerhalb der Bounds ist ein regulaeres Ergebnis", {
+ run <- synthetic_run_factory(demand = 5e6)
+ out <- optimise_swale_design(run, x_targets = 0,
+ fixed = test_fixed, verbose = FALSE)
+ expect_true(all(out$status == "infeasible_within_bounds"))
+ expect_true(all(is.na(out$mulde_area)))
+ expect_true(all(is.na(out$cost_total)))
+})
+
+test_that("Warmstart aus Rasterergebnissen spart Laeufe", {
+ run <- synthetic_run_factory(demand = 3.6e5)
+
+ # Prior im CSV-Schema der Workflows (kf = 360, h_m = 300, Rasterschritt 25)
+ prior <- expand.grid(
+ mulde_area = seq(25, 200, by = 25),
+ mulde_height = 300,
+ storage_type = c("infiltration_box", "gravel_trench"),
+ stringsAsFactors = FALSE
+ )
+ prior$storage_height <- ifelse(prior$storage_type == "infiltration_box",
+ 300, 900)
+ prior$filter_hydraulicconductivity <- 360
+ prior$n_overflows <- vapply(seq_len(nrow(prior)), function(i) {
+ as.numeric(run(c(as.list(prior[i, ]), test_fixed))$n_overflows)
+ }, numeric(1))
+
+ cold <- optimise_swale_design(run, x_targets = 0:3,
+ fixed = test_fixed, verbose = FALSE)
+ warm <- optimise_swale_design(run, x_targets = 0:3,
+ fixed = test_fixed, prior_results = prior,
+ verbose = FALSE)
+
+ # identisches Ergebnis, weniger Laeufe
+ expect_equal(warm$cost_total, cold$cost_total, tolerance = 0.02)
+ expect_lt(attr(warm, "n_runs_total"), attr(cold, "n_runs_total"))
+})
+
+test_that("Such-MC: gejitterte Pfade treffen das deterministische Optimum", {
+ run <- synthetic_run_factory(demand = 3.6e5)
+ det <- optimise_swale_design(run, x_targets = 1, fixed = test_fixed,
+ verbose = FALSE)
+ for (s in 1:3) {
+ set.seed(s)
+ jit <- optimise_swale_design(run, x_targets = 1, fixed = test_fixed,
+ split_jitter = 0.3, verbose = FALSE)
+ expect_equal(jit$storage_height, det$storage_height)
+ expect_lte(max(abs(jit$mulde_area - det$mulde_area)), 2) # area_tol
+ expect_lte(max(abs(jit$mulde_height - det$mulde_height)), 10) # height_tol
+ expect_lte(max(abs(jit$cost_total - det$cost_total) / det$cost_total),
+ 0.03)
+ }
+})
+
+test_that("max_total_depth wirkt als analytische Nebenbedingung", {
+ run <- synthetic_run_factory(demand = 3.6e5)
+ out <- optimise_swale_design(run, x_targets = 0, fixed = test_fixed,
+ max_total_depth = 1200, verbose = FALSE)
+ ok <- out[out$status == "ok", ]
+ expect_true(all(ok$mulde_height + ok$filter_height + ok$storage_height
+ <= 1200 + 1e-9))
+})
diff --git a/tests/testthat/test-optimise_swale_design_simultaneous.R b/tests/testthat/test-optimise_swale_design_simultaneous.R
new file mode 100644
index 0000000..1c7585e
--- /dev/null
+++ b/tests/testthat/test-optimise_swale_design_simultaneous.R
@@ -0,0 +1,346 @@
+# Gleiches synthetisches, monotones Hydraulikmodell wie in
+# test-optimise_swale_design.R: Ueberlaeufe fallen mit der
+# Rueckhaltekapazitaet cap = Flaeche x (Muldentiefe + Porositaet x
+# Speicherhoehe). Kein Engine-Aufruf noetig -> die simultane Suche laesst
+# sich gegen eine Brute-Force-Referenz und gegen die Bisektion verifizieren.
+sim_run_factory <- function(demand) {
+ porosity <- c(infiltration_box = 0.95, gravel_trench = 0.3)
+ function(params) {
+ cap <- params$mulde_area *
+ (params$mulde_height +
+ porosity[[params$storage_type]] * params$storage_height)
+ ratio <- demand / cap
+ list(
+ n_overflows = max(0, floor(ratio) - 3),
+ sum_overflows = 800 * max(0, ratio - 3),
+ element.WB_Evapotranspiration_ = 0.1 * params$mulde_area
+ )
+ }
+}
+
+sim_fixed <- list(connected_area = 1000, filter_height = 300,
+ filter_hydraulicconductivity = 360,
+ bottom_hydraulicconductivity = 12)
+
+# Brute-Force-Referenz: guenstigstes zulaessiges Design auf feinem Raster
+sim_reference_optimum <- function(run, type, x, storage_values) {
+ grid <- expand.grid(
+ mulde_area = seq(25, 200, by = 0.5),
+ mulde_height = seq(100, 300, by = 5),
+ storage_height = storage_values,
+ stringsAsFactors = FALSE
+ )
+ grid$storage_type <- type
+ porosity <- c(infiltration_box = 0.95, gravel_trench = 0.3)
+ cap <- grid$mulde_area *
+ (grid$mulde_height + porosity[[type]] * grid$storage_height)
+ grid$n <- pmax(0, floor(environment(run)$demand / cap) - 3)
+ grid <- grid[grid$n <= x, , drop = FALSE]
+ if (nrow(grid) == 0) return(NULL)
+ grid$filter_height <- 300
+ costs <- compute_costs(grid)
+ costs[which.min(costs$cost_total), , drop = FALSE]
+}
+
+test_that("Simultane Suche findet das Kostenminimum (Vergleich mit Brute-Force)", {
+ run <- sim_run_factory(demand = 3.6e5)
+ out <- optimise_swale_design_simultaneous(run, x_targets = 0:3,
+ fixed = sim_fixed,
+ verbose = FALSE)
+
+ expect_true(all(out$status == "ok"))
+ expect_false(any(out$monotonicity_warning))
+ # Zulaessigkeit: Ueberlaufziel eingehalten
+ expect_true(all(out$n_overflows <= out$x))
+
+ for (i in seq_len(nrow(out))) {
+ type <- out$storage_type[i]
+ stor <- if (type == "infiltration_box") c(300, 600, 900, 1200)
+ else seq(900, 3600, by = 25)
+ ref <- sim_reference_optimum(run, type, out$x[i], stor)
+ expect_false(is.null(ref))
+ # innerhalb 5 % des (quasi-kontinuierlichen) Brute-Force-Optimums
+ expect_lte(out$cost_total[i], ref$cost_total * 1.05)
+ }
+
+ # Kosten-Wirksamkeits-Kurve: lockereres Ziel ist nie teurer
+ for (type in unique(out$storage_type)) {
+ cc <- out$cost_total[out$storage_type == type][order(out$x[out$storage_type == type])]
+ expect_true(all(diff(cc) <= 1e-9))
+ }
+})
+
+test_that("Bisektion und simultane Suche bestaetigen sich gegenseitig", {
+ run <- sim_run_factory(demand = 3.6e5)
+ cd <- optimise_swale_design(run, x_targets = 0:2,
+ fixed = sim_fixed, verbose = FALSE)
+ nm <- optimise_swale_design_simultaneous(run, x_targets = 0:2,
+ fixed = sim_fixed,
+ verbose = FALSE)
+ # gleiche Zellen, gleicher Status, Kosten innerhalb 5 % voneinander
+ expect_identical(nm$status, cd$status)
+ expect_true(all(abs(nm$cost_total - cd$cost_total) <=
+ 0.05 * pmin(nm$cost_total, cd$cost_total)))
+})
+
+test_that("hoher Bedarf erzwingt implizit einen groesseren Speicher", {
+ run <- sim_run_factory(demand = 8e5)
+ out <- optimise_swale_design_simultaneous(run, x_targets = 0,
+ fixed = sim_fixed,
+ verbose = FALSE)
+ box <- out[out$storage_type == "infiltration_box", ]
+ expect_identical(box$status, "ok")
+ # bei Minimal-Speicher 300 ist selbst 200 m2 unzulaessig
+ expect_gt(box$storage_height, 300)
+ expect_lte(box$n_overflows, 0)
+})
+
+test_that("unloesbar innerhalb der Bounds ist ein regulaeres Ergebnis", {
+ run <- sim_run_factory(demand = 5e6)
+ out <- optimise_swale_design_simultaneous(run, x_targets = 0,
+ fixed = sim_fixed,
+ verbose = FALSE)
+ expect_true(all(out$status == "infeasible_within_bounds"))
+ expect_true(all(is.na(out$mulde_area)))
+ expect_true(all(is.na(out$cost_total)))
+})
+
+test_that("Warmstart aus Rasterergebnissen liefert dasselbe Optimum", {
+ run <- sim_run_factory(demand = 3.6e5)
+
+ # Prior im CSV-Schema der Workflows (kf = 360, h_m = 300, Rasterschritt 25)
+ prior <- expand.grid(
+ mulde_area = seq(25, 200, by = 25),
+ mulde_height = 300,
+ storage_type = c("infiltration_box", "gravel_trench"),
+ stringsAsFactors = FALSE
+ )
+ prior$storage_height <- ifelse(prior$storage_type == "infiltration_box",
+ 300, 900)
+ prior$filter_hydraulicconductivity <- 360
+ prior$n_overflows <- vapply(seq_len(nrow(prior)), function(i) {
+ as.numeric(run(c(as.list(prior[i, ]), sim_fixed))$n_overflows)
+ }, numeric(1))
+
+ cold <- optimise_swale_design_simultaneous(run, x_targets = 0:2,
+ fixed = sim_fixed,
+ verbose = FALSE)
+ warm <- optimise_swale_design_simultaneous(run, x_targets = 0:2,
+ fixed = sim_fixed,
+ prior_results = prior,
+ verbose = FALSE)
+
+ # gleiches Optimum (innerhalb der Suchtoleranzen)
+ expect_equal(warm$cost_total, cold$cost_total, tolerance = 0.05)
+})
+
+test_that("max_total_depth wirkt als analytische Nebenbedingung", {
+ run <- sim_run_factory(demand = 3.6e5)
+ out <- optimise_swale_design_simultaneous(run, x_targets = 0,
+ fixed = sim_fixed,
+ max_total_depth = 1200,
+ verbose = FALSE)
+ ok <- out[out$status == "ok", ]
+ expect_true(all(ok$mulde_height + ok$filter_height + ok$storage_height
+ <= 1200 + 1e-9))
+})
+
+test_that("leerer Suchraum (Tiefe verbietet alles) liefert Zeilen statt Fehler", {
+ # max_total_depth = 500 laesst mit filter_height 300 und Muldentiefe
+ # >= 100 keine einzige Speicherhoehe zu -> kein Engine-Lauf, aber ein
+ # regulaeres Ergebnis (kein Absturz beim Zusammenbau der Attribute)
+ run <- sim_run_factory(demand = 3.6e5)
+ for (f in list(optimise_swale_design, optimise_swale_design_simultaneous)) {
+ out <- f(run, x_targets = 0:1, fixed = sim_fixed,
+ max_total_depth = 500, verbose = FALSE)
+ expect_true(all(out$status == "infeasible_within_bounds"))
+ expect_identical(attr(out, "n_runs_total"), 0L)
+ expect_identical(nrow(attr(out, "evaluations")), 0L)
+ }
+})
+
+test_that("degenerierte Rigol-Achse (genau eine zulaessige Hoehe) ist loesbar", {
+ # max_total_depth = 1300: gb[2] wird auf gb[1] = 900 gedrueckt --
+ # genau ein zulaessiger Speicherwert bleibt, die Zelle ist loesbar
+ run <- sim_run_factory(demand = 3.6e5)
+ out <- optimise_swale_design_simultaneous(
+ run, x_targets = 5, fixed = sim_fixed,
+ storage_spec = default_storage_spec()["gravel_trench"],
+ max_total_depth = 1300, verbose = FALSE
+ )
+ expect_identical(out$status, "ok")
+ expect_equal(out$storage_height, 900, tolerance = 0)
+ expect_equal(out$mulde_height, 100, tolerance = 0)
+})
+
+test_that("NA-Zeilen im Prior stuerzen den Warmstart nicht ab", {
+ run <- sim_run_factory(demand = 3.6e5)
+ prior <- data.frame(
+ mulde_area = c(150, NA), mulde_height = c(300, NA),
+ storage_type = c("infiltration_box", NA),
+ storage_height = c(300, NA),
+ filter_hydraulicconductivity = c(360, NA),
+ n_overflows = c(0, NA)
+ )
+ out <- optimise_swale_design_simultaneous(
+ run, x_targets = 0, fixed = sim_fixed,
+ storage_spec = default_storage_spec()["infiltration_box"],
+ prior_results = prior, verbose = FALSE
+ )
+ expect_identical(out$status, "ok")
+})
+
+test_that("max_evals begrenzt die Suchphase messbar", {
+ run <- sim_run_factory(demand = 3.6e5)
+ small <- optimise_swale_design_simultaneous(run, x_targets = 1,
+ fixed = sim_fixed,
+ max_evals = 15,
+ verbose = FALSE)
+ large <- optimise_swale_design_simultaneous(run, x_targets = 1,
+ fixed = sim_fixed,
+ max_evals = 200,
+ verbose = FALSE)
+ expect_lt(attr(small, "n_runs_total"), attr(large, "n_runs_total"))
+ # das Optimum leidet nicht wesentlich unter dem kleinen Budget
+ expect_true(all(small$cost_total <= large$cost_total * 1.10))
+})
+
+test_that("Ergebnis traegt die Attribute evaluations und n_runs_total", {
+ run <- sim_run_factory(demand = 3.6e5)
+ out <- optimise_swale_design_simultaneous(
+ run, x_targets = 1, fixed = sim_fixed,
+ storage_spec = default_storage_spec()["infiltration_box"],
+ verbose = FALSE
+ )
+ ev <- attr(out, "evaluations")
+ expect_s3_class(ev, "tbl_df")
+ expect_gt(nrow(ev), 0)
+ expect_true(all(c("storage_type", "mulde_area", "mulde_height",
+ "storage_height", "n_overflows") %in% names(ev)))
+ expect_identical(attr(out, "n_runs_total"), nrow(ev))
+})
+
+test_that("beide Optimierer folgen veraenderten Kostensaetzen", {
+ # Bei sehr billigem Speichermaterial liegt das Optimum bei hoher
+ # Speicherstufe + kleiner Flaeche. Die simultane Suche traegt die
+ # cost_rates in der Zielfunktion; die Bisektion leitet ihre
+ # Start-Speicherstufe seit dem Spezifikkosten-Proxy ebenfalls aus den
+ # Saetzen ab (statt stur bei der kleinsten Stufe zu starten) -- beide
+ # muessen die billige Ecke finden und eng beieinander liegen.
+ run <- sim_run_factory(demand = 3.6e5)
+ cheap_box <- default_cost_rates()
+ cheap_box$infiltration_box_eur_per_m3 <- 5
+ spec <- default_storage_spec()["infiltration_box"]
+
+ bis <- optimise_swale_design(run, x_targets = 0, fixed = sim_fixed,
+ storage_spec = spec,
+ cost_rates = cheap_box, verbose = FALSE)
+ sim <- optimise_swale_design_simultaneous(run, x_targets = 0,
+ fixed = sim_fixed,
+ storage_spec = spec,
+ cost_rates = cheap_box,
+ verbose = FALSE)
+ expect_identical(bis$status, "ok")
+ expect_identical(sim$status, "ok")
+ expect_equal(bis$storage_height, 1200, tolerance = 0)
+ expect_equal(sim$storage_height, 1200, tolerance = 0)
+ expect_lt(abs(sim$cost_total - bis$cost_total), 0.05 * bis$cost_total)
+
+ # ohne porosity-Eintrag: Legacy-Reihenfolge (kleinste Stufe zuerst)
+ spec_legacy <- spec
+ spec_legacy$infiltration_box$porosity <- NULL
+ leg <- optimise_swale_design(run, x_targets = 0, fixed = sim_fixed,
+ storage_spec = spec_legacy,
+ cost_rates = cheap_box, verbose = FALSE)
+ expect_equal(leg$storage_height, 300, tolerance = 0)
+
+ # unter Default-Saetzen waehlt der Proxy weiterhin die kleinste Stufe
+ def <- optimise_swale_design(run, x_targets = 0, fixed = sim_fixed,
+ storage_spec = spec, verbose = FALSE)
+ expect_equal(def$storage_height, 300, tolerance = 0)
+})
+
+test_that("alle Methoden funktionieren mit Ein-Typ-storage_spec", {
+ run <- sim_run_factory(demand = 3.6e5)
+ for (m in c("nelder_mead", "diff_evolution", "halton_search")) {
+ out <- optimise_swale_design_simultaneous(
+ run, x_targets = 1, fixed = sim_fixed,
+ storage_spec = default_storage_spec()["infiltration_box"],
+ method = m, verbose = FALSE
+ )
+ expect_identical(out$status, "ok")
+ expect_identical(out$method, m)
+ }
+})
+
+test_that("alle Suchverfahren treffen das Brute-Force-Optimum", {
+ run <- sim_run_factory(demand = 3.6e5)
+ # NM ist am praezisesten, DE nah dran, Halton ist die naive Baseline
+ slack <- c(nelder_mead = 1.05, diff_evolution = 1.08, halton_search = 1.12)
+ for (m in names(slack)) {
+ out <- optimise_swale_design_simultaneous(run, x_targets = c(0, 2),
+ fixed = sim_fixed, method = m,
+ verbose = FALSE)
+ expect_true(all(out$status == "ok"), info = m)
+ expect_true(all(out$method == m), info = m)
+ expect_true(all(out$n_overflows <= out$x), info = m)
+ for (i in seq_len(nrow(out))) {
+ type <- out$storage_type[i]
+ stor <- if (type == "infiltration_box") c(300, 600, 900, 1200)
+ else seq(900, 3600, by = 25)
+ ref <- sim_reference_optimum(run, type, out$x[i], stor)
+ expect_lte(out$cost_total[i], ref$cost_total * slack[[m]])
+ }
+ }
+})
+
+test_that("Differential Evolution ist deterministisch und laesst Rs RNG in Ruhe", {
+ run <- sim_run_factory(demand = 3.6e5)
+
+ set.seed(4711)
+ rng_before <- .Random.seed
+ de1 <- optimise_swale_design_simultaneous(run, x_targets = 1,
+ fixed = sim_fixed,
+ method = "diff_evolution",
+ verbose = FALSE)
+ # .Random.seed unveraendert: der interne LCG ersetzt Rs Zufallsstrom
+ expect_identical(.Random.seed, rng_before)
+
+ de2 <- optimise_swale_design_simultaneous(run, x_targets = 1,
+ fixed = sim_fixed,
+ method = "diff_evolution",
+ verbose = FALSE)
+ expect_equal(de1$cost_total, de2$cost_total, tolerance = 0)
+ expect_equal(de1$mulde_area, de2$mulde_area, tolerance = 0)
+
+ # anderer Seed = anderer Suchpfad, aber gleiches Optimum (Toleranzen)
+ de3 <- optimise_swale_design_simultaneous(run, x_targets = 1,
+ fixed = sim_fixed,
+ method = "diff_evolution",
+ seed = 99, verbose = FALSE)
+ expect_equal(de3$cost_total, de1$cost_total, tolerance = 0.05)
+ # Kanarienvogel gegen ein ignoriertes seed-Argument: die besuchten
+ # Designs (Suchpfade) muessen sich unterscheiden, auch wenn die
+ # Optima uebereinstimmen duerfen
+ expect_false(identical(attr(de3, "evaluations"), attr(de1, "evaluations")))
+})
+
+test_that("verschiedene Start-Konfigurationen treffen dasselbe Optimum", {
+ # verschiedene Suchpfade besuchen verschiedene Gitterpunkte -- die
+ # Optima muessen innerhalb der Suchtoleranzen uebereinstimmen
+ # (analog zur split_jitter-Erwartung der Bisektion)
+ run <- sim_run_factory(demand = 3.6e5)
+ few <- optimise_swale_design_simultaneous(run, x_targets = 1,
+ fixed = sim_fixed, n_starts = 1,
+ verbose = FALSE)
+ many <- optimise_swale_design_simultaneous(run, x_targets = 1,
+ fixed = sim_fixed, n_starts = 5,
+ max_evals = 120,
+ verbose = FALSE)
+ # Sickerbox: identische Stufe; Schotterrigol (stufenlos): eine
+ # Toleranzstufe (25 mm) Spielraum
+ tol_hs <- ifelse(many$storage_type == "infiltration_box", 0, 25)
+ expect_true(all(abs(many$storage_height - few$storage_height) <= tol_hs))
+ expect_true(all(abs(many$cost_total - few$cost_total) <=
+ 0.03 * few$cost_total))
+})
diff --git a/tests/testthat/test-stack_levels.R b/tests/testthat/test-stack_levels.R
new file mode 100644
index 0000000..8ebdd63
--- /dev/null
+++ b/tests/testthat/test-stack_levels.R
@@ -0,0 +1,22 @@
+test_that("stack_levels: Vielfache einer Modulhoehe bis zur Obergrenze", {
+ expect_equal(stack_levels(360), seq(360, 2520, by = 360))
+ expect_equal(stack_levels(614), c(614, 1228, 1842, 2456))
+ expect_true(all(stack_levels(400) <= 2600))
+})
+
+test_that("stack_levels: Mischkombination Vollblock + max. 1 Halbblock", {
+ expect_equal(
+ stack_levels(c(660, 350), max_count = c(7L, 1L)),
+ c(350, 660, 1010, 1320, 1670, 1980, 2330)
+ )
+})
+
+test_that("Presets und Default-Spezifikation", {
+ presets <- sickerbox_level_presets()
+ expect_equal(presets$brute_force, c(300, 600, 900, 1200))
+ expect_true(all(vapply(presets, function(p) all(diff(p) > 0), logical(1))))
+
+ spec <- default_storage_spec()
+ expect_equal(spec$infiltration_box$levels, c(300, 600, 900, 1200))
+ expect_equal(spec$gravel_trench$bounds, c(900, 3600))
+})
diff --git a/vignettes/example_wien_minimal.Rmd b/vignettes/example_wien_minimal.Rmd
index 8321142..a40f54a 100644
--- a/vignettes/example_wien_minimal.Rmd
+++ b/vignettes/example_wien_minimal.Rmd
@@ -169,7 +169,7 @@ DT::datatable(
param_grid,
filter = "top",
options = list(pageLength = 12, autoWidth = TRUE),
- caption = "Twelve scenarios — fixed Daniel-reference geometry, sweep of three ET-related engine switches."
+ caption = "Twelve scenarios \u2014 fixed Daniel-reference geometry, sweep of three ET-related engine switches."
)
psi_s_mm <- function(kf_mmh) (3.237 * (kf_mmh / 25.4)^(-0.328)) * 25.4
@@ -476,7 +476,7 @@ DT::datatable(
results,
filter = "top",
options = list(pageLength = 12, autoWidth = TRUE),
- caption = "Twelve-scenario simulation results — water balance + overflow events + construction costs (EUR). Sort by the ET share column to see which combination of `keineVerdunstungBeiRegen` / `Hoernschemeyer_aktiv` / `ET0ref_factor` brings the modelled ET share closest to the SWIMM-Urban-Eva reference of ~7%. Scenarios whose water-balance step errored (see chunk log) are present in the table but have NA in the result columns."
+ caption = "Twelve-scenario simulation results \u2014 water balance + overflow events + construction costs (EUR). Sort by the ET share column to see which combination of `keineVerdunstungBeiRegen` / `Hoernschemeyer_aktiv` / `ET0ref_factor` brings the modelled ET share closest to the SWIMM-Urban-Eva reference of ~7%. Scenarios whose water-balance step errored (see chunk log) are present in the table but have NA in the result columns."
)
```
diff --git a/vignettes/workflow_badaussee.Rmd b/vignettes/workflow_badaussee.Rmd
index 69b87ef..89f6f27 100644
--- a/vignettes/workflow_badaussee.Rmd
+++ b/vignettes/workflow_badaussee.Rmd
@@ -109,14 +109,52 @@ mulde_area <- c(25, 50, 75, 100, 125, 150, 175, 200)
mulde_height <- c(100, 200, 300)
filter_hydraulicconductivity <- c(36, 180, 360)
filter_height <- 300
-storage_height <- c(100, 500, 1000)
+# Storage-layer (Speicher = 2nd Bodenschichtung layer) presets per storage type.
+# Each type brings its own storage_height levels plus the Speicher soil
+# parameters (theta*). They are written to the model in the run loop below:
+# storage_height -> Schichtdicken[2]
+# Startwerte_theta_ActualSoilMoisture -> Startwerte_theta_ActualSoilMoisture[2]
+# thetaWP/thetaFC/thetaS -> //Bodenarten/Speicher/theta*
+storage_type <- list(
+ "infiltration_box" = list(
+ storage_height = c(300, 600, 900, 1200),
+ Startwerte_theta_ActualSoilMoisture = 0,
+ thetaWP_MoistureAtWiltingPoint = 0,
+ thetaFC_MoistureAtFieldCapacity = 0,
+ thetaS_MoistureAtSaturation = 0.95
+ ),
+ "gravel_trench" = list(
+ storage_height = 3 * c(300, 600, 900, 1200),
+ Startwerte_theta_ActualSoilMoisture = 0,
+ thetaWP_MoistureAtWiltingPoint = 0,
+ thetaFC_MoistureAtFieldCapacity = 0,
+ thetaS_MoistureAtSaturation = 0.3
+ )
+)
rain_factor <- 1
bottom_hydraulicconductivity <- 12 #c(1,5,10,20,45,90,180,270,360,1860,3600)
# LAI for Mulde_Rigole only (Dach kept at H5 default).
-# 8.5 = status-quo H5 default; 3.9 = grass per Hörnschemeyer et al.,
+# 8.5 = status-quo H5 default; 3.9 = grass per Hoernschemeyer et al.,
# Water 2023, 15, 2840, Tab. 6, plant type 5 (grasses/herbs).
-lai <- c(3.9, 8.5)
-
+#lai <- c(3.9, 8.5)
+lai <- 3.9
+
+
+# storage_height is coupled to storage_type (each type has its own levels), so
+# build one row per (storage_type, storage_height) carrying the matching
+# Speicher soil parameters, then cross-join with all remaining combinations.
+storage_grid <- do.call(rbind, lapply(names(storage_type), function(type_name) {
+ spec <- storage_type[[type_name]]
+ data.frame(
+ storage_type = type_name,
+ storage_height = spec$storage_height,
+ storage_theta_start = spec$Startwerte_theta_ActualSoilMoisture,
+ storage_thetaWP = spec$thetaWP_MoistureAtWiltingPoint,
+ storage_thetaFC = spec$thetaFC_MoistureAtFieldCapacity,
+ storage_thetaS = spec$thetaS_MoistureAtSaturation,
+ stringsAsFactors = FALSE
+ )
+}))
# Alle Kombinationen erzeugen
param_grid_all_combinations <- expand.grid(
@@ -125,16 +163,25 @@ param_grid_all_combinations <- expand.grid(
mulde_height = mulde_height,
filter_hydraulicconductivity = filter_hydraulicconductivity,
filter_height = filter_height,
- storage_height = storage_height,
bottom_hydraulicconductivity = bottom_hydraulicconductivity,
rain_factor = rain_factor,
- lai = lai
+ lai = lai,
+ stringsAsFactors = FALSE
)
+# Cross-join the free parameters with the coupled storage grid.
+param_grid_all_combinations <- merge(param_grid_all_combinations, storage_grid,
+ by = NULL)
+
param_grid_all_combinations <- param_grid_all_combinations %>%
dplyr::bind_cols(tibble::tibble(scenario_name = sprintf("s%05d",
seq_len(nrow(param_grid_all_combinations)))))
+# Reference = first storage type at its smallest storage_height (storage_height
+# is coupled to storage_type, so both are fixed together).
+ref_storage_type <- names(storage_type)[1]
+ref_storage_height <- min(storage_type[[ref_storage_type]]$storage_height)
+
ref_scenario <- param_grid_all_combinations %>%
dplyr::filter(connected_area == min(unique(param_grid_all_combinations$connected_area)),
mulde_area == min(unique(param_grid_all_combinations$mulde_area)),
@@ -142,7 +189,8 @@ ref_scenario <- param_grid_all_combinations %>%
filter_hydraulicconductivity == min(param_grid_all_combinations$filter_hydraulicconductivity),
bottom_hydraulicconductivity == min(unique(param_grid_all_combinations$bottom_hydraulicconductivity)),
mulde_height == min(param_grid_all_combinations$mulde_height),
- storage_height == min(param_grid_all_combinations$storage_height),
+ storage_type == ref_storage_type,
+ storage_height == ref_storage_height,
lai == max(param_grid_all_combinations$lai)) %>%
dplyr::pull(scenario_name)
@@ -158,6 +206,20 @@ param_grid <- param_grid_all_combinations %>%
dplyr::filter(scenario_name %in% scenarios_with_single_parameter_variation)
param_grid <- param_grid_all_combinations
+# Nutzbares Speichervolumen der Speicherschicht [m3] = Muldenflaeche x
+# Speicherhoehe x nutzbare Porositaet (thetaS - thetaFC) des Speichertyps
+# (Sickerbox 0.95, Schotterrigole 0.3). thetaFC statt thetaWP: nur das
+# oberhalb der Feldkapazitaet entwaesserbare Porenvolumen leert sich zwischen
+# den Ereignissen und steht als Retentionsvolumen erneut zur Verfuegung;
+# Wasser zwischen WP und FC haelt die Schicht gegen die Schwerkraft (in den
+# Presets sind thetaFC = thetaWP = 0, beide Definitionen also identisch).
+# Erscheint in der Grid-Tabelle, den Ergebnis-CSVs und im Plot-Tooltip.
+param_grid <- param_grid %>%
+ dplyr::mutate(
+ storage_volume_m3 = mulde_area * storage_height / 1000 *
+ (storage_thetaS - storage_thetaFC)
+ )
+
DT::datatable(param_grid,
filter = "top",
options = list(pageLength = 25,
@@ -239,7 +301,7 @@ timeseries_rain <- if(max(timeseries_et$time) > max(timeseries_rain$time)) {
timeseries_rain
}
-txt <- sprintf("Für den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Werte die gleich Null sind. (Regenmenge: %f mm/a)\n",
+txt <- sprintf("F\u00fcr den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Werte die gleich Null sind. (Regenmenge: %f mm/a)\n",
paths$path_rain,
100*sum(is.na(timeseries_rain$value))/nrow(timeseries_rain),
100*sum(timeseries_rain$value == 0, na.rm = TRUE)/nrow(timeseries_rain),
@@ -247,7 +309,7 @@ txt <- sprintf("Für den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Wer
message(txt)
-txt <- sprintf("Für den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Werte die gleich Null sind. (Verdunstungs: %f mm/a)\n",
+txt <- sprintf("F\u00fcr den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Werte die gleich Null sind. (Evapotranspirations: %f mm/a)\n",
paths$path_et,
100*sum(is.na(timeseries_et$value))/nrow(timeseries_et),
100*sum(timeseries_et$value == 0, na.rm = TRUE)/nrow(timeseries_et),
@@ -260,6 +322,12 @@ message(txt)
period <- c(diff(timeseries_rain$time), mean(diff(timeseries_rain$time)))
timeseries_rain$value <- timeseries_rain$value / period
+### Convert ET0 from mm/day to mm/h (the engine reads //Kurven/ET0 as a mm/h
+### rate, exactly like rain; daily values must be divided by their interval in
+### hours = 24, otherwise ET0 is integrated 24x too high)
+period_et <- c(diff(timeseries_et$time), mean(diff(timeseries_et$time)))
+timeseries_et$value <- timeseries_et$value / period_et
+
#openxlsx::write.xlsx(list(regen = timeseries_rain, et = timeseries_et), "timeseries.xlsx")
@@ -308,9 +376,14 @@ run_one <- function(i,
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Regen-Skalierungsfaktor` <- 1
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Flaeche` <- param_grid_tmp$mulde_area
vals$`//Massnahmenelemente/Mulde_Rigole/Eigenschaften_Oberflaeche/Ueberlaufhoehe` <- param_grid_tmp$mulde_height
- vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Startwerte_theta_ActualSoilMoisture` <- c(0.3, 0)
+ vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Startwerte_theta_ActualSoilMoisture` <- c(0.3, param_grid_tmp$storage_theta_start)
vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Schichtdicken` <- c(param_grid_tmp$filter_height,
param_grid_tmp$storage_height)
+ # Speicher (2nd Bodenschichtung layer) soil parameters depend on the
+ # storage type (infiltration_box vs. gravel_trench); see `storage_type`.
+ vals$`//Bodenarten/Speicher/thetaWP_MoistureAtWiltingPoint` <- param_grid_tmp$storage_thetaWP
+ vals$`//Bodenarten/Speicher/thetaFC_MoistureAtFieldCapacity` <- param_grid_tmp$storage_thetaFC
+ vals$`//Bodenarten/Speicher/thetaS_MoistureAtSaturation` <- param_grid_tmp$storage_thetaS
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Endversickerungsrate` <- param_grid_tmp$bottom_hydraulicconductivity
vals$`//Bodenarten/Bodenfilter/Ks_HydraulicConductivity` <- param_grid_tmp$filter_hydraulicconductivity
@@ -332,13 +405,33 @@ run_one <- function(i,
path_input = paths$path_target_input,
debug = debug)
- invisible(NULL)
+ # Thin immediately: read only this run's results (lean = water balance +
+ # overflow rates, no states/meta/connected-area rates) and reduce to the
+ # single optimisation row. This way we never hold all scenarios' full
+ # time series in memory at once; the full result HDF5 stays on disk for
+ # ad-hoc inspection.
+ sim_one <- kwb.raindrop::get_simulation_results_optim(
+ paths = paths,
+ path_list = path_list,
+ simulation_names = param_grid_tmp$scenario_name,
+ debug = debug,
+ lean = TRUE
+ )
+
+ kwb.raindrop::add_overflow_events_and_waterbalance(
+ simulation_results = sim_one,
+ event_separation_hours = 4,
+ canonical_variables = kwb.raindrop::default_canonical_wb_variables()
+ )
}
n_cores <- parallel::detectCores()
+# run_one() now returns the thinned per-run optimisation row, so run_scenarios()
+# yields a list of one-row tibbles we simply bind below.
+scenario_rows <- NULL
system.time(expr = {
-kwb.raindrop::run_scenarios(indices = seq_len(nrow(param_grid)),
+scenario_rows <- kwb.raindrop::run_scenarios(indices = seq_len(nrow(param_grid)),
run_one_scenario = run_one,
timestep_hours = 0.1,
debug = FALSE,
@@ -368,21 +461,11 @@ x$Fehlerbeschreibung
### Analyse Results
```{r analyse_results, eval = data_available && is_windows && !is_ghactions}
-system.time(
-simulation_results <- kwb.raindrop::get_simulation_results_optim_parallel(
- paths = paths,
- path_list = path_list,
- simulation_names = param_grid$scenario_name,
- debug = FALSE)
-)
-
-system.time(
-simulation_results_optimisation <- kwb.raindrop::add_overflow_events_and_waterbalance(
- simulation_results = simulation_results,
- event_separation_hours = 4,
- canonical_variables = kwb.raindrop::default_canonical_wb_variables()
- )
-)
+# Each run was already thinned to its optimisation row inside run_one(), so we
+# just bind the per-run rows here instead of re-reading every run's full
+# results into memory. (The previous get_simulation_results_optim_parallel() +
+# add_overflow_events_and_waterbalance() pass loaded all runs at once.)
+simulation_results_optimisation <- dplyr::bind_rows(scenario_rows)
simulation_results_optimisation <- param_grid %>%
dplyr::left_join(simulation_results_optimisation,
@@ -407,6 +490,16 @@ htmlwidgets::saveWidget(DT::datatable(simulation_results_optimisation,
### Plot results
+# Fuer Plots/Tooltips: die an storage_type gekoppelten Speicher-Bodenparameter
+# (storage_theta*) sind durch den Typ bestimmt, also redundant - sie wuerden
+# nur jeden Tooltip aufblaehen. Fuer den Modelllauf oben werden sie gebraucht,
+# ab hier nicht mehr. storage_volume_m3 bekommt im Tooltip eine eigene Zeile
+# (aus den Ergebnisdaten) und fliegt hier ebenfalls raus, sonst stuende es
+# doppelt unter "Variierende Parameter".
+param_grid <- param_grid %>%
+ dplyr::select(-dplyr::starts_with("storage_theta"),
+ -dplyr::any_of("storage_volume_m3"))
+
params <- c(
#"connected_area",
"mulde_area",
@@ -416,12 +509,18 @@ params <- c(
"storage_height",
#"bottom_hydraulicconductivity",
#"rain_factor",
- "lai"
+ "lai",
+ "storage_type"
)
lang <- "de"
max_n_overflows <- 5
+# Kostensaetze-Caption fuer die interaktiven Kostenplots: ggplotly verwirft
+# ggplot-Captions, daher wird sie dort per plotly_add_caption() nachgeruestet;
+# die PDFs bekommen sie automatisch ueber den caption-Default der Funktionen.
+cost_caption <- kwb.raindrop::cost_rates_caption(lang)
+
pdff <- sprintf("simulation_results_optimisation_%s_main-effects.pdf",
paths$modelname)
@@ -458,6 +557,7 @@ grDevices::pdf(pdff, width = 9, height = 4, onefile = TRUE)
alpha_max = 1,
drop_overflow_gt_valid_max = FALSE,
keep_param_grid_limits = TRUE,
+ facet_storage_type = TRUE,
lang = lang,
subtitle = ""
)
@@ -498,11 +598,15 @@ for (y in c("mulde_height", "filter_hydraulicconductivity", "storage_height")) {
alpha_min = 0.25,
alpha_max = 1,
drop_overflow_gt_valid_max = FALSE,
- keep_param_grid_limits = TRUE
+ keep_param_grid_limits = TRUE,
+ facet_storage_type = TRUE
)
- # interaktiv als HTML
+ # interaktiv als HTML; Farb-Legende je Ueberlaufklasse statt
+ # (Farbe, Form)-Tupeln - die Formen erklaeren die Panel-Beschriftungen.
plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang,
+ add_shape_legend = FALSE)
htmlwidgets::saveWidget(
widget = plotly_p,
file = sprintf("simulation_results_optimisation_%s_design-space_mulde-area_vs_%s.html",
@@ -532,8 +636,10 @@ p <- kwb.raindrop::plot_wb_tradeoff_overflows(
use_jitter = TRUE
)
- # interaktiv als HTML
+ # interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+ # statt der (Farbe, Form)-Tupel von ggplotly
plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
htmlwidgets::saveWidget(
widget = plotly_p,
file = sprintf("simulation_results_optimisation_%s_water-balance.html",
@@ -544,6 +650,163 @@ p <- kwb.raindrop::plot_wb_tradeoff_overflows(
)
# statisch ins PDF (WICHTIG!)
- suppressWarnings(print(p))
+ suppressWarnings(print(p))
+dev.off()
+
+pdff <- sprintf("simulation_results_optimisation_%s_cost-vs-overflow-volume.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_vs_overflow_volume(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE
+)
+
+# interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+# statt der (Farbe, Form)-Tupel von ggplotly
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf("simulation_results_optimisation_%s_cost-vs-overflow-volume.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost vs. overflow volume",
+ paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
+dev.off()
+
+
+# Drei Kosten-Boxplots mit unterschiedlichem Optimierungsziel je Kategorie
+# (Kosten als Tie-Break): (i) guenstigste; (ii) geringstes Ueberlaufvolumen
+# (Label m3 + %); (iii) hoechste Evapotranspiration (Label %, Punktgroesse =
+# Evapotranspiration). x = max_n_overflows, Linie ueber alle Klassen. Die beiden
+# Speichertypen liegen als zwei Panels untereinander (Sickerbox oben,
+# Schotterrigol unten); die Punkte bleiben Kreise, da die Panel-Streifen
+# den Typ bereits benennen.
+cost_boxplots <- list(
+ list(suffix = "cheapest", best_by = "min_cost",
+ size_by = "overflow_volume", label_best = FALSE),
+ list(suffix = "min-overflow", best_by = "min_overflow",
+ size_by = "overflow_volume", label_best = TRUE),
+ list(suffix = "max-evap", best_by = "max_evapotranspiration",
+ size_by = "evapotranspiration", label_best = TRUE)
+)
+for (cb in cost_boxplots) {
+ pdff <- sprintf(
+ "simulation_results_optimisation_%s_cost-by-overflows-boxplot-%s.pdf",
+ paths$modelname, cb$suffix)
+ kwb.utils::preparePdf(pdfFile = pdff)
+
+ p <- kwb.raindrop::plot_cost_overflow_boxplot(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang,
+ facet_storage_type = TRUE,
+ size_by = cb$size_by,
+ best_by = cb$best_by,
+ label_best = cb$label_best
+ )
+
+ # interaktiv als HTML
+ plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+ htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf(
+ "simulation_results_optimisation_%s_cost-by-overflows-boxplot-%s.html",
+ paths$modelname, cb$suffix),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost boxplot (%s)", paths$modelname, cb$suffix)
+ )
+
+ # statisch ins PDF (WICHTIG!)
+ suppressWarnings(print(p))
+ dev.off()
+}
+
+
+# Kosten vs. Evapotranspiration: Streudiagramm ueber den Design-Raum, Punktform
+# kodiert den Speichertyp (Viereck = Sickerbox, Dreieck = Schotterrigol),
+# Farbe die Anzahl Ueberlaufereignisse.
+pdff <- sprintf("simulation_results_optimisation_%s_cost-vs-evaporation.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_vs_evaporation(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang
+)
+
+# interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+# statt der (Farbe, Form)-Tupel von ggplotly
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf("simulation_results_optimisation_%s_cost-vs-evaporation.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost vs. evapotranspiration",
+ paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
+dev.off()
+
+
+# Kosten je Prozent Evapotranspiration [EUR/%]: Boxplot je Ueberlaufklasse mit den
+# beiden Speichertypen als zwei Panels untereinander (Sickerbox oben,
+# Schotterrigol unten); guenstigstes Szenario je Box markiert (Label EUR/%),
+# Punktgroesse = Evapotranspiration.
+pdff <- sprintf(
+ "simulation_results_optimisation_%s_cost-per-evap-boxplot.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_overflow_boxplot(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang,
+ y_var = "cost_per_evap_pct",
+ facet_storage_type = TRUE,
+ size_by = "evapotranspiration",
+ best_by = "min_cost",
+ label_best = TRUE
+)
+
+# interaktiv als HTML
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf(
+ "simulation_results_optimisation_%s_cost-per-evap-boxplot.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost per %% evapotranspiration", paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
dev.off()
```
\ No newline at end of file
diff --git a/vignettes/workflow_eisenstadt-2005.Rmd b/vignettes/workflow_eisenstadt-2005.Rmd
index 818fc01..b21d339 100644
--- a/vignettes/workflow_eisenstadt-2005.Rmd
+++ b/vignettes/workflow_eisenstadt-2005.Rmd
@@ -98,11 +98,48 @@ mulde_area <- c(25, 50, 75, 100, 125, 150, 175, 200)
mulde_height <- c(100, 200, 300)
filter_hydraulicconductivity <- c(36, 180, 360)
filter_height <- 300
-storage_height <- c(100, 500, 1000)
+# Storage-layer (Speicher = 2nd Bodenschichtung layer) presets per storage type.
+# Each type brings its own storage_height levels plus the Speicher soil
+# parameters (theta*). They are written to the model in the run loop below:
+# storage_height -> Schichtdicken[2]
+# Startwerte_theta_ActualSoilMoisture -> Startwerte_theta_ActualSoilMoisture[2]
+# thetaWP/thetaFC/thetaS -> //Bodenarten/Speicher/theta*
+storage_type <- list(
+ "infiltration_box" = list(
+ storage_height = c(300, 600, 900, 1200),
+ Startwerte_theta_ActualSoilMoisture = 0,
+ thetaWP_MoistureAtWiltingPoint = 0,
+ thetaFC_MoistureAtFieldCapacity = 0,
+ thetaS_MoistureAtSaturation = 0.95
+ ),
+ "gravel_trench" = list(
+ storage_height = 3 * c(300, 600, 900, 1200),
+ Startwerte_theta_ActualSoilMoisture = 0,
+ thetaWP_MoistureAtWiltingPoint = 0,
+ thetaFC_MoistureAtFieldCapacity = 0,
+ thetaS_MoistureAtSaturation = 0.3
+ )
+)
rain_factor <- 1
bottom_hydraulicconductivity <- 12 #c(1,5,10,20,45,90,180,270,360,1860,3600)
+# storage_height is coupled to storage_type (each type has its own levels), so
+# build one row per (storage_type, storage_height) carrying the matching
+# Speicher soil parameters, then cross-join with all remaining combinations.
+storage_grid <- do.call(rbind, lapply(names(storage_type), function(type_name) {
+ spec <- storage_type[[type_name]]
+ data.frame(
+ storage_type = type_name,
+ storage_height = spec$storage_height,
+ storage_theta_start = spec$Startwerte_theta_ActualSoilMoisture,
+ storage_thetaWP = spec$thetaWP_MoistureAtWiltingPoint,
+ storage_thetaFC = spec$thetaFC_MoistureAtFieldCapacity,
+ storage_thetaS = spec$thetaS_MoistureAtSaturation,
+ stringsAsFactors = FALSE
+ )
+}))
+
# Alle Kombinationen erzeugen
param_grid_all_combinations <- expand.grid(
connected_area = connected_area,
@@ -110,11 +147,20 @@ param_grid_all_combinations <- expand.grid(
mulde_height = mulde_height,
filter_hydraulicconductivity = filter_hydraulicconductivity,
filter_height = filter_height,
- storage_height = storage_height,
bottom_hydraulicconductivity = bottom_hydraulicconductivity,
- rain_factor = rain_factor
+ rain_factor = rain_factor,
+ stringsAsFactors = FALSE
)
+# Cross-join the free parameters with the coupled storage grid.
+param_grid_all_combinations <- merge(param_grid_all_combinations, storage_grid,
+ by = NULL)
+
+# Reference = first storage type at its smallest storage_height (storage_height
+# is coupled to storage_type, so both are fixed together).
+ref_storage_type <- names(storage_type)[1]
+ref_storage_height <- min(storage_type[[ref_storage_type]]$storage_height)
+
param_grid_all_combinations <- param_grid_all_combinations %>%
dplyr::bind_cols(tibble::tibble(scenario_name = sprintf("s%05d",
seq_len(nrow(param_grid_all_combinations)))))
@@ -126,7 +172,8 @@ ref_scenario <- param_grid_all_combinations %>%
filter_hydraulicconductivity == min(param_grid_all_combinations$filter_hydraulicconductivity),
bottom_hydraulicconductivity == min(unique(param_grid_all_combinations$bottom_hydraulicconductivity)),
mulde_height == min(param_grid_all_combinations$mulde_height),
- storage_height == min(param_grid_all_combinations$storage_height)) %>%
+ storage_type == ref_storage_type,
+ storage_height == ref_storage_height) %>%
dplyr::pull(scenario_name)
stopifnot(length(ref_scenario)==1)
@@ -141,6 +188,20 @@ scenarios_with_single_parameter_variation <- kwb.raindrop::find_single_param_var
# dplyr::filter(scenario_name %in% scenarios_with_single_parameter_variation)
param_grid <- param_grid_all_combinations
+# Nutzbares Speichervolumen der Speicherschicht [m3] = Muldenflaeche x
+# Speicherhoehe x nutzbare Porositaet (thetaS - thetaFC) des Speichertyps
+# (Sickerbox 0.95, Schotterrigole 0.3). thetaFC statt thetaWP: nur das
+# oberhalb der Feldkapazitaet entwaesserbare Porenvolumen leert sich zwischen
+# den Ereignissen und steht als Retentionsvolumen erneut zur Verfuegung;
+# Wasser zwischen WP und FC haelt die Schicht gegen die Schwerkraft (in den
+# Presets sind thetaFC = thetaWP = 0, beide Definitionen also identisch).
+# Erscheint in der Grid-Tabelle, den Ergebnis-CSVs und im Plot-Tooltip.
+param_grid <- param_grid %>%
+ dplyr::mutate(
+ storage_volume_m3 = mulde_area * storage_height / 1000 *
+ (storage_thetaS - storage_thetaFC)
+ )
+
DT::datatable(param_grid,
filter = "top",
options = list(pageLength = 25,
@@ -206,15 +267,25 @@ run_one <- function(i,
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Regen-Skalierungsfaktor` <- 1
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Flaeche` <- param_grid_tmp$mulde_area
vals$`//Massnahmenelemente/Mulde_Rigole/Eigenschaften_Oberflaeche/Ueberlaufhoehe` <- param_grid_tmp$mulde_height
- vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Startwerte_theta_ActualSoilMoisture` <- c(0.3, 0)
+ vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Startwerte_theta_ActualSoilMoisture` <- c(0.3, param_grid_tmp$storage_theta_start)
vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Schichtdicken` <- c(param_grid_tmp$filter_height,
param_grid_tmp$storage_height)
+ # Speicher (2nd Bodenschichtung layer) soil parameters depend on the
+ # storage type (infiltration_box vs. gravel_trench); see `storage_type`.
+ vals$`//Bodenarten/Speicher/thetaWP_MoistureAtWiltingPoint` <- param_grid_tmp$storage_thetaWP
+ vals$`//Bodenarten/Speicher/thetaFC_MoistureAtFieldCapacity` <- param_grid_tmp$storage_thetaFC
+ vals$`//Bodenarten/Speicher/thetaS_MoistureAtSaturation` <- param_grid_tmp$storage_thetaS
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Endversickerungsrate` <- param_grid_tmp$bottom_hydraulicconductivity
-
+ # Pin LAI to the grass value from Hoernschemeyer et al. (Water 2023,
+ # 15, 2840, Tab. 6, plant type 5 = grasses/herbs); base.h5 ships 8.5.
+ # Wien and Bad Aussee already use 3.9 (Wien as one of the sweep
+ # levels); this line keeps Eisenstadt 2005 consistent.
+ vals$`//Massnahmenelemente/Mulde_Rigole/Parameter_Evapotranspiration/LAI_LeafAreaIndex` <- 3.9
+
vals$`//Bodenarten/Bodenfilter/Ks_HydraulicConductivity` <- param_grid_tmp$filter_hydraulicconductivity
vals$`//Bodenarten/Bodenfilter/Psi_Saugspannung_CapillarySuction` <- psi_s_mm(param_grid_tmp$filter_hydraulicconductivity)
-# Timeseries (2×N) als tibble?
+# Timeseries (2xN) als tibble?
if (is.data.frame(vals[["//Kurven/Regen"]])) {
vals[["//Kurven/Regen"]]$value <- vals[["//Kurven/Regen"]]$value * param_grid_tmp$rain_factor
}
@@ -228,13 +299,33 @@ if (is.data.frame(vals[["//Kurven/Regen"]])) {
path_input = paths$path_target_input,
debug = debug)
- invisible(NULL)
+ # Thin immediately: read only this run's results (lean = water balance +
+ # overflow rates, no states/meta/connected-area rates) and reduce to the
+ # single optimisation row. This way we never hold all scenarios' full
+ # time series in memory at once; the full result HDF5 stays on disk for
+ # ad-hoc inspection.
+ sim_one <- kwb.raindrop::get_simulation_results_optim(
+ paths = paths,
+ path_list = path_list,
+ simulation_names = param_grid_tmp$scenario_name,
+ debug = debug,
+ lean = TRUE
+ )
+
+ kwb.raindrop::add_overflow_events_and_waterbalance(
+ simulation_results = sim_one,
+ event_separation_hours = 4,
+ canonical_variables = kwb.raindrop::default_canonical_wb_variables()
+ )
}
n_cores <- parallel::detectCores()
+# run_one() now returns the thinned per-run optimisation row, so run_scenarios()
+# yields a list of one-row tibbles we simply bind below.
+scenario_rows <- NULL
system.time(expr = {
-kwb.raindrop::run_scenarios(indices = seq_len(nrow(param_grid)),
+scenario_rows <- kwb.raindrop::run_scenarios(indices = seq_len(nrow(param_grid)),
run_one_scenario = run_one,
timestep_hours = 0.1,
debug = FALSE,
@@ -264,26 +355,17 @@ x$Fehlerbeschreibung
### Analyse Results
```{r analyse_results, eval = data_available && is_windows && !is_ghactions}
-system.time(
-simulation_results <- kwb.raindrop::get_simulation_results_optim_parallel(
- paths = paths,
- path_list = path_list,
- simulation_names = param_grid$scenario_name,
- debug = FALSE)
-)
+# Each run was already thinned to its optimisation row inside run_one(), so we
+# just bind the per-run rows here instead of re-reading every run's full
+# results into memory. (The previous get_simulation_results_optim_parallel() +
+# add_overflow_events_and_waterbalance() pass loaded all runs at once.)
+simulation_results_optimisation <- dplyr::bind_rows(scenario_rows)
-system.time(
-simulation_results_optimisation <- kwb.raindrop::add_overflow_events_and_waterbalance(
- simulation_results = simulation_results,
- event_separation_hours = 4,
- canonical_variables = kwb.raindrop::default_canonical_wb_variables()
- )
-)
-
-simulation_results_optimisation <- param_grid %>%
+simulation_results_optimisation <- param_grid %>%
dplyr::left_join(simulation_results_optimisation,
- by = c("scenario_name" = "s_name")) %>%
- dplyr::relocate(scenario_name, .before = connected_area)
+ by = c("scenario_name" = "s_name")) %>%
+ dplyr::relocate(scenario_name, .before = connected_area) %>%
+ kwb.raindrop::compute_costs()
readr::write_csv(simulation_results_optimisation,
file = sprintf("simulation_results_optimisation_%s.csv",
@@ -301,20 +383,36 @@ htmlwidgets::saveWidget(DT::datatable(simulation_results_optimisation,
)
### Plot results
+# Fuer Plots/Tooltips: die an storage_type gekoppelten Speicher-Bodenparameter
+# (storage_theta*) sind durch den Typ bestimmt, also redundant - sie wuerden
+# nur jeden Tooltip aufblaehen. Fuer den Modelllauf oben werden sie gebraucht,
+# ab hier nicht mehr. storage_volume_m3 bekommt im Tooltip eine eigene Zeile
+# (aus den Ergebnisdaten) und fliegt hier ebenfalls raus, sonst stuende es
+# doppelt unter "Variierende Parameter".
+param_grid <- param_grid %>%
+ dplyr::select(-dplyr::starts_with("storage_theta"),
+ -dplyr::any_of("storage_volume_m3"))
+
params <- c(
#"connected_area",
"mulde_area",
"mulde_height",
"filter_hydraulicconductivity",
#"filter_height",
- "storage_height"
+ "storage_height",
#"bottom_hydraulicconductivity",
- #"rain_factor"
+ #"rain_factor",
+ "storage_type"
)
lang <- "de"
max_n_overflows <- 1
+# Kostensaetze-Caption fuer die interaktiven Kostenplots: ggplotly verwirft
+# ggplot-Captions, daher wird sie dort per plotly_add_caption() nachgeruestet;
+# die PDFs bekommen sie automatisch ueber den caption-Default der Funktionen.
+cost_caption <- kwb.raindrop::cost_rates_caption(lang)
+
pdff <- sprintf("simulation_results_optimisation_%s_main-effects.pdf",
paths$modelname)
@@ -351,6 +449,7 @@ grDevices::pdf(pdff, width = 9, height = 4, onefile = TRUE)
alpha_max = 1,
drop_overflow_gt_valid_max = FALSE,
keep_param_grid_limits = TRUE,
+ facet_storage_type = TRUE,
lang = lang,
subtitle = ""
)
@@ -391,11 +490,15 @@ for (y in c("mulde_height", "filter_hydraulicconductivity", "storage_height")) {
alpha_min = 0.25,
alpha_max = 1,
drop_overflow_gt_valid_max = TRUE,
- keep_param_grid_limits = TRUE
+ keep_param_grid_limits = TRUE,
+ facet_storage_type = TRUE
)
- # interaktiv als HTML
+ # interaktiv als HTML; Farb-Legende je Ueberlaufklasse statt
+ # (Farbe, Form)-Tupeln - die Formen erklaeren die Panel-Beschriftungen.
plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang,
+ add_shape_legend = FALSE)
htmlwidgets::saveWidget(
widget = plotly_p,
file = sprintf("simulation_results_optimisation_%s_design-space_mulde-area_vs_%s.html",
@@ -425,8 +528,10 @@ p <- kwb.raindrop::plot_wb_tradeoff_overflows(
use_jitter = TRUE
)
- # interaktiv als HTML
+ # interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+ # statt der (Farbe, Form)-Tupel von ggplotly
plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
htmlwidgets::saveWidget(
widget = plotly_p,
file = sprintf("simulation_results_optimisation_%s_water-balance.html",
@@ -437,8 +542,165 @@ p <- kwb.raindrop::plot_wb_tradeoff_overflows(
)
# statisch ins PDF (WICHTIG!)
- suppressWarnings(print(p))
+ suppressWarnings(print(p))
dev.off()
#kwb.utils::finishAndShowPdf(pdff)
+pdff <- sprintf("simulation_results_optimisation_%s_cost-vs-overflow-volume.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_vs_overflow_volume(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE
+)
+
+# interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+# statt der (Farbe, Form)-Tupel von ggplotly
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf("simulation_results_optimisation_%s_cost-vs-overflow-volume.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost vs. overflow volume",
+ paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
+dev.off()
+
+
+# Drei Kosten-Boxplots mit unterschiedlichem Optimierungsziel je Kategorie
+# (Kosten als Tie-Break): (i) guenstigste; (ii) geringstes Ueberlaufvolumen
+# (Label m3 + %); (iii) hoechste Evapotranspiration (Label %, Punktgroesse =
+# Evapotranspiration). x = max_n_overflows, Linie ueber alle Klassen. Die beiden
+# Speichertypen liegen als zwei Panels untereinander (Sickerbox oben,
+# Schotterrigol unten); die Punkte bleiben Kreise, da die Panel-Streifen
+# den Typ bereits benennen.
+cost_boxplots <- list(
+ list(suffix = "cheapest", best_by = "min_cost",
+ size_by = "overflow_volume", label_best = FALSE),
+ list(suffix = "min-overflow", best_by = "min_overflow",
+ size_by = "overflow_volume", label_best = TRUE),
+ list(suffix = "max-evap", best_by = "max_evapotranspiration",
+ size_by = "evapotranspiration", label_best = TRUE)
+)
+for (cb in cost_boxplots) {
+ pdff <- sprintf(
+ "simulation_results_optimisation_%s_cost-by-overflows-boxplot-%s.pdf",
+ paths$modelname, cb$suffix)
+ kwb.utils::preparePdf(pdfFile = pdff)
+
+ p <- kwb.raindrop::plot_cost_overflow_boxplot(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang,
+ facet_storage_type = TRUE,
+ size_by = cb$size_by,
+ best_by = cb$best_by,
+ label_best = cb$label_best
+ )
+
+ # interaktiv als HTML
+ plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+ htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf(
+ "simulation_results_optimisation_%s_cost-by-overflows-boxplot-%s.html",
+ paths$modelname, cb$suffix),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost boxplot (%s)", paths$modelname, cb$suffix)
+ )
+
+ # statisch ins PDF (WICHTIG!)
+ suppressWarnings(print(p))
+ dev.off()
+}
+
+
+# Kosten vs. Evapotranspiration: Streudiagramm ueber den Design-Raum, Punktform
+# kodiert den Speichertyp (Viereck = Sickerbox, Dreieck = Schotterrigol),
+# Farbe die Anzahl Ueberlaufereignisse.
+pdff <- sprintf("simulation_results_optimisation_%s_cost-vs-evaporation.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_vs_evaporation(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang
+)
+
+# interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+# statt der (Farbe, Form)-Tupel von ggplotly
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf("simulation_results_optimisation_%s_cost-vs-evaporation.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost vs. evapotranspiration",
+ paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
+dev.off()
+
+
+# Kosten je Prozent Evapotranspiration [EUR/%]: Boxplot je Ueberlaufklasse mit den
+# beiden Speichertypen als zwei Panels untereinander (Sickerbox oben,
+# Schotterrigol unten); guenstigstes Szenario je Box markiert (Label EUR/%),
+# Punktgroesse = Evapotranspiration.
+pdff <- sprintf(
+ "simulation_results_optimisation_%s_cost-per-evap-boxplot.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_overflow_boxplot(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang,
+ y_var = "cost_per_evap_pct",
+ facet_storage_type = TRUE,
+ size_by = "evapotranspiration",
+ best_by = "min_cost",
+ label_best = TRUE
+)
+
+# interaktiv als HTML
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf(
+ "simulation_results_optimisation_%s_cost-per-evap-boxplot.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost per %% evapotranspiration", paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
+dev.off()
+
```
\ No newline at end of file
diff --git a/vignettes/workflow_eisenstadt-2005_neu.Rmd b/vignettes/workflow_eisenstadt-2005_neu.Rmd
deleted file mode 100644
index 5c74100..0000000
--- a/vignettes/workflow_eisenstadt-2005_neu.Rmd
+++ /dev/null
@@ -1,408 +0,0 @@
----
-title: "Workflow Eisenstadt (2005, neuer Rechenkern 2026-01-22)"
-output: rmarkdown::html_vignette
-vignette: >
- %\VignetteIndexEntry{Workflow Eisenstadt (2005, neuer Rechenkern 2026-01-22)}
- %\VignetteEngine{knitr::rmarkdown}
- %\VignetteEncoding{UTF-8}
----
-
-```{r, include = FALSE, eval=TRUE}
-knitr::opts_chunk$set(
- collapse = TRUE,
- comment = "#>"
-)
-is_ghactions <- tolower(Sys.getenv("GITHUB_ACTIONS")) == "true" ||
- tolower(Sys.getenv("CI")) %in% c("true", "1", "yes")
-
-# base.h5 ships in inst/extdata/models/eisenstadt-2005/. The vignette only
-# renders if that file is present; the engine .exe is fetched from the
-# kwb.raindrop.binaries Release on demand and only runs on Windows.
-# This vignette pins engine 2026-01-22 — that release must exist in the
-# binaries repo for the run_model chunk to succeed locally on Windows.
-# On CI the engine is never downloaded (preparation builds path_exe via
-# the is_windows && !is_ghactions guard, and run_model itself is gated
-# off with !is_ghactions).
-path_base <- system.file("extdata/models/eisenstadt-2005/base.h5", package = "kwb.raindrop")
-data_available <- nzchar(path_base) && file.exists(path_base)
-is_windows <- Sys.info()[["sysname"]] == "Windows"
-engine_version <- "2026-01-22"
-```
-
-### Input data
-
-The HDF5 model template (`base.h5`) ships with the package under
-`inst/extdata/models/eisenstadt-2005/` and is produced with the
-Tandler "Regenwasserbewirtschaftung" calculation engine. This vignette
-pins engine version `2026-01-22` (newer Rechenkern); the engine is
-downloaded from the `KWB-R/kwb.raindrop.binaries` GitHub Release on
-demand via `kwb.raindrop::download_engine("2026-01-22")`.
-
-### Define Paths and Scenarios
-
-```{r preparation, eval = data_available}
-library(kwb.raindrop)
-
-path_list <- list(
- modelname = "Eisenstadt_2005",
- root_path = file.path(tempdir(), "raindrop_eisenstadt_2005_neu"),
- dir_input = "/models//input",
- dir_output = "/models//output",
- dir_target_output = "/",
- file_errors_hdf5 = "Fehlerprotokoll.h5",
- file_results_hdf5_element = "Mulde_Rigole.h5",
- file_results_hdf5_flaeche = "Dach.h5",
- file_results_hdf5_verschaltungen = "_Verschaltungen.h5",
- file_results_txt = "Mulde_Rigole_RAINDROP.txt",
- file_results_txt_multilayer = "Mulde_Rigole_RAINDROP_multi_layer.txt",
- file_target = ".h5",
- path_base = system.file("extdata/models/eisenstadt-2005/base.h5", package = "kwb.raindrop"),
- path_exe = if (is_windows && !is_ghactions) kwb.raindrop::download_engine(engine_version) else NA_character_,
- path_errors_hdf5 = "/",
- path_results_hdf5_element = "/",
- path_results_hdf5_flaeche = "/",
- path_results_hdf5_verschaltungen = "/",
- path_results_txt = "/",
- path_results_txt_multilayer = "/",
- path_target_input = "/"
-)
-
-
-parameters <- tibble::tibble(
- para_nama_short = c(
- "connected_area",
- "mulde_area",
- "mulde_height",
- "filter_hydraulicconductivity",
- # "filter_height",
- "storage_height"#,
- # "bottom_hydraulicconductivity"
- ),
- para_name_long = c(
- "/Massnahmenelemente/Dach/Allgemein/Flaeche",
- "/Massnahmenelemente/Mulde_Rigole/Allgemein/Flaeche",
- "/Massnahmenelemente/Mulde_Rigole/Eigenschaften_Oberflaeche/Ueberlaufhoehe",
- "Bodenarten/Bodenfilter/Ks_HydraulicConductivity",
- #"/Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Schichtdicken",
- "/Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Schichtdicken"#,
- # "/Massnahmenelemente/Mulde_Rigole/Allgemein/Endversickerungsrate"
- ),
- index = c(1L,
- 1L,
- 1L,
- 1L,
- 2)
-)
-
-DT::datatable(parameters,
- filter = "top",
- options = list(pageLength = 25,
- autoWidth = TRUE))
-
-
-connected_area <- 1000
-mulde_area <- c(25, 50, 75, 100, 125, 150, 175, 200)
-mulde_height <- c(100, 200, 300)
-filter_hydraulicconductivity <- c(36, 180, 360)
-filter_height <- 300
-storage_height <- c(100, 500, 1000)
-rain_factor <- 1
-bottom_hydraulicconductivity <- 12 #c(1,5,10,20,45,90,180,270,360,1860,3600)
-
-
-# Alle Kombinationen erzeugen
-param_grid_all_combinations <- expand.grid(
- connected_area = connected_area,
- mulde_area = mulde_area,
- mulde_height = mulde_height,
- filter_hydraulicconductivity = filter_hydraulicconductivity,
- filter_height = filter_height,
- storage_height = storage_height,
- bottom_hydraulicconductivity = bottom_hydraulicconductivity,
- rain_factor = rain_factor
-)
-
-param_grid_all_combinations <- param_grid_all_combinations %>%
- dplyr::bind_cols(tibble::tibble(scenario_name = sprintf("s%05d",
- seq_len(nrow(param_grid_all_combinations)))))
-
-ref_scenario <- param_grid_all_combinations %>%
- dplyr::filter(connected_area == min(unique(param_grid_all_combinations$connected_area)),
- mulde_area == min(unique(param_grid_all_combinations$mulde_area)),
- filter_height == min(filter_height),
- filter_hydraulicconductivity == min(param_grid_all_combinations$filter_hydraulicconductivity),
- bottom_hydraulicconductivity == min(unique(param_grid_all_combinations$bottom_hydraulicconductivity)),
- mulde_height == min(param_grid_all_combinations$mulde_height),
- storage_height == min(param_grid_all_combinations$storage_height)) %>%
- dplyr::pull(scenario_name)
-
-stopifnot(length(ref_scenario)==1)
-
-scenarios_with_single_parameter_variation <- kwb.raindrop::find_single_param_variations(
- data = param_grid_all_combinations,
- ref_scenario = ref_scenario
- ) %>%
- dplyr::pull(scenario_name) %>% unique()
-
-param_grid <- param_grid_all_combinations %>%
- dplyr::filter(scenario_name %in% scenarios_with_single_parameter_variation)
-param_grid <- param_grid_all_combinations
-
-DT::datatable(param_grid,
- filter = "top",
- options = list(pageLength = 25,
- autoWidth = TRUE))
-
-htmlwidgets::saveWidget(DT::datatable(parameters,
- filter = "top",
- options = list(pageLength = 25,
- autoWidth = TRUE)), "parameters.html")
-htmlwidgets::saveWidget(DT::datatable(param_grid,
- filter = "top",
- options = list(pageLength = 25,
- autoWidth = TRUE)), "param_grid.html")
-
-
-psi_s_mm <- function(kf_mmh) (3.237 * (kf_mmh/25.4)^(-0.328)) * 25.4
-
-paths <- kwb.utils::resolve(path_list)
-```
-
-### Run Model
-
-```{r run_model, eval = data_available && is_windows && !is_ghactions}
-run_one <- function(i,
- timestep_hours,
- debug = FALSE,
- ...) {
-
- param_grid_tmp <- param_grid[i, ]
-
- paths <- kwb.utils::resolve(path_list,
- dir_target = param_grid_tmp$scenario_name)
-
- fs::dir_create(paths$dir_input, recurse = TRUE)
- fs::dir_create(paths$dir_output, recurse = TRUE)
- fs::dir_create(paths$dir_target_output, recurse = TRUE)
-
- fs::file_copy(path = paths$path_base,
- new_path = paths$path_target_input,
- overwrite = TRUE)
-
- h5 <- hdf5r::H5File$new(paths$path_target_input, mode = "a")
-
- new_path <- stringr::str_c(normalizePath(fs::path_abs(paths$dir_target_output)),
- "\\")
-
- vals <- kwb.raindrop::h5_read_values(h5)
-
- vals$`//Berechnungsparameter/Ergebnispfad` <- new_path
- vals$`//Berechnungsparameter/Zeitschritt_Infiltration` <- timestep_hours
- vals$`//Berechnungsparameter/Zeitschritt_ET` <- timestep_hours
- vals$`//Berechnungsparameter/Zeitschritt_Verschaltungen` <- timestep_hours
- vals$`//Berechnungsparameter/R-Plots` <- 0
- vals$`//Berechnungsparameter/Ausgabemodus` <- "Optimierung"
- vals$`//Berechnungsparameter/Evapotranspiration_aktiv` <- 1
-
- vals$`//Massnahmenelemente/Dach/Berechnungsparameter/Evapotranspiration_aktiv` <- 1
- vals$`//Massnahmenelemente/Dach/Allgemein/Flaeche` <- param_grid_tmp$connected_area
-
- vals$`//Massnahmenelemente/Mulde_Rigole/Berechnungsparameter/Evapotranspiration_aktiv` <- 1
- vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Regen-Skalierungsfaktor` <- 1
- vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Flaeche` <- param_grid_tmp$mulde_area
- vals$`//Massnahmenelemente/Mulde_Rigole/Eigenschaften_Oberflaeche/Ueberlaufhoehe` <- param_grid_tmp$mulde_height
- vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Startwerte_theta_ActualSoilMoisture` <- c(0.3, 0)
- vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Schichtdicken` <- c(param_grid_tmp$filter_height,
- param_grid_tmp$storage_height)
- vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Endversickerungsrate` <- param_grid_tmp$bottom_hydraulicconductivity
-
- vals$`//Bodenarten/Bodenfilter/Ks_HydraulicConductivity` <- param_grid_tmp$filter_hydraulicconductivity
- vals$`//Bodenarten/Bodenfilter/Psi_Saugspannung_CapillarySuction` <- psi_s_mm(param_grid_tmp$filter_hydraulicconductivity)
-
- kwb.raindrop::h5_write_values(h5, vals, resize = TRUE,
- scalar_strategy = "error",
- verbose = FALSE)
- h5$close_all()
-
- kwb.raindrop::run_model(path_exe = paths$path_exe,
- path_input = paths$path_target_input,
- debug = debug)
-
- invisible(NULL)
-}
-
-n_cores <- parallel::detectCores()
-
-system.time(expr = {
-kwb.raindrop::run_scenarios(indices = seq_len(nrow(param_grid)),
- run_one_scenario = run_one,
- timestep_hours = 0.1,
- debug = FALSE,
- parallel = TRUE,
- workers = n_cores,
- show_progress = TRUE
- )
-}
-)
-
-### Read results for first run
-if(FALSE) {
-paths <- kwb.utils::resolve(path_list,
- dir_target = sprintf("s%05d", i = 1))
-
-#simulation_names <- basename(fs::dir_ls(paths$dir_output))
-simulation_names <- scenarios_with_single_parameter_variation
-simulation_names <- param_grid$scenario_nam
-simulation_names <- simulation_names[1:8]
-
-debug <- TRUEn_cores
-errors_df <- kwb.raindrop::read_raindrop_errors(simulation_names, path_list)
-x <- tidyr::unnest(errors_df, errors)
-x$Fehlerbeschreibung
-}
-
-```
-
-### Analyse Results
-
-```{r analyse_results, eval = data_available && is_windows && !is_ghactions}
-system.time(
-simulation_results <- kwb.raindrop::get_simulation_results_optim_parallel(
- paths = paths,
- path_list = path_list,
- simulation_names = param_grid$scenario_name,
- debug = FALSE)
-)
-
-system.time(
-simulation_results_optimisation <- kwb.raindrop::add_overflow_events_and_waterbalance(
- simulation_results = simulation_results,
- event_separation_hours = 4,
- canonical_variables = kwb.raindrop::default_canonical_wb_variables()
- )
-)
-
-simulation_results_optimisation <- param_grid %>%
- dplyr::left_join(simulation_results_optimisation,
- by = c("scenario_name" = "s_name")) %>%
- dplyr::relocate(scenario_name, .before = connected_area)
-
-readr::write_csv(simulation_results_optimisation,
- file = sprintf("simulation_results_optimisation_%s.csv",
- paths$modelname)
- )
-
-htmlwidgets::saveWidget(DT::datatable(simulation_results_optimisation,
- filter = "top",
- options = list(pageLength = 25,
- autoWidth = TRUE)),
- file = sprintf("simulation_results_optimisation_%s.html",
- paths$modelname),
- title = "RAINDROP - Solution Space")
-
-### Plot results
-
-
-params <- c(
- #"connected_area",
- "mulde_area",
- "mulde_height",
- "filter_hydraulicconductivity",
- #"filter_height",
- "storage_height"#,
- #"bottom_hydraulicconductivity",
- #"rain_factor"
-)
-
-pdff <- sprintf("simulation_results_optimisation_%s_main-effects.pdf",
- paths$modelname)
-
-gg <- kwb.raindrop::plot_main_effects(
- df = simulation_results_optimisation,
- y = "n_overflows",
- params = params
-)
-
-# --- 1) Statisch ins PDF: kein Plotly dazwischen!
-kwb.utils::preparePdf(pdfFile = pdff)
-print(gg)
-dev.off()
-#kwb.utils::finishAndShowPdf(pdff)
-
-# --- 2) Interaktiv als HTML: nach dem PDF
-plotly_gg <- plotly::ggplotly(gg)
-
-htmlwidgets::saveWidget(
- widget = plotly_gg,
- file = sprintf("simulation_results_optimisation_%s_main-effects.html",
- paths$modelname),
- selfcontained = TRUE,
- title = "RAINDROP - Main Effects"
-)
-
-
-
-pdff <- sprintf("simulation_results_optimisation_%s_design-space_mulde-area_vs_parameters.pdf",
- paths$modelname)
-kwb.utils::preparePdf(pdfFile = pdff)
-
-for (y in c("mulde_height", "filter_hydraulicconductivity", "storage_height")) {
-
- p <- kwb.raindrop::plot_valid_design_space(
- param_grid = param_grid,
- sim_results = simulation_results_optimisation,
- x = "mulde_area",
- y = y,
- valid_max = 1,
- jitter = TRUE,
- alpha_mode = "duplicates",
- alpha_min = 0.25,
- alpha_max = 1,
- drop_overflow_gt_valid_max = TRUE,
- keep_param_grid_limits = TRUE
- )
-
- # interaktiv als HTML
- plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
- htmlwidgets::saveWidget(
- widget = plotly_p,
- file = sprintf("simulation_results_optimisation_%s_design-space_mulde-area_vs_%s.html",
- paths$modelname,
- y),
- selfcontained = TRUE,
- title = sprintf("Design Space: mulde_area vs. %s", y)
- )
-
- # statisch ins PDF (WICHTIG!)
- suppressWarnings(print(p))
-}
-dev.off()
-#kwb.utils::finishAndShowPdf(pdff)
-
-pdff <- sprintf("simulation_results_optimisation_%s_water-balance.pdf",
- paths$modelname)
-kwb.utils::preparePdf(pdfFile = pdff)
-
-p <- kwb.raindrop::plot_wb_tradeoff_overflows(
- simulation_results_optimisation = simulation_results_optimisation,
- param_grid = param_grid,
- filter_n_gt1 = TRUE,
- use_jitter = TRUE
- )
-
- # interaktiv als HTML
- plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
- htmlwidgets::saveWidget(
- widget = plotly_p,
- file = sprintf("simulation_results_optimisation_%s_water-balance.html",
- paths$modelname),
- selfcontained = TRUE,
- title = "Water balance vs overflows"
- )
-
- # statisch ins PDF (WICHTIG!)
- suppressWarnings(print(p))
-dev.off()
-#kwb.utils::finishAndShowPdf(pdff)
-
-```
diff --git a/vignettes/workflow_optimisation.Rmd b/vignettes/workflow_optimisation.Rmd
new file mode 100644
index 0000000..fbbd302
--- /dev/null
+++ b/vignettes/workflow_optimisation.Rmd
@@ -0,0 +1,507 @@
+---
+title: "Workflow Optimierung (Eisenstadt · Wien · Bad Aussee)"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Workflow Optimierung (Eisenstadt · Wien · Bad Aussee)}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include = FALSE, eval = TRUE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ fig.width = 7.5,
+ fig.height = 3.2
+)
+is_ghactions <- tolower(Sys.getenv("GITHUB_ACTIONS")) == "true" ||
+ tolower(Sys.getenv("CI")) %in% c("true", "1", "yes")
+
+# extdata robust aufloesen: zuerst installiertes Paket, sonst Quellbaum
+# (Knit direkt im Repo, auch ohne installiertes kwb.raindrop)
+extdata_path <- function(...) {
+ p <- system.file("extdata", ..., package = "kwb.raindrop")
+ if (nzchar(p)) return(p)
+ src <- file.path("..", "inst", "extdata", ...)
+ if (file.exists(src)) normalizePath(src) else ""
+}
+
+path_base <- extdata_path("models", "eisenstadt-2005", "base.h5")
+data_available <- nzchar(path_base) && file.exists(path_base)
+is_windows <- Sys.info()[["sysname"]] == "Windows"
+can_run <- data_available && is_windows && !is_ghactions
+
+t_vignette_start <- Sys.time()
+```
+
+## Ziel
+
+Dieser Workflow findet für **alle drei Standorte** (Eisenstadt 2005,
+Wien, Bad Aussee) die **günstigste Muldenkonfiguration je Überlaufziel**
+x = 0…5 — pro Speichertyp (Sickerbox / Schotterrigol) — mit
+`optimise_swale_design()` statt eines Brute-Force-Rasters. Das Verfahren
+ist reine Bisektion ("Zahlenraten"): Fläche schrumpfen, dann Muldentiefe,
+Speicher nur erhöhen, wenn die Fläche am Anschlag klemmt. Voraussetzung
+ist die in der
+[Monotonie-Analyse](https://raindrop.kompetenz-wasser.io/optimisation/monotonicity_analysis/)
+belegte Monotonie
+("größer = nie mehr Überläufe"); die dort abgeleiteten Absicherungen
+(Rand-Guard, Volumen-Schiedsrichter) sind in `find_min_feasible()`
+eingebaut. Eine unabhängige **Gegenprobe ohne Monotonie-Annahme** —
+simultane Optimierung aller Parameter, plus weitere Suchverfahren zum
+Vergleich — führt die separate Vignette
+`workflow_optimisation_simultaneous` durch; sie liest die hier
+exportierte CSV als Vergleichsbasis.
+
+Die Filterdurchlässigkeit wird fest auf das Maximum gesetzt (kostenfrei
+dominant: gleiche Verdunstung, nie mehr Überläufe), Fläche und
+Muldentiefe werden stufenlos gesucht, die Sickerbox in den
+Default-Stufen 300/600/900/1200 mm (`sickerbox_level_presets()` bietet
+Hersteller-Alternativen), der Schotterrigol stufenlos im 3-fachen
+Box-Bereich.
+
+**Laufzeit:** Ein Engine-Lauf dauert ~2 s (Eisenstadt, 1 Jahr) bzw.
+~15 s (Wien / Bad Aussee, 15-Jahres-Serien). Die 6 Tasks
+(Standort × Speichertyp) laufen parallel; die Gesamtdauer entspricht
+dem längsten Einzeltask — ca. 15–20 Minuten. `make_swale_runner()`
+löscht die Szenario-Dateien jedes Laufs standardmäßig direkt nach dem
+Einlesen (`cleanup = TRUE`), damit lange Suchen das Temp-Laufwerk nicht
+füllen.
+
+```{r availability_note, echo = FALSE, results = 'asis', eval = !can_run}
+cat(sprintf(paste0(
+ "> **Hinweis:** Die Rechen-Chunks wurden übersprungen. Prüfungen: ",
+ "Windows: %s · CI/GitHub Actions: %s · base.h5 gefunden: %s (%s). ",
+ "Auf einem lokalen Windows-Rechner sollten alle drei Bedingungen ",
+ "erfüllt sein — falls base.h5 fehlt: Vignette aus dem Paket-Repo ",
+ "heraus rendern oder das Paket installieren.\n"),
+ is_windows, is_ghactions, data_available,
+ if (nzchar(path_base)) path_base else "weder installiert noch ../inst/extdata"
+))
+```
+
+## Standort-Konfiguration
+
+Die Standorte unterscheiden sich nur in zwei Punkten: dem
+Modell-Template (`base.h5`) und der Frage, ob eigene Regen-/ET0-Zeitreihen
+in die Engine geschrieben werden (Wien und Bad Aussee) oder die Kurven
+aus `base.h5` verwendet werden (Eisenstadt). Beides kapselt
+`make_swale_runner()`; die Zeitreihen-Aufbereitung (mm/h-Konvention,
+Serien-Angleichung) übernimmt `read_site_timeseries()`.
+
+```{r site_config, eval = can_run}
+# Im Quellbaum die Entwicklungsversion laden (immer aktuell, auch wenn
+# das installierte Paket aelter ist); ausserhalb: installiertes Paket.
+if (file.exists("../DESCRIPTION") &&
+ requireNamespace("pkgload", quietly = TRUE)) {
+ pkgload::load_all("..", quiet = TRUE)
+} else {
+ library(kwb.raindrop)
+}
+
+sites <- list(
+ Eisenstadt_2005 = list(dir = "eisenstadt-2005", timeseries = FALSE,
+ prior = "simulation_results_optimisation_Eisenstadt_2005.csv"),
+ Wien = list(dir = "wien", timeseries = TRUE,
+ prior = "simulation_results_optimisation_Wien.csv"),
+ BadAussee = list(dir = "badaussee", timeseries = TRUE,
+ prior = "simulation_results_optimisation_BadAussee.csv")
+)
+
+fixed <- list(connected_area = 1000,
+ filter_height = 300,
+ filter_hydraulicconductivity = 360, # Rastermaximum, gratis
+ bottom_hydraulicconductivity = 12)
+
+make_path_list <- function(modelname, model_dir) {
+ list(
+ modelname = modelname,
+ root_path = file.path(tempdir(), paste0("raindrop_opt_", model_dir)),
+ dir_input = "/models//input",
+ dir_output = "/models//output",
+ dir_target_output = "/",
+ file_errors_hdf5 = "Fehlerprotokoll.h5",
+ file_results_hdf5_element = "Mulde_Rigole.h5",
+ file_results_hdf5_flaeche = "Dach.h5",
+ file_results_hdf5_verschaltungen = "_Verschaltungen.h5",
+ file_results_txt = "Mulde_Rigole_RAINDROP.txt",
+ file_results_txt_multilayer = "Mulde_Rigole_RAINDROP_multi_layer.txt",
+ file_target = ".h5",
+ path_base = extdata_path("models", model_dir, "base.h5"),
+ path_exe = download_engine(),
+ path_errors_hdf5 = "/",
+ path_results_hdf5_element = "/",
+ path_results_hdf5_flaeche = "/",
+ path_results_hdf5_verschaltungen = "/",
+ path_results_txt = "/",
+ path_results_txt_multilayer = "/",
+ path_target_input = "/"
+ )
+}
+```
+
+## Suchraum und Kostensätze
+
+Die Suchbereiche der variablen Parameter sind die Default-Argumente von
+`optimise_swale_design()` — bewusst identisch mit den min/max-Bereichen
+des Brute-Force-Rasters, denn nur dort ist die Monotonie geprüft. Hier
+stehen sie explizit, damit sie sichtbar und anpassbar sind:
+
+```{r search_space, eval = can_run}
+area_bounds <- c(25, 200) # Muldenflaeche [m2], stufenlos
+area_tol <- 2 # Aufloesung der Flaechensuche [m2];
+ # jede Halbierung kostet nur 1 Lauf je
+ # Flaechensuche und halbiert den
+ # toleranzbedingten Kostenueberschuss
+height_bounds <- c(100, 300) # Muldentiefe [mm], stufenlos
+height_tol <- 10 # Aufloesung der Tiefensuche [mm]
+storage_spec <- default_storage_spec()
+# Alternativ Hersteller-Stufen, z. B.:
+# storage_spec <- default_storage_spec(
+# levels = sickerbox_level_presets()$graf_ecobloc_smart)
+
+knitr::kable(tibble::tibble(
+ Parameter = c("mulde_area [m2]", "mulde_height [mm]",
+ "storage_height Sickerbox [mm]",
+ "storage_height Schotterrigol [mm]",
+ "filter_hydraulicconductivity [mm/h]",
+ "filter_height [mm]"),
+ Suchraum = c(
+ sprintf("stufenlos %g bis %g (Toleranz %g)",
+ area_bounds[1], area_bounds[2], area_tol),
+ sprintf("stufenlos %g bis %g (Toleranz %g)",
+ height_bounds[1], height_bounds[2], height_tol),
+ paste("Stufen:",
+ paste(storage_spec$infiltration_box$levels, collapse = " / ")),
+ sprintf("stufenlos %g bis %g (Toleranz %g)",
+ storage_spec$gravel_trench$bounds[1],
+ storage_spec$gravel_trench$bounds[2],
+ storage_spec$gravel_trench$tol),
+ "fix = 360 (Rastermaximum; kostenfrei dominant)",
+ "fix = 300"
+ )
+))
+```
+
+Die Kostensätze sind die Defaults nach Leimgruber (2026-03-27,
+`default_cost_rates()`); einzelne Sätze lassen sich hier überschreiben —
+gerechnet wird zunächst mit den Defaults. Die Suchreihenfolge der
+Bisektion wird dabei **aus den Sätzen hergeleitet** (Spezifikkosten-Proxy:
+€ je mm Speicherkapazität, Kapazitätsmodell V ≈ Fläche × (Tiefe +
+Porosität × Speicher); die Porosität liefert `default_storage_spec()`):
+Die Muldentiefe zu maximieren ist unter diesem Kostenmodell für *jeden*
+Satz optimal, die Start-Speicherstufe wählt der Proxy — kleinste Stufe
+bei den Default-Sätzen, hohe Stufe z. B. bei billigem Speichermaterial.
+Der Proxy ist eine Näherung erster Ordnung (kapazitäts-additive Hebel);
+die annahmefreie Gegenprobe — und das Mittel der Wahl bei nichtlinearen
+Hebeln — bleibt die Vignette `workflow_optimisation_simultaneous`:
+
+```{r cost_rates, eval = can_run}
+cost_rates <- default_cost_rates()
+# Beispiel fuer eine Anpassung (auskommentiert):
+# cost_rates$excavation_eur_per_m3 <- 85
+# cost_rates$infiltration_box_eur_per_m3 <- 400
+
+knitr::kable(
+ tibble::tibble(Kostensatz = names(cost_rates),
+ `EUR je m2/m3` = unlist(cost_rates)),
+ caption = "Kostensaetze (inkl. Einbau)"
+)
+```
+
+## Optimierung aller Standorte (parallel)
+
+Parallelisiert wird über **Standort × Speichertyp = 6 unabhängige
+Tasks**: Die Bisektion innerhalb einer Suche ist prinzipbedingt
+sequentiell, und die x-Ziele eines Speichertyps teilen sich den
+Evaluations-Cache — aber Box- und Rigol-Läufe teilen keinen einzigen
+Engine-Lauf (der Cache-Schlüssel enthält den Typ). Jeder Worker ist ein
+eigener R-Prozess mit eigenem `tempdir()`, Kollisionen sind damit
+ausgeschlossen. Die Wall-Time entspricht dem längsten Einzeltask
+(Wien/Rigol, ~15–20 min) statt der Summe aller Tasks (~65 min).
+
+Liegen die Rasterergebnisse der Workflow-Vignetten als CSV neben dieser
+Vignette, verengen sie als Warmstart die erste Flächensuche auf einen
+25-m²-Rasterschritt.
+
+```{r optimise_all, eval = can_run}
+t_opt_start <- Sys.time()
+
+tasks <- expand.grid(site = names(sites), type = names(storage_spec),
+ stringsAsFactors = FALSE)
+
+future::plan(future::multisession,
+ workers = min(nrow(tasks),
+ max(1, parallel::detectCores() - 1)))
+
+opt_list <- future.apply::future_lapply(seq_len(nrow(tasks)), function(i) {
+ site <- tasks$site[i]
+ type <- tasks$type[i]
+
+ # Worker = eigener Prozess: Paket dort genauso laden wie im Hauptprozess
+ if (file.exists("../DESCRIPTION") &&
+ requireNamespace("pkgload", quietly = TRUE)) {
+ pkgload::load_all("..", quiet = TRUE)
+ } else {
+ library(kwb.raindrop)
+ }
+
+ cfg <- sites[[site]]
+ ts <- if (cfg$timeseries) {
+ read_site_timeseries(
+ extdata_path("models", cfg$dir, "rain.csv.gz"),
+ extdata_path("models", cfg$dir, "et.csv"),
+ verbose = FALSE
+ )
+ } else {
+ NULL
+ }
+
+ run_fn <- make_swale_runner(make_path_list(site, cfg$dir),
+ timeseries_rain = ts$rain,
+ timeseries_et = ts$et)
+
+ prior <- if (file.exists(cfg$prior)) {
+ readr::read_csv(cfg$prior, show_col_types = FALSE)
+ } else {
+ NULL
+ }
+
+ t0 <- Sys.time()
+ opt <- optimise_swale_design(run_fn, x_targets = 0:5,
+ area_bounds = area_bounds,
+ area_tol = area_tol,
+ height_bounds = height_bounds,
+ height_tol = height_tol,
+ storage_spec = storage_spec[type],
+ fixed = fixed,
+ prior_results = prior,
+ cost_rates = cost_rates,
+ verbose = FALSE)
+ opt$site <- site
+ opt$n_runs_task <- attr(opt, "n_runs_total")
+ opt$minutes_task <- round(as.numeric(
+ difftime(Sys.time(), t0, units = "mins")), 1)
+ opt
+}, future.seed = TRUE)
+
+future::plan(future::sequential)
+opt_all <- dplyr::bind_rows(opt_list)
+
+t_opt_end <- Sys.time()
+```
+
+## Ergebnis: günstigstes Design je Standort und Überlaufziel
+
+```{r results_table, eval = can_run}
+knitr::kable(
+ opt_all[, c("site", "x", "storage_type", "status", "mulde_area",
+ "mulde_height", "storage_height", "n_overflows",
+ "overflow_volume_m3", "et_pct", "cost_total")],
+ digits = c(NA, 0, NA, NA, 1, 0, 0, 0, 1, 1, 0)
+)
+```
+
+```{r cost_curves, eval = can_run, fig.height = 3.4}
+library(ggplot2)
+
+ok <- opt_all[opt_all$status == "ok", ]
+ggplot(ok, aes(x, cost_total / 1000, colour = storage_type)) +
+ geom_line() +
+ geom_point(size = 2) +
+ facet_wrap(~ site, scales = "free_y") +
+ scale_x_continuous(breaks = 0:5) +
+ labs(title = "Kosten-Wirksamkeits-Kurven: Was kostet ein Ueberlauf weniger?",
+ x = "Ueberlaufziel x (zulaessige Ereignisse)",
+ y = "Kosten Optimum [Tsd. EUR]",
+ colour = "Speichertyp",
+ caption = cost_rates_caption("de", cost_rates)) +
+ theme_bw()
+```
+
+```{r export, eval = can_run}
+readr::write_csv(opt_all, "optimisation_results_all_sites.csv")
+for (site in unique(opt_all$site)) {
+ readr::write_csv(opt_all[opt_all$site == site, ],
+ sprintf("optimisation_results_%s.csv", site))
+}
+
+task_stats <- unique(opt_all[, c("site", "storage_type", "n_runs_task",
+ "minutes_task")])
+knitr::kable(
+ task_stats,
+ col.names = c("Standort", "Speichertyp", "Engine-Laeufe", "Minuten")
+)
+```
+
+```{r runtime_total, echo = FALSE, results = 'asis', eval = can_run}
+opt_wall_min <- as.numeric(difftime(t_opt_end, t_opt_start, units = "mins"))
+cat(sprintf(paste0(
+ "**Gesamtlaufzeit Optimierung:** %d Engine-Läufe · Summe der ",
+ "Task-Zeiten %.1f min · tatsächliche Laufzeit %.1f min ",
+ "(paralleler Speedup %.1f×).\n"),
+ sum(task_stats$n_runs_task), sum(task_stats$minutes_task),
+ opt_wall_min, sum(task_stats$minutes_task) / max(opt_wall_min, 0.1)
+))
+```
+
+## Monte-Carlo-Analyse: Wie robust ist die Suche selbst?
+
+Die Bisektion ist deterministisch: gleiche Eingaben, gleicher Pfad,
+gleiches Ergebnis. Die Monte-Carlo-Frage lautet deshalb: **Hängt das
+gefundene Optimum vom Suchpfad ab?** Dazu wird der Teilungspunkt jeder
+Bisektion zufällig verschoben (`split_jitter = 0.3`: Teilung zufällig
+zwischen 20 % und 80 % des Intervalls statt exakt mittig) und die
+Optimierung `n_mc`-mal mit unterschiedlichen Seeds wiederholt — **Regen,
+Kostensätze und alle übrigen Eingaben bleiben unverändert** (x = 1, ohne
+Warmstart, damit jede Wiederholung den vollen Suchraum durchläuft).
+Gerechnet wird der volle Pool **3 Standorte × 2 Speichertypen ×
+`n_mc` Wiederholungen = 60 unabhängige Tasks**, alle parallel (je Task
+eine komplette Neu-Optimierung mit ~15 Engine-Läufen; Wall-Time je nach
+Kernzahl ~20–35 min). Erwartung, wenn das Optimum eine
+Eigenschaft des Problems ist — und nicht des Wegs, den die Suche
+genommen hat: **identische Speicherstufe, Flächen-Spanne ≤
+2 × `area_tol`, Kostenspanne von wenigen Prozent**. Die Muldentiefe
+darf etwas weiter streuen als 2 × `height_tol`: Sie ist über die
+Hydraulik an die gefundene Fläche gekoppelt (eine um `area_tol` größere
+Fläche erlaubt eine entsprechend geringere Tiefe), sodass sich dort die
+Toleranzen beider Suchen addieren.
+
+```{r mc_config, eval = can_run}
+n_mc <- 10
+mc_seeds <- 1:n_mc
+```
+
+```{r mc_search, eval = can_run}
+t_mc_start <- Sys.time()
+
+mc_tasks <- expand.grid(site = names(sites), type = names(storage_spec),
+ rep = seq_len(n_mc), stringsAsFactors = FALSE)
+
+future::plan(future::multisession,
+ workers = min(nrow(mc_tasks),
+ max(1, parallel::detectCores() - 1)))
+
+mc_search <- future.apply::future_lapply(seq_len(nrow(mc_tasks)), function(i) {
+ site <- mc_tasks$site[i]
+ type <- mc_tasks$type[i]
+ rep <- mc_tasks$rep[i]
+
+ if (file.exists("../DESCRIPTION") &&
+ requireNamespace("pkgload", quietly = TRUE)) {
+ pkgload::load_all("..", quiet = TRUE)
+ } else {
+ library(kwb.raindrop)
+ }
+ set.seed(mc_seeds[rep])
+
+ cfg <- sites[[site]]
+ ts <- if (cfg$timeseries) {
+ read_site_timeseries(
+ extdata_path("models", cfg$dir, "rain.csv.gz"),
+ extdata_path("models", cfg$dir, "et.csv"),
+ verbose = FALSE
+ )
+ } else {
+ NULL
+ }
+ run_fn <- make_swale_runner(make_path_list(paste0(site, "_MC"), cfg$dir),
+ timeseries_rain = ts$rain,
+ timeseries_et = ts$et)
+
+ opt <- optimise_swale_design(
+ run_fn, x_targets = 1,
+ area_bounds = area_bounds, area_tol = area_tol,
+ height_bounds = height_bounds, height_tol = height_tol,
+ storage_spec = storage_spec[type],
+ fixed = fixed,
+ split_jitter = 0.3,
+ cost_rates = cost_rates, verbose = FALSE
+ )
+ opt$site <- site
+ opt$rep <- rep
+ opt$n_runs_rep <- attr(opt, "n_runs_total")
+ opt
+}, future.seed = TRUE)
+
+future::plan(future::sequential)
+mc_search <- dplyr::bind_rows(mc_search)
+
+t_mc_end <- Sys.time()
+```
+
+```{r mc_search_summary, eval = can_run, fig.height = 3.4}
+ok_mc <- mc_search[mc_search$status == "ok", ]
+
+ggplot(ok_mc, aes(rep, cost_total / 1000, colour = storage_type)) +
+ geom_point(size = 2) +
+ facet_wrap(~ site, scales = "free_y") +
+ scale_x_continuous(breaks = seq_len(n_mc)) +
+ labs(title = sprintf(
+ "Such-Monte-Carlo (x = 1, %d zufaellige Suchpfade je Standort und Typ)",
+ n_mc),
+ x = "Wiederholung (Seed)",
+ y = "Kosten Optimum [Tsd. EUR]",
+ colour = "Speichertyp") +
+ theme_bw()
+
+knitr::kable(
+ ok_mc %>%
+ dplyr::group_by(site, storage_type) %>%
+ dplyr::summarise(
+ flaeche_spanne_m2 = max(mulde_area) - min(mulde_area),
+ tiefe_spanne_mm = max(mulde_height) - min(mulde_height),
+ speicher_identisch = dplyr::n_distinct(storage_height) == 1,
+ kosten_min = min(cost_total),
+ kosten_max = max(cost_total),
+ kosten_spanne_pct = round(100 * (max(cost_total) - min(cost_total)) /
+ min(cost_total), 2),
+ .groups = "drop"
+ ),
+ digits = 1,
+ caption = paste("Streuung ueber die Suchpfade -- erwartet: identische",
+ "Speicherstufe, Flaechen-Spanne <= 2 x area_tol,",
+ "Kostenspanne wenige Prozent; die Tiefe streut wegen",
+ "der Flaechen-Kopplung weiter")
+)
+```
+
+```{r mc_runtime, echo = FALSE, results = 'asis', eval = can_run}
+cat(sprintf(paste0(
+ "**Laufzeit Such-Monte-Carlo:** %d Engine-Läufe in %.1f min ",
+ "(parallel über %d Tasks: %d Standorte × %d Speichertypen × ",
+ "%d Wiederholungen).\n"),
+ sum(mc_search$n_runs_rep),
+ as.numeric(difftime(t_mc_end, t_mc_start, units = "mins")),
+ nrow(mc_tasks), length(sites), length(storage_spec), n_mc
+))
+```
+
+## Einordnung
+
+- **Plausibilität:** Die Optima müssen auf oder knapp unter den
+ günstigsten zulässigen Rasterzellen liegen (Warmstart-Tabelle der
+ Monotonie-Analyse); die Kostenkurven müssen monoton fallen.
+ `monotonicity_warning = TRUE` in einer Zeile hieße: Zähler *und*
+ Volumen sind gemeinsam gestiegen — dann Branch prüfen.
+- **Wien x = 0** ist der Stresstest: Im Raster war das Ziel mit
+ minimalem Speicher teils unerreichbar — hier greift die
+ Speicher-Eskalation automatisch; "infeasible_within_bounds" wäre ein
+ reguläres Ergebnis, kein Fehler.
+- **Bad Aussee x = 1** trägt den bekannten +1-Zählwobble am Rasterrand;
+ der Rand-Guard in `find_min_feasible()` deckt ihn ab.
+- **Nebenbedingung Tiefe:** `max_total_depth` (mm) begrenzt
+ Muldentiefe + Filter + Speicher analytisch (DWA-A 138 / Überdeckung),
+ ohne zusätzliche Läufe.
+
+```{r vignette_runtime, echo = FALSE, results = 'asis', eval = can_run}
+cat(sprintf(paste0(
+ "---\n\n**Gesamtlaufzeit dieser Vignette:** %.1f Minuten ",
+ "(Optimierung %.1f min · Such-Monte-Carlo %.1f min · ",
+ "Rest: Setup und Rendern).\n"),
+ as.numeric(difftime(Sys.time(), t_vignette_start, units = "mins")),
+ opt_wall_min,
+ as.numeric(difftime(t_mc_end, t_mc_start, units = "mins"))
+))
+```
+
diff --git a/vignettes/workflow_optimisation_simultaneous.Rmd b/vignettes/workflow_optimisation_simultaneous.Rmd
new file mode 100644
index 0000000..7ab14dd
--- /dev/null
+++ b/vignettes/workflow_optimisation_simultaneous.Rmd
@@ -0,0 +1,507 @@
+---
+title: "Workflow Optimierung — Simultane Suche (alle Parameter gleichzeitig)"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Workflow Optimierung — Simultane Suche (alle Parameter gleichzeitig)}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include = FALSE, eval = TRUE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>",
+ fig.width = 7.5,
+ fig.height = 3.2
+)
+is_ghactions <- tolower(Sys.getenv("GITHUB_ACTIONS")) == "true" ||
+ tolower(Sys.getenv("CI")) %in% c("true", "1", "yes")
+
+# extdata robust aufloesen: zuerst installiertes Paket, sonst Quellbaum
+# (Knit direkt im Repo, auch ohne installiertes kwb.raindrop)
+extdata_path <- function(...) {
+ p <- system.file("extdata", ..., package = "kwb.raindrop")
+ if (nzchar(p)) return(p)
+ src <- file.path("..", "inst", "extdata", ...)
+ if (file.exists(src)) normalizePath(src) else ""
+}
+
+path_base <- extdata_path("models", "eisenstadt-2005", "base.h5")
+data_available <- nzchar(path_base) && file.exists(path_base)
+is_windows <- Sys.info()[["sysname"]] == "Windows"
+can_run <- data_available && is_windows && !is_ghactions
+
+t_vignette_start <- Sys.time()
+```
+
+## Ziel
+
+Die Vignette `workflow_optimisation` findet die günstigste
+Muldenkonfiguration je Überlaufziel per **Bisektion**: Parameter
+nacheinander, gestützt auf die Monotonie je Parameter
+([Monotonie-Analyse](https://raindrop.kompetenz-wasser.io/optimisation/monotonicity_analysis/)).
+Diese Vignette ist die **unabhängige
+Gegenprobe**: `optimise_swale_design_simultaneous()` optimiert **alle
+Parameter gleichzeitig** — Fläche, Muldentiefe und Speicherhöhe in einem
+Zug — und kommt dabei *ohne* die Monotonie-Annahme aus.
+
+Warum das funktioniert: Unzulässige Designs (`n_overflows > x`) werden
+nicht ausgeschlossen, sondern **bestraft** — jedes unzulässige Design ist
+teurer als jedes zulässige, und überzählige Überlaufereignisse staffeln
+die Strafe. Das Optimum liegt (Kosten steigen monoton mit jedem
+Parameter) genau *auf* der Zulässigkeitsgrenze; die Straffunktion erlaubt
+der Suche, diese Grenze zu überqueren, auf beiden Seiten Information zu
+sammeln und die Parameter in einem einzigen Schritt gegeneinander zu
+tauschen (z. B. weniger Fläche gegen mehr Speicher). Ein Ausschluss
+unzulässiger Punkte würde der Suche jenseits der Grenze jede
+Richtungsinformation nehmen — sie würde blind an der Grenze abprallen,
+statt an ihr entlangzuwandern.
+
+Drei Suchverfahren teilen sich dieselbe Infrastruktur (Straf-Ziel,
+Evaluations-Cache, Toleranz-Rasterung, Multi-Tal-Feinschliff) und
+unterscheiden sich nur darin, wie sie Kandidaten vorschlagen
+(`method`-Argument):
+
+* **`nelder_mead`** (Default, Empfehlung): Multistart-Simplex
+ (`stats::optim()`) — Warmstart, Optimum des vorigen x-Ziels, je ein
+ Anker-Start pro Speicherstufe, Raumfüller; jeder Start erhält einen
+ gleichen Anteil am Laufbudget (`max_evals`).
+* **`diff_evolution`**: kompakte Differential Evolution (DE/rand/1/bin)
+ — Vergleichsverfahren; deterministisch über einen internen
+ Park-Miller-Generator (`seed`-Argument), Rs globaler Zufallsstrom
+ (`.Random.seed`) bleibt unangetastet.
+* **`halton_search`**: quasi-zufällige, raumfüllende Halton-Stichprobe —
+ bewusst naive Baseline, die zeigt, was die strukturierten Verfahren
+ schlagen müssen.
+
+**Laufzeit:** Die simultane Suche braucht je (Speichertyp, x)-Zelle mehr
+Engine-Läufe als die Bisektion (typisch 60–120 statt ~15; Suchphase plus
+Feinschliff). Über 6 Überlaufziele summiert sich das auf ~400–700
+Engine-Läufe **je Task**; bei ~15 s je Lauf (Wien / Bad Aussee) sind das
+**2–3 h je Task** — und wenn weniger freie Kerne als 6 Tasks verfügbar
+sind, entsprechend mehr Wandzeit (realistisch **2–5 h** für den
+Nelder-Mead-Sweep). Eisenstadt (~2 s je Lauf) bleibt bei Minuten. Beide
+Rechen-Chunks zeigen deshalb einen **Live-Fortschrittsbalken** (ein Tick
+je Engine-Lauf, über `progressr` aus den Worker-Prozessen heraus) — ein
+über Minuten stehender Balken wäre ein echter Hänger, ein langsam
+wandernder ist Normalbetrieb. Der Methodenvergleich am Ende rechnet nur
+eine Zelle (x = 1) je Standort und Speichertyp. Wer zuerst einen
+schnellen Funktionstest will, rechnet nur Eisenstadt (Kommentar im
+Chunk `site_config`); der Laufzeit-Hebel für den vollen Sweep ist
+`max_evals` (Kommentar im selben Chunk).
+
+**Plattenplatz:** Jeder Engine-Lauf legt ein eigenes Szenario an (Kopie
+der `base.h5` plus Output-HDF5s). `make_swale_runner()` löscht diese
+Dateien standardmäßig direkt nach dem Einlesen der dünnen Ergebniszeile
+(`cleanup = TRUE`) — ohne dieses Aufräumen füllen mehrere hundert Läufe
+je Task das Temp-Laufwerk und die Engine bricht mit `No space left on
+device` ab. Vor einem Neustart nach einem solchen Abbruch die
+`raindrop_sim_*`-Verzeichnisse unter `tempdir()` bzw.
+`%LOCALAPPDATA%\Temp` (`Rtmp*`) löschen.
+
+```{r availability_note, echo = FALSE, results = 'asis', eval = !can_run}
+cat(sprintf(paste0(
+ "> **Hinweis:** Die Rechen-Chunks wurden übersprungen. Prüfungen: ",
+ "Windows: %s · CI/GitHub Actions: %s · base.h5 gefunden: %s (%s). ",
+ "Auf einem lokalen Windows-Rechner sollten alle drei Bedingungen ",
+ "erfüllt sein — falls base.h5 fehlt: Vignette aus dem Paket-Repo ",
+ "heraus rendern oder das Paket installieren.\n"),
+ is_windows, is_ghactions, data_available,
+ if (nzchar(path_base)) path_base else "weder installiert noch ../inst/extdata"
+))
+```
+
+## Standort-Konfiguration
+
+Identisch mit der Vignette `workflow_optimisation` (gleiche Standorte,
+gleiche Suchräume, gleiche Kostensätze — nur so ist der Vergleich
+aussagekräftig):
+
+```{r site_config, eval = can_run}
+# Im Quellbaum die Entwicklungsversion laden (immer aktuell, auch wenn
+# das installierte Paket aelter ist); ausserhalb: installiertes Paket.
+if (file.exists("../DESCRIPTION") &&
+ requireNamespace("pkgload", quietly = TRUE)) {
+ pkgload::load_all("..", quiet = TRUE)
+} else {
+ library(kwb.raindrop)
+}
+
+sites <- list(
+ Eisenstadt_2005 = list(dir = "eisenstadt-2005", timeseries = FALSE,
+ prior = "simulation_results_optimisation_Eisenstadt_2005.csv"),
+ Wien = list(dir = "wien", timeseries = TRUE,
+ prior = "simulation_results_optimisation_Wien.csv"),
+ BadAussee = list(dir = "badaussee", timeseries = TRUE,
+ prior = "simulation_results_optimisation_BadAussee.csv")
+)
+# Schneller Funktionstest (~15-30 min statt Stunden): nur Eisenstadt --
+# 1-Jahres-Modell, ~2 s je Engine-Lauf. Zusaetzlich beschleunigt ein
+# reduziertes Budget (z. B. max_evals <- 50) und, auf Windows deutlich,
+# eine Virenscanner-Ausnahme fuer %LOCALAPPDATA%\Temp (jede Szenario-
+# Datei und jeder Engine-Start wird sonst einzeln gescannt):
+sites <- sites["Eisenstadt_2005"]
+
+fixed <- list(connected_area = 1000,
+ filter_height = 300,
+ filter_hydraulicconductivity = 360, # Rastermaximum, gratis
+ bottom_hydraulicconductivity = 12)
+
+area_bounds <- c(25, 200) # Muldenflaeche [m2], stufenlos
+area_tol <- 2 # Aufloesung der Flaechensuche [m2]
+height_bounds <- c(100, 300) # Muldentiefe [mm], stufenlos
+height_tol <- 10 # Aufloesung der Tiefensuche [mm]
+storage_spec <- default_storage_spec()
+cost_rates <- default_cost_rates()
+max_evals <- 80 # Laufzeit-Hebel: Budget an frischen
+ # Engine-Laeufen je Zelle (Suchphase;
+ # der Feinschliff kommt obendrauf)
+
+make_path_list <- function(modelname, model_dir) {
+ list(
+ modelname = modelname,
+ root_path = file.path(tempdir(), paste0("raindrop_sim_", model_dir)),
+ dir_input = "/models//input",
+ dir_output = "/models//output",
+ dir_target_output = "/",
+ file_errors_hdf5 = "Fehlerprotokoll.h5",
+ file_results_hdf5_element = "Mulde_Rigole.h5",
+ file_results_hdf5_flaeche = "Dach.h5",
+ file_results_hdf5_verschaltungen = "_Verschaltungen.h5",
+ file_results_txt = "Mulde_Rigole_RAINDROP.txt",
+ file_results_txt_multilayer = "Mulde_Rigole_RAINDROP_multi_layer.txt",
+ file_target = ".h5",
+ path_base = extdata_path("models", model_dir, "base.h5"),
+ path_exe = download_engine(),
+ path_errors_hdf5 = "/",
+ path_results_hdf5_element = "/",
+ path_results_hdf5_flaeche = "/",
+ path_results_hdf5_verschaltungen = "/",
+ path_results_txt = "/",
+ path_results_txt_multilayer = "/",
+ path_target_input = "/"
+ )
+}
+
+# Ein Task = eine komplette Optimierung (Standort x Speichertyp x
+# Methode); gekapselt, damit Haupt-Sweep und Methodenvergleich denselben
+# Code nutzen. tick/tick_cap: progressr-Fortschritt ueber die
+# Worker-Grenze hinweg -- ein Tick je Engine-Lauf, am Task-Ende wird
+# der Rest des Task-Kontingents aufgefuellt, damit der Balken exakt
+# bei 100 % endet.
+run_simultaneous_task <- function(site, type, method, x_targets,
+ model_suffix,
+ tick = NULL, tick_cap = Inf) {
+ if (file.exists("../DESCRIPTION") &&
+ requireNamespace("pkgload", quietly = TRUE)) {
+ pkgload::load_all("..", quiet = TRUE)
+ } else {
+ library(kwb.raindrop)
+ }
+
+ cfg <- sites[[site]]
+ ts <- if (cfg$timeseries) {
+ read_site_timeseries(
+ extdata_path("models", cfg$dir, "rain.csv.gz"),
+ extdata_path("models", cfg$dir, "et.csv"),
+ verbose = FALSE
+ )
+ } else {
+ NULL
+ }
+
+ run_fn <- make_swale_runner(
+ make_path_list(paste0(site, "_", model_suffix), cfg$dir),
+ timeseries_rain = ts$rain,
+ timeseries_et = ts$et
+ )
+
+ ticks_sent <- 0L
+ if (!is.null(tick)) {
+ inner_fn <- run_fn
+ run_fn <- function(params) {
+ if (ticks_sent < tick_cap) {
+ ticks_sent <<- ticks_sent + 1L
+ tick(sprintf("%s | %s | Lauf %d", site, type, ticks_sent))
+ }
+ inner_fn(params)
+ }
+ }
+
+ prior <- if (file.exists(cfg$prior)) {
+ readr::read_csv(cfg$prior, show_col_types = FALSE)
+ } else {
+ NULL
+ }
+
+ t0 <- Sys.time()
+ opt <- optimise_swale_design_simultaneous(
+ run_fn, x_targets = x_targets,
+ area_bounds = area_bounds, area_tol = area_tol,
+ height_bounds = height_bounds, height_tol = height_tol,
+ storage_spec = storage_spec[type],
+ fixed = fixed,
+ prior_results = prior,
+ method = method,
+ max_evals = max_evals,
+ cost_rates = cost_rates,
+ verbose = FALSE
+ )
+ opt$site <- site
+ opt$n_runs_task <- attr(opt, "n_runs_total")
+ opt$minutes_task <- round(as.numeric(
+ difftime(Sys.time(), t0, units = "mins")), 1)
+ if (!is.null(tick) && is.finite(tick_cap) && tick_cap > ticks_sent) {
+ tick(sprintf("%s | %s fertig (%d Laeufe, %.1f min)",
+ site, type, opt$n_runs_task[1], opt$minutes_task[1]),
+ amount = tick_cap - ticks_sent)
+ }
+ opt
+}
+```
+
+## Simultane Optimierung aller Standorte (Nelder-Mead, parallel)
+
+Wie im Bisektions-Workflow laufen **Standort × Speichertyp = 6
+unabhängige Tasks** parallel; innerhalb eines Tasks teilen sich die
+x-Ziele den Evaluations-Cache.
+
+```{r optimise_all, eval = can_run}
+t_nm_start <- Sys.time()
+
+tasks <- expand.grid(site = names(sites), type = names(storage_spec),
+ stringsAsFactors = FALSE)
+
+future::plan(future::multisession,
+ workers = min(nrow(tasks),
+ max(1, parallel::detectCores() - 1)))
+
+# Live-Fortschritt ueber die Worker hinweg: 1 Tick = 1 Engine-Lauf
+# (tick_cap = grosszuegiges Kontingent je Task; der Rest wird am
+# Task-Ende aufgefuellt, der Balken endet also exakt bei 100 %)
+progressr::handlers(progressr::handler_txtprogressbar())
+tick_cap_nm <- 1000
+
+nm_all <- progressr::with_progress({
+ p <- progressr::progressor(steps = nrow(tasks) * tick_cap_nm)
+ nm_list <- future.apply::future_lapply(seq_len(nrow(tasks)), function(i) {
+ run_simultaneous_task(tasks$site[i], tasks$type[i],
+ method = "nelder_mead", x_targets = 0:5,
+ model_suffix = "NM",
+ tick = p, tick_cap = tick_cap_nm)
+ }, future.seed = TRUE)
+ dplyr::bind_rows(nm_list)
+})
+
+future::plan(future::sequential)
+
+t_nm_end <- Sys.time()
+```
+
+## Ergebnis: günstigstes Design je Standort und Überlaufziel
+
+```{r results_table, eval = can_run}
+knitr::kable(
+ nm_all[, c("site", "x", "storage_type", "status", "mulde_area",
+ "mulde_height", "storage_height", "n_overflows",
+ "overflow_volume_m3", "et_pct", "cost_total")],
+ digits = c(NA, 0, NA, NA, 1, 0, 0, 0, 1, 1, 0)
+)
+```
+
+```{r cost_curves, eval = can_run, fig.height = 3.4}
+library(ggplot2)
+
+ok <- nm_all[nm_all$status == "ok", ]
+ggplot(ok, aes(x, cost_total / 1000, colour = storage_type)) +
+ geom_line() +
+ geom_point(size = 2) +
+ facet_wrap(~ site, scales = "free_y") +
+ scale_x_continuous(breaks = 0:5) +
+ labs(title = "Kosten-Wirksamkeits-Kurven (simultane Suche, Nelder-Mead)",
+ x = "Ueberlaufziel x (zulaessige Ereignisse)",
+ y = "Kosten Optimum [Tsd. EUR]",
+ colour = "Speichertyp",
+ caption = cost_rates_caption("de", cost_rates)) +
+ theme_bw()
+```
+
+```{r export, eval = can_run}
+readr::write_csv(nm_all, "optimisation_results_simultaneous_all_sites.csv")
+
+nm_stats <- unique(nm_all[, c("site", "storage_type", "n_runs_task",
+ "minutes_task")])
+knitr::kable(
+ nm_stats,
+ col.names = c("Standort", "Speichertyp", "Engine-Laeufe", "Minuten")
+)
+```
+
+## Gegenprobe: Vergleich mit der Bisektion
+
+Liegt der Export der Bisektions-Vignette
+(`optimisation_results_all_sites.csv`) neben dieser Vignette, werden
+beide Optima Zelle für Zelle verglichen. Beide Verfahren müssen — bis
+auf die Suchtoleranzen, also wenige Prozent — auf dieselben Kosten
+kommen. Fände die simultane Suche *systematisch günstigere* Designs,
+wäre das ein Hinweis auf Parameter-Wechselwirkungen, die die
+Koordinatensuche nicht sieht (und ein Fall für die Monotonie-Analyse);
+fände sie nur teurere, hat der Simplex sein Laufbudget nicht
+ausgeschöpft oder klemmt in einem lokalen Tal (`n_starts` / `max_evals`
+erhöhen).
+
+```{r bisection_available, echo = FALSE, eval = can_run}
+has_bisection <- file.exists("optimisation_results_all_sites.csv")
+```
+
+```{r bisection_note, echo = FALSE, results = 'asis', eval = can_run && !has_bisection}
+cat(paste0(
+ "> **Hinweis:** `optimisation_results_all_sites.csv` nicht gefunden — ",
+ "zuerst die Vignette `workflow_optimisation` rendern, dann liefert ",
+ "dieser Abschnitt den Zellenvergleich.\n"
+))
+```
+
+```{r compare_bisection, eval = can_run && has_bisection}
+bisect_all <- readr::read_csv("optimisation_results_all_sites.csv",
+ show_col_types = FALSE)
+
+vergleich <- dplyr::full_join(
+ dplyr::select(bisect_all, site, storage_type, x,
+ status_bisektion = status, kosten_bisektion = cost_total),
+ dplyr::select(nm_all, site, storage_type, x,
+ status_simultan = status, kosten_simultan = cost_total),
+ by = c("site", "storage_type", "x")
+) %>%
+ dplyr::mutate(
+ delta_pct = round(100 * (kosten_simultan - kosten_bisektion) /
+ kosten_bisektion, 1)
+ ) %>%
+ dplyr::arrange(site, storage_type, x)
+
+knitr::kable(
+ vergleich, digits = 0,
+ caption = paste("Gegenprobe Bisektion vs. simultane Suche:",
+ "delta_pct < 0 heisst, die simultane Suche hat ein",
+ "guenstigeres Design gefunden")
+)
+```
+
+## Alternative Optimierer im Vergleich
+
+Dieselbe Zelle (x = 1, beide Speichertypen, alle Standorte), drei
+Suchverfahren: Nelder-Mead (aus dem Haupt-Sweep oben), Differential
+Evolution und die Halton-Baseline. Erwartung: Nelder-Mead und DE liegen
+innerhalb weniger Prozent beieinander; die naive Halton-Stichprobe
+bleibt trotz des gemeinsamen Feinschliffs messbar dahinter — der
+Abstand zeigt, wie viel die strukturierte Suche beiträgt. Parallelisiert
+über **Standort × Speichertyp × Methode = 12 Tasks**.
+
+```{r compare_methods_run, eval = can_run}
+t_cmp_start <- Sys.time()
+
+method_tasks <- expand.grid(site = names(sites),
+ type = names(storage_spec),
+ method = c("diff_evolution", "halton_search"),
+ stringsAsFactors = FALSE)
+
+future::plan(future::multisession,
+ workers = min(nrow(method_tasks),
+ max(1, parallel::detectCores() - 1)))
+
+tick_cap_cmp <- 300 # eine Zelle je Task
+
+cmp_all <- progressr::with_progress({
+ p <- progressr::progressor(steps = nrow(method_tasks) * tick_cap_cmp)
+ cmp_list <- future.apply::future_lapply(seq_len(nrow(method_tasks)),
+ function(i) {
+ run_simultaneous_task(method_tasks$site[i], method_tasks$type[i],
+ method = method_tasks$method[i], x_targets = 1,
+ model_suffix = toupper(substr(
+ method_tasks$method[i], 1, 2)),
+ tick = p, tick_cap = tick_cap_cmp)
+ }, future.seed = TRUE)
+ dplyr::bind_rows(cmp_list)
+})
+
+future::plan(future::sequential)
+
+methoden <- dplyr::bind_rows(
+ dplyr::filter(nm_all, x == 1),
+ cmp_all
+)
+
+t_cmp_end <- Sys.time()
+```
+
+```{r compare_methods_table, eval = can_run}
+methoden_breit <- methoden %>%
+ dplyr::select(site, storage_type, method, cost_total, n_runs_new) %>%
+ tidyr::pivot_wider(names_from = method,
+ values_from = c(cost_total, n_runs_new))
+
+knitr::kable(
+ methoden_breit, digits = 0,
+ caption = paste("Methodenvergleich bei x = 1: Kosten des Optimums und",
+ "frische Engine-Laeufe der Zelle je Suchverfahren.",
+ "Der Nelder-Mead-Wert stammt aus dem Haupt-Sweep",
+ "(profitiert dort vom Cache der uebrigen x-Ziele).")
+)
+```
+
+```{r compare_methods_plot, eval = can_run, fig.height = 3.4}
+ggplot(methoden[methoden$status == "ok", ],
+ aes(method, cost_total / 1000, fill = storage_type)) +
+ geom_col(position = "dodge") +
+ facet_wrap(~ site, scales = "free_y") +
+ labs(title = "Kosten des gefundenen Optimums je Suchverfahren (x = 1)",
+ x = "Suchverfahren",
+ y = "Kosten Optimum [Tsd. EUR]",
+ fill = "Speichertyp",
+ caption = cost_rates_caption("de", cost_rates)) +
+ theme_bw() +
+ theme(axis.text.x = element_text(angle = 20, hjust = 1))
+```
+
+## Einordnung
+
+- **Konsistenz:** Bisektion und simultane Suche bestätigen sich
+ gegenseitig, wenn ihre Kosten je Zelle nur um wenige Prozent
+ differieren — dann ist das Optimum eine Eigenschaft des Problems,
+ nicht des Suchwegs.
+- **Wenn die simultane Suche systematisch günstiger ist**, gibt es zwei
+ mögliche Ursachen: (a) die Monotonie-Annahme der Bisektion ist
+ verletzt (echter Modell-Alarm → die
+ [Monotonie-Analyse](https://raindrop.kompetenz-wasser.io/optimisation/monotonicity_analysis/)
+ prüfen), oder
+ (b) der **Spezifikkosten-Proxy**, aus dem die Bisektion ihre
+ Suchreihenfolge herleitet (€ je mm Speicherkapazität, Kapazitätsmodell
+ V ≈ Fläche × (Tiefe + Porosität × Speicher)), greift zu kurz — etwa
+ weil ein Hebel nicht kapazitäts-additiv wirkt (z. B. eine variable
+ Filterdurchlässigkeit, die die Hydraulik nichtlinear verändert) oder
+ das Kapazitätsmodell die Standort-Hydraulik schlecht beschreibt. Die
+ simultane Suche trägt die `cost_rates` direkt in ihrer Zielfunktion
+ und braucht weder Proxy noch Kapazitätsmodell: Sie ist die
+ annahmefreie Instanz und **das primäre Verfahren, sobald Parameter
+ ohne saubere Grenzkosten-je-Kapazität ins Spiel kommen**.
+- **`monotonicity_warning = TRUE`** heißt hier: Unter den Evaluationen
+ der Zelle liegt ein *strikt größeres* Design mit mehr Überläufen
+ *und* mehr Überlaufvolumen — echte Nicht-Monotonie; dann verdient die
+ Zelle einen Blick in das `"evaluations"`-Attribut.
+- **Methodenwahl:** `nelder_mead` bleibt die Empfehlung (beste
+ Präzision je Engine-Lauf). `diff_evolution` ist die Absicherung gegen
+ Simplex-Artefakte, `halton_search` die Messlatte von unten.
+- **Budget:** `max_evals` begrenzt die Suchphase je Zelle; der
+ Feinschliff (Multi-Tal-Musterabstieg) kommt obendrauf. Wer Laufzeit
+ sparen muss, reduziert zuerst `x_targets`, dann `max_evals`.
+
+```{r vignette_runtime, echo = FALSE, results = 'asis', eval = can_run}
+cat(sprintf(paste0(
+ "---\n\n**Gesamtlaufzeit dieser Vignette:** %.1f Minuten ",
+ "(Nelder-Mead-Sweep %.1f min · Methodenvergleich %.1f min · ",
+ "Rest: Setup und Rendern).\n"),
+ as.numeric(difftime(Sys.time(), t_vignette_start, units = "mins")),
+ as.numeric(difftime(t_nm_end, t_nm_start, units = "mins")),
+ as.numeric(difftime(t_cmp_end, t_cmp_start, units = "mins"))
+))
+```
diff --git a/vignettes/workflow_wien.Rmd b/vignettes/workflow_wien.Rmd
index e9971ef..fab82b8 100644
--- a/vignettes/workflow_wien.Rmd
+++ b/vignettes/workflow_wien.Rmd
@@ -109,14 +109,52 @@ mulde_area <- c(25, 50, 75, 100, 125, 150, 175, 200)
mulde_height <- c(100, 200, 300)
filter_hydraulicconductivity <- c(36, 180, 360)
filter_height <- 300
-storage_height <- c(100, 500, 1000)
+# Storage-layer (Speicher = 2nd Bodenschichtung layer) presets per storage type.
+# Each type brings its own storage_height levels plus the Speicher soil
+# parameters (theta*). They are written to the model in the run loop below:
+# storage_height -> Schichtdicken[2]
+# Startwerte_theta_ActualSoilMoisture -> Startwerte_theta_ActualSoilMoisture[2]
+# thetaWP/thetaFC/thetaS -> //Bodenarten/Speicher/theta*
+storage_type <- list(
+ "infiltration_box" = list(
+ storage_height = c(300, 600, 900, 1200),
+ Startwerte_theta_ActualSoilMoisture = 0,
+ thetaWP_MoistureAtWiltingPoint = 0,
+ thetaFC_MoistureAtFieldCapacity = 0,
+ thetaS_MoistureAtSaturation = 0.95
+ ),
+ "gravel_trench" = list(
+ storage_height = 3 * c(300, 600, 900, 1200),
+ Startwerte_theta_ActualSoilMoisture = 0,
+ thetaWP_MoistureAtWiltingPoint = 0,
+ thetaFC_MoistureAtFieldCapacity = 0,
+ thetaS_MoistureAtSaturation = 0.3
+ )
+)
rain_factor <- 1
bottom_hydraulicconductivity <- 12 #c(1,5,10,20,45,90,180,270,360,1860,3600)
# LAI for Mulde_Rigole only (Dach kept at H5 default).
-# 8.5 = status-quo H5 default; 3.9 = grass per Hörnschemeyer et al.,
+# 8.5 = status-quo H5 default; 3.9 = grass per Hoernschemeyer et al.,
# Water 2023, 15, 2840, Tab. 6, plant type 5 (grasses/herbs).
-lai <- c(3.9, 8.5)
-
+#lai <- c(3.9, 8.5)
+lai <- 3.9
+
+
+# storage_height is coupled to storage_type (each type has its own levels), so
+# build one row per (storage_type, storage_height) carrying the matching
+# Speicher soil parameters, then cross-join with all remaining combinations.
+storage_grid <- do.call(rbind, lapply(names(storage_type), function(type_name) {
+ spec <- storage_type[[type_name]]
+ data.frame(
+ storage_type = type_name,
+ storage_height = spec$storage_height,
+ storage_theta_start = spec$Startwerte_theta_ActualSoilMoisture,
+ storage_thetaWP = spec$thetaWP_MoistureAtWiltingPoint,
+ storage_thetaFC = spec$thetaFC_MoistureAtFieldCapacity,
+ storage_thetaS = spec$thetaS_MoistureAtSaturation,
+ stringsAsFactors = FALSE
+ )
+}))
# Alle Kombinationen erzeugen
param_grid_all_combinations <- expand.grid(
@@ -125,16 +163,25 @@ param_grid_all_combinations <- expand.grid(
mulde_height = mulde_height,
filter_hydraulicconductivity = filter_hydraulicconductivity,
filter_height = filter_height,
- storage_height = storage_height,
bottom_hydraulicconductivity = bottom_hydraulicconductivity,
rain_factor = rain_factor,
- lai = lai
+ lai = lai,
+ stringsAsFactors = FALSE
)
+# Cross-join the free parameters with the coupled storage grid.
+param_grid_all_combinations <- merge(param_grid_all_combinations, storage_grid,
+ by = NULL)
+
param_grid_all_combinations <- param_grid_all_combinations %>%
dplyr::bind_cols(tibble::tibble(scenario_name = sprintf("s%05d",
seq_len(nrow(param_grid_all_combinations)))))
+# Reference = first storage type at its smallest storage_height (storage_height
+# is coupled to storage_type, so both are fixed together).
+ref_storage_type <- names(storage_type)[1]
+ref_storage_height <- min(storage_type[[ref_storage_type]]$storage_height)
+
ref_scenario <- param_grid_all_combinations %>%
dplyr::filter(connected_area == min(unique(param_grid_all_combinations$connected_area)),
mulde_area == min(unique(param_grid_all_combinations$mulde_area)),
@@ -142,7 +189,8 @@ ref_scenario <- param_grid_all_combinations %>%
filter_hydraulicconductivity == min(param_grid_all_combinations$filter_hydraulicconductivity),
bottom_hydraulicconductivity == min(unique(param_grid_all_combinations$bottom_hydraulicconductivity)),
mulde_height == min(param_grid_all_combinations$mulde_height),
- storage_height == min(param_grid_all_combinations$storage_height),
+ storage_type == ref_storage_type,
+ storage_height == ref_storage_height,
lai == max(param_grid_all_combinations$lai)) %>%
dplyr::pull(scenario_name)
@@ -158,6 +206,20 @@ param_grid <- param_grid_all_combinations %>%
dplyr::filter(scenario_name %in% scenarios_with_single_parameter_variation)
param_grid <- param_grid_all_combinations
+# Nutzbares Speichervolumen der Speicherschicht [m3] = Muldenflaeche x
+# Speicherhoehe x nutzbare Porositaet (thetaS - thetaFC) des Speichertyps
+# (Sickerbox 0.95, Schotterrigole 0.3). thetaFC statt thetaWP: nur das
+# oberhalb der Feldkapazitaet entwaesserbare Porenvolumen leert sich zwischen
+# den Ereignissen und steht als Retentionsvolumen erneut zur Verfuegung;
+# Wasser zwischen WP und FC haelt die Schicht gegen die Schwerkraft (in den
+# Presets sind thetaFC = thetaWP = 0, beide Definitionen also identisch).
+# Erscheint in der Grid-Tabelle, den Ergebnis-CSVs und im Plot-Tooltip.
+param_grid <- param_grid %>%
+ dplyr::mutate(
+ storage_volume_m3 = mulde_area * storage_height / 1000 *
+ (storage_thetaS - storage_thetaFC)
+ )
+
DT::datatable(param_grid,
filter = "top",
options = list(pageLength = 25,
@@ -239,7 +301,7 @@ timeseries_rain <- if(max(timeseries_et$time) > max(timeseries_rain$time)) {
timeseries_rain
}
-txt <- sprintf("Für den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Werte die gleich Null sind. (Regenmenge: %f mm/a)\n",
+txt <- sprintf("F\u00fcr den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Werte die gleich Null sind. (Regenmenge: %f mm/a)\n",
paths$path_rain,
100*sum(is.na(timeseries_rain$value))/nrow(timeseries_rain),
100*sum(timeseries_rain$value == 0, na.rm = TRUE)/nrow(timeseries_rain),
@@ -247,7 +309,7 @@ txt <- sprintf("Für den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Wer
message(txt)
-txt <- sprintf("Für den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Werte die gleich Null sind. (Verdunstungs: %f mm/a)\n",
+txt <- sprintf("F\u00fcr den Datensatz '%s' gibt es %.2f %% NA Werte und %.2f %% Werte die gleich Null sind. (Evapotranspirations: %f mm/a)\n",
paths$path_et,
100*sum(is.na(timeseries_et$value))/nrow(timeseries_et),
100*sum(timeseries_et$value == 0, na.rm = TRUE)/nrow(timeseries_et),
@@ -260,6 +322,12 @@ message(txt)
period <- c(diff(timeseries_rain$time), mean(diff(timeseries_rain$time)))
timeseries_rain$value <- timeseries_rain$value / period
+### Convert ET0 from mm/day to mm/h (the engine reads //Kurven/ET0 as a mm/h
+### rate, exactly like rain; daily values must be divided by their interval in
+### hours = 24, otherwise ET0 is integrated 24x too high)
+period_et <- c(diff(timeseries_et$time), mean(diff(timeseries_et$time)))
+timeseries_et$value <- timeseries_et$value / period_et
+
#openxlsx::write.xlsx(list(regen = timeseries_rain, et = timeseries_et), "timeseries.xlsx")
```
@@ -305,9 +373,14 @@ run_one <- function(i,
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Regen-Skalierungsfaktor` <- 1
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Flaeche` <- param_grid_tmp$mulde_area
vals$`//Massnahmenelemente/Mulde_Rigole/Eigenschaften_Oberflaeche/Ueberlaufhoehe` <- param_grid_tmp$mulde_height
- vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Startwerte_theta_ActualSoilMoisture` <- c(0.3, 0)
+ vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Startwerte_theta_ActualSoilMoisture` <- c(0.3, param_grid_tmp$storage_theta_start)
vals$`//Massnahmenelemente/Mulde_Rigole/Bodenschichtung/Schichtdicken` <- c(param_grid_tmp$filter_height,
param_grid_tmp$storage_height)
+ # Speicher (2nd Bodenschichtung layer) soil parameters depend on the
+ # storage type (infiltration_box vs. gravel_trench); see `storage_type`.
+ vals$`//Bodenarten/Speicher/thetaWP_MoistureAtWiltingPoint` <- param_grid_tmp$storage_thetaWP
+ vals$`//Bodenarten/Speicher/thetaFC_MoistureAtFieldCapacity` <- param_grid_tmp$storage_thetaFC
+ vals$`//Bodenarten/Speicher/thetaS_MoistureAtSaturation` <- param_grid_tmp$storage_thetaS
vals$`//Massnahmenelemente/Mulde_Rigole/Allgemein/Endversickerungsrate` <- param_grid_tmp$bottom_hydraulicconductivity
vals$`//Bodenarten/Bodenfilter/Ks_HydraulicConductivity` <- param_grid_tmp$filter_hydraulicconductivity
@@ -329,13 +402,33 @@ run_one <- function(i,
path_input = paths$path_target_input,
debug = debug)
- invisible(NULL)
+ # Thin immediately: read only this run's results (lean = water balance +
+ # overflow rates, no states/meta/connected-area rates) and reduce to the
+ # single optimisation row. This way we never hold all scenarios' full
+ # time series in memory at once; the full result HDF5 stays on disk for
+ # ad-hoc inspection.
+ sim_one <- kwb.raindrop::get_simulation_results_optim(
+ paths = paths,
+ path_list = path_list,
+ simulation_names = param_grid_tmp$scenario_name,
+ debug = debug,
+ lean = TRUE
+ )
+
+ kwb.raindrop::add_overflow_events_and_waterbalance(
+ simulation_results = sim_one,
+ event_separation_hours = 4,
+ canonical_variables = kwb.raindrop::default_canonical_wb_variables()
+ )
}
n_cores <- parallel::detectCores()
+# run_one() now returns the thinned per-run optimisation row, so run_scenarios()
+# yields a list of one-row tibbles we simply bind below.
+scenario_rows <- NULL
system.time(expr = {
-kwb.raindrop::run_scenarios(indices = seq_len(nrow(param_grid)),
+scenario_rows <- kwb.raindrop::run_scenarios(indices = seq_len(nrow(param_grid)),
run_one_scenario = run_one,
timestep_hours = 0.1,
debug = FALSE,
@@ -364,21 +457,11 @@ x$Fehlerbeschreibung
### Analyse Results
```{r analyse_results, eval = data_available && is_windows && !is_ghactions}
-system.time(
-simulation_results <- kwb.raindrop::get_simulation_results_optim_parallel(
- paths = paths,
- path_list = path_list,
- simulation_names = param_grid$scenario_name,
- debug = FALSE)
-)
-
-system.time(
-simulation_results_optimisation <- kwb.raindrop::add_overflow_events_and_waterbalance(
- simulation_results = simulation_results,
- event_separation_hours = 4,
- canonical_variables = kwb.raindrop::default_canonical_wb_variables()
- )
-)
+# Each run was already thinned to its optimisation row inside run_one(), so we
+# just bind the per-run rows here instead of re-reading every run's full
+# results into memory. (The previous get_simulation_results_optim_parallel() +
+# add_overflow_events_and_waterbalance() pass loaded all runs at once.)
+simulation_results_optimisation <- dplyr::bind_rows(scenario_rows)
simulation_results_optimisation <- param_grid %>%
dplyr::left_join(simulation_results_optimisation,
@@ -403,6 +486,16 @@ htmlwidgets::saveWidget(DT::datatable(simulation_results_optimisation,
### Plot results
+# Fuer Plots/Tooltips: die an storage_type gekoppelten Speicher-Bodenparameter
+# (storage_theta*) sind durch den Typ bestimmt, also redundant - sie wuerden
+# nur jeden Tooltip aufblaehen. Fuer den Modelllauf oben werden sie gebraucht,
+# ab hier nicht mehr. storage_volume_m3 bekommt im Tooltip eine eigene Zeile
+# (aus den Ergebnisdaten) und fliegt hier ebenfalls raus, sonst stuende es
+# doppelt unter "Variierende Parameter".
+param_grid <- param_grid %>%
+ dplyr::select(-dplyr::starts_with("storage_theta"),
+ -dplyr::any_of("storage_volume_m3"))
+
params <- c(
#"connected_area",
"mulde_area",
@@ -412,12 +505,18 @@ params <- c(
"storage_height",
#"bottom_hydraulicconductivity",
#"rain_factor",
- "lai"
+ "lai",
+ "storage_type"
)
lang <- "de"
max_n_overflows <- 5
+# Kostensaetze-Caption fuer die interaktiven Kostenplots: ggplotly verwirft
+# ggplot-Captions, daher wird sie dort per plotly_add_caption() nachgeruestet;
+# die PDFs bekommen sie automatisch ueber den caption-Default der Funktionen.
+cost_caption <- kwb.raindrop::cost_rates_caption(lang)
+
pdff <- sprintf("simulation_results_optimisation_%s_main-effects.pdf",
paths$modelname)
@@ -454,6 +553,7 @@ grDevices::pdf(pdff, width = 9, height = 4, onefile = TRUE)
alpha_max = 1,
drop_overflow_gt_valid_max = FALSE,
keep_param_grid_limits = TRUE,
+ facet_storage_type = TRUE,
lang = lang,
subtitle = ""
)
@@ -494,11 +594,15 @@ for (y in c("mulde_height", "filter_hydraulicconductivity", "storage_height")) {
alpha_min = 0.25,
alpha_max = 1,
drop_overflow_gt_valid_max = FALSE,
- keep_param_grid_limits = TRUE
+ keep_param_grid_limits = TRUE,
+ facet_storage_type = TRUE
)
- # interaktiv als HTML
+ # interaktiv als HTML; Farb-Legende je Ueberlaufklasse statt
+ # (Farbe, Form)-Tupeln - die Formen erklaeren die Panel-Beschriftungen.
plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang,
+ add_shape_legend = FALSE)
htmlwidgets::saveWidget(
widget = plotly_p,
file = sprintf("simulation_results_optimisation_%s_design-space_mulde-area_vs_%s.html",
@@ -528,8 +632,10 @@ p <- kwb.raindrop::plot_wb_tradeoff_overflows(
use_jitter = TRUE
)
- # interaktiv als HTML
+ # interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+ # statt der (Farbe, Form)-Tupel von ggplotly
plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
htmlwidgets::saveWidget(
widget = plotly_p,
file = sprintf("simulation_results_optimisation_%s_water-balance.html",
@@ -540,8 +646,165 @@ p <- kwb.raindrop::plot_wb_tradeoff_overflows(
)
# statisch ins PDF (WICHTIG!)
- suppressWarnings(print(p))
+ suppressWarnings(print(p))
dev.off()
#kwb.utils::finishAndShowPdf(pdff)
+pdff <- sprintf("simulation_results_optimisation_%s_cost-vs-overflow-volume.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_vs_overflow_volume(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE
+)
+
+# interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+# statt der (Farbe, Form)-Tupel von ggplotly
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf("simulation_results_optimisation_%s_cost-vs-overflow-volume.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost vs. overflow volume",
+ paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
+dev.off()
+#kwb.utils::finishAndShowPdf(pdff)
+
+# Drei Kosten-Boxplots mit unterschiedlichem Optimierungsziel je Kategorie
+# (Kosten als Tie-Break): (i) guenstigste; (ii) geringstes Ueberlaufvolumen
+# (Label m3 + %); (iii) hoechste Evapotranspiration (Label %, Punktgroesse =
+# Evapotranspiration). x = max_n_overflows, Linie ueber alle Klassen. Die beiden
+# Speichertypen liegen als zwei Panels untereinander (Sickerbox oben,
+# Schotterrigol unten); die Punkte bleiben Kreise, da die Panel-Streifen
+# den Typ bereits benennen.
+cost_boxplots <- list(
+ list(suffix = "cheapest", best_by = "min_cost",
+ size_by = "overflow_volume", label_best = FALSE),
+ list(suffix = "min-overflow", best_by = "min_overflow",
+ size_by = "overflow_volume", label_best = TRUE),
+ list(suffix = "max-evap", best_by = "max_evapotranspiration",
+ size_by = "evapotranspiration", label_best = TRUE)
+)
+for (cb in cost_boxplots) {
+ pdff <- sprintf(
+ "simulation_results_optimisation_%s_cost-by-overflows-boxplot-%s.pdf",
+ paths$modelname, cb$suffix)
+ kwb.utils::preparePdf(pdfFile = pdff)
+
+ p <- kwb.raindrop::plot_cost_overflow_boxplot(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang,
+ facet_storage_type = TRUE,
+ size_by = cb$size_by,
+ best_by = cb$best_by,
+ label_best = cb$label_best
+ )
+
+ # interaktiv als HTML
+ plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+ plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+ htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf(
+ "simulation_results_optimisation_%s_cost-by-overflows-boxplot-%s.html",
+ paths$modelname, cb$suffix),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost boxplot (%s)", paths$modelname, cb$suffix)
+ )
+
+ # statisch ins PDF (WICHTIG!)
+ suppressWarnings(print(p))
+ dev.off()
+}
+
+
+# Kosten vs. Evapotranspiration: Streudiagramm ueber den Design-Raum, Punktform
+# kodiert den Speichertyp (Viereck = Sickerbox, Dreieck = Schotterrigol),
+# Farbe die Anzahl Ueberlaufereignisse.
+pdff <- sprintf("simulation_results_optimisation_%s_cost-vs-evaporation.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_vs_evaporation(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang
+)
+
+# interaktiv als HTML; getrennte Legenden (Ueberlaufklassen + Speichertyp)
+# statt der (Farbe, Form)-Tupel von ggplotly
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_split_legend(plotly_p, lang = lang)
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf("simulation_results_optimisation_%s_cost-vs-evaporation.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost vs. evapotranspiration",
+ paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
+dev.off()
+
+
+# Kosten je Prozent Evapotranspiration [EUR/%]: Boxplot je Ueberlaufklasse mit den
+# beiden Speichertypen als zwei Panels untereinander (Sickerbox oben,
+# Schotterrigol unten); guenstigstes Szenario je Box markiert (Label EUR/%),
+# Punktgroesse = Evapotranspiration.
+pdff <- sprintf(
+ "simulation_results_optimisation_%s_cost-per-evap-boxplot.pdf",
+ paths$modelname)
+kwb.utils::preparePdf(pdfFile = pdff)
+
+p <- kwb.raindrop::plot_cost_overflow_boxplot(
+ simulation_results_optimisation = simulation_results_optimisation,
+ param_grid = param_grid,
+ x = max_n_overflows,
+ filter_n_gtx = FALSE,
+ use_jitter = TRUE,
+ lang = lang,
+ y_var = "cost_per_evap_pct",
+ facet_storage_type = TRUE,
+ size_by = "evapotranspiration",
+ best_by = "min_cost",
+ label_best = TRUE
+)
+
+# interaktiv als HTML
+plotly_p <- suppressWarnings(plotly::ggplotly(p, tooltip = "text"))
+plotly_p <- kwb.raindrop::plotly_add_caption(plotly_p, cost_caption)
+htmlwidgets::saveWidget(
+ widget = plotly_p,
+ file = sprintf(
+ "simulation_results_optimisation_%s_cost-per-evap-boxplot.html",
+ paths$modelname),
+ selfcontained = TRUE,
+ title = sprintf("'%s' - Cost per %% evapotranspiration", paths$modelname)
+)
+
+# statisch ins PDF (WICHTIG!)
+suppressWarnings(print(p))
+dev.off()
+
```