Move get_measure_stats_new() into the package

and rename it to get_measure_stats()

Author: hsonne

NAMESPACE

@@ -9,6 +9,7 @@ export(data_to_natural)
 export(define_controls)
 export(distribute_measures)
 export(generate_rabimo_area)
+export(get_measure_stats)
 export(get_potential_evaporation)
 export(get_soil_properties)
 export(get_usage_tuple)

R/get_measure_stats.R

@@ -0,0 +1,68 @@
+# get_measure_stats ------------------------------------------------------------
+
+#' Get Mean/Max Statistics on Measures
+#'
+#' @param blocks data frame similar to \code{\link{rabimo_inputs_2020}$data},
+#'   with each row representing a block area
+#' @param reference_system indicator for the "reference system" in which the
+#'   returned values are to be given. 1: all values refer to percentages of
+#'   specific areas (green roof: roof area, unsealed: total area, to_swale:
+#'   sealed area); 2: all values refer to percentages of the total area. The
+#'   default is 2.
+#' @returns list with elements "mean" and "max" each of which is a list with one
+#'   element per measure
+#' @importFrom kwb.utils createAccessor
+#' @export
+get_measure_stats <- function(blocks, reference_system = 2)
+{
+  stopifnot(reference_system %in% 1:2)
+
+  refer_to_total <- reference_system == 2
+
+  #blocks <- kwb.rabimo::rabimo_inputs_2020$data
+  get <- kwb.utils::createAccessor(blocks)
+
+  total_areas <- get("total_area")
+  roofs <- get("roof")
+  pvds <- get("pvd")
+
+  area_total <- sum(total_areas)
+  area_roof <- sum(total_areas * roofs)
+  area_green_roof <- sum(total_areas * roofs * get("green_roof"))
+  area_pvd <- sum(total_areas * pvds)
+  area_unpvd <- sum(total_areas * (1 - roofs - pvds))
+  area_sca <- sum(total_areas * (roofs + pvds) * get("to_swale"))
+  area_sealed <- area_roof + area_pvd
+
+  mean_roof <- area_roof / area_total
+  mean_pvd <- area_pvd / area_total
+
+  mean_green_roof <- if (refer_to_total) {
+    area_green_roof / area_total
+  } else {
+    area_green_roof / area_roof
+  }
+
+  mean_unpvd <- area_unpvd / area_total
+
+  mean_sca <- if (refer_to_total) {
+    area_sca / area_total
+  } else {
+    area_sca / area_sealed
+  }
+
+  max_green_roof <- if (refer_to_total) mean_roof else 1
+  max_unpvd <- 1 - mean_roof
+  max_sca <- if (refer_to_total) {
+    1 - mean_unpvd
+  } else {
+    1
+  }
+
+  list(
+    green_roof = c(mean = mean_green_roof, max = max_green_roof),
+    unpaved = c(mean = mean_unpvd, max = max_unpvd),
+    to_swale = c(mean = mean_sca, max = max_sca)
+  )
+}
+

inst/scripts/distribute-measures.R

