Nothing
#' A tile from Theia
#'
#' Generate and manage a tile from Theia (download, check, load).
#'
#' @name TheiaTile
#'
#' @section Usage:
#' \preformatted{
#' t <- TheiaTile$new(file.path,
#' url,
#' file.hash,
#' check = TRUE,
#' quiet = TRUE)
#'
#' t$download(overwrite = FALSE, check = TRUE, quiet = TRUE)
#' t$check()
#' t$extract(overwrite = FALSE, dest.dir = NULL)
#' t$read(bands)
#' }
#'
#' @section Arguments:
#'
#' \describe{
#' \item{t:}{A \code{TheiaTile} object}
#' \item{file.path:}{The path to the zip file containing the tile}
#' \item{url:}{The url to download the tile}
#' \item{file.hash:}{The md5sum used to check the zip file}
#' \item{check:}{Whether or not to check existing files on tile's creation}
#' \item{quiet:}{Control verbose output}
#' \item{auth:}{A character string giving the file path to Theia credentials.
#' Or a \code{\link{TheiaAuth}} object}
#' \item{overwrite:}{Overwrite existing tiles (default to `FALSE`)}
#' \item{bands:}{A character vector of bands to load from tiles}
#' }
#'
#' @section Details:
#' \code{TheiaTile$new(file.path, url, file.hash, check)} Create a new instance of
#' the class
#'
#' \code{t$download(auth, overwrite = FALSE, check = TRUE)} Download the
#' tiles of the collection and check the resulting files
#'
#' \code{t$check()} Check the tiles of the collection
#'
#' \code{t$extract(overwrite = FALSE, dest.dir = NULL)} Extract archive to
#' dest.dir if supplied, or to the same directory as the archive otherwise
#'
#' \code{t$read(bands)} Read requested bands, apply corrections on values
#' (as specified in Theia's product information), and return a RasterStack
#'
#' \code{t$bands} List bands available in the tile
#'
#'
NULL
#' @export
TheiaTile <-
R6Class("TheiaTile",
# public -------------------------------------------------------------
public =
list(file.path = NA,
file.hash = NA,
url = NA,
tile.name = NA,
path.extracted = NA,
md = NULL,
collection = NA,
status = list(exists = FALSE,
checked = FALSE,
correct = FALSE,
extracted = FALSE),
initialize = function(file.path, url, tile.name, file.hash, collection = NULL, check = TRUE, quiet = TRUE)
{
if (quiet == TRUE) {
suppressMessages({
.TheiaTile_initialize(self, file.path, url, tile.name, file.hash, collection, check)
})
} else {
.TheiaTile_initialize(self, file.path, url, tile.name, file.hash, collection, check)
}
},
print = function(...)
{
.TheiaTile_print(self)
},
check = function(check = TRUE)
{
.TheiaTile_check(self, check)
},
download = function(auth, overwrite = FALSE, check = TRUE, quiet = TRUE)
{
if (quiet == TRUE) {
suppressMessages({
.TheiaTile_download(self, auth, overwrite, check)
})
} else {
.TheiaTile_download(self, auth, overwrite, check)
}
},
read = function(bands)
{
.TheiaTile_read(self, bands)
},
extract = function(overwrite = FALSE, dest.dir = NULL)
{
.TheiaTile_extract(self, overwrite, dest.dir)
}),
active =
list(meta.data = function()
{
if (is.null(self$md)) {
return(.TheiaTile_read_md(self))
}
return(self$md)
},
bands = function()
{
.TheiaTile_get_bands(self)
})
)
# Functions definitions --------------------------------------------------------
.TheiaTile_print <- function(self)
{
# Special method to print
cat("An Tile from Theia\n\n")
cat("Collection:", self$collection, "\n\n")
cat("Status:\n")
cat(" downloaded :", self$status$exists, "\n")
cat(" checked :", self$status$checked, "\n")
cat(" correct :", self$status$correct, "\n")
return(invisible(self))
}
.TheiaTile_initialize <- function(self, file.path, url, tile.name, file.hash, collection = NULL, check)
{
# Fill fields of the object
self$file.path <- file.path
self$url <- url
self$tile.name <- gsub("\\.tar\\.gz$|\\.zip$", "", tile.name)
self$file.hash <- file.hash
if (is.null(collection)) {
# try to guess the collection based on the file name (should be used only if
# the collection has been created from a cart file)
self$collection <- gsub("(.*)(/[^/]*$)", "\\2", self$file.path)
self$collection <- gsub("(^/)([[:alnum:]]*)(_.*$)", "\\2", self$collection)
self$collection <- gsub("([[:alnum:]]*)([[:alnum:]]{1}$)", "\\1", self$collection)
} else {
self$collection <- collection
}
# check the tile
self$check(check)
return(invisible(self))
}
.TheiaTile_check <- function(self, check)
{
# check the tile
if (file.exists(self$file.path)) {
# if the file exists, check it
if (check == FALSE) {
message("Assuming file is correctly downloaded. Set 'check=TRUE' to check file's hash")
self$status$exists <- TRUE
self$status$checked <- FALSE
self$status$correct <- TRUE
return(invisible(self))
}
message("Checking downloaded file...")
self$status$exists <- TRUE
self$status$checked <- TRUE
if (is.na(self$file.hash)) {
# if no hash is provided, assume the file is correct
self$status$correct <- TRUE
return(invisible(self))
}
# compute the md5 sum and compare it to the hash
if (tools::md5sum(self$file.path) == self$file.hash) {
self$status$correct <- TRUE
} else {
self$status$correct <- FALSE
warning(self$file.path, "incorrectly downloaded")
}
}
return(invisible(self))
}
.TheiaTile_download <- function(self, auth, overwrite, check)
{
if (is.character(auth)) {
# create authentification system if not supplied
auth <- TheiaAuth$new(auth.file = auth)
}
if (!(self$status$correct) | overwrite == TRUE ) {
# file does not exist, is not correct, or overwrite is TRUE
# build the URL for the request: remove token if link has been created from
# a cart file and add needed part
url <- gsub("\\?_tk=.*$", "", self$url)
url <- paste0(url, "/?issuerId=theia")
# HTTP request
req <- httr::GET(url,
httr::add_headers(Authorization = paste("Bearer", auth$token)),
httr::write_disk(self$file.path, overwrite = TRUE),
httr::progress())
httr::stop_for_status(req, task = paste0("download tile: ", self$file.path))
# test if file is text
if (!(grepl("zip", httr::http_type(req)))) {
stop("Downloaded product is a text file, it should not be... Response:\n\n",
httr::content(req, as = "text"))
}
} else {
# The file already exists
message("File ",
self$file.path,
" already exists. Use 'overwrite=TRUE' to ovewrite.")
}
if (check == TRUE) {
# check the tile
self$check()
} else {
# do not check file
message("Assuming file is correctly downloaded. Set 'check=TRUE' to check file's hash")
self$status$exists <- TRUE
self$status$checked <- FALSE
self$status$correct <- TRUE
}
return(invisible(self))
}
.TheiaTile_read_md <- function(self)
{
message("Parsing meta data...")
# create temporary directory
tmp.dir <- file.path(tempdir(), "/")
# get file name to extract
file.name <- extraction_wrapper(self$file.path, args = list(list = TRUE))
file.name <- file.name[grepl("\\.xml$", file.name)]
# extract and parse xml file
extraction_wrapper(self$file.path, args = list(files = file.name, exdir = tmp.dir))
meta.data <- XML::xmlToList(XML::xmlParse(file.path(tmp.dir, file.name)))
# remove temporary file
unlink(file.path(tmp.dir, file.name))
# store it in object so it we don't have to read again if we need it
self$md = meta.data
return(meta.data)
}
.TheiaTile_get_bands <- function(self)
{
# get bands list from meta data
if (self$collection == 'Landsat57') {
# Read the bands from the old format
bands = data.frame(
band = unlist(strsplit(self$meta.data$RADIOMETRY$BANDS, ';')),
resolution = 'R1'
)
return(bands)
}
bands <- lapply(self$meta.data$Product_Characteristics$Band_Group_List,
function(x) {
band.list <- unlist(x$Band_List[-(length(x$Band_List))])
band.id <- unname(x$.attrs)
data.frame(band = band.list, resolution = band.id)
})
bands <- do.call(rbind, bands)
rownames(bands) <- NULL
return(bands)
}
.TheiaTile_read <- function(self, bands)
{
if (self$collection == 'Landsat57') {
stop(
'This feature is not available for Landsat57 collection. You can read the bands manually with the `raster` library.',
call. = FALSE
)
# file.name <- paste0('/vsitar/', self$file.path, '/', self$meta.data$FILES$ORTHO_SURF_CORR_PENTE)
# tiles.stack <- raster::stack(file.name)
# names(tiles.stack) <- avail.bands
# tiles.stack = tiles.stack[[bands]]
# return(tiles.stack)
}
# check if requested bands are available
avail.bands <- self$bands
if (any(!(bands %in% avail.bands$band))) {
# error if some bands are not available
bad.bands <- paste(bands[!(bands %in% avail.bands)], collapse = ", ")
stop("Bands '", bad.bands, "' are not available!")
}
# get file names to read from
files <- unzip(self$file.path, list = TRUE)$Name
pattern <- paste(paste0("FRE_", bands, ".tif$"), collapse = "|")
files <- files[grepl(pattern, files)]
# read tiles from zip file and create raster::rasterStack object
tiles.list <- lapply(files, read_tiff_from_zip, zip.file = self$file.path)
# correct values
tiles.stack <- raster::stack(lapply(tiles.list, correct_values))
# give names to the layers
bands.names <- gsub("(^.*_)([[:alnum:]]*$)", "\\2", names(tiles.stack))
names(tiles.stack) <- bands.names
return(tiles.stack)
}
.TheiaTile_extract <- function(self, overwrite, dest.dir)
{
if (is.null(dest.dir)) {
# create destination directory if not supllied
dest.dir <- gsub(self$tile.name, "", self$file.path)
dest.dir <- gsub("\\.zip$|\\.tar.\\gz$", "", dest.dir)
}
# get extracted archive name
file.path <- extraction_wrapper(self$file.path, args = list(list = TRUE))[1]
file.path <- gsub("(^.*/)(.*$)", "\\1", file.path)
file.path <- file.path(dest.dir, file.path)
if (!(dir.exists(file.path)) | overwrite == TRUE) {
# check if it exists
extraction_wrapper(self$file.path, args = list(exdir = dest.dir))
self$status$extracted <- TRUE
self$path.extracted <- file.path
} else {
self$status$extracted <- TRUE
self$path.extracted <- file.path
message(file.path, " already exists. Use 'overwrite=TRUE' to overwrite")
}
return(invisible(file.path))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.