Merge pull request #3 from AgroCares/BLN-3

BLN_3

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: BLN
 Type: Package
 Title: Calculate the Soil Quality Assessment Score using the Dutch BLN framework
-Version: 0.3.0
+Version: 0.4.0
 Authors@R: c(
     person("Gerard", "Ros", email = "[email protected]", role = c("aut","cre")),
     person("Sven", "Verweij", email = "[email protected]", role = "aut"),

NAMESPACE

@@ -25,6 +25,7 @@ export(bln_evaluate_parabolic)
 export(bln_field)
 export(bln_field_optimiser)
 export(bln_format_aer)
+export(bln_format_gtclass)
 export(bln_nut_nitrogen)
 export(bln_nut_nue)
 export(bln_nut_phosphorus)

NEWS.md

@@ -1,3 +1,9 @@
+# BLN 0.4.0 2024-12-24
+
+## Added
+* function `bln_format_gtclass` for creating classes of ground water table data, based on GHG and GLG
+* test function `test-bln_format_gtclass` of the function described above
+
 # BLN 0.3.0 2024-12-23
 
 ## Added

R/bln_format_gtclass.R

@@ -0,0 +1,68 @@
+#' Determine groundwater table class based on highest and lowest mean groundwater levels
+#'
+#' @param B_GWL_GHG (numeric) The average highest groundwater level in cm below field level (Gemiddeld Hoogste Grondwaterstand)
+#' @param B_GWL_GLG (numeric) The average lowest groundwater level in cm below field level (Gemiddeld Laagste Grondwaterstand)
+#'
+#' @import data.table
+#'
+#' @examples
+#' bln_format_gtclass(B_GWL_GHG = 35, B_GWL_GLG = 55)
+#' bln_format_gtclass(B_GWL_GHG = 70, B_GWL_GLG = 155)
+#'
+#' @return
+#' A standardized B_GWL_CLASS value as required for BLN functions. A character string.
+#'
+#' @export
+bln_format_gtclass <- function(B_GWL_GHG, B_GWL_GLG) {
+
+  # Add visual bindings
+  B_GWL_CLASS = NULL
+
+  # Check arguments
+  arg.length <- max(length(B_GWL_GLG), length(B_GWL_GHG))
+  checkmate::assert_numeric(B_GWL_GLG, lower = 0, any.missing = FALSE, len = arg.length)
+  checkmate::assert_numeric(B_GWL_GHG, lower = 0, any.missing = FALSE, len = arg.length)
+  checkmate::assert_true(all(B_GWL_GHG < B_GWL_GLG))
+
+  # Make internal table
+  dt <- data.table(B_GWL_GHG = B_GWL_GHG, B_GWL_GLG = B_GWL_GLG)
+
+  # Classification is based on the article:
+  # Knotters, M., Walvoort., D., Brouwer, .F, Stuyt, L., Okx, J. (2018). Landsdekkende, actuele informatie
+  # over grondwatertrappen digitaal beschikbaar. KNW, Den Haag.
+
+  # GW classes range from I to VIII, with 'a' and 'b' as a sub categorization.
+  dt[, B_GWL_CLASS := '-']
+
+  # set Gt class for wet soils (I-II-III)
+  dt[B_GWL_GHG < 40 & B_GWL_GLG < 50, B_GWL_CLASS := 'I']
+  dt[B_GWL_GHG < 25 & B_GWL_GLG >= 50 & B_GWL_GLG < 80, B_GWL_CLASS := 'II']
+  dt[B_GWL_GHG >= 25 & B_GWL_GHG <= 40 & B_GWL_GLG >= 50 & B_GWL_GLG < 80, B_GWL_CLASS := 'IIb']
+  dt[B_GWL_GHG > 40 & B_GWL_GLG >= 50 & B_GWL_GLG < 80, B_GWL_CLASS := 'IIb'] # IIc originally
+  dt[B_GWL_GHG < 40 & B_GWL_GLG >= 80 & B_GWL_GLG < 120, B_GWL_CLASS := 'III']
+  dt[B_GWL_GHG < 25 & B_GWL_GLG >= 80 & B_GWL_GLG < 120, B_GWL_CLASS := 'IIIa']
+  dt[B_GWL_GHG >= 25 & B_GWL_GHG < 40 & B_GWL_GLG >= 80 & B_GWL_GLG < 120, B_GWL_CLASS := 'IIIb']
+
+  # set Gt class for intermediate soils (IV-V-VI)
+  dt[B_GWL_GHG >= 40 & B_GWL_GLG >= 80 & B_GWL_GLG < 120, B_GWL_CLASS := 'IV']
+  dt[B_GWL_GHG < 40 & B_GWL_GLG >= 120, B_GWL_CLASS := 'V']
+  dt[B_GWL_GHG < 25 & B_GWL_GLG >= 120, B_GWL_CLASS := 'Va']
+  dt[B_GWL_GHG >= 25 & B_GWL_GHG < 40 & B_GWL_GLG >= 120, B_GWL_CLASS := 'Vb']
+  dt[B_GWL_GHG >= 40 & B_GWL_GHG < 80 & B_GWL_GLG >= 120, B_GWL_CLASS := 'VI']
+
+  # set Gt class for dry soils (VII-VIII)
+  dt[B_GWL_GHG >= 80 & B_GWL_GHG < 140 & B_GWL_GLG >= 120, B_GWL_CLASS := 'VII']
+  dt[B_GWL_GHG >= 140 & B_GWL_GLG >= 120, B_GWL_CLASS := 'VIII']
+
+  # overwrite "-" when its clear dry soils
+  dt[B_GWL_GHG >= 140 & B_GWL_CLASS == '-', B_GWL_CLASS := 'VIII']
+  dt[B_GWL_GHG >= 80 & B_GWL_GHG < 140 & B_GWL_CLASS == '-', B_GWL_CLASS := 'VII']
+  dt[B_GWL_GLG <= 50 & B_GWL_CLASS == '-', B_GWL_CLASS := 'I']
+
+  # select GT class
+  value = dt[, B_GWL_CLASS]
+
+  # return value
+  return(value)
+
+}

tests/testthat/test-bln_format_gtclass.R

@@ -0,0 +1,11 @@
+test_that("bln_format_gtclass works", {
+
+  expect_equal(
+    bln_format_gtclass(
+      B_GWL_GHG = c(5, 16, 135, 34, 41, 98),
+      B_GWL_GLG = c(41, 60, 157, 156, 55, 135)
+    ),
+    expected = c("I", "II", "VII", "Vb", "IIb", "VII"),
+    tolerance = 0
+  )
+})