@@ -78,14 +78,16 @@ if (FALSE)
 # Working with targets in the "new" reference system ---------------------------
 if (FALSE)
 {
-  # Statistics on measure implementation in new reference system (share of total
-  # area)
-  get_measure_stats_new(blocks)
+  # Statistics on measures in new reference system (shares of total area)
+  kwb.rabimo::get_measure_stats(blocks, reference_system = 2)
 
-  # Convert new targets (all percentages referring to total area) to targets
-  # that are expected by distribute_measures()
+  # Define targets in new reference system (all shares referring to total area)
   new_targets <- list(green_roof = 0.259, unpaved = 0.5, to_swale = 0.67)
 
+  # Convert targets in new reference system to targets in old reference system
+  # that is expected by distribute_measures(). In the old system, the shares
+  # relate to areas that are specific to the measure (e.g. green_roof is related
+  # to the area of roofs, to swale is related to the area of sealed surfaces).
   targets <- rescale_target_values(
     new_targets,
     total_area = sum(kwb.rabimo:::get_main_area(blocks)),
@@ -358,78 +360,6 @@ rescale_target_values <- function(
   list(green_roof = green_roof, unpaved = unpaved, to_swale = to_swale)
 }
 
-# get_measure_stats_new --------------------------------------------------------
-get_measure_stats_new <- function(blocks, refer_to_total = TRUE)
-{
-  #blocks <- kwb.rabimo::rabimo_inputs_2020$data
-  get <- kwb.utils::createAccessor(blocks)
-
-  total_areas <- get("total_area")
-  roofs <- get("roof")
-  pvds <- get("pvd")
-
-  area_total <- sum(total_areas)
-  area_roof <- sum(total_areas * roofs)
-  area_green_roof <- sum(total_areas * roofs * get("green_roof"))
-  area_pvd <- sum(total_areas * pvds)
-  area_unpvd <- sum(total_areas * (1 - roofs - pvds))
-  area_sca <- sum(total_areas * (roofs + pvds) * get("to_swale"))
-  area_sealed <- area_roof + area_pvd
-
-  mean_roof <- area_roof / area_total
-  mean_pvd <- area_pvd / area_total
-
-  mean_green_roof <- if (refer_to_total) {
-    area_green_roof / area_total
-  } else {
-    area_green_roof / area_roof
-  }
-
-  mean_unpvd <- area_unpvd / area_total
-
-  mean_sca <- if (refer_to_total) {
-    area_sca / area_total
-  } else {
-    area_sca / area_sealed
-  }
-
-  max_green_roof <- if (refer_to_total) mean_roof else 1
-  max_unpvd <- 1 - mean_roof
-  max_sca <- if (refer_to_total) {
-    1 - mean_unpvd
-  } else {
-    1
-  }
-
-  # area_total <- sum(kwb.rabimo:::get_main_area(blocks))
-  # area_green_roof <- sum(kwb.rabimo:::get_green_roof_area(blocks))
-  # area_roof <- sum(kwb.rabimo:::get_roof_area(blocks))
-  # area_unpvd <- sum(kwb.rabimo:::get_unpaved_area(blocks))
-  # area_pvd <- sum(kwb.rabimo:::get_paved_area(blocks))
-  # area_sca <- sum(kwb.rabimo:::get_to_swale_area(blocks))
-  # area_sealed <- sum(kwb.rabimo:::get_sealed_area(blocks))
-  #
-  # mean_green_roof <- area_green_roof / area_total
-  # max_green_roof <- area_roof / area_total
-  # mean_unpvd <- area_unpvd / area_total
-  # max_unpvd <- area_pvd / area_total
-  # mean_sca <- area_sca / area_total
-  # max_sca <- area_sealed / area_total
-
-  cbind(
-    mean = c(
-      green_roof = mean_green_roof,
-      unpaved = mean_unpvd,
-      to_swale = mean_sca
-    ),
-    max = c(
-      green_roof = max_green_roof,
-      unpaved = max_unpvd,
-      to_swale = max_sca
-    )
-  )
-}
-
 # check_distribution -----------------------------------------------------------
 check_distribution <- function(
     green_roof_table,

inst/scripts/plumber.R

@@ -86,8 +86,6 @@ function(req, n_records = 3L, seed = as.integer(Sys.time()), output_only = TRUE)
 #* @post data_to_natural
 function(data_json, type = "undeveloped")
 {
-  data <-
-
   data <- kwb.rabimo:::check_or_convert_data_types(
     data = jsonlite::fromJSON(data_json),
     types = kwb.rabimo:::get_expected_data_type(),
@@ -130,3 +128,15 @@ function()
 
   config
 }
+
+# /get_measure_stats -----------------------------------------------------------
+
+#* Statistics (mean, max) on measures within selected blocks
+#* @param blocks_json Selected blocks
+#* @param reference_system "Reference system" (1:old, 2:new = percentages of total area)
+#* @post get_measure_stats
+function(req, blocks_json, reference_system = 2)
+{
+  blocks <- jsonlite::fromJSON(blocks_json)
+  kwb.rabimo::get_measure_stats(blocks, reference_system)
+}