Update read_watersurfaces for version 2024 & read_ws_hab

NAMESPACE

@@ -60,6 +60,7 @@ importFrom(dplyr,mutate)
 importFrom(dplyr,mutate_at)
 importFrom(dplyr,mutate_if)
 importFrom(dplyr,n)
+importFrom(dplyr,na_if)
 importFrom(dplyr,pull)
 importFrom(dplyr,recode)
 importFrom(dplyr,relocate)

R/read_habitatdata.R

@@ -307,11 +307,12 @@ read_habitatmap_stdized <-
 #'
 #' @references
 #' \itemize{
-#' \item Scheers K., Smeekens V., Wils C., Packet J., Leyssen A. & Denys L. (2022).
-#' Watervlakken versie 1.2: polygonenkaart van stilstaand water in Vlaanderen.
-#' Uitgave 2022. Rapporten van het Instituut voor Natuur- en Bosonderzoek 2022
-#' (31). Instituut voor Natuur en Bosonderzoek, Brussel.
-#' \doi{10.21436/inbor.87014272}.
+#' \item Leyssen A., Scheers K., Packet J., Van Hecke F., Wils C. (2024).
+#' Watervlakken 2024: Polygonenkaart van stilstaand water in
+#' Vlaanderen. Uitgave 2024.
+#' Rapporten van het Instituut voor Natuur- en Bosonderzoek 2024
+#' (52). Instituut voor Natuur en Bosonderzoek, Brussel.
+#' \doi{10.21436/inbor.114075267}.
 #' #' \item De Saeger S., Dhaluin P., Erens R., Guelinckx G., Hennebel D.,
 #' Jacobs I., Kumpen M., Van Oost F., Spanhove T., Leyssen A., Oosterlynck P.,
 #' Van Dam G., Van Hove M., Wils C. (red.) (2023).
