diff --git a/R/get.R b/R/get.R index 9ba0210..2b0eacc 100644 --- a/R/get.R +++ b/R/get.R @@ -742,10 +742,6 @@ build_locs_query <- function( #' The timeframe is a selection interval between a given first and last #' hydroyear. #' -#' Note: the arguments \code{truncated} and \code{with_estimated} are currently -#' not used. Currently, non-truncated values are returned, with usage of -#' estimated values. -#' #' (TO BE ADDED: What are XG3 values? What is a hydroyear? Why truncate, and why #' truncate by default? When to choose which \code{vert_crs}?) #' @@ -753,8 +749,9 @@ build_locs_query <- function( #' \code{loc_code} that defines the locations for which values are to be #' returned. Typically, this will be the object returned by #' \code{\link{get_locs}}. +#' @param con A database connection object to the Watina data warehouse. #' @param startyear First hydroyear of the timeframe. -#' @param endyear Last hydroyear of the timeframe. +#' @param endyear Last hydroyear of the timeframe. Defaults to the previous calendar year. #' @param vert_crs A string, defining the 1-dimensional vertical coordinate #' reference system (CRS) of the XG3 water levels. Either \code{"local"} (the #' default, i.e. returned values are relative to soil surface level, with @@ -764,13 +761,15 @@ build_locs_query <- function( #' height} (EPSG \href{https://epsg.io/5710}{5710}), also known as 'TAW' or #' 'DNG'), or \code{"both"}, where the values for both CRS options are #' returned. The units are always meters. -#' @param truncated Logical. If \code{TRUE} (the default), the XG3 values are -#' calculated after having set the underlying water level measurements that -#' are above soil surface level to the soil surface level itself (which is -#' zero in the case of the local CRS). -#' @param with_estimated Logical. If \code{TRUE} (the default), the XG3 values -#' calculations also use estimated (i.e. non-measured) water level data that -#' are available in the data warehouse. +#' @param truncated Logical. If \code{TRUE}, the XG3 values are calculated +#' after having capped the underlying water level measurements that are above +#' soil surface level to the soil surface level itself (zero in the local CRS). +#' Defaults to \code{FALSE}. +#' @param with_estimated Logical. If \code{TRUE}, the XG3 calculation includes +#' estimated or simulated (e.g. Menyanthes model) water level data alongside +#' raw measurements. Defaults to \code{FALSE}. +#' @param collect Logical. If \code{TRUE}, the lazy query is executed and +#' brought into local R memory as a tibble. Defaults to \code{FALSE}. #' #' @inheritParams get_locs #' @@ -833,8 +832,8 @@ get_xg3 <- function( startyear, endyear = year(now()) - 1, vert_crs = c("local", "ostend", "both"), - truncated = TRUE, - with_estimated = TRUE, + truncated = FALSE, + with_estimated = FALSE, collect = FALSE ) { vert_crs <- match.arg(vert_crs) @@ -851,6 +850,44 @@ get_xg3 <- function( assert_that(is.flag(truncated), assertthat::noNA(truncated)) assert_that(is.flag(collect), assertthat::noNA(collect)) + xg3 <- build_xg3_query( + locs, + con, + startyear, + endyear, + truncated, + with_estimated + ) + + xg3 <- + switch( + vert_crs, + local = xg3 %>% select(-contains("ost")), + ostend = xg3 %>% select(-contains("lcl")), + both = xg3 + ) + + if (collect) { + xg3 <- + xg3 %>% + arrange( + .data$loc_code, + .data$hydroyear + ) %>% + collect() + } + + return(xg3) +} + +build_xg3_query <- function( + locs, + con, + startyear, + endyear, + truncated, + with_estimated +) { if (inherits(locs, "data.frame")) { locs <- locs %>% @@ -870,7 +907,7 @@ get_xg3 <- function( "#locs" ) %>% inner_join( - tbl(con, "vwDimMeetpunt") %>% + tbl(con, "DimMeetpunt") %>% select( loc_wid = .data$MeetpuntWID, loc_code = .data$MeetpuntCode @@ -880,25 +917,70 @@ get_xg3 <- function( ) } + param_query <- tbl(con, "DimParameterSet") %>% + filter( + .data$IsAfgetopt == truncated, + .data$IsEstimated == with_estimated + ) + + matching_params <- param_query %>% collect() + param_count <- nrow(matching_params) + + str_settings <- sprintf( + "settings truncated = '%s' and with_estimated = '%s'", + truncated, + with_estimated + ) + + if (param_count == 0) { + stop( + sprintf( + "No parameters found with %s", + str_settings + ), + call. = FALSE + ) + } + if (param_count > 1) { + str_param_options <- paste0(matching_params$Omschrijving, collapse = ", ") + + selected_id <- max((matching_params$ParameterSetWID)) + selected_option <- matching_params$Omschrijving[ + matching_params$ParameterSetWID == selected_id + ] + + message(sprintf( + "Multiple parameter options found with %s. The options are: %s. Option '%s' selected. Contact package maintainer if another parameter should be selected and extra filters are needed. Maybe create your first issue?", + str_settings, + str_param_options, + selected_option + )) + + param_query <- param_query %>% + filter(.data$ParameterSetWID == selected_id) + } + xg3 <- - tbl(con, "ssrs_Precalc") %>% - # left_join(tbl(con, "DimMetingType"), - # by = "MetingTypeWID") %>% - select( - loc_wid = .data$MeetpuntWID, - hydroyear = .data$HydroJaar, - # method_code = .data$MetingTypeCode, - # method_name = .data$MetingTypeNaam, - lg3_lcl = .data$GLG_2, - hg3_lcl = .data$GHG_2, - vg3_lcl = .data$GVG_2, - lg3_ost = .data$GLG_1, - hg3_ost = .data$GHG_1, - vg3_ost = .data$GVG_1 + tbl(con, "FactBRPeilMetingJaar") %>% + inner_join( + param_query, + by = "ParameterSetWID" ) %>% filter( - .data$hydroyear >= startyear, - .data$hydroyear <= endyear + # CRITICAL: Keep only Hydroyears + .data$IsHydroJaar == 1, + .data$Jaar >= startyear, + .data$Jaar <= endyear + ) %>% + select( + loc_wid = .data$MeetpuntWID, + hydroyear = .data$Jaar, + lg3_lcl = .data$LGmMaaiVeldValue, + hg3_lcl = .data$HGmMaaiVeldValue, + vg3_lcl = .data$VGmMaaiVeldValue, + lg3_ost = .data$LGmTAWValue, + hg3_ost = .data$HGmTAWValue, + vg3_ost = .data$VGmTAWValue ) %>% inner_join( locs %>% @@ -912,24 +994,6 @@ get_xg3 <- function( ) %>% select(-.data$loc_wid) - xg3 <- - switch( - vert_crs, - local = xg3 %>% select(-contains("ost")), - ostend = xg3 %>% select(-contains("lcl")), - both = xg3 - ) - - if (collect) { - xg3 <- - xg3 %>% - arrange( - .data$loc_code, - .data$hydroyear - ) %>% - collect() - } - return(xg3) } diff --git a/man/get_xg3.Rd b/man/get_xg3.Rd index 3cd59a4..d219ac9 100644 --- a/man/get_xg3.Rd +++ b/man/get_xg3.Rd @@ -10,8 +10,8 @@ get_xg3( startyear, endyear = year(now()) - 1, vert_crs = c("local", "ostend", "both"), - truncated = TRUE, - with_estimated = TRUE, + truncated = FALSE, + with_estimated = FALSE, collect = FALSE ) } @@ -126,7 +126,7 @@ dbDisconnect(watina) } \seealso{ -Other functions to query the data warehouse: +Other functions to query the data warehouse: \code{\link{get_chem}()}, \code{\link{get_locs}()} }