Proposal of some updates to read_habitatmap_xxx()

NAMESPACE

@@ -57,6 +57,7 @@ importFrom(dplyr,mutate_if)
 importFrom(dplyr,n)
 importFrom(dplyr,pull)
 importFrom(dplyr,recode)
+importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
 importFrom(dplyr,select)
 importFrom(dplyr,starts_with)

R/read_habitatdata.R

@@ -15,9 +15,9 @@
 #' The data source \code{habitatmap_stdized} is the processed version
 #' of the raw data source \code{habitatmap} (De Saeger et al., 2020).
 #' Every polygon in the \code{habitatmap} can consist of maximum 5
-#' different vegetation types. This information is stored in the
+#' different types. This information is stored in the
 #' columns 'HAB1', HAB2',..., 'HAB5' of the attribute table. The
-#' fraction of each vegetation type within the polygons is stored in
+#' fraction of each type within the polygons is stored in
 #' the columns 'PHAB1', 'PHAB2', ..., 'PHAB5'.
 #'
 #' The data source \code{habitatmap_stdized} is a GeoPackage, available at
@@ -33,17 +33,38 @@
 #' The processing of the \code{habitatmap_types} tibble included
 #' following steps:
 #' \itemize{
-#'   \item For some polygons the vegetation type is uncertain, and the
-#'   vegetation code in the raw \code{habitatmap} data source consists
+#'   \item For some polygons the type is uncertain, and the
+#'   type code in the raw \code{habitatmap} data source consists
 #'   of 2 or 3 possible types, separated with a ','. The different
-#'   possible vegetation types are split up and one row is created for
-#'   each of them. The variable \code{certain} will be \code{FALSE} if
-#'   the original code consists of 2 or 3 possible vegetation types, and \code{TRUE}
-#'   if only one vegetation type is provided.
-#'   \item For some polygons the original vegetation code in the
+#'   possible types are split up and one row is created for
+#'   each of them, with \code{phab} for each new row simply set to the original
+#'   value of \code{phab}.
+#'   The variable \code{certain} will be \code{FALSE} if
+#'   the original code consists of 2 or 3 possible types, and \code{TRUE}
+#'   if only one type is provided.
+#'   \item Some polygons contain both a standing water habitat type
+#'   and \code{rbbmr}:
+#'   \code{3130_rbbmr},
+#'   \code{3140_rbbmr},
+#'   \code{3150_rbbmr} and
+#'   \code{3160_rbbmr}.
+#'   Since \code{habitatmap_stdized_2020_v1}, the two
+#'   types \code{31xx} and \code{rbbmr} are split up and one row is
+#'   created for each of them, with \code{phab} for each new row simply
+#'   set to the original value of \code{phab}.
+#'   The variable \code{certain} in this case will be \code{TRUE} for both
+#'   types.
+#'   \item After those first two steps, a given polygon could contain the
+#'   same type with the same value for \code{certain} repeated several
+#'   times, e.g. when \code{31xx_rbbmr} is present with \code{phab} = yy\%
+#'   and \code{31xx} is present with \code{phab} = zz\%.
+#'   In that case the rows with the same \code{polygon_id}, \code{type}
+#'   and \code{certain} were gathered into one row and the respective
+#'   \code{phab} values were added up.
+#'   \item For some polygons the original type code in the
 #'   \code{habitatmap} was not consistent with general coding syntax or
-#'   with the type codes from the \code{\link{types}}. In that case the
-#'   code was adjusted.
+#'   with the type codes from the \code{\link{types}} data source. In that
+#'   case the code was adjusted.
 #'
 #'   }
 #'
@@ -67,20 +88,24 @@
 #'   \itemize{
 #'     \item \code{polygon_id}
 #'     \item \code{description_orig}: polygon description based on the
-#'     orginal vegetation codes in the raw \code{habitatmap}}
+#'     orginal type codes in the raw \code{habitatmap}}
 #'   }
 #'   \itemize{
 #'   \item \code{habitatmap_types}: a tibble with following variables
 #'   \itemize{
 #'     \item \code{polygon_id}
