improved continuous scaling, cartograms, and panels

NAMESPACE

@@ -121,6 +121,9 @@ export(get_fact_levels_na)
 export(make_by_vars)
 export(marker_icon)
 export(opt_tm_bubbles)
+export(opt_tm_cartogram)
+export(opt_tm_cartogram_dorling)
+export(opt_tm_cartogram_ncont)
 export(opt_tm_dots)
 export(opt_tm_labels)
 export(opt_tm_lines)

R/misc_other.R

@@ -72,7 +72,7 @@ completeDT2 = function(DT, cols, defs = NULL){
 } 
 
 cont_breaks = function(breaks, n=101) {
-	x = round(seq(1, 101, length.out=length(breaks)))
+	x = round(seq(1, n, length.out=length(breaks)))
 
 	unlist(lapply(1L:(length(breaks)-1L), function(i) {
 		y = seq(breaks[i], breaks[i+1], length.out=x[i+1]-x[i]+1)	

R/process_meta.R

@@ -40,8 +40,7 @@ preprocess_meta = function(o, cdt) {
 		isdef = !sapply(fl, is.null)
 		n = prod(nby)
 
-
-		if (is.na(panel.type)) panel.type = ifelse(((type == "page" || n == 1) && is.na(panel.labels[[1]])) || ((type %in% c("wrap", "stack")) && !isdef[1]) || (!(type %in% c("wrap", "stack")) && !isdef[1] && !isdef[2]), "none", 
+		if (is.na(panel.type)) panel.type = ifelse(((type == "page" || n == 1) && is.na(panel.labels[[1]])) || ((type %in% c("wrap", "stack")) && !isdef[1]) || (!(type %in% c("wrap", "stack")) && !isdef[1] && !isdef[2]) || !o$panel.show, "none", 
 										    ifelse((type %in% c("wrap", "stack")) || (n == 1), "wrap", "xtab"))
 
 		inner.margins = get_option_class(inner.margins, class = main_class)

R/step2_helper_data.R

@@ -88,16 +88,16 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
 		# active grouping variables (to keep)
 		grp_bv = by123__[sort(c({if (nvars > 1) v else integer(0)}, b))]
 
-		sfun = paste0("tmapValuesScale_", unm)
-		cfun = paste0("tmapValuesColorize_", unm)
+		sfun = paste0("tmapValuesScale_", nm)
+		cfun = paste0("tmapValuesColorize_", nm)
 
 		#print(vars)
 		if (!aes$data_vars && !aes$geo_vars) {
-			# cat("step2_grp_lyr_aes_const", unm," \n")
+			#cat("step2_grp_lyr_aes_const", unm," \n")
 			# constant values (take first value (of possible tm_mv per facet)
 			if (any(nvari) > 1) warning("Aesthetic values considered as direct visual variables, which cannot be used with tm_mv", call. = FALSE)
 			val1 = sapply(vars, "[[", 1, USE.NAMES = FALSE)
-			check_fun = paste0("tmapValuesCheck_", unm)
+			check_fun = paste0("tmapValuesCheck_", nm)
 			check = do.call(check_fun, list(x = val1))
 			if (!check) {
 				# to do: add "layer" name e.g. tm_fill is still "polygons" and not "fill"
@@ -138,7 +138,7 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
 			if (any(!dtl$sel__) || !q$drop.units) {
 				# also needed for drop.units later on
 				cls = data_class(dtl[[nm]])
-				value.null = getAesOption("value.null", o, unm, layer, cls = cls)
+				value.null = getAesOption("value.null", o, nm, layer, cls = cls)
 				value.null = do.call(sfun, list(x = value.null, scale = o$scale))
 				value.null = do.call(cfun, list(x = value.null, pc = o$pc))
 
@@ -162,6 +162,8 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
 
 			dtl_leg = dtl[, .SD[1], by = c(grp_bv)][, tmapID__ := NULL][, legnr := (vapply(get(..nm), function(s) legend_save(list(vneutral = s)), FUN.VALUE = integer(1)))][, crtnr := (vapply(get(..nm), function(s) chart_save(list()), FUN.VALUE = integer(1)))][, (nm) := NULL]
 		} else {
+			#cat("step2_grp_lyr_aes_var", nm," \n")
+
 			relevant_vars = c("tmapID__", "sel__" , vars, by123__[b])
 			dtl = copy(dt[, relevant_vars, with = FALSE])
 
@@ -271,12 +273,12 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
 
 				#aesname = aes$aes
 				value.null = if ("value.null" %in% names(s)) s$value.null else {
-					vn = getAesOption("value.null", o, unm, layer, cls = cls)
+					vn = getAesOption("value.null", o, nm, layer, cls = cls)
 					vn = do.call(sfun, list(x = vn, scale = o$scale))
 					do.call(cfun, list(x = vn, pc = o$pc))
 				}
 
-				arglist = list(scale = s, legend = l, chart = crt, o = o, aes = unm, 
+				arglist = list(scale = s, legend = l, chart = crt, o = o, aes = nm, 
 							   layer = layer, 
 							   layer_args = args,
 							   sortRev = sortRev, 

R/step4_plot.R

@@ -470,7 +470,7 @@ step4_plot = function(tm, vp, return.asp, show, knit, args) {
 
 		# determine row and col ids	
 
-		if (o$panel.type == "xtab") {
+		if (o$type == "grid") {
 			d[, row := as.integer((i - 1) %% o$nrows + 1)]
 			d[, col := as.integer((((i - 1) %/% o$nrows + 1) - 1) %% o$ncols + 1)]
 		} else {

R/tm_layers_cartogram.R

@@ -1,5 +1,8 @@
 #' @rdname tm_cartogram
 #' @name opt_tm_cartogram
+#' @param type cartogram type, one of: "cont" for contiguous cartogram, "ncont" for non-contiguous cartogram and "dorling" for Dorling cartograms
+#' @param itermax, maximum number of iterations (see [cartogram::cartogram_cont()])
+#' @param ... arguments passed on to [cartogram::cartogram_cont()]
 #' @export
 opt_tm_cartogram = function(type = "cont",
 							itermax = 15,
@@ -11,6 +14,8 @@ opt_tm_cartogram = function(type = "cont",
 
 #' @rdname tm_cartogram
 #' @name opt_tm_cartogram
+#' @param expansion factor expansion, see [cartogram::cartogram_ncont()] (argument `k`)
+#' @param inplace should each polygon be modified in its original place? (`TRUE` by default)
 #' @export
 opt_tm_cartogram_ncont = function(type = "ncont",
 								  expansion = 1,
@@ -25,6 +30,7 @@ opt_tm_cartogram_ncont = function(type = "ncont",
 
 #' @rdname tm_cartogram
 #' @name opt_tm_cartogram
+#' @param share share of the bounding box filled with the larger circle (see [cartogram::cartogram_dorling()] argument `k`)
 #' @export
 opt_tm_cartogram_dorling = function(type = "dorling",
 									share = 5,

R/tmapGridComp_leg_landscape.R

@@ -256,15 +256,15 @@ tmapGridLegPlot.tm_legend_standard_landscape = function(comp, o, fH, fW) {
 			id1 = which(!is.na(fill_list[[1]]))[1]
 			id2 = tail(which(!is.na(fill_list[[nlev2]])), 1)
 
-			x1 = ((id1-1) / 10) / nlev2
-			x2 = (id2 / 10) / nlev2 + ((nlev2-1)/nlev2)
+			x1 = ((id1-1) / o$nvv) / nlev2
+			x2 = (id2 / o$nvv) / nlev2 + ((nlev2-1)/nlev2)
 			w = x2 - x1
 
 			if (vary_fill) {
-				cols = unlist(fill_list)[id1:(10*(nlev2-1) + id2)]
+				cols = unlist(fill_list)[id1:(o$nvv*(nlev2-1) + id2)]
 				cols_alph = paste0(cols, num_to_hex(gp$fill_alpha[1] * 255))
 			} else {
-				alph = unlist(alpha_list)[id1:(10*(nlev2-1) + id2)]
+				alph = unlist(alpha_list)[id1:(o$nvv*(nlev2-1) + id2)]
 				cols_alph = paste0(col2hex(gp$fill[1]), num_to_hex(alph * 255))
 			}
 			grItems1 = list(gridCell(6, comp$item_ids[lvs], grid::rectGrob(x = x1 + 0.5*w, width= w, gp=gpar(fill = grid::linearGradient(colours = cols_alph), col = NA))))
@@ -279,11 +279,11 @@ tmapGridLegPlot.tm_legend_standard_landscape = function(comp, o, fH, fW) {
 		}
 
 		if (vary_fill) {
-			x1 = (sum(is.na(fill_list[[1]])) * .1) / nlev2
-			x2 = (sum(is.na(fill_list[[nlev2]])) * .1) / nlev2
+			x1 = (sum(is.na(fill_list[[1]])) / o$nvv) / nlev2
+			x2 = (sum(is.na(fill_list[[nlev2]])) / o$nvv) / nlev2
 		} else {
-			x1 = (sum(is.na(alpha_list[[1]])) * .1) / nlev2
-			x2 = (sum(is.na(alpha_list[[nlev2]])) * .1) / nlev2
+			x1 = (sum(is.na(alpha_list[[1]])) / o$nvv) / nlev2
+			x2 = (sum(is.na(alpha_list[[nlev2]])) / o$nvv) / nlev2
 		}
 
 

R/tmapGridComp_leg_portrait.R

@@ -7,7 +7,7 @@ tmapGridCompPrepare.tm_legend_standard_portrait = function(comp, o) {
 
 		type = if ("biv" %in% names(attributes(gp$fill))) {
 			"bivariate"
-		} else if (!is.na(gp$fill[1]) && any(nchar(gp$fill) > 50) || !is.na(gp$fill_alpha[1]) && any(nchar(gp$fill_alpha) > 50)) {
+		} else if (!is.na(gp$fill[1]) && any(nchar(gp$fill) > 20) || !is.na(gp$fill_alpha[1]) && any(nchar(gp$fill_alpha) > 20)) {
 			"gradient"
 		} else if (!is.na(gp$shape[1])) {
 			"symbols"
@@ -423,15 +423,15 @@ tmapGridLegPlot.tm_legend_standard_portrait = function(comp, o, fH, fW) {
 			id1 = which(!is.na(fill_list[[1]]))[1]
 			id2 = tail(which(!is.na(fill_list[[nlev2]])), 1)
 
-			y1 = 1 - ((id1-1) / 10) / nlev2
-			y2 = 1 - ((id2 / 10) / nlev2 + ((nlev2-1)/nlev2))
+			y1 = 1 - ((id1-1) / o$nvv) / nlev2
+			y2 = 1 - ((id2 / o$nvv) / nlev2 + ((nlev2-1)/nlev2))
 			h = y1 - y2
 
 			if (vary_fill) {
-				cols = unlist(fill_list)[id1:(10*(nlev2-1) + id2)]
+				cols = unlist(fill_list)[id1:(o$nvv*(nlev2-1) + id2)]
 				cols_alph = paste0(cols, num_to_hex(gp$fill_alpha[1] * 255))
 			} else {
-				alph = unlist(alpha_list)[id1:(10*(nlev2-1) + id2)]
+				alph = unlist(alpha_list)[id1:(o$nvv*(nlev2-1) + id2)]
 				cols_alph = paste0(col2hex(gp$fill[1]), num_to_hex(alph * 255))
 			}
 			grItems1 = list(gridCell(comp$item_ids[lvs], 3, grid::rectGrob(y = y2 + 0.5*h, height= h, gp=gpar(fill = grid::linearGradient(colours = rev(cols_alph)), col = NA))))
@@ -448,11 +448,11 @@ tmapGridLegPlot.tm_legend_standard_portrait = function(comp, o, fH, fW) {
 
 
 		if (vary_fill) {
-			y1 = (sum(is.na(fill_list[[1]])) * .1) / nlev2
-			y2 = (sum(is.na(fill_list[[nlev2]])) * .1) / nlev2
+			y1 = (sum(is.na(fill_list[[1]])) /o$nvv) / nlev2
+			y2 = (sum(is.na(fill_list[[nlev2]])) /o$nvv) / nlev2
 		} else {
-			y1 = (sum(is.na(alpha_list[[1]])) * .1) / nlev2
-			y2 = (sum(is.na(alpha_list[[nlev2]])) * .1) / nlev2
+			y1 = (sum(is.na(alpha_list[[1]])) /o$nvv) / nlev2
+			y2 = (sum(is.na(alpha_list[[nlev2]])) /o$nvv) / nlev2
 		}
 
 		grItems2 = list(gridCell(comp$item_ids[lvs], 3, rndrectGrob(y = grid::unit(y2, "npc"), just = c("center", "bottom"), height = grid::unit(1-(y1+y2), "npc"), gp = gpars, r = comp$item.r)))

R/tmapGridInit.R

@@ -12,8 +12,8 @@ tmapGridInit = function(o, return.asp = FALSE, vp) {
 			  grid.buffers.top = grid.buffers[3],
 			  grid.margins.top = grid.margins[3],
 
-			  {if (o$nrows > 1) rep(c(panel.wrap.size[3], 0, panel.wrap.size[1], between.marginH), o$nrows -1) else NULL},
-			  panel.wrap.size[3], 0, panel.wrap.size[1],
+			  {if (o$nrows > 1) rep(c(panel.wrap.size[3], panel.wrap.margin[3], 0, panel.wrap.margin[1], panel.wrap.size[1], between.marginH), o$nrows -1) else NULL},
+			  panel.wrap.size[3], panel.wrap.margin[3], 0, panel.wrap.margin[1], panel.wrap.size[1],
 
 			  grid.margins.bottom = grid.margins[1],
 			  grid.buffers.bottom = grid.buffers[1],
@@ -43,8 +43,8 @@ tmapGridInit = function(o, return.asp = FALSE, vp) {
 			  grid.buffers.left = grid.buffers[2],
 			  grid.margins.left = grid.margins[2],
 
-			  {if (o$ncols > 1) rep(c(panel.wrap.size[2], 0,  panel.wrap.size[4], between.marginW), o$ncols -1) else NULL},
-			  panel.wrap.size[2], 0, panel.wrap.size[4],
+			  {if (o$ncols > 1) rep(c(panel.wrap.size[2], panel.wrap.margin[2], 0,  panel.wrap.margin[4], panel.wrap.size[4], between.marginW), o$ncols -1) else NULL},
+			  panel.wrap.size[2], panel.wrap.margin[2], 0, panel.wrap.margin[4], panel.wrap.size[4],
 
 			  grid.margins.left = grid.margins[4],
 			  grid.buffers.left = grid.buffers[4],
@@ -65,8 +65,8 @@ tmapGridInit = function(o, return.asp = FALSE, vp) {
 	nr = length(rows)
 	nc = length(cols)
 
-	cols_facet_ids = 1:o$ncols * 4 + 7
-	rows_facet_ids = 1:o$nrows * 4 + 7
+	cols_facet_ids = 1:o$ncols * 6 + 6
+	rows_facet_ids = 1:o$nrows * 6 + 6
 
 	#if (o$panel.type == "xtab") {
 	cols_panel_col_ids = cols_facet_ids
@@ -75,8 +75,8 @@ tmapGridInit = function(o, return.asp = FALSE, vp) {
 	rows_panel_row_ids = rows_facet_ids
 	rows_panel_col_id = ifelse(o$panel.xtab.pos[1] == "left", 6, nc - 5)
 	#} else if (o$panel.type == "wrap") {
-	cols_panel_ids = cols_facet_ids + ifelse(o$panel.wrap.pos  == "left", -1, ifelse(o$panel.wrap.pos  == "right", 1, 0))
-	rows_panel_ids = rows_facet_ids + ifelse(o$panel.wrap.pos  == "top", -1, ifelse(o$panel.wrap.pos  == "bottom", 1, 0))
+	cols_panel_ids = cols_facet_ids + ifelse(o$panel.wrap.pos  == "left", -2, ifelse(o$panel.wrap.pos  == "right", 2, 0))
+	rows_panel_ids = rows_facet_ids + ifelse(o$panel.wrap.pos  == "top", -2, ifelse(o$panel.wrap.pos  == "bottom", 2, 0))
 
 	panel_col_rot = 0
 	panel_row_rot = ifelse(o$panel.xtab.pos[1] == "left", 90, 270)

R/tmapGridWrap.R

@@ -8,21 +8,26 @@ tmapGridWrap = function(label, facet_row, facet_col, facet_page, o) {
 	row = g$rows_panel_ids[facet_row]
 	col = g$cols_panel_ids[facet_col]
 
-	frame.col = if (isFALSE(o$frame)) o$attr.color else if (isTRUE(o$frame)) o$attr.color else o$frame
+	frame.col = if (isFALSE(o$panel.label.frame)) o$attr.color else if (isTRUE(o$panel.label.frame)) o$attr.color else o$panel.label.frame
+
+	frame.show = !isFALSE(o$panel.label.frame)
 
 	#scale = o$scale * o$scale_down
 
-	gpar_rect = grid::gpar(fill = o$panel.label.bg.color, lwd=o$frame.lwd * o$scale, col = o$frame)
+	if (frame.show) {
+		gpar_rect = grid::gpar(fill = o$panel.label.bg.color, lwd=o$panel.label.frame.lwd * o$scale, col = frame.col)
+	} 
 	gpar_text = rescale_gp(grid::gpar(cex = o$panel.label.size * o$scale, col = o$panel.label.color, fontfamily = o$panel.label.fontfamily, fontface = o$panel.label.fontface), o$scale_down)
 
 	# resize due to not fitting
 	gpar_text$cex = determine_scale(label = label, rot = rot, row = row, col = col, g = g, scale = gpar_text$cex)
 	grb = grid::grobTree(
-		rndrectGrob(gp = gpar_rect, r = o$frame.r * o$scale),
+		if (frame.show) {
+			rndrectGrob(gp = gpar_rect, r = o$panel.label.frame.r * o$scale)
+		} else NULL,
 		grid::textGrob(label = label, rot = rot, gp = gpar_text)
 	)
-
-
+
 	gt = add_to_gt(gt, grb, row = row, col = col)
 
 	gts[[facet_page]] = gt

R/tmapGrid_misc.R

@@ -74,7 +74,7 @@ gp_to_gpar = function(gp, id = NULL, sel = "all", split_to_n = NULL, pick_middle
 			if (pick_middle) {
 				x = sapply(x, function(i) {
 					if (all(is.na(i))) NA else {
-						sq = c(5,6,4,7,3,8,2,9,1,10) # priority for middle values
+						sq = (o$nvv/2) + (rep(0:5,each=2) * c(1,-1))[-1] # priority for middle values
 						i[sq[which(!is.na(i)[sq])[1]]]
 					}
 				})