Merge pull request #33 from ropensci/dev-terra

Remove dependency from raster package and switch to terra
ropensci · Jul 18, 2022 · 31dfa37 · 31dfa37
2 parents 1842efb + a8f4cf4
commit 31dfa37
Show file tree

Hide file tree

Showing 17 changed files with 136 additions and 128 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: hddtools
 Title: Hydrological Data Discovery Tools
-Version: 0.9.4
+Version: 0.9.5
 Authors@R: c(person(given = "Claudia", family = "Vitolo",
                     role = c("aut"), email = "[email protected]",
                     comment = c(ORCID = "0000-0002-4252-1176")),
@@ -15,8 +15,8 @@ Maintainer: Dorothea Hug Peter <[email protected]>
 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" <doi:10.21105/joss.00056>.
-Depends: R (>= 3.5.0), rgdal
-Imports: zoo, sp, curl, XML, raster, readxl, tidyr
+Depends: R (>= 3.5.0)
+Imports: zoo, curl, XML, terra, readxl, tidyr, sf
 Suggests: testthat, leaflet, rmarkdown, knitr, dplyr
 VignetteBuilder: knitr
 License: GPL-3

diff --git a/NAMESPACE b/NAMESPACE
@@ -9,17 +9,9 @@ export(catalogueSEPA)
 export(tsData60UK)
 export(tsMOPEX)
 export(tsSEPA)
-import(rgdal)
 importFrom(XML,readHTMLTable)
 importFrom(curl,curl_download)
-importFrom(raster,extent)
-importFrom(raster,extract)
-importFrom(raster,raster)
 importFrom(readxl,read_xlsx)
-importFrom(sp,CRS)
-importFrom(sp,Polygon)
-importFrom(sp,Polygons)
-importFrom(sp,SpatialPolygons)
 importFrom(tidyr,pivot_longer)
 importFrom(utils,download.file)
 importFrom(utils,read.csv)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+# hddtools 0.9.5
+
+*Removed dependency fom rgdal and raster packages
+
 # hddtools 0.9.4
 
 * Removed dependency from the rnrfa package

diff --git a/R/Data60UK.R b/R/Data60UK.R
@@ -7,7 +7,7 @@
 #'
 #' @param areaBox bounding box, a list made of 4 elements: minimum longitude
 #' (lonMin), minimum latitude (latMin), maximum longitude (lonMax), maximum
-#' latitude (latMax)
+#' latitude (latMax) or an object of type "SpatExtent"
 #'
 #' @return This function returns a data frame containing the following columns:
 #' \describe{
@@ -18,7 +18,7 @@
 #'   \item{\code{Latitude}}{}
 #'   \item{\code{Longitude}}{}
 #' }
-#' 
+#'
 #' @source \url{http://nrfaapps.ceh.ac.uk/datauk60/data.html}
 #'
 #' @export
@@ -29,7 +29,7 @@
 #'   Data60UK_catalogue_all <- catalogueData60UK()
 #'
 #'   # Filter the catalogue based on a bounding box
-#'   areaBox <- raster::extent(-4, -2, +52, +53)
+#'   areaBox <- terra::ext(-4, -2, +52, +53)
 #'   Data60UK_catalogue_bbox <- catalogueData60UK(areaBox)
 #' }
 #'
@@ -43,23 +43,23 @@ catalogueData60UK <- function(areaBox = NULL){
   Data60UKcatalogue <- tables[[which.max(n.rows)]]
   names(Data60UKcatalogue) <- c("id", "River", "Location")
   Data60UKcatalogue[] <- lapply(Data60UKcatalogue, as.character)
-  
+
   # Find grid reference browsing the NRFA catalogue
   # This was temp <- rnrfa::catalogue() but the catalogue has been saved as
   # external data here so that the dependency from rnrfa could be removed.
   temp <- readRDS(system.file("extdata", "rnrfa_cat.rds", package = "hddtools"))
   temp <- temp[which(temp$id %in% Data60UKcatalogue$id), ]
-  
+
   Data60UKcatalogue$gridReference <- temp$`grid-reference`$ngr
   Data60UKcatalogue$Latitude <- temp$latitude
   Data60UKcatalogue$Longitude <- temp$longitude
 
   # Latitude is the Y axis, longitude is the X axis.
   if (!is.null(areaBox)){
-    lonMin <- areaBox@xmin
-    lonMax <- areaBox@xmax
-    latMin <- areaBox@ymin
-    latMax <- areaBox@ymax
+    lonMin <- areaBox$xmin
+    lonMax <- areaBox$xmax
+    latMin <- areaBox$ymin
+    latMax <- areaBox$ymax
   }else{
     lonMin <- -180
     lonMax <- +180
@@ -103,16 +103,16 @@ tsData60UK <- function(id){
 
   temp <- utils::read.table(file_url)
   names(temp) <- c("P", "Q", "DayNumber", "Year", "nStations")
-  
+
   # Combine the first four columns into a character vector
   date_info <- with(temp, paste(Year, DayNumber))
   # Parse that character vector
   datetime <- strptime(date_info, "%Y %j")
   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)
-  
+
   return(myTS)
 
 }
diff --git a/R/KGClimateClass.R b/R/KGClimateClass.R
@@ -17,7 +17,7 @@
 #' @examples
 #' \dontrun{
 #'   # Define a bounding box
-#'   areaBox <- raster::extent(-3.82, -3.63, 52.41, 52.52)
+#'   areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52)
 #'   # Get climate classes
 #'   KGClimateClass(areaBox = areaBox)
 #' }
@@ -28,7 +28,7 @@ KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE){
   # crop to bounding box
 
   if (is.null(areaBox)){
-    areaBox <- raster::extent(c(-180, +180, -90, +90))
+    areaBox <- terra::ext(c(-180, +180, -90, +90))
   }
   bbSP <- bboxSpatialPolygon(areaBox)
 
@@ -38,7 +38,7 @@ KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE){
     kgLegend <- utils::read.table(system.file(file.path("extdata",
                                                         "KOTTEK_Legend.txt"),
                                               package = "hddtools"))
-
+    kgLegend$V1 <- as.character(kgLegend$V1)
     # message("OFFLINE results")
 
     # create a temporary directory
@@ -50,21 +50,22 @@ KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE){
     utils::untar(system.file(file.path("extdata", "KOTTEK_KG.tar.gz"),
                              package = "hddtools"), exdir = td)
 
-    kgRaster <- raster::raster(paste0(td, "/KOTTEK_koeppen-geiger.tiff",
+    kgRaster <- terra::rast(paste0(td, "/KOTTEK_koeppen-geiger.tiff",
                                       sep = ""))
 
-    temp <- data.frame(table(raster::extract(kgRaster, bbSP)))
+    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] == temp[i,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$Var1,
+    df <- data.frame(ID = temp$ID,
                      Class = temp$Class,
                      Frequency = temp$Freq)
 
@@ -77,7 +78,7 @@ KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE){
                                                         "PEEL_Legend.txt"),
                                               package = "hddtools"),
                                   header = TRUE)
-
+    kgLegend$ID <- as.character(kgLegend$ID)
     # message("OFFLINE results")
 
     # create a temporary directory
@@ -89,20 +90,21 @@ KGClimateClass <- function(areaBox = NULL, updatedBy = "Peel", verbose = FALSE){
     utils::untar(system.file(file.path("extdata", "PEEL_KG.tar.gz"),
                              package = "hddtools"), exdir = td)
 
-    kgRaster <- raster::raster(paste0(td, "/PEEL_koppen_ascii.txt", sep = ""))
+    kgRaster <- terra::rast(paste0(td, "/PEEL_koppen_ascii.txt", sep = ""))
 
-    temp <- data.frame(table(raster::extract(kgRaster, bbSP)))
+    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] == temp[i,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$Var1,
+    df <- data.frame(ID = temp$ID,
                      Class = temp$Class,
                      Frequency = temp$Freq)
 

diff --git a/R/bboxSpatialPolygon.R b/R/bboxSpatialPolygon.R
@@ -15,43 +15,63 @@
 #'
 #' @examples
 #' \dontrun{
-#'   boundingbox <- raster::extent(-180, +180, -50, +50)
-#'   bbSP <- bboxSpatialPolygon(boundingbox = boundingbox)
+#' boundingbox <- terra::ext(-180, +180, -50, +50)
+#' bbSP <- bboxSpatialPolygon(boundingbox = boundingbox)
 #' }
 #'
-
 bboxSpatialPolygon <- function(boundingbox,
                                proj4stringFrom = NULL,
                                proj4stringTo = NULL) {
+  if (!is.null(proj4stringFrom)) {
+    stopifnot(inherits(sf::st_crs(proj4stringFrom),"crs"))
+  }
 
   if (is.null(proj4stringFrom)) {
+    proj4stringFrom <- "+proj=longlat +datum=WGS84"
+  }
 
-    proj4stringFrom <- sp::CRS("+proj=longlat +datum=WGS84")
+  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
+  )}
 
-  }
 
