Nothing
tmprst <- function() {
tempfile(pattern = "tmp_raster_", fileext = ".tif")
}
#' Create map tiles
#'
#' Create geographic and non-geographic map tiles from a file.
#'
#' @details
#' This function supports both geographic and non-geographic tile generation.
#' When `file` is a simple image file such as `png`, `tile()` generates
#' non-geographic, simple CRS tiles. Files that can be loaded by the `raster`
#' package yield geographic tiles as long as `file` has projection information.
#' If the raster object's Proj4 string is `NA`, it falls back on non-geographic
#' tile generation and a warning is thrown.
#'
#' Choice of appropriate zoom levels for non-geographic image files may depend
#' on the size of the image. A `zoom` value may be partially ignored for image
#' files under certain conditions. For instance using the example `map.png`
#' below, when passing strictly `zoom = n` where `n` is less than 3, this still
#' generates tiles for zoom `n` up through 3.
#'
#' \subsection{Supported file types}{
#' Supported simple CRS/non-geographic image file types include `png`, `jpg` and
#' `bmp`. For projected map data, supported file types include three types
#' readable by the `raster` package: `grd`, `tif`, and `nc` (requires `ncdf4`).
#' Other currently unsupported file types passed to `file` throw an error.
#' }
#' \subsection{Raster file inputs}{
#' If a map file loadable by `raster` is a single-layer raster object, tile
#' coloring is applied. To override default coloring of data and `noData`
#' pixels, pass the additional arguments `col` and `colNA` to `...`.
#' Multi-layer raster objects are rejected with an error message. The only
#' exception is a three- or four-band raster, which is assumed to represent
#' red, green, blue and alpha channels, respectively.
#' In this case, processing will continue but coloring arguments are ignored as
#' unnecessary.
#' \cr\cr
#' Prior to tiling, a geographically-projected raster layer is reprojected to
#' EPSG:4326 only if it has some other projection. The only reprojection
#' argument available through `...` is `method`, which can be `"bilinear"`
#' (default) or`"ngb"`. If complete control over reprojection is required, this
#' should be done prior to passing the rasterized file to the `tile` function.
#' Then no reprojection is performed by `tile()`. When `file` consists of RGB or
#' RGBA bands, `method` is ignored if provided and reprojection uses nearest
#' neighbor.
#' \cr\cr
#' It is recommended to avoid using a projected 4-band RGBA raster file.
#' However, the alpha channel appears to be ignored anyway. `gdal2tiles` gives
#' an internal warning. Instead, create your RGBA raster file in unprojected
#' form and it should pass through to `gdal2tiles` without any issues.
#' Three-band RGB raster files are unaffected by reprojection.
#' }
#' \subsection{Tiles and Leaflet}{
#' `gdal2tiles` generates TMS tiles. If expecting XYZ, for example when using
#' with Leaflet, you can change the end of the URL to your hosted tiles from
#' `{z}/{x}/{y}.png` to `{z}/{x}/{-y}.png`.
#' \cr\cr
#' This function is supported by two different versions of `gdal2tiles`. There
#' is the standard version, which generates geospatial tiles in TMS format. The
#' other version of `gdal2tiles} handles basic image files like a matrix of rows
#' and columns, using a simple Cartesian coordinate system based on pixel
#' dimensions of the image file. See the Leaflet JS library and `leaflet`
#' package documentation for working with custom tiles in Leaflet.
#' }
#'
#' @param file character, input file.
#' @param tiles character, output directory for generated tiles.
#' @param zoom character, zoom levels. Example format: `"3-7"`.
#' See details.
#' @param crs character, Proj4 string. Use this to force set the CRS of a loaded
#' raster object from `file` in cases where the CRS is missing but known, to
#' avoid defaulting to non-geographic tiling.
#' @param resume logical, only generate missing tiles.
#' @param viewer logical, also create `preview.html` adjacent to `tiles`
#' directory for previewing tiles in the browser using Leaflet.
#' @param georef logical, for non-geographic tiles only. If `viewer = TRUE`,
#' then the Leaflet widget in `preview.html` will add map markers with
#' coordinate labels on mouse click to assist with georeferencing of
#' non-geographic tiles.
#' @param ... additional arguments for projected maps: reprojection method or
#' any arguments to `raster::RGB()`, e.g. `col` and `colNA`. See details. Other
#' additional arguments `lng` and `lat` can also be passed to the tile
#' previewer. See [tile_viewer()] for details.
#'
#' @return nothing is returned but tiles are written to disk.
#' @export
#' @seealso [view_tiles()], [tile_viewer()]
#'
#' @examples
#' \dontshow{tmpfiles <- list.files(tempdir(), full.names = TRUE)}
#' # non-geographic/simple CRS
#' x <- system.file("maps/map.png", package = "tiler")
#' tiles <- file.path(tempdir(), "tiles")
#' tile(x, tiles, "2-3")
#'
#' \dontrun{
#' # unprojected map
#' x <- system.file("maps/map_wgs84.tif", package = "tiler")
#' tile(x, tiles, 0)
#'
#' # projected map
#' x <- system.file("maps/map_albers.tif", package = "tiler")
#' tile(x, tiles, 0)
#' }
#' \dontshow{
#' unlink(c(tiles, file.path(tempdir(), "preview.html")), recursive = TRUE,
#' force = TRUE)
#' extrafiles <- setdiff(list.files(tempdir(), full.names = TRUE), tmpfiles)
#' if(length(extrafiles)) unlink(extrafiles, recursive = TRUE, force = TRUE)
#' }
tile <- function(file, tiles, zoom, crs = NULL, resume = FALSE, viewer = TRUE,
georef = TRUE, ...){
ext <- .get_ext(file)
if(ext == "jpg" && !requireNamespace("jpeg", quietly = TRUE)){
message(paste("jpg files are optionally supported (png recommended).",
"Install `jpeg` package to use jpg images."))
return(invisible())
}
if(ext == "bmp" && !requireNamespace("bmp", quietly = TRUE)){
message(paste("bmp files are optionally supported (png recommended).",
"Install `bmp` package to use bmp images."))
return(invisible())
}
if(!ext %in% unlist(.supported_filetypes))
stop(paste0("File type .", ext, " not supported."))
ex <- tiler_options()$python
if(.Platform$OS.type == "windows"){
if(ex != "python") ex <- paste0("\"", ex, "\"")
bat <- tiler_options()$osgeo4w
if(bat != "OSGeo4W.bat"){
ex <- paste0("\"", bat, "\" ", ex)
} else {
ex <- paste(bat, ex)
}
}
dir.create(tiles, showWarnings = FALSE, recursive = TRUE)
tf <- tmprst()
projected <- .proj_check(file, crs, tmpf = tf, ...)
if(ext %in% .supported_filetypes$ras)
file <- tf
dir.create(g2t_tmp_dir <- tempfile("g2ttmp_"),
showWarnings = FALSE, recursive = TRUE)
if(projected){
g2t <- system.file("python/gdal2tiles.py", package = "tiler")
ex <- paste0(ex, " \"", g2t, "\" -z ", zoom, " -w none ", "--tmpdir \"",
normalizePath(g2t_tmp_dir), "\" ",
ifelse(resume, "-e ", ""), "\"",
normalizePath(file), "\" \"", normalizePath(tiles), "\"")
} else {
g2t <- system.file("python/gdal2tilesIMG.py", package = "tiler")
ex <- paste0(ex, " \"", g2t, "\" --leaflet -p raster -z ", zoom,
" -w none ", "--tmpdir \"", normalizePath(g2t_tmp_dir), "\" ",
ifelse(resume, "-e ", ""), "\"", normalizePath(file), "\" \"",
normalizePath(tiles), "\"")
}
cat("Creating tiles. Please wait...\n")
system(ex)
unlink(g2t_tmp_dir, recursive = TRUE, force = TRUE)
if(viewer){
cat("Creating tile viewer...\n")
w <- h <- NULL
if(!projected){
if(file == tf){
x <- raster::raster(file)
w <- ncol(x)
h <- nrow(x)
} else {
if(ext == "png") f <- png::readPNG else
if(ext == "jpg") f <- jpeg::readJPEG else f <- bmp::read.bmp
x <- f(file)
w <- dim(x)[2]
h <- dim(x)[1]
}
}
viewer_args <- c(
list(tiles = tiles, zoom = zoom, width = w, height = h, georef = georef),
list(...)
)
do.call(tile_viewer, viewer_args)
cat("Complete.\n")
}
if(ext %in% .supported_filetypes$ras) unlink(file)
invisible()
}
.proj_check <- function(file, crs = NULL, tmpf = tmprst(), ...){
ext <- .get_ext(file)
if(ext %in% .supported_filetypes$img) return(FALSE)
dots <- list(...)
r <- raster::readAll(raster::stack(file))
bands <- raster::nlayers(r)
if(!bands %in% c(1, 3, 4))
stop("`file` is multi-band but does not appear to be RGB or RGBA layers.")
method <- ifelse(bands != 1, "ngb", ifelse(is.null(dots$method), "bilinear",
dots$method))
if(bands == 1) r <- raster::raster(r, layer = 1)
wgs84 <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"
proj4 <- raster::projection(r)
req_reproj <- !is.na(proj4) && !.is_wgs84(proj4)
projected <- req_reproj || !is.null(crs)
if(!projected && !.is_wgs84(proj4)){
warning(paste("Projection expected but is missing.",
"Continuing as non-geographic image."))
} else if(!is.null(crs)){
proj4 <- raster::projection(r) <- crs
}
if(projected){
cat("Reprojecting raster...\n")
e <- raster::projectExtent(r, crs = sp::CRS(wgs84))
r <- raster::projectRaster(r, e, method = method)
}
if(bands == 1){
cat("Coloring raster...\n")
if(!is.null(dots$col)){
col <- .fix_colors(dots$col, no_white = TRUE)
} else if(method == "ngb"){
col <- c("#66C2A5", "#FC8D62", "#8DA0CB", "#E78AC3", "#A6D854",
"#FFD92F", "#E5C494", "#B3B3B3")
} else {
col <- grDevices::colorRampPalette(
c("#7F3B08", "#B35806", "#E08214", "#FDB863", "#FEE0B6",
"#F7F7F7", "#D8DAEB", "#B2ABD2", "#8073AC", "#542788", "#2D004B"))(30)
}
nacol <- if(!is.null(dots$colNA)) .fix_colors(dots$colNA) else "#FFFFFF"
alpha <- if(!is.null(dots$alpha)) dots$alpha else FALSE
r <- raster::RGB(r, col = col, breaks = dots$breaks, alpha = alpha,
colNA = nacol, zlim = dots$zlim, zlimcol = dots$zcol,
ext = dots$ext)
}
cat("Preparing for tiling...\n")
raster::writeRaster(r, filename = tmpf, overwrite = TRUE, datatype = "INT1U")
projected
}
.get_ext <- function(file) utils::tail(strsplit(file, "\\.")[[1]], 1)
.supported_filetypes <- list(img = c("bmp", "jpg", "png"),
ras = c("grd", "tif", "nc"))
.is_wgs84 <- function(x){
grepl("+proj=longlat", x) & grepl("+datum=WGS84", x) &
grepl("+no_defs|+towgs84=0,0,0", x) # & grepl("+ellps=WGS84", x) # last bit unnecessary?
}
.fix_colors <- function(x, no_white = FALSE){
x <- tolower(x)
if(no_white) x <- gsub("#ffffff|white", "#feffff", x)
hex <- grepl("^#", x)
if(any(hex)) x[hex] <- gsub("^#ff", "#fe", x[hex])
if(!all(hex)){
f <- function(x){
x <- format(as.hexmode(x), width = 2)
x[1] <- gsub("ff", "fe", x[1])
paste0("#", paste(x, collapse = ""))
}
x[!hex] <- apply(grDevices::col2rgb(x[!hex]), 2, f)
}
x
}
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.