|
| 1 | +#' Get ALS tiles by intersection |
| 2 | +#' |
| 3 | +#' Non-interactive version of `select_tiles2download()`. Takes an input of point locations and finds intersecting ALS tiles. |
| 4 | +#' Currently supports open LiDAR archives from three German states: Northrhine-Westfalia (NRW), Thuringia (TH), and Saxony (SN). |
| 5 | +#' |
| 6 | +#' @param region Region to select tiles from. Options are 'NRW', 'TH', 'SN', or 'all' (default). |
| 7 | +#' @param gedi_obs Point locations of GEDI observations. Should be a `sf` or `sfc` object. |
| 8 | +#' @param quiet If TRUE, hide message with ALS tile names. Default is FALSE. |
| 9 | +#' |
| 10 | +#' @return sf object with download links for tiles of ALS point clouds, |
| 11 | +#' digital elevation models, and digital surface models. Used as input to download_tiles(). |
| 12 | +#' @export |
| 13 | +#' @seealso [GEDIcalibratoR::select_tiles2download()] |
| 14 | +#' @examples print("hi") |
| 15 | +intersect_tiles2download = function(region = "all", gedi_obs = NULL, quiet = F){ |
| 16 | + if (! any(inherits(gedi_obs, c("sf", "sfc")))) |
| 17 | + stop("Please provide GEDI observations as georeferenced point dataset (sf/sfc object).", call. = F) |
| 18 | + if (missing(region)) region = "all" |
| 19 | + if (! region %in% c("TH","NRW","SN", "all")) |
| 20 | + stop(call. = F,paste(region,"is not a valid region. Please select one of TH, NRW, SN or all.")) |
| 21 | + if (! region == "all") als = dplyr::filter(als, state == region) |
| 22 | + if (! sf::st_crs(gedi_obs) == sf::st_crs(als)) gedi_obs = sf::st_transform(gedi_obs, sf::st_crs(als)) |
| 23 | + |
| 24 | + #tiles = sf::st_intersection(als, gedi_obs) |> unique() |
| 25 | + tiles = als[gedi_obs,] |> unique() |
| 26 | + if (!quiet){ |
| 27 | + message(paste(nrow(gedi_obs), "GEDI observations intersect the following", nrow(tiles),"tiles:")) |
| 28 | + message(crayon::yellow(paste(tiles$tile_laz, collapse = "\n"))) |
| 29 | + } |
| 30 | + return(tiles) |
| 31 | +} |
| 32 | + |
| 33 | +#' Get ALS tiles by manual selection |
| 34 | +#' |
| 35 | +#' Interactive version of `intersect_tiles2download()`. Opens a map from which one can select ALS tiles for download. |
| 36 | +#' Currently supports open LiDAR archives from three German states: Northrhine-Westfalia (NRW), Thuringia (TH), and Saxony (SN). |
| 37 | +#' |
| 38 | +#' @param region Region to select tiles from. Options are 'NRW', 'TH', 'SN', or 'all' (default). Selecting a region speeds up map display. |
| 39 | +#' @param gedi_obs Point locations of GEDI observations. Should be a `sf` or `sfc` object. Not required, but helpful for visual comparison. |
| 40 | +#' @param quiet If TRUE, hide message with ALS tile names. Default is FALSE. |
| 41 | +#' @param mode Select tiles with either a "click" (default) or by "draw"-ing a polygon. |
| 42 | +#' |
| 43 | +#' @return sf object with download links for tiles of ALS point clouds, |
| 44 | +#' digital elevation models, and digital surface models. Used as input to download_tiles(). |
| 45 | +#' @export |
| 46 | +#' @seealso [GEDIcalibratoR::intersect_tiles2download()] |
| 47 | +#' @examples |
| 48 | +#' \dontrun{ |
| 49 | +#' tiles = select_tiles2download("SN") |
| 50 | +#' # manually select tiles of interest in the view pane |
| 51 | +#' } |
| 52 | +select_tiles2download = function(region = "all", gedi_obs = NULL, quiet = FALSE, mode = "click"){ |
| 53 | + if (!missing(gedi_obs) & !any(inherits(gedi_obs, c("sf", "sfc")))) |
| 54 | + stop("Please provide GEDI observations as georeferenced point dataset (sf/sfc object). |
| 55 | + GEDI observations are helpful but not required for select_tiles2download() to work.", call. = F) |
| 56 | + if (missing(region)) region = "all" |
| 57 | + if (! region %in% c("TH","NRW","SN", "all")){ |
| 58 | + stop(call. = F, |
| 59 | + message(paste(region,"is not a valid region. Please select one of TH, NRW, SN or all.")) |
| 60 | + )} |
| 61 | + |
| 62 | + if (! region == "all"){ |
| 63 | + als = dplyr::filter(als, state == region) |
| 64 | + overview_layers = lapply(overview_layers, function(x) dplyr::filter(x, state == region)) |
| 65 | + } |
| 66 | + |
| 67 | + basemap = mapview::mapview(overview_layers[[1]], zcol="year_laz", layer.name = "ALS Year",hide = T, |
| 68 | + popup = leafpop::popupTable(overview_layers[[1]], zcol = c(1,2), feature.id = F)) + |
| 69 | + mapview::mapview(overview_layers[[2]], zcol="year_dem", hide = T, legend = T,layer.name = "DEM Year", |
| 70 | + popup = leafpop::popupTable(overview_layers[[2]], zcol = c(1,2), feature.id = F)) + |
| 71 | + mapview::mapview(overview_layers[[3]], zcol="year_dsm", hide = T, legend = T,layer.name = "DSM Year", |
| 72 | + popup = leafpop::popupTable(overview_layers[[3]], zcol = c(1,2), feature.id = F)) |
| 73 | + |
| 74 | + if (! missing(gedi_obs)) basemap = basemap + mapview::mapview(gedi_obs, col.regions = "orange", |
| 75 | + layer.name = "GEDI", popup=F) |
| 76 | + files = mapedit::selectFeatures(als, alpha = 0.2, color="white", |
| 77 | + title="Select ALS tiles for download", |
| 78 | + label = als$tile_laz, map = basemap, mode) |
| 79 | + if (!quiet){ |
| 80 | + message(paste(nrow(files),"tiles selected:")) |
| 81 | + message(crayon::yellow(paste(files$tile_laz, collapse = "\n"))) |
| 82 | + } |
| 83 | + return(files) |
| 84 | +} |
| 85 | + |
| 86 | + |
| 87 | +#' Download selected LAZ, DEM, and DSM tiles |
| 88 | +#' |
| 89 | +#' @param tiles Table containing tiles to download. Output of [GEDIcalibratoR::intersect_tiles2download()] |
| 90 | +#' or [GEDIcalibratoR::select_tiles2download()]. |
| 91 | +#' @param dir Directory to download tiles to. |
| 92 | +#' @param what Either "LAZ", "DEM", or "DSM" (default). |
| 93 | +#' @param setTimeOut If e.g. laz files are large, download performance may suffer from the default |
| 94 | +#' timeout setting (60 sec). Adjust this in case you run into difficulties. |
| 95 | +#' |
| 96 | +#' @return paths to downloaded files |
| 97 | +#' @export |
| 98 | +#' |
| 99 | +#' @examples |
| 100 | +#' \dontrun{ |
| 101 | +#' data("gedi") |
| 102 | +#' tiles = intersect_tiles2download(gedi_obs=gedi) |
| 103 | +#' |
| 104 | +#' # subset to keep one tile from each region |
| 105 | +#' library(dplyr) |
| 106 | +#' tiles = group_by(tiles, state) |> slice_head(n=1) |
| 107 | +#' |
| 108 | +#' # download to temporary directory |
| 109 | +#' td = tempdir() |
| 110 | +#' dsm_tiles = download_tiles(tiles, dir = td, what = "DSM") |
| 111 | +#' dem_tiles = download_tiles(tiles, dir = td, what = "DEM") |
| 112 | +#' laz_tiles = download_tiles(tiles, dir = td, what = "LAZ", setTimeOut = 300) |
| 113 | +#' |
| 114 | +#' file.exists(c(dsm_tiles, dem_tiles, laz_tiles)) |
| 115 | +#' |
| 116 | +#' # delete files |
| 117 | +#' unlink(c(dsm_tiles, dem_tiles, laz_tiles)) |
| 118 | +#'} |
| 119 | +download_tiles = function(tiles, dir, what = "DSM", setTimeOut = NULL){ |
| 120 | + if (missing(tiles)) stop("First select ALS tiles using select_tiles2download() or intersect_tiles2download().") |
| 121 | + if (! what %in% c("LAZ","DEM","DSM")){ |
| 122 | + stop(call. = F, "Invalid file type for Download. Choose from \n(1) LAZ - raw ALS point cloud, |
| 123 | + \n(2) DEM - digital elevation model, or \n(3) DSM - digital surface model.") |
| 124 | + } |
| 125 | + if (! dir.exists(dir)) stop("Directory does not exist!") |
| 126 | + if (! missing(setTimeOut)) options(timeout = setTimeOut) |
| 127 | + tiles = select(tiles, ends_with(what)) |
| 128 | + names(tiles) = gsub(paste0(what,"|_"), "", names(tiles), ignore.case = T) |
| 129 | + tiles = tiles[order(tiles$ftype),] |
| 130 | + if (any(grepl("zip|gz", tiles$ftype))) tmp = tempfile() |
| 131 | + |
| 132 | + pb = txtProgressBar(min = 0, max = nrow(tiles), initial = 0, style = 3) |
| 133 | + dlfiles = as.vector(NULL) |
| 134 | + for (t in 1:nrow(tiles)) { |
| 135 | + if (tiles[t,]$ftype %in% c("laz","tif")){ |
| 136 | + download_als_laz(tiles[t,], dir) |
| 137 | + } else if (tiles[t,]$ftype == "gz") { |
| 138 | + download_als_gz(tiles[t,], dir, tmp) |
| 139 | + } else { |
| 140 | + download_als_zip(tiles[t,], dir, tmp) |
| 141 | + } |
| 142 | + dlfiles = append(dlfiles, tiles[t,]$tile) |
| 143 | + setTxtProgressBar(pb, t) |
| 144 | + close(pb) |
| 145 | + } |
| 146 | + message(crayon::yellow(paste("\n", paste(dlfiles, sep=" -- ")))) |
| 147 | + message(paste(length(dlfiles), "were successfully downloaded to", dir, ".")) |
| 148 | + return(file.path(dir, dlfiles)) |
| 149 | +} |
| 150 | + |
| 151 | +#' Download LAZ, DEM, and DSM tiles |
| 152 | +#' |
| 153 | +#' Internal function used by [GEDIcalibratoR::download_tiles()] |
| 154 | +#' |
| 155 | +#' @param tile single row from tiles table, an output of [GEDIcalibratoR::intersect_tiles2download()] |
| 156 | +#' or [GEDIcalibratoR::select_tiles2download()]. |
| 157 | +#' @param dir directory to download tiles to. |
| 158 | +#' @param tmp temporary file |
| 159 | +download_als_zip = function(tile, dir, tmp){ |
| 160 | + laz = file.path(dir, tile$tile) |
| 161 | + if (! file.exists(laz)){ |
| 162 | + download.file(tile$url, tmp, quiet = F) |
| 163 | + unzip(tmp, exdir = dir, files = basename(laz)) |
| 164 | + } |
| 165 | +} |
| 166 | + |
| 167 | +#' @rdname download_als_zip |
| 168 | +download_als_gz = function(tile, dir, tmp){ |
| 169 | + laz = file.path(dir, tile$tile) |
| 170 | + if (! file.exists(laz)){ |
| 171 | + download.file(tile$url, tmp, quiet = F) |
| 172 | + R.utils::gunzip(tmp, destname = file.path(dir,basename(laz))) |
| 173 | + } |
| 174 | +} |
| 175 | + |
| 176 | +#' @rdname download_als_zip |
| 177 | +download_als_laz = function(tile, dir){ |
| 178 | + laz = file.path(dir, tile$tile) |
| 179 | + if (! file.exists(laz)){ |
| 180 | + download.file(tile$url, laz, quiet = T) |
| 181 | + } |
| 182 | +} |
0 commit comments