@@ -359,6 +360,7 @@ read_watersurfaces_hab <-
            ),
            interpreted = FALSE,
            version = c(
+             "watersurfaces_hab_v6",
              "watersurfaces_hab_v5",
              "watersurfaces_hab_v4",
              "watersurfaces_hab_v3",
@@ -448,7 +450,7 @@ read_watersurfaces_hab <-
 
 #' Return the data source \code{watersurfaces} as an \code{sf} polygon layer
 #'
-#' Returns the raw data source \code{watersurfaces} (Scheers et al., 2022)
+#' Returns the raw data source \code{watersurfaces} (Leyssen et al., 2024)
 #' as a standardized \code{sf} polygon layer
 #' (tidyverse-styled, internationalized) in the Belgian Lambert 72 CRS
 #' (EPSG-code \href{https://epsg.io/31370}{31370}).
@@ -462,7 +464,7 @@ read_watersurfaces_hab <-
 #' is the version corresponding to the \code{file} (note that the \code{version}
 #' defaults to the latest version).
 #'
-#' See Scheers et al. (2022) for an elaborate explanation of the data source
+#' See Leyssen et al. (2024) for an elaborate explanation of the data source
 #' and its attributes.
 #'
 #' @param file Optional string. An absolute or relative file path of
@@ -499,19 +501,23 @@ read_watersurfaces_hab <-
 #'   \item \code{polygon_id}: code of the polygon;
 #'   \item \code{wfd_code}: optional; Flemish code of the water body with
 #'   regard to the Water Framework Directive (WFD);
-#'   \item \code{hyla_code}: optional; code of the watersurface according to the
-#'   Flemish working group 'Hyla', a working group on amphibians & reptiles;
+#'   \item \code{hyla_code}: optional (only v1.2 and earlier); code of the
+#'   watersurface according to the Flemish working group 'Hyla', a working group
+#'   on amphibians & reptiles;
 #'   \item \code{name}: name of the watersurface;
 #'   \item \code{area_name}: name of the area;
 #'   \item \code{wfd_type}: type code according to the Flemish WFD typology
 #'   (Denys, 2009);
+#'   \item \code{wfd_type_alternative}: alternative type code according to the
+#'   Flemish WFD typology, in case there is a gradient between different types
+#'   (only version 2024);
 #'   \item \code{wfd_type_certain}: Logical.
 #'   Is there high confidence about the \code{wfd_type} determination?
 #'   \item \code{depth_class}: class of water depth;
 #'   \item \code{connectivity}: connectivity class;
 #'   \item \code{usage}: usage class;
-#'   \item \code{water_level_management}: water-level management class (not in
-#'   older versions).
+#'   \item \code{water_level_management}: water-level management class (only
+#'   since v1.2).
 #' }
 #'
 #' @family functions involved in processing the 'watersurfaces' data source
@@ -524,10 +530,10 @@ read_watersurfaces_hab <-
 #' wateren in Vlaanderen.
 #' Rapporten van het Instituut voor Natuur- en Bosonderzoek INBO.R.2009.34.
 #' Instituut voor Natuur- en Bosonderzoek, Brussel.
-#' \item Scheers K., Smeekens V., Wils C., Packet J., Leyssen A. & Denys L.
-#' (2022). Watervlakken versie 1.2: Polygonenkaart van stilstaand water in
-#' Vlaanderen. Uitgave 2022. Instituut voor Natuur- en Bosonderzoek.
-#' \doi{10.21436/inbor.87014272}.
+#' \item Leyssen A., Scheers K., Packet J., Van Hecke F., Wils C. (2024).
+#' Watervlakken 2024: Polygonenkaart van stilstaand water in
+#' Vlaanderen. Uitgave 2024. Instituut voor Natuur- en Bosonderzoek.
+#' \doi{10.21436/inbor.114075267}.
 #' }
 #'
 #' @examples
@@ -566,8 +572,7 @@ read_watersurfaces_hab <-
 #' across
 #' arrange
 #' mutate
-#' mutate_at
-#' mutate_if
+#' na_if
 #' rename
 #' select
 #' left_join
@@ -582,7 +587,8 @@ read_watersurfaces <-
   function(file = NULL,
            extended = FALSE,
            fix_geom = FALSE,
-           version = c("watersurfaces_v1.2",
+           version = c("watersurfaces_v2024",
+                       "watersurfaces_v1.2",
                        "watersurfaces_v1.1",
                        "watersurfaces_v1.0")) {
     version <- match.arg(version)
@@ -631,11 +637,9 @@ read_watersurfaces <-
       )
 
       wfd_typetransl <- read_sf(file, layer = "LktKRWTYPE") %>%
-        mutate_if(., is.character,
-          .funs = function(x) {
-            return(`Encoding<-`(x, "UTF-8"))
-          }
-        ) %>%
+        mutate(across(where(is.character),
+                      ~ return(`Encoding<-`(.x, "UTF-8"))
+        )) %>%
         mutate(across(c(.data$Code), as.factor)) %>%
         rename(
           wfd_type = .data$Code,
@@ -664,6 +668,7 @@ read_watersurfaces <-
           "C", "circumneutraal",
           "Cb", "circumneutraal, sterk gebufferd",
           "CbFe", "circumneutraal, sterk gebufferd, ijzerrijk",
+          "CFe", "circumneutraal, ijzerrijk",
           "Czb", "circumneutraal, zwak gebufferd",
           "Z", "zuur",
           "Zm", "zwak zuur",
@@ -676,6 +681,21 @@ read_watersurfaces <-
         )
     }
 
+    if (version == "watersurfaces_v2024") {
+      wfd_type_alttransl <- data.frame(wfd_type = "-", wfd_type_name = "geen ander watertype") %>%
+        bind_rows(wfd_typetransl) %>%
+        bind_rows(wfd_typetransl %>%
+                    mutate(wfd_type = paste0("(",wfd_type,")"),
+                           wfd_type_name = paste(wfd_type_name, "(weinig waarschijnlijk)"))) %>%
+        rename(wfd_type_alt_name = wfd_type_name,
+               wfd_type_alternative = wfd_type) %>%
+        mutate(
+          wfd_type_alternative = factor(.data$wfd_type_alternative,
+                                        levels = .$wfd_type_alternative
+          )
+        )
+    }
+
     if (fix_geom) {
       validities <- st_is_valid(watersurfaces)
       n_invalid <- sum(!validities | is.na(validities))
@@ -691,18 +711,25 @@ read_watersurfaces <-
       watersurfaces %>%
       {
         if (version == "watersurfaces_v1.2") {
-          rename(., water_level_management = .data$PEILBEHEER)
+          rename(., water_level_management = .data$PEILBEHEER,
+                 hyla_code = .data$HYLAC)
+        } else if (version == "watersurfaces_v2024") {
+          rename(.,
+                 wfd_type_alternative = .data$KRWTYPEA,
+                 water_level_management = .data$PEILBEHEER) %>%
+            mutate(across(where(is.character), ~na_if(., "")))
         } else {
-          .
+          rename(., hyla_code = .data$HYLAC)
         }
       } %>%
       select(
         polygon_id = .data$WVLC,
         wfd_code = .data$WTRLICHC,
-        hyla_code = .data$HYLAC,
+        matches("^hyla_code$"),
         name = .data$NAAM,
         area_name = .data$GEBIED,
         wfd_type = .data$KRWTYPE,
+        matches("^wfd_type_alternative$"),
         wfd_type_certain = .data$KRWTYPES,
         depth_class = .data$DIEPKL,
         connectivity = .data$CONNECT,
@@ -729,23 +756,29 @@ read_watersurfaces <-
           factor(
             levels =
               levels(wfd_typetransl$wfd_type)
-          ),
-        hyla_code = ifelse(.data$hyla_code == 0,
-          NA,
-          .data$hyla_code
-        )
+            )
       ) %>%
+      mutate(across(
+        matches("^wfd_type_alternative$"),
+        ~ factor(.,
+                 levels =
+                   levels(wfd_type_alttransl$wfd_type_alternative)
+        )
+      )) %>%
+      mutate(across(
+        matches("^hyla_code$"),
+        ~ ifelse(.data$hyla_code == 0,
+                 NA,
+                 .data$hyla_code)
+      )) %>%
       arrange(.data$polygon_id)
 
     if (version == "watersurfaces_v1.0") {
       watersurfaces <-
         watersurfaces %>%
-        mutate_at(
-          .vars = c("wfd_code", "name"),
-          .funs = function(x) {
-            ifelse(x == "<Null>", NA, x)
-          }
-        ) %>%
+        mutate(across(c("wfd_code", "name"),
+                      ~ ifelse(.x == "<Null>", NA, .x)
+        )) %>%
         mutate(wfd_type_certain = ifelse(is.na(.data$wfd_type_certain),
           na_lgl,
           .data$wfd_type_certain %in%
@@ -777,11 +810,9 @@ read_watersurfaces <-
     if (extended) {
       if (version == "watersurfaces_v1.1") {
         connectivitytransl <- read_sf(file, layer = "LktCONNECT") %>%
-          mutate_if(., is.character,
-            .funs = function(x) {
-              return(`Encoding<-`(x, "UTF-8"))
-            }
-          ) %>%
+          mutate(across(where(is.character),
+                        ~ return(`Encoding<-`(.x, "UTF-8"))
+          )) %>%
           mutate(across(c(.data$Code), as.factor)) %>%
           rename(
             connectivity = .data$Code,
@@ -823,8 +854,23 @@ read_watersurfaces <-
                 to = wfd_typetransl$wfd_type_name
               )
         ) %>%
-        # following match is only partial in case of v1.2
-        left_join(connectivitytransl, by = "connectivity") %>%
+        {
+          if (version == "watersurfaces_v2024") {
+            left_join(., wfd_type_alttransl, by = "wfd_type_alternative") %>%
+              mutate(
+                wfd_type_alt_name =
+                  .data$wfd_type_alternative %>%
+                  mapvalues(
+                    from = wfd_type_alttransl$wfd_type_alternative,
+                    to = wfd_type_alttransl$wfd_type_alt_name
+                    )
+              )
+          } else {
+            .
+          }
+        } %>%
+        #following match is only partial in case of v1.2
+        left_join(., connectivitytransl, by = "connectivity") %>%
         mutate(
           connectivity_name =
             .data$connectivity %>%
@@ -834,10 +880,19 @@ read_watersurfaces <-
               )
         ) %>%
         select(
-          1:6,
-          .data$wfd_type_name,
-          7:9,
-          .data$connectivity_name,
+          polygon_id,
+          wfd_code,
+          matches("^hyla_code$"),
+          name,
+          area_name,
+          wfd_type,
+          wfd_type_name,
+          matches("^wfd_type_alternative$"),
+          matches("^wfd_type_alt_name$"),
+          wfd_type_certain,
+          depth_class,
+          connectivity,
+          connectivity_name,
           everything()
         )
     }