From 6110cd1b5e6b0584aa2f15bd8519568254233d0c Mon Sep 17 00:00:00 2001 From: cecileherr Date: Wed, 11 Dec 2024 15:29:28 +0100 Subject: [PATCH 01/17] read_watersurfaces: update doc for v 2024 --- R/read_habitatdata.R | 24 ++++++++++++++---------- man/read_watersurfaces.Rd | 27 ++++++++++++++++----------- 2 files changed, 30 insertions(+), 21 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 2c6ccae4..43ded3fc 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -448,7 +448,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 +462,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 +499,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 +528,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 diff --git a/man/read_watersurfaces.Rd b/man/read_watersurfaces.Rd index 10065bc8..18e51b56 100644 --- a/man/read_watersurfaces.Rd +++ b/man/read_watersurfaces.Rd @@ -8,7 +8,8 @@ read_watersurfaces( file = NULL, extended = FALSE, fix_geom = FALSE, - version = c("watersurfaces_v1.2", "watersurfaces_v1.1", "watersurfaces_v1.0") + version = c("watersurfaces_v2024", "watersurfaces_v1.2", "watersurfaces_v1.1", + "watersurfaces_v1.0") ) } \arguments{ @@ -49,23 +50,27 @@ variables (not mentioning extra 'name' variables for \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). } } \description{ -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}). @@ -80,7 +85,7 @@ In both cases: always make sure to specify the correct \code{version}, that 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. } \examples{ @@ -112,10 +117,10 @@ ws2 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}. } } \seealso{ From 08b3655604bdd1683a4bd46b3b1e0a2337ec0082 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Wed, 11 Dec 2024 15:31:05 +0100 Subject: [PATCH 02/17] read_watersurfaces: replace mutate_if _at by across --- R/read_habitatdata.R | 27 +++++++++------------------ 1 file changed, 9 insertions(+), 18 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 43ded3fc..2c464b8b 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -570,8 +570,6 @@ read_watersurfaces_hab <- #' across #' arrange #' mutate -#' mutate_at -#' mutate_if #' rename #' select #' left_join @@ -635,11 +633,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, @@ -744,12 +740,9 @@ read_watersurfaces <- if (version == "watersurfaces_v1.0") { watersurfaces <- watersurfaces %>% - mutate_at( - .vars = c("wfd_code", "name"), - .funs = function(x) { - ifelse(x == "", NA, x) - } - ) %>% + mutate(across(c("wfd_code", "name"), + ~ ifelse(.x == "", NA, .x) + )) %>% mutate(wfd_type_certain = ifelse(is.na(.data$wfd_type_certain), na_lgl, .data$wfd_type_certain %in% @@ -781,11 +774,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, From b706a0be15fc2c1a51496180cca2be2ba8c8ec4a Mon Sep 17 00:00:00 2001 From: cecileherr Date: Wed, 11 Dec 2024 15:42:01 +0100 Subject: [PATCH 03/17] read_watersurfaces: adapt foor v2024 - drop hyla_code - add wfd_type_alternative - add wfd_type_alt_name - include water_level_management - add CFe in list water types - use na_if for empty cells ("") --- NAMESPACE | 1 + R/read_habitatdata.R | 88 ++++++++++++++++++++++++++++++++++++-------- 2 files changed, 74 insertions(+), 15 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 245aa959..e5200804 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 2c464b8b..61be90ac 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -570,6 +570,7 @@ read_watersurfaces_hab <- #' across #' arrange #' mutate +#' na_if #' rename #' select #' left_join @@ -584,7 +585,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) @@ -664,6 +666,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 +679,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 +709,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,12 +754,21 @@ 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") { @@ -818,8 +852,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 %>% @@ -829,10 +878,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() ) } From 24960cc31777c6999c8d3dae9e349a66587ee673 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Thu, 12 Dec 2024 11:28:02 +0100 Subject: [PATCH 04/17] read_watersurfaces_hab: update to v6 - that is with watersurfaces 2024 - incl. documentation --- R/read_habitatdata.R | 12 +++++++----- man/read_watersurfaces_hab.Rd | 15 ++++++++------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 61be90ac..eaeb6edc 100644 --- a/R/read_habitatdata.R +++ b/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", diff --git a/man/read_watersurfaces_hab.Rd b/man/read_watersurfaces_hab.Rd index 2db2983a..1e382128 100644 --- a/man/read_watersurfaces_hab.Rd +++ b/man/read_watersurfaces_hab.Rd @@ -9,8 +9,8 @@ read_watersurfaces_hab( file = file.path(locate_n2khab_data(), "20_processed/watersurfaces_hab/watersurfaces_hab.gpkg"), interpreted = FALSE, - version = c("watersurfaces_hab_v5", "watersurfaces_hab_v4", "watersurfaces_hab_v3", - "watersurfaces_hab_v2", "watersurfaces_hab_v1") + version = c("watersurfaces_hab_v6", "watersurfaces_hab_v5", "watersurfaces_hab_v4", + "watersurfaces_hab_v3", "watersurfaces_hab_v2", "watersurfaces_hab_v1") ) } \arguments{ @@ -105,11 +105,12 @@ wsh_types } \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). From d41f598a29a4a09e0145c380eeca760bbfed5a53 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Mon, 23 Dec 2024 12:02:50 +0100 Subject: [PATCH 05/17] read_habitatdata: add tidyselect where --- DESCRIPTION | 1 + NAMESPACE | 1 + R/read_habitatdata.R | 2 ++ 3 files changed, 4 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index a399d813..578c5d5c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,6 +44,7 @@ Imports: sf, stringr, tidyr (>= 1.0.0), + tidyselect Encoding: UTF-8 LazyData: true RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index e5200804..fabfc5f0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -109,5 +109,6 @@ importFrom(stringr,str_to_title) importFrom(tidyr,nest) importFrom(tidyr,tribble) importFrom(tidyr,unnest) +importFrom(tidyselect,where) importFrom(utils,packageDescription) importFrom(utils,packageVersion) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index eaeb6edc..23f9ec2a 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -582,6 +582,8 @@ read_watersurfaces_hab <- #' assert_that #' @importFrom stringr #' str_replace +#' @importFrom tidyselect +#' where #' @export read_watersurfaces <- function(file = NULL, From 546650f94191e20bbd3b8f14b64b7360721267d2 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Mon, 23 Dec 2024 12:15:02 +0100 Subject: [PATCH 06/17] read_watersurfaces: group several mutate in one --- R/read_habitatdata.R | 94 +++++++++++++++++++++----------------------- 1 file changed, 45 insertions(+), 49 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 23f9ec2a..176285d8 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -639,10 +639,12 @@ read_watersurfaces <- ) wfd_typetransl <- read_sf(file, layer = "LktKRWTYPE") %>% - mutate(across(where(is.character), - ~ return(`Encoding<-`(.x, "UTF-8")) - )) %>% - mutate(across(c(.data$Code), as.factor)) %>% + mutate( + across(where(is.character), + ~ return(`Encoding<-`(.x, "UTF-8"))), + across(c(.data$Code), + as.factor) + ) %>% rename( wfd_type = .data$Code, wfd_type_name = .data$Omschrijving @@ -738,57 +740,50 @@ read_watersurfaces <- usage = .data$FUNCTIE, matches("^water_level_management$") ) %>% - mutate(depth_class = str_replace( - string = .data$depth_class, - pattern = "\u2265", - replacement = ">=" - )) %>% - mutate(across( - c( - .data$area_name, - .data$depth_class, - .data$connectivity, - .data$usage, - matches("^water_level_management$") - ), - as.factor - )) %>% mutate( + depth_class = str_replace( + string = .data$depth_class, + pattern = "\u2265", + replacement = ">="), + across( + c( + .data$area_name, + .data$depth_class, + .data$connectivity, + .data$usage, + matches("^water_level_management$") + ), + as.factor), wfd_type = .data$wfd_type %>% factor( levels = levels(wfd_typetransl$wfd_type) - ) - ) %>% - 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) - )) %>% + ), + across( + matches("^wfd_type_alternative$"), + ~ factor(., + levels = + levels(wfd_type_alttransl$wfd_type_alternative) + )), + 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(across(c("wfd_code", "name"), - ~ ifelse(.x == "", NA, .x) - )) %>% - mutate(wfd_type_certain = ifelse(is.na(.data$wfd_type_certain), - na_lgl, - .data$wfd_type_certain %in% - c( - "zeker", - "definitief" - ) - )) + mutate( + across(c("wfd_code", "name"), + ~ ifelse(.x == "", NA, .x)), + wfd_type_certain = ifelse(is.na(.data$wfd_type_certain), + na_lgl, + .data$wfd_type_certain %in% + c("zeker","definitief")) + ) } else { watersurfaces <- watersurfaces %>% @@ -812,10 +807,11 @@ read_watersurfaces <- if (extended) { if (version == "watersurfaces_v1.1") { connectivitytransl <- read_sf(file, layer = "LktCONNECT") %>% - mutate(across(where(is.character), - ~ return(`Encoding<-`(.x, "UTF-8")) - )) %>% - mutate(across(c(.data$Code), as.factor)) %>% + mutate( + across(where(is.character), + ~ return(`Encoding<-`(.x, "UTF-8"))), + across(c(.data$Code), as.factor) + ) %>% rename( connectivity = .data$Code, connectivity_name = .data$Omschr From 74321098ca0b5afcc4e8f7169e304de3a20d8036 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Mon, 23 Dec 2024 12:17:11 +0100 Subject: [PATCH 07/17] read_watersurfaces: solve 'undefined global var' for tidyselect --- R/read_habitatdata.R | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 176285d8..f364e798 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -689,10 +689,10 @@ read_watersurfaces <- 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 = paste0("(",.data$wfd_type,")"), + wfd_type_name = paste(.data$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 @@ -878,19 +878,19 @@ read_watersurfaces <- ) ) %>% select( - polygon_id, - wfd_code, + "polygon_id", + "wfd_code", matches("^hyla_code$"), - name, - area_name, - wfd_type, - wfd_type_name, + "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, + "wfd_type_certain", + "depth_class", + "connectivity", + "connectivity_name", everything() ) } From 413db8394a5cf0a493dadcae6b982d0ccb96c406 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Mon, 23 Dec 2024 12:22:07 +0100 Subject: [PATCH 08/17] read_watersurfaces: minor changes --- R/read_habitatdata.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index f364e798..a038c7d8 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -868,7 +868,7 @@ read_watersurfaces <- } } %>% #following match is only partial in case of v1.2 - left_join(., connectivitytransl, by = "connectivity") %>% + left_join(connectivitytransl, by = "connectivity") %>% mutate( connectivity_name = .data$connectivity %>% From 075644975503a4d39b74ddd205b538784f8d9a5f Mon Sep 17 00:00:00 2001 From: cecileherr Date: Mon, 23 Dec 2024 12:35:16 +0100 Subject: [PATCH 09/17] read_watersurfaces: replace deprecated .data in tidy-selection - replace the deprecated .data$xxx by "xxx" in all rename, select, arrange --- R/read_habitatdata.R | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index a038c7d8..9d2ac891 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -646,9 +646,9 @@ read_watersurfaces <- as.factor) ) %>% rename( - wfd_type = .data$Code, - wfd_type_name = .data$Omschrijving - ) + wfd_type = "Code", + wfd_type_name = "Omschrijving" + ) } else { suppressWarnings( watersurfaces <- read_sf(file, @@ -715,29 +715,29 @@ read_watersurfaces <- watersurfaces %>% { if (version == "watersurfaces_v1.2") { - rename(., water_level_management = .data$PEILBEHEER, - hyla_code = .data$HYLAC) + rename(., water_level_management = "PEILBEHEER", + hyla_code = "HYLAC") } else if (version == "watersurfaces_v2024") { rename(., - wfd_type_alternative = .data$KRWTYPEA, - water_level_management = .data$PEILBEHEER) %>% mutate(across(where(is.character), ~na_if(., ""))) + wfd_type_alternative = "KRWTYPEA", + water_level_management = "PEILBEHEER") %>% } else { - rename(., hyla_code = .data$HYLAC) + rename(., hyla_code = "HYLAC") } } %>% select( - polygon_id = .data$WVLC, - wfd_code = .data$WTRLICHC, + polygon_id = "WVLC", + wfd_code = "WTRLICHC", matches("^hyla_code$"), - name = .data$NAAM, - area_name = .data$GEBIED, - wfd_type = .data$KRWTYPE, + name = "NAAM", + area_name = "GEBIED", + wfd_type = "KRWTYPE", matches("^wfd_type_alternative$"), - wfd_type_certain = .data$KRWTYPES, - depth_class = .data$DIEPKL, - connectivity = .data$CONNECT, - usage = .data$FUNCTIE, + wfd_type_certain = "KRWTYPES", + depth_class = "DIEPKL", + connectivity = "CONNECT", + usage = "FUNCTIE", matches("^water_level_management$") ) %>% mutate( @@ -771,7 +771,7 @@ read_watersurfaces <- NA, .data$hyla_code)) ) %>% - arrange(.data$polygon_id) + arrange("polygon_id") if (version == "watersurfaces_v1.0") { watersurfaces <- @@ -813,8 +813,8 @@ read_watersurfaces <- across(c(.data$Code), as.factor) ) %>% rename( - connectivity = .data$Code, - connectivity_name = .data$Omschr + connectivity = "Code", + connectivity_name = "Omschr" ) } else { connectivitytransl <- From 880cd3fbf14db500c6cec1987a22107fa05a5428 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Mon, 23 Dec 2024 13:08:49 +0100 Subject: [PATCH 10/17] read_watersurfaces: minor correction --- R/read_habitatdata.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 9d2ac891..fffb8d8b 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -719,9 +719,10 @@ read_watersurfaces <- hyla_code = "HYLAC") } else if (version == "watersurfaces_v2024") { rename(., - mutate(across(where(is.character), ~na_if(., ""))) wfd_type_alternative = "KRWTYPEA", water_level_management = "PEILBEHEER") %>% + mutate( + across(where(is.character), ~na_if(., ""))) } else { rename(., hyla_code = "HYLAC") } From 76da084304a229978d2ae552dfbeb6d78f974b84 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Mon, 23 Dec 2024 13:45:50 +0100 Subject: [PATCH 11/17] read_watersurfaces_hab: replace mutate_at by mutate(across) --- R/read_habitatdata.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index fffb8d8b..6525e8be 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -345,9 +345,8 @@ read_habitatmap_stdized <- #' @importFrom rlang .data #' @importFrom dplyr #' %>% +#' across #' mutate -#' mutate_at -#' vars #' relocate #' @importFrom assertthat #' assert_that @@ -375,10 +374,9 @@ read_watersurfaces_hab <- ) watersurfaces_polygons <- watersurfaces_polygons %>% - mutate_at( - .vars = vars(starts_with("polygon_id")), - .funs = factor - ) + mutate( + across(starts_with("polygon_id"), + factor)) suppressWarnings(st_crs(watersurfaces_polygons) <- 31370) From 434a9043c6211a429d91e7dbbee58b9feed932d4 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Mon, 23 Dec 2024 14:03:23 +0100 Subject: [PATCH 12/17] read_watersurfaces_hab: replace deprecated .data in tidy-selection - replace the deprecated .data$xxx by "xxx" in all (rename, select, arrange,) relocate --- R/read_habitatdata.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 6525e8be..a2efaa4e 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -412,9 +412,9 @@ read_watersurfaces_hab <- ) ) %>% relocate( - .data$polygon_id, - .data$type, - .data$certain + "polygon_id", + "type", + "certain" ) if (version %in% c("watersurfaces_hab_v1", "watersurfaces_hab_v2")) { From 84f10266104a2b13019f1736944b6cbb1c5638b9 Mon Sep 17 00:00:00 2001 From: florisvdh Date: Mon, 6 Jan 2025 13:37:40 +0100 Subject: [PATCH 13/17] read_watersurfaces(): use tidyselect expressions in across() (no .data) --- R/read_habitatdata.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index a2efaa4e..38bb2195 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -640,7 +640,7 @@ read_watersurfaces <- mutate( across(where(is.character), ~ return(`Encoding<-`(.x, "UTF-8"))), - across(c(.data$Code), + across("Code", as.factor) ) %>% rename( @@ -746,12 +746,12 @@ read_watersurfaces <- replacement = ">="), across( c( - .data$area_name, - .data$depth_class, - .data$connectivity, - .data$usage, + "area_name", + "depth_class", + "connectivity", + "usage", matches("^water_level_management$") - ), + ), as.factor), wfd_type = .data$wfd_type %>% factor( @@ -809,7 +809,7 @@ read_watersurfaces <- mutate( across(where(is.character), ~ return(`Encoding<-`(.x, "UTF-8"))), - across(c(.data$Code), as.factor) + across("Code", as.factor) ) %>% rename( connectivity = "Code", From 19827a2b77125e25a16b93014b5ab33b4ec3a873 Mon Sep 17 00:00:00 2001 From: florisvdh Date: Mon, 6 Jan 2025 13:40:17 +0100 Subject: [PATCH 14/17] read_watersurfaces(): replace matches("^...$") with any_of("...") --- NAMESPACE | 1 + R/read_habitatdata.R | 19 ++++++++++--------- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index fabfc5f0..80083f7f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -109,6 +109,7 @@ importFrom(stringr,str_to_title) importFrom(tidyr,nest) importFrom(tidyr,tribble) importFrom(tidyr,unnest) +importFrom(tidyselect,any_of) importFrom(tidyselect,where) importFrom(utils,packageDescription) importFrom(utils,packageVersion) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 38bb2195..69085b46 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -582,6 +582,7 @@ read_watersurfaces_hab <- #' str_replace #' @importFrom tidyselect #' where +#' any_of #' @export read_watersurfaces <- function(file = NULL, @@ -728,16 +729,16 @@ read_watersurfaces <- select( polygon_id = "WVLC", wfd_code = "WTRLICHC", - matches("^hyla_code$"), + any_of("hyla_code"), name = "NAAM", area_name = "GEBIED", wfd_type = "KRWTYPE", - matches("^wfd_type_alternative$"), + any_of("wfd_type_alternative"), wfd_type_certain = "KRWTYPES", depth_class = "DIEPKL", connectivity = "CONNECT", usage = "FUNCTIE", - matches("^water_level_management$") + any_of("water_level_management") ) %>% mutate( depth_class = str_replace( @@ -750,7 +751,7 @@ read_watersurfaces <- "depth_class", "connectivity", "usage", - matches("^water_level_management$") + any_of("water_level_management") ), as.factor), wfd_type = .data$wfd_type %>% @@ -759,13 +760,13 @@ read_watersurfaces <- levels(wfd_typetransl$wfd_type) ), across( - matches("^wfd_type_alternative$"), + any_of("wfd_type_alternative"), ~ factor(., levels = levels(wfd_type_alttransl$wfd_type_alternative) )), across( - matches("^hyla_code$"), + any_of("hyla_code"), ~ ifelse(.data$hyla_code == 0, NA, .data$hyla_code)) @@ -879,13 +880,13 @@ read_watersurfaces <- select( "polygon_id", "wfd_code", - matches("^hyla_code$"), + any_of("hyla_code"), "name", "area_name", "wfd_type", "wfd_type_name", - matches("^wfd_type_alternative$"), - matches("^wfd_type_alt_name$"), + any_of("wfd_type_alternative"), + any_of("wfd_type_alt_name"), "wfd_type_certain", "depth_class", "connectivity", From fe005033308d91c16572c2ab322b45391ebfad8c Mon Sep 17 00:00:00 2001 From: cecileherr Date: Tue, 7 Jan 2025 16:04:09 +0100 Subject: [PATCH 15/17] read_watersurfaces: replace deprecated .data in tidy-selection --- R/read_habitatdata.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 69085b46..fc70552c 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -767,9 +767,9 @@ read_watersurfaces <- )), across( any_of("hyla_code"), - ~ ifelse(.data$hyla_code == 0, + ~ ifelse(.x == 0, NA, - .data$hyla_code)) + .x)) ) %>% arrange("polygon_id") From 225316b67fcca545b6a18c01236a31a728e519c7 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Tue, 7 Jan 2025 17:02:30 +0100 Subject: [PATCH 16/17] read_watersurfaces: add a correction per record - for version 2024: polygon_id "d" => "WVLKNO0072" --- R/read_habitatdata.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index fc70552c..6b60654f 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -804,6 +804,16 @@ read_watersurfaces <- )) } + # corrections per record + # 2024: wrong polygon_id "d" + if (version == "watersurfaces_v2024") { + watersurfaces <- + watersurfaces %>% + mutate(polygon_id = ifelse(.data$polygon_id == "d", + "WVLKNO0072", + .data$polygon_id)) + } + if (extended) { if (version == "watersurfaces_v1.1") { connectivitytransl <- read_sf(file, layer = "LktCONNECT") %>% From bd784a5a7ff51b4081611383aa40ca0f36602483 Mon Sep 17 00:00:00 2001 From: cecileherr Date: Tue, 7 Jan 2025 17:07:07 +0100 Subject: [PATCH 17/17] run styler::style_pkg() --- R/read_habitatdata.R | 122 ++++++++++++++++++++++++++----------------- 1 file changed, 75 insertions(+), 47 deletions(-) diff --git a/R/read_habitatdata.R b/R/read_habitatdata.R index 6b60654f..933c14c3 100644 --- a/R/read_habitatdata.R +++ b/R/read_habitatdata.R @@ -375,8 +375,11 @@ read_watersurfaces_hab <- watersurfaces_polygons <- watersurfaces_polygons %>% mutate( - across(starts_with("polygon_id"), - factor)) + across( + starts_with("polygon_id"), + factor + ) + ) suppressWarnings(st_crs(watersurfaces_polygons) <- 31370) @@ -588,10 +591,12 @@ read_watersurfaces <- function(file = NULL, extended = FALSE, fix_geom = FALSE, - version = c("watersurfaces_v2024", - "watersurfaces_v1.2", - "watersurfaces_v1.1", - "watersurfaces_v1.0")) { + version = c( + "watersurfaces_v2024", + "watersurfaces_v1.2", + "watersurfaces_v1.1", + "watersurfaces_v1.0" + )) { version <- match.arg(version) assert_that(is.flag(extended), noNA(extended)) assert_that(is.flag(fix_geom), noNA(fix_geom)) @@ -639,15 +644,19 @@ read_watersurfaces <- wfd_typetransl <- read_sf(file, layer = "LktKRWTYPE") %>% mutate( - across(where(is.character), - ~ return(`Encoding<-`(.x, "UTF-8"))), - across("Code", - as.factor) - ) %>% + across( + where(is.character), + ~ return(`Encoding<-`(.x, "UTF-8")) + ), + across( + "Code", + as.factor + ) + ) %>% rename( wfd_type = "Code", wfd_type_name = "Omschrijving" - ) + ) } else { suppressWarnings( watersurfaces <- read_sf(file, @@ -688,13 +697,17 @@ read_watersurfaces <- 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("(",.data$wfd_type,")"), - wfd_type_name = paste(.data$wfd_type_name, "(weinig waarschijnlijk)"))) %>% - rename(wfd_type_alt_name = "wfd_type_name", - wfd_type_alternative = "wfd_type") %>% + mutate( + wfd_type = paste0("(", .data$wfd_type, ")"), + wfd_type_name = paste(.data$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 + levels = .$wfd_type_alternative ) ) } @@ -714,14 +727,18 @@ read_watersurfaces <- watersurfaces %>% { if (version == "watersurfaces_v1.2") { - rename(., water_level_management = "PEILBEHEER", - hyla_code = "HYLAC") + rename(., + water_level_management = "PEILBEHEER", + hyla_code = "HYLAC" + ) } else if (version == "watersurfaces_v2024") { rename(., - wfd_type_alternative = "KRWTYPEA", - water_level_management = "PEILBEHEER") %>% + wfd_type_alternative = "KRWTYPEA", + water_level_management = "PEILBEHEER" + ) %>% mutate( - across(where(is.character), ~na_if(., ""))) + across(where(is.character), ~ na_if(., "")) + ) } else { rename(., hyla_code = "HYLAC") } @@ -744,7 +761,8 @@ read_watersurfaces <- depth_class = str_replace( string = .data$depth_class, pattern = "\u2265", - replacement = ">="), + replacement = ">=" + ), across( c( "area_name", @@ -753,36 +771,43 @@ read_watersurfaces <- "usage", any_of("water_level_management") ), - as.factor), + as.factor + ), wfd_type = .data$wfd_type %>% factor( levels = levels(wfd_typetransl$wfd_type) - ), + ), across( any_of("wfd_type_alternative"), ~ factor(., - levels = - levels(wfd_type_alttransl$wfd_type_alternative) - )), + levels = + levels(wfd_type_alttransl$wfd_type_alternative) + ) + ), across( any_of("hyla_code"), ~ ifelse(.x == 0, - NA, - .x)) - ) %>% + NA, + .x + ) + ) + ) %>% arrange("polygon_id") if (version == "watersurfaces_v1.0") { watersurfaces <- watersurfaces %>% mutate( - across(c("wfd_code", "name"), - ~ ifelse(.x == "", NA, .x)), + across( + c("wfd_code", "name"), + ~ ifelse(.x == "", NA, .x) + ), wfd_type_certain = ifelse(is.na(.data$wfd_type_certain), - na_lgl, - .data$wfd_type_certain %in% - c("zeker","definitief")) + na_lgl, + .data$wfd_type_certain %in% + c("zeker", "definitief") + ) ) } else { watersurfaces <- @@ -810,16 +835,19 @@ read_watersurfaces <- watersurfaces <- watersurfaces %>% mutate(polygon_id = ifelse(.data$polygon_id == "d", - "WVLKNO0072", - .data$polygon_id)) + "WVLKNO0072", + .data$polygon_id + )) } if (extended) { if (version == "watersurfaces_v1.1") { connectivitytransl <- read_sf(file, layer = "LktCONNECT") %>% mutate( - across(where(is.character), - ~ return(`Encoding<-`(.x, "UTF-8"))), + across( + where(is.character), + ~ return(`Encoding<-`(.x, "UTF-8")) + ), across("Code", as.factor) ) %>% rename( @@ -868,16 +896,16 @@ read_watersurfaces <- 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 + 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 + # following match is only partial in case of v1.2 left_join(connectivitytransl, by = "connectivity") %>% mutate( connectivity_name = @@ -1122,9 +1150,9 @@ read_habitatmap <- # !validities | is.na(validities) # ) # if (n_invalid > 0) { - habitatmap <- st_make_valid(habitatmap) - # message("Fixed ", n_invalid, " invalid or corrupt geometries.") - message("Fixed invalid or corrupt geometries.") + habitatmap <- st_make_valid(habitatmap) + # message("Fixed ", n_invalid, " invalid or corrupt geometries.") + message("Fixed invalid or corrupt geometries.") # } }