diff --git a/R/cli_style.R b/R/cli_style.R index abc69ae..c45b64d 100644 --- a/R/cli_style.R +++ b/R/cli_style.R @@ -10,7 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - ## drawing heavily from the tidyverse package done <- function(msg) { diff --git a/R/data.R b/R/data.R index 5e4225c..b30eb45 100644 --- a/R/data.R +++ b/R/data.R @@ -10,7 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - #' All Canadian stations #' #' A shorthand to avoid having always call `hy_stations` or `realtime_stations`. @@ -66,7 +65,7 @@ #' @title Parameter ID #' #' @description A tibble of parameter id codes and their corresponding explanation/description specific to the ECCC webservice -#' +#' #' @format A tibble with 8 rows and 7 variables: #' \describe{ #' \item{Parameter}{Numeric parameter code} diff --git a/R/download.R b/R/download.R index 4b3ed3b..00c6552 100644 --- a/R/download.R +++ b/R/download.R @@ -34,13 +34,14 @@ download_hydat <- function(dl_hydat_here = NULL, ask = TRUE) { if (!dir.exists(dl_hydat_here)) { dir.create(dl_hydat_here) message(crayon::blue("You have downloaded hydat to", dl_hydat_here)) - message(crayon::blue("See ?hy_set_default_db to change where tidyhydat looks for HYDAT")) + message(crayon::blue( + "See ?hy_set_default_db to change where tidyhydat looks for HYDAT" + )) } } if (!is.logical(ask)) stop("Parameter ask must be a logical") - ## Create actual hydat_path hydat_path <- file.path(dl_hydat_here, "Hydat.sqlite3") @@ -52,7 +53,6 @@ download_hydat <- function(dl_hydat_here = NULL, ask = TRUE) { existing_hydat <- "HYDAT not present" } - new_hydat <- hy_remote() # Make the download URL url <- paste0(hy_base_url(), "Hydat_sqlite3_", new_hydat, ".zip") @@ -62,18 +62,23 @@ download_hydat <- function(dl_hydat_here = NULL, ask = TRUE) { req <- tidyhydat_perform(req) httr2::resp_check_status(req) - size <- round(as.numeric( - httr2::resp_header(req, "Content-Length") - ) / 1000000, 0) - + size <- round( + as.numeric( + httr2::resp_header(req, "Content-Length") + ) / + 1000000, + 0 + ) ## Do we need to download a new version? - if (new_hydat == existing_hydat & ask) { # DB exists and no new version + if (new_hydat == existing_hydat & ask) { + # DB exists and no new version msg <- paste0( "The existing local version of HYDAT, published on ", lubridate::ymd(existing_hydat), ", is the most recent version available. \nDo you wish to overwrite it? \nDownloading HYDAT could take up to 10 minutes (", - size, " MB)." + size, + " MB)." ) dl_overwrite <- ask(msg) } else { @@ -81,11 +86,16 @@ download_hydat <- function(dl_hydat_here = NULL, ask = TRUE) { } if (!dl_overwrite) { - info("HYDAT is updated on a quarterly basis, check again soon for an updated version.") + info( + "HYDAT is updated on a quarterly basis, check again soon for an updated version." + ) } - if (new_hydat != existing_hydat & ask) { # New DB available or no local DB at all + if (new_hydat != existing_hydat & ask) { + # New DB available or no local DB at all msg <- paste0( - "This version of HYDAT is ", size, "MB in size and will take some time to download. + "This version of HYDAT is ", + size, + "MB in size and will take some time to download. \nThis will remove any older versions of HYDAT, if applicable. \nIs that okay?" ) ans <- ask(msg) @@ -99,12 +109,18 @@ download_hydat <- function(dl_hydat_here = NULL, ask = TRUE) { green_message(paste0("Downloading HYDAT to ", dl_hydat_here)) } - if (dl_overwrite) { if (new_hydat == existing_hydat) { - info(paste0("Your local copy of HYDAT published on ", crayon::blue(lubridate::ymd(new_hydat)), " will be overwritten.")) + info(paste0( + "Your local copy of HYDAT published on ", + crayon::blue(lubridate::ymd(new_hydat)), + " will be overwritten." + )) } else { - info(paste0("Downloading new version of HYDAT created on ", crayon::blue(lubridate::ymd(new_hydat)))) + info(paste0( + "Downloading new version of HYDAT created on ", + crayon::blue(lubridate::ymd(new_hydat)) + )) } ## temporary path to save @@ -130,7 +146,6 @@ download_hydat <- function(dl_hydat_here = NULL, ask = TRUE) { overwrite = TRUE ) - if (file.exists(hydat_path)) { congrats("HYDAT successfully downloaded") } else { @@ -160,10 +175,10 @@ hy_remote <- function() { req <- tidyhydat_perform(req) resp <- httr2::resp_check_status(req) - raw_date <- substr( gsub("^.*\\Hydat_sqlite3_", "", httr2::resp_body_string(req)), - 1, 8 + 1, + 8 ) raw_date @@ -182,7 +197,6 @@ hy_check <- function(hydat_path = NULL) { red_message(paste0(tbl_diff, "\n")) } - invisible(lapply(have_tbls, function(x) { tbl_rows <- dplyr::tbl(con, x) |> utils::head(1) |> diff --git a/R/hy-classes.R b/R/hy-classes.R index e007aff..34aa2c7 100644 --- a/R/hy-classes.R +++ b/R/hy-classes.R @@ -25,7 +25,11 @@ print.hy <- function(x, ...) { } summary_msg <- function(x) { - cat(paste0(" Queried from version of HYDAT released on ", as.Date(hy_version()$Date), "\n")) + cat(paste0( + " Queried from version of HYDAT released on ", + as.Date(hy_version()$Date), + "\n" + )) n_records <- format(nrow(x), big.mark = ",") cat(paste0(" Observations: ", n_records, "\n")) @@ -36,11 +40,19 @@ summary_msg <- function(x) { } if ("PROV_TERR_STATE_LOC" %in% names(x)) { - cat(paste0(" Jurisdictions: ", paste0(unique(x$PROV_TERR_STATE_LOC), collapse = ", "), "\n")) + cat(paste0( + " Jurisdictions: ", + paste0(unique(x$PROV_TERR_STATE_LOC), collapse = ", "), + "\n" + )) } if ("Parameter" %in% names(x)) { - cat(paste0(" Parameter(s): ", paste0(unique(x$Parameter), collapse = "/"), "\n")) + cat(paste0( + " Parameter(s): ", + paste0(unique(x$Parameter), collapse = "/"), + "\n" + )) } } @@ -58,12 +70,17 @@ missed_station_msg <- function(x) { cat(" Stations requested but not returned: \n") if (length(differ) != 0) { if (length(differ) > 50) { - cat(crayon::cyan(" More than 50 stations requested but not returned. \n")) - cat(crayon::cyan(paste0(" See object attributes for complete list of missing stations.\n"))) + cat(crayon::cyan( + " More than 50 stations requested but not returned. \n" + )) + cat(crayon::cyan(paste0( + " See object attributes for complete list of missing stations.\n" + ))) } else { cat( crayon::cyan( - paste0(" ", + paste0( + " ", strwrap( paste0(differ, collapse = " "), width = 40 diff --git a/R/hy.R b/R/hy.R index b79fc48..0934d5f 100644 --- a/R/hy.R +++ b/R/hy.R @@ -20,9 +20,11 @@ #' hy_stn_remarks(station_number = c("02JE013", "08MF005")) #' } #' -hy_stn_remarks <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL) { +hy_stn_remarks <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -37,14 +39,25 @@ hy_stn_remarks <- function(station_number = NULL, stn_remarks <- dplyr::tbl(hydat_con, "STN_REMARKS") stn_remarks <- dplyr::filter(stn_remarks, !!sym_STATION_NUMBER %in% stns) - stn_remarks <- dplyr::left_join(stn_remarks, dplyr::tbl(hydat_con, "STN_REMARK_CODES"), by = c("REMARK_TYPE_CODE")) - stn_remarks <- dplyr::select(stn_remarks, STATION_NUMBER, - REMARK_TYPE = REMARK_TYPE_EN, Year = YEAR, REMARK = REMARK_EN + stn_remarks <- dplyr::left_join( + stn_remarks, + dplyr::tbl(hydat_con, "STN_REMARK_CODES"), + by = c("REMARK_TYPE_CODE") + ) + stn_remarks <- dplyr::select( + stn_remarks, + STATION_NUMBER, + REMARK_TYPE = REMARK_TYPE_EN, + Year = YEAR, + REMARK = REMARK_EN ) stn_remarks <- dplyr::collect(stn_remarks) - attr(stn_remarks, "missed_stns") <- setdiff(unique(stns), unique(stn_remarks$STATION_NUMBER)) + attr(stn_remarks, "missed_stns") <- setdiff( + unique(stns), + unique(stn_remarks$STATION_NUMBER) + ) as.hy(stn_remarks) } @@ -70,8 +83,11 @@ hy_stn_remarks <- function(station_number = NULL, #' \dontrun{ #' hy_stn_datum_conv(station_number = c("02JE013", "08MF005")) #' } -hy_stn_datum_conv <- function(station_number = NULL, - hydat_path = NULL, prov_terr_state_loc = NULL) { +hy_stn_datum_conv <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -86,19 +102,42 @@ hy_stn_datum_conv <- function(station_number = NULL, sym_DATUM_EN <- sym("DATUM_EN") stn_datum_conversion <- dplyr::tbl(hydat_con, "STN_DATUM_CONVERSION") - stn_datum_conversion <- dplyr::filter(stn_datum_conversion, !!sym_STATION_NUMBER %in% stns) - stn_datum_conversion <- dplyr::left_join(stn_datum_conversion, dplyr::tbl(hydat_con, "DATUM_LIST"), by = c("DATUM_ID_FROM" = "DATUM_ID")) - stn_datum_conversion <- dplyr::rename(stn_datum_conversion, DATUM_EN_FROM = !!sym_DATUM_EN) - stn_datum_conversion <- dplyr::left_join(stn_datum_conversion, dplyr::tbl(hydat_con, "DATUM_LIST"), by = c("DATUM_ID_TO" = "DATUM_ID")) - stn_datum_conversion <- dplyr::rename(stn_datum_conversion, DATUM_EN_TO = !!sym_DATUM_EN) - stn_datum_conversion <- dplyr::select(stn_datum_conversion, STATION_NUMBER, + stn_datum_conversion <- dplyr::filter( + stn_datum_conversion, + !!sym_STATION_NUMBER %in% stns + ) + stn_datum_conversion <- dplyr::left_join( + stn_datum_conversion, + dplyr::tbl(hydat_con, "DATUM_LIST"), + by = c("DATUM_ID_FROM" = "DATUM_ID") + ) + stn_datum_conversion <- dplyr::rename( + stn_datum_conversion, + DATUM_EN_FROM = !!sym_DATUM_EN + ) + stn_datum_conversion <- dplyr::left_join( + stn_datum_conversion, + dplyr::tbl(hydat_con, "DATUM_LIST"), + by = c("DATUM_ID_TO" = "DATUM_ID") + ) + stn_datum_conversion <- dplyr::rename( + stn_datum_conversion, + DATUM_EN_TO = !!sym_DATUM_EN + ) + stn_datum_conversion <- dplyr::select( + stn_datum_conversion, + STATION_NUMBER, DATUM_FROM = DATUM_EN_FROM, - DATUM_TO = DATUM_EN_TO, CONVERSION_FACTOR + DATUM_TO = DATUM_EN_TO, + CONVERSION_FACTOR ) stn_datum_conversion <- dplyr::collect(stn_datum_conversion) - attr(stn_datum_conversion, "missed_stns") <- setdiff(unique(stns), unique(stn_datum_conversion$STATION_NUMBER)) + attr(stn_datum_conversion, "missed_stns") <- setdiff( + unique(stns), + unique(stn_datum_conversion$STATION_NUMBER) + ) as.hy(stn_datum_conversion) } @@ -123,8 +162,11 @@ hy_stn_datum_conv <- function(station_number = NULL, #' hy_stn_datum_unrelated() #' } #' -hy_stn_datum_unrelated <- function(station_number = NULL, - hydat_path = NULL, prov_terr_state_loc = NULL) { +hy_stn_datum_unrelated <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -138,15 +180,29 @@ hy_stn_datum_unrelated <- function(station_number = NULL, sym_STATION_NUMBER <- sym("STATION_NUMBER") stn_datum_unrelated <- dplyr::tbl(hydat_con, "STN_DATUM_UNRELATED") - stn_datum_unrelated <- dplyr::filter(stn_datum_unrelated, !!sym_STATION_NUMBER %in% stns) + stn_datum_unrelated <- dplyr::filter( + stn_datum_unrelated, + !!sym_STATION_NUMBER %in% stns + ) stn_datum_unrelated <- dplyr::collect(stn_datum_unrelated) - stn_datum_unrelated$YEAR_FROM <- lubridate::ymd(as.Date(stn_datum_unrelated$YEAR_FROM)) - stn_datum_unrelated$YEAR_TO <- lubridate::ymd(as.Date(stn_datum_unrelated$YEAR_TO)) - - stn_datum_unrelated <- dplyr::rename(stn_datum_unrelated, Year_from = YEAR_FROM, Year_to = YEAR_TO) + stn_datum_unrelated$YEAR_FROM <- lubridate::ymd(as.Date( + stn_datum_unrelated$YEAR_FROM + )) + stn_datum_unrelated$YEAR_TO <- lubridate::ymd(as.Date( + stn_datum_unrelated$YEAR_TO + )) + + stn_datum_unrelated <- dplyr::rename( + stn_datum_unrelated, + Year_from = YEAR_FROM, + Year_to = YEAR_TO + ) - attr(stn_datum_unrelated, "missed_stns") <- setdiff(unique(stns), unique(stn_datum_unrelated$STATION_NUMBER)) + attr(stn_datum_unrelated, "missed_stns") <- setdiff( + unique(stns), + unique(stn_datum_unrelated$STATION_NUMBER) + ) as.hy(stn_datum_unrelated) } @@ -175,9 +231,11 @@ hy_stn_datum_unrelated <- function(station_number = NULL, #' hy_stn_data_range(station_number = c("02JE013", "08MF005")) #' } #' -hy_stn_data_range <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL) { +hy_stn_data_range <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -191,15 +249,27 @@ hy_stn_data_range <- function(station_number = NULL, sym_STATION_NUMBER <- sym("STATION_NUMBER") stn_data_range <- dplyr::tbl(hydat_con, "STN_DATA_RANGE") - stn_data_range <- dplyr::filter(stn_data_range, !!sym_STATION_NUMBER %in% stns) + stn_data_range <- dplyr::filter( + stn_data_range, + !!sym_STATION_NUMBER %in% stns + ) stn_data_range <- dplyr::collect(stn_data_range) - stn_data_range[stn_data_range$SED_DATA_TYPE == "NA", ]$SED_DATA_TYPE <- NA_character_ + stn_data_range[ + stn_data_range$SED_DATA_TYPE == "NA", + ]$SED_DATA_TYPE <- NA_character_ - stn_data_range <- dplyr::rename(stn_data_range, Year_from = YEAR_FROM, Year_to = YEAR_TO) + stn_data_range <- dplyr::rename( + stn_data_range, + Year_from = YEAR_FROM, + Year_to = YEAR_TO + ) - attr(stn_data_range, "missed_stns") <- setdiff(unique(stns), unique(stn_data_range$STATION_NUMBER)) + attr(stn_data_range, "missed_stns") <- setdiff( + unique(stns), + unique(stn_data_range$STATION_NUMBER) + ) as.hy(stn_data_range) } @@ -230,8 +300,11 @@ hy_stn_data_range <- function(station_number = NULL, #' hy_stn_data_coll(station_number = c("02JE013", "08MF005")) #' } #' -hy_stn_data_coll <- function(station_number = NULL, - hydat_path = NULL, prov_terr_state_loc = NULL) { +hy_stn_data_coll <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -246,19 +319,38 @@ hy_stn_data_coll <- function(station_number = NULL, stn_data_coll <- dplyr::tbl(hydat_con, "STN_DATA_COLLECTION") stn_data_coll <- dplyr::filter(stn_data_coll, !!sym_STATION_NUMBER %in% stns) - stn_data_coll <- dplyr::left_join(stn_data_coll, dplyr::tbl(hydat_con, "MEASUREMENT_CODES"), by = c("MEASUREMENT_CODE")) - stn_data_coll <- dplyr::left_join(stn_data_coll, dplyr::tbl(hydat_con, "OPERATION_CODES"), by = c("OPERATION_CODE")) + stn_data_coll <- dplyr::left_join( + stn_data_coll, + dplyr::tbl(hydat_con, "MEASUREMENT_CODES"), + by = c("MEASUREMENT_CODE") + ) + stn_data_coll <- dplyr::left_join( + stn_data_coll, + dplyr::tbl(hydat_con, "OPERATION_CODES"), + by = c("OPERATION_CODE") + ) stn_data_coll <- dplyr::collect(stn_data_coll) - stn_data_coll <- dplyr::left_join(stn_data_coll, tidyhydat::hy_data_types, by = c("DATA_TYPE")) - stn_data_coll <- dplyr::select(stn_data_coll, STATION_NUMBER, + stn_data_coll <- dplyr::left_join( + stn_data_coll, + tidyhydat::hy_data_types, + by = c("DATA_TYPE") + ) + stn_data_coll <- dplyr::select( + stn_data_coll, + STATION_NUMBER, DATA_TYPE = DATA_TYPE_EN, - Year_from = YEAR_FROM, Year_to = YEAR_TO, - MEASUREMENT = MEASUREMENT_EN, OPERATION = OPERATION_EN + Year_from = YEAR_FROM, + Year_to = YEAR_TO, + MEASUREMENT = MEASUREMENT_EN, + OPERATION = OPERATION_EN ) stn_data_coll <- dplyr::arrange(stn_data_coll, STATION_NUMBER, Year_from) - attr(stn_data_coll, "missed_stns") <- setdiff(unique(stns), unique(stn_data_coll$STATION_NUMBER)) + attr(stn_data_coll, "missed_stns") <- setdiff( + unique(stns), + unique(stn_data_coll$STATION_NUMBER) + ) as.hy(stn_data_coll) } @@ -287,9 +379,11 @@ hy_stn_data_coll <- function(station_number = NULL, #' hy_stn_op_schedule(station_number = c("02JE013")) #' } #' -hy_stn_op_schedule <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL) { +hy_stn_op_schedule <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -303,16 +397,30 @@ hy_stn_op_schedule <- function(station_number = NULL, sym_STATION_NUMBER <- sym("STATION_NUMBER") stn_operation_schedule <- dplyr::tbl(hydat_con, "STN_OPERATION_SCHEDULE") - stn_operation_schedule <- dplyr::filter(stn_operation_schedule, !!sym_STATION_NUMBER %in% stns) + stn_operation_schedule <- dplyr::filter( + stn_operation_schedule, + !!sym_STATION_NUMBER %in% stns + ) stn_operation_schedule <- dplyr::collect(stn_operation_schedule) - stn_operation_schedule <- dplyr::left_join(stn_operation_schedule, tidyhydat::hy_data_types, by = c("DATA_TYPE")) + stn_operation_schedule <- dplyr::left_join( + stn_operation_schedule, + tidyhydat::hy_data_types, + by = c("DATA_TYPE") + ) - stn_operation_schedule <- dplyr::select(stn_operation_schedule, STATION_NUMBER, - DATA_TYPE = DATA_TYPE_EN, Year = YEAR, - Month_from = MONTH_FROM, Month_to = MONTH_TO + stn_operation_schedule <- dplyr::select( + stn_operation_schedule, + STATION_NUMBER, + DATA_TYPE = DATA_TYPE_EN, + Year = YEAR, + Month_from = MONTH_FROM, + Month_to = MONTH_TO ) - attr(stn_operation_schedule, "missed_stns") <- setdiff(unique(stns), unique(stn_operation_schedule$STATION_NUMBER)) + attr(stn_operation_schedule, "missed_stns") <- setdiff( + unique(stns), + unique(stn_operation_schedule$STATION_NUMBER) + ) as.hy(stn_operation_schedule) } diff --git a/R/hy_annual_instant_peaks.R b/R/hy_annual_instant_peaks.R index 33befd6..737b570 100644 --- a/R/hy_annual_instant_peaks.R +++ b/R/hy_annual_instant_peaks.R @@ -10,7 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - #' Extract annual max/min instantaneous flows and water levels from HYDAT database #' #' Provides wrapper to turn the ANNUAL_INSTANT_PEAKS table in HYDAT into a tidy data frame of instantaneous flows and water levels. @@ -36,11 +35,13 @@ #' @source HYDAT #' @export #' -hy_annual_instant_peaks <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_year = NULL, - end_year = NULL) { +hy_annual_instant_peaks <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_year = NULL, + end_year = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -62,7 +63,11 @@ hy_annual_instant_peaks <- function(station_number = NULL, aip <- dplyr::left_join(aip, tidyhydat::hy_data_types, by = c("DATA_TYPE")) ## Add in Symbol - aip <- dplyr::left_join(aip, tidyhydat::hy_data_symbols, by = c("SYMBOL" = "SYMBOL_ID")) + aip <- dplyr::left_join( + aip, + tidyhydat::hy_data_symbols, + by = c("SYMBOL" = "SYMBOL_ID") + ) ## If a year is supplied... if (!is.null(start_year)) aip <- dplyr::filter(aip, YEAR >= start_year) @@ -72,37 +77,51 @@ hy_annual_instant_peaks <- function(station_number = NULL, aip <- dplyr::mutate(aip, PEAK_CODE = ifelse(PEAK_CODE == "H", "MAX", "MIN")) ## Parse PRECISION_CODE manually - there are only 2 - aip <- dplyr::mutate(aip, PRECISION_CODE = ifelse(PRECISION_CODE == 8, "in m (to mm)", "in m (to cm)")) + aip <- dplyr::mutate( + aip, + PRECISION_CODE = ifelse(PRECISION_CODE == 8, "in m (to mm)", "in m (to cm)") + ) ## Add in timezone information aip <- dplyr::left_join(aip, tidyhydat::allstations, by = c("STATION_NUMBER")) ## Convert to dttm ## Manually convert to UTC - aip <- dplyr::mutate(aip, Datetime = lubridate::make_datetime( - year = YEAR, - month = MONTH, - day = DAY, - hour = HOUR, - min = MINUTE - ) - lubridate::dhours(standard_offset)) - - aip <- dplyr::mutate(aip, Date = lubridate::make_date( - year = YEAR, - month = MONTH, - day = DAY - )) - + aip <- dplyr::mutate( + aip, + Datetime = lubridate::make_datetime( + year = YEAR, + month = MONTH, + day = DAY, + hour = HOUR, + min = MINUTE + ) - + lubridate::dhours(standard_offset) + ) + aip <- dplyr::mutate( + aip, + Date = lubridate::make_date( + year = YEAR, + month = MONTH, + day = DAY + ) + ) ## Clean up and select only columns we need - aip <- dplyr::select(aip, STATION_NUMBER, Datetime, Date, - station_tz = station_tz, Parameter = DATA_TYPE_EN, - Value = PEAK, PEAK_CODE, - PRECISION_CODE, Symbol = SYMBOL_EN + aip <- dplyr::select( + aip, + STATION_NUMBER, + Datetime, + Date, + station_tz = station_tz, + Parameter = DATA_TYPE_EN, + Value = PEAK, + PEAK_CODE, + PRECISION_CODE, + Symbol = SYMBOL_EN ) - attr(aip, "missed_stns") <- setdiff(unique(stns), unique(aip$STATION_NUMBER)) as.hy(aip) } diff --git a/R/hy_annual_stats.R b/R/hy_annual_stats.R index e2c466b..a4f35d0 100644 --- a/R/hy_annual_stats.R +++ b/R/hy_annual_stats.R @@ -10,7 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - #' Extract annual statistics information from the HYDAT database #' #' Provides wrapper to turn the ANNUAL_STATISTICS table in HYDAT into a tidy data frame of annual statistics. @@ -48,10 +47,13 @@ #' @source HYDAT #' @export -hy_annual_stats <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_year = "ALL", end_year = "ALL") { +hy_annual_stats <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_year = "ALL", + end_year = "ALL" +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -72,36 +74,81 @@ hy_annual_stats <- function(station_number = NULL, ## If a yearis supplied... if (start_year != "ALL" | end_year != "ALL") { - annual_statistics <- dplyr::filter(annual_statistics, !!sym_YEAR >= start_year & !!sym_YEAR <= end_year) + annual_statistics <- dplyr::filter( + annual_statistics, + !!sym_YEAR >= start_year & !!sym_YEAR <= end_year + ) } - annual_statistics <- dplyr::filter(annual_statistics, !!sym_STATION_NUMBER %in% stns) |> + annual_statistics <- dplyr::filter( + annual_statistics, + !!sym_STATION_NUMBER %in% stns + ) |> dplyr::collect() ## TODO: Figure out how to do this in fewer steps ## Mean tibble - as_mean <- dplyr::select(annual_statistics, STATION_NUMBER, DATA_TYPE, YEAR, MEAN) - as_mean <- tidyr::gather(as_mean, !!sym_SUM_STAT, !!sym_Value, -STATION_NUMBER, -DATA_TYPE, -YEAR) + as_mean <- dplyr::select( + annual_statistics, + STATION_NUMBER, + DATA_TYPE, + YEAR, + MEAN + ) + as_mean <- tidyr::gather( + as_mean, + !!sym_SUM_STAT, + !!sym_Value, + -STATION_NUMBER, + -DATA_TYPE, + -YEAR + ) ## Min tibble as_min <- dplyr::select( - annual_statistics, STATION_NUMBER, DATA_TYPE, YEAR, MIN_MONTH, - MIN_DAY, MIN, MIN_SYMBOL + annual_statistics, + STATION_NUMBER, + DATA_TYPE, + YEAR, + MIN_MONTH, + MIN_DAY, + MIN, + MIN_SYMBOL ) as_min <- tidyr::gather( - as_min, !!sym_SUM_STAT, !!sym_Value, -STATION_NUMBER, -DATA_TYPE, -YEAR, - -MIN_MONTH, -MIN_DAY, -MIN_SYMBOL + as_min, + !!sym_SUM_STAT, + !!sym_Value, + -STATION_NUMBER, + -DATA_TYPE, + -YEAR, + -MIN_MONTH, + -MIN_DAY, + -MIN_SYMBOL ) colnames(as_min) <- gsub("MIN_", "", names(as_min)) ## Max tibble as_max <- dplyr::select( - annual_statistics, STATION_NUMBER, DATA_TYPE, YEAR, MAX_MONTH, - MAX_DAY, MAX, MAX_SYMBOL + annual_statistics, + STATION_NUMBER, + DATA_TYPE, + YEAR, + MAX_MONTH, + MAX_DAY, + MAX, + MAX_SYMBOL ) as_max <- tidyr::gather( - as_max, !!sym_SUM_STAT, !!sym_Value, -STATION_NUMBER, -DATA_TYPE, -YEAR, -MAX_MONTH, - -MAX_DAY, -MAX_SYMBOL + as_max, + !!sym_SUM_STAT, + !!sym_Value, + -STATION_NUMBER, + -DATA_TYPE, + -YEAR, + -MAX_MONTH, + -MAX_DAY, + -MAX_SYMBOL ) colnames(as_max) <- gsub("MAX_", "", names(as_max)) @@ -113,21 +160,43 @@ hy_annual_stats <- function(station_number = NULL, dplyr::left_join(tidyhydat::hy_data_symbols, by = c("SYMBOL" = "SYMBOL_ID")) ## Format date of occurence; SuppressWarnings are justified because NA's are valid for MEAN Sum_stat - annual_statistics <- dplyr::mutate(annual_statistics, Date = suppressWarnings( - lubridate::ymd(paste(YEAR, MONTH, DAY, sep = "-")) - )) + annual_statistics <- dplyr::mutate( + annual_statistics, + Date = suppressWarnings( + lubridate::ymd(paste(YEAR, MONTH, DAY, sep = "-")) + ) + ) ## Format - annual_statistics <- dplyr::left_join(annual_statistics, tidyhydat::hy_data_types, by = c("DATA_TYPE")) + annual_statistics <- dplyr::left_join( + annual_statistics, + tidyhydat::hy_data_types, + by = c("DATA_TYPE") + ) ## Clean up the variables annual_statistics <- dplyr::select( - annual_statistics, STATION_NUMBER, DATA_TYPE_EN, YEAR:Value, - Date, SYMBOL_EN + annual_statistics, + STATION_NUMBER, + DATA_TYPE_EN, + YEAR:Value, + Date, + SYMBOL_EN ) ## Rename to tidyhydat format - colnames(annual_statistics) <- c("STATION_NUMBER", "Parameter", "Year", "Sum_stat", "Value", "Date", "Symbol") - attr(annual_statistics, "missed_stns") <- setdiff(unique(stns), unique(annual_statistics$STATION_NUMBER)) + colnames(annual_statistics) <- c( + "STATION_NUMBER", + "Parameter", + "Year", + "Sum_stat", + "Value", + "Date", + "Symbol" + ) + attr(annual_statistics, "missed_stns") <- setdiff( + unique(stns), + unique(annual_statistics$STATION_NUMBER) + ) as.hy(annual_statistics) } diff --git a/R/hy_daily.R b/R/hy_daily.R index e53ab8b..c639602 100644 --- a/R/hy_daily.R +++ b/R/hy_daily.R @@ -37,8 +37,12 @@ #' hy_daily(station_number = c("02JE013", "08MF005")) #' } #' -hy_daily <- function(station_number = NULL, prov_terr_state_loc = NULL, - hydat_path = NULL, ...) { +hy_daily <- function( + station_number = NULL, + prov_terr_state_loc = NULL, + hydat_path = NULL, + ... +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -51,7 +55,6 @@ hy_daily <- function(station_number = NULL, prov_terr_state_loc = NULL, ## Create an empty tibble daily <- dplyr::tibble() - ## Query each parameter then check if it returned a tibble ## flows @@ -59,8 +62,6 @@ hy_daily <- function(station_number = NULL, prov_terr_state_loc = NULL, suppressMessages(hy_daily_flows(stns, hydat_path = hydat_con, ...)) ) - - if (inherits(flows, "tbl_df")) daily <- flows ## levels @@ -84,11 +85,17 @@ hy_daily <- function(station_number = NULL, prov_terr_state_loc = NULL, if (inherits(suscon, "tbl_df")) daily <- dplyr::bind_rows(daily, suscon) - if (nrow(daily) == 0) { - info(paste0("No data for ", station_number, ". Did you correctly input station name or province?")) + info(paste0( + "No data for ", + station_number, + ". Did you correctly input station name or province?" + )) } - attr(daily, "missed_stns") <- setdiff(unique(stns), unique(daily$STATION_NUMBER)) + attr(daily, "missed_stns") <- setdiff( + unique(stns), + unique(daily$STATION_NUMBER) + ) as.hy(dplyr::arrange(daily, STATION_NUMBER, Date)) } diff --git a/R/hy_daily_flows.R b/R/hy_daily_flows.R index 74b3359..bdd4473 100644 --- a/R/hy_daily_flows.R +++ b/R/hy_daily_flows.R @@ -48,14 +48,14 @@ #' @source HYDAT #' @export - - -hy_daily_flows <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL, - symbol_output = "code") { +hy_daily_flows <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL, + symbol_output = "code" +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -82,20 +82,40 @@ hy_daily_flows <- function(station_number = NULL, ## Do the initial subset to take advantage of dbplyr only issuing sql query when it has too ## by year - if (!dates_null[["start_is_null"]]) dly_flows <- dplyr::filter(dly_flows, !!sym_YEAR >= lubridate::year(start_date)) - if (!dates_null[["end_is_null"]]) dly_flows <- dplyr::filter(dly_flows, !!sym_YEAR <= lubridate::year(end_date)) - + if (!dates_null[["start_is_null"]]) + dly_flows <- dplyr::filter( + dly_flows, + !!sym_YEAR >= lubridate::year(start_date) + ) + if (!dates_null[["end_is_null"]]) + dly_flows <- dplyr::filter( + dly_flows, + !!sym_YEAR <= lubridate::year(end_date) + ) dly_flows <- dplyr::select( - dly_flows, STATION_NUMBER, YEAR, MONTH, - NO_DAYS, dplyr::contains("FLOW") + dly_flows, + STATION_NUMBER, + YEAR, + MONTH, + NO_DAYS, + dplyr::contains("FLOW") ) dly_flows <- dplyr::collect(dly_flows) - if (is.data.frame(dly_flows) && nrow(dly_flows) == 0) stop("No flow data for this station in HYDAT") + if (is.data.frame(dly_flows) && nrow(dly_flows) == 0) + stop("No flow data for this station in HYDAT") - dly_flows <- tidyr::gather(dly_flows, !!sym_variable, !!sym_temp, -(STATION_NUMBER:NO_DAYS)) - dly_flows <- dplyr::mutate(dly_flows, DAY = as.numeric(gsub("FLOW|FLOW_SYMBOL", "", variable))) + dly_flows <- tidyr::gather( + dly_flows, + !!sym_variable, + !!sym_temp, + -(STATION_NUMBER:NO_DAYS) + ) + dly_flows <- dplyr::mutate( + dly_flows, + DAY = as.numeric(gsub("FLOW|FLOW_SYMBOL", "", variable)) + ) dly_flows <- dplyr::mutate(dly_flows, variable = gsub("[0-9]+", "", variable)) dly_flows <- tidyr::spread(dly_flows, variable, temp) dly_flows <- dplyr::mutate(dly_flows, FLOW = as.numeric(FLOW)) @@ -103,43 +123,71 @@ hy_daily_flows <- function(station_number = NULL, dly_flows <- dplyr::filter(dly_flows, DAY <= NO_DAYS) ## convert into R date. - dly_flows <- dplyr::mutate(dly_flows, Date = lubridate::ymd(paste0(YEAR, "-", MONTH, "-", DAY))) + dly_flows <- dplyr::mutate( + dly_flows, + Date = lubridate::ymd(paste0(YEAR, "-", MONTH, "-", DAY)) + ) ## Then when a date column exist fine tune the subset - if (!dates_null[["start_is_null"]]) dly_flows <- dplyr::filter(dly_flows, !!sym_Date >= start_date) - if (!dates_null[["end_is_null"]]) dly_flows <- dplyr::filter(dly_flows, !!sym_Date <= end_date) - - dly_flows <- dplyr::left_join(dly_flows, tidyhydat::hy_data_symbols, by = c("FLOW_SYMBOL" = "SYMBOL_ID")) + if (!dates_null[["start_is_null"]]) + dly_flows <- dplyr::filter(dly_flows, !!sym_Date >= start_date) + if (!dates_null[["end_is_null"]]) + dly_flows <- dplyr::filter(dly_flows, !!sym_Date <= end_date) + + dly_flows <- dplyr::left_join( + dly_flows, + tidyhydat::hy_data_symbols, + by = c("FLOW_SYMBOL" = "SYMBOL_ID") + ) dly_flows <- dplyr::mutate(dly_flows, Parameter = "Flow") ## Control for symbol ouput if (symbol_output == "code") { dly_flows <- dplyr::select( - dly_flows, STATION_NUMBER, Date, Parameter, FLOW, + dly_flows, + STATION_NUMBER, + Date, + Parameter, + FLOW, FLOW_SYMBOL ) } if (symbol_output == "english") { dly_flows <- dplyr::select( - dly_flows, STATION_NUMBER, Date, - Parameter, FLOW, SYMBOL_EN + dly_flows, + STATION_NUMBER, + Date, + Parameter, + FLOW, + SYMBOL_EN ) } if (symbol_output == "french") { dly_flows <- dplyr::select( - dly_flows, STATION_NUMBER, Date, - Parameter, FLOW, SYMBOL_FR + dly_flows, + STATION_NUMBER, + Date, + Parameter, + FLOW, + SYMBOL_FR ) } - dly_flows <- dplyr::arrange(dly_flows, Date) - colnames(dly_flows) <- c("STATION_NUMBER", "Date", "Parameter", "Value", "Symbol") - + colnames(dly_flows) <- c( + "STATION_NUMBER", + "Date", + "Parameter", + "Value", + "Symbol" + ) - attr(dly_flows, "missed_stns") <- setdiff(unique(stns), unique(dly_flows$STATION_NUMBER)) + attr(dly_flows, "missed_stns") <- setdiff( + unique(stns), + unique(dly_flows$STATION_NUMBER) + ) as.hy(dly_flows) } diff --git a/R/hy_daily_levels.R b/R/hy_daily_levels.R index 00305bf..7de82f7 100644 --- a/R/hy_daily_levels.R +++ b/R/hy_daily_levels.R @@ -43,14 +43,14 @@ #' @source HYDAT #' @export - - -hy_daily_levels <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL, - symbol_output = "code") { +hy_daily_levels <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL, + symbol_output = "code" +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -77,12 +77,24 @@ hy_daily_levels <- function(station_number = NULL, ## Do the initial subset to take advantage of dbplyr only issuing sql query when it has too ## by year - if (!dates_null[["start_is_null"]]) dly_levels <- dplyr::filter(dly_levels, !!sym_YEAR >= lubridate::year(start_date)) - if (!dates_null[["end_is_null"]]) dly_levels <- dplyr::filter(dly_levels, !!sym_YEAR <= lubridate::year(end_date)) + if (!dates_null[["start_is_null"]]) + dly_levels <- dplyr::filter( + dly_levels, + !!sym_YEAR >= lubridate::year(start_date) + ) + if (!dates_null[["end_is_null"]]) + dly_levels <- dplyr::filter( + dly_levels, + !!sym_YEAR <= lubridate::year(end_date) + ) dly_levels <- dplyr::select( - dly_levels, STATION_NUMBER, YEAR, MONTH, - NO_DAYS, dplyr::contains("LEVEL") + dly_levels, + STATION_NUMBER, + YEAR, + MONTH, + NO_DAYS, + dplyr::contains("LEVEL") ) dly_levels <- dplyr::collect(dly_levels) @@ -90,52 +102,92 @@ hy_daily_levels <- function(station_number = NULL, stop("No level data for this station in HYDAT") } - dly_levels <- tidyr::gather(dly_levels, !!sym_variable, !!sym_temp, -(STATION_NUMBER:NO_DAYS)) - dly_levels <- dplyr::mutate(dly_levels, DAY = as.numeric(gsub("LEVEL|LEVEL_SYMBOL", "", variable))) - dly_levels <- dplyr::mutate(dly_levels, variable = gsub("[0-9]+", "", variable)) + dly_levels <- tidyr::gather( + dly_levels, + !!sym_variable, + !!sym_temp, + -(STATION_NUMBER:NO_DAYS) + ) + dly_levels <- dplyr::mutate( + dly_levels, + DAY = as.numeric(gsub("LEVEL|LEVEL_SYMBOL", "", variable)) + ) + dly_levels <- dplyr::mutate( + dly_levels, + variable = gsub("[0-9]+", "", variable) + ) dly_levels <- tidyr::spread(dly_levels, variable, temp) dly_levels <- dplyr::mutate(dly_levels, LEVEL = as.numeric(LEVEL)) ## No days that exceed actual number of days in the month dly_levels <- dplyr::filter(dly_levels, DAY <= NO_DAYS) ## convert into R date. - dly_levels <- dplyr::mutate(dly_levels, Date = lubridate::ymd(paste0(YEAR, "-", MONTH, "-", DAY))) + dly_levels <- dplyr::mutate( + dly_levels, + Date = lubridate::ymd(paste0(YEAR, "-", MONTH, "-", DAY)) + ) ## Then when a date column exist fine tune the subset - if (!dates_null[["start_is_null"]]) dly_levels <- dplyr::filter(dly_levels, !!sym_Date >= start_date) - if (!dates_null[["end_is_null"]]) dly_levels <- dplyr::filter(dly_levels, !!sym_Date <= end_date) - - - dly_levels <- dplyr::left_join(dly_levels, tidyhydat::hy_data_symbols, by = c("LEVEL_SYMBOL" = "SYMBOL_ID")) + if (!dates_null[["start_is_null"]]) + dly_levels <- dplyr::filter(dly_levels, !!sym_Date >= start_date) + if (!dates_null[["end_is_null"]]) + dly_levels <- dplyr::filter(dly_levels, !!sym_Date <= end_date) + + dly_levels <- dplyr::left_join( + dly_levels, + tidyhydat::hy_data_symbols, + by = c("LEVEL_SYMBOL" = "SYMBOL_ID") + ) dly_levels <- dplyr::mutate(dly_levels, Parameter = "Level") ## Control for symbol ouput if (symbol_output == "code") { dly_levels <- dplyr::select( - dly_levels, STATION_NUMBER, Date, Parameter, - LEVEL, LEVEL_SYMBOL + dly_levels, + STATION_NUMBER, + Date, + Parameter, + LEVEL, + LEVEL_SYMBOL ) } if (symbol_output == "english") { dly_levels <- dplyr::select( - dly_levels, STATION_NUMBER, Date, Parameter, - LEVEL, SYMBOL_EN + dly_levels, + STATION_NUMBER, + Date, + Parameter, + LEVEL, + SYMBOL_EN ) } if (symbol_output == "french") { dly_levels <- dplyr::select( - dly_levels, STATION_NUMBER, Date, Parameter, - LEVEL, SYMBOL_FR + dly_levels, + STATION_NUMBER, + Date, + Parameter, + LEVEL, + SYMBOL_FR ) } dly_levels <- dplyr::arrange(dly_levels, Date) - colnames(dly_levels) <- c("STATION_NUMBER", "Date", "Parameter", "Value", "Symbol") + colnames(dly_levels) <- c( + "STATION_NUMBER", + "Date", + "Parameter", + "Value", + "Symbol" + ) - attr(dly_levels, "missed_stns") <- setdiff(unique(stns), unique(dly_levels$STATION_NUMBER)) + attr(dly_levels, "missed_stns") <- setdiff( + unique(stns), + unique(dly_levels$STATION_NUMBER) + ) as.hy(dly_levels) } diff --git a/R/hy_db.R b/R/hy_db.R index af93c58..877b36d 100644 --- a/R/hy_db.R +++ b/R/hy_db.R @@ -1,4 +1,3 @@ - #' Open a connection to the HYDAT database #' #' This function gives low-level access to the underlying HYDAT database used by @@ -50,7 +49,8 @@ hy_src <- function(hydat_path = NULL) { if (!file.exists(hydat_path)) { stop(sprintf( "No %s found at %s. Run download_hydat() to download the database.", - basename(hydat_path), dirname(hydat_path) + basename(hydat_path), + dirname(hydat_path) )) } diff --git a/R/hy_monthly_flows.R b/R/hy_monthly_flows.R index 1fb7953..39264e1 100644 --- a/R/hy_monthly_flows.R +++ b/R/hy_monthly_flows.R @@ -49,13 +49,13 @@ #' @source HYDAT #' @export - - -hy_monthly_flows <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL) { +hy_monthly_flows <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -82,42 +82,81 @@ hy_monthly_flows <- function(station_number = NULL, ## Do the initial subset to take advantage of dbplyr only issuing sql query when it has too ## by year - if (!dates_null[["start_is_null"]]) monthly_flows <- dplyr::filter(monthly_flows, !!sym_YEAR >= lubridate::year(start_date)) - if (!dates_null[["end_is_null"]]) monthly_flows <- dplyr::filter(monthly_flows, !!sym_YEAR <= lubridate::year(end_date)) + if (!dates_null[["start_is_null"]]) + monthly_flows <- dplyr::filter( + monthly_flows, + !!sym_YEAR >= lubridate::year(start_date) + ) + if (!dates_null[["end_is_null"]]) + monthly_flows <- dplyr::filter( + monthly_flows, + !!sym_YEAR <= lubridate::year(end_date) + ) monthly_flows <- dplyr::select(monthly_flows, STATION_NUMBER:MAX) monthly_flows <- dplyr::collect(monthly_flows) - if (is.data.frame(monthly_flows) && nrow(monthly_flows) == 0) stop("This station is not present in HYDAT") - + if (is.data.frame(monthly_flows) && nrow(monthly_flows) == 0) + stop("This station is not present in HYDAT") ## Need to rename columns for gather colnames(monthly_flows) <- c( - "STATION_NUMBER", "Year", "Month", "Full_Month", "No_days", "MEAN_Value", - "TOTAL_Value", "MIN_DAY", "MIN_Value", "MAX_DAY", "MAX_Value" + "STATION_NUMBER", + "Year", + "Month", + "Full_Month", + "No_days", + "MEAN_Value", + "TOTAL_Value", + "MIN_DAY", + "MIN_Value", + "MAX_DAY", + "MAX_Value" ) - - - monthly_flows <- tidyr::gather(monthly_flows, !!sym_variable, !!sym_temp, -(STATION_NUMBER:No_days)) - monthly_flows <- tidyr::separate(monthly_flows, !!sym_variable, into = c("Sum_stat", "temp2"), sep = "_") + monthly_flows <- tidyr::gather( + monthly_flows, + !!sym_variable, + !!sym_temp, + -(STATION_NUMBER:No_days) + ) + monthly_flows <- tidyr::separate( + monthly_flows, + !!sym_variable, + into = c("Sum_stat", "temp2"), + sep = "_" + ) monthly_flows <- tidyr::spread(monthly_flows, !!sym_temp2, !!sym_temp) ## convert into R date for date of occurence. - monthly_flows <- dplyr::mutate(monthly_flows, Date_occurred = paste0(Year, "-", Month, "-", DAY)) + monthly_flows <- dplyr::mutate( + monthly_flows, + Date_occurred = paste0(Year, "-", Month, "-", DAY) + ) ## Check if DAY is NA and if so give it an NA value so the date parse correctly. - monthly_flows <- dplyr::mutate(monthly_flows, Date_occurred = ifelse(is.na(DAY), NA, Date_occurred)) - monthly_flows <- dplyr::mutate(monthly_flows, Date_occurred = lubridate::ymd(Date_occurred, quiet = TRUE)) + monthly_flows <- dplyr::mutate( + monthly_flows, + Date_occurred = ifelse(is.na(DAY), NA, Date_occurred) + ) + monthly_flows <- dplyr::mutate( + monthly_flows, + Date_occurred = lubridate::ymd(Date_occurred, quiet = TRUE) + ) ## Then when a date column exist fine tune the subset - if (!dates_null[["start_is_null"]]) monthly_flows <- dplyr::filter(monthly_flows, Date_occurred >= start_date) - if (!dates_null[["end_is_null"]]) monthly_flows <- dplyr::filter(monthly_flows, Date_occurred <= end_date) + if (!dates_null[["start_is_null"]]) + monthly_flows <- dplyr::filter(monthly_flows, Date_occurred >= start_date) + if (!dates_null[["end_is_null"]]) + monthly_flows <- dplyr::filter(monthly_flows, Date_occurred <= end_date) monthly_flows <- dplyr::select(monthly_flows, -DAY) monthly_flows <- dplyr::mutate(monthly_flows, Full_Month = Full_Month == 1) - attr(monthly_flows, "missed_stns") <- setdiff(unique(stns), unique(monthly_flows$STATION_NUMBER)) + attr(monthly_flows, "missed_stns") <- setdiff( + unique(stns), + unique(monthly_flows$STATION_NUMBER) + ) as.hy(monthly_flows) } diff --git a/R/hy_monthly_levels.R b/R/hy_monthly_levels.R index 64a97e7..9f3c11f 100644 --- a/R/hy_monthly_levels.R +++ b/R/hy_monthly_levels.R @@ -48,13 +48,13 @@ #' @source HYDAT #' @export - - -hy_monthly_levels <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL) { +hy_monthly_levels <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -76,13 +76,24 @@ hy_monthly_levels <- function(station_number = NULL, ## Data manipulations to make it "tidy" monthly_levels <- dplyr::tbl(hydat_con, "DLY_LEVELS") - monthly_levels <- dplyr::filter(monthly_levels, !!sym_STATION_NUMBER %in% stns) + monthly_levels <- dplyr::filter( + monthly_levels, + !!sym_STATION_NUMBER %in% stns + ) ## Do the initial subset to take advantage of dbplyr only issuing sql query when it has too ## by year - if (!dates_null[["start_is_null"]]) monthly_levels <- dplyr::filter(monthly_levels, !!sym_YEAR >= lubridate::year(start_date)) - if (!dates_null[["end_is_null"]]) monthly_levels <- dplyr::filter(monthly_levels, !!sym_YEAR <= lubridate::year(end_date)) + if (!dates_null[["start_is_null"]]) + monthly_levels <- dplyr::filter( + monthly_levels, + !!sym_YEAR >= lubridate::year(start_date) + ) + if (!dates_null[["end_is_null"]]) + monthly_levels <- dplyr::filter( + monthly_levels, + !!sym_YEAR <= lubridate::year(end_date) + ) monthly_levels <- dplyr::select(monthly_levels, STATION_NUMBER:MAX) monthly_levels <- dplyr::collect(monthly_levels) @@ -93,32 +104,63 @@ hy_monthly_levels <- function(station_number = NULL, ## Need to rename columns for gather colnames(monthly_levels) <- c( - "STATION_NUMBER", "Year", "Month", "PRECISION_CODE", "Full_month", "No_days", "MEAN_Value", - "TOTAL_Value", "MIN_DAY", "MIN_Value", "MAX_DAY", "MAX_Value" + "STATION_NUMBER", + "Year", + "Month", + "PRECISION_CODE", + "Full_month", + "No_days", + "MEAN_Value", + "TOTAL_Value", + "MIN_DAY", + "MIN_Value", + "MAX_DAY", + "MAX_Value" ) - - - monthly_levels <- tidyr::gather(monthly_levels, !!sym_variable, !!sym_temp, -(STATION_NUMBER:No_days)) - monthly_levels <- tidyr::separate(monthly_levels, !!sym_variable, into = c("Sum_stat", "temp2"), sep = "_") + monthly_levels <- tidyr::gather( + monthly_levels, + !!sym_variable, + !!sym_temp, + -(STATION_NUMBER:No_days) + ) + monthly_levels <- tidyr::separate( + monthly_levels, + !!sym_variable, + into = c("Sum_stat", "temp2"), + sep = "_" + ) monthly_levels <- tidyr::spread(monthly_levels, !!sym_temp2, !!sym_temp) ## convert into R date for date of occurence. - monthly_levels <- dplyr::mutate(monthly_levels, Date_occurred = paste0(Year, "-", Month, "-", DAY)) + monthly_levels <- dplyr::mutate( + monthly_levels, + Date_occurred = paste0(Year, "-", Month, "-", DAY) + ) ## Check if DAY is NA and if so give it an NA value so the date parse correctly. - monthly_levels <- dplyr::mutate(monthly_levels, Date_occurred = ifelse(is.na(DAY), NA, Date_occurred)) - monthly_levels <- dplyr::mutate(monthly_levels, Date_occurred = lubridate::ymd(Date_occurred, quiet = TRUE)) + monthly_levels <- dplyr::mutate( + monthly_levels, + Date_occurred = ifelse(is.na(DAY), NA, Date_occurred) + ) + monthly_levels <- dplyr::mutate( + monthly_levels, + Date_occurred = lubridate::ymd(Date_occurred, quiet = TRUE) + ) ## Then when a date column exist fine tune the subset - if (!dates_null[["start_is_null"]]) monthly_levels <- dplyr::filter(monthly_levels, Date_occurred >= start_date) - if (!dates_null[["end_is_null"]]) monthly_levels <- dplyr::filter(monthly_levels, Date_occurred <= end_date) + if (!dates_null[["start_is_null"]]) + monthly_levels <- dplyr::filter(monthly_levels, Date_occurred >= start_date) + if (!dates_null[["end_is_null"]]) + monthly_levels <- dplyr::filter(monthly_levels, Date_occurred <= end_date) monthly_levels <- dplyr::select(monthly_levels, -DAY) monthly_levels <- dplyr::mutate(monthly_levels, Full_month = Full_month == 1) - - attr(monthly_levels, "missed_stns") <- setdiff(unique(stns), unique(monthly_levels$STATION_NUMBER)) + attr(monthly_levels, "missed_stns") <- setdiff( + unique(stns), + unique(monthly_levels$STATION_NUMBER) + ) as.hy(monthly_levels) } diff --git a/R/hy_plot.R b/R/hy_plot.R index ef625c6..4ada2b5 100644 --- a/R/hy_plot.R +++ b/R/hy_plot.R @@ -10,7 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - #' Plot historical and realtime data #' #' This method plots either daily time series data from HYDAT or realtime data from @@ -39,7 +38,8 @@ plot.hy <- function(x = NULL, ...) { } ### Join with meta data to get station name - hydf <- dplyr::left_join(x, + hydf <- dplyr::left_join( + x, suppressMessages(tidyhydat::allstations), by = c("STATION_NUMBER") ) @@ -50,7 +50,11 @@ plot.hy <- function(x = NULL, ...) { num_stns <- length(unique(hydf$STATION)) - if (num_stns > 4L) stop("You are trying to plot more than four stations at once.", call. = FALSE) + if (num_stns > 4L) + stop( + "You are trying to plot more than four stations at once.", + call. = FALSE + ) if (num_stns > 2L) { m <- matrix(c(1, 1, 2, 3, 4, 5, 6, 6), nrow = 4, ncol = 2, byrow = TRUE) @@ -69,7 +73,13 @@ plot.hy <- function(x = NULL, ...) { graphics::par(mar = c(1, 1, 1, 1)) graphics::plot.new() - graphics::text(0.5, 0.5, "Historical Water Survey of Canada Gauges", cex = 2, font = 2) + graphics::text( + 0.5, + 0.5, + "Historical Water Survey of Canada Gauges", + cex = 2, + font = 2 + ) for (i in seq_along(unique(hydf$STATION))) { graphics::par( @@ -77,34 +87,58 @@ plot.hy <- function(x = NULL, ...) { mgp = c(3.1, 0.4, 0), las = 1, tck = -.01, - xaxs = "i", yaxs = "i" + xaxs = "i", + yaxs = "i" ) - graphics::plot(Value ~ Date, + graphics::plot( + Value ~ Date, data = hydf[hydf$STATION == unique(hydf$STATION)[i], ], xlab = "Date", ylab = eval(parse(text = label_helper(unique(hydf$Parameter)))), axes = FALSE, pch = 20, - ylim = c(0, max(hydf[hydf$STATION == unique(hydf$STATION)[i], ]$Value, na.rm = TRUE)), + ylim = c( + 0, + max(hydf[hydf$STATION == unique(hydf$STATION)[i], ]$Value, na.rm = TRUE) + ), cex = 0.75, frame.plot = TRUE, ... ) - at_y <- utils::head(pretty(hydf[hydf$STATION == unique(hydf$STATION)[i], ]$Value), -1) + at_y <- utils::head( + pretty(hydf[hydf$STATION == unique(hydf$STATION)[i], ]$Value), + -1 + ) graphics::mtext( - side = 2, text = at_y, at = at_y, - col = "grey20", line = 1, cex = 0.75 + side = 2, + text = at_y, + at = at_y, + col = "grey20", + line = 1, + cex = 0.75 ) - at_x <- utils::tail(utils::head(pretty(hydf[hydf$STATION == unique(hydf$STATION)[i], ]$Date), -1), -1) - graphics::mtext(side = 1, text = format(at_x, "%Y"), at = at_x, col = "grey20", line = 1, cex = 0.75) + at_x <- utils::tail( + utils::head( + pretty(hydf[hydf$STATION == unique(hydf$STATION)[i], ]$Date), + -1 + ), + -1 + ) + graphics::mtext( + side = 1, + text = format(at_x, "%Y"), + at = at_x, + col = "grey20", + line = 1, + cex = 0.75 + ) graphics::title(main = paste0(unique(hydf$STATION)[i]), cex.main = 1.1) } - graphics::plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") invisible(TRUE) @@ -134,9 +168,13 @@ label_helper <- function(parameter) { #' @param Parameter Parameter of interest. Either "Flow" or "Level". #' #' @export -hy_plot <- function(station_number = NULL, Parameter = c("Flow", "Level", "Suscon", "Load")) { - message("hy_plot has been deprecated in favour of using the generic R plot method and will disappear in future versions.") - +hy_plot <- function( + station_number = NULL, + Parameter = c("Flow", "Level", "Suscon", "Load") +) { + message( + "hy_plot has been deprecated in favour of using the generic R plot method and will disappear in future versions." + ) Parameter <- match.arg(Parameter, several.ok = TRUE) @@ -147,7 +185,8 @@ hy_plot <- function(station_number = NULL, Parameter = c("Flow", "Level", "Susco params <- unique(hydf$Parameter) ### Join with meta data to get station name - hydf <- dplyr::left_join(hydf, + hydf <- dplyr::left_join( + hydf, suppressMessages(hy_stations()), by = c("STATION_NUMBER") ) @@ -156,7 +195,6 @@ hy_plot <- function(station_number = NULL, Parameter = c("Flow", "Level", "Susco hydf$STATION <- factor(hydf$STATION) - # y_axis <- ifelse(Parameter == "Flow", expression(Discharge~(m^3/s)), "Level (m)") ## Set the palette @@ -175,7 +213,6 @@ hy_plot <- function(station_number = NULL, Parameter = c("Flow", "Level", "Susco graphics::layout(mat = m, heights = c(0.2, 0.6, 0.2)) } - if (length(params) == 1) { m <- matrix(c(1, 2, 3), nrow = 3, ncol = 1, byrow = TRUE) @@ -185,29 +222,38 @@ hy_plot <- function(station_number = NULL, Parameter = c("Flow", "Level", "Susco graphics::par(mar = c(1, 1, 1, 1)) graphics::plot.new() # graphics::plot(1, type = "n", axes=FALSE, xlab="", ylab="") - graphics::text(0.5, 0.5, "Historical Water Survey of Canada Gauges", cex = 2, font = 2) + graphics::text( + 0.5, + 0.5, + "Historical Water Survey of Canada Gauges", + cex = 2, + font = 2 + ) for (i in seq_along(params)) { graphics::par(mar = c(2, 2, 1, 1)) - graphics::plot(Value ~ Date, + graphics::plot( + Value ~ Date, data = hydf[hydf$Parameter == params[i], ], col = hydf$STATION, xlab = "Date", ylab = paste0(params[i]), bty = "L", - pch = 20, cex = 1 + pch = 20, + cex = 1 ) graphics::title(main = paste0(params[i]), cex.main = 1.75) } - graphics::plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") graphics::legend( - x = "top", inset = 0, + x = "top", + inset = 0, legend = unique(hydf$STATION), fill = unique(hydf$STATION), bty = "n", - cex = 1, horiz = TRUE + cex = 1, + horiz = TRUE ) } diff --git a/R/hy_sed_daily_loads.R b/R/hy_sed_daily_loads.R index db3d9e3..0ae6835 100644 --- a/R/hy_sed_daily_loads.R +++ b/R/hy_sed_daily_loads.R @@ -39,13 +39,13 @@ #' @source HYDAT #' @export - - -hy_sed_daily_loads <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL) { +hy_sed_daily_loads <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -72,12 +72,24 @@ hy_sed_daily_loads <- function(station_number = NULL, ## Do the initial subset to take advantage of dbplyr only issuing sql query when it has too ## by year - if (!dates_null[["start_is_null"]]) sed_dly_loads <- dplyr::filter(sed_dly_loads, !!sym_YEAR >= lubridate::year(start_date)) - if (!dates_null[["end_is_null"]]) sed_dly_loads <- dplyr::filter(sed_dly_loads, !!sym_YEAR <= lubridate::year(end_date)) + if (!dates_null[["start_is_null"]]) + sed_dly_loads <- dplyr::filter( + sed_dly_loads, + !!sym_YEAR >= lubridate::year(start_date) + ) + if (!dates_null[["end_is_null"]]) + sed_dly_loads <- dplyr::filter( + sed_dly_loads, + !!sym_YEAR <= lubridate::year(end_date) + ) sed_dly_loads <- dplyr::select( - sed_dly_loads, STATION_NUMBER, YEAR, MONTH, - NO_DAYS, dplyr::contains("LOAD") + sed_dly_loads, + STATION_NUMBER, + YEAR, + MONTH, + NO_DAYS, + dplyr::contains("LOAD") ) sed_dly_loads <- dplyr::collect(sed_dly_loads) @@ -85,29 +97,54 @@ hy_sed_daily_loads <- function(station_number = NULL, stop("No sediment load data for this station in HYDAT") } - sed_dly_loads <- tidyr::gather(sed_dly_loads, !!sym_variable, !!sym_temp, -(STATION_NUMBER:NO_DAYS)) - sed_dly_loads <- dplyr::mutate(sed_dly_loads, DAY = as.numeric(gsub("LOAD", "", variable))) - sed_dly_loads <- dplyr::mutate(sed_dly_loads, variable = gsub("[0-9]+", "", variable)) + sed_dly_loads <- tidyr::gather( + sed_dly_loads, + !!sym_variable, + !!sym_temp, + -(STATION_NUMBER:NO_DAYS) + ) + sed_dly_loads <- dplyr::mutate( + sed_dly_loads, + DAY = as.numeric(gsub("LOAD", "", variable)) + ) + sed_dly_loads <- dplyr::mutate( + sed_dly_loads, + variable = gsub("[0-9]+", "", variable) + ) sed_dly_loads <- tidyr::spread(sed_dly_loads, !!sym_variable, !!sym_temp) sed_dly_loads <- dplyr::mutate(sed_dly_loads, LOAD = as.numeric(LOAD)) ## No days that exceed actual number of days in the month sed_dly_loads <- dplyr::filter(sed_dly_loads, DAY <= NO_DAYS) ## convert into R date. - sed_dly_loads <- dplyr::mutate(sed_dly_loads, Date = lubridate::ymd( - paste0(YEAR, "-", MONTH, "-", DAY) - )) + sed_dly_loads <- dplyr::mutate( + sed_dly_loads, + Date = lubridate::ymd( + paste0(YEAR, "-", MONTH, "-", DAY) + ) + ) ## Then when a date column exist fine tune the subset - if (!dates_null[["start_is_null"]]) sed_dly_loads <- dplyr::filter(sed_dly_loads, !!sym_Date >= start_date) - if (!dates_null[["end_is_null"]]) sed_dly_loads <- dplyr::filter(sed_dly_loads, !!sym_Date <= end_date) + if (!dates_null[["start_is_null"]]) + sed_dly_loads <- dplyr::filter(sed_dly_loads, !!sym_Date >= start_date) + if (!dates_null[["end_is_null"]]) + sed_dly_loads <- dplyr::filter(sed_dly_loads, !!sym_Date <= end_date) sed_dly_loads <- dplyr::mutate(sed_dly_loads, Parameter = "Load") - sed_dly_loads <- dplyr::select(sed_dly_loads, STATION_NUMBER, Date, Parameter, LOAD) + sed_dly_loads <- dplyr::select( + sed_dly_loads, + STATION_NUMBER, + Date, + Parameter, + LOAD + ) sed_dly_loads <- dplyr::arrange(sed_dly_loads, Date) colnames(sed_dly_loads) <- c("STATION_NUMBER", "Date", "Parameter", "Value") - attr(sed_dly_loads, "missed_stns") <- setdiff(unique(stns), unique(sed_dly_loads$STATION_NUMBER)) + attr(sed_dly_loads, "missed_stns") <- setdiff( + unique(stns), + unique(sed_dly_loads$STATION_NUMBER) + ) as.hy(sed_dly_loads) } diff --git a/R/hy_sed_daily_suscon.R b/R/hy_sed_daily_suscon.R index b2eca9d..9c110fc 100644 --- a/R/hy_sed_daily_suscon.R +++ b/R/hy_sed_daily_suscon.R @@ -38,14 +38,14 @@ #' @source HYDAT #' @export - - -hy_sed_daily_suscon <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL, - symbol_output = "code") { +hy_sed_daily_suscon <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL, + symbol_output = "code" +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -67,16 +67,31 @@ hy_sed_daily_suscon <- function(station_number = NULL, ## Data manipulations sed_dly_suscon <- dplyr::tbl(hydat_con, "SED_DLY_SUSCON") - sed_dly_suscon <- dplyr::filter(sed_dly_suscon, !!sym_STATION_NUMBER %in% stns) + sed_dly_suscon <- dplyr::filter( + sed_dly_suscon, + !!sym_STATION_NUMBER %in% stns + ) ## Do the initial subset to take advantage of dbplyr only issuing sql query when it has too ## by year - if (!dates_null[["start_is_null"]]) sed_dly_suscon <- dplyr::filter(sed_dly_suscon, !!sym_YEAR >= lubridate::year(start_date)) - if (!dates_null[["end_is_null"]]) sed_dly_suscon <- dplyr::filter(sed_dly_suscon, !!sym_YEAR <= lubridate::year(end_date)) + if (!dates_null[["start_is_null"]]) + sed_dly_suscon <- dplyr::filter( + sed_dly_suscon, + !!sym_YEAR >= lubridate::year(start_date) + ) + if (!dates_null[["end_is_null"]]) + sed_dly_suscon <- dplyr::filter( + sed_dly_suscon, + !!sym_YEAR <= lubridate::year(end_date) + ) sed_dly_suscon <- dplyr::select( - sed_dly_suscon, STATION_NUMBER, YEAR, MONTH, NO_DAYS, + sed_dly_suscon, + STATION_NUMBER, + YEAR, + MONTH, + NO_DAYS, dplyr::contains("SUSCON") ) sed_dly_suscon <- dplyr::collect(sed_dly_suscon) @@ -85,53 +100,93 @@ hy_sed_daily_suscon <- function(station_number = NULL, stop("No suspended sediment data for this station in HYDAT") } - sed_dly_suscon <- tidyr::gather(sed_dly_suscon, !!sym_variable, !!sym_temp, -(STATION_NUMBER:NO_DAYS)) - sed_dly_suscon <- dplyr::mutate(sed_dly_suscon, DAY = as.numeric(gsub("SUSCON|SUSCON_SYMBOL", "", variable))) - sed_dly_suscon <- dplyr::mutate(sed_dly_suscon, variable = gsub("[0-9]+", "", variable)) + sed_dly_suscon <- tidyr::gather( + sed_dly_suscon, + !!sym_variable, + !!sym_temp, + -(STATION_NUMBER:NO_DAYS) + ) + sed_dly_suscon <- dplyr::mutate( + sed_dly_suscon, + DAY = as.numeric(gsub("SUSCON|SUSCON_SYMBOL", "", variable)) + ) + sed_dly_suscon <- dplyr::mutate( + sed_dly_suscon, + variable = gsub("[0-9]+", "", variable) + ) sed_dly_suscon <- tidyr::spread(sed_dly_suscon, !!sym_variable, !!sym_temp) sed_dly_suscon <- dplyr::mutate(sed_dly_suscon, SUSCON = as.numeric(SUSCON)) ## No days that exceed actual number of days in the month sed_dly_suscon <- dplyr::filter(sed_dly_suscon, DAY <= NO_DAYS) ## convert into R date. - sed_dly_suscon <- dplyr::mutate(sed_dly_suscon, Date = lubridate::ymd( - paste0(YEAR, "-", MONTH, "-", DAY) - )) + sed_dly_suscon <- dplyr::mutate( + sed_dly_suscon, + Date = lubridate::ymd( + paste0(YEAR, "-", MONTH, "-", DAY) + ) + ) ## Then when a date column exist fine tune the subset - if (!dates_null[["start_is_null"]]) sed_dly_suscon <- dplyr::filter(sed_dly_suscon, !!sym_Date >= start_date) - if (!dates_null[["end_is_null"]]) sed_dly_suscon <- dplyr::filter(sed_dly_suscon, !!sym_Date <= end_date) - - - sed_dly_suscon <- dplyr::left_join(sed_dly_suscon, tidyhydat::hy_data_symbols, by = c("SUSCON_SYMBOL" = "SYMBOL_ID")) + if (!dates_null[["start_is_null"]]) + sed_dly_suscon <- dplyr::filter(sed_dly_suscon, !!sym_Date >= start_date) + if (!dates_null[["end_is_null"]]) + sed_dly_suscon <- dplyr::filter(sed_dly_suscon, !!sym_Date <= end_date) + + sed_dly_suscon <- dplyr::left_join( + sed_dly_suscon, + tidyhydat::hy_data_symbols, + by = c("SUSCON_SYMBOL" = "SYMBOL_ID") + ) sed_dly_suscon <- dplyr::mutate(sed_dly_suscon, Parameter = "Suscon") ## Control for symbol ouput if (symbol_output == "code") { sed_dly_suscon <- dplyr::select( - sed_dly_suscon, STATION_NUMBER, Date, Parameter, - SUSCON, SUSCON_SYMBOL + sed_dly_suscon, + STATION_NUMBER, + Date, + Parameter, + SUSCON, + SUSCON_SYMBOL ) } if (symbol_output == "english") { sed_dly_suscon <- dplyr::select( - sed_dly_suscon, STATION_NUMBER, Date, Parameter, - SUSCON, SYMBOL_EN + sed_dly_suscon, + STATION_NUMBER, + Date, + Parameter, + SUSCON, + SYMBOL_EN ) } if (symbol_output == "french") { sed_dly_suscon <- dplyr::select( - sed_dly_suscon, STATION_NUMBER, Date, Parameter, - SUSCON, SYMBOL_FR + sed_dly_suscon, + STATION_NUMBER, + Date, + Parameter, + SUSCON, + SYMBOL_FR ) } sed_dly_suscon <- dplyr::arrange(sed_dly_suscon, Date) - colnames(sed_dly_suscon) <- c("STATION_NUMBER", "Date", "Parameter", "Value", "Symbol") + colnames(sed_dly_suscon) <- c( + "STATION_NUMBER", + "Date", + "Parameter", + "Value", + "Symbol" + ) - attr(sed_dly_suscon, "missed_stns") <- setdiff(unique(stns), unique(sed_dly_suscon$STATION_NUMBER)) + attr(sed_dly_suscon, "missed_stns") <- setdiff( + unique(stns), + unique(sed_dly_suscon$STATION_NUMBER) + ) as.hy(sed_dly_suscon) } diff --git a/R/hy_sed_monthly_loads.R b/R/hy_sed_monthly_loads.R index a7b3d76..e7a87ee 100644 --- a/R/hy_sed_monthly_loads.R +++ b/R/hy_sed_monthly_loads.R @@ -44,13 +44,13 @@ #' @source HYDAT #' @export - - -hy_sed_monthly_loads <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL) { +hy_sed_monthly_loads <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -60,7 +60,6 @@ hy_sed_monthly_loads <- function(station_number = NULL, on.exit(hy_src_disconnect(hydat_con), add = TRUE) } - ## Determine which stations we are querying stns <- station_choice(hydat_con, station_number, prov_terr_state_loc) @@ -73,13 +72,24 @@ hy_sed_monthly_loads <- function(station_number = NULL, ## Data manipulations to make it "tidy" sed_monthly_loads <- dplyr::tbl(hydat_con, "SED_DLY_LOADS") - sed_monthly_loads <- dplyr::filter(sed_monthly_loads, !!sym_STATION_NUMBER %in% stns) + sed_monthly_loads <- dplyr::filter( + sed_monthly_loads, + !!sym_STATION_NUMBER %in% stns + ) ## Do the initial subset to take advantage of dbplyr only issuing sql query when it has too ## by year - if (!dates_null[["start_is_null"]]) sed_monthly_loads <- dplyr::filter(sed_monthly_loads, !!sym_YEAR >= lubridate::year(start_date)) - if (!dates_null[["end_is_null"]]) sed_monthly_loads <- dplyr::filter(sed_monthly_loads, !!sym_YEAR <= lubridate::year(end_date)) + if (!dates_null[["start_is_null"]]) + sed_monthly_loads <- dplyr::filter( + sed_monthly_loads, + !!sym_YEAR >= lubridate::year(start_date) + ) + if (!dates_null[["end_is_null"]]) + sed_monthly_loads <- dplyr::filter( + sed_monthly_loads, + !!sym_YEAR <= lubridate::year(end_date) + ) sed_monthly_loads <- dplyr::select(sed_monthly_loads, STATION_NUMBER:MAX) sed_monthly_loads <- dplyr::collect(sed_monthly_loads) @@ -90,31 +100,71 @@ hy_sed_monthly_loads <- function(station_number = NULL, ## Need to rename columns for gather colnames(sed_monthly_loads) <- c( - "STATION_NUMBER", "Year", "Month", "Full_Month", "No_days", "MEAN_Value", - "TOTAL_Value", "MIN_DAY", "MIN_Value", "MAX_DAY", "MAX_Value" + "STATION_NUMBER", + "Year", + "Month", + "Full_Month", + "No_days", + "MEAN_Value", + "TOTAL_Value", + "MIN_DAY", + "MIN_Value", + "MAX_DAY", + "MAX_Value" ) - - - sed_monthly_loads <- tidyr::gather(sed_monthly_loads, !!sym_variable, !!sym_temp, -(STATION_NUMBER:No_days)) - sed_monthly_loads <- tidyr::separate(sed_monthly_loads, !!sym_variable, into = c("Sum_stat", "temp2"), sep = "_") + sed_monthly_loads <- tidyr::gather( + sed_monthly_loads, + !!sym_variable, + !!sym_temp, + -(STATION_NUMBER:No_days) + ) + sed_monthly_loads <- tidyr::separate( + sed_monthly_loads, + !!sym_variable, + into = c("Sum_stat", "temp2"), + sep = "_" + ) sed_monthly_loads <- tidyr::spread(sed_monthly_loads, !!sym_temp2, !!sym_temp) ## convert into R date for date of occurence. - sed_monthly_loads <- dplyr::mutate(sed_monthly_loads, Date_occurred = paste0(Year, "-", Month, "-", DAY)) + sed_monthly_loads <- dplyr::mutate( + sed_monthly_loads, + Date_occurred = paste0(Year, "-", Month, "-", DAY) + ) ## Check if DAY is NA and if so give it an NA value so the date parse correctly. - sed_monthly_loads <- dplyr::mutate(sed_monthly_loads, Date_occurred = ifelse(is.na(DAY), NA, Date_occurred)) - sed_monthly_loads <- dplyr::mutate(sed_monthly_loads, Date_occurred = lubridate::ymd(Date_occurred, quiet = TRUE)) + sed_monthly_loads <- dplyr::mutate( + sed_monthly_loads, + Date_occurred = ifelse(is.na(DAY), NA, Date_occurred) + ) + sed_monthly_loads <- dplyr::mutate( + sed_monthly_loads, + Date_occurred = lubridate::ymd(Date_occurred, quiet = TRUE) + ) ## Then when a date column exist fine tune the subset - if (!dates_null[["start_is_null"]]) sed_monthly_loads <- dplyr::filter(sed_monthly_loads, Date_occurred >= start_date) - if (!dates_null[["end_is_null"]]) sed_monthly_loads <- dplyr::filter(sed_monthly_loads, Date_occurred <= end_date) + if (!dates_null[["start_is_null"]]) + sed_monthly_loads <- dplyr::filter( + sed_monthly_loads, + Date_occurred >= start_date + ) + if (!dates_null[["end_is_null"]]) + sed_monthly_loads <- dplyr::filter( + sed_monthly_loads, + Date_occurred <= end_date + ) sed_monthly_loads <- dplyr::select(sed_monthly_loads, -DAY) - sed_monthly_loads <- dplyr::mutate(sed_monthly_loads, Full_Month = Full_Month == 1) + sed_monthly_loads <- dplyr::mutate( + sed_monthly_loads, + Full_Month = Full_Month == 1 + ) - attr(sed_monthly_loads, "missed_stns") <- setdiff(unique(stns), unique(sed_monthly_loads$STATION_NUMBER)) + attr(sed_monthly_loads, "missed_stns") <- setdiff( + unique(stns), + unique(sed_monthly_loads$STATION_NUMBER) + ) as.hy(sed_monthly_loads) } diff --git a/R/hy_sed_monthly_suscon.R b/R/hy_sed_monthly_suscon.R index 8f78aeb..b00676e 100644 --- a/R/hy_sed_monthly_suscon.R +++ b/R/hy_sed_monthly_suscon.R @@ -43,13 +43,13 @@ #' @source HYDAT #' @export - - -hy_sed_monthly_suscon <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL) { +hy_sed_monthly_suscon <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -71,14 +71,24 @@ hy_sed_monthly_suscon <- function(station_number = NULL, ## Data manipulations to make it "tidy" sed_monthly_suscon <- dplyr::tbl(hydat_con, "SED_DLY_SUSCON") - sed_monthly_suscon <- dplyr::filter(sed_monthly_suscon, !!sym_STATION_NUMBER %in% stns) + sed_monthly_suscon <- dplyr::filter( + sed_monthly_suscon, + !!sym_STATION_NUMBER %in% stns + ) ## Do the initial subset to take advantage of dbplyr only issuing sql query when it has too ## by year - if (!dates_null[["start_is_null"]]) sed_monthly_suscon <- dplyr::filter(sed_monthly_suscon, !!sym_YEAR >= lubridate::year(start_date)) - if (!dates_null[["end_is_null"]]) sed_monthly_suscon <- dplyr::filter(sed_monthly_suscon, !!sym_YEAR <= lubridate::year(end_date)) - + if (!dates_null[["start_is_null"]]) + sed_monthly_suscon <- dplyr::filter( + sed_monthly_suscon, + !!sym_YEAR >= lubridate::year(start_date) + ) + if (!dates_null[["end_is_null"]]) + sed_monthly_suscon <- dplyr::filter( + sed_monthly_suscon, + !!sym_YEAR <= lubridate::year(end_date) + ) sed_monthly_suscon <- dplyr::select(sed_monthly_suscon, STATION_NUMBER:MAX) sed_monthly_suscon <- dplyr::collect(sed_monthly_suscon) @@ -89,31 +99,74 @@ hy_sed_monthly_suscon <- function(station_number = NULL, ## Need to rename columns for gather colnames(sed_monthly_suscon) <- c( - "STATION_NUMBER", "Year", "Month", "Full_Month", "No_days", - "TOTAL_Value", "MIN_DAY", "MIN_Value", "MAX_DAY", "MAX_Value" + "STATION_NUMBER", + "Year", + "Month", + "Full_Month", + "No_days", + "TOTAL_Value", + "MIN_DAY", + "MIN_Value", + "MAX_DAY", + "MAX_Value" ) + sed_monthly_suscon <- tidyr::gather( + sed_monthly_suscon, + !!sym_variable, + !!sym_temp, + -(STATION_NUMBER:No_days) + ) + sed_monthly_suscon <- tidyr::separate( + sed_monthly_suscon, + !!sym_variable, + into = c("Sum_stat", "temp2"), + sep = "_" + ) - - sed_monthly_suscon <- tidyr::gather(sed_monthly_suscon, !!sym_variable, !!sym_temp, -(STATION_NUMBER:No_days)) - sed_monthly_suscon <- tidyr::separate(sed_monthly_suscon, !!sym_variable, into = c("Sum_stat", "temp2"), sep = "_") - - sed_monthly_suscon <- tidyr::spread(sed_monthly_suscon, !!sym_temp2, !!sym_temp) + sed_monthly_suscon <- tidyr::spread( + sed_monthly_suscon, + !!sym_temp2, + !!sym_temp + ) ## convert into R date for date of occurence. - sed_monthly_suscon <- dplyr::mutate(sed_monthly_suscon, Date_occurred = paste0(Year, "-", Month, "-", DAY)) + sed_monthly_suscon <- dplyr::mutate( + sed_monthly_suscon, + Date_occurred = paste0(Year, "-", Month, "-", DAY) + ) ## Check if DAY is NA and if so give it an NA value so the date parse correctly. - sed_monthly_suscon <- dplyr::mutate(sed_monthly_suscon, Date_occurred = ifelse(is.na(DAY), NA, Date_occurred)) - sed_monthly_suscon <- dplyr::mutate(sed_monthly_suscon, Date_occurred = lubridate::ymd(Date_occurred, quiet = TRUE)) + sed_monthly_suscon <- dplyr::mutate( + sed_monthly_suscon, + Date_occurred = ifelse(is.na(DAY), NA, Date_occurred) + ) + sed_monthly_suscon <- dplyr::mutate( + sed_monthly_suscon, + Date_occurred = lubridate::ymd(Date_occurred, quiet = TRUE) + ) ## Then when a date column exist fine tune the subset - if (!dates_null[["start_is_null"]]) sed_monthly_suscon <- dplyr::filter(sed_monthly_suscon, Date_occurred >= start_date) - if (!dates_null[["end_is_null"]]) sed_monthly_suscon <- dplyr::filter(sed_monthly_suscon, Date_occurred <= end_date) + if (!dates_null[["start_is_null"]]) + sed_monthly_suscon <- dplyr::filter( + sed_monthly_suscon, + Date_occurred >= start_date + ) + if (!dates_null[["end_is_null"]]) + sed_monthly_suscon <- dplyr::filter( + sed_monthly_suscon, + Date_occurred <= end_date + ) sed_monthly_suscon <- dplyr::select(sed_monthly_suscon, -DAY) - sed_monthly_suscon <- dplyr::mutate(sed_monthly_suscon, Full_Month = Full_Month == 1) + sed_monthly_suscon <- dplyr::mutate( + sed_monthly_suscon, + Full_Month = Full_Month == 1 + ) - attr(sed_monthly_suscon, "missed_stns") <- setdiff(unique(stns), unique(sed_monthly_suscon$STATION_NUMBER)) + attr(sed_monthly_suscon, "missed_stns") <- setdiff( + unique(stns), + unique(sed_monthly_suscon$STATION_NUMBER) + ) as.hy(sed_monthly_suscon) } diff --git a/R/hy_sed_samples.R b/R/hy_sed_samples.R index 6c12852..289029b 100644 --- a/R/hy_sed_samples.R +++ b/R/hy_sed_samples.R @@ -52,17 +52,16 @@ #' @source HYDAT #' @export - - -hy_sed_samples <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL) { +hy_sed_samples <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) - ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -76,38 +75,84 @@ hy_sed_samples <- function(station_number = NULL, sym_STATION_NUMBER <- sym("STATION_NUMBER") sym_DATE <- sym("DATE") - ## Data manipulations sed_samples <- dplyr::tbl(hydat_con, "SED_SAMPLES") sed_samples <- dplyr::filter(sed_samples, !!sym_STATION_NUMBER %in% stns) - sed_samples <- dplyr::left_join(sed_samples, dplyr::tbl(hydat_con, "SED_DATA_TYPES"), by = c("SED_DATA_TYPE")) - sed_samples <- dplyr::left_join(sed_samples, dplyr::tbl(hydat_con, "SAMPLE_REMARK_CODES"), by = c("SAMPLE_REMARK_CODE")) sed_samples <- dplyr::left_join( - sed_samples, dplyr::tbl(hydat_con, "SED_VERTICAL_LOCATION"), + sed_samples, + dplyr::tbl(hydat_con, "SED_DATA_TYPES"), + by = c("SED_DATA_TYPE") + ) + sed_samples <- dplyr::left_join( + sed_samples, + dplyr::tbl(hydat_con, "SAMPLE_REMARK_CODES"), + by = c("SAMPLE_REMARK_CODE") + ) + sed_samples <- dplyr::left_join( + sed_samples, + dplyr::tbl(hydat_con, "SED_VERTICAL_LOCATION"), by = c("SAMPLING_VERTICAL_LOCATION" = "SAMPLING_VERTICAL_LOCATION_ID") ) - sed_samples <- dplyr::left_join(sed_samples, dplyr::tbl(hydat_con, "SED_VERTICAL_SYMBOLS"), by = c("SAMPLING_VERTICAL_SYMBOL")) - sed_samples <- dplyr::left_join(sed_samples, dplyr::tbl(hydat_con, "CONCENTRATION_SYMBOLS"), by = c("CONCENTRATION_SYMBOL")) + sed_samples <- dplyr::left_join( + sed_samples, + dplyr::tbl(hydat_con, "SED_VERTICAL_SYMBOLS"), + by = c("SAMPLING_VERTICAL_SYMBOL") + ) + sed_samples <- dplyr::left_join( + sed_samples, + dplyr::tbl(hydat_con, "CONCENTRATION_SYMBOLS"), + by = c("CONCENTRATION_SYMBOL") + ) sed_samples <- dplyr::collect(sed_samples) - if (is.data.frame(sed_samples) && nrow(sed_samples) == 0) stop("This station is not present in HYDAT") + if (is.data.frame(sed_samples) && nrow(sed_samples) == 0) + stop("This station is not present in HYDAT") - sed_samples <- dplyr::left_join(sed_samples, tidyhydat::hy_data_symbols, by = c("FLOW_SYMBOL" = "SYMBOL_ID")) - sed_samples <- dplyr::mutate(sed_samples, DATE = lubridate::ymd_hms(DATE), date_no_time = as.Date(DATE)) + sed_samples <- dplyr::left_join( + sed_samples, + tidyhydat::hy_data_symbols, + by = c("FLOW_SYMBOL" = "SYMBOL_ID") + ) + sed_samples <- dplyr::mutate( + sed_samples, + DATE = lubridate::ymd_hms(DATE), + date_no_time = as.Date(DATE) + ) ## SUBSET by date - if (!dates_null[["start_is_null"]]) sed_samples <- dplyr::filter(sed_samples, !!sym("date_no_time") >= as.Date(start_date)) - if (!dates_null[["end_is_null"]]) sed_samples <- dplyr::filter(sed_samples, !!sym("date_no_time") <= as.Date(end_date)) - + if (!dates_null[["start_is_null"]]) + sed_samples <- dplyr::filter( + sed_samples, + !!sym("date_no_time") >= as.Date(start_date) + ) + if (!dates_null[["end_is_null"]]) + sed_samples <- dplyr::filter( + sed_samples, + !!sym("date_no_time") <= as.Date(end_date) + ) sed_samples <- dplyr::select( - sed_samples, STATION_NUMBER, SED_DATA_TYPE_EN, - Date = DATE, SAMPLE_REMARK_EN, TIME_SYMBOL, - FLOW, SYMBOL_EN, SAMPLER_TYPE, SAMPLING_VERTICAL_LOCATION, SAMPLING_VERTICAL_EN, - TEMPERATURE, CONCENTRATION, CONCENTRATION_EN, SV_DEPTH2 + sed_samples, + STATION_NUMBER, + SED_DATA_TYPE_EN, + Date = DATE, + SAMPLE_REMARK_EN, + TIME_SYMBOL, + FLOW, + SYMBOL_EN, + SAMPLER_TYPE, + SAMPLING_VERTICAL_LOCATION, + SAMPLING_VERTICAL_EN, + TEMPERATURE, + CONCENTRATION, + CONCENTRATION_EN, + SV_DEPTH2 ) - attr(sed_samples, "missed_stns") <- setdiff(unique(stns), unique(sed_samples$STATION_NUMBER)) + attr(sed_samples, "missed_stns") <- setdiff( + unique(stns), + unique(sed_samples$STATION_NUMBER) + ) as.hy(sed_samples) } diff --git a/R/hy_sed_samples_psd.R b/R/hy_sed_samples_psd.R index 33373a8..9555b7b 100644 --- a/R/hy_sed_samples_psd.R +++ b/R/hy_sed_samples_psd.R @@ -41,13 +41,13 @@ #' @source HYDAT #' @export - - -hy_sed_samples_psd <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL, - start_date = NULL, - end_date = NULL) { +hy_sed_samples_psd <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL, + start_date = NULL, + end_date = NULL +) { ## Determine which dates should be queried dates_null <- date_check(start_date, end_date) @@ -66,25 +66,51 @@ hy_sed_samples_psd <- function(station_number = NULL, ## Data manipulations sed_samples_psd <- dplyr::tbl(hydat_con, "SED_SAMPLES_PSD") - sed_samples_psd <- dplyr::filter(sed_samples_psd, !!sym_STATION_NUMBER %in% stns) - sed_samples_psd <- dplyr::left_join(sed_samples_psd, dplyr::tbl(hydat_con, "SED_DATA_TYPES"), by = c("SED_DATA_TYPE")) + sed_samples_psd <- dplyr::filter( + sed_samples_psd, + !!sym_STATION_NUMBER %in% stns + ) + sed_samples_psd <- dplyr::left_join( + sed_samples_psd, + dplyr::tbl(hydat_con, "SED_DATA_TYPES"), + by = c("SED_DATA_TYPE") + ) sed_samples_psd <- dplyr::collect(sed_samples_psd) - if (is.data.frame(sed_samples_psd) && nrow(sed_samples_psd) == 0) stop("This station is not present in HYDAT") + if (is.data.frame(sed_samples_psd) && nrow(sed_samples_psd) == 0) + stop("This station is not present in HYDAT") - sed_samples_psd <- dplyr::mutate(sed_samples_psd, DATE = lubridate::ymd_hms(DATE), date_no_time = as.Date(DATE)) + sed_samples_psd <- dplyr::mutate( + sed_samples_psd, + DATE = lubridate::ymd_hms(DATE), + date_no_time = as.Date(DATE) + ) ## SUBSET by date - if (!dates_null[["start_is_null"]]) sed_samples_psd <- dplyr::filter(sed_samples_psd, !!sym("date_no_time") >= as.Date(start_date)) - if (!dates_null[["end_is_null"]]) sed_samples_psd <- dplyr::filter(sed_samples_psd, !!sym("date_no_time") <= as.Date(end_date)) - + if (!dates_null[["start_is_null"]]) + sed_samples_psd <- dplyr::filter( + sed_samples_psd, + !!sym("date_no_time") >= as.Date(start_date) + ) + if (!dates_null[["end_is_null"]]) + sed_samples_psd <- dplyr::filter( + sed_samples_psd, + !!sym("date_no_time") <= as.Date(end_date) + ) - sed_samples_psd <- dplyr::select(sed_samples_psd, STATION_NUMBER, + sed_samples_psd <- dplyr::select( + sed_samples_psd, + STATION_NUMBER, SED_DATA_TYPE = SED_DATA_TYPE_EN, - Date = DATE, PARTICLE_SIZE, PERCENT + Date = DATE, + PARTICLE_SIZE, + PERCENT ) - attr(sed_samples_psd, "missed_stns") <- setdiff(unique(stns), unique(sed_samples_psd$STATION_NUMBER)) + attr(sed_samples_psd, "missed_stns") <- setdiff( + unique(stns), + unique(sed_samples_psd$STATION_NUMBER) + ) as.hy(sed_samples_psd) } diff --git a/R/hy_stations.R b/R/hy_stations.R index 9582d78..7d69d7a 100644 --- a/R/hy_stations.R +++ b/R/hy_stations.R @@ -10,8 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - - #' Extract station information from the HYDAT database #' #' Provides wrapper to turn the hy_stations table in HYDAT into a tidy data frame of station information. `station_number` and @@ -66,9 +64,11 @@ #' @source HYDAT #' @export -hy_stations <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL) { +hy_stations <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -101,7 +101,6 @@ hy_stations <- function(station_number = NULL, REAL_TIME = REAL_TIME == 1 ) - attr(df, "missed_stns") <- setdiff(unique(stns), unique(df$STATION_NUMBER)) as.hy(df) } diff --git a/R/hy_stn_regulation.R b/R/hy_stn_regulation.R index 2dcd8c4..576fb93 100644 --- a/R/hy_stn_regulation.R +++ b/R/hy_stn_regulation.R @@ -10,8 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - - #' Extract station regulation from the HYDAT database #' #' Provides wrapper to turn the hy_stn_regulation table in HYDAT into a tidy data frame of station regulation. @@ -44,9 +42,11 @@ #' @source HYDAT #' @export -hy_stn_regulation <- function(station_number = NULL, - hydat_path = NULL, - prov_terr_state_loc = NULL) { +hy_stn_regulation <- function( + station_number = NULL, + hydat_path = NULL, + prov_terr_state_loc = NULL +) { ## Read in database hydat_con <- hy_src(hydat_path) if (!dplyr::is.src(hydat_path)) { @@ -67,6 +67,9 @@ hy_stn_regulation <- function(station_number = NULL, colnames(stn_reg) <- c("STATION_NUMBER", "Year_from", "Year_to", "REGULATED") - attr(stn_reg, "missed_stns") <- setdiff(unique(stns), unique(stn_reg$STATION_NUMBER)) + attr(stn_reg, "missed_stns") <- setdiff( + unique(stns), + unique(stn_reg$STATION_NUMBER) + ) as.hy(stn_reg) } diff --git a/R/realtime-classes.R b/R/realtime-classes.R index b7a8a46..9268396 100644 --- a/R/realtime-classes.R +++ b/R/realtime-classes.R @@ -24,7 +24,10 @@ as.realtime <- function(x) { print.realtime <- function(x, ...) { cat(paste(" Queried on:", attributes(x)$query_time, "(UTC)\n")) if (c("Date") %in% names(x) && !all(is.na(x$Date))) { - date_range <- paste0(range(as.Date(x$Date), na.rm = TRUE), collapse = " to ") + date_range <- paste0( + range(as.Date(x$Date), na.rm = TRUE), + collapse = " to " + ) cat(paste0(" Date range: ", date_range, " \n")) } else { cat(" Date range: not available \n") diff --git a/R/realtime-webservice.R b/R/realtime-webservice.R index 5c277b1..d9cfbb4 100755 --- a/R/realtime-webservice.R +++ b/R/realtime-webservice.R @@ -10,12 +10,9 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - - - #' Download realtime data from the ECCC web service #' -#' Function to actually retrieve data from ECCC web service. +#' Function to actually retrieve data from ECCC web service. #' The maximum number of days that can be queried depends on other parameters being requested. #' If one station is requested, 18 months of data can be requested. If you continually receiving #' errors when invoking this function, reduce the number of observations (via station_number, @@ -65,45 +62,58 @@ #' @family realtime functions #' @export - -realtime_ws <- function(station_number, - parameters = NULL, - start_date = Sys.Date() - 30, - end_date = Sys.Date()) { - +realtime_ws <- function( + station_number, + parameters = NULL, + start_date = Sys.Date() - 30, + end_date = Sys.Date() +) { if (is.null(parameters)) parameters <- c(46, 16, 52, 47, 8, 5, 41, 18) if (any(!parameters %in% param_id$Parameter)) { stop( paste0( - paste0(parameters[!parameters %in% tidyhydat::param_id$Parameter], collapse = ","), + paste0( + parameters[!parameters %in% tidyhydat::param_id$Parameter], + collapse = "," + ), " are invalid parameters. Check param_id for a list of valid options." ), call. = FALSE ) } - if (!is.numeric(parameters)) stop("parameters should be a number", call. = FALSE) + if (!is.numeric(parameters)) + stop("parameters should be a number", call. = FALSE) - if (inherits(start_date, "Date")) start_date <- paste0(start_date, " 00:00:00") + if (inherits(start_date, "Date")) + start_date <- paste0(start_date, " 00:00:00") if (inherits(end_date, "Date")) end_date <- paste0(end_date, " 23:59:59") - - if (!grepl("[0-9]{4}-[0-1][0-9]-[0-3][0-9] [0-2][0-9]:[0-5][0-9]:[0-5][0-9]", start_date)) { + if ( + !grepl( + "[0-9]{4}-[0-1][0-9]-[0-3][0-9] [0-2][0-9]:[0-5][0-9]:[0-5][0-9]", + start_date + ) + ) { stop( "Invalid date format. start_date need to be in either YYYY-MM-DD or YYYY-MM-DD HH:MM:SS formats", call. = FALSE ) } - if (!grepl("[0-9]{4}-[0-1][0-9]-[0-3][0-9] [0-2][0-9]:[0-5][0-9]:[0-5][0-9]", end_date)) { + if ( + !grepl( + "[0-9]{4}-[0-1][0-9]-[0-3][0-9] [0-2][0-9]:[0-5][0-9]:[0-5][0-9]", + end_date + ) + ) { stop( "Invalid date format. start_date need to be in either YYYY-MM-DD or YYYY-MM-DD HH:MM:SS formats", call. = FALSE ) } - if (!is.null(start_date) & !is.null(end_date)) { if (lubridate::ymd_hms(end_date) < lubridate::ymd_hms(start_date)) { stop( @@ -114,26 +124,36 @@ realtime_ws <- function(station_number, } ## Check date is in the right format - if (is.na(as.Date(start_date, format = "%Y-%m-%d")) | is.na(as.Date(end_date, format = "%Y-%m-%d"))) { + if ( + is.na(as.Date(start_date, format = "%Y-%m-%d")) | + is.na(as.Date(end_date, format = "%Y-%m-%d")) + ) { stop("Invalid date format. Dates need to be in YYYY-MM-DD format") } ## Build link for GET baseurl <- "https://wateroffice.ec.gc.ca/services/real_time_data/csv/inline?" - station_string <- paste0("stations[]=", station_number, collapse = "&") parameters_string <- paste0("parameters[]=", parameters, collapse = "&") date_string <- paste0( - "start_date=", substr(start_date, 1, 10), "%20", substr(start_date, 12, 19), - "&end_date=", substr(end_date, 1, 10), "%20", substr(end_date, 12, 19) + "start_date=", + substr(start_date, 1, 10), + "%20", + substr(start_date, 12, 19), + "&end_date=", + substr(end_date, 1, 10), + "%20", + substr(end_date, 12, 19) ) ## paste them all together query_url <- paste0( baseurl, - station_string, "&", - parameters_string, "&", + station_string, + "&", + parameters_string, + "&", date_string ) @@ -145,11 +165,9 @@ realtime_ws <- function(station_number, ## Give webservice some time Sys.sleep(1) - ## Check the respstatus httr2::resp_check_status(resp) - if (httr2::resp_headers(resp)$`Content-Type` != "text/csv; charset=utf-8") { stop("Response is not a csv file") } @@ -160,14 +178,21 @@ realtime_ws <- function(station_number, col_types = "cTidccc" ) - ## Check here to see if csv_df has any data in it if (nrow(csv_df) == 0) { stop("No data exists for this station query") } ## Rename columns to reflect tidyhydat naming - colnames(csv_df) <- c("STATION_NUMBER", "Date", "Parameter", "Value", "Grade", "Symbol", "Approval") + colnames(csv_df) <- c( + "STATION_NUMBER", + "Date", + "Parameter", + "Value", + "Grade", + "Symbol", + "Approval" + ) csv_df <- dplyr::left_join( csv_df, @@ -175,18 +200,34 @@ realtime_ws <- function(station_number, by = c("Parameter") ) csv_df <- dplyr::select( - csv_df, STATION_NUMBER, Date, Name_En, Value, Unit, - Grade, Symbol, Approval, Parameter, Code + csv_df, + STATION_NUMBER, + Date, + Name_En, + Value, + Unit, + Grade, + Symbol, + Approval, + Parameter, + Code ) ## What stations were missed? differ <- setdiff(unique(station_number), unique(csv_df$STATION_NUMBER)) if (length(differ) != 0) { if (length(differ) <= 10) { - message("The following station(s) were not retrieved: ", paste0(differ, sep = " ")) - message("Check station number for typos or if it is a valid station in the network") + message( + "The following station(s) were not retrieved: ", + paste0(differ, sep = " ") + ) + message( + "Check station number for typos or if it is a valid station in the network" + ) } else { - message("More than 10 stations from the initial query were not returned. Ensure realtime and active status are correctly specified.") + message( + "More than 10 stations from the initial query were not returned. Ensure realtime and active status are correctly specified." + ) } } else { message("All station successfully retrieved") @@ -194,12 +235,14 @@ realtime_ws <- function(station_number, p_differ <- setdiff(unique(parameters), unique(csv_df$Parameter)) if (length(p_differ) != 0) { - message("The following valid parameter(s) were not retrieved for at least one station you requested: ", paste0(p_differ, sep = " ")) + message( + "The following valid parameter(s) were not retrieved for at least one station you requested: ", + paste0(p_differ, sep = " ") + ) } else { message("All parameters successfully retrieved") } - ## Return it csv_df diff --git a/R/realtime.R b/R/realtime.R index 2897276..3ed6dfb 100644 --- a/R/realtime.R +++ b/R/realtime.R @@ -10,7 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - #' Download a tibble of realtime river data from the last 30 days from the Meteorological Service of Canada datamart #' #' Download realtime river data from the last 30 days from the Meteorological Service of Canada (MSC) datamart. @@ -128,7 +127,6 @@ realtime_stations <- function(prov_terr_state_loc = NULL) { return(net_tibble) } - as.realtime(net_tibble[net_tibble$PROV_TERR_STATE_LOC %in% prov, ]) } @@ -154,12 +152,22 @@ realtime_stations <- function(prov_terr_state_loc = NULL) { #' #' @export realtime_add_local_datetime <- function(.data, set_tz = NULL) { - timezone_data <- dplyr::left_join(.data, tidyhydat::allstations[, c("STATION_NUMBER", "station_tz")], by = c("STATION_NUMBER")) + timezone_data <- dplyr::left_join( + .data, + tidyhydat::allstations[, c("STATION_NUMBER", "station_tz")], + by = c("STATION_NUMBER") + ) tz_used <- names(sort(table(timezone_data$station_tz), decreasing = TRUE)[1]) if (dplyr::n_distinct(timezone_data$station_tz) > 1) { - warning(paste0("Multiple timezones detected. All times in local_time have been adjusted to ", tz_used), call. = FALSE) + warning( + paste0( + "Multiple timezones detected. All times in local_time have been adjusted to ", + tz_used + ), + call. = FALSE + ) } if (!is.null(set_tz)) { @@ -167,13 +175,22 @@ realtime_add_local_datetime <- function(.data, set_tz = NULL) { tz_used <- set_tz } - timezone_data$local_datetime <- lubridate::with_tz(timezone_data$Date, tz = tz_used) + timezone_data$local_datetime <- lubridate::with_tz( + timezone_data$Date, + tz = tz_used + ) timezone_data$tz_used <- tz_used dplyr::select( - timezone_data, STATION_NUMBER, PROV_TERR_STATE_LOC, Date, - station_tz, local_datetime, tz_used, dplyr::everything() + timezone_data, + STATION_NUMBER, + PROV_TERR_STATE_LOC, + Date, + station_tz, + local_datetime, + tz_used, + dplyr::everything() ) } @@ -195,11 +212,17 @@ realtime_add_local_datetime <- function(.data, set_tz = NULL) { realtime_daily_mean <- function(.data, na.rm = FALSE) { df_mean <- dplyr::mutate(.data, Date = as.Date(Date)) - df_mean <- dplyr::group_by(df_mean, STATION_NUMBER, PROV_TERR_STATE_LOC, Date, Parameter) + df_mean <- dplyr::group_by( + df_mean, + STATION_NUMBER, + PROV_TERR_STATE_LOC, + Date, + Parameter + ) df_mean <- dplyr::summarise(df_mean, Value = mean(Value, na.rm = na.rm)) df_mean <- dplyr::arrange(df_mean, Parameter) dplyr::ungroup(df_mean) -} \ No newline at end of file +} diff --git a/R/realtime_plot.R b/R/realtime_plot.R index 2a07df6..29d7dea 100644 --- a/R/realtime_plot.R +++ b/R/realtime_plot.R @@ -30,27 +30,51 @@ plot.realtime <- function(x = NULL, Parameter = c("Flow", "Level"), ...) { Parameter <- match.arg(Parameter) if (length(unique(x$STATION_NUMBER)) > 1L) { - stop("realtime plots only work with objects that contain one station", call. = FALSE) + stop( + "realtime plots only work with objects that contain one station", + call. = FALSE + ) } if (is.null(x)) stop("Station not present in the datamart") ## Catch mis labelled parameter - if (Parameter == "Level" && ((nrow(x[x$Parameter == "Level", ]) == 0) | all(is.na(x[x$Parameter == "Level", ]$Value)))) { - stop(paste0(unique(x$STATION_NUMBER), " is likely a flow station. Try setting Parameter = 'Flow'"), call. = FALSE) + if ( + Parameter == "Level" && + ((nrow(x[x$Parameter == "Level", ]) == 0) | + all(is.na(x[x$Parameter == "Level", ]$Value))) + ) { + stop( + paste0( + unique(x$STATION_NUMBER), + " is likely a flow station. Try setting Parameter = 'Flow'" + ), + call. = FALSE + ) } - if (Parameter == "Flow" && ((nrow(x[x$Parameter == "Flow", ]) == 0) | all(is.na(x[x$Parameter == "Flow", ]$Value)))) { - stop(paste0(unique(x$STATION_NUMBER), " is likely a lake level station. Try setting Parameter = 'Level'"), call. = FALSE) + if ( + Parameter == "Flow" && + ((nrow(x[x$Parameter == "Flow", ]) == 0) | + all(is.na(x[x$Parameter == "Flow", ]$Value))) + ) { + stop( + paste0( + unique(x$STATION_NUMBER), + " is likely a lake level station. Try setting Parameter = 'Level'" + ), + call. = FALSE + ) } else { x <- x[x$Parameter == Parameter, ] } - - - ## Join with meta data to get station name - x <- dplyr::left_join(x, tidyhydat::allstations, by = c("STATION_NUMBER", "PROV_TERR_STATE_LOC")) + x <- dplyr::left_join( + x, + tidyhydat::allstations, + by = c("STATION_NUMBER", "PROV_TERR_STATE_LOC") + ) x$STATION <- paste(x$STATION_NAME, x$STATION_NUMBER, sep = " - ") @@ -61,10 +85,12 @@ plot.realtime <- function(x = NULL, Parameter = c("Flow", "Level"), ...) { mgp = c(3.1, 0.4, 0), las = 1, tck = -.01, - xaxs = "i", yaxs = "i" + xaxs = "i", + yaxs = "i" ) - graphics::plot(Value ~ Date, + graphics::plot( + Value ~ Date, data = x, xlab = "Date", ylab = eval(parse(text = label_helper(unique(x$Parameter)))), @@ -79,18 +105,28 @@ plot.realtime <- function(x = NULL, Parameter = c("Flow", "Level"), ...) { at_y <- utils::tail(utils::head(pretty(x$Value), -1), -1) graphics::mtext( - side = 2, text = at_y, at = at_y, - col = "grey20", line = 1, cex = 1 + side = 2, + text = at_y, + at = at_y, + col = "grey20", + line = 1, + cex = 1 ) at_x <- utils::tail(utils::head(pretty(x$Date), -1), -1) - graphics::mtext(side = 1, text = format(at_x, "%b-%d"), at = at_x, col = "grey20", line = 1, cex = 1) + graphics::mtext( + side = 1, + text = format(at_x, "%b-%d"), + at = at_x, + col = "grey20", + line = 1, + cex = 1 + ) graphics::title(main = paste0(unique(x$STATION)), cex.main = 1.1) } - #' Convenience function to plot realtime data #' #' This is an easy way to visualize a single station using base R graphics. @@ -114,47 +150,62 @@ plot.realtime <- function(x = NULL, Parameter = c("Flow", "Level"), ...) { #' #' @export -realtime_plot <- function(station_number = NULL, Parameter = c("Flow", "Level")) { +realtime_plot <- function( + station_number = NULL, + Parameter = c("Flow", "Level") +) { Parameter <- match.arg(Parameter) - if (length(station_number) > 1L) stop("realtime_plot only accepts one station number") + if (length(station_number) > 1L) + stop("realtime_plot only accepts one station number") rldf <- realtime_dd(station_number) if (is.null(rldf)) stop("Station(s) not present in the datamart") ## Is there any NA's in the flow data? - if (any(is.na(rldf[rldf$Parameter == "Flow", ]$Value)) & Parameter == "Flow") { + if ( + any(is.na(rldf[rldf$Parameter == "Flow", ]$Value)) & Parameter == "Flow" + ) { rldf <- rldf[rldf$Parameter == "Level", ] - message(paste0(station_number, " is lake level station. Defaulting Parameter = 'Level'")) + message(paste0( + station_number, + " is lake level station. Defaulting Parameter = 'Level'" + )) } else { rldf <- rldf[rldf$Parameter == Parameter, ] } - - - ## Join with meta data to get station name - rldf <- dplyr::left_join(rldf, realtime_stations(), by = c("STATION_NUMBER", "PROV_TERR_STATE_LOC")) + rldf <- dplyr::left_join( + rldf, + realtime_stations(), + by = c("STATION_NUMBER", "PROV_TERR_STATE_LOC") + ) rldf$STATION <- paste(rldf$STATION_NAME, rldf$STATION_NUMBER, sep = " - ") rldf$STATION <- factor(rldf$STATION) - - y_axis <- ifelse(Parameter == "Flow", expression(Discharge ~ (m^3 / s)), "Level (m)") + y_axis <- ifelse( + Parameter == "Flow", + expression(Discharge ~ (m^3 / s)), + "Level (m)" + ) ## Set the palette # palette(rainbow(length(unique(rldf$STATION_NUMBER)))) - graphics::plot(Value ~ Date, + graphics::plot( + Value ~ Date, data = rldf, col = rldf$STATION, main = "Realtime Water Survey of Canada Gauges", xlab = "Date", ylab = "", bty = "L", - pch = 20, cex = 1 + pch = 20, + cex = 1 ) graphics::title(ylab = y_axis, line = 2.25) diff --git a/R/utils-realtime.R b/R/utils-realtime.R index ef1bd56..ed73f58 100644 --- a/R/utils-realtime.R +++ b/R/utils-realtime.R @@ -33,17 +33,22 @@ single_realtime_station <- function(station_number) { ## first check internal dataframe for station info if (any(tidyhydat::allstations$STATION_NUMBER %in% station_number)) { - choose_df <- dplyr::filter(tidyhydat::allstations, !!sym_STATION_NUMBER %in% station_number) + choose_df <- dplyr::filter( + tidyhydat::allstations, + !!sym_STATION_NUMBER %in% station_number + ) STATION_NUMBER_SEL <- choose_df$STATION_NUMBER PROV <- choose_df$PROV_TERR_STATE_LOC } else { - choose_df <- dplyr::filter(realtime_stations(), !!sym_STATION_NUMBER %in% station_number) + choose_df <- dplyr::filter( + realtime_stations(), + !!sym_STATION_NUMBER %in% station_number + ) STATION_NUMBER_SEL <- choose_df$STATION_NUMBER PROV <- choose_df$PROV_TERR_STATE_LOC } } - base_url <- "https://dd.weather.gc.ca/hydrometric" # build URL @@ -63,8 +68,16 @@ single_realtime_station <- function(station_number) { h_resp_str <- realtime_parser(infile[1]) if (is.na(h_resp_str)) { h <- dplyr::tibble( - A = station_number, B = NA, C = NA, D = NA, E = NA, - F = NA, G = NA, H = NA, I = NA, J = NA + A = station_number, + B = NA, + C = NA, + D = NA, + E = NA, + F = NA, + G = NA, + H = NA, + I = NA, + J = NA ) colnames(h) <- colHeaders h <- readr::type_convert(h, realtime_cols_types()) @@ -77,14 +90,21 @@ single_realtime_station <- function(station_number) { ) } - # download daily file p_resp_str <- realtime_parser(infile[2]) if (is.na(p_resp_str)) { d <- dplyr::tibble( - A = station_number, B = NA, C = NA, D = NA, E = NA, - F = NA, G = NA, H = NA, I = NA, J = NA + A = station_number, + B = NA, + C = NA, + D = NA, + E = NA, + F = NA, + G = NA, + H = NA, + I = NA, + J = NA ) colnames(d) <- colHeaders d <- readr::type_convert(d, realtime_cols_types()) @@ -115,12 +135,11 @@ all_realtime_station <- function(PROV) { colHeaders <- realtime_cols_headers() output <- readr::read_csv( res, - skip = 1, + skip = 1, col_names = colHeaders, col_types = realtime_cols_types() ) - ## Offloading tidying to another function realtime_tidy_data(output, PROV) } @@ -166,14 +185,27 @@ realtime_tidy_data <- function(data, prov) { ## TODO: Find a better way to do this data <- dplyr::rename(data, `Level_` = Level, `Flow_` = Flow) data <- tidyr::gather(data, !!sym_temp, !!sym_val, -STATION_NUMBER, -Date) - data <- tidyr::separate(data, !!sym_temp, c("Parameter", "key"), sep = "_", remove = TRUE) + data <- tidyr::separate( + data, + !!sym_temp, + c("Parameter", "key"), + sep = "_", + remove = TRUE + ) data <- dplyr::mutate(data, key = ifelse(key == "", "Value", key)) data <- tidyr::spread(data, !!sym_key, !!sym_val) data <- dplyr::rename(data, Code = CODE, Grade = GRADE, Symbol = SYMBOL) data <- dplyr::mutate(data, PROV_TERR_STATE_LOC = prov) data <- dplyr::select( - data, STATION_NUMBER, PROV_TERR_STATE_LOC, Date, Parameter, Value, - Grade, Symbol, Code + data, + STATION_NUMBER, + PROV_TERR_STATE_LOC, + Date, + Parameter, + Value, + Grade, + Symbol, + Code ) data <- dplyr::arrange(data, Parameter, STATION_NUMBER, Date) data$Value <- as.numeric(data$Value) @@ -182,8 +214,9 @@ realtime_tidy_data <- function(data, prov) { } has_internet <- function() { - z <- try(suppressWarnings(readLines("https://www.google.ca", n = 1)), + z <- try( + suppressWarnings(readLines("https://www.google.ca", n = 1)), silent = TRUE ) !inherits(z, "try-error") -} \ No newline at end of file +} diff --git a/R/utils-search.R b/R/utils-search.R index 183199c..b27d8b8 100644 --- a/R/utils-search.R +++ b/R/utils-search.R @@ -28,7 +28,13 @@ search_stn_name <- function(search_term, hydat_path = NULL) { results <- realtime_stations() |> dplyr::bind_rows(suppressMessages(hy_stations(hydat_path = hydat_con))) |> dplyr::distinct(STATION_NUMBER, .keep_all = TRUE) |> - dplyr::select(STATION_NUMBER, STATION_NAME, PROV_TERR_STATE_LOC, LATITUDE, LONGITUDE) + dplyr::select( + STATION_NUMBER, + STATION_NAME, + PROV_TERR_STATE_LOC, + LATITUDE, + LONGITUDE + ) results <- results[grepl(toupper(search_term), results$STATION_NAME), ] @@ -54,7 +60,13 @@ search_stn_number <- function(search_term, hydat_path = NULL) { results <- realtime_stations() |> dplyr::bind_rows(suppressMessages(hy_stations(hydat_path = hydat_con))) |> dplyr::distinct(STATION_NUMBER, .keep_all = TRUE) |> - dplyr::select(STATION_NUMBER, STATION_NAME, PROV_TERR_STATE_LOC, LATITUDE, LONGITUDE) + dplyr::select( + STATION_NUMBER, + STATION_NAME, + PROV_TERR_STATE_LOC, + LATITUDE, + LONGITUDE + ) results <- results[grepl(toupper(search_term), results$STATION_NUMBER), ] diff --git a/R/utils.R b/R/utils.R index b62b2b6..8903734 100644 --- a/R/utils.R +++ b/R/utils.R @@ -10,9 +10,6 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - - - #' @title Function to chose a station based on consistent arguments for hydat functions. #' #' @description A function to avoid duplication in HYDAT functions. This function is not intended for external use. @@ -25,21 +22,33 @@ #' station_choice <- function(hydat_con, station_number, prov_terr_state_loc) { if (!is.null(station_number) && !is.null(prov_terr_state_loc)) { - stop("Only specify one of station_number or prov_terr_state_loc.", call. = FALSE) + stop( + "Only specify one of station_number or prov_terr_state_loc.", + call. = FALSE + ) } if (!is.null(prov_terr_state_loc) && prov_terr_state_loc[1] == "CA") { prov_terr_state_loc <- c( - "QC", "NB", "PE", "NS", "ON", "NL", "MB", - "AB", "SK", "NU", "NT", "BC", "YT" + "QC", + "NB", + "PE", + "NS", + "ON", + "NL", + "MB", + "AB", + "SK", + "NU", + "NT", + "BC", + "YT" ) } - ## Prov symbol sym_PROV_TERR_STATE_LOC <- sym("PROV_TERR_STATE_LOC") - ## Get all stations if (is.null(station_number) && is.null(prov_terr_state_loc)) { stns <- dplyr::tbl(hydat_con, "STATIONS") |> @@ -61,7 +70,8 @@ station_choice <- function(hydat_con, station_number, prov_terr_state_loc) { ## Only possible values for prov_terr_state_loc stn_option <- unique(tidyhydat::allstations$PROV_TERR_STATE_LOC) - if (any(!prov_terr_state_loc %in% stn_option) == TRUE) stop("Invalid prov_terr_state_loc value") + if (any(!prov_terr_state_loc %in% stn_option) == TRUE) + stop("Invalid prov_terr_state_loc value") dplyr::tbl(hydat_con, "STATIONS") |> dplyr::filter(!!sym_PROV_TERR_STATE_LOC %in% prov_terr_state_loc) |> @@ -80,18 +90,26 @@ date_check <- function(start_date = NULL, end_date = NULL) { ## Check date is in the right format TODO if (!is.null(start_date)) { - if (!grepl("[0-9]{4}-[0-1][0-9]-[0-3][0-9]", start_date)) stop("Invalid date format. start_date need to be in YYYY-MM-DD format", call. = FALSE) + if (!grepl("[0-9]{4}-[0-1][0-9]-[0-3][0-9]", start_date)) + stop( + "Invalid date format. start_date need to be in YYYY-MM-DD format", + call. = FALSE + ) } if (!is.null(end_date)) { - if (!grepl("[0-9]{4}-[0-1][0-9]-[0-3][0-9]", end_date)) stop("Invalid date format. end_date need to be in YYYY-MM-DD format", call. = FALSE) + if (!grepl("[0-9]{4}-[0-1][0-9]-[0-3][0-9]", end_date)) + stop( + "Invalid date format. end_date need to be in YYYY-MM-DD format", + call. = FALSE + ) } if (!is.null(start_date) & !is.null(end_date)) { - if (lubridate::ymd(end_date) < lubridate::ymd(start_date)) stop("start_date is after end_date. Try swapping values.", call. = FALSE) + if (lubridate::ymd(end_date) < lubridate::ymd(start_date)) + stop("start_date is after end_date. Try swapping values.", call. = FALSE) } - invisible(list(start_is_null = start_is_null, end_is_null = end_is_null)) } @@ -114,7 +132,9 @@ differ_msg <- function(stns_input, stns_output) { "The following station(s) were not retrieved: ", paste0(differ, sep = " ") ) - message("Check station number typos or if it is a valid station in the network") + message( + "Check station number typos or if it is a valid station in the network" + ) } else { message( "More than 10 stations from the initial query were not returned. Ensure realtime and active status are correctly specified." @@ -136,7 +156,12 @@ multi_param_msg <- function(data_arg, stns, params) { ## Is the data anything other than a tibble? if (!inherits(data_arg, "tbl_df")) { return( - cli::cat_line(paste0(crayon::red(cli::symbol$cross), " ", stns, collapse = "\n")) + cli::cat_line(paste0( + crayon::red(cli::symbol$cross), + " ", + stns, + collapse = "\n" + )) ) } @@ -150,7 +175,12 @@ multi_param_msg <- function(data_arg, stns, params) { good_stns <- c() if (length(flow_stns) > 0L) { - good_stns <- paste0(crayon::green(cli::symbol$tick), " ", flow_stns, collapse = "\n") + good_stns <- paste0( + crayon::green(cli::symbol$tick), + " ", + flow_stns, + collapse = "\n" + ) } ## Station not in output @@ -158,7 +188,12 @@ multi_param_msg <- function(data_arg, stns, params) { bad_stns <- c() if (length(not_in) > 0L) { - bad_stns <- paste0(crayon::red(cli::symbol$cross), " ", not_in, collapse = "\n") + bad_stns <- paste0( + crayon::red(cli::symbol$cross), + " ", + not_in, + collapse = "\n" + ) } cli::cat_line(paste0(good_stns, "\n", bad_stns)) @@ -184,24 +219,27 @@ network_check <- function(url, proxy_url = NULL, proxy_port = NULL) { if (!is.null(proxy_url) && !is.null(proxy_port)) { req <- httr2::req_proxy(req, url = proxy_url, port = proxy_port) } - tryCatch(httr2::req_perform(req), - error = function(e) { - if (grepl("Timeout was reached:", e$message)) { - stop(paste0("Could not connect to HYDAT source. Check your connection settings. + tryCatch(httr2::req_perform(req), error = function(e) { + if (grepl("Timeout was reached:", e$message)) { + stop( + paste0( + "Could not connect to HYDAT source. Check your connection settings. Try downloading HYDAT_sqlite3 from this url: [http://collaboration.cmc.ec.gc.ca/cmc/hydrometrics/www/] - and unzipping the saved file to this directory: ", hy_dir()), - call. = FALSE - ) - } + and unzipping the saved file to this directory: ", + hy_dir() + ), + call. = FALSE + ) } - ) + }) } tidyhydat_agent <- function(req) { httr2::req_user_agent( - req, - string = "https://github.com/ropensci/tidyhydat") + req, + string = "https://github.com/ropensci/tidyhydat" + ) } @@ -226,7 +264,8 @@ tidyhydat_agent <- function(req) { #' } #' pull_station_number <- function(.data) { - if (!("STATION_NUMBER" %in% colnames(.data))) stop("No STATION_NUMBER column present", call. = FALSE) + if (!("STATION_NUMBER" %in% colnames(.data))) + stop("No STATION_NUMBER column present", call. = FALSE) unique(.data$STATION_NUMBER) } @@ -235,15 +274,39 @@ pull_station_number <- function(.data) { ## expected tables hy_expected_tbls <- function() { c( - "AGENCY_LIST", "ANNUAL_INSTANT_PEAKS", "ANNUAL_STATISTICS", - "CONCENTRATION_SYMBOLS", "DATA_SYMBOLS", "DATA_TYPES", "DATUM_LIST", - "DLY_FLOWS", "DLY_LEVELS", "MEASUREMENT_CODES", "OPERATION_CODES", - "PEAK_CODES", "PRECISION_CODES", "REGIONAL_OFFICE_LIST", "SAMPLE_REMARK_CODES", - "SED_DATA_TYPES", "SED_DLY_LOADS", "SED_DLY_SUSCON", "SED_SAMPLES", - "SED_SAMPLES_PSD", "SED_VERTICAL_LOCATION", "SED_VERTICAL_SYMBOLS", - "STATIONS", "STN_DATA_COLLECTION", "STN_DATA_RANGE", "STN_DATUM_CONVERSION", - "STN_DATUM_UNRELATED", "STN_OPERATION_SCHEDULE", "STN_REGULATION", - "STN_REMARKS", "STN_REMARK_CODES", "STN_STATUS_CODES", "VERSION" + "AGENCY_LIST", + "ANNUAL_INSTANT_PEAKS", + "ANNUAL_STATISTICS", + "CONCENTRATION_SYMBOLS", + "DATA_SYMBOLS", + "DATA_TYPES", + "DATUM_LIST", + "DLY_FLOWS", + "DLY_LEVELS", + "MEASUREMENT_CODES", + "OPERATION_CODES", + "PEAK_CODES", + "PRECISION_CODES", + "REGIONAL_OFFICE_LIST", + "SAMPLE_REMARK_CODES", + "SED_DATA_TYPES", + "SED_DLY_LOADS", + "SED_DLY_SUSCON", + "SED_SAMPLES", + "SED_SAMPLES_PSD", + "SED_VERTICAL_LOCATION", + "SED_VERTICAL_SYMBOLS", + "STATIONS", + "STN_DATA_COLLECTION", + "STN_DATA_RANGE", + "STN_DATUM_CONVERSION", + "STN_DATUM_UNRELATED", + "STN_OPERATION_SCHEDULE", + "STN_REGULATION", + "STN_REMARKS", + "STN_REMARK_CODES", + "STN_STATUS_CODES", + "VERSION" ) } @@ -253,8 +316,8 @@ is_mac <- function() { grepl("darwin", tolower(system_info["sysname"])) } -tidyhydat_perform <- function(req, ...) { +tidyhydat_perform <- function(req, ...) { req <- httr2::req_retry(req, max_tries = 5) req <- httr2::req_progress(req) httr2::req_perform(req, ...) -} \ No newline at end of file +} diff --git a/R/zzz.R b/R/zzz.R index 6229cae..16ea8f4 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -3,7 +3,9 @@ if (interactive()) { if (!file.exists(file.path(hy_dir(), "Hydat.sqlite3"))) { packageStartupMessage( - not_done("tidyhydat requires HYDAT which has not yet been downloaded. Run download_hydat() now.") + not_done( + "tidyhydat requires HYDAT which has not yet been downloaded. Run download_hydat() now." + ) ) } @@ -11,98 +13,285 @@ return(done("No access to internet.")) } - ## HYDAT is updated quarterly - should we go check if a new one is available for download? ## Only check when there is likely a new version i.e. about 3 months after last version - if (file.exists(file.path(hy_dir(), "Hydat.sqlite3")) && Sys.Date() > (as.Date(hy_version()$Date) + 115)) { + if ( + file.exists(file.path(hy_dir(), "Hydat.sqlite3")) && + Sys.Date() > (as.Date(hy_version()$Date) + 115) + ) { packageStartupMessage(info("Checking for a new version of HYDAT...")) base_url <- "http://collaboration.cmc.ec.gc.ca/cmc/hydrometrics/www/" x <- realtime_parser(base_url) - + ## Extract newest HYDAT - new_hydat <- as.Date(substr(gsub( - "^.*\\Hydat_sqlite3_", "", - x - ), 1, 8), "%Y%m%d") + new_hydat <- as.Date( + substr( + gsub( + "^.*\\Hydat_sqlite3_", + "", + x + ), + 1, + 8 + ), + "%Y%m%d" + ) ## Compare that to existing HYDAT if (new_hydat != as.Date(hy_version()$Date)) { packageStartupMessage( not_done( - paste0("Your version of HYDAT is out of date. Use download_hydat() to get the new version.") + paste0( + "Your version of HYDAT is out of date. Use download_hydat() to get the new version." + ) ) ) } else { - packageStartupMessage(congrats("You are using the most current version of HYDAT")) + packageStartupMessage(congrats( + "You are using the most current version of HYDAT" + )) } } } } globalVariables(unique(c( -# hy_annual_instant_peaks: -"DATA_TYPE_EN", "Date", "Datetime", "DAY", "HOUR", "MINUTE", "MONTH", "PEAK", "PEAK_CODE", "PRECISION_CODE", "standard_offset", "STATION_NUMBER", "station_tz", "SYMBOL_EN", "YEAR", -# hy_annual_stats: -"DATA_TYPE", "DATA_TYPE_EN", "Date", "DAY", "MAX", "MAX_DAY", "MAX_MONTH", "MAX_SYMBOL", "MEAN", "MIN", "MIN_DAY", "MIN_MONTH", "MIN_SYMBOL", "MONTH", "STATION_NUMBER", "SYMBOL_EN", "Value", "YEAR", -# hy_daily: -"Date", "STATION_NUMBER", -# hy_daily_flows: -"Date", "DAY", "FLOW", "FLOW_SYMBOL", "MONTH", "NO_DAYS", "Parameter", "STATION_NUMBER", "SYMBOL_EN", "SYMBOL_FR", "temp", "variable", "YEAR", -# hy_daily_levels: -"Date", "DAY", "LEVEL", "LEVEL_SYMBOL", "MONTH", "NO_DAYS", "Parameter", "STATION_NUMBER", "SYMBOL_EN", "SYMBOL_FR", "temp", "variable", "YEAR", -# hy_monthly_flows: -"Date_occurred", "DAY", "Full_Month", "MAX", "Month", "No_days", "STATION_NUMBER", "Year", -# hy_monthly_levels: -"Date_occurred", "DAY", "Full_month", "MAX", "Month", "No_days", "STATION_NUMBER", "Year", -# hy_sed_daily_loads: -"Date", "DAY", "LOAD", "MONTH", "NO_DAYS", "Parameter", "STATION_NUMBER", "variable", "YEAR", -# hy_sed_daily_suscon: -"Date", "DAY", "MONTH", "NO_DAYS", "Parameter", "STATION_NUMBER", "SUSCON", "SUSCON_SYMBOL", "SYMBOL_EN", "SYMBOL_FR", "variable", "YEAR", -# hy_sed_monthly_loads: -"Date_occurred", "DAY", "Full_Month", "MAX", "Month", "No_days", "STATION_NUMBER", "Year", -# hy_sed_monthly_suscon: -"Date_occurred", "DAY", "Full_Month", "MAX", "Month", "No_days", "STATION_NUMBER", "Year", -# hy_sed_samples: -"CONCENTRATION", "CONCENTRATION_EN", "DATE", "FLOW", "SAMPLE_REMARK_EN", "SAMPLER_TYPE", "SAMPLING_VERTICAL_EN", "SAMPLING_VERTICAL_LOCATION", "SED_DATA_TYPE_EN", "STATION_NUMBER", "SV_DEPTH2", "SYMBOL_EN", "TEMPERATURE", "TIME_SYMBOL", -# hy_sed_samples_psd: -"DATE", "PARTICLE_SIZE", "PERCENT", "SED_DATA_TYPE_EN", "STATION_NUMBER", -# hy_stations: -"REAL_TIME", "REGIONAL_OFFICE_ID", "RHBN", -# hy_stn_data_coll: -"DATA_TYPE_EN", "MEASUREMENT_EN", "OPERATION_EN", "STATION_NUMBER", "Year_from", "YEAR_FROM", "YEAR_TO", -# hy_stn_data_range: -"YEAR_FROM", "YEAR_TO", -# hy_stn_datum_conv: -"CONVERSION_FACTOR", "DATUM_EN_FROM", "DATUM_EN_TO", "STATION_NUMBER", -# hy_stn_datum_unrelated: -"YEAR_FROM", "YEAR_TO", -# hy_stn_op_schedule: -"DATA_TYPE_EN", "MONTH_FROM", "MONTH_TO", "STATION_NUMBER", "YEAR", -# hy_stn_regulation: -"REGULATED", -# hy_stn_remarks: -"REMARK_EN", "REMARK_TYPE_EN", "STATION_NUMBER", "YEAR", -# hy_version: -"Date", -# multi_param_msg: -"STATION_NUMBER", -# realtime_add_local_datetime: -"Date", "local_datetime", "PROV_TERR_STATE_LOC", "STATION_NUMBER", "station_tz", -# realtime_daily_mean: -"Date", "Parameter", "PROV_TERR_STATE_LOC", "STATION_NUMBER", "Value", -# realtime_stations: -"PROV_TERR_STATE_LOC", -# realtime_tidy_data: -"Code", "CODE", "Date", "Flow", "Grade", "GRADE", "key", "Level", "Parameter", "PROV_TERR_STATE_LOC", "STATION_NUMBER", "Symbol", "SYMBOL", "Value", -# search_stn_name: -"LATITUDE", "LONGITUDE", "PROV_TERR_STATE_LOC", "STATION_NAME", "STATION_NUMBER", -# search_stn_number: -"LATITUDE", "LONGITUDE", "PROV_TERR_STATE_LOC", "STATION_NAME", "STATION_NUMBER", -# single_realtime_station: -"Date", -# station_choice: -"STATION_NUMBER", -# realtime_ws: -"Approval", "Name_En", "Name_Fr", "param_id", "Unit" + # hy_annual_instant_peaks: + "DATA_TYPE_EN", + "Date", + "Datetime", + "DAY", + "HOUR", + "MINUTE", + "MONTH", + "PEAK", + "PEAK_CODE", + "PRECISION_CODE", + "standard_offset", + "STATION_NUMBER", + "station_tz", + "SYMBOL_EN", + "YEAR", + # hy_annual_stats: + "DATA_TYPE", + "DATA_TYPE_EN", + "Date", + "DAY", + "MAX", + "MAX_DAY", + "MAX_MONTH", + "MAX_SYMBOL", + "MEAN", + "MIN", + "MIN_DAY", + "MIN_MONTH", + "MIN_SYMBOL", + "MONTH", + "STATION_NUMBER", + "SYMBOL_EN", + "Value", + "YEAR", + # hy_daily: + "Date", + "STATION_NUMBER", + # hy_daily_flows: + "Date", + "DAY", + "FLOW", + "FLOW_SYMBOL", + "MONTH", + "NO_DAYS", + "Parameter", + "STATION_NUMBER", + "SYMBOL_EN", + "SYMBOL_FR", + "temp", + "variable", + "YEAR", + # hy_daily_levels: + "Date", + "DAY", + "LEVEL", + "LEVEL_SYMBOL", + "MONTH", + "NO_DAYS", + "Parameter", + "STATION_NUMBER", + "SYMBOL_EN", + "SYMBOL_FR", + "temp", + "variable", + "YEAR", + # hy_monthly_flows: + "Date_occurred", + "DAY", + "Full_Month", + "MAX", + "Month", + "No_days", + "STATION_NUMBER", + "Year", + # hy_monthly_levels: + "Date_occurred", + "DAY", + "Full_month", + "MAX", + "Month", + "No_days", + "STATION_NUMBER", + "Year", + # hy_sed_daily_loads: + "Date", + "DAY", + "LOAD", + "MONTH", + "NO_DAYS", + "Parameter", + "STATION_NUMBER", + "variable", + "YEAR", + # hy_sed_daily_suscon: + "Date", + "DAY", + "MONTH", + "NO_DAYS", + "Parameter", + "STATION_NUMBER", + "SUSCON", + "SUSCON_SYMBOL", + "SYMBOL_EN", + "SYMBOL_FR", + "variable", + "YEAR", + # hy_sed_monthly_loads: + "Date_occurred", + "DAY", + "Full_Month", + "MAX", + "Month", + "No_days", + "STATION_NUMBER", + "Year", + # hy_sed_monthly_suscon: + "Date_occurred", + "DAY", + "Full_Month", + "MAX", + "Month", + "No_days", + "STATION_NUMBER", + "Year", + # hy_sed_samples: + "CONCENTRATION", + "CONCENTRATION_EN", + "DATE", + "FLOW", + "SAMPLE_REMARK_EN", + "SAMPLER_TYPE", + "SAMPLING_VERTICAL_EN", + "SAMPLING_VERTICAL_LOCATION", + "SED_DATA_TYPE_EN", + "STATION_NUMBER", + "SV_DEPTH2", + "SYMBOL_EN", + "TEMPERATURE", + "TIME_SYMBOL", + # hy_sed_samples_psd: + "DATE", + "PARTICLE_SIZE", + "PERCENT", + "SED_DATA_TYPE_EN", + "STATION_NUMBER", + # hy_stations: + "REAL_TIME", + "REGIONAL_OFFICE_ID", + "RHBN", + # hy_stn_data_coll: + "DATA_TYPE_EN", + "MEASUREMENT_EN", + "OPERATION_EN", + "STATION_NUMBER", + "Year_from", + "YEAR_FROM", + "YEAR_TO", + # hy_stn_data_range: + "YEAR_FROM", + "YEAR_TO", + # hy_stn_datum_conv: + "CONVERSION_FACTOR", + "DATUM_EN_FROM", + "DATUM_EN_TO", + "STATION_NUMBER", + # hy_stn_datum_unrelated: + "YEAR_FROM", + "YEAR_TO", + # hy_stn_op_schedule: + "DATA_TYPE_EN", + "MONTH_FROM", + "MONTH_TO", + "STATION_NUMBER", + "YEAR", + # hy_stn_regulation: + "REGULATED", + # hy_stn_remarks: + "REMARK_EN", + "REMARK_TYPE_EN", + "STATION_NUMBER", + "YEAR", + # hy_version: + "Date", + # multi_param_msg: + "STATION_NUMBER", + # realtime_add_local_datetime: + "Date", + "local_datetime", + "PROV_TERR_STATE_LOC", + "STATION_NUMBER", + "station_tz", + # realtime_daily_mean: + "Date", + "Parameter", + "PROV_TERR_STATE_LOC", + "STATION_NUMBER", + "Value", + # realtime_stations: + "PROV_TERR_STATE_LOC", + # realtime_tidy_data: + "Code", + "CODE", + "Date", + "Flow", + "Grade", + "GRADE", + "key", + "Level", + "Parameter", + "PROV_TERR_STATE_LOC", + "STATION_NUMBER", + "Symbol", + "SYMBOL", + "Value", + # search_stn_name: + "LATITUDE", + "LONGITUDE", + "PROV_TERR_STATE_LOC", + "STATION_NAME", + "STATION_NUMBER", + # search_stn_number: + "LATITUDE", + "LONGITUDE", + "PROV_TERR_STATE_LOC", + "STATION_NAME", + "STATION_NUMBER", + # single_realtime_station: + "Date", + # station_choice: + "STATION_NUMBER", + # realtime_ws: + "Approval", + "Name_En", + "Name_Fr", + "param_id", + "Unit" ))) diff --git a/data-raw/HYDAT_internal_data/process_internal_data.R b/data-raw/HYDAT_internal_data/process_internal_data.R index 48dadfb..2e37d18 100644 --- a/data-raw/HYDAT_internal_data/process_internal_data.R +++ b/data-raw/HYDAT_internal_data/process_internal_data.R @@ -8,7 +8,8 @@ load_all() ## Borrowed from @steffilazerte tz_offset <- function(tz) { - t <- as.numeric(difftime(as.POSIXct("2016-01-01 00:00:00", tz = "UTC"), + t <- as.numeric(difftime( + as.POSIXct("2016-01-01 00:00:00", tz = "UTC"), as.POSIXct("2016-01-01 00:00:00", tz = tz), units = "hours" )) @@ -26,8 +27,18 @@ allstations <- realtime_stations() |> mutate(HYD_STATUS = "ACTIVE", REAL_TIME = TRUE) |> bind_rows(hy_stations()) |> distinct(STATION_NUMBER, .keep_all = TRUE) |> - select(STATION_NUMBER, STATION_NAME, PROV_TERR_STATE_LOC, HYD_STATUS, REAL_TIME, LATITUDE, LONGITUDE) |> - mutate(station_tz = tz_lookup_coords(LATITUDE, LONGITUDE, method = "accurate")) |> + select( + STATION_NUMBER, + STATION_NAME, + PROV_TERR_STATE_LOC, + HYD_STATUS, + REAL_TIME, + LATITUDE, + LONGITUDE + ) |> + mutate( + station_tz = tz_lookup_coords(LATITUDE, LONGITUDE, method = "accurate") + ) |> mutate(standard_offset = map_dbl(station_tz, ~ tz_offset(.x))) |> mutate(OlsonName = map_chr(standard_offset, ~ create_olson(.x))) |> write_csv("./data-raw/HYDAT_internal_data/allstations.csv") @@ -40,15 +51,19 @@ if (!all(unique(allstations$OlsonName) %in% c(OlsonNames(), "Etc/GMT+3.5"))) { } - ## Load up hydat connection ## Read in database -hydat_con <- DBI::dbConnect(RSQLite::SQLite(), file.path(hy_dir(), "Hydat.sqlite3")) +hydat_con <- DBI::dbConnect( + RSQLite::SQLite(), + file.path(hy_dir(), "Hydat.sqlite3") +) ## DATA_TYPES hy_data_types <- tbl(hydat_con, "DATA_TYPES") |> collect() |> - mutate(DATA_TYPE_FR = iconv(DATA_TYPE_FR, from = "UTF-8", to = "ASCII//TRANSLIT")) + mutate( + DATA_TYPE_FR = iconv(DATA_TYPE_FR, from = "UTF-8", to = "ASCII//TRANSLIT") + ) use_data(hy_data_types, overwrite = TRUE) ## DATA_SYMBOLS diff --git a/data-raw/HYDAT_internal_data/tinyhydat_proc.R b/data-raw/HYDAT_internal_data/tinyhydat_proc.R index e64cb10..b64a60a 100644 --- a/data-raw/HYDAT_internal_data/tinyhydat_proc.R +++ b/data-raw/HYDAT_internal_data/tinyhydat_proc.R @@ -10,44 +10,68 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - ## Load in packages library(purrr) library(dplyr) library(dbplyr) ## Create a subset of the data -hydat_con <- DBI::dbConnect(RSQLite::SQLite(), file.path(hy_dir(), "Hydat.sqlite3")) +hydat_con <- DBI::dbConnect( + RSQLite::SQLite(), + file.path(hy_dir(), "Hydat.sqlite3") +) all_tables <- DBI::dbListTables(hydat_con) # table_vector <- DBI::dbListTables(hydat_con) # Don't need all the tables. I will export what I need for testing table_vector <- c( - "ANNUAL_INSTANT_PEAKS", "ANNUAL_STATISTICS", - "DLY_FLOWS", "DLY_LEVELS", "SED_DLY_LOADS", "SED_DLY_SUSCON", "SED_SAMPLES", "SED_SAMPLES_PSD", - "STATIONS", "STN_REGULATION", "STN_REMARKS", "STN_DATUM_CONVERSION", "STN_DATA_RANGE", "STN_DATA_COLLECTION", - "STN_OPERATION_SCHEDULE", "STN_DATUM_UNRELATED" + "ANNUAL_INSTANT_PEAKS", + "ANNUAL_STATISTICS", + "DLY_FLOWS", + "DLY_LEVELS", + "SED_DLY_LOADS", + "SED_DLY_SUSCON", + "SED_SAMPLES", + "SED_SAMPLES_PSD", + "STATIONS", + "STN_REGULATION", + "STN_REMARKS", + "STN_DATUM_CONVERSION", + "STN_DATA_RANGE", + "STN_DATA_COLLECTION", + "STN_OPERATION_SCHEDULE", + "STN_DATUM_UNRELATED" ) ## List of tables with STATION_NUMBER INFORMATION list_of_small_tables <- table_vector |> - map(~ tbl(src = hydat_con, .) |> - filter(STATION_NUMBER %in% c( - "08MF005", "08NM083", "08NE102", - "05AA008", "05HD008" - )) |> - head(2000) |> - collect()) |> + map( + ~ tbl(src = hydat_con, .) |> + filter( + STATION_NUMBER %in% + c( + "08MF005", + "08NM083", + "08NE102", + "05AA008", + "05HD008" + ) + ) |> + head(2000) |> + collect() + ) |> set_names(table_vector) ## All tables without STATION_NUMBER no_stn_table_vector <- all_tables[!all_tables %in% table_vector] list_of_no_stn_tables <- no_stn_table_vector |> - map(~ tbl(src = hydat_con, .) |> - head(50) |> - collect()) |> + map( + ~ tbl(src = hydat_con, .) |> + head(50) |> + collect() + ) |> set_names(no_stn_table_vector) SED_DATA_TYPES <- dplyr::tbl(hydat_con, "SED_DATA_TYPES") |> collect() @@ -62,12 +86,18 @@ db_path <- "./inst/test_db/tinyhydat.sqlite3" con <- DBI::dbConnect(RSQLite::SQLite(), db_path) ## Add tables to mini database -imap(table_vector, ~ { - DBI::dbWriteTable(con, .x, list_of_small_tables[[.x]], overwrite = TRUE) -}) -imap(no_stn_table_vector, ~ { - DBI::dbWriteTable(con, .x, list_of_no_stn_tables[[.x]], overwrite = TRUE) -}) +imap( + table_vector, + ~ { + DBI::dbWriteTable(con, .x, list_of_small_tables[[.x]], overwrite = TRUE) + } +) +imap( + no_stn_table_vector, + ~ { + DBI::dbWriteTable(con, .x, list_of_no_stn_tables[[.x]], overwrite = TRUE) + } +) DBI::dbDisconnect(con) diff --git a/data-raw/param-id/process-param-id.R b/data-raw/param-id/process-param-id.R index c086f84..4b84d58 100755 --- a/data-raw/param-id/process-param-id.R +++ b/data-raw/param-id/process-param-id.R @@ -14,6 +14,14 @@ library(readxl) param_id <- read_excel('data-raw/param-id/parameterList_viaWebService.xlsx') -colnames(param_id) <- c("Parameter", "Code", "Unit", "Name_En", "Name_Fr", "Description_En", "Description_Fr") +colnames(param_id) <- c( + "Parameter", + "Code", + "Unit", + "Name_En", + "Name_Fr", + "Description_En", + "Description_Fr" +) usethis::use_data(param_id, overwrite = TRUE) diff --git a/tests/testthat/test-hy_db.R b/tests/testthat/test-hy_db.R index 79b0991..b32cd92 100644 --- a/tests/testthat/test-hy_db.R +++ b/tests/testthat/test-hy_db.R @@ -40,10 +40,16 @@ test_that("default place to look for Hydat database can be get/set internally", prev_val <- tidyhydat:::hy_set_default_db(NULL) # NULL should set back to original default - expect_equal(tidyhydat:::hy_default_db(), file.path(hy_dir(), "Hydat.sqlite3")) + expect_equal( + tidyhydat:::hy_default_db(), + file.path(hy_dir(), "Hydat.sqlite3") + ) # set_default_db should return previous value - expect_equal(tidyhydat:::hy_set_default_db(hy_test_db()), file.path(hy_dir(), "Hydat.sqlite3")) + expect_equal( + tidyhydat:::hy_set_default_db(hy_test_db()), + file.path(hy_dir(), "Hydat.sqlite3") + ) # set back to value when we started tidyhydat:::hy_set_default_db(prev_val) diff --git a/tests/testthat/test-realtime-webservice.R b/tests/testthat/test-realtime-webservice.R index 7fc06cf..7e35700 100644 --- a/tests/testthat/test-realtime-webservice.R +++ b/tests/testthat/test-realtime-webservice.R @@ -11,8 +11,16 @@ test_that("realtime_ws returns the correct data header", { expect_identical( colnames(ws_test), c( - "STATION_NUMBER", "Date", "Name_En", "Value", "Unit", "Grade", - "Symbol", "Approval", "Parameter", "Code" + "STATION_NUMBER", + "Date", + "Name_En", + "Value", + "Unit", + "Grade", + "Symbol", + "Approval", + "Parameter", + "Code" ) ) diff --git a/tests/testthat/test_date_check.R b/tests/testthat/test_date_check.R index 0213cf5..456d6d5 100644 --- a/tests/testthat/test_date_check.R +++ b/tests/testthat/test_date_check.R @@ -21,6 +21,12 @@ test_that("correct logicals are returned when date params are left null", { test_that("date_check errors when start_date is after end_date", { - expect_error(tidyhydat::date_check(start_date = "2010-01-01", end_date = "2009-01-01")) - expect_silent(tidyhydat:::date_check(start_date = "2009-01-01", end_date = "2010-01-01")) + expect_error(tidyhydat::date_check( + start_date = "2010-01-01", + end_date = "2009-01-01" + )) + expect_silent(tidyhydat:::date_check( + start_date = "2009-01-01", + end_date = "2010-01-01" + )) }) diff --git a/tests/testthat/test_download_realtime.R b/tests/testthat/test_download_realtime.R index 0495f39..7e4c3cd 100644 --- a/tests/testthat/test_download_realtime.R +++ b/tests/testthat/test_download_realtime.R @@ -1,18 +1,34 @@ test_that("realtime_dd returns the correct data header", { - skip_on_cran() expect_identical( - colnames(realtime_dd(station_number = "08MF005", prov_terr_state_loc = "BC")), - c("STATION_NUMBER", "PROV_TERR_STATE_LOC", "Date", "Parameter", "Value", "Grade", "Symbol", "Code") + colnames(realtime_dd( + station_number = "08MF005", + prov_terr_state_loc = "BC" + )), + c( + "STATION_NUMBER", + "PROV_TERR_STATE_LOC", + "Date", + "Parameter", + "Value", + "Grade", + "Symbol", + "Code" + ) ) }) test_that("realtime_dd can download stations from a whole province using prov_terr_state_loc and stores query time", { - skip_on_cran() expected_columns <- c( - "STATION_NUMBER", "PROV_TERR_STATE_LOC", "Date", "Parameter", - "Value", "Grade", "Symbol", "Code" + "STATION_NUMBER", + "PROV_TERR_STATE_LOC", + "Date", + "Parameter", + "Value", + "Grade", + "Symbol", + "Code" ) rldf <- realtime_dd(prov_terr_state_loc = "PE") @@ -22,13 +38,14 @@ test_that("realtime_dd can download stations from a whole province using prov_te test_that("realtime_dd can download stations from multiple provinces using station_number", { - skip_on_cran() - expect_error(realtime_dd(station_number = c("01CD005", "08MF005")), regexp = NA) + expect_error( + realtime_dd(station_number = c("01CD005", "08MF005")), + regexp = NA + ) }) test_that("When station_number is ALL there is an error", { - skip_on_cran() expect_error(realtime_dd(station_number = "ALL")) }) @@ -36,6 +53,9 @@ test_that("When station_number is ALL there is an error", { test_that("realtime_dd works when station is not realtime", { skip_on_cran() stns <- hy_stations(hydat_path = hy_test_db()) - stn <- sample(stns$STATION_NUMBER[!stns$REAL_TIME & stns$HYD_STATUS == "DISCONTINUED"], 1) + stn <- sample( + stns$STATION_NUMBER[!stns$REAL_TIME & stns$HYD_STATUS == "DISCONTINUED"], + 1 + ) expect_s3_class(realtime_dd(stn), "realtime") }) diff --git a/tests/testthat/test_hy_annual_instant_peaks.R b/tests/testthat/test_hy_annual_instant_peaks.R index 0cd1940..141b5b1 100644 --- a/tests/testthat/test_hy_annual_instant_peaks.R +++ b/tests/testthat/test_hy_annual_instant_peaks.R @@ -1,33 +1,45 @@ test_that("hy_annual_instant_peaks accepts single and multiple province arguments", { stns <- "08NM083" - expect_identical(unique( - hy_annual_instant_peaks( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_annual_instant_peaks( - station_number = c("08NM083", "08NE102"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_annual_instant_peaks( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_annual_instant_peaks( + station_number = c("08NM083", "08NE102"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_annual_instant_peaks accepts single and multiple province arguments", { - expect_true(nrow( - hy_annual_instant_peaks( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_annual_instant_peaks( - prov_terr_state_loc = c("BC", "YT"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_annual_instant_peaks( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_annual_instant_peaks( + prov_terr_state_loc = c("BC", "YT"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_annual_instant_peaks produces an error when a province is not specified correctly", { @@ -44,9 +56,12 @@ test_that("hy_annual_instant_peaks produces an error when a province is not spec ## TODO add test for CA test_that("hy_annual_instant_peaks gather data when no arguments are supplied", { - expect_true(nrow(hy_annual_instant_peaks( - hydat_path = hy_test_db() - )) >= 1) + expect_true( + nrow(hy_annual_instant_peaks( + hydat_path = hy_test_db() + )) >= + 1 + ) }) diff --git a/tests/testthat/test_hy_annual_stats.R b/tests/testthat/test_hy_annual_stats.R index 5ef7d23..9420c86 100644 --- a/tests/testthat/test_hy_annual_stats.R +++ b/tests/testthat/test_hy_annual_stats.R @@ -1,24 +1,52 @@ test_that("hy_annual_stats accepts single and multiple province arguments", { stns <- "08NM083" - expect_identical(unique(hy_annual_stats( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER), stns) - expect_identical(length(unique(hy_annual_stats( - station_number = c("08NM083", "08NE102"), - hydat_path = hy_test_db() - )$STATION_NUMBER)), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_annual_stats( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_annual_stats( + station_number = c("08NM083", "08NE102"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_annual_stats accepts single and multiple province arguments", { - expect_true(nrow(hy_annual_stats(prov_terr_state_loc = "BC", hydat_path = hy_test_db())) >= 1) - expect_true(nrow(hy_annual_stats(prov_terr_state_loc = c("BC", "YT"), hydat_path = hy_test_db())) >= 1) + expect_true( + nrow(hy_annual_stats( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + )) >= + 1 + ) + expect_true( + nrow(hy_annual_stats( + prov_terr_state_loc = c("BC", "YT"), + hydat_path = hy_test_db() + )) >= + 1 + ) }) test_that("hy_annual_stats produces an error when a province is not specified correctly", { - expect_error(hy_annual_stats(prov_terr_state_loc = "BCD", hydat_path = hy_test_db())) - expect_error(hy_annual_stats(prov_terr_state_loc = c("AB", "BCD"), hydat_path = hy_test_db())) + expect_error(hy_annual_stats( + prov_terr_state_loc = "BCD", + hydat_path = hy_test_db() + )) + expect_error(hy_annual_stats( + prov_terr_state_loc = c("AB", "BCD"), + hydat_path = hy_test_db() + )) }) test_that("hy_annual_stats gather data when no arguments are supplied", { @@ -26,7 +54,12 @@ test_that("hy_annual_stats gather data when no arguments are supplied", { }) test_that("hy_annual_stats respects year inputs", { - df <- hy_annual_stats(station_number = c("08NM083", "08NE102"), hydat_path = hy_test_db(), start_year = 1981, end_year = 2007) + df <- hy_annual_stats( + station_number = c("08NM083", "08NE102"), + hydat_path = hy_test_db(), + start_year = 1981, + end_year = 2007 + ) expect_equal(2007, max(df$Year)) expect_equal(1981, min(df$Year)) }) diff --git a/tests/testthat/test_hy_daily.R b/tests/testthat/test_hy_daily.R index c40247d..aca3f90 100644 --- a/tests/testthat/test_hy_daily.R +++ b/tests/testthat/test_hy_daily.R @@ -20,5 +20,8 @@ test_that("hy_daily generates right column names", { skip_on_cran() hy_daily_out <- hy_daily("08MF005", hydat_path = hy_test_db()) - expect_identical(colnames(hy_daily_out), c("STATION_NUMBER", "Date", "Parameter", "Value", "Symbol")) + expect_identical( + colnames(hy_daily_out), + c("STATION_NUMBER", "Date", "Parameter", "Value", "Symbol") + ) }) diff --git a/tests/testthat/test_hy_daily_flows.R b/tests/testthat/test_hy_daily_flows.R index aa63026..7c8f3c4 100644 --- a/tests/testthat/test_hy_daily_flows.R +++ b/tests/testthat/test_hy_daily_flows.R @@ -1,33 +1,45 @@ test_that("hy_daily_flows accepts single and multiple station arguments", { stns <- "08MF005" - expect_identical(unique( - hy_daily_flows( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_daily_flows( - station_number = c("08MF005", "05AA008"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_daily_flows( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_daily_flows( + station_number = c("08MF005", "05AA008"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_daily_flows accepts single and multiple province arguments", { - expect_true(nrow( - hy_daily_flows( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_daily_flows( - prov_terr_state_loc = c("BC", "YT"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_daily_flows( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_daily_flows( + prov_terr_state_loc = c("BC", "YT"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_daily_flows produces an error when a province is not specified correctly", { @@ -54,16 +66,27 @@ test_that("hy_daily_flows respects Date specification", { start_date = date_vector[1], end_date = date_vector[2] ) - expect_identical(c(min(temp_df$Date), max(temp_df$Date)), as.Date(date_vector)) + expect_identical( + c(min(temp_df$Date), max(temp_df$Date)), + as.Date(date_vector) + ) }) test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1961-01-01" - open_date_start <- hy_daily_flows(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_daily_flows( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_identical(min(open_date_start$Date), as.Date(date_string)) - open_date_end <- hy_daily_flows(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_daily_flows( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_identical(max(open_date_end$Date), as.Date(date_string)) }) diff --git a/tests/testthat/test_hy_daily_levels.R b/tests/testthat/test_hy_daily_levels.R index 3b5b98b..9ce836f 100644 --- a/tests/testthat/test_hy_daily_levels.R +++ b/tests/testthat/test_hy_daily_levels.R @@ -1,33 +1,45 @@ test_that("hy_daily_levels accepts single and multiple station arguments", { stns <- "08MF005" - expect_identical(unique( - hy_daily_levels( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_daily_levels( - station_number = c("08MF005", "05AA008"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_daily_levels( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_daily_levels( + station_number = c("08MF005", "05AA008"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_daily_levels accepts single and multiple province arguments", { - expect_true(nrow( - hy_daily_levels( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_daily_levels( - prov_terr_state_loc = c("YT", "BC"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_daily_levels( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_daily_levels( + prov_terr_state_loc = c("YT", "BC"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_daily_levels produces an error when a province is not specified correctly", { @@ -46,7 +58,6 @@ test_that("hy_daily_levels produces an error when a province is not specified co # expect_true(nrow(hy_daily_levels(hydat_path = hy_test_db())) >= 1) # }) - test_that("hy_daily_levels respects Date specification", { date_vector <- c("2013-01-01", "2014-01-01") temp_df <- hy_daily_levels( @@ -55,17 +66,28 @@ test_that("hy_daily_levels respects Date specification", { start_date = date_vector[1], end_date = date_vector[2] ) - expect_identical(c(min(temp_df$Date), max(temp_df$Date)), as.Date(date_vector)) + expect_identical( + c(min(temp_df$Date), max(temp_df$Date)), + as.Date(date_vector) + ) }) test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1961-01-01" - open_date_start <- hy_daily_levels(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_daily_levels( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_identical(min(open_date_start$Date), as.Date(date_string)) - open_date_end <- hy_daily_levels(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_daily_levels( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_identical(max(open_date_end$Date), as.Date(date_string)) }) diff --git a/tests/testthat/test_hy_monthly_flows.R b/tests/testthat/test_hy_monthly_flows.R index cf54895..321e288 100644 --- a/tests/testthat/test_hy_monthly_flows.R +++ b/tests/testthat/test_hy_monthly_flows.R @@ -1,33 +1,45 @@ test_that("hy_monthly_flows accepts single and multiple province arguments", { stns <- "08MF005" - expect_identical(unique( - hy_monthly_flows( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_monthly_flows( - station_number = c("08MF005", "05AA008"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_monthly_flows( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_monthly_flows( + station_number = c("08MF005", "05AA008"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_monthly_flows accepts single and multiple province arguments", { - expect_true(nrow( - hy_monthly_flows( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_monthly_flows( - prov_terr_state_loc = c("BC", "YT"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_monthly_flows( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_monthly_flows( + prov_terr_state_loc = c("BC", "YT"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_monthly_flows produces an error when a province is not specified correctly", { @@ -57,10 +69,18 @@ test_that("hy_monthly_flows respects Date specification", { test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1961-01-01" - open_date_start <- hy_monthly_flows(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_monthly_flows( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_true(min(open_date_start$Date_occurred) >= as.Date(date_string)) - open_date_end <- hy_monthly_flows(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_monthly_flows( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_true(max(open_date_end$Date_occurred) <= as.Date(date_string)) }) diff --git a/tests/testthat/test_hy_monthly_levels.R b/tests/testthat/test_hy_monthly_levels.R index e5c86c5..e5e0bae 100644 --- a/tests/testthat/test_hy_monthly_levels.R +++ b/tests/testthat/test_hy_monthly_levels.R @@ -1,33 +1,45 @@ test_that("hy_monthly_levels accepts single and multiple province arguments", { stns <- "08MF005" - expect_identical(unique( - hy_monthly_levels( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_monthly_levels( - station_number = c("08MF005", "05AA008"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_monthly_levels( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_monthly_levels( + station_number = c("08MF005", "05AA008"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_monthly_levels accepts single and multiple province arguments", { - expect_true(nrow( - hy_monthly_levels( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_monthly_levels( - prov_terr_state_loc = c("YT", "BC"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_monthly_levels( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_monthly_levels( + prov_terr_state_loc = c("YT", "BC"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_monthly_levels produces an error when a province is not specified correctly", { @@ -57,10 +69,18 @@ test_that("hy_monthly_levels respects Date specification", { test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1961-01-01" - open_date_start <- hy_monthly_levels(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_monthly_levels( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_true(min(open_date_start$Date_occurred) >= as.Date(date_string)) - open_date_end <- hy_monthly_levels(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_monthly_levels( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_true(max(open_date_end$Date_occurred) <= as.Date(date_string)) }) test_that("When hy_monthly_levels is ALL there is an error", { diff --git a/tests/testthat/test_hy_sed_daily_loads.R b/tests/testthat/test_hy_sed_daily_loads.R index 55257f9..42698b8 100644 --- a/tests/testthat/test_hy_sed_daily_loads.R +++ b/tests/testthat/test_hy_sed_daily_loads.R @@ -1,33 +1,45 @@ test_that("hy_sed_daily_loads accepts single and multiple province arguments", { stns <- "05AA008" - expect_identical(unique( - hy_sed_daily_loads( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_sed_daily_loads( - station_number = c("05AA008", "08MF005"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_sed_daily_loads( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_sed_daily_loads( + station_number = c("05AA008", "08MF005"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_sed_daily_loads accepts single and multiple province arguments", { - expect_true(nrow( - hy_sed_daily_loads( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_sed_daily_loads( - prov_terr_state_loc = c("BC", "AB"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_sed_daily_loads( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_sed_daily_loads( + prov_terr_state_loc = c("BC", "AB"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_sed_daily_loads produces an error when a province is not specified correctly", { @@ -46,7 +58,6 @@ test_that("hy_sed_daily_loads produces an error when a province is not specified # expect_true(nrow(hy_sed_daily_loads(hydat_path = hy_test_db())) >= 1) # }) - test_that("hy_sed_daily_loads respects Date specification", { date_vector <- c("1965-06-01", "1966-03-01") temp_df <- hy_sed_daily_loads( @@ -55,16 +66,27 @@ test_that("hy_sed_daily_loads respects Date specification", { start_date = date_vector[1], end_date = date_vector[2] ) - expect_identical(c(min(temp_df$Date), max(temp_df$Date)), as.Date(date_vector)) + expect_identical( + c(min(temp_df$Date), max(temp_df$Date)), + as.Date(date_vector) + ) }) test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1965-05-01" - open_date_start <- hy_sed_daily_loads(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_sed_daily_loads( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_identical(min(open_date_start$Date), as.Date(date_string)) - open_date_end <- hy_sed_daily_loads(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_sed_daily_loads( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_identical(max(open_date_end$Date), as.Date(date_string)) }) diff --git a/tests/testthat/test_hy_sed_daily_suscon.R b/tests/testthat/test_hy_sed_daily_suscon.R index 3fedfcb..c8dd231 100644 --- a/tests/testthat/test_hy_sed_daily_suscon.R +++ b/tests/testthat/test_hy_sed_daily_suscon.R @@ -1,33 +1,45 @@ test_that("hy_sed_daily_suscon accepts single and multiple province arguments", { stns <- "05AA008" - expect_identical(unique( - hy_sed_daily_suscon( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_sed_daily_suscon( - station_number = c("05AA008", "08MF005"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_sed_daily_suscon( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_sed_daily_suscon( + station_number = c("05AA008", "08MF005"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_sed_daily_suscon accepts single and multiple province arguments", { - expect_true(nrow( - hy_sed_daily_suscon( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_sed_daily_suscon( - prov_terr_state_loc = c("BC", "AB"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_sed_daily_suscon( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_sed_daily_suscon( + prov_terr_state_loc = c("BC", "AB"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) ## Too much data @@ -35,7 +47,6 @@ test_that("hy_sed_daily_suscon accepts single and multiple province arguments", # expect_true(nrow(hy_sed_daily_suscon(hydat_path = hy_test_db())) >= 1) # }) - test_that("hy_sed_daily_suscon respects Date specification", { date_vector <- c("1965-06-01", "1966-03-01") temp_df <- hy_sed_daily_suscon( @@ -44,16 +55,27 @@ test_that("hy_sed_daily_suscon respects Date specification", { start_date = date_vector[1], end_date = date_vector[2] ) - expect_identical(c(min(temp_df$Date), max(temp_df$Date)), as.Date(date_vector)) + expect_identical( + c(min(temp_df$Date), max(temp_df$Date)), + as.Date(date_vector) + ) }) test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1965-05-01" - open_date_start <- hy_sed_daily_suscon(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_sed_daily_suscon( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_identical(min(open_date_start$Date), as.Date(date_string)) - open_date_end <- hy_sed_daily_suscon(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_sed_daily_suscon( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_identical(max(open_date_end$Date), as.Date(date_string)) }) diff --git a/tests/testthat/test_hy_sed_monthly_loads.R b/tests/testthat/test_hy_sed_monthly_loads.R index 2e3b3f4..52eaff2 100644 --- a/tests/testthat/test_hy_sed_monthly_loads.R +++ b/tests/testthat/test_hy_sed_monthly_loads.R @@ -1,33 +1,45 @@ test_that("hy_sed_monthly_loads accepts single and multiple province arguments", { stns <- "08MF005" - expect_identical(unique( - hy_sed_monthly_loads( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_sed_monthly_loads( - station_number = c("08MF005", "05AA008"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_sed_monthly_loads( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_sed_monthly_loads( + station_number = c("08MF005", "05AA008"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_sed_monthly_loads accepts single and multiple province arguments", { - expect_true(nrow( - hy_sed_monthly_loads( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_sed_monthly_loads( - prov_terr_state_loc = c("BC", "AB"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_sed_monthly_loads( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_sed_monthly_loads( + prov_terr_state_loc = c("BC", "AB"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_sed_monthly_loads produces an error when a province is not specified correctly", { @@ -56,10 +68,18 @@ test_that("hy_sed_monthly_loads respects Date specification", { test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1965-07-12" - open_date_start <- hy_sed_monthly_loads(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_sed_monthly_loads( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_true(min(open_date_start$Date_occurred) >= as.Date(date_string)) - open_date_end <- hy_sed_monthly_loads(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_sed_monthly_loads( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_true(max(open_date_end$Date_occurred) <= as.Date(date_string)) }) diff --git a/tests/testthat/test_hy_sed_monthly_suscon.R b/tests/testthat/test_hy_sed_monthly_suscon.R index eae138a..cb23b35 100644 --- a/tests/testthat/test_hy_sed_monthly_suscon.R +++ b/tests/testthat/test_hy_sed_monthly_suscon.R @@ -1,33 +1,45 @@ test_that("hy_sed_monthly_suscon accepts single and multiple province arguments", { stns <- "08MF005" - expect_identical(unique( - hy_sed_monthly_suscon( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_sed_monthly_suscon( - station_number = c("08MF005", "05AA008"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_sed_monthly_suscon( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_sed_monthly_suscon( + station_number = c("08MF005", "05AA008"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_sed_monthly_suscon accepts single and multiple province arguments", { - expect_true(nrow( - hy_sed_monthly_suscon( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_sed_monthly_suscon( - prov_terr_state_loc = c("BC", "AB"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_sed_monthly_suscon( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_sed_monthly_suscon( + prov_terr_state_loc = c("BC", "AB"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_sed_monthly_suscon produces an error when a province is not specified correctly", { @@ -56,15 +68,22 @@ test_that("hy_sed_monthly_suscon respects Date specification", { test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1965-07-12" - open_date_start <- hy_sed_monthly_suscon(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_sed_monthly_suscon( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_true(min(open_date_start$Date_occurred) >= as.Date(date_string)) - open_date_end <- hy_sed_monthly_suscon(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_sed_monthly_suscon( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_true(max(open_date_end$Date_occurred) <= as.Date(date_string)) }) - test_that("When hy_sed_monthly_suscon is ALL there is an error", { expect_error(hy_sed_monthly_suscon(station_number = "ALL")) }) diff --git a/tests/testthat/test_hy_sed_samples.R b/tests/testthat/test_hy_sed_samples.R index 0f1030d..9d06184 100644 --- a/tests/testthat/test_hy_sed_samples.R +++ b/tests/testthat/test_hy_sed_samples.R @@ -1,33 +1,45 @@ test_that("hy_sed_samples accepts single and multiple province arguments", { stns <- "05AA008" - expect_identical(unique( - hy_sed_samples( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_sed_samples( - station_number = c("05AA008", "08MF005"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_sed_samples( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_sed_samples( + station_number = c("05AA008", "08MF005"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_sed_samples accepts single and multiple province arguments", { - expect_true(nrow( - hy_sed_samples( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_sed_samples( - prov_terr_state_loc = c("BC", "AB"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_sed_samples( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_sed_samples( + prov_terr_state_loc = c("BC", "AB"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_sed_samples produces an error when a province is not specified correctly", { @@ -46,7 +58,6 @@ test_that("hy_sed_samples produces an error when a province is not specified cor # expect_true(nrow(hy_sed_samples(hydat_path = hy_test_db())) >= 1) # }) - test_that("hy_sed_samples respects Date specification", { date_vector <- c("1966-01-01", "1977-01-01") temp_df <- hy_sed_samples( @@ -62,10 +73,18 @@ test_that("hy_sed_samples respects Date specification", { test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1969-04-17" - open_date_start <- hy_sed_samples(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_sed_samples( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_identical(min(as.Date(open_date_start$Date)), as.Date(date_string)) - open_date_end <- hy_sed_samples(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_sed_samples( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_identical(max(as.Date(open_date_end$Date)), as.Date(date_string)) }) diff --git a/tests/testthat/test_hy_sed_samples_psd.R b/tests/testthat/test_hy_sed_samples_psd.R index 34a75a6..b5a432a 100644 --- a/tests/testthat/test_hy_sed_samples_psd.R +++ b/tests/testthat/test_hy_sed_samples_psd.R @@ -1,33 +1,45 @@ test_that("hy_sed_samples_psd accepts single and multiple province arguments", { stns <- "05AA008" - expect_identical(unique( - hy_sed_samples_psd( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_sed_samples_psd( - station_number = c("05AA008", "08MF005"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_sed_samples_psd( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_sed_samples_psd( + station_number = c("05AA008", "08MF005"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_sed_samples_psd accepts single and multiple province arguments", { - expect_true(nrow( - hy_sed_samples_psd( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_sed_samples_psd( - prov_terr_state_loc = c("BC", "AB"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_sed_samples_psd( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_sed_samples_psd( + prov_terr_state_loc = c("BC", "AB"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_sed_samples_psd respects Date specification", { @@ -45,10 +57,18 @@ test_that("hy_sed_samples_psd respects Date specification", { test_that("functions that accept a date argument return data when specifying only the start date or end date", { date_string <- "1969-04-17" - open_date_start <- hy_sed_samples_psd(station_number = "08MF005", hydat_path = hy_test_db(), start_date = date_string) + open_date_start <- hy_sed_samples_psd( + station_number = "08MF005", + hydat_path = hy_test_db(), + start_date = date_string + ) expect_identical(min(as.Date(open_date_start$Date)), as.Date(date_string)) - open_date_end <- hy_sed_samples_psd(station_number = "08MF005", hydat_path = hy_test_db(), end_date = date_string) + open_date_end <- hy_sed_samples_psd( + station_number = "08MF005", + hydat_path = hy_test_db(), + end_date = date_string + ) expect_identical(max(as.Date(open_date_end$Date)), as.Date(date_string)) }) @@ -68,7 +88,6 @@ test_that("hy_sed_samples_psd produces an error when a province is not specified # expect_true(nrow(hy_sed_samples_psd(hydat_path = hy_test_db())) >= 1) # }) - test_that("hy_sed_samples_psd respects Date specification", { date_vector <- c("1965-06-01", "1966-03-01") expect_error( diff --git a/tests/testthat/test_hy_stations.R b/tests/testthat/test_hy_stations.R index c3157ad..713a268 100644 --- a/tests/testthat/test_hy_stations.R +++ b/tests/testthat/test_hy_stations.R @@ -1,14 +1,21 @@ test_that("hy_stations accepts single and multiple province arguments", { stns <- "08NM083" - expect_identical(unique(hy_stations( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER), stns) expect_identical( - length(unique(hy_stations( - station_number = c("08NM083", "08NE102"), - hydat_path = hy_test_db() - )$STATION_NUMBER)), + unique( + hy_stations( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_stations( + station_number = c("08NM083", "08NE102"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), length(c("08NM083", "08NE102")) ) }) @@ -16,19 +23,35 @@ test_that("hy_stations accepts single and multiple province arguments", { test_that("hy_stations accepts single and multiple province arguments", { prov <- c("BC") - expect_identical(unique(hy_stations( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - )$PROV_TERR_STATE_LOC), prov) - expect_identical(unique(hy_stations( - prov_terr_state_loc = c("AB", "BC"), - hydat_path = hy_test_db() - )$PROV_TERR_STATE_LOC), c("AB", "BC")) + expect_identical( + unique( + hy_stations( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + )$PROV_TERR_STATE_LOC + ), + prov + ) + expect_identical( + unique( + hy_stations( + prov_terr_state_loc = c("AB", "BC"), + hydat_path = hy_test_db() + )$PROV_TERR_STATE_LOC + ), + c("AB", "BC") + ) }) test_that("hy_stations produces an error when a province is not specified correctly", { - expect_error(hy_stations(prov_terr_state_loc = "BCD", hydat_path = hy_test_db())) - expect_error(hy_stations(prov_terr_state_loc = c("AB", "BCD"), hydat_path = hy_test_db())) + expect_error(hy_stations( + prov_terr_state_loc = "BCD", + hydat_path = hy_test_db() + )) + expect_error(hy_stations( + prov_terr_state_loc = c("AB", "BCD"), + hydat_path = hy_test_db() + )) }) test_that("hy_stations gather data when no arguments are supplied", { diff --git a/tests/testthat/test_hy_stn__.R b/tests/testthat/test_hy_stn__.R index b3410e0..68dcba4 100644 --- a/tests/testthat/test_hy_stn__.R +++ b/tests/testthat/test_hy_stn__.R @@ -52,5 +52,7 @@ test_that("hy_stn_op_schedule returns a dataframe", { test_that("hy_stn_data_range contains properly coded NA's", { - expect_true(is.na(hy_stn_data_range(hydat_path = hy_test_db())$SED_DATA_TYPE[1])) + expect_true(is.na(hy_stn_data_range(hydat_path = hy_test_db())$SED_DATA_TYPE[ + 1 + ])) }) diff --git a/tests/testthat/test_hy_stn_regulation.R b/tests/testthat/test_hy_stn_regulation.R index e258e27..4342dfa 100644 --- a/tests/testthat/test_hy_stn_regulation.R +++ b/tests/testthat/test_hy_stn_regulation.R @@ -1,33 +1,45 @@ test_that("hy_stn_regulation accepts single and multiple province arguments", { stns <- "08NM083" - expect_identical(unique( - hy_stn_regulation( - station_number = stns, - hydat_path = hy_test_db() - )$STATION_NUMBER - ), stns) - expect_identical(length(unique( - hy_stn_regulation( - station_number = c("08NM083", "08NE102"), - hydat_path = hy_test_db() - )$STATION_NUMBER - )), length(c("08NM083", "08NE102"))) + expect_identical( + unique( + hy_stn_regulation( + station_number = stns, + hydat_path = hy_test_db() + )$STATION_NUMBER + ), + stns + ) + expect_identical( + length(unique( + hy_stn_regulation( + station_number = c("08NM083", "08NE102"), + hydat_path = hy_test_db() + )$STATION_NUMBER + )), + length(c("08NM083", "08NE102")) + ) }) test_that("hy_stn_regulation accepts single and multiple province arguments", { - expect_true(nrow( - hy_stn_regulation( - prov_terr_state_loc = "BC", - hydat_path = hy_test_db() - ) - ) >= 1) - expect_true(nrow( - hy_stn_regulation( - prov_terr_state_loc = c("BC", "YT"), - hydat_path = hy_test_db() - ) - ) >= 1) + expect_true( + nrow( + hy_stn_regulation( + prov_terr_state_loc = "BC", + hydat_path = hy_test_db() + ) + ) >= + 1 + ) + expect_true( + nrow( + hy_stn_regulation( + prov_terr_state_loc = c("BC", "YT"), + hydat_path = hy_test_db() + ) + ) >= + 1 + ) }) test_that("hy_stn_regulation produces an error when a province is not specified correctly", { @@ -42,7 +54,10 @@ test_that("hy_stn_regulation produces an error when a province is not specified }) test_that("hy_stn_regulation gather data when no arguments are supplied", { - expect_true(nrow(hy_stn_regulation( - hydat_path = hy_test_db() - )) >= 1) + expect_true( + nrow(hy_stn_regulation( + hydat_path = hy_test_db() + )) >= + 1 + ) }) diff --git a/tests/testthat/test_realtime_add_local_datetime.R b/tests/testthat/test_realtime_add_local_datetime.R index b4dd52f..8f11332 100644 --- a/tests/testthat/test_realtime_add_local_datetime.R +++ b/tests/testthat/test_realtime_add_local_datetime.R @@ -2,14 +2,20 @@ test_that("realtime_add_local_datetime add applies correct timezone", { skip_on_cran() skip_if_net_down() col_added <- realtime_dd("08MF005") |> realtime_add_local_datetime() - expect_equal(lubridate::tz(col_added$local_datetime), unique(col_added$station_tz)) + expect_equal( + lubridate::tz(col_added$local_datetime), + unique(col_added$station_tz) + ) }) test_that("realtime_add_local_datetime add applies first timezone when multiple timezones exist and generates a warning", { skip_on_cran() skip_if_net_down() - expect_warning(col_added <- realtime_dd(c("08MF005", "02LA004", "02AB006")) |> realtime_add_local_datetime()) + expect_warning( + col_added <- realtime_dd(c("08MF005", "02LA004", "02AB006")) |> + realtime_add_local_datetime() + ) expect_equal(lubridate::tz(col_added$local_datetime), "America/Toronto") }) @@ -17,8 +23,14 @@ test_that("realtime_add_local_datetime add applies first timezone when multiple test_that("when set_tz is supplied, it is respected", { skip_on_cran() skip_if_net_down() - expect_warning(col_added <- realtime_dd(c("08MF005", "02LA004")) |> realtime_add_local_datetime(set_tz = "America/Moncton")) - expect_equal(lubridate::tz(col_added$local_datetime), unique(col_added$tz_used)) + expect_warning( + col_added <- realtime_dd(c("08MF005", "02LA004")) |> + realtime_add_local_datetime(set_tz = "America/Moncton") + ) + expect_equal( + lubridate::tz(col_added$local_datetime), + unique(col_added$tz_used) + ) expect_equal(lubridate::tz(col_added$local_datetime), "America/Moncton") expect_equal(unique(col_added$tz_used), "America/Moncton") }) diff --git a/tests/testthat/test_search.R b/tests/testthat/test_search.R index 0369ab8..e3835cb 100644 --- a/tests/testthat/test_search.R +++ b/tests/testthat/test_search.R @@ -1,10 +1,16 @@ test_that("search_stn_number returns a dataframe", { skip_if_net_down() - expect_s3_class(search_stn_number("08HF", hydat_path = hy_test_db()), "data.frame") + expect_s3_class( + search_stn_number("08HF", hydat_path = hy_test_db()), + "data.frame" + ) }) test_that("search_stn_name returns a dataframe", { skip_if_net_down() - expect_s3_class(search_stn_name("Saskatchewan", hydat_path = hy_test_db()), "data.frame") + expect_s3_class( + search_stn_name("Saskatchewan", hydat_path = hy_test_db()), + "data.frame" + ) }) diff --git a/tests/testthat/test_station_choice.R b/tests/testthat/test_station_choice.R index 1cd49b1..0c6b056 100644 --- a/tests/testthat/test_station_choice.R +++ b/tests/testthat/test_station_choice.R @@ -4,7 +4,11 @@ test_that("Outputs that same station that is inputted in outputted when province hydat_con <- DBI::dbConnect(RSQLite::SQLite(), hydat_path) stns <- c("08NM083", "08NE102") on.exit(DBI::dbDisconnect(hydat_con), add = TRUE) - stns_out <- tidyhydat:::station_choice(hydat_con, station_number = stns, prov_terr_state_loc = NULL) + stns_out <- tidyhydat:::station_choice( + hydat_con, + station_number = stns, + prov_terr_state_loc = NULL + ) expect_identical(stns, stns_out) }) @@ -18,7 +22,11 @@ test_that("Test that all stations are outputted when just a province is supplied dplyr::collect() |> dplyr::pull(STATION_NUMBER) -> stns on.exit(DBI::dbDisconnect(hydat_con), add = TRUE) - stns_out <- tidyhydat:::station_choice(hydat_con, station_number = NULL, prov_terr_state_loc = "BC") + stns_out <- tidyhydat:::station_choice( + hydat_con, + station_number = NULL, + prov_terr_state_loc = "BC" + ) expect_identical(stns, stns_out) }) @@ -29,7 +37,13 @@ test_that("station name in any case is accepted", { hydat_con <- DBI::dbConnect(RSQLite::SQLite(), hydat_path) stns <- c("08nm083", "08nE102") on.exit(DBI::dbDisconnect(hydat_con), add = TRUE) - expect_silent(out_stns <- tidyhydat:::station_choice(hydat_con, station_number = stns, prov_terr_state_loc = NULL)) + expect_silent( + out_stns <- tidyhydat:::station_choice( + hydat_con, + station_number = stns, + prov_terr_state_loc = NULL + ) + ) expect_identical(toupper(stns), out_stns) }) @@ -40,11 +54,25 @@ test_that("province in any case is accepted", { hydat_con <- DBI::dbConnect(RSQLite::SQLite(), hydat_path) prov <- c("Ab", "bC") on.exit(DBI::dbDisconnect(hydat_con), add = TRUE) - expect_silent(stns <- tidyhydat:::station_choice(hydat_con, station_number = NULL, prov_terr_state_loc = prov)) - expect_identical(toupper(prov), unique(hy_stations(hydat_path, station_number = stns)$PROV_TERR_STATE_LOC)) + expect_silent( + stns <- tidyhydat:::station_choice( + hydat_con, + station_number = NULL, + prov_terr_state_loc = prov + ) + ) + expect_identical( + toupper(prov), + unique(hy_stations(hydat_path, station_number = stns)$PROV_TERR_STATE_LOC) + ) }) test_that("'CA' to prov_terr_state_loc argument returns only Canadian stations", { - only_canada <- unique(hy_stations(prov_terr_state_loc = "CA", hydat_path = hy_test_db())$PROV_TERR_STATE_LOC) + only_canada <- unique( + hy_stations( + prov_terr_state_loc = "CA", + hydat_path = hy_test_db() + )$PROV_TERR_STATE_LOC + ) expect_equal(c("AB", "SK", "BC"), only_canada) }) diff --git a/tests/testthat/test_utils.R b/tests/testthat/test_utils.R index 323c9cb..3e1ea07 100644 --- a/tests/testthat/test_utils.R +++ b/tests/testthat/test_utils.R @@ -41,7 +41,8 @@ test_that("pull_station_number fails when a dataframe doesn't contain a STATION_ test_that("pull_station_number grabs station number successfully", { stns <- c("08NM083", "08NE102") - pulled_stns <- hy_annual_stats(stns, hydat_path = hy_test_db()) |> pull_station_number() + pulled_stns <- hy_annual_stats(stns, hydat_path = hy_test_db()) |> + pull_station_number() expect_identical(stns, unique(pulled_stns)) }) diff --git a/vignettes/precompile.R b/vignettes/precompile.R index b8d5740..7f926d8 100644 --- a/vignettes/precompile.R +++ b/vignettes/precompile.R @@ -10,13 +10,14 @@ # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and limitations under the License. - - - # Precompile vignettes precompile <- function(vignette_to_run = NULL) { - orig_files <- file.path(list.files(path = "vignettes/", pattern = "*\\.Rmd\\.orig", full.names = TRUE)) + orig_files <- file.path(list.files( + path = "vignettes/", + pattern = "*\\.Rmd\\.orig", + full.names = TRUE + )) if (!is.null(vignette_to_run)) { orig_files <- orig_files[basename(orig_files) %in% vignette_to_run] @@ -25,13 +26,15 @@ precompile <- function(vignette_to_run = NULL) { } # Convert *.orig to *.Rmd ------------------------------------------------- - purrr::walk(orig_files, ~knitr::knit(.x, tools::file_path_sans_ext(.x))) + purrr::walk(orig_files, ~ knitr::knit(.x, tools::file_path_sans_ext(.x))) # Move .png files into correct directory so they render ------------------- images <- file.path(list.files(".", pattern = 'vignette-fig.*\\.png$')) - success <- file.copy(from = images, - to = file.path("vignettes", images), - overwrite = TRUE) + success <- file.copy( + from = images, + to = file.path("vignettes", images), + overwrite = TRUE + ) # Clean up if successful -------------------------------------------------- if (!all(success)) { @@ -40,15 +43,3 @@ precompile <- function(vignette_to_run = NULL) { unlink(images) } } - - - - - - - - - - - -