tmap
tmap copied to clipboard
Published
20 hours ago •
r-tmap
r-tmap
tm_rbg stretch
Now, as tmap moved completely to stars, I would think it would be good to consider adding some argument similar to stretch to tm_rgb().
Motivation for that, including example data and comparison with raster can be seen below:
library(stars)
#> Loading required package: abind
#> Loading required package: sf
#> Linking to GEOS 3.8.1, GDAL 3.1.4, PROJ 6.3.2
library(tmap)
library(raster)
#> Loading required package: sp
# get data ----------------------------------------------------------------
tf = tempfile()
td = tempdir()
download.file("https://github.com/mtennekes/tmap/files/5987567/rgbexample.tif.zip",
destfile = tf)
unzip(tf, exdir = td)
file_path = paste0(td, "/", "rgbexample.tif")
x = read_stars(file_path)
# try tmap ----------------------------------------------------------------
# 1
tm_shape(x) +
tm_rgb(r = 4, g = 3, b = 2)
#> Error in rgb(x[, 1], x[, 2], x[, 3], maxColorValue = max.value): color intensity 256, not in 0:255
# 2
tm_shape(x) +
tm_rgb(r = 4, g = 3, b = 2, max.value = 65536)
# 3
tm_shape(x) +
tm_rgb(r = 4, g = 3, b = 2, max.value = 19000)
# try raster --------------------------------------------------------------
r = stack(file_path)
plotRGB(r, r = 4, g = 3, b = 2, scale = 65536)
plotRGB(r, r = 4, g = 3, b = 2, scale = 65536, stretch = "lin")
plotRGB(r, r = 4, g = 3, b = 2, scale = 65536, stretch = "hist")
Created on 2021-02-16 by the reprex package (v1.0.0)
I made some trials based on raster::stretch approach. May be there were more better ways to do the same. But I will share my way to the discussion:
I tested with the rgbexample.tif shared
library(stars)
#> Loading required package: abind
#> Loading required package: sf
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(tmap)
# Example data ---
tf = tempfile()
td = tempdir()
download.file("https://github.com/mtennekes/tmap/files/5987567/rgbexample.tif.zip",
destfile = tf)
unzip(tf, exdir = td)
file_path = file.path(td, "rgbexample.tif")
x = read_stars(file_path)
# Functions to stretch stars rasters -----
# Percent clip
.quantStretch <- function (x, q = c(0.02, 0.98), max.value = 255) {
nx <- names(x)
v <- st_apply(adrop(x), 3, FUN = stats::quantile,
probs = q, na.rm = TRUE)
x[[2]] <- rep(v[[1]][1,], each = prod(dim(x)[1:2]))
x[[3]] <- rep(v[[1]][2,], each = prod(dim(x)[1:2]))
names(x)[2:3] <- st_get_dimension_values(v, "stats::quantile")
temp <- max.value * (x[1] - x[2])/(x[3] - x[2])
temp <- (temp > 0) * temp
temp <- c(temp < max.value) * temp + (temp > max.value) * max.value
return(temp)
}
# Histogram equalizer
.equalizerStretch <- function(x, max.value = 255){
temp <- st_apply(x, 3, function(x) x <- stats::ecdf(x)(x))
return(temp * max.value)
}
# min/max equalizer
.rangeStretch <- function(x,
rgs = matrix(c(0, 255), ncol = dim(x)[3], nrow = 2),
max.value = 255){
x[[2]] <- rep(rgs[1,], each = prod(dim(x)[1:2]))
x[[3]] <- rep(rgs[2,], each = prod(dim(x)[1:2]))
names(x)[2:3] <- c("min", "max")
temp <- max.value * (x[1] - x[2])/(x[3] - x[2])
temp <- (temp > 0) * temp
temp <- c(temp < max.value) * temp + (temp > max.value) * max.value
return(temp)
}
# None stretching
tm_shape(x) +
tm_rgb(3, 2, 1,max.value = 65536)
# Stretching by histogram equalizer
tm_shape(.equalizerStretch(x)) +
tm_rgb(3, 2, 1, max.value = 255)
# Stretching by percent clip
tm_shape(.quantStretch(x, q = c(0.02, 0.98))) +
tm_rgb(3, 2, 1, max.value = 255)
# Stretching by user range input
tm_shape(.rangeStretch(x,
rgs = matrix(c(0, 1000),
ncol = 4,
nrow = 2))) +
tm_rgb(3, 2, 1, max.value = 255)
Created on 2021-06-09 by the reprex package (v2.0.0)
Session info
sessioninfo::session_info()
#> ─ Session info ───────────────────────────────────────────────────────────────
#> setting value
#> version R version 4.1.0 (2021-05-18)
#> os Ubuntu 20.04.2 LTS
#> system x86_64, linux-gnu
#> ui X11
#> language (EN)
#> collate en_US.UTF-8
#> ctype en_US.UTF-8
#> tz America/Guayaquil
#> date 2021-06-09
#>
#> ─ Packages ───────────────────────────────────────────────────────────────────
#> package * version date lib source
#> abind * 1.4-5 2016-07-21 [2] CRAN (R 4.0.2)
#> assertthat 0.2.1 2019-03-21 [2] CRAN (R 4.0.2)
#> backports 1.2.1 2020-12-09 [2] CRAN (R 4.0.3)
#> base64enc 0.1-3 2015-07-28 [2] CRAN (R 4.0.2)
#> class 7.3-19 2021-05-03 [4] CRAN (R 4.0.5)
#> classInt 0.4-3 2020-04-07 [2] CRAN (R 4.0.2)
#> cli 2.5.0 2021-04-26 [2] CRAN (R 4.0.5)
#> codetools 0.2-18 2020-11-04 [4] CRAN (R 4.0.3)
#> crayon 1.4.1 2021-02-08 [2] CRAN (R 4.0.4)
#> crosstalk 1.1.1 2021-01-12 [2] CRAN (R 4.0.3)
#> curl 4.3.1 2021-04-30 [2] CRAN (R 4.0.5)
#> DBI 1.1.1 2021-01-15 [2] CRAN (R 4.0.3)
#> dichromat 2.0-0 2013-01-24 [2] CRAN (R 4.0.2)
#> digest 0.6.27 2020-10-24 [2] CRAN (R 4.0.3)
#> dplyr 1.0.6 2021-05-05 [2] CRAN (R 4.0.5)
#> e1071 1.7-7 2021-05-23 [2] CRAN (R 4.1.0)
#> ellipsis 0.3.2 2021-04-29 [2] CRAN (R 4.0.5)
#> evaluate 0.14 2019-05-28 [2] CRAN (R 4.0.2)
#> fansi 0.5.0 2021-05-25 [2] CRAN (R 4.1.0)
#> fs 1.5.0 2020-07-31 [2] CRAN (R 4.0.2)
#> generics 0.1.0 2020-10-31 [2] CRAN (R 4.0.3)
#> glue 1.4.2 2020-08-27 [2] CRAN (R 4.0.2)
#> highr 0.9 2021-04-16 [2] CRAN (R 4.0.5)
#> htmltools 0.5.1.1 2021-01-22 [2] CRAN (R 4.0.3)
#> htmlwidgets 1.5.3 2020-12-10 [2] CRAN (R 4.0.3)
#> httr 1.4.2 2020-07-20 [2] CRAN (R 4.0.2)
#> KernSmooth 2.23-20 2021-05-03 [4] CRAN (R 4.0.5)
#> knitr 1.33 2021-04-24 [2] CRAN (R 4.0.5)
#> lattice 0.20-44 2021-05-02 [4] CRAN (R 4.1.0)
#> leafem 0.1.6 2021-05-24 [2] CRAN (R 4.1.0)
#> leaflet 2.0.4.1 2021-01-07 [2] CRAN (R 4.0.3)
#> leafsync 0.1.0 2019-03-05 [2] CRAN (R 4.0.2)
#> lifecycle 1.0.0 2021-02-15 [2] CRAN (R 4.0.4)
#> lwgeom 0.2-6 2021-04-02 [2] CRAN (R 4.0.5)
#> magrittr 2.0.1 2020-11-17 [2] CRAN (R 4.0.3)
#> mime 0.10 2021-02-13 [2] CRAN (R 4.0.4)
#> pillar 1.6.1 2021-05-16 [2] CRAN (R 4.0.5)
#> pkgconfig 2.0.3 2019-09-22 [2] CRAN (R 4.0.2)
#> png 0.1-7 2013-12-03 [2] CRAN (R 4.0.2)
#> proxy 0.4-25 2021-03-05 [2] CRAN (R 4.0.5)
#> purrr 0.3.4 2020-04-17 [2] CRAN (R 4.0.2)
#> R6 2.5.0 2020-10-28 [2] CRAN (R 4.0.3)
#> raster 3.4-10 2021-05-03 [2] CRAN (R 4.0.5)
#> RColorBrewer 1.1-2 2014-12-07 [2] CRAN (R 4.0.2)
#> Rcpp 1.0.6 2021-01-15 [2] CRAN (R 4.0.3)
#> reprex 2.0.0 2021-04-02 [2] CRAN (R 4.0.5)
#> rlang 0.4.11 2021-04-30 [2] CRAN (R 4.0.5)
#> rmarkdown 2.8 2021-05-07 [2] CRAN (R 4.0.5)
#> sessioninfo 1.1.1 2018-11-05 [2] CRAN (R 4.0.5)
#> sf * 0.9-8 2021-03-17 [2] CRAN (R 4.0.5)
#> sp 1.4-5 2021-01-10 [2] CRAN (R 4.0.3)
#> stars * 0.5-2 2021-03-17 [2] CRAN (R 4.0.5)
#> stringi 1.6.2 2021-05-17 [2] CRAN (R 4.0.5)
#> stringr 1.4.0 2019-02-10 [2] CRAN (R 4.0.2)
#> styler 1.4.1 2021-03-30 [2] CRAN (R 4.0.5)
#> tibble 3.1.2 2021-05-16 [2] CRAN (R 4.0.5)
#> tidyselect 1.1.1 2021-04-30 [2] CRAN (R 4.0.5)
#> tmap * 3.3-1 2021-03-15 [2] CRAN (R 4.0.5)
#> tmaptools 3.1-1 2021-01-19 [2] CRAN (R 4.0.3)
#> units 0.7-1 2021-03-16 [2] CRAN (R 4.0.5)
#> utf8 1.2.1 2021-03-12 [2] CRAN (R 4.0.5)
#> vctrs 0.3.8 2021-04-29 [2] CRAN (R 4.0.5)
#> viridisLite 0.4.0 2021-04-13 [2] CRAN (R 4.0.5)
#> withr 2.4.2 2021-04-18 [2] CRAN (R 4.0.5)
#> xfun 0.23 2021-05-15 [2] CRAN (R 4.0.5)
#> XML 3.99-0.6 2021-03-16 [2] CRAN (R 4.0.5)
#> xml2 1.3.2 2020-04-23 [2] CRAN (R 4.0.2)
#> yaml 2.2.1 2020-02-01 [2] CRAN (R 4.0.2)
#>
#> [1] /home/gabo/R/x86_64-pc-linux-gnu-library/4.1
#> [2] /usr/local/lib/R/site-library
#> [3] /usr/lib/R/site-library
#> [4] /usr/lib/R/library
Excellent work @gavg712 ! This is very useful for the rspatial community. We can add these functions to tmap for sure (probably as of v4).
Would these functions also be useful for other uses except visualization? If so, it may make more sense to add these functions somewhere else. Perhaps in stars?
What do you think @edzer @Nowosad ?
Some work on converting bands to rgb, including cutoffs and stretching, was done in stars::st_rgb() - maybe some of it overlaps this.
Perhaps, tmap could process the layers using stars::st_rgb(), but some changes has to be done in tm_rgb to pass one layer instead 3 (rgb) or 4 (rgba). This works fine:
# stretching by "Percent clip"
st_rgb(x[,,,4:2], # Passing only selected bands: 4, 3, 2
dimension = 3,
maxColorValue = 255,
use_alpha = FALSE,
probs = c(0.02, 0.98), #Probabilities for percent clip
stretch = TRUE) |>
tm_shape() +
tm_raster()
But, as I can see, stars::st_rgb() only allows to perform a "percent clip" stretching. Changing a bit the function could be feasible to use different methods in the argument stretch (I.e stretch = "histogram" or stretch = "percent"). @edzer, if you prefer I could make a PR in the stars package repo, with some changes to the st_rgb(). This is my test:
# stretching by "histogram equalizer" using my local st_rgb() function
st_rgb(x[,,,4:2],
dimension = 3,
maxColorValue = 255,
use_alpha = FALSE,
probs = c(0.02, 0.98), #ignored when histogram equalizer stretch defined
stretch = "histogram") |>
tm_shape() +
tm_raster()
What do you think?