#952

R/tm_vars.R

@@ -1,10 +1,10 @@
 #' tmap function to specify variables
-#' 
+#'
 #' tmap function to specify all variables in the shape object
-#' 
+#'
 #' @param x variable names, variable indices, or a dimension name
 #' @param dimvalues dimension values
-#' @param n if specified the first `n` variables are taken (or the first `n` dimension values) 
+#' @param n if specified the first `n` variables are taken (or the first `n` dimension values)
 #' @param multivariate in case multiple variables are specified, should they serve as facets (FALSE) or as a multivariate visual variable?
 #' @export
 tm_vars = function(x = NA, dimvalues = NULL, n = NA, multivariate = FALSE) {
@@ -15,23 +15,30 @@ tm_vars = function(x = NA, dimvalues = NULL, n = NA, multivariate = FALSE) {
 # process visual variable specification. Can either be tmapVars (output of tm_vars) or a list of values.
 tmapVV = function(x) {
 	if (inherits(x, c("tmapOption", "tmapVars"))) return(x)
-	
+
 	# if (inherits(x, "tm_shape_vars")) return(structure(list(ids = x$ids, n = x$n), class = "tmapShpVars"))
 	# if (inherits(x, "tm_mv_shape_vars")) return(structure(list(ids = x$ids, n = x$n), class = "tmapMVShpVars"))
 	# if (inherits(x, "tmapDimVars")) return(x)
-	
+
 	cls = if (inherits(x, "AsIs")) "tmapAsIs" else if (inherits(x, "tmapUsrCls")) "tmapUsrCls" else "tbd"
-	
+
 	isL = is.list(x)
+	isNestedL = isL && any(vapply(x, is.list, FUN.VALUE = logical(1)))
 	isSpecialL = isL && !setequal(class(x), "list")
 	isSpecialNestedL = isL && is.list(x[[1]]) &&  !setequal(class(x[[1]]), "list")
 	if (!isL) {
 		x = as.list(x)
 	} else if (isSpecialL) {
 		x = list(x)
 	}
-
-	if (cls == "tbd") cls = if (isSpecialL) "tmapSpecial" else if (isSpecialNestedL) "tmapSpecial" else "tmapStandard"
 
-	structure(x, names = x, class = cls)
-}
+	if (cls == "tbd") cls = if (isSpecialL || isSpecialNestedL || isNestedL) "tmapSpecial" else "tmapStandard"
+
+	if (cls == "tmapSpecial") {
+		nms = seq_along(x)
+	} else {
+		nms = x
+	}
+
+	structure(x, names = nms, class = cls)
+}

R/tmapGridSymbols.R

@@ -88,11 +88,18 @@ tmapGridSymbols = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page,
 													 width=unit(size, "lines"),
 													 height=unit(size, "lines")))
 				} else {
+					gpi = structure(lapply(gp, function(x) {
+						if (length(x) == 1L) {
+							x
+						} else {
+							x[i]
+						}
+					}), class = "gpar")
 					pointsGrob(x=grid::unit(coords[i,1] + justx * gp$size[i], "native"),
 							   y=grid::unit(coords[i,2] + justx * gp$size[i], "native"),
 							   size=unit(gp$size[i], "lines"),
 							   pch=shi,
-							   gp=gp)
+							   gp=gpi)
 				}
 			})
 			grb = gTree(children=do.call(gList, grobs), name=paste0("symbols_", id))

R/tmapLeaflet_layers.R

@@ -223,21 +223,19 @@ tmapLeafletSymbols = function(shpTM, dt, pdt, popup.format, hdt, idt, gp, bbx, f
 		sid = which(is_num)
 		nid = which(!is_num)
 
-		gp2$shape[sid] = "circle" # as dummy
+		gp2$shape[sid] = paste0("icon", seq_along(sid))
 
 		# faster than symbols2 = do.call(makeSymbolIcons2, gp2)
-		symbols = local({
-			gp2df = as.data.table(gp2)
-			gp2dfU = unique(gp2df)
+		gp2df = as.data.table(gp2)
+		gp2dfU = unique(gp2df)
 
-			symb = do.call(makeSymbolIcons2, as.list(gp2dfU))
+		symbols = do.call(makeSymbolIcons2, as.list(gp2dfU))
 
-			gp2dfU[, id:=1L:.N]
-			gp2join = gp2df[gp2dfU, on=names(gp2df)]
-			ids = gp2join$id
+		gp2dfU[, id:=1L:.N]
+		gp2join = gp2df[gp2dfU, on=names(gp2df)]
+		ids = gp2join$id
 
-			lapply(symb, function(s) s[ids])
-		})
+		symbols = lapply(symb, function(s) s[ids])
 
 		symbols$iconWidth = rep(NA, length(symbols$iconUrl))
 		symbols$iconHeight = rep(NA, length(symbols$iconUrl))