Commit ⋅ ropensci/hddtools

#' @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 @@

  # 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 @@

    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,13 +50,14 @@

    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])
      }

@@ -64,7 +65,7 @@


    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 @@

                                                        "PEEL_Legend.txt"),
                                              package = "hddtools"),
                                  header = TRUE)

    kgLegend$ID <- as.character(kgLegend$ID)
    # message("OFFLINE results")

    # create a temporary directory

@@ -89,12 +90,13 @@

    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])
      }

@@ -102,7 +104,7 @@


    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)


@@ -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)

}

@@ -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 @@

  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 @@


  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)

}

Files		•	•	•	Coverage
R	326	159	0	167	48.77%
Project Totals (6 files)	326	159	0	167	48.77%

View CI Build Download

No yaml found.

Create your codecov.yml to customize your Codecov experience

Read the docs

Interact now

The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.

SVG

Learn more about the coverage sunburst graph

102	104
103	105		temp <- temp[which(!is.na(temp$Class)),]
104	106
105		-	df <- data.frame(ID = temp$Var1,
	107	+	df <- data.frame(ID = temp$ID,
106	108		Class = temp$Class,
107	109		Frequency = temp$Freq)
108	110

103	103
104	104		temp <- utils::read.table(file_url)
105	105		names(temp) <- c("P", "Q", "DayNumber", "Year", "nStations")
106		-
	106	+
107	107		# Combine the first four columns into a character vector
108	108		date_info <- with(temp, paste(Year, DayNumber))
109	109		# Parse that character vector
110	110		datetime <- strptime(date_info, "%Y %j")
111	111		P <- zoo::zoo(temp$P, order.by = datetime) # measured in mm
112	112		Q <- zoo::zoo(temp$Q, order.by = datetime) # measured in m3/s
113		-
	113	+
114	114		myTS <- zoo::merge.zoo(P,Q)
115		-
	115	+
116	116		return(myTS)
117	117
118	118		}

Navigation	Overlay
`t` Navigate files	`h` Toggle hits
`y` Change url to tip of branch	`m` Toggle misses
`b / v` Jump to prev/next hit line	`p` Toggle partial
`z / x` Jump to prev/next missed or partial line	`1..9` Toggle flags
`shift + o` Open current page in GitHub	`a` Toggle all on
`/ or ?` Show keyboard shortcuts dialog	`c` Toggle context lines or commits

17	17		#' @examples
18	18		#' \dontrun{
19	19		#' # Define a bounding box
20		-	#' areaBox <- raster::extent(-3.82, -3.63, 52.41, 52.52)
	20	+	#' areaBox <- terra::ext(-3.82, -3.63, 52.41, 52.52)
21	21		#' # Get climate classes
22	22		#' KGClimateClass(areaBox = areaBox)
23	23		#' }

28	28		# crop to bounding box
29	29
30	30		if (is.null(areaBox)){
31		-	areaBox <- raster::extent(c(-180, +180, -90, +90))
	31	+	areaBox <- terra::ext(c(-180, +180, -90, +90))
32	32		}
33	33		bbSP <- bboxSpatialPolygon(areaBox)
34	34

38	38		kgLegend <- utils::read.table(system.file(file.path("extdata",
39	39		"KOTTEK_Legend.txt"),
40	40		package = "hddtools"))
41		-
	41	+	kgLegend$V1 <- as.character(kgLegend$V1)
42	42		# message("OFFLINE results")
43	43
44	44		# create a temporary directory

50	50		utils::untar(system.file(file.path("extdata", "KOTTEK_KG.tar.gz"),
51	51		package = "hddtools"), exdir = td)
52	52
53		-	kgRaster <- raster::raster(paste0(td, "/KOTTEK_koeppen-geiger.tiff",
	53	+	kgRaster <- terra::rast(paste0(td, "/KOTTEK_koeppen-geiger.tiff",
54	54		sep = ""))
55	55
56		-	temp <- data.frame(table(raster::extract(kgRaster, bbSP)))
	56	+	temp <- data.frame(table(terra::extract(kgRaster, bbSP)))[,2:3]
	57	+	colnames(temp)[1] <- "ID"
57	58		temp$Class <- NA
58	59		for (i in 1:dim(temp)[1]){
59		-	class1 <- which(kgLegend[,1] == temp[i,1])
	60	+	class1 <- which(kgLegend[,1] == as.character(temp[i,1]))
60	61		if (length(class1) > 0){
61	62		temp$Class[i] <- as.character(kgLegend[class1,3])
62	63		}

77	78		"PEEL_Legend.txt"),
78	79		package = "hddtools"),
79	80		header = TRUE)
80		-
	81	+	kgLegend$ID <- as.character(kgLegend$ID)
81	82		# message("OFFLINE results")
82	83
83	84		# create a temporary directory

15	15		#'
16	16		#' @examples
17	17		#' \dontrun{
18		-	#' boundingbox <- raster::extent(-180, +180, -50, +50)
19		-	#' bbSP <- bboxSpatialPolygon(boundingbox = boundingbox)
	18	+	#' boundingbox <- terra::ext(-180, +180, -50, +50)
	19	+	#' bbSP <- bboxSpatialPolygon(boundingbox = boundingbox)
