Merge pull request #1 from KWB-R/dev

Adaptations after comparing Abimo and R-Abimo results

Author: hsonne

R/getSoilProperties.R

@@ -112,7 +112,9 @@ getMeanPotentialCapillaryRiseRate <- function(
     ]
   )
 
-  as.integer(estimateDaysOfGrowth(usage, yieldPower) * kr)
+  days_of_growth <- estimateDaysOfGrowth(usage, yieldPower)
+
+  as.integer(round(days_of_growth * kr))
 }
 
 # MEAN_POTENTIAL_CAPILLARY_RISE_RATES_SUMMER_MATRIX ----------------------------
@@ -152,24 +154,20 @@ MEAN_POTENTIAL_CAPILLARY_RISE_RATES_SUMMER_MATRIX <- local({
 })
 
 # estimateDaysOfGrowth ---------------------------------------------------------
-estimateDaysOfGrowth <- function(usage, yield)
+estimateDaysOfGrowth <- function(usage, yield, default = 50)
 {
+  # Special case for agricultural use
   if (usage == "agricultural_L") {
     return(ifelse(yield <= 50, 60, 75))
   }
 
-  if (usage == "vegetationless_D") {
-    return(50)
-  }
-
-  if (usage == "horticultural_K") {
-    return(100)
-  }
-
-  if (usage == "forested_W") {
-    return(90)
-  }
+  # Constant estimates for other uses
+  days_of_growth <- list(
+    vegetationless_D = 50,
+    horticultural_K = 100,
+    forested_W = 90
+  )
 
-  # default value for any other case
-  50
+  # Lookup constant estimate. Return default if use is not in list
+  kwb.utils::defaultIfNULL(days_of_growth[[usage]], default)
 }

R/utils.R

@@ -47,9 +47,11 @@ filter_elements <- function(x, pattern)
 }
 
 # helpers_index ----------------------------------------------------------------
-helpers_index <- function(x, values)
+helpers_index <- function(x, values, epsilon = 0.0001)
 {
-  which.min(abs(x - values)) - 1L
+  indices <- which(x <= values + epsilon)
+
+  ifelse(length(indices), min(indices), length(values)) - 1L
 }
 
 # index_string_to_integers -----------------------------------------------------