-  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")
+
   rownames(bb) <- c("lon", "lat")
   colnames(bb) <- c("min", "max")
 
   # Create unprojected boundingbox as spatial object
   # clockwise, 5 points to close it
-  bboxMat <- rbind(c(bb["lon", "min"], bb["lat", "min"]),
-                   c(bb["lon", "min"], bb["lat", "max"]),
-                   c(bb["lon", "max"], bb["lat", "max"]),
-                   c(bb["lon", "max"], bb["lat", "min"]),
-                   c(bb["lon", "min"], bb["lat", "min"]))
+  bboxMat <- rbind(
+    c(bb["lon", "min"], bb["lat", "min"]),
+    c(bb["lon", "min"], bb["lat", "max"]),
+    c(bb["lon", "max"], bb["lat", "max"]),
+    c(bb["lon", "max"], bb["lat", "min"]),
+    c(bb["lon", "min"], bb["lat", "min"])
+  )
 
-  bboxSP <- sp::SpatialPolygons(list(sp::Polygons(list(sp::Polygon(bboxMat)),
-                                                  "bbox")),
-                                proj4string = proj4stringFrom)
+
+  bboxSP <- terra::vect(bboxMat, "polygon", crs = proj4stringFrom)
 
   if (!is.null(proj4stringTo)) {
-    bboxSP <- sp::spTransform(bboxSP, proj4stringTo)
+    stopifnot(class(sf::st_crs(proj4stringTo)) == "crs")
+    bboxSP <- terra::project(bboxSP, proj4stringTo)
   }
 
   return(bboxSP)
