feat(get_locs): migrate to DWH 'W0002_10_Watina'

DESCRIPTION

@@ -28,7 +28,8 @@ Imports:
     rlang,
     stringr,
     stats,
-    tidyr
+    tidyr,
+    lifecycle
 Suggests:
     DBI,
     ggplot2,

NAMESPACE

@@ -60,6 +60,7 @@ importFrom(dplyr,ungroup)
 importFrom(dplyr,vars)
 importFrom(inbodb,connect_inbo_dbase)
 importFrom(inbodb,dbDisconnect)
+importFrom(lifecycle,deprecated)
 importFrom(lubridate,as_date)
 importFrom(lubridate,day)
 importFrom(lubridate,dmy)

R/connect_watina.R

@@ -20,7 +20,7 @@
 #' @export
 #' @importFrom inbodb connect_inbo_dbase
 connect_watina <- function() {
-  connect_inbo_dbase("W0002_00_Watina", autoconvert_utf8 = TRUE)
+  connect_inbo_dbase("W0002_10_Watina")
 }
 
 

R/get.R

@@ -130,9 +130,9 @@
 #' @param loc_type Type of the location (mainly: the type of measurement
 #'   device). Defaults to \code{"P"}, i.e. only groundwater piezometers are
 #'   returned by default. Can be a vector with multiple selected values.
-#' @param loc_validity Validation status of the location. Can be a vector with
-#'   multiple selected values, which must belong to \code{"VLD"}, \code{"ENT"},
-#'   \code{"DEL"} or \code{"CLD"}. Defaults to \code{c("VLD", "ENT")}.
+#' @param loc_validity Validation status of the location. The new DWH only
+#'   contains records with status \code{"VLD"}. This argument is deprecated and
+#'   will be removed in a future version.
 #' @param loc_vec An optional vector with location codes. If provided, only
 #'   locations are returned that are present in this vector.
 #' @param collect Should the data be retrieved as a local tibble? If
@@ -287,6 +287,7 @@
 #' @importFrom assertthat assert_that is.number is.flag noNA
 #' @importFrom dplyr %>% tbl filter left_join select distinct arrange group_by
 #'   ungroup sql
