migrated tm_logo

NAMESPACE

@@ -24,6 +24,7 @@ S3method(tmapGridCompHeight,tm_compass)
 S3method(tmapGridCompHeight,tm_credits)
 S3method(tmapGridCompHeight,tm_legend_standard_landscape)
 S3method(tmapGridCompHeight,tm_legend_standard_portrait)
+S3method(tmapGridCompHeight,tm_logo)
 S3method(tmapGridCompHeight,tm_minimap)
 S3method(tmapGridCompHeight,tm_mouse_coordinates)
 S3method(tmapGridCompHeight,tm_scalebar)
@@ -35,6 +36,7 @@ S3method(tmapGridCompPrepare,tm_compass)
 S3method(tmapGridCompPrepare,tm_credits)
 S3method(tmapGridCompPrepare,tm_legend_standard_landscape)
 S3method(tmapGridCompPrepare,tm_legend_standard_portrait)
+S3method(tmapGridCompPrepare,tm_logo)
 S3method(tmapGridCompPrepare,tm_minimap)
 S3method(tmapGridCompPrepare,tm_mouse_coordinates)
 S3method(tmapGridCompPrepare,tm_scalebar)
@@ -44,6 +46,7 @@ S3method(tmapGridCompWidth,tm_compass)
 S3method(tmapGridCompWidth,tm_credits)
 S3method(tmapGridCompWidth,tm_legend_standard_landscape)
 S3method(tmapGridCompWidth,tm_legend_standard_portrait)
+S3method(tmapGridCompWidth,tm_logo)
 S3method(tmapGridCompWidth,tm_minimap)
 S3method(tmapGridCompWidth,tm_mouse_coordinates)
 S3method(tmapGridCompWidth,tm_scalebar)
@@ -58,6 +61,7 @@ S3method(tmapGridLegPlot,tm_compass)
 S3method(tmapGridLegPlot,tm_credits)
 S3method(tmapGridLegPlot,tm_legend_standard_landscape)
 S3method(tmapGridLegPlot,tm_legend_standard_portrait)
+S3method(tmapGridLegPlot,tm_logo)
 S3method(tmapGridLegPlot,tm_minimap)
 S3method(tmapGridLegPlot,tm_mouse_coordinates)
 S3method(tmapGridLegPlot,tm_scalebar)

R/tm_components.R

@@ -241,4 +241,40 @@ tm_minimap <- function(server,
 	tm_element_list(do.call(tm_element, c(args, list(subclass = c("tm_minimap", "tm_component")))))
 }
 
-
+
+#' Map component: logo
+#' 
+#' Map component that adds a scale bar. As of version 4.0, `tm_scalebar()` is
+#' used instead of `tm_scale_bar()` (now deprecated), because of the potential
+#' confusion with the `tm_scale_*()` scaling functions (like [tm_scale_continuous()]).
+#' 
+#' @param file either a filename or url of a png image. If multiple files/urls are provided with a character vector, the logos are placed near each other. To specify logos for small multiples use a list of character values/vectors. In order to stack logos vertically, multiple \code{tm_logo} elements can be stacked.
+#' @param height height of the logo in number of text line heights. The width is scaled based the height and the aspect ratio of the logo. If multiple logos are specified by a vector or list, the heights can be specified accordingly.
+#' @param margins margins
+#' @param between.margin between.margin
+#' @param stack stack
+#' @param position position
+#' @param frame frame
+#' @param frame.lwd frame.lwd
+#' @param frame.r frame.r
+#' @param group.frame group.frame
+#' @param resize.as.group resize.as.group
+#' @param z z
+#' @example ./examples/tm_logo.R 
+#' @export
+tm_logo = function(file,
+				   height,
+				   margins,
+				   between.margin,
+				   stack,
+				   position,
+				   frame,
+				   frame.lwd,
+				   frame.r,
+				   group.frame,
+				   resize.as.group,
+				   z) {
+	args = lapply(as.list(match.call()[-1]), eval, envir = parent.frame())
+	if (!("z" %in% names(args))) args$z = as.integer(NA)
+	tm_element_list(do.call(tm_element, c(args, list(subclass = c("tm_logo", "tm_component")))))
+}

R/tmapGridComp.R