-
 }
diff --git a/R/hddtools-package.R b/R/hddtools-package.R
@@ -18,11 +18,8 @@
 #' Vitolo C, Buytaert W, 2014, HDDTOOLS: an R package serving Hydrological Data
 #' Discovery Tools, AGU Fall Meeting, 15-19 December 2014, San Francisco, USA.
 #'
-#' @import rgdal
 #' @importFrom curl curl_download
-#' @importFrom raster raster extract extent
 #' @importFrom readxl read_xlsx
-#' @importFrom sp CRS SpatialPolygons Polygon Polygons
 #' @importFrom tidyr pivot_longer
 #' @importFrom utils download.file read.csv read.fwf read.table untar unzip
 #' @importFrom XML readHTMLTable

diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -34,7 +34,6 @@ reference:
     Get data from various providers
   contents:
   - tsData60UK
-  - tsGRDC
   - tsMOPEX
   - tsSEPA
   - grdcLTMMD
@@ -45,16 +44,7 @@ reference:
     Utility functions, mainly used internally
   contents:
   - bboxSpatialPolygon
-  - getContent
 
-- title: Cached catalogues
-  desc: >
-    Cached version of the output of the catalogue*() functions
-  contents:
-  - Data60UKcatalogue
-  - GRDCcatalogue
-  - MOPEXcatalogue
-  - SEPAcatalogue
 
 articles:
 - title: All articles