Add rasterization support for simple heatmap annotations

R/HeatmapAnnotation-class.R

@@ -116,7 +116,14 @@ HeatmapAnnotation = function(...,
 	height = NULL,
 	width = NULL,
 	simple_anno_size = ht_opt$simple_anno_size,
-	simple_anno_size_adjust = FALSE
+	simple_anno_size_adjust = FALSE,
+
+	use_raster = FALSE,
+	raster_device = NULL,
+	raster_quality = 1,
+	raster_device_param = list(),
+	raster_by_magick = requireNamespace("magick", quietly = TRUE),
+	raster_magick_filter = NULL
 	) {
 
 	dev.null()
@@ -136,6 +143,10 @@ HeatmapAnnotation = function(...,
 
 	fun_args = names(as.list(environment()))
 
+	if(missing(use_raster) && !is.null(ht_opt$annotation_use_raster)) {
+		use_raster = ht_opt$annotation_use_raster
+	}
+
 	verbose = ht_opt$verbose
 
 	.Object = new("HeatmapAnnotation")
@@ -326,12 +337,18 @@ HeatmapAnnotation = function(...,
 		i_anno = i_anno + 1
 		arg_list = list(name = ag, which = which,
 				label = annotation_label[[i_anno]],
-				show_name = show_annotation_name[[i_anno]], 
-				name_gp = subset_gp(annotation_name_gp, i_anno), 
-	        	name_offset = annotation_name_offset[[i_anno]], 
-	        	name_side = annotation_name_side[i_anno], 
+				show_name = show_annotation_name[[i_anno]],
+				name_gp = subset_gp(annotation_name_gp, i_anno),
+	        	name_offset = annotation_name_offset[[i_anno]],
+	        	name_side = annotation_name_side[i_anno],
 	        	name_rot = annotation_name_rot[[i_anno]],
-	        	border = border[i_anno])
+	        	border = border[i_anno],
+	        	use_raster = use_raster,
+	        	raster_device = raster_device,
+	        	raster_quality = raster_quality,
+	        	raster_device_param = raster_device_param,
+	        	raster_by_magick = raster_by_magick,
+	        	raster_magick_filter = raster_magick_filter)
 
 		if(inherits(anno_value_list[[ag]], c("function", "AnnotationFunction"))) {
 			arg_list$fun = anno_value_list[[ag]]

R/SingleAnnotation-class.R

@@ -36,7 +36,8 @@ SingleAnnotation = setClass("SingleAnnotation",
         width = "ANY",
         height = "ANY",
         extended = "ANY",
-        subsettable = "logical"
+        subsettable = "logical",
+        raster_param = "list"
 	),
 	prototype = list(
 		color_mapping = NULL,
@@ -45,7 +46,8 @@ SingleAnnotation = setClass("SingleAnnotation",
         color_is_random = FALSE,
 		name_to_data_vp = FALSE,
         extended = unit(c(0, 0, 0, 0), "mm"),
-        subsettable = FALSE
+        subsettable = FALSE,
+        raster_param = list(use_raster = FALSE)
 	)
 )
 
@@ -156,7 +158,13 @@ SingleAnnotation = function(name, value, col, fun,
 	name_side = ifelse(which == "column", "right", "bottom"),
     name_rot = NULL,
     simple_anno_size = ht_opt$simple_anno_size,
-    width = NULL, height = NULL) {
+    width = NULL, height = NULL,
+    use_raster = FALSE,
+    raster_device = NULL,
+    raster_quality = 1,
+    raster_device_param = list(),
+    raster_by_magick = requireNamespace("magick", quietly = TRUE),
+    raster_magick_filter = NULL) {
 
     .ENV$current_annotation_which = NULL
 	which = match.arg(which)[1]
@@ -582,6 +590,22 @@ SingleAnnotation = function(name, value, col, fun,
         .Object@subsettable = .Object@fun@subsettable
     }
 
+    if(is.null(raster_device)) {
+        if(requireNamespace("Cairo", quietly = TRUE)) {
+            raster_device = "CairoPNG"
+        } else {
+            raster_device = "png"
+        }
+    }
+    .Object@raster_param = list(
+        use_raster = use_raster,
+        raster_device = raster_device,
+        raster_quality = raster_quality,
+        raster_device_param = raster_device_param,
+        raster_by_magick = raster_by_magick,
+        raster_magick_filter = raster_magick_filter
+    )
+
     return(.Object)
 }
 
@@ -666,8 +690,21 @@ setMethod(f = "draw",
         xscale = data_scale$x, yscale = data_scale$y))
 
     if(verbose) qqcat("execute annotation function\n")
-    draw(object@fun, index = index, k = k, n = n)
-
+    use_raster = isTRUE(object@raster_param$use_raster)
+    if(use_raster) {
+        rp = object@raster_param
+        rasterize_in_viewport(
+            draw_fun = function() draw(object@fun, index = index, k = k, n = n),
+            raster_device = rp$raster_device,
+            raster_quality = rp$raster_quality,
+            raster_device_param = rp$raster_device_param,
+            raster_by_magick = rp$raster_by_magick,
+            raster_magick_filter = rp$raster_magick_filter
+        )
+    } else {
+        draw(object@fun, index = index, k = k, n = n)
+    }
+
 	# add annotation name
     draw_name = object@name_param$show
 	if(object@name_param$show && n > 1) {

R/global.R

@@ -209,6 +209,11 @@ ht_opt = setGlobalOptions(
 		.value = FALSE
 	),
 	"validate_names" = TRUE,
+	annotation_use_raster = list(
+		.value = NULL,
+		.class = "logical",
+		.length = 1
+	),
 	raster_temp_image_max_width = 30000,
 	raster_temp_image_max_height = 30000,
 	COLOR = c("blue", "#EEEEEE", "red")

R/utils.R

@@ -1137,6 +1137,105 @@ setAs("list", "HeatmapList", function(from) {
 })
 
 
+rasterize_in_viewport = function(draw_fun,
+    raster_device = "png",
+    raster_quality = 1,
+    raster_device_param = list(),
+    raster_by_magick = FALSE,
+    raster_magick_filter = NULL) {
+
+    # calculate current viewport size in pixels
+    vp_width_pt = max(1, ceiling(convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE)))
+    vp_height_pt = max(1, ceiling(convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE)))
+
+    if(raster_quality < 1) raster_quality = 1
+    vp_width_pt = ceiling(vp_width_pt * raster_quality)
+    vp_height_pt = ceiling(vp_height_pt * raster_quality)
+
+    # if viewport is too small, fall back to vector
+    if(vp_width_pt < 1 || vp_height_pt < 1) {
+        draw_fun()
+        return(invisible(NULL))
+    }
+
+    device_info = switch(raster_device,
+        png = c("grDevices", "png", "readPNG"),
+        jpeg = c("grDevices", "jpeg", "readJPEG"),
+        tiff = c("grDevices", "tiff", "readTIFF"),
+        CairoPNG = c("Cairo", "png", "readPNG"),
+        CairoJPEG = c("Cairo", "jpeg", "readJPEG"),
+        CairoTIFF = c("Cairo", "tiff", "readTIFF"),
+        agg_png = c("ragg", "png", "readPNG")
+    )
+
+    if(!requireNamespace(device_info[1], quietly = TRUE)) {
+        stop_wrap(paste0("Need ", device_info[1], " package to write image."))
+    }
+    if(!requireNamespace(device_info[2], quietly = TRUE)) {
+        stop_wrap(paste0("Need ", device_info[2], " package to read image."))
+    }
+
+    if(raster_device %in% c("png", "jpeg", "tiff")) {
+        if(!"type" %in% names(raster_device_param)) {
+            if(capabilities("cairo")) {
+                raster_device_param$type = "cairo"
+            }
+        }
+    }
+
+    temp_image_width = as.integer(ceiling(max(vp_width_pt, 1)))
+    temp_image_height = as.integer(ceiling(max(vp_height_pt, 1)))
+
+    if(!is.na(ht_opt$raster_temp_image_max_width)) {
+        temp_image_width = min(temp_image_width, ht_opt$raster_temp_image_max_width)
+    }
+    if(!is.na(ht_opt$raster_temp_image_max_height)) {
+        temp_image_height = min(temp_image_height, ht_opt$raster_temp_image_max_height)
+    }
+
+    temp_dir = tempdir()
+    temp_image = tempfile(pattern = ".annotation_raster_", tmpdir = temp_dir,
+        fileext = paste0(".", device_info[2]))
+    device_fun = getFromNamespace(raster_device, ns = device_info[1])
+
+    # Scale res with raster_quality so the device's physical size (in inches)
+    # matches the original viewport. Without this, annotation draw functions
+    # that push viewports with absolute units (e.g. unit(5, "mm")) would only
+    # fill a fraction of the enlarged temp device.
+    if(!"res" %in% names(raster_device_param)) {
+        raster_device_param$res = as.integer(72 * raster_quality)
+    }
+
+    oe = try(do.call(device_fun, c(list(filename = temp_image,
+        width = temp_image_width, height = temp_image_height), raster_device_param)))
+    if(inherits(oe, "try-error")) {
+        stop_wrap(qq("The temporary image size for annotation rasterization is too large (@{temp_image_width} x @{temp_image_height} px)."))
+    }
+
+    draw_fun()
+    dev.off2()
+
+    if(raster_by_magick) {
+        if(!requireNamespace("magick", quietly = TRUE)) {
+            stop_wrap("'magick' package should be installed.")
+        }
+        image = magick::image_read(temp_image)
+        image = magick::image_resize(image,
+            paste0(vp_width_pt, "x", vp_height_pt, "!"),
+            filter = raster_magick_filter)
+        image = as.raster(image)
+    } else {
+        image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
+    }
+
+    grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = FALSE)
+
+    file.remove(temp_image)
+
+    invisible(NULL)
+}
+
+
 draw_heatmap_in_jupyter = function(ht, ...) {
     width = getOption("repr.plot.width")
     height = getOption("repr.plot.height")