working on cartogram

R/step2_helper_data.R

@@ -284,16 +284,16 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
  submit_legend = TRUE)
  if (!all(dtl$sel__)) {
  if (bypass_ord) {
- dtl[, c(varname, legname, crtname) := list(value.null, 0L)]
+ dtl[, c(varname, legname, crtname) := list(value.null, 0L, 0L)]
  } else {
- dtl[, c(varname, ordname, legname, crtname) := list(value.null, -1L, 0L)] 
+ dtl[, c(varname, ordname, legname, crtname) := list(value.null, -1L, 0L, 0L)] 
  }
 
  if (is.na(value.null)) stop("value.null not specified for aesthetic ", nm, call. = FALSE)
  if (bypass_ord) {
- dtl[sel__ == TRUE, c(varname, legname) := do.call(f, c(unname(.SD), arglist)), grp_b_fr, .SDcols = v]
+ dtl[sel__ == TRUE, c(varname, legname, crtname) := do.call(f, c(unname(.SD), arglist)), grp_b_fr, .SDcols = v]
  } else {
- dtl[sel__ == TRUE, c(varname, ordname, legname) := do.call(f, c(unname(.SD), arglist)), grp_b_fr, .SDcols = v]
+ dtl[sel__ == TRUE, c(varname, ordname, legname, crtname) := do.call(f, c(unname(.SD), arglist)), grp_b_fr, .SDcols = v]
  }
  } else {
  if (bypass_ord) {
@@ -308,7 +308,6 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
  names(levs) = grp_bv
  dtl = completeDT2(dtl, cols = c(list("tmapID__" = unique(dtl$tmapID__)), levs), defs = imp)
  }
-
  dtl
  }
 

R/tm_layers_cartogram.R

@@ -1,3 +1,41 @@
+#' @rdname tm_cartogram
+#' @name opt_tm_cartogram
+#' @export
+opt_tm_cartogram = function(type = "cont",
+ itermax = 15,
+ ...) {
+ list(cartogram = list(mapping.args = list(),
+ trans.args = list(type = type, itermax = itermax)),
+ polygons = do.call(opt_tm_polygons, list(...)))
+}
+
+#' @rdname tm_cartogram
+#' @name opt_tm_cartogram
+#' @export
+opt_tm_cartogram_ncont = function(type = "ncont",
+ expansion = 1,
+ inplace = FALSE,
+ ...) {
+
+ list(cartogram = list(mapping.args = list(),
+ trans.args = list(type = type, expansion = expansion, inplace = inplace)),
+ polygons = do.call(opt_tm_polygons, list(...)))
+}
+
+
+#' @rdname tm_cartogram
+#' @name opt_tm_cartogram
+#' @export
+opt_tm_cartogram_dorling = function(type = "dorling",
+ share = 5,
+ itermax = 1000,
+ ...) {
+ list(cartogram = list(mapping.args = list(),
+ trans.args = list(type = type, share = share, itermax = itermax)),
+ polygons = do.call(opt_tm_polygons, list(...)))
+}
+
+
 #' Map layer: cartogram
 #' 
 #' Map layer that draws a cartogram
@@ -6,7 +44,7 @@
 #' determines the size of the polygons.
 #' @param plot.order Specification in which order the spatial features are drawn.
 #' See [tm_plot_order()] for details.
