working on tmap_style_catalog

R/tmapScaleContinuous.R

@@ -207,7 +207,7 @@ tmapScaleContinuous = function(x1, scale, legend, chart, o, aes, layer, layer_ar
  VV = transform_values(x_t, limits_t, values.range, values$power, values.scale * o$scale)
 
  vals = VV$x
- value.neutral = VV$neutral
+ if (is.na(value.neutral)) value.neutral = VV$neutral
  }
 
  isna = is.na(vals)

R/tmapScale_defaults.R

@@ -226,10 +226,15 @@ tmapValuesRange_fontface = function(x, n, isdiv) {
  c(0, 1)
 }
 
-tmapValuesVV_fill = function(x, value.na, isdiv, n, dvalues, are_breaks, midpoint, range, scale, rep, o) {
+tmapValuesVV_fill = function(x, value.na, isdiv, n, dvalues, are_breaks, midpoint, range, scale, rep, o, aes = "fill") {
  #palid = tmapPalId(x[1])
+ if (x[1] %in% c("seq", "div", "unord", "ord", "biv")) {
+ # cols4all can also take "div", but does not take into account tmap style
+ x = getAesOption("values.var", o, aes = aes, layer = NA, cls = x[1])
+ }
+
+ m = getPalMeta(x[1]) 
 
- m = getPalMeta(x[1])
 
  scale_ids = function(ids, n) {
  1 + ((ids - 1) / (n - 1)) * 100 
@@ -302,11 +307,11 @@ tmapValuesVV_fill = function(x, value.na, isdiv, n, dvalues, are_breaks, midpoin
 }
 
 tmapValuesVV_col = function(...) {
- tmapValuesVV_fill(...)
+ tmapValuesVV_fill(..., aes = "col")
 }
 
 tmapValuesVV_bgcol = function(...) {
- tmapValuesVV_fill(...)
+ tmapValuesVV_fill(..., aes = "bgcol")
 }
 
 tmapValuesVV_shape = function(x, value.na, isdiv, n, dvalues, are_breaks, midpoint, range, scale, rep, o) {
@@ -492,7 +497,7 @@ transform_values = function(x, lim, rng, power, scale, include.neutral = TRUE) {
  x2 = norm_vector(x, lim)
  x3 = if (rng[1] != 0 || rng[2] != 1) scale_vector(x2, rng) else x2
 
- if (include.neutral) neutral = mean(x3)
+ if (include.neutral) neutral = mean(rng)
  if (p != 1) {
  x3 = x3 ^ p
  if (include.neutral) neutral = neutral ^ p

R/tmap_options.R

@@ -505,7 +505,7 @@ tmapMode = function(id, name, ...) {
 
  scalebar.show = FALSE,
  scalebar.breaks=NULL,
- scalebar.width=20, 
+ scalebar.width=40, 
  scalebar.text.size = .5,
  scalebar.text.color=NA,
  scalebar.color.dark="black", 
@@ -737,8 +737,8 @@ styles = list(
  fill = "grey70",
  col = "grey70",
  col.polygons = "grey70"),
- values.var = list(fill = list(seq = "brewer.ylgn", div = "brewer.rdylgn", unord = "brewer.set3", ord = "brewer.ylgn"),
- col = list(seq = "brewer.ylgn", div = "brewer.rdylgn", unord = "brewer.set3", ord = "brewer.ylgn")),
+ values.var = list(fill = list(seq = "brewer.yl_gn", div = "brewer.rd_yl_gn", unord = "brewer.set3", ord = "brewer.yl_gn"),
+ col = list(seq = "brewer.yl_gn", div = "brewer.rd_yl_gn", unord = "brewer.set3", ord = "brewer.yl_gn")),
  attr.color = "black",
  space.color = "white",
  legend.frame = TRUE,
@@ -788,8 +788,8 @@ styles = list(
  fill = "#4C4C88",
  col = "#4C4C88",
  col.polygons = "#4C4C88"),
- values.var = list(fill = list(seq = "brewer.ylorrd", div = "brewer.rdylgn", unord = "brewer.set3", ord = "brewer.ylorrd"),
- col = list(seq = "brewer.ylorrd", div = "brewer.rdylgn", unord = "brewer.set3", ord = "brewer.ylorrd")),
+ values.var = list(fill = list(seq = "brewer.yl_or_rd", div = "brewer.rd_yl_gn", unord = "brewer.set3", ord = "brewer.yl_or_rd"),
+ col = list(seq = "brewer.yl_or_rd", div = "brewer.rd_yl_gn", unord = "brewer.set3", ord = "brewer.yl_or_rd")),
  attr.color = "#BFBFFF",
  basemaps = "CartoDB.DarkMatter",
  basemaps.alpha = .5),

R/tmap_style_catalogue.R

@@ -0,0 +1,111 @@
+#' Create a style catalogue
+#' 
+#' Create a style catalogue for each predefined tmap style. The result is a set of png images, one for each style.
+#' 
+#' @param path path where the png images are stored
+#' @param styles vector of styles function names (see \code{\link{tmap_style}}) for which a preview is generated. By default, a preview is generated for all loaded styles.
+#' @import grid
+#' @rdname tmap_style_catalogue
+#' @export
+tmap_style_catalogue <- function(path="./tmap_style_previews", styles=NA) {
+ # get all styles
+
+ styles <- get_style_names()
+
+ ns <- length(styles)
+
+ if (!file.exists(path)) dir.create(path, recursive=TRUE)
+
+ # load and process data
+ World <- metro <- rivers <- land <- NULL
+ data(World, metro, rivers, land, envir = environment())
+ metro$growth <- (metro$pop2020 - metro$pop2010) / (metro$pop2010 * 10) * 100
+
+ rivers <- sf::st_transform(rivers, st_crs(World))
+
+ pb <- txtProgressBar()
+
+ print_style <- function(style, i) {
+ on.exit(dev.off())
+ png(file.path(path, paste0(style, ".png")), width=1920, height=1080)
+ grid.newpage()
+ pushViewport(viewport(layout = grid.layout(3,3)))
+
+ # set progress bar init
+ pbi <- (i-1)/ns
+ pbii <- function(i) pbi + (i/9) * (1/ns)
+
+ # first column
+ print(tm_shape(World) +
+ tm_polygons() +
+ tm_text("iso_a3", size="AREA") +
+ tm_symbols() +
+ tm_shape(rivers) +
+ tm_lines() + 
+ tm_compass() +
+ tm_scale_bar() +
+ tm_style(style) + tm_format("World", title="Fixed aesthetics"),
+ vp = viewport(layout.pos.row = 1, layout.pos.col = 1))
+ setTxtProgressBar(pb, pbii(1))
+ print(tm_shape(World) +
+ tm_borders() + 
+ tm_text("name", size="AREA") +
+ tm_style(style) + tm_format("World", title="Polygon borders with text"),
+ vp = viewport(layout.pos.row = 2, layout.pos.col = 1))
+ setTxtProgressBar(pb, pbii(2))
+ print(tm_shape(rivers, bbox = bb(World)) +
+ tm_lines() + 
+ tm_style(style) + tm_format("World", title="Lines only"),
+ vp = viewport(layout.pos.row = 3, layout.pos.col = 1))
+ setTxtProgressBar(pb, pbii(3))
+
+ # second column
+ print(tm_shape(World) +
+ tm_polygons("MAP_COLORS", ncols=5) + 
+ tm_style(style) + tm_format("World", title="Map coloring"),
+ vp = viewport(layout.pos.row = 1, layout.pos.col = 2))
+ setTxtProgressBar(pb, pbii(4))
+ print(tm_shape(World) +
+ tm_polygons() + 
+ tm_shape(metro) +
+ tm_dots() + 
+ tm_grid(projection = 4326) +
+ tm_style(style) + tm_format("World", title="Dot map"),
+ vp = viewport(layout.pos.row = 2, layout.pos.col = 2))
+ setTxtProgressBar(pb, pbii(5))
+ print(tm_shape(World) +
+ tm_polygons() +
+ tm_shape(metro) +
+ tm_symbols(size = "pop2010", col = "growth", breaks = c(-Inf, -2, -1, -.5, .5, 1, 2, Inf), midpoint = 0) + tm_style(style) + tm_format("World", title="symbol map"),
+ vp = viewport(layout.pos.row = 3, layout.pos.col = 2))
+ setTxtProgressBar(pb, pbii(6))
+
+ # third column
+ print(tm_shape(World) +
+ tm_polygons("gdp_cap_est", breaks=c(0, 10000, 20000, 30000, 40000, 50000, Inf)) +
+ tm_text("iso_a3", size="AREA") + tm_style(style) + tm_format("World", title="Choropleth"),
+ vp = viewport(layout.pos.row = 1, layout.pos.col = 3))
+ setTxtProgressBar(pb, pbii(7))
+ print(tm_shape(World) +
+ tm_polygons("HPI", palette="div", n=9) +
+ tm_text("iso_a3", size="AREA") + tm_style(style) + tm_format("World", title="Choropleth (diverging)"),
+ vp = viewport(layout.pos.row = 2, layout.pos.col = 3))
+ setTxtProgressBar(pb, pbii(8))
+ print(tm_shape(World) +
+ tm_polygons("economy") +
+ tm_text("iso_a3", size="AREA") + tm_style(style) + tm_format("World", title="Categorical map"),
+ vp = viewport(layout.pos.row = 3, layout.pos.col = 3))
+ setTxtProgressBar(pb, pbii(9))
+ upViewport()
+ }
+
+ mapply(print_style, styles, 1:ns)
+ if (get("tmapOptions", envir = .TMAP)$show.messages) message("\nCatalogue created in ", normalizePath(path))
+ invisible()
+}
+
+#' @export
+#' @rdname tmap_style_catalogue
+tmap_style_catalog <- tmap_style_catalogue
+
+

R/v4-not-implemented.R

@@ -10,13 +10,3 @@ NULL
 tmap_tip <- function(...) {
  stop("Not yet implemented in v4")
 }
-#' @export
-#' @rdname v4-not-yet
-tmap_style_catalog <- function(...) {
- stop("Not yet implemented in v4")
-}
-#' @export
-#' @rdname v4-not-yet
-tmap_style_catalogue <- function(...) {
- stop("Not yet implemented in v4")
-}