From 3c6da168c60d3bf6477f6a9130f6f6829639fadd Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Fri, 10 Oct 2025 23:00:54 +0200
Subject: [PATCH 01/12] Fix error in distribution of measures

Keep original behaviour of run_rabimo_with_measures()
by setting new arg "old_version" to TRUE
---
 R/apply_measures_to_blocks.R                  | 204 ++++++++++++++++++
 R/run_rabimo_with_measures.R                  |  23 +-
 man/run_rabimo_with_measures.Rd               |   7 +-
 .../test-function-apply_measures_to_blocks.R  |  88 ++++++++
 .../test-function-distribute_measures.R       | 110 +---------
 .../test-function-rescale_target_values.R     |  13 ++
 .../test-function-run_rabimo_with_measures.R  | 128 ++++++++++-
 7 files changed, 449 insertions(+), 124 deletions(-)
 create mode 100644 R/apply_measures_to_blocks.R
 create mode 100644 tests/testthat/test-function-apply_measures_to_blocks.R

diff --git a/R/apply_measures_to_blocks.R b/R/apply_measures_to_blocks.R
new file mode 100644
index 00000000..8df92b7e
--- /dev/null
+++ b/R/apply_measures_to_blocks.R
@@ -0,0 +1,204 @@
+# @param measures list with elements green_roof, unpaved, to_swale representing 
+#   the target percentages of the total areas corresponding to each measure.
+#   A value of NA means that the corresponding measure column is not touched.
+apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALSE)
+{
+  #dbg = FALSE; check = FALSE
+  
+  # Define helper functions
+  {
+    report_problem <- function(...) {
+      problem <- paste(unlist(list(...)), collapse = "")
+      warning(problem, call. = FALSE)
+    }
+    
+    debug <- function(...) {
+      if (dbg) {
+        writeLines(...)
+      }
+    }
+    
+    share_of_sum <- function(x) {
+      # Do not divide by zero, return vector of zeros instead.
+      if ((s <- sum(x)) == 0) {
+        rep(0, length(x))
+      } else {
+        x/s  
+      }
+    }
+    
+    check_if_target_was_reached <- function(blocks, measure) {
+      obtained <- kwb.rabimo::get_measure_stats(blocks)[[measure]]$mean
+      target <- measures[[measure]]
+      if (!isTRUE(all.equal(obtained, target))) {
+        warning(
+          sprintf("Target value %0.2f for '%s' ", target, measure),
+          sprintf("could not be achieved. Actual value: %0.2f", obtained), 
+          call. = FALSE
+        )
+      }
+    }
+    
+    check_for_negative_values <- function(blocks, measure) {
+      is_negative <- blocks[[measure]] < 0
+      if (any(is_negative)) {
+        warning(call. = FALSE, sprintf(
+          "There are %d negative values in column '%s'", 
+          sum(is_negative), measure
+        ))
+      }
+    }
+  }
+  
+  # The prefix "a_" refers to absolute area (in square metres)
+  
+  # Provide the total areas and roof areas in advance. They are not changed by 
+  # the measures.
+  a_total <- blocks$total_area
+  a_roof <- blocks$total_area * blocks$roof
+  
+  # 1. Handle measure "green roof"
+  if (!is.na(measures$green_roof)) {
+    
+    a_green_roof <- a_roof * blocks$green_roof
+    
+    # Total green roof area to add (if value >= 0) or to remove (if value < 0)
+    a_green_roof_change <- sum(measures$green_roof * a_total) - sum(a_green_roof)
+    
+    # Roof area that can be converted to green roof area
+    if (a_green_roof_change >= 0) {
+      
+      # increase green roof area
+      a_green_roof_potential <- a_roof - a_green_roof
+      
+      if (a_green_roof_change > sum(a_green_roof_potential)) {
+        report_problem(sprintf(
+          "Not enough (non-green) roof area available (%0.2f m2 missing)",
+          a_green_roof_change - sum(a_green_roof_potential)
+        ))
+      }
+      
+    } else {
+      
+      # decrease green roof area
+      a_green_roof_potential <- a_green_roof
+      
+      if (- a_green_roof_change > sum(a_green_roof_potential)) {
+        report_problem(sprintf(
+          "Not enough green roof area available (%0.2f m2 missing)",
+          - a_green_roof_change - sum(a_green_roof_potential)
+        ))
+      }    
+    }
+    
+    # Distribute change in green roof area to the different blocks    
+    a_green_roof_new <- a_green_roof + share_of_sum(a_green_roof_potential) * a_green_roof_change
+    
+    # Update column "green_roof" (as fraction of roof area)
+    blocks$green_roof <- ifelse(a_roof == 0, 0, a_green_roof_new / a_roof)
+  }
+  
+  # 2. Handle measure "Unsealing"
+  if (!is.na(measures$unpaved)) {
+    
+    # current paved/unpaved areas
+    a_paved <- a_total * blocks$pvd
+    a_unpaved <- a_total - a_roof - a_paved
+
+    # Required increase/decrease in unpaved area
+    a_unpaved_change <- measures$unpaved * sum(a_total) - sum(a_unpaved)
+    unpave <- a_unpaved_change >= 0
+    
+    debug(sprintf(
+      "%s area to be %s: %0.2f m2", 
+      ifelse(unpave, "Paved", "Unpaved"),
+      ifelse(unpave, "unpaved", "paved"),
+      abs(a_unpaved_change)
+    ))
+    
+    if (unpave) {
+      
+      a_potential <- a_paved
+      
+      if (a_unpaved_change > sum(a_potential)) {
+        report_problem(sprintf(
+          "Not enough paved area available to be unpaved (%0.2f m2 missing)",
+          a_unpaved_change - sum(a_potential)
+        ))
+      }
+      
+    } else {
+      
+      # actually pave instead of unpave!
+      a_potential <- a_unpaved
+      
+      # a_unpaved_change is negative here
+      if (- a_unpaved_change > sum(a_potential)) {
+        report_problem(sprintf(
+          "Not enough unpaved area available to be paved (%0.2f m2 missing)",
+          - a_unpaved_change - sum(a_potential)
+        ))
+      }
+    }
+    
+    # Distribute change in paved/unpaved area to the different blocks
+    a_paved_new <- a_paved - share_of_sum(a_potential) * a_unpaved_change
+    
+    blocks$pvd <- ifelse(a_total == 0, 0, a_paved_new / a_total)
+  }
+  
+  # 3. Handle measure "Connection to swales"
+  if (!is.na(measures$to_swale)) {
+    a_sealed <- a_roof + a_total * blocks$pvd
+    a_to_swale <- blocks$to_swale * a_sealed
+    a_to_swale_change <- sum(measures$to_swale * a_total) - sum(a_to_swale)
+    
+    increase <- a_to_swale_change >= 0
+    
+    debug(sprintf(
+      "Sealed area to be %s swales: %0.2f m2",
+      ifelse(increase, "connected to", "disconnected from"),
+      abs(a_to_swale_change)
+    ))
+    
+    if (increase) {
+      
+      a_to_swale_potential <- a_sealed - a_to_swale
+      
+      if (a_to_swale_change > sum(a_to_swale_potential)) {
+        report_problem(sprintf(
+          "Not enough sealed area available to be connected to swales (%0.2f m2 missing)",
+          a_to_swale_change - sum(a_to_swale_potential)
+        ))
+      }
+      
+    } else {
+      
+      # a_to_swale_change is negative here
+      a_to_swale_potential <- a_to_swale
+      
+      if (- a_to_swale_change > sum(a_to_swale_potential)) {
+        report_problem(sprintf(
+          "Not enough swale-connected sealed area available to be disconnected (%0.2f m2 missing)",
+          abs(a_to_swale_change) - sum(a_to_swale_potential)
+        ))
+      }
+    }
+    
+    # distribute
+    a_to_swale_new <- a_to_swale + share_of_sum(a_to_swale_potential) * a_to_swale_change
+    
+    # Update column "to_swale"
+    blocks$to_swale <- ifelse(a_sealed == 0, 0, a_to_swale_new / a_sealed)
+  }
+  
+  # Targets reached?
+  if (check) {
+    for (measure in names(measures)[!is.na(measures)]) {
+      check_if_target_was_reached(blocks, measure)  
+      check_for_negative_values(blocks, measure)
+    }
+  }
+  
+  blocks
+}
diff --git a/R/run_rabimo_with_measures.R b/R/run_rabimo_with_measures.R
index c6416a4f..9a10fef6 100644
--- a/R/run_rabimo_with_measures.R
+++ b/R/run_rabimo_with_measures.R
@@ -7,21 +7,24 @@
 #'   corresponding to each measure
 #' @param config configuration object, default:
 #'   \code{\link{rabimo_inputs_2020}$config}
+#' @param old_version if \code{TRUE} the old, erroneous version of this function 
+#'   is used (not correctly considering the updated pvd value before calculating 
+#'   the new to_swale values). The default is \code{FALSE}.
 #' @export
 run_rabimo_with_measures <- function(
     blocks,
     measures,
-    config = kwb.rabimo::rabimo_inputs_2020$config
+    config = kwb.rabimo::rabimo_inputs_2020$config,
+    old_version = FALSE
 )
 {
   #kwb.utils::assignPackageObjects("kwb.rabimo")
-  rescaled_targets <- rescale_target_values(
-    new_targets = measures,
-    blocks = blocks
-  )
-
-  run_rabimo(
-    distribute_measures(blocks = blocks, targets = rescaled_targets),
-    config = config
-  )
+  
+  new_blocks <- if (old_version) {
+    distribute_measures(blocks, rescale_target_values(measures, blocks))
+  } else {
+    apply_measures_to_blocks(blocks, measures)
+  }
+  
+  run_rabimo(new_blocks, config = config)
 }
diff --git a/man/run_rabimo_with_measures.Rd b/man/run_rabimo_with_measures.Rd
index 89080434..78c0971b 100644
--- a/man/run_rabimo_with_measures.Rd
+++ b/man/run_rabimo_with_measures.Rd
@@ -7,7 +7,8 @@
 run_rabimo_with_measures(
   blocks,
   measures,
-  config = kwb.rabimo::rabimo_inputs_2020$config
+  config = kwb.rabimo::rabimo_inputs_2020$config,
+  old_version = FALSE
 )
 }
 \arguments{
@@ -20,6 +21,10 @@ corresponding to each measure}
 
 \item{config}{configuration object, default:
 \code{\link{rabimo_inputs_2020}$config}}
