From 9ac70757c4539c325d99f2874f69321f9737dddb Mon Sep 17 00:00:00 2001 From: bczernecki Date: Mon, 21 Oct 2024 14:17:30 +0200 Subject: [PATCH] fix: remove hydro semiannual and annual --- NAMESPACE | 1 - NEWS.md | 3 +- R/clean_metadata_hydro.R | 17 --- R/hydro_imgw.R | 14 +-- R/hydro_imgw_annual.R | 146 ---------------------- R/hydro_metadata_imgw.R | 8 +- R/nearest_stations_imgw.R | 2 +- README.md | 18 +-- man/hydro_imgw.Rd | 3 +- man/hydro_imgw_annual.Rd | 47 ------- tests/testthat/test-hydro_imgw.R | 13 +- tests/testthat/test-hydro_metadata_imgw.R | 4 - vignettes/getstarted.Rmd | 2 +- 13 files changed, 27 insertions(+), 251 deletions(-) delete mode 100644 R/hydro_imgw_annual.R delete mode 100644 man/hydro_imgw_annual.Rd diff --git a/NAMESPACE b/NAMESPACE index a9cb5574..4c7b8247 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,6 @@ export(.onAttach) export(hydro_imgw) -export(hydro_imgw_annual) export(hydro_imgw_daily) export(hydro_imgw_monthly) export(hydro_shortening_imgw) diff --git a/NEWS.md b/NEWS.md index 2bb8e67b..968ab7d2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,9 @@ # climate 1.2.2 -* Fixes for `hydro_imgw()` set of functions due to changes in the IMGW-PIB hydrological datasets +* Fixes and modifications for `hydro_imgw()` set of functions due to changes in the IMGW-PIB hydrological datasets * adjusting code to recognize different encoding and directory structure * adjusting changes in metadata + * removed option to download data for "semiannual and annual" time resolutions due to inconsistencies in the data * Fix unit tests for ogimet-related datasets # climate 1.2.1 diff --git a/R/clean_metadata_hydro.R b/R/clean_metadata_hydro.R index dda531cc..a5dc1d6f 100644 --- a/R/clean_metadata_hydro.R +++ b/R/clean_metadata_hydro.R @@ -24,22 +24,5 @@ clean_metadata_hydro = function(address, interval) { if (interval == "daily") { b = data.frame(parameters = a[1:10]) } - if (interval == "semiannual_and_annual") { - godzina = paste0(a[13], ":", a[14]) - data = c(a[10:12], godzina) - data_od = paste0("wystapienie_od_", data) - data_do = paste0("wystapienie_do_", data) - SPT = unlist(strsplit(a[8], "]/")) # stan/przeplyw/temperatura - SPT[1] = paste0(SPT[1], "]") - SPT[2] = paste0(SPT[2], "]") - b = NULL - for (i in seq_along(SPT)) { - tmp = c(a[1:7], SPT[i], data_od, data_do) - b = cbind(b, tmp) - } - b = list("H" = data.frame(parameters = b[, 1]), - "Q" = data.frame(parameters = b[, 2]), - "T" = data.frame(parameters = b[, 3])) - } return(b) } diff --git a/R/hydro_imgw.R b/R/hydro_imgw.R index 5cc0ffb9..f03bf4c1 100644 --- a/R/hydro_imgw.R +++ b/R/hydro_imgw.R @@ -3,8 +3,7 @@ #' Downloading daily, and monthly hydrological data from the measurement stations #' available in the danepubliczne.imgw.pl collection #' -#' @param interval temporal resolution of the data ("daily" , "monthly", -#' or "semiannual_and_annual") +#' @param interval temporal resolution of the data ("daily" or "monthly") #' @param year vector of years (e.g., 1966:2000) #' @param coords add coordinates of the stations (logical value TRUE or FALSE) #' @param value type of data (can be: state - "H" (default), flow - "Q", or @@ -38,20 +37,13 @@ hydro_imgw = function(interval, # dobowe calosc = hydro_imgw_daily(year = year, coords = coords, station = station, col_names = col_names, ...) } else if (interval == "monthly") { - #miesieczne + # miesieczne calosc = hydro_imgw_monthly(year = year, coords = coords, station = station, col_names = col_names, ...) - } else if (interval == "semiannual_and_annual") { - # polroczne_i_roczne - calosc = hydro_imgw_annual(year = year, - coords = coords, - value = value, - station = station, - col_names = col_names, ...) } else{ - stop("Wrong `interval` value. It should be either 'daily', 'monthly', or 'semiannual_and_annual'.", call. = FALSE) + stop("Wrong `interval` value. It should be either 'daily' or 'monthly'", call. = FALSE) } return(calosc) } diff --git a/R/hydro_imgw_annual.R b/R/hydro_imgw_annual.R deleted file mode 100644 index ed127216..00000000 --- a/R/hydro_imgw_annual.R +++ /dev/null @@ -1,146 +0,0 @@ -#' Semi-annual and annual hydrological data -#' -#' Downloading hydrological data for the semi-annual and annual period -#' available in the danepubliczne.imgw.pl collection -#' -#' @param year vector of years (e.g., 1966:2000) -#' @param coords add coordinates of the stations (logical value TRUE or FALSE) -#' @param value type of data (can be: state - "H" (default), flow - "Q", or temperature - "T") -#' @param station name or ID of hydrological station(s). -#' It accepts names (characters in CAPITAL LETTERS) or stations' IDs (numeric) -#' @param col_names three types of column names possible: -#' "short" - default, values with shorten names, -#' "full" - full English description, -#' "polish" - original names in the dataset -#' @param allow_failure logical - whether to proceed or stop on failure. By default set to TRUE (i.e. don't stop on error). For debugging purposes change to FALSE -#' @param ... other parameters that may be passed to the 'shortening' function that shortens column names -#' @importFrom XML readHTMLTable -#' @importFrom utils download.file unzip read.csv -#' @importFrom data.table fread -#' @export -#' @returns data.frame with historical hydrological data for the semi-annual and annual period -#' @examples -#' \donttest{ -#' hydro_yearly = hydro_imgw_annual(year = 2000, value = "H", station = "ANNOPOL") -#' } -hydro_imgw_annual = function(year, - coords = FALSE, - value = "H", - station = NULL, - col_names = "short", - allow_failure = TRUE, - ...) { - - if (allow_failure) { - tryCatch(hydro_imgw_annual_bp(year, - coords, - value, - station, - col_names, - ...), - error = function(e){ - message(paste("Problems with downloading data.", - "Run function with argument allow_failure = FALSE", - "to see more details"))}) - } else { - hydro_imgw_annual_bp(year, - coords, - value, - station, - col_names, - ...) - } -} - -#' @keywords internal -#' @noRd -hydro_imgw_annual_bp = function(year = year, - coords = coords, - value = value, - station = station, - col_names = col_names, - ...) { - - translit = check_locale() - base_url = "https://danepubliczne.imgw.pl/data/dane_pomiarowo_obserwacyjne/dane_hydrologiczne/" - interval = "semiannual_and_annual" - interval_pl = "polroczne_i_roczne" - - temp = tempfile() - test_url(link = paste0(base_url, interval_pl, "/"), output = temp) - a = readLines(temp, warn = FALSE) - - ind = grep(readHTMLTable(a)[[1]]$Name, pattern = "/") - catalogs = as.character(readHTMLTable(a)[[1]]$Name[ind]) - catalogs = gsub(x = catalogs, pattern = "/", replacement = "") - - catalogs = catalogs[catalogs %in% as.character(year)] - if (length(catalogs) == 0) { - stop("Selected year(s) is/are not available in the database.", call. = FALSE) - } - meta = hydro_metadata_imgw(interval) - - all_data = vector("list", length = length(catalogs)) - for (i in seq_along(catalogs)) { - catalog = catalogs[i] - address = paste0(base_url, interval_pl, "/", catalog, "/polr_", value, "_", catalog, ".zip") - - temp = tempfile() - temp2 = tempfile() - test_url(address, temp) - #download.file(address, temp) - unzip(zipfile = temp, exdir = temp2) - file1 = paste(temp2, dir(temp2), sep = "/")[1] - - if (translit) { - data1 = as.data.frame(data.table::fread(cmd = paste("iconv -f ISO-8859-2 -t ASCII//TRANSLIT", file1))) - } else { - data1 = tryCatch(expr = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, sep = ",", - fileEncoding = "CP1250"), - warning = function(w) { - read.csv(file1, header = FALSE, stringsAsFactors = FALSE, sep = ";") - }) - if (ncol(data1) == 1) { - data1 = tryCatch(expr = read.csv(file1, header = FALSE, stringsAsFactors = FALSE, sep = ";", - fileEncoding = "UTF-8"), - warning = function(w) { - read.csv(file1, header = FALSE, stringsAsFactors = FALSE, sep = ";") - }) - } - } - - colnames(data1) = meta[[value]]$parameters - all_data[[i]] = data1 - } - all_data = do.call(rbind, all_data) - all_data[all_data == 99999.999] = NA - all_data = all_data[, !duplicated(colnames(all_data))] - - # coords - if (coords) { - all_data = merge(climate::imgw_hydro_stations, all_data, by.x = "id", by.y = "Nazwa rzeki/jeziora", all.y = TRUE) - } - #station selection - if (!is.null(station)) { - if (is.character(station)) { - all_data = all_data[substr(all_data$`Nazwa stacji`, 1, nchar(station)) == station, ] - if (nrow(all_data) == 0) { - - stop("Selected station(s) is not available in the database.", call. = FALSE) - } - } else if (is.numeric(station)) { - all_data = all_data[all_data$`Kod stacji` %in% station, ] - if (nrow(all_data) == 0) { - stop("Selected station(s) is not available in the database.", call. = FALSE) - } - } else { - stop("Selected station(s) are not in the proper format.", call. = FALSE) - } - } - - all_data = all_data[order(all_data$`Nazwa stacji`, all_data$`Rok hydrologiczny`), ] - # adding option for shortening column names and removing duplicates - all_data = hydro_shortening_imgw(all_data, col_names = col_names, ...) - - return(all_data) -} diff --git a/R/hydro_metadata_imgw.R b/R/hydro_metadata_imgw.R index 20028195..fcd54192 100644 --- a/R/hydro_metadata_imgw.R +++ b/R/hydro_metadata_imgw.R @@ -3,7 +3,7 @@ #' Downloading the description (metadata) to hydrological data available in the danepubliczne.imgw.pl repository. #' By default, the function returns a list or data frame for a selected subset #` -#' @param interval temporal resolution of the data ("daily" , "monthly", or "semiannual_and_annual") +#' @param interval temporal resolution of the data ("daily" or "monthly") #' @param allow_failure logical - whether to proceed or stop on failure. By default set to TRUE (i.e. don't stop on error). For debugging purposes change to FALSE #' @keywords internal #' @noRd @@ -37,12 +37,8 @@ hydro_metadata_imgw_bp = function(interval) { #miesieczne address_meta = paste0(base_url, "miesieczne/mies_info.txt") meta = clean_metadata_hydro(address_meta, interval) - } else if (interval == "semiannual_and_annual") { - # polroczne_i_roczne - address_meta = paste0(base_url, "polroczne_i_roczne/polr_info.txt") - meta = clean_metadata_hydro(address_meta, interval) } else { - stop("Wrong `interval` value. It should be either 'daily', 'monthly', or 'semiannual_and_annual'.") + stop("Wrong `interval` value. It should be either 'daily' or 'monthly'.") } return(meta) diff --git a/R/nearest_stations_imgw.R b/R/nearest_stations_imgw.R index d6af31f6..741860f0 100644 --- a/R/nearest_stations_imgw.R +++ b/R/nearest_stations_imgw.R @@ -97,7 +97,7 @@ nearest_stations_imgw_bp = function(type, if (type == "meteo") { result = unique(meteo_imgw_monthly(rank = rank, year = year, coords = TRUE)[, c(2:5)]) } else if (type == "hydro") { - result = unique(hydro_imgw_annual(year = year, coords = TRUE)[, c(1:4)]) + result = unique(hydro_imgw_monthly(year = year, coords = TRUE)[, c(1:4)]) } else { stop("You've provided wrong type argument; please use: \"meteo\", or \"hydro\"") } diff --git a/README.md b/README.md index 2a0100fc..e323b529 100644 --- a/README.md +++ b/README.md @@ -59,7 +59,7 @@ It is a wrapper for `meteo_monthly()`, `meteo_daily()`, and `meteo_hourly()` - **hydro_imgw()** - Downloading hourly, daily, and monthly hydrological data from the SYNOP / CLIMATE / PRECIP stations available in the danepubliczne.imgw.pl collection. -It is a wrapper for previously developed set of functions such as: `hydro_annual()`, `hydro_monthly()`, and `hydro_daily()` +It is a wrapper for previously developed set of functions such as: `hydro_monthly()`, and `hydro_daily()` ### Auxiliary functions and datasets @@ -166,15 +166,15 @@ head(m) #> 580 21.3 -4.3 5.7 13.8 -8.3 9.4 #> 581 23.1 1.0 9.6 16.6 -1.8 36.4 -h = hydro_imgw(interval = "semiannual_and_annual", year = 2010:2011) +h = hydro_imgw(interval = "daily", year = 2010:2011) head(h) - id station riv_or_lake hyy idyy Mesu idex H beyy bemm bedd behm -3223 150210180 ANNOPOL Wisła (2) 2010 13 H 1 227 2009 12 19 NA -3224 150210180 ANNOPOL Wisła (2) 2010 13 H 2 319 NA NA NA NA -3225 150210180 ANNOPOL Wisła (2) 2010 13 H 3 531 2010 3 3 18 -3226 150210180 ANNOPOL Wisła (2) 2010 14 H 1 271 2010 8 29 NA -3227 150210180 ANNOPOL Wisła (2) 2010 14 H 1 271 2010 10 27 NA -3228 150210180 ANNOPOL Wisła (2) 2010 14 H 2 392 NA NA NA NA + id station riv_or_lake hyy idhyy dd H Q T mm thick id_ice p_ice +97843 150210180 ANNOPOL Wisła (2) 2010 1 1 287 436 NA 11 NA NA NA +507527 150210180 ANNOPOL Wisła (2) 2010 1 1 287 436 NA 11 NA NA NA +97844 150210180 ANNOPOL Wisła (2) 2010 1 2 282 412 NA 11 NA NA NA +507528 150210180 ANNOPOL Wisła (2) 2010 1 2 282 412 NA 11 NA NA NA +97845 150210180 ANNOPOL Wisła (2) 2010 1 3 272 368 NA 11 NA NA NA +507529 150210180 ANNOPOL Wisła (2) 2010 1 3 272 368 NA 11 NA NA NA ``` ## Example 5 diff --git a/man/hydro_imgw.Rd b/man/hydro_imgw.Rd index 756fab2c..085a4d85 100644 --- a/man/hydro_imgw.Rd +++ b/man/hydro_imgw.Rd @@ -15,8 +15,7 @@ hydro_imgw( ) } \arguments{ -\item{interval}{temporal resolution of the data ("daily" , "monthly", -or "semiannual_and_annual")} +\item{interval}{temporal resolution of the data ("daily" or "monthly")} \item{year}{vector of years (e.g., 1966:2000)} diff --git a/man/hydro_imgw_annual.Rd b/man/hydro_imgw_annual.Rd deleted file mode 100644 index 6569b09e..00000000 --- a/man/hydro_imgw_annual.Rd +++ /dev/null @@ -1,47 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/hydro_imgw_annual.R -\name{hydro_imgw_annual} -\alias{hydro_imgw_annual} -\title{Semi-annual and annual hydrological data} -\usage{ -hydro_imgw_annual( - year, - coords = FALSE, - value = "H", - station = NULL, - col_names = "short", - allow_failure = TRUE, - ... -) -} -\arguments{ -\item{year}{vector of years (e.g., 1966:2000)} - -\item{coords}{add coordinates of the stations (logical value TRUE or FALSE)} - -\item{value}{type of data (can be: state - "H" (default), flow - "Q", or temperature - "T")} - -\item{station}{name or ID of hydrological station(s). -It accepts names (characters in CAPITAL LETTERS) or stations' IDs (numeric)} - -\item{col_names}{three types of column names possible: -"short" - default, values with shorten names, -"full" - full English description, -"polish" - original names in the dataset} - -\item{allow_failure}{logical - whether to proceed or stop on failure. By default set to TRUE (i.e. don't stop on error). For debugging purposes change to FALSE} - -\item{...}{other parameters that may be passed to the 'shortening' function that shortens column names} -} -\value{ -data.frame with historical hydrological data for the semi-annual and annual period -} -\description{ -Downloading hydrological data for the semi-annual and annual period -available in the danepubliczne.imgw.pl collection -} -\examples{ -\donttest{ -hydro_yearly = hydro_imgw_annual(year = 2000, value = "H", station = "ANNOPOL") -} -} diff --git a/tests/testthat/test-hydro_imgw.R b/tests/testthat/test-hydro_imgw.R index 223c8590..26a4c1ab 100644 --- a/tests/testthat/test-hydro_imgw.R +++ b/tests/testthat/test-hydro_imgw.R @@ -25,10 +25,13 @@ test_that("hydro_imgw_not_available", { testthat::expect_true(nrow(h2022_2023) > 50000) } + h2022_2023d = hydro_imgw(interval = "daily", + year = 2022:2023, + coord = TRUE, + allow_failure = FALSE) + if (is.data.frame(h2022_2023d) & nrow(h2022_2023d > 50000)) { + testthat::expect_true(is.data.frame(h2022_2023d)) + testthat::expect_true(nrow(h2022_2023d) > 50000) + } - expect_error(suppressWarnings(hydro_imgw(interval = "semiannual_and_annual", year = 1960, coord = TRUE, - station = "not available", allow_failure = FALSE))) - - expect_error(suppressWarnings(hydro_imgw(interval = "semiannual_and_annual", year = 1960, coord = TRUE, - station = 999, allow_failure = FALSE))) }) \ No newline at end of file diff --git a/tests/testthat/test-hydro_metadata_imgw.R b/tests/testthat/test-hydro_metadata_imgw.R index 8d79f872..887c09a9 100644 --- a/tests/testthat/test-hydro_metadata_imgw.R +++ b/tests/testthat/test-hydro_metadata_imgw.R @@ -2,15 +2,11 @@ context("hydro-metadata") h_d <- suppressWarnings(hydro_metadata_imgw("daily")) h_m <- suppressWarnings(hydro_metadata_imgw("monthly")) -h_a <- suppressWarnings(hydro_metadata_imgw("semiannual_and_annual")) test_that("hydro-metadata works!", { if (is.list(h_d) && is.list(h_m) && is.list(h_a)) { expect_equal(dim(h_d[[1]]), c(10, 1)) expect_equal(dim(h_d[[2]]), c(10, 1)) expect_equal(dim(h_m[[1]]), c(10, 1)) - expect_equal(dim(h_a[[1]]), c(16, 1)) - expect_equal(dim(h_a[[2]]), c(16, 1)) - expect_equal(dim(h_a[[3]]), c(16, 1)) } }) diff --git a/vignettes/getstarted.Rmd b/vignettes/getstarted.Rmd index 20e4e3d1..5c638f7a 100644 --- a/vignettes/getstarted.Rmd +++ b/vignettes/getstarted.Rmd @@ -47,7 +47,7 @@ It is a wrapper for `meteo_monthly()`, `meteo_daily()`, and `meteo_hourly()` - **hydro_imgw()** - Downloading hourly, daily, and monthly hydrological data from the SYNOP / CLIMATE / PRECIP stations available in the danepubliczne.imgw.pl collection. -It is a wrapper for `hydro_annual()`, `hydro_monthly()`, and `hydro_daily()` +It is a wrapper for `hydro_monthly()`, and `hydro_daily()` ### Auxiliary functions and datasets