+#' @importFrom lifecycle deprecated
 # FUNCTION GET LOCS ------------------------------------------------------------
 get_locs <- function(
   con,
@@ -306,10 +307,24 @@ get_locs <- function(
   bbox = NULL,
   area_codes = NULL,
   loc_type = c("P", "S", "R", "N", "W", "D", "L", "B"),
-  loc_validity = c("VLD", "ENT"),
+  loc_validity = "VLD",
   loc_vec = NULL,
   collect = FALSE
 ) {
+  if (!missing(loc_validity) && !identical(loc_validity, "VLD")) {
+    lifecycle::deprecate_warn(
+      when = "1.0.0",
+      what = "get_locs(loc_validity)",
+      details = paste(
+        "The new DWH only contains records with validity status 'VLD'. Your",
+        "input will be ignored. This argument will be removed in a future",
+        "version."
+      )
+    )
+  }
+
+  loc_validity <- "VLD"
+
   assert_that(
     is.numeric(filterdepth_range),
     length(filterdepth_range) == 2,
@@ -373,113 +388,18 @@ get_locs <- function(
     msg = "You specified at least one unknown loc_validity."
   )
 
+  locs <- build_locs_query(
+    con = con,
+    bbox = bbox,
+    area_codes = area_codes,
+    loc_type = loc_type,
+    loc_validity = loc_validity,
+    loc_vec = loc_vec
+  )
+
   min_filterdepth <- filterdepth_range[1]
   max_filterdepth <- filterdepth_range[2]
 
-  locs <-
-    tbl(con, "vwDimMeetpunt") %>%
-    filter(
-      .data$MeetpuntTypeCode %in% loc_type,
-      .data$MeetpuntStatusCode %in% loc_validity
-    ) %>%
-    left_join(
-      tbl(con, "vwDimGebied") %>%
-        select(
-          .data$GebiedWID,
-          .data$GebiedCode,
-          .data$GebiedNaam
-        ),
-      by = "GebiedWID"
-    )
-
-  if (!is.null(loc_vec)) {
-    locs <-
-      locs %>%
-      filter(.data$MeetpuntCode %in% loc_vec)
-  }
-
-  if (!is.null(area_codes)) {
-    locs <-
-      locs %>%
-      filter(.data$GebiedCode %in% area_codes)
-  }
-
-  if (!is.null(bbox)) {
-    bbox_xmin <- unname(bbox["xmin"])
-    bbox_xmax <- unname(bbox["xmax"])
-    bbox_ymin <- unname(bbox["ymin"])
-    bbox_ymax <- unname(bbox["ymax"])
-    locs <-
-      locs %>%
-      filter(
-        .data$MeetpuntXCoordinaat >= bbox_xmin,
-        .data$MeetpuntXCoordinaat <= bbox_xmax,
-        .data$MeetpuntYCoordinaat >= bbox_ymin,
-        .data$MeetpuntYCoordinaat <= bbox_ymax
-      )
-  }
-
-  locs <-
-    locs %>%
-    left_join(
-      tbl(con, "vwDimPeilpunt") %>%
-        filter(
-          .data$PeilpuntStatusCode %in%
-            c(
-              "VLD",
-              "ENT",
-              "CLD"
-            ),
-          .data$PeilpuntOpenbaarheidTypeCode == "PLME",
-          .data$PeilpuntOpenbaarheidCode == "UNKWN"
-        ) %>%
-        mutate(
-          PeilpuntPlaatsing = sql("CAST(PeilpuntPlaatsing AS date)"),
-          PeilpuntStopzetting = sql("CAST(PeilpuntStopzetting AS date)")
-        ),
-      by = "MeetpuntWID"
-    ) %>%
-    mutate(
-      tubelength = ifelse(
-        .data$PeilbuisLengte <= 0,
-        NA,
-        .data$PeilbuisLengte
-      ),
-      filterlength = ifelse(
-        is.na(.data$FilterLengte) | .data$FilterLengte == 0,
-        0.3,
-        .data$FilterLengte
-      ),
-      filterdepth = .data$tubelength -
-        .data$ReferentieNiveauMaaiveld -
-        .data$filterlength / 2,
-      soilsurf_ost = .data$ReferentieNiveauTAW -
-        .data$ReferentieNiveauMaaiveld
-    ) %>%
-    select(
-      loc_wid = .data$MeetpuntWID,
-      loc_code = .data$MeetpuntCode,
-      area_code = .data$GebiedCode,
-      area_name = .data$GebiedNaam,
-      x = .data$MeetpuntXCoordinaat,
-      y = .data$MeetpuntYCoordinaat,
-      loc_validitycode = .data$MeetpuntStatusCode,
-      loc_validity = .data$MeetpuntStatus,
-      loc_typecode = .data$MeetpuntTypeCode,
-      loc_typename = .data$MeetpuntType,
-      obswell_code = .data$PeilpuntCode,
-      obswell_rank = .data$PeilpuntVersie,
-      obswell_statecode = .data$PeilpuntToestandCode,
-      obswell_state = .data$PeilpuntToestandNaam,
-      obswell_installdate = .data$PeilpuntPlaatsing,
-      obswell_stopdate = .data$PeilpuntStopzetting,
-      .data$soilsurf_ost,
-      measuringref_ost = .data$ReferentieNiveauTAW,
-      .data$tubelength,
-      .data$filterlength,
-      .data$filterdepth
-    )
-
   if (filterdepth_guess) {
     locs <-
       locs %>%
@@ -626,6 +546,7 @@ get_locs <- function(
         -.data$obswell_maxrank,
         -.data$obswell_maxrank_fd,
         -.data$obswell_maxrank_sso
+        # Should we exclude obswell_validity from this output?
       )
   }
 
@@ -698,6 +619,113 @@ get_locs <- function(
   return(locs)
 }
 
+build_locs_query <- function(
+  con,
+  bbox,
+  area_codes,
+  loc_type,
+  loc_validity,
+  loc_vec
+) {
+  locs <-
+    tbl(con, "DimMeetpunt") %>%
+    filter(
+      .data$MeetpuntTypeCode %in% loc_type,
+      .data$MeetpuntStatusCode %in% loc_validity
+    ) %>%
+    left_join(
+      tbl(con, "DimGebied") %>%
+        select(
+          .data$GebiedWID,
+          .data$GebiedCode,
+          .data$GebiedNaam
+        ),
+      by = "GebiedWID"
+    )
+
+  if (!is.null(loc_vec)) {
+    locs <-
+      locs %>%
+      filter(.data$MeetpuntCode %in% loc_vec)
+  }
+
+  if (!is.null(area_codes)) {
+    locs <-
+      locs %>%
+      filter(.data$GebiedCode %in% area_codes)
+  }
+
+  if (!is.null(bbox)) {
+    bbox_xmin <- unname(bbox["xmin"])
+    bbox_xmax <- unname(bbox["xmax"])
+    bbox_ymin <- unname(bbox["ymin"])
+    bbox_ymax <- unname(bbox["ymax"])
+    locs <-
+      locs %>%
+      filter(
+        .data$MeetpuntXCoordinaat >= bbox_xmin,
+        .data$MeetpuntXCoordinaat <= bbox_xmax,
+        .data$MeetpuntYCoordinaat >= bbox_ymin,
+        .data$MeetpuntYCoordinaat <= bbox_ymax
+      )
+  }
+
+  locs <-
+    locs %>%
+    left_join(
+      tbl(con, "DimPeilpunt") %>%
+        mutate(
+          PeilpuntPlaatsing = sql("CAST(PeilpuntPlaatsing AS date)"),
+          PeilpuntStopzetting = sql("CAST(PeilpuntStopzetting AS date)")
+        ),
+      by = "MeetpuntWID"
+    ) %>%
+    mutate(
+      tubelength = ifelse(
+        .data$PeilbuisLengte <= 0,
+        NA,
+        .data$PeilbuisLengte
+      ),
+      filterlength = ifelse(
+        is.na(.data$FilterLengte) | .data$FilterLengte == 0,
+        0.3,
+        .data$FilterLengte
+      ),
+      filterdepth = .data$tubelength -
+        .data$ReferentieNiveauMaaiveld -
+        .data$filterlength / 2,
+      soilsurf_ost = .data$ReferentieNiveauTAW -
+        .data$ReferentieNiveauMaaiveld
+    ) %>%
+    select(
+      loc_wid = .data$MeetpuntWID,
+      loc_code = .data$MeetpuntCode,
+      area_code = .data$GebiedCode,
+      area_name = .data$GebiedNaam,
+      x = .data$MeetpuntXCoordinaat,
+      y = .data$MeetpuntYCoordinaat,
+      loc_validitycode = .data$MeetpuntStatusCode,
+      loc_validity = .data$MeetpuntStatus,
+      loc_typecode = .data$MeetpuntTypeCode,
+      loc_typename = .data$MeetpuntType,
+      obswell_code = .data$PeilpuntCode,
+      obswell_rank = .data$PeilpuntVersie,
+      obswell_statecode = .data$PeilpuntToestandCode,
+      obswell_state = .data$PeilpuntToestandNaam,
+      # Is this column necessary in the output?
+      obswell_validity = .data$PeilpuntStatusCode,
+      obswell_installdate = .data$PeilpuntPlaatsing,
+      obswell_stopdate = .data$PeilpuntStopzetting,
+      .data$soilsurf_ost,
+      measuringref_ost = .data$ReferentieNiveauTAW,
+      .data$tubelength,
+      .data$filterlength,
+      .data$filterdepth
+    )
+
+  return(locs)
+}
+
 # DOOCUMENTATION GET XG3 -------------------------------------------------------
 #' Get XG3 values from the data warehouse
 #'