+
+\item{old_version}{if \code{TRUE} the old, erroneous version of this function
+is used (not correctly considering the updated pvd value before calculating
+the new to_swale values). The default is \code{FALSE}.}
 }
 \description{
 Distribute Rainwater Management Measures and run R-Abimo
diff --git a/tests/testthat/test-function-apply_measures_to_blocks.R b/tests/testthat/test-function-apply_measures_to_blocks.R
new file mode 100644
index 00000000..a3340803
--- /dev/null
+++ b/tests/testthat/test-function-apply_measures_to_blocks.R
@@ -0,0 +1,88 @@
+#library(testthat)
+test_that("apply_measures_to_blocks() works", {
+  
+  apply_measures_to_blocks <- kwb.rabimo:::apply_measures_to_blocks
+  
+  test_me <- function(data) {
+    
+    blocks <- data[sample(seq_len(nrow(data)), 10L), ]
+    stats <- kwb.rabimo:::get_measure_stats(blocks)
+    safety_factor <- 0.999
+    
+    measures_max <- list(
+      green_roof = safety_factor * stats$green_roof$max,
+      unpaved_max = safety_factor * stats$unpaved$max,
+      to_swale = NA
+    )
+    
+    measures_too_big_green_roof <- list(
+      green_roof = measures_max$green_roof + 0.01,
+      unpaved = measures_max$unpaved,
+      to_swale = NA
+    )
+    
+    measures_too_big_unpaved <- list(
+      green_roof = measures_max$green_roof,
+      unpaved = measures_max$unpaved + 0.01,
+      to_swale = NA
+    )
+    
+    expect_silent(b1 <- apply_measures_to_blocks(
+      blocks, 
+      measures = measures_max
+    ))
+    
+    expect_warning(b2 <- apply_measures_to_blocks(
+      blocks, 
+      measures = measures_too_big_green_roof
+    ))
+    
+    expect_warning(b3 <- apply_measures_to_blocks(
+      blocks, 
+      measures = measures_too_big_unpaved
+    ))
+  }
+  
+  test_me(data = kwb.rabimo::rabimo_inputs_2020$data)
+  test_me(data = kwb.rabimo::rabimo_inputs_2025$data)
+  
+})
+
+if (FALSE) {
+  
+  blocks <- rbind(
+    data.frame(total_area = 100, roof = 0.1, green_roof = 0, pvd = 0.7, to_swale = 1)
+    , data.frame(total_area = 200, roof = 0.2, green_roof = 0.8, pvd = 0.5, to_swale = 1)
+    , data.frame(total_area =  50, roof = 0.9, green_roof = 0.2, pvd = 0.1, to_swale = 1)
+  )
+  
+  stats <- kwb.rabimo::get_measure_stats(blocks)
+  str(stats)
+  
+  n <- 10L
+  
+  m <- as.data.frame(matrix(
+    runif(3*n), 
+    ncol = 3L, 
+    dimnames = list(NULL, c("green_roof", "unpaved", "to_swale"))
+  ))
+  
+  combinations <- split(m, seq_len(n))
+  
+  result <- lapply(combinations, function(measures) {
+    apply_measures_to_blocks(blocks, measures, dbg = TRUE, check = TRUE)
+  })
+  
+  measures <- list(
+    green_roof = 0, 
+    unpaved = 0,
+    to_swale = 0.1
+  )
+  
+  new_blocks <- apply_measures_to_blocks(blocks, measures)
+  
+  new_stats <- kwb.rabimo::get_measure_stats(new_blocks)
+  new_stats$green_roof$mean
+  new_stats$unpaved$mean
+  new_stats$to_swale$mean
+}
diff --git a/tests/testthat/test-function-distribute_measures.R b/tests/testthat/test-function-distribute_measures.R
index 19ef567c..dc397251 100644
--- a/tests/testthat/test-function-distribute_measures.R
+++ b/tests/testthat/test-function-distribute_measures.R
@@ -1,8 +1,9 @@
+#library(testthat)
 test_that("distribute_measures() works", {
 
-  f <- kwb.rabimo:::distribute_measures
+  distribute_measures <- kwb.rabimo:::distribute_measures
 
-  expect_error(f())
+  expect_error(distribute_measures())
 
   blocks <- data.frame(
     total_area = 100,
@@ -14,111 +15,8 @@ test_that("distribute_measures() works", {
   )
 
   targets <- c(green_roof = 0.5, unpaved = 0.5, to_swale = 0.5)
-  result <- f(blocks, targets)
+  result <- distribute_measures(blocks, targets)
 
   expect_identical(result$green_roof, targets[["green_roof"]])
   expect_identical(result$to_swale, targets[["to_swale"]])
-
-  features <- jsonlite::fromJSON('
-    [
-      {
-        "code": "0000000001000016",
-        "prec_yr": 632,
-        "prec_s": 333,
-        "epot_yr": 660,
-        "epot_s": 530,
-        "district": "1",
-        "total_area": 4951.8538,
-        "area_main": 4951.8538,
-        "area_rd": 0,
-        "main_frac": 1,
-        "roof": 0.009,
-        "green_roof": 0,
-        "swg_roof": 1,
-        "pvd": 0.9736,
-        "swg_pvd": 1,
-        "srf1_pvd": 0.33,
-        "srf2_pvd": 0.15,
-        "srf3_pvd": 0.16,
-        "srf4_pvd": 0,
-        "srf5_pvd": 0.36,
-        "road_frac": 0,
-        "pvd_r": 0,
-        "swg_pvd_r": 1,
-        "srf1_pvd_r": 0,
-        "srf2_pvd_r": 0,
-        "srf3_pvd_r": 0,
-        "srf4_pvd_r": 0,
-        "sealed": 0.9826,
-        "to_swale": 0,
-        "gw_dist": 2.8,
-        "ufc30": 12,
-        "ufc150": 10,
-        "land_type": "urban",
-        "veg_class": 35,
-        "irrigation": 0,
-        "block_type": "300_road"
-      },
-      {
-        "code": "0000000001000017",
-        "prec_yr": 632,
-        "prec_s": 333,
-        "epot_yr": 660,
-        "epot_s": 530,
-        "district": "1",
-        "total_area": 4951.8538,
-        "area_main": 4951.8538,
-        "area_rd": 0,
-        "main_frac": 1.0,
-        "roof": 0.009,
-        "green_roof": 0,
-        "swg_roof": 1,
-        "pvd": 0.9736,
-        "swg_pvd": 1,
-        "srf1_pvd": 0.33,
-        "srf2_pvd": 0.15,
-        "srf3_pvd": 0.16,
-        "srf4_pvd": 0,
-        "srf5_pvd": 0.36,
-        "road_frac": 0,
-        "pvd_r": 0,
-        "swg_pvd_r": 1,
-        "srf1_pvd_r": 0,
-        "srf2_pvd_r": 0,
-        "srf3_pvd_r": 0,
-        "srf4_pvd_r": 0,
-        "sealed": 0.9826,
-        "to_swale": 0,
-        "gw_dist": 2.8,
-        "ufc30": 12,
-        "ufc150": 10,
-        "land_type": "urban",
-        "veg_class": 35,
-        "irrigation": 0,
-        "block_type": "300_road"
-      }
-    ]')
-
-  measure_stats <- kwb.rabimo::get_measure_stats(blocks)
-  sprintf("%0.10f", measure_stats$green_roof$max)
-
-  features <- kwb.rabimo:::check_or_convert_data_types(
-    features,
-    types = kwb.rabimo:::get_expected_data_type(),
-    convert = TRUE,
-    dbg = FALSE
-  )
-
-  expect_no_error(expect_output(
-    kwb.rabimo::run_rabimo_with_measures(features, measures = list(
-      green_roof = 0.009, to_swale = 0, unpaved = 0.3
-    ))
-  ))
-
-  expect_error(
-    kwb.rabimo::run_rabimo_with_measures(features, measures = list(
-      green_roof = 0.00900001, to_swale = 0, unpaved = 0.3
-    ))
-  )
-
 })
diff --git a/tests/testthat/test-function-rescale_target_values.R b/tests/testthat/test-function-rescale_target_values.R
index 2f21975f..148c10e4 100644
--- a/tests/testthat/test-function-rescale_target_values.R
+++ b/tests/testthat/test-function-rescale_target_values.R
@@ -15,6 +15,7 @@ test_that("rescale_target_values() works", {
   ))
 
   blocks <- kwb.rabimo::generate_rabimo_area("a", roof = 0)
+  
   # case reported by Luise
   new_targets <- list(green_roof = 0, unpaved = 0.995489083, to_swale = 0)
   expect_no_error(result <- f(new_targets, blocks = blocks))
@@ -25,6 +26,7 @@ test_that("rescale_target_values() works", {
   expect_identical(result$green_roof, 0)
 
   blocks <- kwb.rabimo::generate_rabimo_area("a", roof = 0, pvd = 0)
+  
   # case reported by Luise
   new_targets <- list(green_roof = 0, unpaved = 1, to_swale = 0)
   expect_no_error(result <- f(new_targets, blocks = blocks))
@@ -33,4 +35,15 @@ test_that("rescale_target_values() works", {
   new_targets <- list(green_roof = 0, unpaved = 1, to_swale = 0.1)
   expect_no_error(result <- f(new_targets, blocks = blocks))
   expect_identical(result$to_swale, 0)
+  
+  block <- data.frame(
+    code = "a", 
+    total_area = 100, 
+    roof = 0.1,
+    pvd = 0.1
+  )
+
+  given    <- list(green_roof = 0.1, unpaved = 0.1, to_swale = 0)
+  expected <- list(green_roof =   1, unpaved = 0.1, to_swale = 0)
+  expect_identical(f(given, block), expected)
 })
diff --git a/tests/testthat/test-function-run_rabimo_with_measures.R b/tests/testthat/test-function-run_rabimo_with_measures.R
index 32a2d71f..f55d1edb 100644
--- a/tests/testthat/test-function-run_rabimo_with_measures.R
+++ b/tests/testthat/test-function-run_rabimo_with_measures.R
@@ -1,9 +1,97 @@
 #library(testthat)
-test_that("run_rabimo_with_measures() works", {
 
-  f <- kwb.rabimo::run_rabimo_with_measures
+features <- jsonlite::fromJSON('
+    [
+      {
+        "code": "0000000001000016",
+        "prec_yr": 632,
+        "prec_s": 333,
+        "epot_yr": 660,
+        "epot_s": 530,
+        "district": "1",
+        "total_area": 4951.8538,
+        "area_main": 4951.8538,
+        "area_rd": 0,
+        "main_frac": 1,
+        "roof": 0.009,
+        "green_roof": 0,
+        "swg_roof": 1,
+        "pvd": 0.9736,
+        "swg_pvd": 1,
+        "srf1_pvd": 0.33,
+        "srf2_pvd": 0.15,
+        "srf3_pvd": 0.16,
+        "srf4_pvd": 0,
+        "srf5_pvd": 0.36,
+        "road_frac": 0,
+        "pvd_r": 0,
+        "swg_pvd_r": 1,
+        "srf1_pvd_r": 0,
+        "srf2_pvd_r": 0,
+        "srf3_pvd_r": 0,
+        "srf4_pvd_r": 0,
+        "sealed": 0.9826,
+        "to_swale": 0,
+        "gw_dist": 2.8,
+        "ufc30": 12,
+        "ufc150": 10,
+        "land_type": "urban",
+        "veg_class": 35,
+        "irrigation": 0,
+        "block_type": "300_road"
+      },
+      {
+        "code": "0000000001000017",
+        "prec_yr": 632,
+        "prec_s": 333,
+        "epot_yr": 660,
+        "epot_s": 530,
+        "district": "1",
+        "total_area": 4951.8538,
+        "area_main": 4951.8538,
+        "area_rd": 0,
+        "main_frac": 1.0,
+        "roof": 0.009,
+        "green_roof": 0,
+        "swg_roof": 1,
+        "pvd": 0.9736,
+        "swg_pvd": 1,
+        "srf1_pvd": 0.33,
+        "srf2_pvd": 0.15,
+        "srf3_pvd": 0.16,
+        "srf4_pvd": 0,
+        "srf5_pvd": 0.36,
+        "road_frac": 0,
+        "pvd_r": 0,
+        "swg_pvd_r": 1,
+        "srf1_pvd_r": 0,
+        "srf2_pvd_r": 0,
+        "srf3_pvd_r": 0,
+        "srf4_pvd_r": 0,
+        "sealed": 0.9826,
+        "to_swale": 0,
+        "gw_dist": 2.8,
+        "ufc30": 12,
+        "ufc150": 10,
+        "land_type": "urban",
+        "veg_class": 35,
+        "irrigation": 0,
+        "block_type": "300_road"
+      }
+    ]')
 
-  expect_error(f())
+features <- kwb.rabimo:::check_or_convert_data_types(
+  features,
+  types = kwb.rabimo:::get_expected_data_type(),
+  convert = TRUE,
+  dbg = FALSE
+)
+
+test_that("run_rabimo_with_measures(old_version = TRUE) works", {
+
+  run_rabimo_with_measures <- kwb.rabimo::run_rabimo_with_measures
+
+  expect_error(run_rabimo_with_measures())
 
   test_me <- function(data) {
     blocks <- data[sample(seq_len(nrow(data)), 10L), ]
@@ -34,15 +122,41 @@ test_that("run_rabimo_with_measures() works", {
       to_swale = measures_max$to_swale + 0.01
     )
     
-    expect_output(result <- f(blocks, measures = measures_max))
+    expect_output(result <- run_rabimo_with_measures(
+      blocks, measures = measures_max, old_version = TRUE
+    ))
+    
     expect_true(all(result$surface_runoff == 0))
     
-    expect_error(f(blocks, measures = measures_too_big_1))
-    expect_error(f(blocks, measures = measures_too_big_2))
-    expect_error(f(blocks, measures = measures_too_big_3))
+    expect_error(run_rabimo_with_measures(
+      blocks, measures = measures_too_big_1, old_version = TRUE
+    ))
+    
+    expect_error(run_rabimo_with_measures(
+      blocks, measures = measures_too_big_2, old_version = TRUE
+    ))
+    
+    expect_error(run_rabimo_with_measures(
+      blocks, measures = measures_too_big_3, old_version = TRUE
+    ))
   }
   
   test_me(data = kwb.rabimo::rabimo_inputs_2020$data)
   test_me(data = kwb.rabimo::rabimo_inputs_2025$data)
   
+  expect_no_error(expect_output(
+    kwb.rabimo::run_rabimo_with_measures(
+      features, 
+      measures = list(green_roof = 0.009, to_swale = 0, unpaved = 0.3), 
+      old_version = TRUE
+    )
+  ))
+  
+  expect_error(
+    kwb.rabimo::run_rabimo_with_measures(
+      features, 
+      measures = list(green_roof = 0.00900001, to_swale = 0, unpaved = 0.3),
+      old_version = TRUE
+    )
+  )
 })

From 6a7858acd9d78dc054721aac5e1378a1e2077763 Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Fri, 10 Oct 2025 23:21:06 +0200
Subject: [PATCH 02/12] Add .idea to .gitignore

---
 .gitignore | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.gitignore b/.gitignore
index 6893b526..44842428 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,4 @@
+.idea
 .Rproj.user
 .Rhistory
 .RData

From 6a1c54da587cb2c84ef45cfc88d23cf0b0e667cb Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Fri, 10 Oct 2025 23:21:37 +0200
Subject: [PATCH 03/12] Use helper variable "a_total_sum"

---
 R/apply_measures_to_blocks.R | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/R/apply_measures_to_blocks.R b/R/apply_measures_to_blocks.R
index 8df92b7e..19b96e14 100644
--- a/R/apply_measures_to_blocks.R
+++ b/R/apply_measures_to_blocks.R
@@ -56,6 +56,7 @@ apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALS
   # the measures.
   a_total <- blocks$total_area
   a_roof <- blocks$total_area * blocks$roof
+  a_total_sum <- sum(a_total)
   
   # 1. Handle measure "green roof"
   if (!is.na(measures$green_roof)) {
@@ -63,7 +64,7 @@ apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALS
     a_green_roof <- a_roof * blocks$green_roof
     
     # Total green roof area to add (if value >= 0) or to remove (if value < 0)
-    a_green_roof_change <- sum(measures$green_roof * a_total) - sum(a_green_roof)
+    a_green_roof_change <- measures$green_roof * a_total_sum - sum(a_green_roof)
     
     # Roof area that can be converted to green roof area
     if (a_green_roof_change >= 0) {
@@ -106,7 +107,7 @@ apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALS
     a_unpaved <- a_total - a_roof - a_paved
 
     # Required increase/decrease in unpaved area
-    a_unpaved_change <- measures$unpaved * sum(a_total) - sum(a_unpaved)
+    a_unpaved_change <- measures$unpaved * a_total_sum - sum(a_unpaved)
     unpave <- a_unpaved_change >= 0
     
     debug(sprintf(
@@ -151,7 +152,7 @@ apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALS
   if (!is.na(measures$to_swale)) {
     a_sealed <- a_roof + a_total * blocks$pvd
     a_to_swale <- blocks$to_swale * a_sealed
-    a_to_swale_change <- sum(measures$to_swale * a_total) - sum(a_to_swale)
+    a_to_swale_change <- measures$to_swale * a_total_sum - sum(a_to_swale)
     
     increase <- a_to_swale_change >= 0
     

From de025662c7bde6e12a978810d96c4cf2d771f8ac Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Fri, 10 Oct 2025 23:29:50 +0200
Subject: [PATCH 04/12] Simply and consistently use name "a_potential"

---
 R/apply_measures_to_blocks.R | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/R/apply_measures_to_blocks.R b/R/apply_measures_to_blocks.R
index 19b96e14..7620f52a 100644
--- a/R/apply_measures_to_blocks.R
+++ b/R/apply_measures_to_blocks.R
@@ -70,30 +70,30 @@ apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALS
     if (a_green_roof_change >= 0) {
       
       # increase green roof area
-      a_green_roof_potential <- a_roof - a_green_roof
+      a_potential <- a_roof - a_green_roof
       
-      if (a_green_roof_change > sum(a_green_roof_potential)) {
+      if (a_green_roof_change > sum(a_potential)) {
         report_problem(sprintf(
           "Not enough (non-green) roof area available (%0.2f m2 missing)",
-          a_green_roof_change - sum(a_green_roof_potential)
+          a_green_roof_change - sum(a_potential)
         ))
       }
       
     } else {
       
       # decrease green roof area
-      a_green_roof_potential <- a_green_roof
+      a_potential <- a_green_roof
       
-      if (- a_green_roof_change > sum(a_green_roof_potential)) {
+      if (- a_green_roof_change > sum(a_potential)) {
         report_problem(sprintf(
           "Not enough green roof area available (%0.2f m2 missing)",
-          - a_green_roof_change - sum(a_green_roof_potential)
+          - a_green_roof_change - sum(a_potential)
         ))
       }    
     }
     
     # Distribute change in green roof area to the different blocks    
-    a_green_roof_new <- a_green_roof + share_of_sum(a_green_roof_potential) * a_green_roof_change
+    a_green_roof_new <- a_green_roof + share_of_sum(a_potential) * a_green_roof_change
     
     # Update column "green_roof" (as fraction of roof area)
     blocks$green_roof <- ifelse(a_roof == 0, 0, a_green_roof_new / a_roof)
@@ -164,30 +164,30 @@ apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALS
     
     if (increase) {
       
-      a_to_swale_potential <- a_sealed - a_to_swale
+      a_potential <- a_sealed - a_to_swale
       
-      if (a_to_swale_change > sum(a_to_swale_potential)) {
+      if (a_to_swale_change > sum(a_potential)) {
         report_problem(sprintf(
           "Not enough sealed area available to be connected to swales (%0.2f m2 missing)",
-          a_to_swale_change - sum(a_to_swale_potential)
+          a_to_swale_change - sum(a_potential)
         ))
       }
       
     } else {
       
       # a_to_swale_change is negative here
-      a_to_swale_potential <- a_to_swale
+      a_potential <- a_to_swale
       
-      if (- a_to_swale_change > sum(a_to_swale_potential)) {
+      if (- a_to_swale_change > sum(a_potential)) {
         report_problem(sprintf(
           "Not enough swale-connected sealed area available to be disconnected (%0.2f m2 missing)",
-          abs(a_to_swale_change) - sum(a_to_swale_potential)
+          abs(a_to_swale_change) - sum(a_potential)
         ))
       }
     }
     
     # distribute
-    a_to_swale_new <- a_to_swale + share_of_sum(a_to_swale_potential) * a_to_swale_change
+    a_to_swale_new <- a_to_swale + share_of_sum(a_potential) * a_to_swale_change
     
     # Update column "to_swale"
     blocks$to_swale <- ifelse(a_sealed == 0, 0, a_to_swale_new / a_sealed)

From 7b7b6d4693da0c71f9a2293d12a54f248f17f90e Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Sat, 11 Oct 2025 06:41:10 +0200
Subject: [PATCH 05/12] Implement tests for single "extreme" measures

---
 R/apply_measures_to_blocks.R                  |   2 +-
 .../test-function-apply_measures_to_blocks.R  | 147 +++++++++---------
 2 files changed, 73 insertions(+), 76 deletions(-)

diff --git a/R/apply_measures_to_blocks.R b/R/apply_measures_to_blocks.R
index 7620f52a..3ed7e302 100644
--- a/R/apply_measures_to_blocks.R
+++ b/R/apply_measures_to_blocks.R
@@ -3,7 +3,7 @@
 #   A value of NA means that the corresponding measure column is not touched.
 apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALSE)
 {
-  #dbg = FALSE; check = FALSE
+  #dbg = TRUE; check = TRUE
   
   # Define helper functions
   {
diff --git a/tests/testthat/test-function-apply_measures_to_blocks.R b/tests/testthat/test-function-apply_measures_to_blocks.R
index a3340803..6021b9a6 100644
--- a/tests/testthat/test-function-apply_measures_to_blocks.R
+++ b/tests/testthat/test-function-apply_measures_to_blocks.R
@@ -1,88 +1,85 @@
 #library(testthat)
-test_that("apply_measures_to_blocks() works", {
-  
-  apply_measures_to_blocks <- kwb.rabimo:::apply_measures_to_blocks
-  
-  test_me <- function(data) {
-    
-    blocks <- data[sample(seq_len(nrow(data)), 10L), ]
-    stats <- kwb.rabimo:::get_measure_stats(blocks)
-    safety_factor <- 0.999
-    
-    measures_max <- list(
-      green_roof = safety_factor * stats$green_roof$max,
-      unpaved_max = safety_factor * stats$unpaved$max,
-      to_swale = NA
-    )
-    
-    measures_too_big_green_roof <- list(
-      green_roof = measures_max$green_roof + 0.01,
-      unpaved = measures_max$unpaved,
-      to_swale = NA
-    )
-    
-    measures_too_big_unpaved <- list(
-      green_roof = measures_max$green_roof,
-      unpaved = measures_max$unpaved + 0.01,
-      to_swale = NA
-    )
-    
-    expect_silent(b1 <- apply_measures_to_blocks(
-      blocks, 
-      measures = measures_max
-    ))
-    
-    expect_warning(b2 <- apply_measures_to_blocks(
-      blocks, 
-      measures = measures_too_big_green_roof
-    ))
-    
-    expect_warning(b3 <- apply_measures_to_blocks(
-      blocks, 
-      measures = measures_too_big_unpaved
-    ))
-  }
-  
-  test_me(data = kwb.rabimo::rabimo_inputs_2020$data)
-  test_me(data = kwb.rabimo::rabimo_inputs_2025$data)
+apply_measures_to_blocks <- kwb.rabimo:::apply_measures_to_blocks
+
+test_that("apply_measures_to_blocks() sets green_roof (alone) correctly", {
   
+  # Make all roofs green roofs
+  blocks <- data.frame(total_area = 100, roof = 0.5, green_roof = 0)
+  measures <- list(green_roof = 0.5, unpaved = NA, to_swale = NA)
+  expected <- blocks
+  expected$green_roof <- 1
+  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+
+  # Remove all green roofs
+  blocks <- data.frame(total_area = 100, roof = 0.5, green_roof = 0.4)
+  measures <- list(green_roof = 0, unpaved = NA, to_swale = NA)
+  expected <- blocks
+  expected$green_roof <- 0
+  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+
 })
 
-if (FALSE) {
+test_that("apply_measures_to_blocks() sets pvd (alone) correctly", {
   
-  blocks <- rbind(
-    data.frame(total_area = 100, roof = 0.1, green_roof = 0, pvd = 0.7, to_swale = 1)
-    , data.frame(total_area = 200, roof = 0.2, green_roof = 0.8, pvd = 0.5, to_swale = 1)
-    , data.frame(total_area =  50, roof = 0.9, green_roof = 0.2, pvd = 0.1, to_swale = 1)
-  )
+  # Remove all pavement
   
-  stats <- kwb.rabimo::get_measure_stats(blocks)
-  str(stats)
-  
-  n <- 10L
+  # roof = 0 -> max. unpaved = 1
+  blocks <- data.frame(total_area = 100, roof = 0, pvd = seq(0, 1, 0.1))
+  measures <- list(green_roof = NA, unpaved = 1, to_swale = NA)
+  expected <- blocks
+  expected$pvd <- 0
+  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+
+  # roof = 0.2 -> max. unpaved = 0.8
+  blocks <- data.frame(total_area = 100, roof = 0.2, pvd = seq(0, 0.8, 0.1))
+  measures <- list(green_roof = NA, unpaved = 0.8, to_swale = NA)
+  expected <- blocks
+  expected$pvd <- 0
+  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
   
-  m <- as.data.frame(matrix(
-    runif(3*n), 
-    ncol = 3L, 
-    dimnames = list(NULL, c("green_roof", "unpaved", "to_swale"))
-  ))
+  # Pave everything
+
+  # roof = 0 -> max. paved = 1
+  blocks <- data.frame(total_area = 100, roof = 0, pvd = seq(0, 1, 0.1))
+  measures <- list(green_roof = NA, unpaved = 0, to_swale = NA)
+  expected <- blocks
+  expected$pvd <- 1
+  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+
+  # roof = 0.5 -> max. paved = 0.5
+  blocks <- data.frame(total_area = 100, roof = 0.5, pvd = seq(0, 0.5, 0.1))
+  measures <- list(green_roof = NA, unpaved = 0, to_swale = NA)
+  expected <- blocks
+  expected$pvd <- 0.5
+  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
   
-  combinations <- split(m, seq_len(n))
+})
+
+test_that("apply_measures_to_blocks() sets to_swale (alone) correctly", {
   
-  result <- lapply(combinations, function(measures) {
-    apply_measures_to_blocks(blocks, measures, dbg = TRUE, check = TRUE)
-  })
+  # Connect everything to swales
   
-  measures <- list(
-    green_roof = 0, 
-    unpaved = 0,
-    to_swale = 0.1
+  blocks <- rbind(
+    data.frame(total_area = 100, roof = 0.1, pvd = 0.4, to_swale = 0),
+    data.frame(total_area = 100, roof = 0.2, pvd = 0.3, to_swale = 0),
+    data.frame(total_area = 100, roof = 0.3, pvd = 0.2, to_swale = 0)
   )
+  # max. to_swale = roof + pvd = 0.5
+  measures <- list(green_roof = NA, unpaved = NA, to_swale = 0.5)
+  expected <- blocks
+  expected$to_swale <- 1
+  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+
+  # Disconnect everything from swales
   
-  new_blocks <- apply_measures_to_blocks(blocks, measures)
+  blocks <- rbind(
+    data.frame(total_area = 100, roof = 0.1, pvd = 0.4, to_swale = 0.0),
+    data.frame(total_area = 100, roof = 0.2, pvd = 0.3, to_swale = 0.2),
+    data.frame(total_area = 100, roof = 0.3, pvd = 0.2, to_swale = 0.4)
+  )
+  measures <- list(green_roof = NA, unpaved = NA, to_swale = 0)
+  expected <- blocks
+  expected$to_swale <- 0
+  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
   
-  new_stats <- kwb.rabimo::get_measure_stats(new_blocks)
-  new_stats$green_roof$mean
-  new_stats$unpaved$mean
-  new_stats$to_swale$mean
-}
+})

From b480475d5caf48bf229d814d47e83cc243cf7594 Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Sat, 11 Oct 2025 08:11:20 +0200
Subject: [PATCH 06/12] Add arguments global_share_<measure>

---
 R/apply_measures_to_blocks.R                  | 16 ++++++-
 R/run_rabimo_with_measures.R                  |  7 ++-
 man/run_rabimo_with_measures.Rd               |  6 ++-
 .../test-function-apply_measures_to_blocks.R  | 34 +++++++-------
 tests/testthat/test-function-run_rabimo.R     | 14 ++++++
 .../test-function-run_rabimo_with_measures.R  | 47 +++++++++++++++++--
 6 files changed, 99 insertions(+), 25 deletions(-)

diff --git a/R/apply_measures_to_blocks.R b/R/apply_measures_to_blocks.R
index 3ed7e302..636093b8 100644
--- a/R/apply_measures_to_blocks.R
+++ b/R/apply_measures_to_blocks.R
@@ -1,7 +1,19 @@
 # @param measures list with elements green_roof, unpaved, to_swale representing 
-#   the target percentages of the total areas corresponding to each measure.
+#   the target shares of the total areas corresponding to each measure.
 #   A value of NA means that the corresponding measure column is not touched.
-apply_measures_to_blocks <- function(blocks, measures, dbg = FALSE, check = FALSE)
+apply_measures_to_blocks <- function(
+    blocks, 
+    measures = list(
+      green_roof = global_share_green_roof,
+      unpaved = global_share_unpaved,
+      to_swale = global_share_to_swale
+    ), 
+    dbg = FALSE, 
+    check = FALSE,
+    global_share_green_roof = NA,
+    global_share_unpaved = NA,
+    global_share_to_swale = NA
+)
 {
   #dbg = TRUE; check = TRUE
   
diff --git a/R/run_rabimo_with_measures.R b/R/run_rabimo_with_measures.R
index 9a10fef6..88d5f819 100644
--- a/R/run_rabimo_with_measures.R
+++ b/R/run_rabimo_with_measures.R
@@ -10,12 +10,15 @@
 #' @param old_version if \code{TRUE} the old, erroneous version of this function 
 #'   is used (not correctly considering the updated pvd value before calculating 
 #'   the new to_swale values). The default is \code{FALSE}.
+#' @param \dots further arguments passed to \code{\link{run_rabimo}}, such as
+#'   \code{silent = TRUE}
 #' @export
 run_rabimo_with_measures <- function(
     blocks,
     measures,
     config = kwb.rabimo::rabimo_inputs_2020$config,
-    old_version = FALSE
+    old_version = FALSE,
+    ...
 )
 {
   #kwb.utils::assignPackageObjects("kwb.rabimo")
@@ -26,5 +29,5 @@ run_rabimo_with_measures <- function(
     apply_measures_to_blocks(blocks, measures)
   }
   
-  run_rabimo(new_blocks, config = config)
+  run_rabimo(new_blocks, config = config, ...)
 }
diff --git a/man/run_rabimo_with_measures.Rd b/man/run_rabimo_with_measures.Rd
index 78c0971b..1c4f6c9e 100644
--- a/man/run_rabimo_with_measures.Rd
+++ b/man/run_rabimo_with_measures.Rd
@@ -8,7 +8,8 @@ run_rabimo_with_measures(
   blocks,
   measures,
   config = kwb.rabimo::rabimo_inputs_2020$config,
-  old_version = FALSE
+  old_version = FALSE,
+  ...
 )
 }
 \arguments{
@@ -25,6 +26,9 @@ corresponding to each measure}
 \item{old_version}{if \code{TRUE} the old, erroneous version of this function
 is used (not correctly considering the updated pvd value before calculating
 the new to_swale values). The default is \code{FALSE}.}
+
+\item{\dots}{further arguments passed to \code{\link{run_rabimo}}, such as
+\code{silent = TRUE}}
 }
 \description{
 Distribute Rainwater Management Measures and run R-Abimo
diff --git a/tests/testthat/test-function-apply_measures_to_blocks.R b/tests/testthat/test-function-apply_measures_to_blocks.R
index 6021b9a6..0a7e90c0 100644
--- a/tests/testthat/test-function-apply_measures_to_blocks.R
+++ b/tests/testthat/test-function-apply_measures_to_blocks.R
@@ -1,21 +1,21 @@
 #library(testthat)
-apply_measures_to_blocks <- kwb.rabimo:::apply_measures_to_blocks
+apply_measures <- kwb.rabimo:::apply_measures_to_blocks
 
 test_that("apply_measures_to_blocks() sets green_roof (alone) correctly", {
   
   # Make all roofs green roofs
   blocks <- data.frame(total_area = 100, roof = 0.5, green_roof = 0)
-  measures <- list(green_roof = 0.5, unpaved = NA, to_swale = NA)
+  result <- apply_measures(blocks, global_share_green_roof = 0.5)
   expected <- blocks
   expected$green_roof <- 1
-  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+  expect_equal(result, expected)
 
   # Remove all green roofs
   blocks <- data.frame(total_area = 100, roof = 0.5, green_roof = 0.4)
-  measures <- list(green_roof = 0, unpaved = NA, to_swale = NA)
+  result <- apply_measures(blocks, global_share_green_roof = 0)
   expected <- blocks
   expected$green_roof <- 0
-  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+  expect_equal(result, expected)
 
 })
 
@@ -25,33 +25,33 @@ test_that("apply_measures_to_blocks() sets pvd (alone) correctly", {
   
   # roof = 0 -> max. unpaved = 1
   blocks <- data.frame(total_area = 100, roof = 0, pvd = seq(0, 1, 0.1))
-  measures <- list(green_roof = NA, unpaved = 1, to_swale = NA)
+  result <- apply_measures(blocks, global_share_unpaved = 1)
   expected <- blocks
   expected$pvd <- 0
-  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+  expect_equal(result, expected)
 
   # roof = 0.2 -> max. unpaved = 0.8
   blocks <- data.frame(total_area = 100, roof = 0.2, pvd = seq(0, 0.8, 0.1))
-  measures <- list(green_roof = NA, unpaved = 0.8, to_swale = NA)
+  result <- apply_measures(blocks, unpaved = 0.8)
   expected <- blocks
   expected$pvd <- 0
-  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+  expect_equal(result, expected)
   
   # Pave everything
 
   # roof = 0 -> max. paved = 1
   blocks <- data.frame(total_area = 100, roof = 0, pvd = seq(0, 1, 0.1))
-  measures <- list(green_roof = NA, unpaved = 0, to_swale = NA)
+  result <- apply_measures(blocks, unpaved = 0)
   expected <- blocks
   expected$pvd <- 1
-  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+  expect_equal(result, expected)
 
   # roof = 0.5 -> max. paved = 0.5
   blocks <- data.frame(total_area = 100, roof = 0.5, pvd = seq(0, 0.5, 0.1))
-  measures <- list(green_roof = NA, unpaved = 0, to_swale = NA)
+  result <- apply_measures(blocks, global_share_unpaved = 0)
   expected <- blocks
   expected$pvd <- 0.5
-  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+  expect_equal(result, expected)
   
 })
 
@@ -65,10 +65,10 @@ test_that("apply_measures_to_blocks() sets to_swale (alone) correctly", {
     data.frame(total_area = 100, roof = 0.3, pvd = 0.2, to_swale = 0)
   )
   # max. to_swale = roof + pvd = 0.5
-  measures <- list(green_roof = NA, unpaved = NA, to_swale = 0.5)
+  result <- apply_measures(blocks, global_share_to_swale = 0.5)
   expected <- blocks
   expected$to_swale <- 1
-  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+  expect_equal(result, expected)
 
   # Disconnect everything from swales
   
@@ -77,9 +77,9 @@ test_that("apply_measures_to_blocks() sets to_swale (alone) correctly", {
     data.frame(total_area = 100, roof = 0.2, pvd = 0.3, to_swale = 0.2),
     data.frame(total_area = 100, roof = 0.3, pvd = 0.2, to_swale = 0.4)
   )
-  measures <- list(green_roof = NA, unpaved = NA, to_swale = 0)
+  result <- apply_measures(blocks, global_share_to_swale = 0)
   expected <- blocks
   expected$to_swale <- 0
-  expect_equal(apply_measures_to_blocks(blocks, measures), expected)
+  expect_equal(result, expected)
   
 })
diff --git a/tests/testthat/test-function-run_rabimo.R b/tests/testthat/test-function-run_rabimo.R
index c3db81d9..2fa190e5 100644
--- a/tests/testthat/test-function-run_rabimo.R
+++ b/tests/testthat/test-function-run_rabimo.R
@@ -99,3 +99,17 @@ test_that("run_rabimo() keeps geometry if data inherits from 'sf'", {
   expect_output(result <- kwb.rabimo::run_rabimo(data, config = inputs$config))
   expect_true("sf" %in% class(result))
 })
+
+test_that("Full connection to swales results in zero runoff", {
+  generate <- kwb.rabimo::generate_rabimo_area
+  data <- rbind(
+    generate("area_0"), 
+    generate("all_swale", to_swale = 1), 
+    generate("all_swale_plus_green_roof", green_roof = 1, to_swale = 1), 
+    generate("all_swale_plus_green_roof", pvd = 0, to_swale = 1), 
+    kwb.rabimo::generate_rabimo_area("all_swale_plus_both", pvd = 0, green_roof = 1, to_swale = 1)
+  )
+  config <- kwb.rabimo::rabimo_inputs_2025$config
+  result <- kwb.rabimo::run_rabimo(data, config, silent = TRUE)
+  expect_true(all(result$runoff[startsWith(result$code, "all_swale")] == 0))
+})
diff --git a/tests/testthat/test-function-run_rabimo_with_measures.R b/tests/testthat/test-function-run_rabimo_with_measures.R
index f55d1edb..5e0c18a4 100644
--- a/tests/testthat/test-function-run_rabimo_with_measures.R
+++ b/tests/testthat/test-function-run_rabimo_with_measures.R
@@ -88,11 +88,11 @@ features <- kwb.rabimo:::check_or_convert_data_types(
 )
 
 test_that("run_rabimo_with_measures(old_version = TRUE) works", {
-
+  
   run_rabimo_with_measures <- kwb.rabimo::run_rabimo_with_measures
-
+  
   expect_error(run_rabimo_with_measures())
-
+  
   test_me <- function(data) {
     blocks <- data[sample(seq_len(nrow(data)), 10L), ]
     stats <- kwb.rabimo:::get_measure_stats(blocks)
@@ -160,3 +160,44 @@ test_that("run_rabimo_with_measures(old_version = TRUE) works", {
     )
   )
 })
+
+test_that("Full connection to swales results in zero runoff", {
+
+  generate <- kwb.rabimo::generate_rabimo_area
+  get_stats <- kwb.rabimo:::get_measure_stats
+  apply_measures <- kwb.rabimo:::apply_measures_to_blocks
+  
+  run <- function(blocks, measures) {
+    kwb.rabimo::run_rabimo_with_measures(
+      blocks = blocks, 
+      measures = measures, 
+      config = kwb.rabimo::rabimo_inputs_2025$config, 
+      silent = TRUE
+    )
+  }
+  
+  # different versions of sealed = 0.3
+  blocks <- generate(
+    code = as.character(1:3), 
+    roof = c(0.0, 0.1, 0.2), 
+    pvd  = c(0.3, 0.2, 0.1)
+  )
+  
+  measures <- list(green_roof = NA, unpaved = NA, to_swale = 0.3)
+  result <- run(blocks, measures)
+  expect_true(all(result$runoff == 0))
+  
+  # max. green_roof = mean(roof) = 0.1
+  max_green_roof <- get_stats(blocks)$green_roof$max
+  # max. unpaved = mean(1 - roof) = 0.9
+  max_unpaved <- get_stats(blocks)$unpaved$max
+  # max. to_swale = mean(roof) = 0.1 (in case of max. removal of pavement)
+  max_to_swale <- get_stats(
+    apply_measures(blocks, global_share_unpaved = max_unpaved)
+  )$to_swale$max
+
+  measures <- list(green_roof = 0.1, unpaved = 0.9, to_swale = 0.1)
+  result <- run(blocks, measures)
+  expect_true(all(result$runoff == 0))
+  
+})

From fc5c498f7aaab9bd71c04b1e41fae878b4edce23 Mon Sep 17 00:00:00 2001
From: Hauke Sonnenberg <hsonne@users.noreply.github.com>
Date: Sat, 11 Oct 2025 08:21:08 +0200
Subject: [PATCH 07/12] Fix test-function-apply_measures_to_blocks.R

---
 tests/testthat/test-function-apply_measures_to_blocks.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-function-apply_measures_to_blocks.R b/tests/testthat/test-function-apply_measures_to_blocks.R
index 0a7e90c0..5f874a60 100644
--- a/tests/testthat/test-function-apply_measures_to_blocks.R
+++ b/tests/testthat/test-function-apply_measures_to_blocks.R
@@ -32,7 +32,7 @@ test_that("apply_measures_to_blocks() sets pvd (alone) correctly", {
 
   # roof = 0.2 -> max. unpaved = 0.8
   blocks <- data.frame(total_area = 100, roof = 0.2, pvd = seq(0, 0.8, 0.1))
-  result <- apply_measures(blocks, unpaved = 0.8)
+  result <- apply_measures(blocks, global_share_unpaved = 0.8)
   expected <- blocks
   expected$pvd <- 0
   expect_equal(result, expected)
@@ -41,7 +41,7 @@ test_that("apply_measures_to_blocks() sets pvd (alone) correctly", {
 
   # roof = 0 -> max. paved = 1
   blocks <- data.frame(total_area = 100, roof = 0, pvd = seq(0, 1, 0.1))
-  result <- apply_measures(blocks, unpaved = 0)
+  result <- apply_measures(blocks, global_share_unpaved = 0)
   expected <- blocks
   expected$pvd <- 1
   expect_equal(result, expected)

From a027f640fcbebfaae2065b91c678893996b8c89b Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Sun, 12 Oct 2025 07:55:01 +0200
Subject: [PATCH 08/12] Use some globals to shorten the main code

---
 .../test-function-run_rabimo_with_measures.R  | 140 +++++++-----------
 1 file changed, 53 insertions(+), 87 deletions(-)

diff --git a/tests/testthat/test-function-run_rabimo_with_measures.R b/tests/testthat/test-function-run_rabimo_with_measures.R
index 5e0c18a4..39afac0e 100644
--- a/tests/testthat/test-function-run_rabimo_with_measures.R
+++ b/tests/testthat/test-function-run_rabimo_with_measures.R
@@ -1,7 +1,13 @@
 #library(testthat)
 
-features <- jsonlite::fromJSON('
-    [
+# Define globals
+{
+  FEATURES <- kwb.rabimo:::check_or_convert_data_types(
+    types = kwb.rabimo:::get_expected_data_type(), 
+    convert = TRUE, 
+    dbg = FALSE, 
+    data = jsonlite::fromJSON(
+      '[
       {
         "code": "0000000001000016",
         "prec_yr": 632,
@@ -50,7 +56,7 @@ features <- jsonlite::fromJSON('
         "total_area": 4951.8538,
         "area_main": 4951.8538,
         "area_rd": 0,
-        "main_frac": 1.0,
+        "main_frac": 1,
         "roof": 0.009,
         "green_roof": 0,
         "swg_roof": 1,
@@ -78,94 +84,55 @@ features <- jsonlite::fromJSON('
         "irrigation": 0,
         "block_type": "300_road"
       }
-    ]')
-
-features <- kwb.rabimo:::check_or_convert_data_types(
-  features,
-  types = kwb.rabimo:::get_expected_data_type(),
-  convert = TRUE,
-  dbg = FALSE
-)
+    ]'
+    )
+  )
+  
+  SAFETY_FACTOR <- 0.999
+  RUN <- kwb.rabimo::run_rabimo_with_measures
+  RUN_OLD <- function(...) RUN(..., old_version = TRUE, silent = TRUE)
+  GET_MAX <- function(x) lapply(kwb.rabimo:::get_measure_stats(x), `[[`, "max")
+  APPLY_MEASURES <- kwb.rabimo:::apply_measures_to_blocks
+  DATASETS <- lapply(
+    X = list(
+      d2020 = kwb.rabimo::rabimo_inputs_2020$data,
+      d2025 = kwb.rabimo::rabimo_inputs_2025$data
+    ), 
+    FUN = function(df) {
+      df[sample(seq_len(nrow(df)), 10L), ]
+    }
+  )
+  ADD_DELTA <- function(x, element, delta) {
+    x[[element]] <- x[[element]] + 0.01
+    x
+  }
+}
 
 test_that("run_rabimo_with_measures(old_version = TRUE) works", {
   
-  run_rabimo_with_measures <- kwb.rabimo::run_rabimo_with_measures
-  
-  expect_error(run_rabimo_with_measures())
+  expect_error(RUN())
   
-  test_me <- function(data) {
-    blocks <- data[sample(seq_len(nrow(data)), 10L), ]
-    stats <- kwb.rabimo:::get_measure_stats(blocks)
-    safety_factor <- 0.999
-    
-    measures_max <- list(
-      green_roof = safety_factor * stats$green_roof$max,
-      unpaved = safety_factor * stats$unpaved$max,
-      to_swale = safety_factor * stats$to_swale$max
-    )
-    
-    measures_too_big_1 <- list(
-      green_roof = measures_max$green_roof + 0.01,
-      unpaved = measures_max$unpaved,
-      to_swale = measures_max$to_swale
-    )
-    
-    measures_too_big_2 <- list(
-      green_roof = measures_max$green_roof,
-      unpaved = measures_max$unpaved + 0.01,
-      to_swale = measures_max$to_swale
-    )
-    
-    measures_too_big_3 <- list(
-      green_roof = measures_max$green_roof,
-      unpaved = measures_max$unpaved,
-      to_swale = measures_max$to_swale + 0.01
-    )
+  for (blocks in DATASETS) {
     
-    expect_output(result <- run_rabimo_with_measures(
-      blocks, measures = measures_max, old_version = TRUE
-    ))
+    #blocks <- DATASETS$d2020
+    m_max <- as.list(SAFETY_FACTOR * unlist(GET_MAX(blocks)))
     
+    expect_no_error(result <- RUN_OLD(blocks, measures = m_max))
     expect_true(all(result$surface_runoff == 0))
     
-    expect_error(run_rabimo_with_measures(
-      blocks, measures = measures_too_big_1, old_version = TRUE
-    ))
+    expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "green_roof")))
+    expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "unpaved")))
+    expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "to_swale")))
     
-    expect_error(run_rabimo_with_measures(
-      blocks, measures = measures_too_big_2, old_version = TRUE
-    ))
-    
-    expect_error(run_rabimo_with_measures(
-      blocks, measures = measures_too_big_3, old_version = TRUE
-    ))
-  }
-  
-  test_me(data = kwb.rabimo::rabimo_inputs_2020$data)
-  test_me(data = kwb.rabimo::rabimo_inputs_2025$data)
-  
-  expect_no_error(expect_output(
-    kwb.rabimo::run_rabimo_with_measures(
-      features, 
-      measures = list(green_roof = 0.009, to_swale = 0, unpaved = 0.3), 
-      old_version = TRUE
-    )
-  ))
+  } # end of for (data in DATASETS)
   
-  expect_error(
-    kwb.rabimo::run_rabimo_with_measures(
-      features, 
-      measures = list(green_roof = 0.00900001, to_swale = 0, unpaved = 0.3),
-      old_version = TRUE
-    )
-  )
+  measures <- list(green_roof = 0.009, to_swale = 0, unpaved = 0.3)
+  expect_no_error(RUN_OLD(FEATURES, measures = measures))
+  expect_error(RUN_OLD(FEATURES, measures = ADD_DELTA(measures, "green_roof")))
+
 })
 
 test_that("Full connection to swales results in zero runoff", {
-
-  generate <- kwb.rabimo::generate_rabimo_area
-  get_stats <- kwb.rabimo:::get_measure_stats
-  apply_measures <- kwb.rabimo:::apply_measures_to_blocks
   
   run <- function(blocks, measures) {
     kwb.rabimo::run_rabimo_with_measures(
@@ -177,7 +144,7 @@ test_that("Full connection to swales results in zero runoff", {
   }
   
   # different versions of sealed = 0.3
-  blocks <- generate(
+  blocks <- kwb.rabimo::generate_rabimo_area(
     code = as.character(1:3), 
     roof = c(0.0, 0.1, 0.2), 
     pvd  = c(0.3, 0.2, 0.1)
@@ -186,16 +153,15 @@ test_that("Full connection to swales results in zero runoff", {
   measures <- list(green_roof = NA, unpaved = NA, to_swale = 0.3)
   result <- run(blocks, measures)
   expect_true(all(result$runoff == 0))
-  
+
   # max. green_roof = mean(roof) = 0.1
-  max_green_roof <- get_stats(blocks)$green_roof$max
   # max. unpaved = mean(1 - roof) = 0.9
-  max_unpaved <- get_stats(blocks)$unpaved$max
-  # max. to_swale = mean(roof) = 0.1 (in case of max. removal of pavement)
-  max_to_swale <- get_stats(
-    apply_measures(blocks, global_share_unpaved = max_unpaved)
-  )$to_swale$max
-
+  m_max <- GET_MAX(blocks)
+  # correct max. to_swale
+  m_max$to_swale <- GET_MAX(
+    APPLY_MEASURES(blocks, global_share_unpaved = m_max$unpaved)
+  )$to_swale
+  
   measures <- list(green_roof = 0.1, unpaved = 0.9, to_swale = 0.1)
   result <- run(blocks, measures)
   expect_true(all(result$runoff == 0))

From 214708b076bc32e5b3862d7dd640c32df83b0ec7 Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Sun, 12 Oct 2025 08:39:18 +0200
Subject: [PATCH 09/12] Add CORRECT_TO_SWALE_MAX

---
 .../test-function-run_rabimo_with_measures.R  | 62 +++++++++++--------
 1 file changed, 37 insertions(+), 25 deletions(-)

diff --git a/tests/testthat/test-function-run_rabimo_with_measures.R b/tests/testthat/test-function-run_rabimo_with_measures.R
index 39afac0e..50c99b86 100644
--- a/tests/testthat/test-function-run_rabimo_with_measures.R
+++ b/tests/testthat/test-function-run_rabimo_with_measures.R
@@ -88,9 +88,9 @@
     )
   )
   
-  SAFETY_FACTOR <- 0.999
-  RUN <- kwb.rabimo::run_rabimo_with_measures
-  RUN_OLD <- function(...) RUN(..., old_version = TRUE, silent = TRUE)
+  SAFETY_FACTOR <- 0.9999
+  RUN_NEW <- function(...) kwb.rabimo::run_rabimo_with_measures(..., silent = TRUE)
+  RUN_OLD <- function(...) RUN_NEW(..., old_version = TRUE)
   GET_MAX <- function(x) lapply(kwb.rabimo:::get_measure_stats(x), `[[`, "max")
   APPLY_MEASURES <- kwb.rabimo:::apply_measures_to_blocks
   DATASETS <- lapply(
@@ -106,43 +106,57 @@
     x[[element]] <- x[[element]] + 0.01
     x
   }
+  CORRECT_TO_SWALE_MAX <- function(m, blocks) {
+    m$to_swale <- NA
+    m$to_swale <- GET_MAX(APPLY_MEASURES(blocks, m))$to_swale
+    m
+  }
 }
 
 test_that("run_rabimo_with_measures(old_version = TRUE) works", {
   
-  expect_error(RUN())
+  expect_error(RUN_OLD())
+  expect_error(RUN_NEW())
   
   for (blocks in DATASETS) {
     
     #blocks <- DATASETS$d2020
     m_max <- as.list(SAFETY_FACTOR * unlist(GET_MAX(blocks)))
     
+    # The maximum values were ok in the old version
     expect_no_error(result <- RUN_OLD(blocks, measures = m_max))
     expect_true(all(result$surface_runoff == 0))
-    
+
+    # Exceeding any maximum value results in an error
     expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "green_roof")))
     expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "unpaved")))
     expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "to_swale")))
     
+    # The maximum values lead to an error in the new version because after
+    # maximum unpaving there is nothing left to be connected to swales
+    expect_error(expect_warning(RUN_NEW(blocks, measures = m_max)))
+
+    # However, we can recalculate the maximum "to_swale"
+    expect_no_error(
+      result <- RUN_NEW(blocks, measures = CORRECT_TO_SWALE_MAX(m_max, blocks))
+    )
+    expect_true(all(result$runoff < 0.1))
+
   } # end of for (data in DATASETS)
   
   measures <- list(green_roof = 0.009, to_swale = 0, unpaved = 0.3)
   expect_no_error(RUN_OLD(FEATURES, measures = measures))
   expect_error(RUN_OLD(FEATURES, measures = ADD_DELTA(measures, "green_roof")))
 
+  expect_no_error(RUN_NEW(FEATURES, measures))
+  expect_error(RUN_NEW(FEATURES, ADD_DELTA(measures, "green_roof")))
+  
 })
 
 test_that("Full connection to swales results in zero runoff", {
   
-  run <- function(blocks, measures) {
-    kwb.rabimo::run_rabimo_with_measures(
-      blocks = blocks, 
-      measures = measures, 
-      config = kwb.rabimo::rabimo_inputs_2025$config, 
-      silent = TRUE
-    )
-  }
-  
+  CONFIG <- kwb.rabimo::rabimo_inputs_2025$config
+
   # different versions of sealed = 0.3
   blocks <- kwb.rabimo::generate_rabimo_area(
     code = as.character(1:3), 
@@ -150,20 +164,18 @@ test_that("Full connection to swales results in zero runoff", {
     pvd  = c(0.3, 0.2, 0.1)
   )
   
+  check_result <- function(result) {
+    expect_true(all(result$runoff == 0))
+  }
+
   measures <- list(green_roof = NA, unpaved = NA, to_swale = 0.3)
-  result <- run(blocks, measures)
-  expect_true(all(result$runoff == 0))
+  result <- RUN_NEW(blocks, measures, config = CONFIG)
+  check_result(result)
 
   # max. green_roof = mean(roof) = 0.1
   # max. unpaved = mean(1 - roof) = 0.9
-  m_max <- GET_MAX(blocks)
   # correct max. to_swale
-  m_max$to_swale <- GET_MAX(
-    APPLY_MEASURES(blocks, global_share_unpaved = m_max$unpaved)
-  )$to_swale
-  
-  measures <- list(green_roof = 0.1, unpaved = 0.9, to_swale = 0.1)
-  result <- run(blocks, measures)
-  expect_true(all(result$runoff == 0))
-  
+  m_max <- CORRECT_TO_SWALE_MAX(GET_MAX(blocks), blocks)
+  result <- RUN_NEW(blocks, m_max, config = CONFIG)
+  check_result(result)
 })

From 0c041d6f9b5713d1f06785bc790f4479fb0d1ae5 Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Tue, 14 Oct 2025 19:35:19 +0200
Subject: [PATCH 10/12] Test only new version of run_rabimo_with_measures()

---
 R/apply_measures_to_blocks.R                  |  7 +-
 .../test-function-run_rabimo_with_measures.R  | 94 ++++++++++---------
 2 files changed, 54 insertions(+), 47 deletions(-)

diff --git a/R/apply_measures_to_blocks.R b/R/apply_measures_to_blocks.R
index 636093b8..8eddd90c 100644
--- a/R/apply_measures_to_blocks.R
+++ b/R/apply_measures_to_blocks.R
@@ -67,8 +67,8 @@ apply_measures_to_blocks <- function(
   # Provide the total areas and roof areas in advance. They are not changed by 
   # the measures.
   a_total <- blocks$total_area
-  a_roof <- blocks$total_area * blocks$roof
   a_total_sum <- sum(a_total)
+  a_roof <- a_total * blocks$roof
   
   # 1. Handle measure "green roof"
   if (!is.na(measures$green_roof)) {
@@ -125,7 +125,7 @@ apply_measures_to_blocks <- function(
     debug(sprintf(
       "%s area to be %s: %0.2f m2", 
       ifelse(unpave, "Paved", "Unpaved"),
-      ifelse(unpave, "unpaved", "paved"),
+      ifelse(unpave, "Unpaved", "paved"),
       abs(a_unpaved_change)
     ))
     
@@ -162,6 +162,7 @@ apply_measures_to_blocks <- function(
   
   # 3. Handle measure "Connection to swales"
   if (!is.na(measures$to_swale)) {
+    
     a_sealed <- a_roof + a_total * blocks$pvd
     a_to_swale <- blocks$to_swale * a_sealed
     a_to_swale_change <- measures$to_swale * a_total_sum - sum(a_to_swale)
@@ -208,7 +209,7 @@ apply_measures_to_blocks <- function(
   # Targets reached?
   if (check) {
     for (measure in names(measures)[!is.na(measures)]) {
-      check_if_target_was_reached(blocks, measure)  
+      check_if_target_was_reached(blocks, measure)
       check_for_negative_values(blocks, measure)
     }
   }
diff --git a/tests/testthat/test-function-run_rabimo_with_measures.R b/tests/testthat/test-function-run_rabimo_with_measures.R
index 50c99b86..0aaac858 100644
--- a/tests/testthat/test-function-run_rabimo_with_measures.R
+++ b/tests/testthat/test-function-run_rabimo_with_measures.R
@@ -88,20 +88,11 @@
     )
   )
   
+  #FEATURES
   SAFETY_FACTOR <- 0.9999
-  RUN_NEW <- function(...) kwb.rabimo::run_rabimo_with_measures(..., silent = TRUE)
-  RUN_OLD <- function(...) RUN_NEW(..., old_version = TRUE)
+  RUN <- function(...) kwb.rabimo::run_rabimo_with_measures(..., silent = TRUE)
   GET_MAX <- function(x) lapply(kwb.rabimo:::get_measure_stats(x), `[[`, "max")
   APPLY_MEASURES <- kwb.rabimo:::apply_measures_to_blocks
-  DATASETS <- lapply(
-    X = list(
-      d2020 = kwb.rabimo::rabimo_inputs_2020$data,
-      d2025 = kwb.rabimo::rabimo_inputs_2025$data
-    ), 
-    FUN = function(df) {
-      df[sample(seq_len(nrow(df)), 10L), ]
-    }
-  )
   ADD_DELTA <- function(x, element, delta) {
     x[[element]] <- x[[element]] + 0.01
     x
@@ -115,42 +106,57 @@
 
 test_that("run_rabimo_with_measures(old_version = TRUE) works", {
   
-  expect_error(RUN_OLD())
-  expect_error(RUN_NEW())
+  expect_error(RUN())
+  
+  sample_size <- 100L
   
-  for (blocks in DATASETS) {
+  for (seed in sample(1e10, 5)) {
     
-    #blocks <- DATASETS$d2020
-    m_max <- as.list(SAFETY_FACTOR * unlist(GET_MAX(blocks)))
+    #seed <- seeds[1L]
+    writeLines(paste("seed:", seed))
     
-    # The maximum values were ok in the old version
-    expect_no_error(result <- RUN_OLD(blocks, measures = m_max))
-    expect_true(all(result$surface_runoff == 0))
-
-    # Exceeding any maximum value results in an error
-    expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "green_roof")))
-    expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "unpaved")))
-    expect_error(RUN_OLD(blocks, measures = ADD_DELTA(m_max, "to_swale")))
+    DATASETS <- lapply(
+      X = list(
+        d2020 = kwb.rabimo::rabimo_inputs_2020$data,
+        d2025 = kwb.rabimo::rabimo_inputs_2025$data
+      ), 
+      FUN = function(df) {
+        df[sample(seq_len(nrow(df)), sample_size), ]
+      }
+    )
     
-    # The maximum values lead to an error in the new version because after
-    # maximum unpaving there is nothing left to be connected to swales
-    expect_error(expect_warning(RUN_NEW(blocks, measures = m_max)))
+    for (blocks in DATASETS) {
+      
+      #blocks <- DATASETS$d2025
+      m_max_old <- as.list(SAFETY_FACTOR * unlist(GET_MAX(blocks)))
+      m_max_new <- CORRECT_TO_SWALE_MAX(m_max_old, blocks)
 
-    # However, we can recalculate the maximum "to_swale"
-    expect_no_error(
-      result <- RUN_NEW(blocks, measures = CORRECT_TO_SWALE_MAX(m_max, blocks))
-    )
-    expect_true(all(result$runoff < 0.1))
+      # The maximum values lead to an error in the new version because after
+      # maximum unpaving there is nothing left to be connected to swales
+      expect_error(suppressWarnings(RUN(blocks, measures = m_max_old)))
+      
+      # However, with the corrected maximum value for "to_swale" it works
+      # The new version should not produce runoff with the well-calculated values
+      expect_no_error(suppressWarnings(result <- RUN(blocks, measures = m_max_new)))
 
-  } # end of for (data in DATASETS)
-  
+      expect_true(all(result$runoff == 0))
+      #expect_true(all(result$runoff < 0.1))
+
+      # Exceeding any maximum value results in an error
+      expect_error(suppressWarnings(RUN(blocks, measures = ADD_DELTA(m_max_new, "green_roof"))))
+      expect_error(suppressWarnings(RUN(blocks, measures = ADD_DELTA(m_max_new, "unpaved"))))
+      expect_error(suppressWarnings(RUN(blocks, measures = ADD_DELTA(m_max_new, "to_swale"))))
+
+    } # end of for (data in DATASETS)
+  }
+
+  # Testing the features that caused problems as reported by Luise
   measures <- list(green_roof = 0.009, to_swale = 0, unpaved = 0.3)
-  expect_no_error(RUN_OLD(FEATURES, measures = measures))
-  expect_error(RUN_OLD(FEATURES, measures = ADD_DELTA(measures, "green_roof")))
+  expect_no_error(RUN(FEATURES, measures = measures))
+  expect_error(suppressWarnings(RUN(FEATURES, measures = ADD_DELTA(measures, "green_roof"))))
 
-  expect_no_error(RUN_NEW(FEATURES, measures))
-  expect_error(RUN_NEW(FEATURES, ADD_DELTA(measures, "green_roof")))
-  
+  expect_no_error(RUN(FEATURES, measures))
+  expect_error(suppressWarnings(RUN(FEATURES, ADD_DELTA(measures, "green_roof"))))
 })
 
 test_that("Full connection to swales results in zero runoff", {
@@ -164,18 +170,18 @@ test_that("Full connection to swales results in zero runoff", {
     pvd  = c(0.3, 0.2, 0.1)
   )
   
-  check_result <- function(result) {
+  check_for_no_runoff <- function(result) {
     expect_true(all(result$runoff == 0))
   }
 
   measures <- list(green_roof = NA, unpaved = NA, to_swale = 0.3)
-  result <- RUN_NEW(blocks, measures, config = CONFIG)
-  check_result(result)
+  result <- RUN(blocks, measures, config = CONFIG)
+  check_for_no_runoff(result)
 
   # max. green_roof = mean(roof) = 0.1
   # max. unpaved = mean(1 - roof) = 0.9
   # correct max. to_swale
   m_max <- CORRECT_TO_SWALE_MAX(GET_MAX(blocks), blocks)
-  result <- RUN_NEW(blocks, m_max, config = CONFIG)
-  check_result(result)
+  result <- RUN(blocks, m_max, config = CONFIG)
+  check_for_no_runoff(result)
 })

From de8a9ce34679bd4bdd2a6e189c017c895b1c0b17 Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Mon, 3 Nov 2025 11:12:10 +0100
Subject: [PATCH 11/12] Rename correction factors

It is not about dry/wet summer but about
whether the information about precipitation and
evaporation in the summer months is available
or not available.
---
 R/actual_evaporation_waterbody_or_pervious.R  | 142 ++++++++----------
 ...rigation_in_dry_summer_correction_factor.R |  16 +-
 tests/testthat/test-function-is_dry_summer.R  |  17 ---
 tests/testthat/test-function-is_wet_summer.R  |  17 ---
 4 files changed, 68 insertions(+), 124 deletions(-)
 delete mode 100644 tests/testthat/test-function-is_dry_summer.R
 delete mode 100644 tests/testthat/test-function-is_wet_summer.R

diff --git a/R/actual_evaporation_waterbody_or_pervious.R b/R/actual_evaporation_waterbody_or_pervious.R
index 700b4b12..156e22c0 100644
--- a/R/actual_evaporation_waterbody_or_pervious.R
+++ b/R/actual_evaporation_waterbody_or_pervious.R
@@ -32,33 +32,33 @@ actual_evaporation_waterbody_or_pervious <- function(
   fetch_usage <- create_accessor(usage_tuple)
   fetch_climate <- create_accessor(climate)
   fetch_soil <- create_accessor(soil_properties)
-
+  
   rpot <- fetch_soil("mean_potential_capillary_rise_rate")
   epot_year <- fetch_climate("epot_yr")
-
+  
   # Check input(s)
   stopifnot(!anyNA(rpot))
-
+  
   # Initialise result vector
   y <- numeric(length(epot_year))
-
+  
   # For water bodies, use the potential evaporation
   land_types <- fetch_usage("land_type")
   is_waterbody <- land_type_is_waterbody(land_types)
-
+  
   y[is_waterbody] <- epot_year[is_waterbody]
-
+  
   # if all block areas are waterbodies, return
   if (all(is_waterbody)) {
     return(y)
   }
-
+  
   # indices of entries related to any other land_type
   i <- which(!is_waterbody)
-
+  
   # otherwise calculate the real evapotranspiration
   stopifnot(all(epot_year[i] > 0)) # ???
-
+  
   # determine the BAGROV parameter(s) for unsealed surfaces
   bagrov_values <- get_bagrov_parameter_unsealed(
     g02 = fetch_soil("g02")[i],
@@ -69,19 +69,19 @@ actual_evaporation_waterbody_or_pervious <- function(
     epot_summer = fetch_climate("epot_s")[i],
     mean_potential_capillary_rise_rate = rpot[i]
   )
-
+  
   if (!is.null(digits)) {
     bagrov_values <- cat_and_run(
       sprintf("Rounding BAGROV parameters to %d digits", digits),
       round(bagrov_values, digits)
     )
   }
-
+  
   available_water <-
     fetch_climate("prec_yr")[i] +
     rpot[i] +
     fetch_usage("irrigation")[i]
-
+  
   y[i] <- real_evapo_transpiration(
     potential_evaporation = epot_year[i],
     x_ratio = available_water / epot_year[i],
@@ -89,21 +89,25 @@ actual_evaporation_waterbody_or_pervious <- function(
     #, use_abimo_algorithm = TRUE
     , ...
   )
-
+  
   rises <- fetch_soil("potential_capillary_rise")
   depths <- fetch_soil("depth_to_water_table")
-
+  
   # indices of entries related to non-water land_type and capillary rises < 0
   j <- which(!is_waterbody & rises < 0)
-
+  
   y[j] <- y[j] + (epot_year[j] - y[j]) * exp(depths[j] / rises[j])
-
+  
   nas <- rep(NA_real_, length(y))
-
+  
   structure(y, bagrovUnsealed = data.frame(
     bagrov_eff = `[<-`(nas, i, bagrov_values),
-    factor_dry = `[<-`(nas, i, get_attribute(bagrov_values, "factor_dry")),
-    factor_wet = `[<-`(nas, i, get_attribute(bagrov_values, "factor_wet"))
+    correction_irrigation_and_unknown_summer = `[<-`(nas, i, get_attribute(
+      bagrov_values, "correction_irrigation_and_unknown_summer"
+    )),
+    correction_known_summer = `[<-`(nas, i, get_attribute(
+      bagrov_values, "correction_known_summer"
+    ))
   ))
 }
 
@@ -120,38 +124,38 @@ get_bagrov_parameter_unsealed <- function(
 {
   # Initialise result vector
   y <- numeric(length = length(g02))
-
+  
   is_forest <- land_type_is_forest(land_type)
   no_forest <- !is_forest
-
+  
   y[is_forest] <- lookup_bagrov_forest(g02[is_forest])
-
-  factor_dry <- ifelse(
-    test = irrigation > 0 & is_dry_summer(prec_summer, epot_summer),
-    yes = irrigation_in_dry_summer_correction_factor(irrigation[no_forest]),
+  
+  # It seems that in the original Abimo code, values of zero in the "summer" 
+  # columns were used to indicate "missing"
+  correction_irrigation_and_unknown_summer <- ifelse(
+    test = irrigation > 0 & (prec_summer <= 0 & epot_summer <= 0),
+    yes = irrigation_and_unknown_summer_correction(irrigation[no_forest]),
     no = 1
   )
-
+  
   y[no_forest] <- lookup_bagrov_unsealed(g02[no_forest], veg_class[no_forest]) *
-    factor_dry[no_forest]
-
-  # in case of a "wet" summer, correct the BAGROV parameter with a factor
-  factor_wet <- ifelse(
-    test = is_wet_summer(prec_summer, epot_summer),
-    yes = wet_summer_correction_factor(
-      water_availability =
-        prec_summer +
-        irrigation +
-        mean_potential_capillary_rise_rate,
+    correction_irrigation_and_unknown_summer[no_forest]
+  
+  # in case of known "summer" values for precipitation and evaporation, correct 
+  # the BAGROV parameter with a factor
+  correction_known_summer <- ifelse(
+    test = prec_summer > 0 & epot_summer > 0,
+    yes = summer_correction(
+      water_availability = prec_summer + irrigation + mean_potential_capillary_rise_rate,
       epot_summer = epot_summer
     ),
     no = 1
   )
-
+  
   structure(
-    y * factor_wet,
-    factor_dry = factor_dry,
-    factor_wet = factor_wet
+    y * correction_known_summer,
+    correction_irrigation_and_unknown_summer = correction_irrigation_and_unknown_summer,
+    correction_known_summer = correction_known_summer
   )
 }
 
@@ -159,14 +163,14 @@ get_bagrov_parameter_unsealed <- function(
 lookup_bagrov_forest <- function(g02)
 {
   n <- length(g02)
-
+  
   if (n == 0L) {
     return(numeric(0))
   }
-
+  
   breaks <- c(-Inf, 10.0, 25.0, Inf)
   values <- c(3.0,  4.0,  8.0)
-
+  
   index <- if (n > 1L) {
     findInterval(g02, breaks, left.open = TRUE)
   } else if (g02 <= breaks[2L]) {
@@ -176,7 +180,7 @@ lookup_bagrov_forest <- function(g02)
   } else {
     3L
   }
-
+  
   values[index]
 }
 
@@ -185,28 +189,28 @@ lookup_bagrov_unsealed <- function(g02, veg_class, do_correction = TRUE)
 {
   # Calculate the k index (integer)
   k <- veg_class_to_k_index(veg_class)
-
+  
   # Calculate result based on the k index
   y <-
     BAGROV_COEFFICIENTS[k] +
     BAGROV_COEFFICIENTS[k + 1L] * g02 +
     BAGROV_COEFFICIENTS[k + 2L] * g02^2
-
+  
   # Return y if no correction is required
   if (!do_correction) {
     return(y)
   }
-
+  
   # Apply correction where needed
   i <- which(
     (y >= 2.0 & veg_class < 60) |
       (g02 >= 20.0 & veg_class >= 60)
   )
-
+  
   y[i] <-
     BAGROV_COEFFICIENTS[k[i] - 2L] * g02[i] +
     BAGROV_COEFFICIENTS[k[i] - 1L]
-
+  
   y
 }
 
@@ -214,14 +218,14 @@ lookup_bagrov_unsealed <- function(g02, veg_class, do_correction = TRUE)
 veg_class_to_k_index <- function(veg_class)
 {
   k <- as.integer(ifelse(veg_class < 50, veg_class / 5, veg_class / 10 + 5))
-
+  
   # make sure that k is at least 1
   k <- pmax(1L, k)
-
+  
   # if k is at least 4, reduce it by one
   selected <- k >= 4L
   k[selected] <- k[selected] - 1L
-
+  
   5L * pmin(k, 13L) - 2L
 }
 
@@ -245,38 +249,22 @@ BAGROV_COEFFICIENTS <- c(
   0.33895,  3.721 , 6.69999, -0.07   , 0.013
 )
 
-# is_dry_summer ----------------------------------------------------------------
-# TODO: Remove redundancy with is_wet_summer.
-# Variables are (almost!) one another's opposite!
-is_dry_summer <- function(prec_summer, epot_summer)
-{
-  prec_summer <= 0 & epot_summer <= 0
-}
-
-# irrigation_in_dry_summer_correction_factor -----------------------------------
-irrigation_in_dry_summer_correction_factor <- function(irrigation)
+# irrigation_and_unknown_summer_correction -------------------------------------
+irrigation_and_unknown_summer_correction <- function(irrigation)
 {
   0.9985 + 0.00284 * irrigation - 0.00000379762 * irrigation^2
 }
 
-# is_wet_summer ----------------------------------------------------------------
-# TODO: Remove redundancy with is_dry_summer.
-# Variables are (almost!) one another's opposite!
-is_wet_summer <- function(prec_summer, epot_summer)
-{
-  prec_summer > 0 & epot_summer > 0
-}
-
-# wet_summer_correction_factor -------------------------------------------------
+# summer_correction ------------------------------------------------------------
 #' @importFrom stats approx
-wet_summer_correction_factor <- function(
+summer_correction <- function(
     water_availability, epot_summer, use_abimo_approx = TRUE
 )
 {
   xout <- water_availability / epot_summer
-  x <- WET_SUMMER_CORRECTION_MATRIX[, "water_availability"]
-  y <- WET_SUMMER_CORRECTION_MATRIX[, "correction_factor"]
-
+  x <- SUMMER_CORRECTION_MATRIX[, "water_availability"]
+  y <- SUMMER_CORRECTION_MATRIX[, "correction_factor"]
+  
   if (use_abimo_approx) {
     interpolate(x = x, y = y, xout = xout)
   } else {
@@ -284,8 +272,8 @@ wet_summer_correction_factor <- function(
   }
 }
 
-# WET_SUMMER_CORRECTION_MATRIX -------------------------------------------------
-WET_SUMMER_CORRECTION_MATRIX <- matrix(
+# SUMMER_CORRECTION_MATRIX -----------------------------------------------------
+SUMMER_CORRECTION_MATRIX <- matrix(
   ncol = 2L,
   byrow = TRUE,
   dimnames = list(
diff --git a/tests/testthat/test-function-irrigation_in_dry_summer_correction_factor.R b/tests/testthat/test-function-irrigation_in_dry_summer_correction_factor.R
index 6076bf52..325377a3 100644
--- a/tests/testthat/test-function-irrigation_in_dry_summer_correction_factor.R
+++ b/tests/testthat/test-function-irrigation_in_dry_summer_correction_factor.R
@@ -1,17 +1,7 @@
-#
-# This file was generated by kwb.test::create_test_files(), 
-# launched by hsonne on 2024-02-16 08:26:26.841162.
-# Please modify the dummy functions so that real cases are
-# tested. Then, delete this comment.
-#
+test_that("irrigation_and_unknown_summer_correction() works", {
 
-test_that("irrigation_in_dry_summer_correction_factor() works", {
+  f <- kwb.rabimo:::irrigation_and_unknown_summer_correction
 
-  f <- kwb.rabimo:::irrigation_in_dry_summer_correction_factor
-
-  expect_error(
-    f()
-    # Argument "irrigation" fehlt (ohne Standardwert)
-  )
+  expect_error(f())
 
 })
diff --git a/tests/testthat/test-function-is_dry_summer.R b/tests/testthat/test-function-is_dry_summer.R
deleted file mode 100644
index 23dfa765..00000000
--- a/tests/testthat/test-function-is_dry_summer.R
+++ /dev/null
@@ -1,17 +0,0 @@
-#
-# This file was generated by kwb.test::create_test_files(),
-# launched by hsonne on 2024-02-16 08:26:26.841162.
-# Please modify the dummy functions so that real cases are
-# tested. Then, delete this comment.
-#
-
-test_that("is_dry_summer() works", {
-
-  f <- kwb.rabimo:::is_dry_summer
-
-  expect_error(
-    f()
-    # Argument "prec_summer" fehlt (ohne Standardwert)
-  )
-
-})
diff --git a/tests/testthat/test-function-is_wet_summer.R b/tests/testthat/test-function-is_wet_summer.R
deleted file mode 100644
index cbd0e38d..00000000
--- a/tests/testthat/test-function-is_wet_summer.R
+++ /dev/null
@@ -1,17 +0,0 @@
-#
-# This file was generated by kwb.test::create_test_files(), 
-# launched by hsonne on 2024-02-16 08:26:26.841162.
-# Please modify the dummy functions so that real cases are
-# tested. Then, delete this comment.
-#
-
-test_that("is_wet_summer() works", {
-
-  f <- kwb.rabimo:::is_wet_summer
-
-  expect_error(
-    f()
-    # Argument "prec_summer" fehlt (ohne Standardwert)
-  )
-
-})

From e16b6259344bcdc0d0d797677be7c8c64d4ce7de Mon Sep 17 00:00:00 2001
From: hsonne <hauke.sonnenberg@kompetenz-wasser.de>
Date: Mon, 3 Nov 2025 13:37:36 +0100
Subject: [PATCH 12/12] Rename and repair test functions

---
 ...n-irrigation_and_unknown_summer_correction.R | 13 +++++++++++++
 ...irrigation_in_dry_summer_correction_factor.R |  7 -------
 .../testthat/test-function-summer_correction.R  | 15 +++++++++++++++
 ...test-function-wet_summer_correction_factor.R | 17 -----------------
 4 files changed, 28 insertions(+), 24 deletions(-)
 create mode 100644 tests/testthat/test-function-irrigation_and_unknown_summer_correction.R
 delete mode 100644 tests/testthat/test-function-irrigation_in_dry_summer_correction_factor.R
 create mode 100644 tests/testthat/test-function-summer_correction.R
 delete mode 100644 tests/testthat/test-function-wet_summer_correction_factor.R

diff --git a/tests/testthat/test-function-irrigation_and_unknown_summer_correction.R b/tests/testthat/test-function-irrigation_and_unknown_summer_correction.R
new file mode 100644
index 00000000..9e71c485
--- /dev/null
+++ b/tests/testthat/test-function-irrigation_and_unknown_summer_correction.R
@@ -0,0 +1,13 @@
+#library(testthat)
+test_that("irrigation_and_unknown_summer_correction() works", {
+
+  f <- kwb.rabimo:::irrigation_and_unknown_summer_correction
+
+  expect_error(f())
+
+  irrigation <- 1:1000
+  correction_factor <- f(irrigation)
+  
+  # We expect the maximum at 374, why?
+  expect_equal(irrigation[which.max(correction_factor)], 374)
+})
diff --git a/tests/testthat/test-function-irrigation_in_dry_summer_correction_factor.R b/tests/testthat/test-function-irrigation_in_dry_summer_correction_factor.R
deleted file mode 100644
index 325377a3..00000000
--- a/tests/testthat/test-function-irrigation_in_dry_summer_correction_factor.R
+++ /dev/null
@@ -1,7 +0,0 @@
-test_that("irrigation_and_unknown_summer_correction() works", {
-
-  f <- kwb.rabimo:::irrigation_and_unknown_summer_correction
-
-  expect_error(f())
-
-})
diff --git a/tests/testthat/test-function-summer_correction.R b/tests/testthat/test-function-summer_correction.R
new file mode 100644
index 00000000..f63c8f3a
--- /dev/null
+++ b/tests/testthat/test-function-summer_correction.R
@@ -0,0 +1,15 @@
+# library(testthat)
+test_that("summer_correction() works", {
+
+  f <- kwb.rabimo:::summer_correction
+
+  expect_error(f())
+
+  water_availability <- 1:1000
+  correction_factor <- f(water_availability, epot_summer = 1000)
+
+  #plot(water_availability, correction_factor)
+  
+  expect_true(all(correction_factor > 0.6))
+  expect_true(all(correction_factor < 1.6))
+})
diff --git a/tests/testthat/test-function-wet_summer_correction_factor.R b/tests/testthat/test-function-wet_summer_correction_factor.R
deleted file mode 100644
index 88302212..00000000
--- a/tests/testthat/test-function-wet_summer_correction_factor.R
+++ /dev/null
@@ -1,17 +0,0 @@
-#
-# This file was generated by kwb.test::create_test_files(), 
-# launched by hsonne on 2024-02-16 08:26:26.841162.
-# Please modify the dummy functions so that real cases are
-# tested. Then, delete this comment.
-#
-
-test_that("wet_summer_correction_factor() works", {
-
-  f <- kwb.rabimo:::wet_summer_correction_factor
-
-  expect_error(
-    f()
-    # Argument "water_availability" fehlt (ohne Standardwert)
-  )
-
-})