-#'     \item \code{code_orig}: original vegetation code in raw \code{habitatmap}.
-#'     \item \code{phab}: proportion of polygon covered by type, as a percentage.
-#'     \item \code{certain}: \code{TRUE} when vegetation type is certain and
-#'      \code{FALSE} when vegetation type is uncertain.
 #'     \item \code{type}: habitat or RIB type listed in \code{\link{types}}.
+#'     \item \code{certain}: \code{TRUE} when the type is certain and
+#'      \code{FALSE} when the type is uncertain.
+#'     \item \code{code_orig}: original type code in raw \code{habitatmap}.
+#'     \item \code{phab}: proportion of polygon covered by type, as a percentage.
 #'     }
+#'     Since version \code{habitatmap_stdized_2020_v1}, rows are unique only
+#'     by the combination of the \code{polygon_id}, \code{type} and
+#'     \code{certain} columns.
 #'     }
 #'
+#'
 #' @family functions involved in processing the 'habitatmap' data source
 #'
 #' @references
@@ -113,7 +138,10 @@
 #' read_sf
 #' st_crs<-
 #' @importFrom rlang .data
-#' @importFrom dplyr %>% mutate
+#' @importFrom dplyr
+#' %>%
+#' mutate
+#' relocate
 #' @importFrom assertthat
 #' assert_that
 #' is.string
@@ -122,7 +150,8 @@ read_habitatmap_stdized <-
     function(file = file.path(fileman_up("n2khab_data"),
                               "20_processed/habitatmap_stdized/habitatmap_stdized.gpkg"),
              version = c("habitatmap_stdized_2020_v1",
-                         "habitatmap_stdized_2018_v2", "habitatmap_stdized_2018_v1")){
+                         "habitatmap_stdized_2018_v2",
+                         "habitatmap_stdized_2018_v1")){
 
         version <- match.arg(version)
 
@@ -157,6 +186,14 @@ read_habitatmap_stdized <-
                                   )
                     )
 