20	20		#' }
21	21		#'
22		-
23	22		bboxSpatialPolygon <- function(boundingbox,
24	23		proj4stringFrom = NULL,
25	24		proj4stringTo = NULL) {
	25	+	if (!is.null(proj4stringFrom)) {
	26	+	stopifnot(inherits(sf::st_crs(proj4stringFrom),"crs"))
	27	+	}
26	28
27	29		if (is.null(proj4stringFrom)) {
	30	+	proj4stringFrom <- "+proj=longlat +datum=WGS84"
	31	+	}
28	32
29		-	proj4stringFrom <- sp::CRS("+proj=longlat +datum=WGS84")
	33	+	if(is.matrix(boundingbox)) if(dim(boundingbox)==c(2,2)) bb <- boundingbox
	34	+
	35	+	#For compatibility with raster input bounding box objects
	36	+	if(inherits(boundingbox, "Extent")){
	37	+	bb <- matrix(as.numeric(c(
	38	+	boundingbox@xmin, boundingbox@ymin,
	39	+	boundingbox@xmax, boundingbox@ymax
	40	+	)),
	41	+	nrow = 2
	42	+	)}
30	43
31		-	}
32	44
33		-	bb <- matrix(as.numeric(c(boundingbox@xmin, boundingbox@ymin,
34		-	boundingbox@xmax, boundingbox@ymax)),
35		-	nrow = 2)
	45	+	if(inherits(boundingbox, "SpatExtent")){
	46	+	bb <- matrix(as.numeric(c(
	47	+	boundingbox$xmin, boundingbox$ymin,
	48	+	boundingbox$xmax, boundingbox$ymax
	49	+	)),
	50	+	nrow = 2
	51	+	)}
	52	+
	53	+	if(!exists("bb")) stop("No valid bounding box provided")
	54	+
36	55		rownames(bb) <- c("lon", "lat")
37	56		colnames(bb) <- c("min", "max")
38	57
39	58		# Create unprojected boundingbox as spatial object
40	59		# clockwise, 5 points to close it
41		-	bboxMat <- rbind(c(bb["lon", "min"], bb["lat", "min"]),
42		-	c(bb["lon", "min"], bb["lat", "max"]),
43		-	c(bb["lon", "max"], bb["lat", "max"]),
44		-	c(bb["lon", "max"], bb["lat", "min"]),
45		-	c(bb["lon", "min"], bb["lat", "min"]))
	60	+	bboxMat <- rbind(
	61	+	c(bb["lon", "min"], bb["lat", "min"]),
	62	+	c(bb["lon", "min"], bb["lat", "max"]),
	63	+	c(bb["lon", "max"], bb["lat", "max"]),
	64	+	c(bb["lon", "max"], bb["lat", "min"]),
	65	+	c(bb["lon", "min"], bb["lat", "min"])
	66	+	)
46	67
47		-	bboxSP <- sp::SpatialPolygons(list(sp::Polygons(list(sp::Polygon(bboxMat)),
48		-	"bbox")),
49		-	proj4string = proj4stringFrom)
	68	+
	69	+	bboxSP <- terra::vect(bboxMat, "polygon", crs = proj4stringFrom)
50	70
51	71		if (!is.null(proj4stringTo)) {
52		-	bboxSP <- sp::spTransform(bboxSP, proj4stringTo)
	72	+	stopifnot(class(sf::st_crs(proj4stringTo)) == "crs")
	73	+	bboxSP <- terra::project(bboxSP, proj4stringTo)
53	74		}
54	75
55	76		return(bboxSP)
56		-
57	77		}

7	7		#'
8	8		#' @param areaBox bounding box, a list made of 4 elements: minimum longitude
9	9		#' (lonMin), minimum latitude (latMin), maximum longitude (lonMax), maximum
10		-	#' latitude (latMax)
	10	+	#' latitude (latMax) or an object of type "SpatExtent"
11	11		#'
12	12		#' @return This function returns a data frame containing the following columns:
13	13		#' \describe{

18	18		#' \item{\code{Latitude}}{}
19	19		#' \item{\code{Longitude}}{}
20	20		#' }
21		-	#'
	21	+	#'
22	22		#' @source \url{http://nrfaapps.ceh.ac.uk/datauk60/data.html}
23	23		#'
24	24		#' @export

29	29		#' Data60UK_catalogue_all <- catalogueData60UK()
30	30		#'
31	31		#' # Filter the catalogue based on a bounding box
32		-	#' areaBox <- raster::extent(-4, -2, +52, +53)
	32	+	#' areaBox <- terra::ext(-4, -2, +52, +53)
33	33		#' Data60UK_catalogue_bbox <- catalogueData60UK(areaBox)
34	34		#' }
35	35		#'

43	43		Data60UKcatalogue <- tables[[which.max(n.rows)]]
44	44		names(Data60UKcatalogue) <- c("id", "River", "Location")
45	45		Data60UKcatalogue[] <- lapply(Data60UKcatalogue, as.character)
46		-
	46	+
47	47		# Find grid reference browsing the NRFA catalogue
48	48		# This was temp <- rnrfa::catalogue() but the catalogue has been saved as
49	49		# external data here so that the dependency from rnrfa could be removed.
50	50		temp <- readRDS(system.file("extdata", "rnrfa_cat.rds", package = "hddtools"))
51	51		temp <- temp[which(temp$id %in% Data60UKcatalogue$id), ]
52		-
	52	+
53	53		Data60UKcatalogue$gridReference <- temp$`grid-reference`$ngr
54	54		Data60UKcatalogue$Latitude <- temp$latitude
55	55		Data60UKcatalogue$Longitude <- temp$longitude
56	56
57	57		# Latitude is the Y axis, longitude is the X axis.
58	58		if (!is.null(areaBox)){
59		-	lonMin <- areaBox@xmin
60		-	lonMax <- areaBox@xmax
61		-	latMin <- areaBox@ymin
62		-	latMax <- areaBox@ymax
	59	+	lonMin <- areaBox$xmin
	60	+	lonMax <- areaBox$xmax
	61	+	latMin <- areaBox$ymin
	62	+	latMax <- areaBox$ymax
63	63		}else{
64	64		lonMin <- -180
65	65		lonMax <- +180

Updating our web app

No yaml found.