Merge pull request #16 from AgroCares/hotfix/v4.0.1

Hotfix/v4.0.1

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: BBWPC
 Type: Package
 Title: Calculator for BedrijfsBodemWaterPlan (BBWP)
-Version: 0.4.0
+Version: 0.4.1
 Authors@R: c(
     person("Gerard", "Ros", email = "[email protected]", role = c("aut","cre")),
     person("Sven", "Verweij", email = "[email protected]", role = c("aut")),

NEWS.md

@@ -1,5 +1,18 @@
 # Changelog BBWPC
 
+## 0.4.1
+
+### Added
+- B_SLOPE and B_SLOPE_DEGREE as input in wrapper function `bbwp`
+
+### Changed
+- change output of `er_meas_rank` from `top.x` to `top_er_x` with x being the targets
+- change output of `bbwp_meas_rank` from `top.x` to `top_bbwp_x` with x being the targets
+- replace `x_meas_rank` to inside the if-function in wrapper funs to speed up the code
+- change output scores of `bbwp_field_score` and input for `bbwp_farm_score` from `D_OPI_x` to `S_BBWP_x`
+- change output scores of `er_field_score` and input for `er_farm_score` from `D_OPI_x` to `S_ER_x`
+- change B_SLOPE to B_SLOPE_DEGREE in all functions
+
 ## 0.4.0
 ### Added
 - add wrapper function `bbwp` to run BBWP for a series of fields

R/bbwp_farm_score.R

@@ -2,47 +2,47 @@
 #'
 #' Estimate the potential to contribute to agronomic and environmental challenges in a region for a farm
 #'
-#' @param D_OPI_TOT (numeric) the score for the integrative opportunity index (risk times impact) for each field
-#' @param D_OPI_NGW (numeric) the scoring index for lowering N emission to ground water (risk times impact) for each field
-#' @param D_OPI_NSW (numeric) the scoring index for lowering N emission to surface water (risk times impact) for each field
-#' @param D_OPI_PSW (numeric) the scoring index for lowering P emission to surface water (risk times impact) for each field
-#' @param D_OPI_NUE (numeric) the scoring index to use N and P inputs efficiently for each field
-#' @param D_OPI_WB (numeric) the scoring index to buffer and store water and efficiently use water for plant growth for each field
+#' @param S_BBWP_TOT (numeric) the score for the integrative opportunity index (risk times impact) for each field
+#' @param S_BBWP_NGW (numeric) the scoring index for lowering N emission to ground water (risk times impact) for each field
+#' @param S_BBWP_NSW (numeric) the scoring index for lowering N emission to surface water (risk times impact) for each field
+#' @param S_BBWP_PSW (numeric) the scoring index for lowering P emission to surface water (risk times impact) for each field
+#' @param S_BBWP_NUE (numeric) the scoring index to use N and P inputs efficiently for each field
+#' @param S_BBWP_WB (numeric) the scoring index to buffer and store water and efficiently use water for plant growth for each field
 #' @param D_AREA (numeric) the area of the field (\ m2 or \ ha) 
 #'   
 #' @import data.table
 #'
 #' @export
 # calculate the opportunities for a set of fields
-bbwp_farm_score <- function(D_OPI_TOT,D_OPI_NGW,D_OPI_NSW,D_OPI_PSW,D_OPI_NUE,D_OPI_WB, D_AREA){
+bbwp_farm_score <- function(S_BBWP_TOT,S_BBWP_NGW,S_BBWP_NSW,S_BBWP_PSW,S_BBWP_NUE,S_BBWP_WB, D_AREA){
 
   # check length of the inputs
-  arg.length <- max(length(D_OPI_TOT),length(D_OPI_NGW),length(D_OPI_NSW),length(D_OPI_PSW),
-                    length(D_OPI_NUE),length(D_OPI_WB),length(D_AREA))
+  arg.length <- max(length(S_BBWP_TOT),length(S_BBWP_NGW),length(S_BBWP_NSW),length(S_BBWP_PSW),
+                    length(S_BBWP_NUE),length(S_BBWP_WB),length(D_AREA))
 
   # check inputs
-  checkmate::assert_numeric(D_OPI_TOT, lower = 0, upper = 100, len = arg.length)
-  checkmate::assert_numeric(D_OPI_NGW, lower = 0, upper = 100, len = arg.length)
-  checkmate::assert_numeric(D_OPI_NSW, lower = 0, upper = 100, len = arg.length)
-  checkmate::assert_numeric(D_OPI_PSW, lower = 0, upper = 100, len = arg.length)
-  checkmate::assert_numeric(D_OPI_NUE, lower = 0, upper = 100, len = arg.length)
-  checkmate::assert_numeric(D_OPI_WB, lower = 0, upper = 100, len = arg.length)
+  checkmate::assert_numeric(S_BBWP_TOT, lower = 0, upper = 100, len = arg.length)
+  checkmate::assert_numeric(S_BBWP_NGW, lower = 0, upper = 100, len = arg.length)
+  checkmate::assert_numeric(S_BBWP_NSW, lower = 0, upper = 100, len = arg.length)
+  checkmate::assert_numeric(S_BBWP_PSW, lower = 0, upper = 100, len = arg.length)
+  checkmate::assert_numeric(S_BBWP_NUE, lower = 0, upper = 100, len = arg.length)
+  checkmate::assert_numeric(S_BBWP_WB, lower = 0, upper = 100, len = arg.length)
   checkmate::assert_numeric(D_AREA, lower = 0, upper = 50000, len = arg.length)
 
   # collect data in one data.table
   dt <- data.table(
     id = 1:arg.length,
-    D_OPI_NGW = D_OPI_NGW,
-    D_OPI_NSW = D_OPI_NSW,
-    D_OPI_PSW = D_OPI_PSW,
-    D_OPI_NUE = D_OPI_NUE,
-    D_OPI_WB = D_OPI_WB,
-    D_OPI_TOT = D_OPI_TOT,
+    S_BBWP_NGW = S_BBWP_NGW,
+    S_BBWP_NSW = S_BBWP_NSW,
+    S_BBWP_PSW = S_BBWP_PSW,
+    S_BBWP_NUE = S_BBWP_NUE,
+    S_BBWP_WB = S_BBWP_WB,
+    S_BBWP_TOT = S_BBWP_TOT,
     D_AREA = D_AREA
   )
 
   # columns with the score of the opportunity indexes
-  cols <- c('D_OPI_TOT','D_OPI_NGW','D_OPI_NSW','D_OPI_PSW','D_OPI_NUE','D_OPI_WB')
+  cols <- c('S_BBWP_TOT','S_BBWP_NGW','S_BBWP_NSW','S_BBWP_PSW','S_BBWP_NUE','S_BBWP_WB')
 
   # calculate area weigthed sum of the field indices
   dt <- dt[,lapply(.SD, stats::weighted.mean, w = D_AREA), .SDcols = cols]

R/bbwp_field_properties.R

@@ -3,12 +3,12 @@
 #' Estimate the relative ranking of field properties given their contribution to nutrient losses to aquatic ecosystems as well as nutrient and water efficiency.
 #' A high rank is indicative for the number of opportunities to improve soil quality and land use.
 #'
-#' @param B_SOILTYPE_AGR (character) The type of soil
+#' @param B_SOILTYPE_AGR (character) The type of soil, using agronomic classification
 #' @param B_LU_BRP (numeric) The crop type (conform BRP coding, preferable the most frequent crop on the field)
 #' @param B_GWL_CLASS (character) The groundwater table class
 #' @param B_SC_WENR (character) The risk for subsoil compaction as derived from risk assessment study of Van den Akker (2006)
 #' @param B_HELP_WENR (character) The soil type abbreviation, derived from 1:50.000 soil map
-#' @param B_SLOPE (numeric) The slope of the field (degrees)
+#' @param B_SLOPE_DEGREE (numeric) The slope of the field (degrees)
 #' @param A_CLAY_MI (numeric) The clay content of the soil (\%)
 #' @param A_SAND_MI (numeric) The sand content of the soil (\%)
 #' @param A_SILT_MI (numeric) The silt content of the soil (\%)
@@ -18,7 +18,7 @@
 #' @param A_AL_OX (numeric) The iron content of soil (mmol+ / kg)
 #' @param A_P_CC (numeric) The plant available P content, measured via 0.01M CaCl2 extraction (mg / kg)
 #' @param A_P_AL (numeric) The plant extractable P content, measured via ammonium lactate extraction (mg / kg)
-#' @param A_P_WA (numeric) The P-content of the soil extracted with water
+#' @param A_P_WA (numeric) The P-content of the soil extracted with water (mg P2O5 / L)
 #' @param A_P_SG (numeric) The P-saturation index (\%)
 #' @param D_WP (numeric) The fraction of the parcel that is surrounded by surface water
 #' @param D_RO_R (numeric) The risk that surface water runs off the parcel
@@ -28,7 +28,7 @@
 #' @import OBIC
 #'
 #' @export
-bbwp_field_properties <- function(B_SOILTYPE_AGR, B_LU_BRP, B_GWL_CLASS, B_SC_WENR, B_HELP_WENR,B_SLOPE,
+bbwp_field_properties <- function(B_SOILTYPE_AGR, B_LU_BRP, B_GWL_CLASS, B_SC_WENR, B_HELP_WENR,B_SLOPE_DEGREE,
                                   A_CLAY_MI, A_SAND_MI, A_SILT_MI, A_SOM_LOI, A_N_RT,
                                   A_FE_OX, A_AL_OX, A_P_CC, A_P_AL, A_P_WA, A_P_SG,
                                   D_WP, D_RO_R, LSW) {
@@ -46,7 +46,7 @@ bbwp_field_properties <- function(B_SOILTYPE_AGR, B_LU_BRP, B_GWL_CLASS, B_SC_WE
   # check length inputs
   arg.length <- max(
     length(B_SOILTYPE_AGR), length(B_LU_BRP), length(B_GWL_CLASS), length(B_SC_WENR), length(B_HELP_WENR),
-    length(A_CLAY_MI), length(A_SAND_MI), length(A_SILT_MI), length(A_SOM_LOI), length(A_N_RT),
+    length(A_CLAY_MI), length(A_SAND_MI), length(A_SILT_MI), length(A_SOM_LOI), length(A_N_RT), length(B_SLOPE_DEGREE),
     length(A_FE_OX), length(A_AL_OX), length(A_P_CC), length(A_P_AL),length(A_P_WA), length(A_P_SG),
     length(D_WP), length(D_RO_R)
   )
@@ -56,6 +56,7 @@ bbwp_field_properties <- function(B_SOILTYPE_AGR, B_LU_BRP, B_GWL_CLASS, B_SC_WE
   checkmate::assert_subset(B_GWL_CLASS, choices = c('-', 'GtI','GtII','GtIIb','GtIII','GtIIIb','GtIV','GtV','GtVb','GtVI','GtVII','GtVIII'))
   checkmate::assert_subset(B_SC_WENR, choices = c(3, 4, 1, 401, 902, 2, 901, 5, 11, 10))
   checkmate::assert_subset(B_HELP_WENR, choices = c(unique(OBIC::waterstress.obic$soilunit), "unknown"), empty.ok = FALSE)
+  checkmate::assert_numeric(B_SLOPE_DEGREE, lower = 0, upper = 30, any.missing = FALSE, len = arg.length)
 
   # check inputs A parameters
   checkmate::assert_numeric(A_CLAY_MI, lower = 0, upper = 100, any.missing = FALSE,len = arg.length)
@@ -92,7 +93,7 @@ bbwp_field_properties <- function(B_SOILTYPE_AGR, B_LU_BRP, B_GWL_CLASS, B_SC_WE
     B_GWL_CLASS = B_GWL_CLASS,
     B_SC_WENR = B_SC_WENR, 
     B_HELP_WENR = B_HELP_WENR,
-    B_SLOPE = B_SLOPE,
+    B_SLOPE_DEGREE = B_SLOPE_DEGREE,
     A_CLAY_MI = A_CLAY_MI,
     A_SAND_MI = A_SAND_MI,
     A_SILT_MI = A_SILT_MI,
@@ -165,7 +166,7 @@ bbwp_field_properties <- function(B_SOILTYPE_AGR, B_LU_BRP, B_GWL_CLASS, B_SC_WE
 
   # classify fields with a high slope as extra vulnerable for surface runoff
   # with fields with slope > 2% being vulnerabile (Groenendijk, 2020)
-  dt[,nsw_slope := pmax(0.2,pmin(1,B_SLOPE/2))]
+  dt[,nsw_slope := pmax(0.2,pmin(1,B_SLOPE_DEGREE/2))]
 
   # rank the risk for wet surroundings (Van Gerven, 2018)
   # higher risk is associated to increased risks for N runoff

R/bbwp_field_scores.R

@@ -6,7 +6,7 @@
 #' @param B_GWL_CLASS (character) The groundwater table class
 #' @param M_DRAIN (boolean) is there tube drainage present in the field
 #' @param A_P_SG (numeric) 
-#' @param B_SLOPE (boolean)
+#' @param B_SLOPE_DEGREE (numeric) The slope of the field (degrees)
 #' @param B_LU_BRP (integer)
 #' @param B_LU_BBWP (numeric) The BBWP category used for allocation of measures to BBWP crop categories
 #' @param D_WP (numeric) The fraction of the parcel that is surrounded by surface water
@@ -29,7 +29,7 @@
 #'
 #' @export
 # calculate the opportunities for a set of fields
-bbwp_field_scores <- function(B_SOILTYPE_AGR, B_GWL_CLASS, A_P_SG, B_SLOPE, B_LU_BRP, B_LU_BBWP,
+bbwp_field_scores <- function(B_SOILTYPE_AGR, B_GWL_CLASS, A_P_SG, B_SLOPE_DEGREE, B_LU_BRP, B_LU_BBWP,
                               M_DRAIN, D_WP, D_RISK_NGW, D_RISK_NSW, D_RISK_PSW, D_RISK_NUE, D_RISK_WB,
                               B_GWP, B_AREA_DROUGHT, B_CT_PSW, B_CT_NSW, 
                               B_CT_PSW_MAX = 0.5, B_CT_NSW_MAX = 5.0, measures, sector){
@@ -41,7 +41,7 @@ bbwp_field_scores <- function(B_SOILTYPE_AGR, B_GWL_CLASS, A_P_SG, B_SLOPE, B_LU
 
   # check length of the inputs
   arg.length <- max(length(B_SOILTYPE_AGR),length(B_GWL_CLASS), length(A_P_SG),
-                    length(B_SLOPE), length(B_LU_BRP), length(B_LU_BBWP),length(M_DRAIN),length(D_WP),
+                    length(B_SLOPE_DEGREE), length(B_LU_BRP), length(B_LU_BBWP),length(M_DRAIN),length(D_WP),
                     length(D_RISK_NGW),length(D_RISK_NSW),length(D_RISK_PSW),length(D_RISK_NUE),
                     length(D_RISK_WB),length(B_GWP),length(B_AREA_DROUGHT),length(B_CT_PSW),
                     length(B_CT_NSW))
@@ -50,7 +50,7 @@ bbwp_field_scores <- function(B_SOILTYPE_AGR, B_GWL_CLASS, A_P_SG, B_SLOPE, B_LU
   checkmate::assert_subset(B_SOILTYPE_AGR, choices = c('duinzand','dekzand','zeeklei','rivierklei','maasklei',
                                                        'dalgrond','moerige_klei','veen','loess'))
   checkmate::assert_numeric(A_P_SG, lower = 0, upper = 120, len = arg.length)
-  checkmate::assert_numeric(B_SLOPE, len = arg.length)
+  checkmate::assert_numeric(B_SLOPE_DEGREE, lower = 0, upper = 30,len = arg.length)
   checkmate::assert_integerish(B_LU_BRP, lower = 0, len = arg.length)
   checkmate::assert_integerish(B_LU_BBWP, lower = 0, upper = 9,len = arg.length)
   checkmate::assert_logical(M_DRAIN,len = arg.length)
@@ -73,7 +73,7 @@ bbwp_field_scores <- function(B_SOILTYPE_AGR, B_GWL_CLASS, A_P_SG, B_SLOPE, B_LU
                     B_SOILTYPE_AGR = B_SOILTYPE_AGR,
                     B_GWL_CLASS = B_GWL_CLASS,
                     A_P_SG = A_P_SG,
-                    B_SLOPE = B_SLOPE,
+                    B_SLOPE_DEGREE = B_SLOPE_DEGREE,
                     B_LU_BRP = B_LU_BRP,
                     B_LU_BBWP = B_LU_BBWP,
                     M_DRAIN = M_DRAIN,
@@ -133,7 +133,7 @@ bbwp_field_scores <- function(B_SOILTYPE_AGR, B_GWL_CLASS, A_P_SG, B_SLOPE, B_LU
                                         B_LU_BBWP = dt$B_LU_BBWP,
                                         B_GWL_CLASS = dt$B_GWL_CLASS,
                                         A_P_SG = dt$A_P_SG,
-                                        B_SLOPE = dt$B_SLOPE,
+                                        B_SLOPE_DEGREE = dt$B_SLOPE_DEGREE,
                                         M_DRAIN = dt$M_DRAIN,
                                         D_WP = dt$D_WP,
                                         D_OPI_NGW = dt$D_OPI_NGW,
@@ -181,8 +181,12 @@ bbwp_field_scores <- function(B_SOILTYPE_AGR, B_GWL_CLASS, A_P_SG, B_SLOPE, B_LU
   # order the fields
   setorder(dt, id)
 
+  # rename the opportunity indexes to the final score
+  setnames(dt,c('D_OPI_NGW','D_OPI_NSW','D_OPI_PSW','D_OPI_NUE','D_OPI_WB','D_OPI_TOT'),
+           c('S_BBWP_NGW','S_BBWP_NSW','S_BBWP_PSW','S_BBWP_NUE','S_BBWP_WB','S_BBWP_TOT'))
+
   # extract value
-  value <- dt[,mget(c('D_OPI_NGW','D_OPI_NSW','D_OPI_PSW','D_OPI_NUE','D_OPI_WB','D_OPI_TOT'))]
+  value <- dt[,mget(c('S_BBWP_NGW','S_BBWP_NSW','S_BBWP_PSW','S_BBWP_NUE','S_BBWP_WB','S_BBWP_TOT'))]
 
   # Round the values
   value <- value[, lapply(.SD, round, digits = 0)]