@@ -728,3 +728,81 @@ tmapGridCompWidth.tm_minimap = function(comp, o) {
 tmapGridLegPlot.tm_minimap = function(comp, o, fH, fW) {
 	NULL
 }
+
+
+
+
+#' @export
+tmapGridCompPrepare.tm_logo = function(comp, o) {
+	comp$logo = lapply(comp$file, function(lf){
+		tmap_icons(lf)
+	})
+	comp$asp = vapply(comp$logo, function(lg) {
+		lg$iconWidth / lg$iconHeight
+	}, FUN.VALUE = numeric(1))
+	comp$show = TRUE
+	comp
+}
+
+#' @export
+tmapGridCompHeight.tm_logo = function(comp, o) {
+	marH = comp$margins[c(3,1)] * o$lin
+	hs = c(marH[1], comp$height * o$lin, marH[2])
+
+	sides = switch(comp$position$align.v, top = "second", bottom = "first", "both")
+	hsu = set_unit_with_stretch(hs, sides = sides)
+
+	Hin = sum(hs)
+	comp$flexRow = NA
+	comp$Hin = Hin #  sum(textP[1], textH, textP[2])
+	comp$hsu = hsu
+	comp
+}
+
+#' @export
+tmapGridCompWidth.tm_logo = function(comp, o) {
+	k = length(comp$asp)
+	comp$width = comp$height * comp$asp
+
+	marW = comp$margins[c(2,4)] * o$lin
+	ws = c(marW[1], 
+		   comp$width[1] * o$lin, 
+		   {if (k > 1) unlist(lapply(comp$width[-1], function(w) c(comp$between.margin, w) * o$lin)) else NULL},
+		   marW[2])
+
+	sides = switch(comp$position$align.h, left = "second", right = "first", "both")
+	wsu = set_unit_with_stretch(ws, sides = sides)
+	comp$col_ids = seq(3L, by = 2L, length.out = k)
+	comp$flexCol = NA
+	comp$Win = sum(ws)
+	comp$wsu = wsu
+	comp
+}
+
+#' @export
+tmapGridLegPlot.tm_logo = function(comp, o, fH, fW) {
+
+	k = length(comp$logo)
+
+	wsu = comp$wsu
+	hsu = comp$hsu
+
+	vp = grid::viewport(layout = grid::grid.layout(ncol = length(wsu),
+												   nrow = length(hsu), 
+												   widths = wsu,
+												   heights = hsu))
+	gLogos = mapply(function(logo, col) {
+		grobLogo = pngGrob(logo$iconUrl, fix.borders = TRUE, n=2, height.inch=as.numeric(comp$hsu[3]), target.dpi=96)
+		rdim = dim(grobLogo$raster)
+		grobLogo$raster = matrix(do.call("process_color", c(list(as.vector(grobLogo$raster), alpha=1), o$pc)), nrow = rdim[1], ncol=rdim[2])
+		gridCell(3L, col, grobLogo)
+	}, comp$logo, comp$col_ids, SIMPLIFY = FALSE)
+
+	grobBG = if (getOption("tmap.design.mode")) rectGrob(gp=gpar(fill="orange")) else NULL
+	gBG = gridCell(3L, 3L:(length(wsu) - 2L), grobBG)
+
+	do.call(grid::grobTree, c(list(gBG), gLogos, list(vp = vp)))
+
+}
+
+

R/tmap_icons.R

@@ -37,8 +37,8 @@ tmap_one_icon <- function(file, width, height, keep.asp, just, as.local, ...) {
 		stop(file, " is neither a valid path nor url", call.=FALSE)
 	}
 	if (!pu) {
-		tmpfile <- tempfile(fileext=".png")
-		download.file(file, destfile=tmpfile, mode="wb")
+		tmpfile <- file.path(tempdir(), basename(file))
+		if (!file.exists(tmpfile)) download.file(file, destfile=tmpfile, mode="wb")
 		localfile <- tmpfile
 	} else {
 		localfile <- file
@@ -95,8 +95,8 @@ pngGrob <- function(file, fix.borders=FALSE, n=NULL, height.inch=NULL, target.dp
 	}
 
 	if (!pu) {
-		tmpfile <- tempfile(fileext=".png")
-		download.file(file, destfile=tmpfile, mode="wb")
+		tmpfile <- file.path(tempdir(), basename(file))
+		if (!file.exists(tmpfile)) download.file(file, destfile=tmpfile, mode="wb")
 		file <- tmpfile
 	}
 

R/tmap_options.R

@@ -491,6 +491,18 @@ tmapMode = function(id, name, ...) {
 		compass.group.frame = TRUE,
 		compass.resize.as.group = FALSE,
 
+		logo.height = 3,
+		logo.margins = c(0.2, 0.2, 0.2, 0.2),
+		logo.between.margin = 0.2,
+		logo.show = FALSE,
+		logo.stack = "vertical",
+		logo.position = tm_pos_in(pos.h = "right", pos.v = "bottom", align.h = "right", align.v = "top", just.h = "left", just.v = "bottom"),
+		logo.frame = FALSE,
+		logo.frame.lwd = 1,
+		logo.frame.r = 2,
+		logo.group.frame = TRUE,
+		logo.resize.as.group = FALSE,
+
 		scalebar.show = FALSE,
 		scalebar.breaks=NULL,
 		scalebar.width=20, 

R/v4-not-implemented.R

@@ -4,11 +4,7 @@
 #' @name v4-not-yet
 NULL
 
-#' @export
-#' @rdname v4-not-yet
-tm_logo <- function(...) {
-	stop("Not yet implemented in v4")
-}
+
 #' @export
 #' @rdname v4-not-yet
 tmap_tip <- function(...) {

examples/tm_logo.R

@@ -0,0 +1,9 @@
+data(World)
+
+tm_shape(World) +
+	tm_polygons("HPI", fill.scale = tm_scale_intervals(values = "RdYlGn")) +
+	tm_logo(c("https://www.r-project.org/logo/Rlogo.png", 
+			  system.file("img/tmap.png", package="tmap"))) +
+	tm_logo("http://blog.kulikulifoods.com/wp-content/uploads/2014/10/logo.png", 
+			height=5, position = c("left", "top")) +
+	tm_format("World")