#930

R/step1_helper_facets.R

@@ -242,7 +242,8 @@ step1_rearrange_facets = function(tmo, o) {
 				if (length(popup.vars)) add_used_vars(popup.vars)
 
 
-				if (length(popup.format) != 0 && all(names(popup.format) %in% popup.vars)) {
+				if (length(popup.format) != 0 && !is.null(names(popup.format)) && all(names(popup.format) %in% popup.vars)) {
+					popup.called = names(popup.format)
 					popup.format = lapply(popup.vars, function(pv) {
 						if (pv %in% names(popup.format)) {
 							process_label_format(popup.format[[pv]], o$label.format)
@@ -251,12 +252,14 @@ step1_rearrange_facets = function(tmo, o) {
 						}
 					})
 				} else {
+					popup.called = character(0)
 					one.popup.format = process_label_format(popup.format, o$label.format)
 					popup.format = lapply(popup.vars, function(pv) {
 						one.popup.format
 					})
 				}
 				names(popup.format) = popup.vars
+				attr(popup.format, "called") = popup.called
         if (length(hover) > 1) {
           stop("hover should have length <= 1", call. = FALSE)
         }

R/step2_data.R

@@ -1,33 +1,33 @@
 step2_data = function(tm) {
 	dev = getOption("tmap.devel.mode")
-	
+
 	tmo = tm$tmo
 	o = tm$o
 	aux = tm$aux
 	cmp = tm$cmp
 	prx = tm$prx
-	
+
 	if (is.null(tmo)) {
 		return(	list(tmo = NULL, aux = aux, cmp = cmp, prx = prx, o = o))
 	}
-	
+
 	groupnames = paste0("group", seq_along(tmo))
 	fl = list(1L, 1L, 1L)
 	assign("fl", fl, envir = .TMAP)
-	
+
 	# to reset the legends (which are  temporarily stored in .TMAP environment)
 	legends_init()
 	charts_init()
-	
+
 	grps = lapply(tmo, function(tmg) {
 		tmf = tmg$tmf
 		dt = tmg$tms$dt
 
 		if ("by1__" %in% names(dt) && o$rev1) dt[, by1__ := (o$fn[1]+1L)-by1__]
 		if ("by2__" %in% names(dt) && o$rev2) dt[, by2__ := (o$fn[2]+1L)-by2__]
 		if ("by3__" %in% names(dt) && o$rev3) dt[, by3__ := (o$fn[3]+1L)-by3__]
-		
-				
+
+
 		if (o$facet.flip && !o$type %in% c("wrapstack", "wrap", "stack")) {
 			if ("by2__" %in% names(dt)) {
 				dt[, by2b__:= by2__]
@@ -52,25 +52,26 @@ step2_data = function(tm) {
 				#fn = fn[c(2,1,3)]
 			})
 		}
-		
+
 		shpvars = tmg$tms$smeta$vars
 
 		# step2_data_grp_prepare
 		#tmf_meta = step2_data_grp_prepare(tmg$tmf, grpvars, dt)
-		
+
 		layernames = paste0("layer", seq_along(tmg$tmls))
 		lrs = lapply(tmg$tmls, function(tml) {
 			#cat("step2_grp_lyr======================\n")
-			
+
 			gp = tml$gpar
 			tp = tml$tpar
-			
+
 			plot.order = tml$plot.order
-			
+
 			group = if (is.na(tml$group)) tmg$tms$shp_name else as.character(tml$group)
 			group.control = as.character(tml$group.control)
-
-
+
+			.TMAP$popup.format = tml$popup.format
+
 			# args will be passed on to the scale functions (in case needed)
 			# they also will be used in step 3 (trans) and step 4 (mapping)
 			trans = mapply(getdts, tml$trans.aes, names(tml$trans.aes), SIMPLIFY = FALSE, MoreArgs = list(p = tp, q = tmf, o = o, dt = dt, shpvars = shpvars, layer = tml$layer, group = group, mfun = tml$mapping.fun, args = tml$trans.args, plot.order = plot.order))
@@ -79,13 +80,13 @@ step2_data = function(tm) {
 
 			dts_trans = cbind_dts(lapply(trans, function(x) x$dt), plot.order)
 			trans_legend = lapply(trans, function(x) x$leg)
-			
+
 			dts_mapping = cbind_dts(lapply(mapping, function(x) x$dt), plot.order)
 			mapping_legend = lapply(mapping, function(x) x$leg)
 			if (dev) timing_add(s4 = "combine")
 			if (dev) timing_add(s3 = paste0("layer ", tml$layer))
-			
-			
+
+
 			popup.data = if (!length(tml$popup.vars)) {
 				NULL
 			} else {
@@ -101,71 +102,76 @@ step2_data = function(tm) {
 			} else {
 				as.character(dt[[tml$id]])
 			}
-
-
-			list(trans_dt = dts_trans, 
-				 trans_legend = trans_legend, 
+
+			format_called = attr(tml$popup.format, "called")
+			if (length(format_called) > 0L) {
+				.TMAP$popup.format[format_called] = tml$popup.format[format_called]
+			}
+
+
+			list(trans_dt = dts_trans,
+				 trans_legend = trans_legend,
 				 trans_fun = tml$trans.fun,
 				 trans_args = tml$trans.args,
 				 trans_isglobal = tml$trans.isglobal,
-				 mapping_dt = dts_mapping, 
+				 mapping_dt = dts_mapping,
 				 mapping_legend = mapping_legend,
 				 mapping_fun = tml$mapping.fun,
 				 mapping_args = tml$mapping.args,
 				 lid = tml$lid,
 				 group = group,
 				 group.control = group.control,
 				 popup.data = popup.data,
-				 popup.format = tml$popup.format,
+				 popup.format = .TMAP$popup.format,
 				 hover.data = hover.data,
 				 id.data = id.data,
 				 plot.order = plot.order, # passed on for step 3 non-data driven transformation
 				 gp = gp,
 				 tp = tp)
 		})
 		if (length(lrs)) names(lrs) = layernames
-		
+
 		shpDT = data.table(shpTM = list(tmg$tms$shpTM))
 		if (dev) timing_add(s2 = "group")
-		
+
 		list(layers = lrs, shpDT = shpDT)
 	})
 	names(grps) = groupnames
 	#attr(grps, "fl") = fl
 	#attr(grps, "main") = attr(tmo, "main")
 	#attr(grps, "crs") = attr(tmo, "crs")
-	
+
 	#tmf = get_tmf(lapply(tmo, function(tmoi) tmoi$tmf))
-	
-	
-	
+
+
+
 	# facet labels "_old' were obtained in step2, and still determine data levels
 	# currently, facet labels are determined in step1, but they need to be the same as the data labels
 	# o$fl_old = get("fl", envir = .TMAP)
-	# o$fn_old = sapply(o$fl_old, function(f) { 
+	# o$fn_old = sapply(o$fl_old, function(f) {
 	# 	if (is.character(f)) length(f) else f
 	# })
 	# o$fl_old = lapply(o$fl_old, function(f) {
 	# 	if (is.character(f)) f else NULL
 	# })
-	# 
+	#
 	# if (!identical(o$fn, o$fn_old) || !identical(o$fl, o$fl_old)) {
 	# 	po(o$fn_old, o$fl_old, o$fn, o$fl)
 	# 	stop("fl not identical")
 	# }
-	
-	
-	
+
+
+
 	#cat("fl old:\n")
 	#print(o$fl_old)
-	
-	
+
+
 	#o = c(o, tmf)
-	
+
 	# attr(grps, "is.wrap") = tmo[[1]]$tmf$is.wrap
 	# attr(grps, "nrows") = tmo[[1]]$tmf$nrows
 	# attr(grps, "ncols") = tmo[[1]]$tmf$ncols
-	
+
 	o = within(o, {
 		if (rev1) fl[[1]][] = rev(fl[[1]][])
 		if (rev2) fl[[2]][] = rev(fl[[2]][])