From 26bcfaf1216ecb2c8063147365215d453ee42533 Mon Sep 17 00:00:00 2001 From: billbillbilly Date: Fri, 26 Jan 2024 03:06:55 -0500 Subject: [PATCH] - remove LiDAR-related functions --- DESCRIPTION | 4 +- NAMESPACE | 13 --- R/get_lidar.R | 123 ----------------------------- R/lidar_search.R | 74 ----------------- R/utils.R | 120 +++------------------------- man/get_lidar.Rd | 48 ----------- man/lidar_search.Rd | 42 ---------- tests/testthat/test-get_lidar.R | 10 --- tests/testthat/test-lidar_search.R | 11 --- 9 files changed, 11 insertions(+), 434 deletions(-) delete mode 100644 R/get_lidar.R delete mode 100644 R/lidar_search.R delete mode 100644 man/get_lidar.Rd delete mode 100644 man/lidar_search.Rd delete mode 100644 tests/testthat/test-get_lidar.R delete mode 100644 tests/testthat/test-lidar_search.R diff --git a/DESCRIPTION b/DESCRIPTION index b9082b9..6e3a741 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,10 +36,8 @@ Imports: sf, sp, terra, - lidR, ForestTools, parallel, - pbmcapply, - httr2 + pbmcapply LinkingTo: Rcpp diff --git a/NAMESPACE b/NAMESPACE index 8b3282e..5201d65 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,8 +4,6 @@ export(calculate_diversity) export(calculate_feature) export(calculate_viewmetrics) export(compute_viewshed) -export(get_lidar) -export(lidar_search) export(visualize_viewshed) import(Rcpp) import(methods) @@ -16,23 +14,12 @@ importFrom(ForestTools,mcws) importFrom(ForestTools,vwf) importFrom(Rcpp,evalCpp) importFrom(Rcpp,sourceCpp) -importFrom(dplyr,"%>%") importFrom(dplyr,count) importFrom(grDevices,rgb) importFrom(graphics,par) -importFrom(httr2,req_perform) -importFrom(httr2,req_timeout) -importFrom(httr2,request) -importFrom(httr2,resp_body_json) -importFrom(lidR,clip_rectangle) -importFrom(lidR,readLAScatalog) -importFrom(lidR,writeLAS) importFrom(methods,new) importFrom(parallel,detectCores) importFrom(rlang,.data) -importFrom(sp,CRS) -importFrom(sp,SpatialPoints) -importFrom(sp,spTransform) importFrom(stats,sd) importFrom(terra,as.polygons) importFrom(terra,crop) diff --git a/R/get_lidar.R b/R/get_lidar.R deleted file mode 100644 index 03ab93b..0000000 --- a/R/get_lidar.R +++ /dev/null @@ -1,123 +0,0 @@ -#' get_lidar -#' @description Search for and download LiDAR data based on coordinates -#' of a spatial point with a given distance. The maximum distance is 800m. -#' Different dataset could be found and the function automatically downloads -#' the latest dataset -#' To get more details of data on a larger scale, please use viewscape::lidar_search. -#' -#' @param x numeric, indicating Longtitude of the center point. -#' @param y numeric, indicating latitude of the center point. -#' @param r numeric, indicating search distance for LiDAR data. -#' The maximum distance is 1000m (3281ft). -#' If r > 1000m, it will be reset to 1000m. -#' @param epsg numeric, the EPSG code specifying the coordinate reference system. -#' @param max_return numeric, indicating the maximum of returns. -#' @param folder string, indicating a path for downloading the LiDAR data -#' @param plot logical (default is FALSE), enable or disable the plotting of -#' the processed LiDAR data. -#' -#' @return The function returns the processed LiDAR data as a lidR LAS object. -#' -#' @references Jean-Romain Roussel and David Auty (2022). -#' Airborne LiDAR Data Manipulation and Visualization for -#' Forestry Applications. R package version 4.0.1. https://cran.r-project.org/package=lidR -#' -#' @examples -#' \dontrun{ -#' #las <- get_lidar(-83.741289, 42.270146, 1000, 2253, 'path/to/folder') -#' #terra::plot(lidR::rasterize_canopy(las, 10, dsmtin())) -#' } -#' -#' @importFrom dplyr "%>%" -#' @importFrom lidR readLAScatalog -#' @importFrom lidR clip_rectangle -#' @importFrom lidR writeLAS -#' @importFrom sp SpatialPoints -#' @importFrom sp CRS -#' @importFrom sp spTransform -#' -#' @export - -get_lidar <- function(x, - y, - r, - epsg, - max_return=500, - folder, - plot = FALSE) { - if (missing(x) || missing(y)) { - stop("x or y is missing. Please indicate the coordinates of centroid") - } else if (missing(r) == TRUE) { - stop("r is missing. Please indicate distance for searching the LiDAR data") - } else if (missing(epsg)) { - stop("epsg is missing. Please set epsg code") - } - if (missing(folder)) { - message("folder is missng. Please set path for downloading the LiDAR data") - } else { - proj <- sp::CRS(paste0("+init=epsg:", epsg)) - longlat <- sp::CRS("+proj=longlat") - # check searching distance - unit <- sub(".no_defs", "", sub(".*=", "", proj@projargs)) - if (r > 1000 && unit == "m ") { - r <- 1000 - } else if (r > 3281 && unit == "us-ft " ) { - r <- 3281 - } - # create bbox - coor <- data.frame(lon=x, lat=y) - pt <- sp::SpatialPoints(coor, proj4string=longlat) - pt <- sp::spTransform(pt, proj) - xmin <- pt@coords[1,1] - r - xmax <- pt@coords[1,1] + r - ymin <- pt@coords[1,2] - r - ymax <- pt@coords[1,2] + r - coor_ <- data.frame(lon=c(xmin, xmax), lat=c(ymin, ymax)) - pt_ <- sp::SpatialPoints(coor_, proj) - pt_ <- sp::spTransform(pt_, CRSobj=longlat) - bbox <- c(pt_@coords[1,1], pt_@coords[1,2], pt_@coords[2,1], pt_@coords[2,2]) - # get response using API - result <- return_response(bbox, max_return) - # filter overlapping files - lastYear <- max(result$startYear) - result <- result[which(result$startYear == lastYear),] - num <- length(result[,1]) - cat(paste0("Downloading ", num," file(s)...\n")) - title <- result$titles - download <- result$downloadLazURL - # download data - original_timeout <- getOption('timeout') - options(timeout=9999) - files <- c() - if (isTRUE(Sys.info()[1]=="Windows") == FALSE){ - m <- "curl" - }else if (isTRUE(Sys.info()[1]=="Windows") == TRUE){ - m <- "wininet" - } - for (i in 1:num) { - destination <- paste0(folder, "/", title[i], ".laz") - files <- c(files, destination) - try(download.file(download[i], - destination, - method = m, - quiet = TRUE)) - } - options(timeout=original_timeout) - # clip and merge - lasc <- lidR::readLAScatalog(files, progress = FALSE) - las <- lidR::clip_rectangle(lasc, - xleft = xmin, - xright = xmax, - ybottom = ymin, - ytop = ymax) - # save - lidR::writeLAS(las, paste0(folder, "/", Sys.time(), ".laz")) - rm(lasc) - # delete other laz data - unlink(files) - if (plot) { - plot(las) - } - return(las) - } -} diff --git a/R/lidar_search.R b/R/lidar_search.R deleted file mode 100644 index 19a4fca..0000000 --- a/R/lidar_search.R +++ /dev/null @@ -1,74 +0,0 @@ -#' lidar_search -#' @description The lidar_search function is designed to facilitate the retrieval -#' and exploration of LiDAR (Light Detection and Ranging) data within a specified -#' bounding box (bbox). This function enables users to search for LiDAR data, -#' preview available graphics, and optionally download LiDAR data files for -#' further analysis. -#' @param bbox vector, a bounding box defining the geographical area -#' for the LiDAR data search. -#' @param max_return numeric, indicating the maximum of returns. -#' @param preview logical. If TRUE (default is FALSE), enable or disable -#' previewing LiDAR graphics. -#' @param folder string (optional), indicating an optional folder path -#' where downloaded LiDAR data files will be saved. -#' -#' @return dataframe -#' -#' @note The lidar_search function simplifies the process of searching for -#' and working with LiDAR data via the TNMAccess API: https://tnmaccess.nationalmap.gov/api/v1/docs. -#' -#' @importFrom httr2 request -#' @importFrom httr2 req_timeout -#' @importFrom httr2 req_perform -#' @importFrom httr2 resp_body_json -#' -#' @examples -#' \dontrun{ -#' #bbox <- c(-83.742282,42.273389,-83.733442,42.278724) -#' #search_result <- viewscape::lidar_search(bbox = bbox, -#' # max_return = 25, -#' # preview = TRUE) -#'} -#' @export - - -lidar_search <- function(bbox, - max_return=500, - preview = FALSE, - folder = "") { - if (missing(bbox)) { - stop("Please define a bbox") - } - result <- return_response(bbox, max_return) - num <- length(result[,1]) - if (preview == TRUE) { - if (!requireNamespace("imager", quietly = TRUE)) { - install.packages("imager") - } - url <- result$previewGraphicURL - if (num == 1) { - imager::load.image(url) %>% plot() - } else { - if (num == 2) { - par(mfrow=c(1,2)) - } else if (num >= 3) { - par(mfrow=c(ceiling(num/3),3)) - } - for (i in 1:num) { - imager::load.image(url[i]) %>% plot() - } - } - } - if (isTRUE(folder != "")) { - title <- result$titles - download <- result$downloadLazURL - original_timeout <- getOption('timeout') - options(timeout=9999) - for (i in 1:num) { - destination <- paste0(folder, "/", title[i], ".laz") - try(download.file(download[i], destination)) - } - options(timeout=original_timeout) - } - return(result) -} diff --git a/R/utils.R b/R/utils.R index 5420ee6..1f11c12 100644 --- a/R/utils.R +++ b/R/utils.R @@ -36,44 +36,16 @@ radius_viewshed <- function(dsm, r, viewPt, offset, offset2 = 0) { return(output) } - -# radius_viewshed_m <- function(dsm, r, viewPts, offset, offset2 = 0) { -# output <- c() -# dsm_list <- list() -# ex <- list() -# resolution <- terra::res(dsm) -# projt <- terra::crs(dsm, proj = TRUE) -# x <- c() -# y <- c() -# z <- terra::extract(dsm, viewPts)[,1] + offset -# distance <- round(r/resolution[1]) -# for (i in 1:length(z)) { -# subarea <- get_buffer(viewPts[i,1], viewPts[i,2], r) -# subdsm <- terra::crop(dsm, terra::ext(subarea)) -# e <- as.vector(sf::st_bbox(subdsm)) -# ex[[i]] <- e -# x <- c(x, terra::colFromX(subdsm, viewPts[i,1])) -# y <- c(y, terra::rowFromY(subdsm, viewPts[i,2])) -# dsm_list[[i]] <- terra::as.matrix(subdsm, wide=TRUE) -# } -# vpts <- cbind(x, y) -# vpts <- cbind(vpts, z) -# label_matrix <- multiLabelParallel(vpts=vpts, -# dsm=dsm_list, -# max_dis=distance, -# vpth=offset, -# h=offset2) -# for(i in 1:length(z)) { -# out <- new("Viewshed", -# viewpoint = viewPts[i,], -# visible = label_matrix[[i]], -# resolution = resolution, -# extent = ex[[i]], -# crs = projt) -# output <- c(output, out) -# } -# return(output) -# } +#' @noMd +paral_nix <- function(X, dsm, r, offset, workers){ + results <- pbmcapply::pbmclapply(X = X, + FUN=radius_viewshed, + dsm=dsm, + r=r, + offset=offset, + mc.cores=workers) + return(results) +} #' @noMd # H=−∑[(pi)×ln(pi)] @@ -142,75 +114,3 @@ patch_p <- function(m, patchpoly){ samples <- sf::st_coordinates(samples)[,-3] return(list(Nump, MSI, ED, PS, PD, samples)) } - - -#' @noMd -# create a request of the TNMAccess API -return_response <- function(bbox, max_return) { - api1 <- 'https://tnmaccess.nationalmap.gov/api/v1/products?bbox=' - api2 <- paste0(bbox[1], ",", - bbox[2], ",", - bbox[3], ",", - bbox[4]) - api3 <- paste0('&datasets=Lidar%20Point%20Cloud%20(LPC)&max=', - max_return, - '&prodFormats=LAS,LAZ') - json <- httr2::request(paste0(api1, api2, api3)) %>% - httr2::req_timeout(10000) %>% - httr2::req_perform() %>% - httr2::resp_body_json() - items <- length(json$items) - cat(paste0("Get ", items, " returns", "\n")) - cat(paste0("Find available items: ", json$total, "\n")) - if (json$total > items) { - cat("There are more available items\n") - cat("You can set a greater return number to return\n") - } - titles <- c() - sourceId <- c() - metaUrl <- c() - sizeInBytes <- c() - startYear <- c() - previewGraphicURL <- c() - downloadLazURL <- c() - if (items >= 1) { - for (i in 1:items) { - item <- json[[2]][[i]] - titles <- c(titles, item$title) - sourceId <- c(sourceId, item$sourceId) - url <- paste0(item$metaUrl, "?format=json") - metaUrl <- c(metaUrl, url) - sizeInBytes <- c(sizeInBytes, item$sizeInBytes) - startYear <- c(startYear, find_year(url)) - previewGraphicURL <- c(previewGraphicURL, item$previewGraphicURL) - downloadLazURL <- c(downloadLazURL, item$downloadLazURL) - } - df <- data.frame(titles, sourceId, - metaUrl, sizeInBytes, - startYear, previewGraphicURL, - downloadLazURL) - return(df) - } -} - -#' @noMd -# find year -find_year <- function(url) { - j <- httr2::request(url) %>% - httr2::req_timeout(10000) %>% - httr2::req_perform() %>% - httr2::resp_body_json() - date <- j$dates[[2]]$dateString %>% strsplit("-") %>% unlist() - return(as.integer(date[1])) -} - -#' @noMd -paral_nix <- function(X, dsm, r, offset, workers){ - results <- pbmcapply::pbmclapply(X = X, - FUN=radius_viewshed, - dsm=dsm, - r=r, - offset=offset, - mc.cores=workers) - return(results) -} diff --git a/man/get_lidar.Rd b/man/get_lidar.Rd deleted file mode 100644 index e4a22d2..0000000 --- a/man/get_lidar.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_lidar.R -\name{get_lidar} -\alias{get_lidar} -\title{get_lidar} -\usage{ -get_lidar(x, y, r, epsg, max_return = 500, folder, plot = FALSE) -} -\arguments{ -\item{x}{numeric, indicating Longtitude of the center point.} - -\item{y}{numeric, indicating latitude of the center point.} - -\item{r}{numeric, indicating search distance for LiDAR data. -The maximum distance is 1000m (3281ft). -If r > 1000m, it will be reset to 1000m.} - -\item{epsg}{numeric, the EPSG code specifying the coordinate reference system.} - -\item{max_return}{numeric, indicating the maximum of returns.} - -\item{folder}{string, indicating a path for downloading the LiDAR data} - -\item{plot}{logical (default is FALSE), enable or disable the plotting of -the processed LiDAR data.} -} -\value{ -The function returns the processed LiDAR data as a lidR LAS object. -} -\description{ -Search for and download LiDAR data based on coordinates -of a spatial point with a given distance. The maximum distance is 800m. -Different dataset could be found and the function automatically downloads -the latest dataset -To get more details of data on a larger scale, please use viewscape::lidar_search. -} -\examples{ -\dontrun{ -#las <- get_lidar(-83.741289, 42.270146, 1000, 2253, 'path/to/folder') -#terra::plot(lidR::rasterize_canopy(las, 10, dsmtin())) -} - -} -\references{ -Jean-Romain Roussel and David Auty (2022). -Airborne LiDAR Data Manipulation and Visualization for -Forestry Applications. R package version 4.0.1. https://cran.r-project.org/package=lidR -} diff --git a/man/lidar_search.Rd b/man/lidar_search.Rd deleted file mode 100644 index cd22bd7..0000000 --- a/man/lidar_search.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lidar_search.R -\name{lidar_search} -\alias{lidar_search} -\title{lidar_search} -\usage{ -lidar_search(bbox, max_return = 500, preview = FALSE, folder = "") -} -\arguments{ -\item{bbox}{vector, a bounding box defining the geographical area -for the LiDAR data search.} - -\item{max_return}{numeric, indicating the maximum of returns.} - -\item{preview}{logical. If TRUE (default is FALSE), enable or disable -previewing LiDAR graphics.} - -\item{folder}{string (optional), indicating an optional folder path -where downloaded LiDAR data files will be saved.} -} -\value{ -dataframe -} -\description{ -The lidar_search function is designed to facilitate the retrieval -and exploration of LiDAR (Light Detection and Ranging) data within a specified -bounding box (bbox). This function enables users to search for LiDAR data, -preview available graphics, and optionally download LiDAR data files for -further analysis. -} -\note{ -The lidar_search function simplifies the process of searching for -and working with LiDAR data via the TNMAccess API: https://tnmaccess.nationalmap.gov/api/v1/docs. -} -\examples{ -\dontrun{ -#bbox <- c(-83.742282,42.273389,-83.733442,42.278724) -#search_result <- viewscape::lidar_search(bbox = bbox, -# max_return = 25, -# preview = TRUE) -} -} diff --git a/tests/testthat/test-get_lidar.R b/tests/testthat/test-get_lidar.R deleted file mode 100644 index 6e66907..0000000 --- a/tests/testthat/test-get_lidar.R +++ /dev/null @@ -1,10 +0,0 @@ -testthat::test_that("runs correctly", { - - las <- viewscape::get_lidar(x = -83.741289, - y = 42.270146, - r = 1000, - epsg = 2253, - plot = FALSE) - - testthat::expect_type(las, "NULL") -}) diff --git a/tests/testthat/test-lidar_search.R b/tests/testthat/test-lidar_search.R deleted file mode 100644 index c7a39a0..0000000 --- a/tests/testthat/test-lidar_search.R +++ /dev/null @@ -1,11 +0,0 @@ -testthat::test_that("runs correctly", { - - # search for lidar data information using bbox - search_result <- viewscape::lidar_search(bbox = c(-83.742282, - 42.273389, - -83.733442, - 42.278724), - preview = FALSE) - - testthat::expect_type(search_result, "list") -})