diff --git a/.Rbuildignore b/.Rbuildignore index ac8f161..3c317c5 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,3 +9,4 @@ appveyor.yml inst/extdata/grdc inst/experimental/* ^\.github$ +^cran-comments\.md$ diff --git a/DESCRIPTION b/DESCRIPTION index ad59f26..bbf9852 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,25 +1,44 @@ Package: hddtools Title: Hydrological Data Discovery Tools Version: 0.9.5 -Authors@R: c(person(given = "Claudia", family = "Vitolo", - role = c("aut"), email = "cvitolodev@gmail.com", - comment = c(ORCID = "0000-0002-4252-1176")), - person(given = "Wouter", family = "Buytaert", role = c("ctb"), - comment = "Supervisor"), - person(given = "Erin", family = "Le Dell", role = c("ctb"), - comment = "Erin reviewed the package for rOpenSci, see https://github.com/ropensci/software-review/issues/73"), - person(given = "Michael", family = "Sumner", role = c("ctb"), - comment = "Michael reviewed the package for rOpenSci, see https://github.com/ropensci/software-review/issues/73"), - person(given = "Dorothea", family = "Hug Peter", role = c("aut", "cre"), email = "dorothea.hug@wsl.ch")) +Authors@R: c( + person("Claudia", "Vitolo", , "cvitolodev@gmail.com", role = "aut", + comment = c(ORCID = "0000-0002-4252-1176")), + person("Wouter", "Buytaert", role = "ctb", + comment = "Supervisor"), + person("Erin", "Le Dell", role = "ctb", + comment = "Erin reviewed the package for rOpenSci, see https://github.com/ropensci/software-review/issues/73"), + person("Michael", "Sumner", role = "ctb", + comment = "Michael reviewed the package for rOpenSci, see https://github.com/ropensci/software-review/issues/73"), + person("Dorothea", "Hug Peter", , "dorothea.hug@wsl.ch", role = c("aut", "cre")) + ) Maintainer: Dorothea Hug Peter -URL: https://docs.ropensci.org/hddtools/, https://github.com/ropensci/hddtools -BugReports: https://github.com/ropensci/hddtools/issues -Description: Tools to discover hydrological data, accessing catalogues and databases from various data providers. The package is described in Vitolo (2017) "hddtools: Hydrological Data Discovery Tools" . -Depends: R (>= 3.5.0) -Imports: zoo, curl, XML, terra, readxl, tidyr, sf -Suggests: testthat, leaflet, rmarkdown, knitr, dplyr -VignetteBuilder: knitr +Description: Tools to discover hydrological data, accessing catalogues and + databases from various data providers. The package is described in + Vitolo (2017) "hddtools: Hydrological Data Discovery Tools" + . License: GPL-3 -Repository: CRAN -RoxygenNote: 7.2.0 +URL: https://docs.ropensci.org/hddtools/, + https://github.com/ropensci/hddtools +BugReports: https://github.com/ropensci/hddtools/issues +Depends: + R (>= 3.5.0) +Imports: + curl, + readxl, + sf, + terra, + tidyr, + XML, + zoo +Suggests: + dplyr, + knitr, + leaflet, + rmarkdown, + testthat +VignetteBuilder: + knitr Encoding: UTF-8 +Repository: CRAN +RoxygenNote: 7.2.3 diff --git a/NEWS.md b/NEWS.md index d995632..36ad841 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # hddtools 0.9.5 -*Removed dependency fom rgdal and raster packages +*Removed dependency from rgdal and raster packages # hddtools 0.9.4 diff --git a/R/Data60UK.R b/R/Data60UK.R index f2671cd..1aed93f 100644 --- a/R/Data60UK.R +++ b/R/Data60UK.R @@ -25,17 +25,15 @@ #' #' @examples #' \dontrun{ -#' # Retrieve the whole catalogue -#' Data60UK_catalogue_all <- catalogueData60UK() +#' # Retrieve the whole catalogue +#' Data60UK_catalogue_all <- catalogueData60UK() #' -#' # Filter the catalogue based on a bounding box -#' areaBox <- terra::ext(-4, -2, +52, +53) -#' Data60UK_catalogue_bbox <- catalogueData60UK(areaBox) +#' # Filter the catalogue based on a bounding box +#' areaBox <- terra::ext(-4, -2, +52, +53) +#' Data60UK_catalogue_bbox <- catalogueData60UK(areaBox) #' } #' - -catalogueData60UK <- function(areaBox = NULL){ - +catalogueData60UK <- function(areaBox = NULL) { file_url <- "http://nrfaapps.ceh.ac.uk/datauk60/data.html" tables <- XML::readHTMLTable(file_url) @@ -55,28 +53,29 @@ catalogueData60UK <- function(areaBox = NULL){ Data60UKcatalogue$Longitude <- temp$longitude # Latitude is the Y axis, longitude is the X axis. - if (!is.null(areaBox)){ + if (!is.null(areaBox)) { lonMin <- areaBox$xmin lonMax <- areaBox$xmax latMin <- areaBox$ymin latMax <- areaBox$ymax - }else{ + } else { lonMin <- -180 lonMax <- +180 latMin <- -90 latMax <- +90 } - Data60UKcatalogue <- subset(Data60UKcatalogue, - (Data60UKcatalogue$Latitude <= latMax & - Data60UKcatalogue$Latitude >= latMin & - Data60UKcatalogue$Longitude <= lonMax & - Data60UKcatalogue$Longitude >= lonMin)) + Data60UKcatalogue <- subset( + Data60UKcatalogue, + (Data60UKcatalogue$Latitude <= latMax & + Data60UKcatalogue$Latitude >= latMin & + Data60UKcatalogue$Longitude <= lonMax & + Data60UKcatalogue$Longitude >= lonMin) + ) row.names(Data60UKcatalogue) <- NULL return(Data60UKcatalogue) - } #' Interface for the Data60UK database of Daily Time Series @@ -93,12 +92,10 @@ catalogueData60UK <- function(areaBox = NULL){ #' #' @examples #' \dontrun{ -#' Morwick <- tsData60UK(id = "22001") +#' Morwick <- tsData60UK(id = "22001") #' } #' - -tsData60UK <- function(id){ - +tsData60UK <- function(id) { file_url <- paste0("http://nrfaapps.ceh.ac.uk/datauk60/data/rq", id, ".txt") temp <- utils::read.table(file_url) @@ -111,8 +108,7 @@ tsData60UK <- function(id){ P <- zoo::zoo(temp$P, order.by = datetime) # measured in mm Q <- zoo::zoo(temp$Q, order.by = datetime) # measured in m3/s - myTS <- zoo::merge.zoo(P,Q) + myTS <- zoo::merge.zoo(P, Q) return(myTS) - } diff --git a/R/GRDC.R b/R/GRDC.R index a3873b5..76d0c61 100644 --- a/R/GRDC.R +++ b/R/GRDC.R @@ -38,47 +38,56 @@ #' #' @examples #' \dontrun{ -#' # Retrieve the catalogue -#' GRDC_catalogue_all <- catalogueGRDC() +#' # Retrieve the catalogue +#' GRDC_catalogue_all <- catalogueGRDC() #' } #' - catalogueGRDC <- function() { - file_url <- "ftp://ftp.bafg.de/pub/REFERATE/GRDC/catalogue/grdc_stations.zip" # Create a temporary directory td <- tempdir() # Create the placeholder file tf <- tempfile(tmpdir = td, fileext = ".zip") - + # Retrieve the catalogue into the placeholder file x <- curl::curl_download(url = file_url, destfile = tf) - + # Unzip the file to the temporary directory utils::unzip(tf, exdir = td, overwrite = TRUE) - + # Read - GRDCcatalogue <- readxl::read_xlsx(path = file.path(td, "GRDC_Stations.xlsx"), - sheet = "station_catalogue") - + GRDCcatalogue <- readxl::read_xlsx( + path = file.path(td, "GRDC_Stations.xlsx"), + sheet = "station_catalogue" + ) + # Cleanup - GRDCcatalogue <- data.frame(lapply(GRDCcatalogue, - function(x) {gsub("n.a.|-999.0", NA, x)}), - stringsAsFactors = FALSE) - + GRDCcatalogue <- data.frame( + lapply( + GRDCcatalogue, + function(x) { + gsub("n.a.|-999.0", NA, x) + } + ), + stringsAsFactors = FALSE + ) + # Convert to numeric some of the columns - colx <- c("wmo_reg", "sub_reg", - "d_start", "d_end", "d_yrs", - "m_start", "m_end", "m_yrs", - "t_start", "t_end", "t_yrs") + colx <- c( + "wmo_reg", "sub_reg", + "d_start", "d_end", "d_yrs", + "m_start", "m_end", "m_yrs", + "t_start", "t_end", "t_yrs" + ) GRDCcatalogue[, colx] <- lapply(GRDCcatalogue[, colx], as.integer) - + # Convert to integers some of the columns - colx <- c("lat", "long", "area", "altitude", "d_miss", "m_miss", - "lta_discharge", "r_volume_yr", "r_height_yr") + colx <- c( + "lat", "long", "area", "altitude", "d_miss", "m_miss", + "lta_discharge", "r_volume_yr", "r_height_yr" + ) GRDCcatalogue[, colx] <- lapply(GRDCcatalogue[, colx], as.numeric) return(GRDCcatalogue) - } diff --git a/R/KGClimateClass.R b/R/KGClimateClass.R index a7c6c9f..623751d 100644 --- a/R/KGClimateClass.R +++ b/R/KGClimateClass.R @@ -16,28 +16,29 @@ #' #' @examples #' \dontrun{ -#' # Define a bounding box -#' areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52) -#' # Get climate classes -#' KGClimateClass(areaBox = areaBox) +#' # Define a bounding box +#' areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52) +#' # Get climate classes +#' KGClimateClass(areaBox = areaBox) #' } #' - -KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE){ - +KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE) { # crop to bounding box - if (is.null(areaBox)){ + if (is.null(areaBox)) { areaBox <- terra::ext(c(-180, +180, -90, +90)) } bbSP <- bboxSpatialPolygon(areaBox) if (updatedBy == "Kottek") { - # MAP UPDATED BY KOTTEK - kgLegend <- utils::read.table(system.file(file.path("extdata", - "KOTTEK_Legend.txt"), - package = "hddtools")) + kgLegend <- utils::read.table(system.file( + file.path( + "extdata", + "KOTTEK_Legend.txt" + ), + package = "hddtools" + )) kgLegend$V1 <- as.character(kgLegend$V1) # message("OFFLINE results") @@ -48,36 +49,44 @@ KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE){ tf <- tempfile(tmpdir = td, fileext = ".tar.gz") utils::untar(system.file(file.path("extdata", "KOTTEK_KG.tar.gz"), - package = "hddtools"), exdir = td) + package = "hddtools" + ), exdir = td) kgRaster <- terra::rast(paste0(td, "/KOTTEK_koeppen-geiger.tiff", - sep = "")) + sep = "" + )) - temp <- data.frame(table(terra::extract(kgRaster, bbSP)))[,2:3] + temp <- data.frame(table(terra::extract(kgRaster, bbSP)))[, 2:3] colnames(temp)[1] <- "ID" temp$Class <- NA - for (i in 1:dim(temp)[1]){ - class1 <- which(kgLegend[,1] == as.character(temp[i,1])) - if (length(class1) > 0){ - temp$Class[i] <- as.character(kgLegend[class1,3]) + for (i in 1:dim(temp)[1]) { + class1 <- which(kgLegend[, 1] == as.character(temp[i, 1])) + if (length(class1) > 0) { + temp$Class[i] <- as.character(kgLegend[class1, 3]) } } - temp <- temp[which(!is.na(temp$Class)),] - - df <- data.frame(ID = temp$ID, - Class = temp$Class, - Frequency = temp$Freq) + temp <- temp[which(!is.na(temp$Class)), ] + df <- data.frame( + ID = temp$ID, + Class = temp$Class, + Frequency = temp$Freq + ) } if (updatedBy == "Peel") { - # MAP UPDATED BY PEEL - kgLegend <- utils::read.table(system.file(file.path("extdata", - "PEEL_Legend.txt"), - package = "hddtools"), - header = TRUE) + kgLegend <- utils::read.table( + system.file( + file.path( + "extdata", + "PEEL_Legend.txt" + ), + package = "hddtools" + ), + header = TRUE + ) kgLegend$ID <- as.character(kgLegend$ID) # message("OFFLINE results") @@ -88,198 +97,232 @@ KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE){ tf <- tempfile(tmpdir = td, fileext = ".tar.gz") utils::untar(system.file(file.path("extdata", "PEEL_KG.tar.gz"), - package = "hddtools"), exdir = td) + package = "hddtools" + ), exdir = td) kgRaster <- terra::rast(paste0(td, "/PEEL_koppen_ascii.txt", sep = "")) - temp <- data.frame(table(terra::extract(kgRaster, bbSP)))[,2:3] + temp <- data.frame(table(terra::extract(kgRaster, bbSP)))[, 2:3] colnames(temp)[1] <- "ID" temp$Class <- NA - for (i in 1:dim(temp)[1]){ - class1 <- which(kgLegend[,1] == as.character(temp[i,1])) - if (length(class1) > 0){ - temp$Class[i] <- as.character(kgLegend[class1,2]) + for (i in 1:dim(temp)[1]) { + class1 <- which(kgLegend[, 1] == as.character(temp[i, 1])) + if (length(class1) > 0) { + temp$Class[i] <- as.character(kgLegend[class1, 2]) } } - temp <- temp[which(!is.na(temp$Class)),] - - df <- data.frame(ID = temp$ID, - Class = temp$Class, - Frequency = temp$Freq) + temp <- temp[which(!is.na(temp$Class)), ] + df <- data.frame( + ID = temp$ID, + Class = temp$Class, + Frequency = temp$Freq + ) } - firstPart <- substr(temp$Class,1,1) - secondPart <- substr(temp$Class,2,2) - thirdPart <- substr(temp$Class,3,3) - - description <- vector(mode="character", length=max(length(firstPart), - length(secondPart), - length(thirdPart))) - - criterion <- vector(mode="character", length=max(length(firstPart), - length(secondPart), - length(thirdPart))) + firstPart <- substr(temp$Class, 1, 1) + secondPart <- substr(temp$Class, 2, 2) + thirdPart <- substr(temp$Class, 3, 3) + description <- vector(mode = "character", length = max( + length(firstPart), + length(secondPart), + length(thirdPart) + )) - for (j in 1:length(description)){ + criterion <- vector(mode = "character", length = max( + length(firstPart), + length(secondPart), + length(thirdPart) + )) - if (firstPart[j] == "A"){ + for (j in seq_len(length(description))) { + if (firstPart[j] == "A") { description[j] <- "A = Equatorial climates" criterion[j] <- "A = Tmin >= +18 C" - if (secondPart[j] == "f"){ - description[j] <- paste0(description[j], - "; f = Equatorial rainforest, fully humid") - criterion[j] <- paste0(criterion[j],"; f = Pmin >= 60mm") + if (secondPart[j] == "f") { + description[j] <- paste0( + description[j], + "; f = Equatorial rainforest, fully humid" + ) + criterion[j] <- paste0(criterion[j], "; f = Pmin >= 60mm") } - if (secondPart[j] == "m"){ + if (secondPart[j] == "m") { description[j] <- paste0(description[j], "; m = Equatorial monsoon") criterion[j] <- paste0(criterion[j], "; m = Pann >= 25*(100 - Pmin)") } - if (secondPart[j] == "s"){ - description[j] <- paste0(description[j], - "; s = Equatorial savannah with dry summer") + if (secondPart[j] == "s") { + description[j] <- paste0( + description[j], + "; s = Equatorial savannah with dry summer" + ) criterion[j] <- paste0(criterion[j], "; s = Pmin < 60mm in summer") } - if (secondPart[j] == "w"){ - description[j] <- paste0(description[j], - "; w = Equatorial savannah with dry winter") + if (secondPart[j] == "w") { + description[j] <- paste0( + description[j], + "; w = Equatorial savannah with dry winter" + ) criterion[j] <- paste0(criterion[j], "; w = Pmin < 60mm in winter") } } - if (firstPart[j] == "B"){ - + if (firstPart[j] == "B") { description[j] <- "B = Arid climates" criterion[j] <- "B = Pann < 10 Pth" - if (secondPart[j] == "S"){ + if (secondPart[j] == "S") { description[j] <- paste0(description[j], "; S = Steppe climate") criterion[j] <- paste0(criterion[j], "; S = Pann > 5 Pth") } - if (secondPart[j] == "W"){ + if (secondPart[j] == "W") { description[j] <- paste0(description[j], "; W = Desert climate") criterion[j] <- paste0(criterion[j], "; W = Pann <= 5 Pth") } } - if (firstPart[j] == "C"){ - + if (firstPart[j] == "C") { description[j] <- "C = Warm temperate climates" criterion[j] <- "C = -3 C < Tmin < +18 C" - if (secondPart[j] == "s"){ - description[j] <- paste0(description[j], - "; s = Warm temperate climate with dry summer") - criterion[j] <- paste0(criterion[j], - "; s = Psmin < Pwmin , Pwmax > 3", - "Psmin and Psmin < 40mm") + if (secondPart[j] == "s") { + description[j] <- paste0( + description[j], + "; s = Warm temperate climate with dry summer" + ) + criterion[j] <- paste0( + criterion[j], + "; s = Psmin < Pwmin , Pwmax > 3", + "Psmin and Psmin < 40mm" + ) } - if (secondPart[j] == "w"){ - description[j] <- paste0(description[j], - "; w = Warm temperate climate with dry winter") - criterion[j] <- paste0(criterion[j], - "; w = Pwmin < Psmin and Psmax > 10 Pwmin") + if (secondPart[j] == "w") { + description[j] <- paste0( + description[j], + "; w = Warm temperate climate with dry winter" + ) + criterion[j] <- paste0( + criterion[j], + "; w = Pwmin < Psmin and Psmax > 10 Pwmin" + ) } - if (secondPart[j] == "f"){ - description[j] <- paste0(description[j], - "; f = Warm temperate climate, fully humid") - criterion[j] <- paste0(criterion[j], - "; f = neither Cs nor Cw", - "; (Cs's criterion: Psmin <", - "Pwmin, Pwmax > 3 Psmin and Psmin < 40mm.; Cw's", - "criterion: Pwmin < Psmin and Psmax >10 Pwmin.)") + if (secondPart[j] == "f") { + description[j] <- paste0( + description[j], + "; f = Warm temperate climate, fully humid" + ) + criterion[j] <- paste0( + criterion[j], + "; f = neither Cs nor Cw", + "; (Cs's criterion: Psmin <", + "Pwmin, Pwmax > 3 Psmin and Psmin < 40mm.; Cw's", + "criterion: Pwmin < Psmin and Psmax >10 Pwmin.)" + ) } } - if (firstPart[j] == "D"){ - + if (firstPart[j] == "D") { description[j] <- "D = Snow climates" criterion[j] <- "D = Tmin <= -3 C" - if (secondPart[j] == "s"){ - description[j] <- paste0(description[j], - "; s = Snow climate with dry summer") - criterion[j] <- paste0(criterion[j], - "; s = Psmin < Pwmin , Pwmax > 3", - "Psmin and Psmin < 40mm") + if (secondPart[j] == "s") { + description[j] <- paste0( + description[j], + "; s = Snow climate with dry summer" + ) + criterion[j] <- paste0( + criterion[j], + "; s = Psmin < Pwmin , Pwmax > 3", + "Psmin and Psmin < 40mm" + ) } - if (secondPart[j] == "w"){ - description[j] <- paste0(description[j], - "; w = Snow climate with dry winter") - criterion[j] <- paste0(criterion[j], - "; w = Pwmin < Psmin and Psmax > 10 Pwmin") + if (secondPart[j] == "w") { + description[j] <- paste0( + description[j], + "; w = Snow climate with dry winter" + ) + criterion[j] <- paste0( + criterion[j], + "; w = Pwmin < Psmin and Psmax > 10 Pwmin" + ) } - if (secondPart[j] == "f"){ - description[j] <- paste0(description[j], - "; f = Snow climate, fully humid") - criterion[j] <- paste0(criterion[j], - "; f = neither Ds nor Dw","; (Ds's", - "criterion: Psmin < Pwmin , Pwmax > 3 Psmin and", - "Psmin < 40mm.;", - "Dw's criterion: Pwmin < Psmin and", - "Psmax > 10 Pwmin.)") + if (secondPart[j] == "f") { + description[j] <- paste0( + description[j], + "; f = Snow climate, fully humid" + ) + criterion[j] <- paste0( + criterion[j], + "; f = neither Ds nor Dw", "; (Ds's", + "criterion: Psmin < Pwmin , Pwmax > 3 Psmin and", + "Psmin < 40mm.;", + "Dw's criterion: Pwmin < Psmin and", + "Psmax > 10 Pwmin.)" + ) } } - if (firstPart[j] == "E"){ - + if (firstPart[j] == "E") { description[j] <- "E = Polar climates" criterion[j] <- "E = Tmax < +10 C" - if (secondPart[j] == "T"){ + if (secondPart[j] == "T") { description[j] <- paste0(description[j], "; T = Tundra climate") criterion[j] <- paste0(criterion[j], "; T = 0 C <= Tmax < +10 C") } - if (secondPart[j] == "F"){ + if (secondPart[j] == "F") { description[j] <- paste0(description[j], "; F = Frost climate") criterion[j] <- paste0(criterion[j], "; F = Tmax < 0 C") } } - if (thirdPart[j] == "h"){ + if (thirdPart[j] == "h") { description[j] <- paste0(description[j], "; h = Hot steppe / desert") criterion[j] <- paste0(criterion[j], "; h = Tann >= +18 C") } - if (thirdPart[j] == "k"){ + if (thirdPart[j] == "k") { description[j] <- paste0(description[j], "; k = Cold steppe /desert") criterion[j] <- paste0(criterion[j], "; k = Tann < +18 C") } - if (thirdPart[j] == "a"){ + if (thirdPart[j] == "a") { description[j] <- paste0(description[j], "; a = Hot summer") criterion[j] <- paste0(criterion[j], "; a = Tmax >= +22 C") } - if (thirdPart[j] == "b"){ + if (thirdPart[j] == "b") { description[j] <- paste0(description[j], "; b = Warm summer") - criterion[j] <- paste0(criterion[j], - "; b = Tmax < +22 C & at least 4 Tmon >= +10 C") + criterion[j] <- paste0( + criterion[j], + "; b = Tmax < +22 C & at least 4 Tmon >= +10 C" + ) } - if (thirdPart[j] == "c"){ - description[j] <- paste0(description[j], - "; c = Cool summer and cold winter") - criterion[j] <- paste0(criterion[j], "; c = Tmax >= +22 C ", - "& 4 Tmon < +10 C & Tmin > -38 C") + if (thirdPart[j] == "c") { + description[j] <- paste0( + description[j], + "; c = Cool summer and cold winter" + ) + criterion[j] <- paste0( + criterion[j], "; c = Tmax >= +22 C ", + "& 4 Tmon < +10 C & Tmin > -38 C" + ) } - if (thirdPart[j] == "d"){ + if (thirdPart[j] == "d") { description[j] <- paste0(description[j], "; d = Extremely continental") - criterion[j] <- paste0(criterion[j], "; d = Tmax >= +22 C ", - "& 4 Tmon < +10 C & Tmin <= -38 C") + criterion[j] <- paste0( + criterion[j], "; d = Tmax >= +22 C ", + "& 4 Tmon < +10 C & Tmin <= -38 C" + ) } - } - if ( verbose == TRUE ){ - + if (verbose == TRUE) { message("Class(es):") print(temp$Class) message("Description:") print(description) message("Criterion:") print(criterion) - } return(df) - } diff --git a/R/MOPEX.R b/R/MOPEX.R index 40c15a4..6fcb0ad 100644 --- a/R/MOPEX.R +++ b/R/MOPEX.R @@ -3,7 +3,7 @@ #' @author Claudia Vitolo #' #' @description This function retrieves the list of the MOPEX basins. -#' +#' #' @param MAP Boolean, TRUE by default. If FALSE it returns a list of the USGS #' station ID’s and the gage locations of all 1861 potential MOPEX basins. #' If TRUE, it return a list of the USGS station ID’s and the gage locations of @@ -17,7 +17,7 @@ #' \item{\code{Drainage_Area}}{Square Miles} #' \item{\code{R_gauges}}{Required number of precipitation gages to meet MAP accuracy criteria} #' \item{\code{N_gauges}}{Number of gages in total gage window used to estimate MAP} -#' \item{\code{A_gauges}}{Avaliable number of gages in the basin} +#' \item{\code{A_gauges}}{Available number of gauges in the basin} #' \item{\code{Ratio_AR}}{Ratio of Available to Required number of gages in the basin} #' \item{\code{Date_start}}{Date when recordings start} #' \item{\code{Date_end}}{Date when recordings end} @@ -31,18 +31,16 @@ #' obtained as output of \code{tsMOPEX()}. #' #' @export -#' +#' #' @source https://hydrology.nws.noaa.gov/pub/gcip/mopex/US_Data/Documentation/ #' #' @examples #' \dontrun{ -#' # Retrieve the MOPEX catalogue -#' catalogue <- catalogueMOPEX() +#' # Retrieve the MOPEX catalogue +#' catalogue <- catalogueMOPEX() #' } #' - -catalogueMOPEX <- function(MAP = TRUE){ - +catalogueMOPEX <- function(MAP = TRUE) { service_url <- "https://hydrology.nws.noaa.gov/pub/gcip/mopex/US_Data" folder_name <- "Basin_Characteristics" @@ -52,32 +50,38 @@ catalogueMOPEX <- function(MAP = TRUE){ # Read the file as a table mopexTable <- utils::read.table(curl::curl(file_url)) - names(mopexTable) <- c("USGS_ID", "Longitude", "Latitude", "Drainage_Area", - "R_gauges", "N_gauges", "A_gauges", "Ratio_AR") + names(mopexTable) <- c( + "USGS_ID", "Longitude", "Latitude", "Drainage_Area", + "R_gauges", "N_gauges", "A_gauges", "Ratio_AR" + ) # Get extra information for 431 basins only file_name <- "usgs431.txt" file_url <- paste(service_url, folder_name, file_name, sep = "/") - extra_info <- utils::read.fwf(file = file_url, - widths = c(8, 10, 10, 11, 11, 8, - 8, 4, 4, 3, 9, 50)) + extra_info <- utils::read.fwf( + file = file_url, + widths = c( + 8, 10, 10, 11, 11, 8, + 8, 4, 4, 3, 9, 50 + ) + ) extra_info <- extra_info[, c("V1", "V6", "V7", "V10", "V12")] names(extra_info) <- c("USGS_ID", "Date_start", "Date_end", "State", "Name") - + # Join mopexTable and extra_info df <- merge(x = mopexTable, y = extra_info, by = "USGS_ID", all = TRUE) # Ensure USGS_ID is made of 8 digits, add leading zeros if needed # This is needed for consistency with the names of the time series files. df$USGS_ID <- sprintf("%08d", df$USGS_ID) - + # Convert all the factor to character character_cols <- c("Date_start", "Date_end", "State", "Name") df[, character_cols] <- lapply(df[, character_cols], as.character) - + # Remove spaces at the leading and trailing ends, not inside the string values df[, character_cols] <- lapply(df[, character_cols], trimws) - + # Convert dates date_cols <- c("Date_start", "Date_end") df$Date_start <- paste0("01/", df$Date_start) @@ -85,7 +89,6 @@ catalogueMOPEX <- function(MAP = TRUE){ df[, date_cols] <- lapply(df[, date_cols], as.Date, format = "%d/%m/%Y") return(df) - } #' Interface for the MOPEX database of Daily Time Series @@ -116,21 +119,21 @@ catalogueMOPEX <- function(MAP = TRUE){ #' #' @examples #' \dontrun{ -#' BroadRiver <- tsMOPEX(id = "01048000") +#' BroadRiver <- tsMOPEX(id = "01048000") #' } #' - -tsMOPEX <- function(id, MAP = TRUE){ - +tsMOPEX <- function(id, MAP = TRUE) { service_url <- "https://hydrology.nws.noaa.gov/pub/gcip/mopex/US_Data" folder_name <- ifelse(MAP == TRUE, "Us_438_Daily", "Daily%20Q%201800") file_name <- ifelse(MAP == TRUE, paste0(id, ".dly"), paste0(id, ".dq")) file_url <- paste(service_url, folder_name, file_name, sep = "/") - + if (MAP == TRUE) { # Read the file as a table - df <- utils::read.fwf(file = curl::curl(file_url), - widths = c(4, 2, 2, 10, 10, 10, 10, 10)) + df <- utils::read.fwf( + file = curl::curl(file_url), + widths = c(4, 2, 2, 10, 10, 10, 10, 10) + ) Year <- df$V1 Month <- sprintf("%02d", df$V2) Day <- sprintf("%02d", df$V3) @@ -140,8 +143,10 @@ tsMOPEX <- function(id, MAP = TRUE){ } else { # Read the file as a table df <- utils::read.table(file = file_url, header = FALSE, skip = 1) - df <- tidyr::pivot_longer(data = df, cols = 2:32, - values_to = "Q", names_to = "Day") + df <- tidyr::pivot_longer( + data = df, cols = 2:32, + values_to = "Q", names_to = "Day" + ) Year <- substr(x = df$V1, start = 1, stop = 4) Month <- substr(x = df$V1, start = 5, stop = 6) Day <- trimws(substr(x = df$Day, start = 2, stop = nchar(df$Day))) @@ -159,5 +164,4 @@ tsMOPEX <- function(id, MAP = TRUE){ mopexTS <- zoo::zoo(df, order.by = date) return(mopexTS) - } diff --git a/R/SEPA.R b/R/SEPA.R index b08997c..7859a58 100644 --- a/R/SEPA.R +++ b/R/SEPA.R @@ -36,32 +36,27 @@ #' #' @examples #' \dontrun{ -#' # Retrieve the whole catalogue -#' SEPA_catalogue_all <- catalogueSEPA() +#' # Retrieve the whole catalogue +#' SEPA_catalogue_all <- catalogueSEPA() #' } #' +catalogueSEPA <- function() { + theurl <- paste0( + "https://www2.sepa.org.uk/waterlevels/CSVs/", + "SEPA_River_Levels_Web.csv" + ) -catalogueSEPA <- function(){ - - theurl <- paste0("https://www2.sepa.org.uk/waterlevels/CSVs/", - "SEPA_River_Levels_Web.csv") - SEPAcatalogue <- utils::read.csv(theurl, stringsAsFactors = FALSE) - - if (ncol(SEPAcatalogue) > 1){ - + + if (ncol(SEPAcatalogue) > 1) { SEPAcatalogue$CATCHMENT_NAME[SEPAcatalogue$CATCHMENT_NAME == "---"] <- NA SEPAcatalogue$WEB_MESSAGE[SEPAcatalogue$WEB_MESSAGE == ""] <- NA - - }else{ - + } else { message("Website temporarily unavailable") SEPAcatalogue <- NULL - } return(SEPAcatalogue) - } #' Interface for the MOPEX database of Daily Time Series @@ -73,49 +68,45 @@ catalogueSEPA <- function(){ #' #' @param id hydrometric reference number (string) #' -#' @return The function returns river level data in metres, as a zoo object. +#' @return The function returns river level data in meters, as a zoo object. #' #' @export #' #' @examples #' \dontrun{ -#' sampleTS <- tsSEPA(id = "10048") +#' sampleTS <- tsSEPA(id = "10048") #' } #' - -tsSEPA <- function(id){ - +tsSEPA <- function(id) { myTS <- NULL myList <- list() counter <- 0 - for (id in as.list(id)){ + for (id in as.list(id)) { counter <- counter + 1 theurl <- paste("https://www2.sepa.org.uk/waterlevels/CSVs/", - id, "-SG.csv", sep = "") + id, "-SG.csv", + sep = "" + ) sepaTS <- utils::read.csv(theurl, skip = 6) - - if (ncol(sepaTS) > 1){ - + + if (ncol(sepaTS) > 1) { # Coerse first column into a date - datetime <- strptime(sepaTS[,1], "%d/%m/%Y %H:%M") - myTS <- zoo::zoo(sepaTS[,2], order.by = datetime) # measured in m - + datetime <- strptime(sepaTS[, 1], "%d/%m/%Y %H:%M") + myTS <- zoo::zoo(sepaTS[, 2], order.by = datetime) # measured in m + myList[[counter]] <- myTS - - }else{ - + } else { message("Website temporarily unavailable") myList <- NULL - } + } + if (!is.null(myList) & counter == 1) { + myList <- myTS } - - if (!is.null(myList) & counter == 1) {myList <- myTS} - - return(myList) + return(myList) } diff --git a/R/bboxSpatialPolygon.R b/R/bboxSpatialPolygon.R index fa0d92b..ab45906 100644 --- a/R/bboxSpatialPolygon.R +++ b/R/bboxSpatialPolygon.R @@ -3,7 +3,7 @@ #' #' @param boundingbox Bounding box: a 2x2 numerical matrix of lat/lon #' coordinates -#' @param proj4stringFrom Projection string for the current boundingbox +#' @param proj4stringFrom Projection string for the current bounding box #' coordinates (defaults to lat/lon, WGS84) #' @param proj4stringTo Projection string, or NULL to not project #' @@ -23,34 +23,38 @@ bboxSpatialPolygon <- function(boundingbox, proj4stringFrom = NULL, proj4stringTo = NULL) { if (!is.null(proj4stringFrom)) { - stopifnot(inherits(sf::st_crs(proj4stringFrom),"crs")) + stopifnot(inherits(sf::st_crs(proj4stringFrom), "crs")) } if (is.null(proj4stringFrom)) { proj4stringFrom <- "+proj=longlat +datum=WGS84" } - if(is.matrix(boundingbox)) if(dim(boundingbox)==c(2,2)) bb <- boundingbox + if (is.matrix(boundingbox)) if (dim(boundingbox) == c(2, 2)) bb <- boundingbox - #For compatibility with raster input bounding box objects - if(inherits(boundingbox, "Extent")){ - bb <- matrix(as.numeric(c( - boundingbox@xmin, boundingbox@ymin, - boundingbox@xmax, boundingbox@ymax - )), - nrow = 2 - )} + # For compatibility with raster input bounding box objects + if (inherits(boundingbox, "Extent")) { + bb <- matrix( + as.numeric(c( + boundingbox@xmin, boundingbox@ymin, + boundingbox@xmax, boundingbox@ymax + )), + nrow = 2 + ) + } - if(inherits(boundingbox, "SpatExtent")){ - bb <- matrix(as.numeric(c( - boundingbox$xmin, boundingbox$ymin, - boundingbox$xmax, boundingbox$ymax - )), - nrow = 2 - )} + if (inherits(boundingbox, "SpatExtent")) { + bb <- matrix( + as.numeric(c( + boundingbox$xmin, boundingbox$ymin, + boundingbox$xmax, boundingbox$ymax + )), + nrow = 2 + ) + } - if(!exists("bb")) stop("No valid bounding box provided") + if (!exists("bb")) stop("No valid bounding box provided") rownames(bb) <- c("lon", "lat") colnames(bb) <- c("min", "max") diff --git a/R/hddtools-package.R b/R/hddtools-package.R index 36b4468..8bd1d1e 100644 --- a/R/hddtools-package.R +++ b/R/hddtools-package.R @@ -10,7 +10,7 @@ #' \item{\strong{KGClimateClass} (\url{http://koeppen-geiger.vu-wien.ac.at/}): The Koppen Climate Classification map is used for classifying the world's climates based on the annual and monthly averages of temperature and precipitation} #' \item{\strong{GRDC} (\url{http://www.bafg.de/GRDC/EN/Home/homepage_node.html}): The Global Runoff Data Centre (GRDC) provides datasets for all the major rivers in the world} #' \item{\strong{Data60UK} (\url{http://tdwg.catchment.org/datasets.html}): The Data60UK initiative collated datasets of areal precipitation and streamflow discharge across 61 gauging sites in England and Wales (UK).} -#' \item{\strong{MOPEX} (\url{https://www.nws.noaa.gov/ohd/mopex/mo_datasets.htm}): This dataset contains historical hydrometeorological data and river basin characteristics for hundreds of river basins in the US.} +#' \item{\strong{MOPEX} (\url{https://hydrology.nws.noaa.gov/pub/gcip/mopex/US_Data/Documentation/}): This dataset contains historical hydrometeorological data and river basin characteristics for hundreds of river basins in the US.} #' \item{\strong{SEPA} (\url{https://www2.sepa.org.uk/WaterLevels/}): The Scottish Environment Protection Agency (SEPA) provides river level data for hundreds of gauging stations in the UK.}} #' This package complements R's growing functionality in environmental web technologies by bridging the gap between data providers and data consumers. It is designed to be an initial building block of scientific workflows for linking data and models in a seamless fashion. #' diff --git a/cran-comments.md b/cran-comments.md index 375cb73..54da797 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,15 +1,7 @@ -This is a resubmission after the package was archived. -New release (hddtools v0.9.4). - ---------------------------------- - -## Release Summary - -* Removed dependency from the rnrfa package +## R CMD check results -## Test environment -* Ubuntu 18.04, R 3.6.3 +0 errors | 0 warnings | 0 note -## R CMD check results +This is a resubmission after the package has been archived. -There were no ERRORs, WARNINGs or NOTEs. +* This is a new release (hddtools v.0.9.5) * diff --git a/inst/experimental/getContent.R b/inst/experimental/getContent.R index 135d27b..3010820 100644 --- a/inst/experimental/getContent.R +++ b/inst/experimental/getContent.R @@ -12,22 +12,20 @@ #' #' @examples #' \dontrun{ -#' # Retrieve mopex daily catalogue -#' url <- "https://hydrology.nws.noaa.gov/gcip/mopex/US_Data/Us_438_Daily/" -#' getContent(dirs = url) +#' # Retrieve mopex daily catalogue +#' url <- "https://hydrology.nws.noaa.gov/gcip/mopex/US_Data/Us_438_Daily/" +#' getContent(dirs = url) #' } #' - getContent <- function(dirs) { - # Get names of files fls <- strsplit(RCurl::getURL(dirs, dirlistonly = TRUE), "\n")[[1]] # Keep only files with extension .dly fls_dly <- fls[grepl(pattern = "*.dly", x = fls)] # Combine with url to get full path links <- unlist(mapply(paste, dirs, fls_dly, sep = "", SIMPLIFY = FALSE), - use.names = FALSE) + use.names = FALSE + ) return(links) - } diff --git a/inst/experimental/moreGRDC.R b/inst/experimental/moreGRDC.R index e2a6d51..0936d2d 100644 --- a/inst/experimental/moreGRDC.R +++ b/inst/experimental/moreGRDC.R @@ -42,58 +42,70 @@ #' #' @examples #' \dontrun{ -#' # Retrieve the whole catalogue -#' GRDC_catalogue_all <- catalogueGRDC() +#' # Retrieve the whole catalogue +#' GRDC_catalogue_all <- catalogueGRDC() #' -#' # Define a bounding box -#' areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52) -#' # Filter the catalogue based on bounding box -#' GRDC_catalogue_bbox <- catalogueGRDC(areaBox = areaBox) +#' # Define a bounding box +#' areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52) +#' # Filter the catalogue based on bounding box +#' GRDC_catalogue_bbox <- catalogueGRDC(areaBox = areaBox) #' -#' # Get only catchments with area above 5000 Km2 -#' GRDC_catalogue_area <- catalogueGRDC(columnName = "area", -#' columnValue = ">= 5000") +#' # Get only catchments with area above 5000 Km2 +#' GRDC_catalogue_area <- catalogueGRDC( +#' columnName = "area", +#' columnValue = ">= 5000" +#' ) #' -#' # Get only catchments within river Thames -#' GRDC_catalogue_river <- catalogueGRDC(columnName = "river", -#' columnValue = "Thames") +#' # Get only catchments within river Thames +#' GRDC_catalogue_river <- catalogueGRDC( +#' columnName = "river", +#' columnValue = "Thames" +#' ) #' } #' - test_catalogueGRDC <- function() { - the_url <- "ftp://ftp.bafg.de/pub/REFERATE/GRDC/catalogue/" # Retrieve the catalogue - result <- RCurl::getURL(the_url, ftp.use.epsv=TRUE, dirlistonly = TRUE) + result <- RCurl::getURL(the_url, ftp.use.epsv = TRUE, dirlistonly = TRUE) list_of_files <- strsplit(result, "\r*\n")[[1]] yesterday <- gsub(pattern = "-", replacement = "_", Sys.Date() - 1) today <- gsub(pattern = "-", replacement = "_", Sys.Date()) latest_file <- - ifelse(test = length(list_of_files[grep(pattern = today, - x = list_of_files)]), - yes = list_of_files[grep(pattern = today, x = list_of_files)], - no = list_of_files[grep(pattern = yesterday, x = list_of_files)]) + ifelse(test = length(list_of_files[grep( + pattern = today, + x = list_of_files + )]), + yes = list_of_files[grep(pattern = today, x = list_of_files)], + no = list_of_files[grep(pattern = yesterday, x = list_of_files)] + ) latest_file <- paste0(the_url, latest_file) my_tmp_file <- tempfile() - x <- RCurl::getBinaryURL(latest_file, ftp.use.epsv = FALSE,crlf = TRUE) + x <- RCurl::getBinaryURL(latest_file, ftp.use.epsv = FALSE, crlf = TRUE) writeBin(object = x, con = my_tmp_file) GRDCcatalogue <- readxl::read_xlsx(my_tmp_file, sheet = "Catalogue") # Cleanup non - GRDCcatalogue <- data.frame(lapply(GRDCcatalogue, - function(x) {gsub("n.a.|-999|-", NA, x)}), - stringsAsFactors = FALSE) + GRDCcatalogue <- data.frame( + lapply( + GRDCcatalogue, + function(x) { + gsub("n.a.|-999|-", NA, x) + } + ), + stringsAsFactors = FALSE + ) # Convert to numeric some of the columns - colx <- which(!(names(GRDCcatalogue) %in% c("grdc_no", "wmo_reg", "sub_reg", - "nat_id", "river", "station", - "country", "provider_id"))) + colx <- which(!(names(GRDCcatalogue) %in% c( + "grdc_no", "wmo_reg", "sub_reg", + "nat_id", "river", "station", + "country", "provider_id" + ))) GRDCcatalogue[, colx] <- lapply(GRDCcatalogue[, colx], as.numeric) return(GRDCcatalogue) - } #' Interface for the Global Runoff Data Centre database of Monthly Time Series. @@ -228,12 +240,10 @@ test_catalogueGRDC <- function() { #' #' @examples #' \dontrun{ -#' Adaitu <- tsGRDC(id = "1577602") +#' Adaitu <- tsGRDC(id = "1577602") #' } #' - test_tsGRDC <- function(id) { - options(warn = -1) catalogueTmp <- catalogueGRDC() @@ -247,8 +257,10 @@ test_tsGRDC <- function(id) { wmoRegion <- catalogueTmp$wmo_reg # Retrieve ftp server location - zipFile <- as.character(grdcLTMMD[which(grdcLTMMD$WMO_Region == wmoRegion), - "Archive"]) + zipFile <- as.character(grdcLTMMD[ + which(grdcLTMMD$WMO_Region == wmoRegion), + "Archive" + ]) # create a temporary directory td <- tempdir() @@ -274,9 +286,7 @@ test_tsGRDC <- function(id) { fpath <- file.path(td, fname) if (!all(file.exists(fpath))) { - stop("Data are not available at this station") - } # Initialise empty list of tables @@ -284,12 +294,13 @@ test_tsGRDC <- function(id) { # Populate tables for (j in seq_along(fpath)) { - TS <- readLines(fpath[j]) # find dataset content row_data <- grep(pattern = "# Data Set Content:", x = TS) - data_names <- trimws(x = unlist(strsplit(TS[row_data], ":")), - which = "both") + data_names <- trimws( + x = unlist(strsplit(TS[row_data], ":")), + which = "both" + ) data_names <- data_names[seq(2, length(data_names), 2)] data_names <- gsub(pattern = " ", replacement = "", x = data_names) data_names <- gsub(pattern = ")", replacement = "", x = data_names) @@ -298,15 +309,18 @@ test_tsGRDC <- function(id) { ## find data lines row_data_lines <- grep(pattern = "# Data lines:", x = TS)[1] - chr_positions <- gregexpr(pattern = "[0-9]", - text = TS[row_data_lines])[[1]] + chr_positions <- gregexpr( + pattern = "[0-9]", + text = TS[row_data_lines] + )[[1]] lchr_positions <- length(chr_positions) - rows_to_read <- as.numeric(substr(x = TS[row_data_lines], - start = chr_positions[1], - stop = chr_positions[lchr_positions])) + rows_to_read <- as.numeric(substr( + x = TS[row_data_lines], + start = chr_positions[1], + stop = chr_positions[lchr_positions] + )) if (rows_to_read > 0) { - # find tables row_data <- grep(pattern = "DATA", x = TS, ignore.case = FALSE) row_start <- row_data + 2 @@ -317,10 +331,14 @@ test_tsGRDC <- function(id) { for (k in seq_along(data_names)) { tempcolnames <- unlist(strsplit(TS[row_data[k] + 1], ";")) tempcolnames <- trimws(tempcolnames, which = "both") - tempcolnames <- gsub(pattern = "-", replacement = "_", - x = tempcolnames) - column_names <- c(column_names, paste0(data_names[k], "__", - tempcolnames)) + tempcolnames <- gsub( + pattern = "-", replacement = "_", + x = tempcolnames + ) + column_names <- c(column_names, paste0( + data_names[k], "__", + tempcolnames + )) } for (w in seq_along(row_start)) { @@ -330,8 +348,10 @@ test_tsGRDC <- function(id) { if (w == 1) { tmp <- matrix(no_spaces, nrow = rows_to_read, byrow = TRUE) } else { - tmp <- cbind(tmp, matrix(no_spaces, nrow = rows_to_read, - byrow = TRUE)) + tmp <- cbind(tmp, matrix(no_spaces, + nrow = rows_to_read, + byrow = TRUE + )) } } @@ -339,15 +359,13 @@ test_tsGRDC <- function(id) { names(df) <- column_names ltables[[j]] <- df - }else{ + } else { message(paste(tablenames[j], "data are not available at this station")) ltables[[j]] <- NULL } - } names(ltables) <- tablenames return(ltables) - } diff --git a/man/KGClimateClass.Rd b/man/KGClimateClass.Rd index d5b9996..94f7785 100644 --- a/man/KGClimateClass.Rd +++ b/man/KGClimateClass.Rd @@ -21,10 +21,10 @@ Given a bounding box, the function identifies the overlapping climate zones. } \examples{ \dontrun{ - # Define a bounding box - areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52) - # Get climate classes - KGClimateClass(areaBox = areaBox) +# Define a bounding box +areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52) +# Get climate classes +KGClimateClass(areaBox = areaBox) } } diff --git a/man/bboxSpatialPolygon.Rd b/man/bboxSpatialPolygon.Rd index b870906..599a077 100644 --- a/man/bboxSpatialPolygon.Rd +++ b/man/bboxSpatialPolygon.Rd @@ -11,7 +11,7 @@ bboxSpatialPolygon(boundingbox, proj4stringFrom = NULL, proj4stringTo = NULL) \item{boundingbox}{Bounding box: a 2x2 numerical matrix of lat/lon coordinates} -\item{proj4stringFrom}{Projection string for the current boundingbox +\item{proj4stringFrom}{Projection string for the current bounding box coordinates (defaults to lat/lon, WGS84)} \item{proj4stringTo}{Projection string, or NULL to not project} diff --git a/man/catalogueData60UK.Rd b/man/catalogueData60UK.Rd index 46ac9a0..f6bbbf2 100644 --- a/man/catalogueData60UK.Rd +++ b/man/catalogueData60UK.Rd @@ -31,12 +31,12 @@ listing 61 gauging stations. } \examples{ \dontrun{ - # Retrieve the whole catalogue - Data60UK_catalogue_all <- catalogueData60UK() +# Retrieve the whole catalogue +Data60UK_catalogue_all <- catalogueData60UK() - # Filter the catalogue based on a bounding box - areaBox <- terra::ext(-4, -2, +52, +53) - Data60UK_catalogue_bbox <- catalogueData60UK(areaBox) +# Filter the catalogue based on a bounding box +areaBox <- terra::ext(-4, -2, +52, +53) +Data60UK_catalogue_bbox <- catalogueData60UK(areaBox) } } diff --git a/man/catalogueGRDC.Rd b/man/catalogueGRDC.Rd index 2cd6497..93b9094 100644 --- a/man/catalogueGRDC.Rd +++ b/man/catalogueGRDC.Rd @@ -42,8 +42,8 @@ which provides river discharge data for almost 1000 sites over 157 countries. } \examples{ \dontrun{ - # Retrieve the catalogue - GRDC_catalogue_all <- catalogueGRDC() +# Retrieve the catalogue +GRDC_catalogue_all <- catalogueGRDC() } } diff --git a/man/catalogueMOPEX.Rd b/man/catalogueMOPEX.Rd index d6a812d..5c3aef5 100644 --- a/man/catalogueMOPEX.Rd +++ b/man/catalogueMOPEX.Rd @@ -24,7 +24,7 @@ This function returns a data frame containing the following columns: \item{\code{Drainage_Area}}{Square Miles} \item{\code{R_gauges}}{Required number of precipitation gages to meet MAP accuracy criteria} \item{\code{N_gauges}}{Number of gages in total gage window used to estimate MAP} - \item{\code{A_gauges}}{Avaliable number of gages in the basin} + \item{\code{A_gauges}}{Available number of gauges in the basin} \item{\code{Ratio_AR}}{Ratio of Available to Required number of gages in the basin} \item{\code{Date_start}}{Date when recordings start} \item{\code{Date_end}}{Date when recordings end} @@ -42,8 +42,8 @@ This function retrieves the list of the MOPEX basins. } \examples{ \dontrun{ - # Retrieve the MOPEX catalogue - catalogue <- catalogueMOPEX() +# Retrieve the MOPEX catalogue +catalogue <- catalogueMOPEX() } } diff --git a/man/catalogueSEPA.Rd b/man/catalogueSEPA.Rd index f352c57..e6f4a56 100644 --- a/man/catalogueSEPA.Rd +++ b/man/catalogueSEPA.Rd @@ -40,8 +40,8 @@ The function has no input arguments. } \examples{ \dontrun{ - # Retrieve the whole catalogue - SEPA_catalogue_all <- catalogueSEPA() +# Retrieve the whole catalogue +SEPA_catalogue_all <- catalogueSEPA() } } diff --git a/man/hddtools.Rd b/man/hddtools.Rd index b3b8488..67b3e9e 100644 --- a/man/hddtools.Rd +++ b/man/hddtools.Rd @@ -12,7 +12,7 @@ The package facilitate access to various online data sources such as: \item{\strong{KGClimateClass} (\url{http://koeppen-geiger.vu-wien.ac.at/}): The Koppen Climate Classification map is used for classifying the world's climates based on the annual and monthly averages of temperature and precipitation} \item{\strong{GRDC} (\url{http://www.bafg.de/GRDC/EN/Home/homepage_node.html}): The Global Runoff Data Centre (GRDC) provides datasets for all the major rivers in the world} \item{\strong{Data60UK} (\url{http://tdwg.catchment.org/datasets.html}): The Data60UK initiative collated datasets of areal precipitation and streamflow discharge across 61 gauging sites in England and Wales (UK).} - \item{\strong{MOPEX} (\url{https://www.nws.noaa.gov/ohd/mopex/mo_datasets.htm}): This dataset contains historical hydrometeorological data and river basin characteristics for hundreds of river basins in the US.} + \item{\strong{MOPEX} (\url{https://hydrology.nws.noaa.gov/pub/gcip/mopex/US_Data/Documentation/}): This dataset contains historical hydrometeorological data and river basin characteristics for hundreds of river basins in the US.} \item{\strong{SEPA} (\url{https://www2.sepa.org.uk/WaterLevels/}): The Scottish Environment Protection Agency (SEPA) provides river level data for hundreds of gauging stations in the UK.}} This package complements R's growing functionality in environmental web technologies by bridging the gap between data providers and data consumers. It is designed to be an initial building block of scientific workflows for linking data and models in a seamless fashion. } diff --git a/man/tsData60UK.Rd b/man/tsData60UK.Rd index 5ec573c..919d735 100644 --- a/man/tsData60UK.Rd +++ b/man/tsData60UK.Rd @@ -17,7 +17,7 @@ This function extract the dataset containing daily rainfall and streamflow disch } \examples{ \dontrun{ - Morwick <- tsData60UK(id = "22001") +Morwick <- tsData60UK(id = "22001") } } diff --git a/man/tsMOPEX.Rd b/man/tsMOPEX.Rd index 04b4fec..d39a2b6 100644 --- a/man/tsMOPEX.Rd +++ b/man/tsMOPEX.Rd @@ -32,7 +32,7 @@ streamflow discharge at one of the MOPEX locations. } \examples{ \dontrun{ - BroadRiver <- tsMOPEX(id = "01048000") +BroadRiver <- tsMOPEX(id = "01048000") } } diff --git a/man/tsSEPA.Rd b/man/tsSEPA.Rd index c6cb25e..a9b069f 100644 --- a/man/tsSEPA.Rd +++ b/man/tsSEPA.Rd @@ -10,7 +10,7 @@ tsSEPA(id) \item{id}{hydrometric reference number (string)} } \value{ -The function returns river level data in metres, as a zoo object. +The function returns river level data in meters, as a zoo object. } \description{ This function extract the dataset containing daily rainfall and @@ -18,7 +18,7 @@ streamflow discharge at one of the MOPEX locations. } \examples{ \dontrun{ - sampleTS <- tsSEPA(id = "10048") +sampleTS <- tsSEPA(id = "10048") } } diff --git a/tests/testthat.R b/tests/testthat.R index bedc199..fe2145f 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ -library('testthat') -library('hddtools') +library("testthat") +library("hddtools") -test_check('hddtools') +test_check("hddtools") diff --git a/tests/testthat/test-Data60UK.R b/tests/testthat/test-Data60UK.R index 6555f74..cccaa05 100644 --- a/tests/testthat/test-Data60UK.R +++ b/tests/testthat/test-Data60UK.R @@ -1,32 +1,26 @@ context("Data60UK") test_that("Test catalogueData60UK", { - # Retrieve the whole catalogue x1 <- try(catalogueData60UK(), silent = TRUE) expect_that(class(x1) != "try-error", equals(TRUE)) expect_that(all(dim(x1) == c(61, 6)), equals(TRUE)) - }) test_that("Test catalogueData60UK bounding box", { - # Define a bounding box areaBox <- terra::ext(c(-4, -2, +52, +53)) # Filter the catalogue based on a bounding box x2 <- catalogueData60UK(areaBox) expect_that(all(dim(x2) == c(6, 6)), equals(TRUE)) - }) test_that("Test tsData60UK function", { - # Retrieve sample data x <- tsData60UK(id = 39015) expect_that(class(x) == "zoo", equals(TRUE)) expect_that(all(names(x) == c("P", "Q")), equals(TRUE)) - }) diff --git a/tests/testthat/test-GRDC.R b/tests/testthat/test-GRDC.R index 62c46aa..0512c8a 100644 --- a/tests/testthat/test-GRDC.R +++ b/tests/testthat/test-GRDC.R @@ -1,11 +1,9 @@ context("GRDC") test_that("Test catalogueGRDC", { - # Retrieve the whole catalogue x1 <- catalogueGRDC() expect_true("data.frame" %in% class(x1)) expect_true(all(dim(x1) >= c(9922, 24))) expect_true(x1$river[x1$grdc_no == "1159900"] == "KLIPRIVIER") - }) diff --git a/tests/testthat/test-KGClimateClass.R b/tests/testthat/test-KGClimateClass.R index c08a82c..7a471a7 100644 --- a/tests/testthat/test-KGClimateClass.R +++ b/tests/testthat/test-KGClimateClass.R @@ -1,12 +1,10 @@ context("KGClimateClass") test_that("Test KGClimateClass function", { - # Define a bounding box areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52) # Get climate classes x <- try(KGClimateClass(areaBox = areaBox), silent = TRUE) expect_that(all(dim(x) == c(1, 3)), equals(TRUE)) - }) diff --git a/tests/testthat/test-MOPEX.R b/tests/testthat/test-MOPEX.R index 327965d..07debfe 100644 --- a/tests/testthat/test-MOPEX.R +++ b/tests/testthat/test-MOPEX.R @@ -1,7 +1,6 @@ context("MOPEX") test_that("Test catalogueMOPEX - MAP = FALSE", { - testthat::skip_on_cran() testthat::skip_on_ci() @@ -11,11 +10,9 @@ test_that("Test catalogueMOPEX - MAP = FALSE", { expect_true("data.frame" %in% class(x1)) expect_true(all(dim(x1) == c(1861, 12))) expect_true(is.na(x1$State[x1$USGS_ID == "08167000"])) - }) test_that("Test catalogueMOPEX - MAP = TRUE", { - testthat::skip_on_cran() testthat::skip_on_ci() @@ -26,11 +23,9 @@ test_that("Test catalogueMOPEX - MAP = TRUE", { expect_true("data.frame" %in% class(x2)) expect_true(all(dim(x2) == c(438, 12))) expect_true(x2$State[x2$USGS_ID == "01048000"] == "ME") - }) test_that("Test tsMOPEX - MAP = FALSE", { - testthat::skip_on_cran() testthat::skip_on_ci() # Retrieve data @@ -39,11 +34,9 @@ test_that("Test tsMOPEX - MAP = FALSE", { expect_true("zoo" %in% class(x3)) expect_true(all(names(x3) == "Q")) expect_true(as.numeric(x3$Q[1]) == 13.45) - }) test_that("Test tsMOPEX - MAP = TRUE", { - testthat::skip_on_cran() testthat::skip_on_ci() # Retrieve data @@ -52,5 +45,4 @@ test_that("Test tsMOPEX - MAP = TRUE", { expect_true("zoo" %in% class(x4)) expect_true(all(names(x4) == c("P", "E", "Q", "T_max", "T_min"))) expect_true(as.numeric(x4$T_min[1]) == -10.8444) - }) diff --git a/tests/testthat/test-SEPA.R b/tests/testthat/test-SEPA.R index f2aa5c6..f6fd598 100644 --- a/tests/testthat/test-SEPA.R +++ b/tests/testthat/test-SEPA.R @@ -1,28 +1,22 @@ context("SEPA") test_that("Test catalogueSEPA", { - # Retrieve the SEPA catalogue x1 <- catalogueSEPA() - + # If the service/website is up and running, x1 should be not NULL - if (!is.null(x1)){ + if (!is.null(x1)) { expect_that("data.frame" %in% class(x1), equals(TRUE)) expect_that(all(dim(x1) >= c(366, 20)), equals(TRUE)) } - }) test_that("Test tsSEPA function", { - # Retrieve sample data x2 <- tsSEPA(id = "234253") - + # If the service/website is up and running, x2 should be not NULL - if (!is.null(x2)){ - + if (!is.null(x2)) { expect_true("zoo" %in% class(x2)) - } - }) diff --git a/tests/testthat/test-bboxSpatialPolygon.R b/tests/testthat/test-bboxSpatialPolygon.R index 823cb7b..2829897 100644 --- a/tests/testthat/test-bboxSpatialPolygon.R +++ b/tests/testthat/test-bboxSpatialPolygon.R @@ -1,10 +1,8 @@ context("bboxSpatialPolygon") test_that("Test bboxSpatialPolygon function", { - boundingbox <- terra::ext(c(-180, +180, -50, +50)) bbSP <- bboxSpatialPolygon(boundingbox = boundingbox) expect_that("SpatVector" %in% class(bbSP), equals(TRUE)) - }) diff --git a/vignettes/hddtools_vignette.Rmd b/vignettes/hddtools_vignette.Rmd index 53e27bc..6338b13 100644 --- a/vignettes/hddtools_vignette.Rmd +++ b/vignettes/hddtools_vignette.Rmd @@ -77,7 +77,7 @@ KGClimateClass(areaBox = areaBox, updatedBy = "Kottek") ### The Global Runoff Data Centre The Global Runoff Data Centre (GRDC) is an international archive hosted by the Federal Institute of Hydrology in Koblenz, Germany. The Centre operates under the auspices of the World Meteorological Organisation and retains services and datasets for all the major rivers in the world. Catalogue, kml files and the product Long-Term Mean Monthly Discharges are open data and accessible via the hddtools. -Information on all the GRDC stations can be retrieved using the function `catalogueGRDC` with no input arguments, as in the examle below: +Information on all the GRDC stations can be retrieved using the function `catalogueGRDC` with no input arguments, as in the example below: ```{r catalogueGRDC1, eval = FALSE} # GRDC full catalogue GRDC_catalogue <- catalogueGRDC() @@ -100,15 +100,19 @@ GRDC_catalogue %>% # Filter the catalogue based on a geographical bounding box GRDC_catalogue %>% - filter(between(x = long, left = -10, right = 5), - between(x = lat, left = 48, right = 62)) + filter( + between(x = long, left = -10, right = 5), + between(x = lat, left = 48, right = 62) + ) # Combine filtering criteria GRDC_catalogue %>% - filter(between(x = long, left = -10, right = 5), - between(x = lat, left = 48, right = 62), - d_start >= 2000, - area > 1000) + filter( + between(x = long, left = -10, right = 5), + between(x = lat, left = 48, right = 62), + d_start >= 2000, + area > 1000 + ) ``` The GRDC catalogue (or a subset) can be used to create a map. @@ -116,7 +120,7 @@ The GRDC catalogue (or a subset) can be used to create a map. # Visualise outlets on an interactive map library(leaflet) leaflet(data = GRDC_catalogue %>% dplyr::filter(river == "PO, FIUME")) %>% - addTiles() %>% # Add default OpenStreetMap map tiles + addTiles() %>% # Add default OpenStreetMap map tiles addMarkers(~long, ~lat, popup = ~station) ``` ![](leaflet.png) @@ -127,7 +131,7 @@ The Top-Down modelling Working Group (TDWG) for the Prediction in Ungauged Basin #### The Data60UK dataset The Data60UK initiative collated datasets of areal precipitation and streamflow discharge across 61 gauging sites in England and Wales (UK). The database was prepared from source databases for research purposes, with the intention to make it re-usable. This is now available in the public domain free of charge. -The hddtools contain two functions to interact with this database: one to retreive the catalogue and another to retreive time series of areal precipitation and streamflow discharge. +The hddtools contain two functions to interact with this database: one to retrieve the catalogue and another to retrieve time series of areal precipitation and streamflow discharge. ```{r catalogueData60UK1, eval = TRUE} # Data60UK full catalogue @@ -142,14 +146,14 @@ Data60UK_catalogue_bbox <- catalogueData60UK(areaBox = areaBox) # Visualise outlets on an interactive map library(leaflet) leaflet(data = Data60UK_catalogue_bbox) %>% - addTiles() %>% # Add default OpenStreetMap map tiles + addTiles() %>% # Add default OpenStreetMap map tiles addMarkers(~Longitude, ~Latitude, popup = ~Location) ``` ![](leaflet2.png) ```{r catalogueData60UK3, eval = TRUE, message = FALSE, fig.width = 7, fig.height = 7} -# Extract time series +# Extract time series id <- catalogueData60UK()$id[1] # Extract only the time series @@ -164,15 +168,19 @@ MOPEX_catalogue <- catalogueMOPEX() # Extract data within a geographic bounding box MOPEX_catalogue %>% - filter(dplyr::between(x = Longitude, left = -95, right = -92), - dplyr::between(x = Latitude, left = 37, right = 41)) + filter( + dplyr::between(x = Longitude, left = -95, right = -92), + dplyr::between(x = Latitude, left = 37, right = 41) + ) ``` ```{r MOPEX_meta2, eval = FALSE, message = FALSE, fig.width = 7, fig.height = 7} # Get stations with recondings in the period 1st Jan to 31st Dec 1995 MOPEX_catalogue %>% - filter(Date_start <= as.Date("1995-01-01"), - Date_end >= as.Date("1995-12-31")) + filter( + Date_start <= as.Date("1995-01-01"), + Date_end >= as.Date("1995-12-31") + ) # Get only catchments within NC MOPEX_catalogue %>% @@ -183,21 +191,23 @@ For each station, historical hydrometeorological data can also be retrieved. ```{r MOPEX_data, eval = FALSE, message = FALSE, fig.width = 7, fig.height = 7} # Take the first record in the catalogue -river_metadata <- MOPEX_catalogue[1,] +river_metadata <- MOPEX_catalogue[1, ] # Get corresponding time series river_ts <- tsMOPEX(id = river_metadata$USGS_ID) # Extract data between 1st Jan and 31st December 1948 river_ts_shorter <- window(river_ts, - start = as.Date("1948-01-01"), - end = as.Date("1948-12-31")) + start = as.Date("1948-01-01"), + end = as.Date("1948-12-31") +) # Plot plot(river_ts_shorter, - main = river_metadata$Name, - xlab = "", - ylab = c("P [mm/day]","E [mm/day]", "Q [mm/day]", "Tmax [C]","Tmin [C]")) + main = river_metadata$Name, + xlab = "", + ylab = c("P [mm/day]", "E [mm/day]", "Q [mm/day]", "Tmax [C]", "Tmin [C]") +) ``` ![](mopex.png) @@ -214,16 +224,17 @@ SEPA_catalogue <- catalogueSEPA() The time series of the last few days is available from SEPA website and can be downloaded using the following function: ```{r SEPA2, eval = FALSE, message = FALSE, fig.width = 7} # Take the first record in the catalogue -Perth_metadata <- SEPA_catalogue[1,] +Perth_metadata <- SEPA_catalogue[1, ] # Single time series extraction Perth_ts <- tsSEPA(id = Perth_metadata$LOCATION_CODE) # Plot plot(Perth_ts, - main = Perth_metadata$STATION_NAME, - xlab = "", - ylab = "Water level [m]") + main = Perth_metadata$STATION_NAME, + xlab = "", + ylab = "Water level [m]" +) # Get only catchments with area above 4000 Km2 SEPA_catalogue %>% @@ -234,13 +245,15 @@ SEPA_catalogue %>% filter(RIVER_NAME == "Ayr") ``` -Plese note that these data are updated every 15 minutes and the code will always generate different plots. +Please note that these data are updated every 15 minutes and the code will always generate different plots. ```{r SEPA3, eval=FALSE, message = FALSE, fig.width = 7} # Multiple time series extraction y <- tsSEPA(id = c("234253", "234174", "234305")) -plot(y[[1]], ylim = c(0, max(y[[1]], y[[2]], y[[3]])), - xlab = "", ylab = "Water level [m]") +plot(y[[1]], + ylim = c(0, max(y[[1]], y[[2]], y[[3]])), + xlab = "", ylab = "Water level [m]" +) lines(y[[2]], col = "red") lines(y[[3]], col = "blue") ```