-#' @param trans.args lists that are passed on to internal transformation function
+#' @param options options passed on to the corresponding `opt_<layer_function>` function 
 #' @inheritDotParams tm_polygons
 #' @export
 tm_cartogram = function(size = 1,
@@ -15,26 +53,66 @@ tm_cartogram = function(size = 1,
  size.chart = tm_chart_none(),
  size.free = NA,
  plot.order = tm_plot_order("size", reverse = FALSE),
- trans.args = list(type = "cont", itermax = 15),
+ options = opt_tm_cartogram(),
  ...) {
  po = plot.order
  #trans.args$type = match.arg(trans.args$type)
 
  # types: "cont", "ncont", "dorling"
 
- tmp = do.call(tm_polygons, list(...))
+ tmp = do.call(tm_polygons, c(list(...), list(options = options$polygons)))
  tmp[[1]] = within(tmp[[1]], {
  trans.fun = tmapTransCartogram
- trans.args = get("trans.args", envir = parent.env(environment()))
+ trans.args = options$cartogram$trans.args
  trans.aes = list(size = tmapScale(aes = "area",
  value = size,
  scale = size.scale,
  legend = size.legend,
  chart = size.chart,
  free = size.free))
  tpar = tmapTpar(area = "__area")
- trans.isglobal = TRUE
+ trans.isglobal = FALSE
  plot.order = po
  })
  tmp
 }
+
+
+tm_cartogram_ncont = function(size = 1,
+ size.scale = tm_scale(),
+ size.legend = tm_legend_hide(),
+ size.chart = tm_chart_none(),
+ size.free = NA,
+ plot.order = tm_plot_order("size", reverse = FALSE),
+ options = opt_tm_cartogram_ncont(),
+ ...) {
+ args = list(...)
+ do.call(tm_cartogram, c(list(size = size,
+ size.scale = size.scale,
+ size.legend = size.legend,
+ size.chart = size.chart,
+ size.free = size.free,
+ plot.order = plot.order,
+ options = options), args))
+}
+
+
+
+tm_cartogram_dorling = function(size = 1,
+ size.scale = tm_scale(),
+ size.legend = tm_legend_hide(),
+ size.chart = tm_chart_none(),
+ size.free = NA,
+ plot.order = tm_plot_order("size", reverse = FALSE),
+ options = opt_tm_cartogram_dorling(),
+ ...) {
+ args = list(...)
+ do.call(tm_cartogram, c(list(size = size,
+ size.scale = size.scale,
+ size.legend = size.legend,
+ size.chart = size.chart,
+ size.free = size.free,
+ plot.order = plot.order,
+ options = options), args))
+}
+

R/tm_layers_text.R

@@ -493,7 +493,6 @@ tm_labels = function(text = tm_const(),
  angle.legend = tm_legend_hide(),
  angle.chart = tm_chart_none(),
  angle.free = NA,
- shadow = FALSE,
  plot.order = tm_plot_order("AREA", reverse = FALSE, na.order = "bottom"),
  zindex = NA,
  group = NA,

R/tm_shape.R

@@ -30,6 +30,7 @@
 #' @importFrom rlang missing_arg expr
 #' @importFrom grDevices col2rgb colorRampPalette colors dev.off dev.size png rgb
 #' @import utils
+#' @example ./examples/tm_shape.R 
 #' @export
 tm_shape = function(shp, 
  bbox = NULL,

R/tmapTrans.R

@@ -248,15 +248,17 @@ tmapTransCartogram = function(shpTM, area, ord__, plot.order, args, scale) {
  message("Cartogram in progress...")
 
  x = sf::st_sf(geometry = s, weight = area, tmapID__ = shpTM$tmapID)
+ x = x[x$weight > 0,]
 
+
  rlang::check_installed("cartogram")
 
  if (args$type == "cont") {
  shp = suppressMessages(suppressWarnings({cartogram::cartogram_cont(x, weight = "weight", itermax = args$itermax)}))
  } else if (args$type == "ncont") {
- shp = suppressMessages(suppressWarnings({cartogram::cartogram_ncont(x, weight = "weight")}))
+ shp = suppressMessages(suppressWarnings({cartogram::cartogram_ncont(x, weight = "weight", k = args$expansion, inplace = args$inplace)}))
  } else if (args$type == "dorling") {
- shp = suppressMessages(suppressWarnings({cartogram::cartogram_dorling(x, weight = "weight")}))
+ shp = suppressMessages(suppressWarnings({cartogram::cartogram_dorling(x, weight = "weight", k = args$share, itermax = args$itermax)}))
  } else {
  stop("unknown cartogram type", call. = FALSE)
  }

examples/tm_cartogram.R

@@ -0,0 +1,23 @@
+Africa = World[World$continent == "Africa", ]
+
+#step3 L50: to do: trans.isglobal needs another variant trans.apply_from_here
+tm_shape(Africa, crs = "+proj=robin") + 
+ tm_cartogram(size = "pop_est", options = opt_tm_cartogram(itermax = 15)) +
+ tm_text("name")
+
+
+tm_shape(Africa, crs = "+proj=robin") + 
+ tm_cartogram_ncont(size = "pop_est", options = opt_tm_cartogram_ncont()) +
+ tm_text("name")
+
+tm_shape(World, crs = "+proj=robin") +
+ tm_polygons() +
+ tm_cartogram_ncont(size = "pop_est", fill = "yellow")
+
+
+# to do: make output like this:
+W = cartogram_ncont(World |> st_transform("+proj=robin"), weight = "pop_est")
+tm_shape(World, crs = "+proj=robin") +
+ tm_polygons() +
+tm_shape(W) +
+ tm_polygons(fill = "yellow")

examples/tm_shape.R

@@ -0,0 +1,2 @@
+tm_shape(World, crs = "+proj=robin", filter = World$continent=="Africa") + 
+ tm_polygons()