+        if (grepl("2018", version)) {
+            habmap_types <-
+                habmap_types %>%
+                relocate(.data$polygon_id,
+                         .data$type,
+                         .data$certain)
+        }
+
         if (version == "habitatmap_stdized_2018_v1") {
 
             result <- list(habitatmap_polygons = habmap_polygons,
@@ -710,7 +747,8 @@ read_watersurfaces <-
 #' @param filter_hab If \code{TRUE} only polygons that (partially) contain habitat or a regionally
 #' important biotope (RIB) are returned. The default value is \code{FALSE}. This
 #' requires the corresponding version of the processed data source
-#' \code{habitatmap_stdized} to be present in the 'n2khab_data' folder.
+#' \code{habitatmap_stdized} to be present in its default location inside the
+#' \code{n2khab_data} folder.
 #'
 #' @inheritParams read_habitatmap_stdized
 #'
@@ -768,6 +806,30 @@ read_habitatmap <-
         assert_that(is.flag(filter_hab), noNA(filter_hab))
         version <- match.arg(version)
 
+        if (filter_hab) {
+            # version control: version habitatmap == version habitatmap_stdized
+            xxh64sum_habitatmap_stdized_present <- xxh64sum(file.path(
+                fileman_up("n2khab_data"),
+                "20_processed/habitatmap_stdized/habitatmap_stdized.gpkg"))
+
+            if (version == "habitatmap_2020") {
+                xxh64sum_habitatmap_stdized_expected <- "3109c26f0a27a0f3"
+            } else {
+                xxh64sum_habitatmap_stdized_expected <- c("b80f469f33636c8b","8e9c4e09f5f67c3e")
+            }
+
+            if (!(xxh64sum_habitatmap_stdized_present %in%
+                  xxh64sum_habitatmap_stdized_expected)) {
+                stop("You are trying to use habitatmap version '", version,"' ",
+                     "with another version of habitatmap_stdized. ",
+                     "Specify the correct version as argument (version =) ",
+                     "and add the corresponding files under ",
+                     "'n2khab_data/10_raw/habitatmap' and ",
+                     "'n2khab_data/20_processed/habitatmap_stdized'.",
+                     call. = FALSE)
+            }
+        }
+
         habitatmap <- read_sf(file,
                               "habitatmap")
 
@@ -805,28 +867,6 @@ read_habitatmap <-
 
         if (filter_hab) {
 
-            # version control: version habitatmap == version habitatmap_stdized
-            xxh64sum_habitatmap_stdized_present <- xxh64sum(file.path(
-                fileman_up("n2khab_data"),
-                "20_processed/habitatmap_stdized/habitatmap_stdized.gpkg"))
-
-            if (version == "habitatmap_2020") {
-                xxh64sum_habitatmap_stdized_expected <- "3109c26f0a27a0f3"
-            } else {
-                xxh64sum_habitatmap_stdized_expected <- c("b80f469f33636c8b","8e9c4e09f5f67c3e")
-            }
-
-            if (!(xxh64sum_habitatmap_stdized_present %in%
-                xxh64sum_habitatmap_stdized_expected)) {
-                stop("You are trying to use habitatmap version '", version,"' ",
-                     "with another version of habitatmap_stdized. ",
-                     "Specify the correct version as argument (version =) ",
-                     "and add the corresponding files under ",
-                     "'n2khab_data/10_raw/habitatmap' and ",
-                     "'n2khab_data/10_processed/habitatmap_stdized'.",
-                     call. = FALSE)
-            }
-
             # we only select polygons with habitat or RIB, i.e. polygons in habitatmap_stdized data source
             if (xxh64sum_habitatmap_stdized_present == "8e9c4e09f5f67c3e") {
                 # 2018_v1
@@ -952,13 +992,16 @@ read_habitatmap <-
 #'   \code{habitatmap_stdized}):
 #'   \itemize{
 #'     \item \code{polygon_id}
+#'     \item \code{type}: the interpreted habitat or RIB type
+#'     \item \code{certain}
 #'     \item \code{code_orig}
 #'     \item \code{phab}
-#'     \item \code{certain}
-#'     \item \code{type}: the interpreted habitat or RIB type
 #'     \item \code{source}: states where \code{type} comes from: either
 #'     \code{habitatmap_stdized} or \code{habitatmap_stdized + interpretation}
 #'     }
+#'     Since version \code{habitatmap_terr_2020_v1}, rows are unique only
+#'     by the combination of the \code{polygon_id}, \code{type} and
+#'     \code{certain} columns.
 #'     }
 #'
 #' @family functions involved in processing the 'habitatmap' data source
@@ -995,13 +1038,15 @@ read_habitatmap <-
 #' %>%
 #' mutate
 #' filter
+#' relocate
 read_habitatmap_terr <-
     function(file = file.path(fileman_up("n2khab_data"),
                               "20_processed/habitatmap_terr/habitatmap_terr.gpkg"),
              keep_aq_types = TRUE,
              drop_7220 = TRUE,
              version = c("habitatmap_terr_2020_v1",
-                         "habitatmap_terr_2018_v2", "habitatmap_terr_2018_v1")){
+                         "habitatmap_terr_2018_v2",
+                         "habitatmap_terr_2018_v1")){
 
         assert_that(is.flag(keep_aq_types), noNA(keep_aq_types))
         assert_that(is.flag(drop_7220), noNA(drop_7220))
@@ -1064,6 +1109,14 @@ read_habitatmap_terr <-
             # alone
         }
 
+        if (grepl("2018", version)) {
+            habmap_terr_types <-
+                habmap_terr_types %>%
+                relocate(.data$polygon_id,
+                         .data$type,
+                         .data$certain)
+            }
+
         if (version == "habitatmap_terr_2018_v1") {
             result <- list(habitatmap_terr_polygons = habmap_terr_polygons,
                            habitatmap_terr_patches = habmap_terr_types)
@@ -1604,4 +1657,3 @@ if (references) {
         return(habitatquarries)
 
     }
-