# == title # Empty Annotation # # == param # -which Whether it is a column annotation or a row annotation? # -border Whether draw borders of the annotation region? # -zoom If it is true and when the heatmap is split, the empty annotation slices will have # equal height or width, and you can see the correspondance between the annotation slices # and the original heatmap slices. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == details # It creates an empty annotation and holds space, later users can add graphics # by `decorate_annotation`. This function is useful when users have difficulty to # implement `AnnotationFunction` object. # # In following example, an empty annotation is first created and later points are added: # # m = matrix(rnorm(100), 10) # ht = Heatmap(m, top_annotation = HeatmapAnnotation(pt = anno_empty())) # ht = draw(ht) # co = column_order(ht)[[1]] # pt_value = 1:10 # decorate_annotation("pt", { # pushViewport(viewport(xscale = c(0.5, ncol(mat)+0.5), yscale = range(pt_value))) # grid.points(seq_len(ncol(mat)), pt_value[co], pch = 16, default.units = "native") # grid.yaxis() # popViewport() # }) # # And it is similar as using `anno_points`: # # Heatmap(m, top_annotation = HeatmapAnnotation(pt = anno_points(pt_value))) # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#empty-annotation # # == examples # anno = anno_empty() # draw(anno, test = "anno_empty") # anno = anno_empty(border = FALSE) # draw(anno, test = "anno_empty without border") anno_empty = function(which = c("column", "row"), border = TRUE, zoom = FALSE, width = NULL, height = NULL) { if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] } else { which = .ENV$current_annotation_which } anno_size = anno_width_and_height(which, width, height, unit(1, "cm")) fun = function(index) { if(border) grid.rect() } anno = AnnotationFunction( fun = fun, n = NA, fun_name = "anno_empty", which = which, var_import = list(border, zoom), subset_rule = list(), subsetable = TRUE, height = anno_size$height, width = anno_size$width, show_name = FALSE ) return(anno) } # == title # Subset the Matrix by Rows # # == param # -x A matrix. # -i The row indices. # # == details # Mainly used for constructing the `AnnotationFunction-class` object. # subset_matrix_by_row = function(x, i) x[i, , drop = FALSE] # == title # Subset the vector # # == param # -x A vector. # -i The indices. # # == details # Mainly used for constructing the `AnnotationFunction-class` object. # subset_vector = function(x, i) x[i] # == title # Simple Annotation # # == param # -x The value vector. The value can be a vector or a matrix. The length of the vector # or the nrow of the matrix is taken as the number of the observations of the annotation. # The value can be numeric or character and NA value is allowed. # -col Color that maps to ``x``. If ``x`` is numeric and needs a continuous mapping, ``col`` # should be a color mapping function which accepts a vector of values and returns a # vector of colors. Normally it is generated by `circlize::colorRamp2`. If ``x`` is discrete # (numeric or character) and needs a discrete color mapping, ``col`` should be a vector of # colors with levels in ``x`` as vector names. If ``col`` is not specified, the color mapping # is randomly generated by ``ComplexHeatmap:::default_col``. # -na_col Color for NA value. # -which Whether it is a column annotation or a row annotation? # -border Wether draw borders of the annotation region? # -gp Graphic parameters for grid borders. The ``fill`` parameter is disabled. # -pch Points/symbols that are added on top of the annotation grids. The value can be numeric # or single letters. It can be a vector if ``x`` is a vector and a matrix if ``x`` is a matrix. # No points are drawn if the corresponding values are NA. # -pt_size Size of the points/symbols. It should be a `grid::unit` object. If ``x`` is a vector, # the value of ``pt_size`` can be a vector, while if ``x`` is a matrix, ``pt_size`` can # only be a single value. # -pt_gp Graphic parameters for points/symbols. The length setting is same as ``pt_size``. # If ``pch`` is set as letters, the fontsize should be set as ``pt_gp = gpar(fontsize = ...)``. # -simple_anno_size size of the simple annotation. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == details # The "simple annotation" is the most widely used annotation type which is heatmap-like, where # the grid colors correspond to the values. `anno_simple` also supports to add points/symbols # on top of the grids where the it can be normal point (when ``pch`` is set as numbers) or letters (when # ``pch`` is set as single letters). # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#simple-annotation-as-an-annotation-function # # == example # anno = anno_simple(1:10) # draw(anno, test = "a numeric vector") # # anno = anno_simple(cbind(1:10, 10:1)) # draw(anno, test = "a matrix") # # anno = anno_simple(1:10, pch = c(1:4, NA, 6:8, NA, 10)) # draw(anno, test = "pch has NA values") # # anno = anno_simple(1:10, pch = c(rep("A", 5), rep(NA, 5))) # draw(anno, test = "pch has NA values") # # pch = matrix(1:20, nc = 2) # pch[sample(length(pch), 10)] = NA # anno = anno_simple(cbind(1:10, 10:1), pch = pch) # draw(anno, test = "matrix, pch is a matrix with NA values") anno_simple = function(x, col, na_col = "grey", which = c("column", "row"), border = FALSE, gp = gpar(col = NA), pch = NULL, pt_size = unit(1, "snpc")*0.8, pt_gp = gpar(), simple_anno_size = ht_opt$simple_anno_size, width = NULL, height = NULL) { if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] } else { which = .ENV$current_annotation_which } if(is.data.frame(x)) x = as.matrix(x) if(is.matrix(x)) { if(ncol(x) == 1) { x = x[, 1] } } input_is_matrix = is.matrix(x) anno_size = anno_width_and_height(which, width, height, simple_anno_size*ifelse(input_is_matrix, ncol(x), 1)) if(missing(col)) { col = default_col(x) } if(is.atomic(col)) { color_mapping = ColorMapping(name = "foo", colors = col, na_col = na_col) } else if(is.function(col)) { color_mapping = ColorMapping(name = "foo", col_fun = col, na_col = na_col) } else if(inherits(col, "ColorMapping")) { color_mapping = col } else { stop_wrap("`col` should be a named vector/a color mapping function/a ColorMapping object.") } value = x gp = subset_gp(gp, 1) # gp controls border if(is.matrix(value)) { n = nrow(value) nr = n nc = ncol(value) } else { n = length(value) nr = n nc = 1 } if(!is.null(pch)) { if(input_is_matrix) { pch = normalize_graphic_param_to_mat(pch, ifelse(is.matrix(x), ncol(x), 1), n, "pch") pt_size = pt_size[1]*(1/nc) pt_gp = subset_gp(pt_gp, 1) } else { if(length(pch) == 1) pch = rep(pch, n) if(length(pt_size) == 1) pt_size = rep(pt_size, n) pt_gp = recycle_gp(pt_gp, n) } } row_fun = function(index) { n = length(index) y = (n - seq_len(n) + 0.5) / n if(is.matrix(value)) { nc = ncol(value) pch = pch[index, , drop = FALSE] for(i in seq_len(nc)) { fill = map_to_colors(color_mapping, value[index, i]) grid.rect(x = (i-0.5)/nc, y, height = 1/n, width = 1/nc, gp = do.call("gpar", c(list(fill = fill), gp))) if(!is.null(pch)) { l = !is.na(pch[, i]) grid.points(x = rep((i-0.5)/nc, sum(l)), y = y[l], pch = pch[l, i], size = {if(length(pt_size) == 1) pt_size else pt_size[i]}, gp = subset_gp(pt_gp, i)) } } } else { fill = map_to_colors(color_mapping, value[index]) grid.rect(x = 0.5, y, height = 1/n, width = 1, gp = do.call("gpar", c(list(fill = fill), gp))) if(!is.null(pch)) { pch = pch[index] pt_size = pt_size[index] pt_gp = subset_gp(pt_gp, index) l = !is.na(pch) grid.points(x = rep(0.5, sum(l)), y = y[l], pch = pch[l], size = pt_size[l], gp = subset_gp(pt_gp, which(l))) } } if(border) grid.rect(gp = gpar(fill = "transparent")) } column_fun = function(index) { n = length(index) x = (seq_len(n) - 0.5) / n if(is.matrix(value)) { nc = ncol(value) pch = pch[index, , drop = FALSE] for(i in seq_len(nc)) { fill = map_to_colors(color_mapping, value[index, i]) grid.rect(x, y = (nc-i +0.5)/nc, width = 1/n, height = 1/nc, gp = do.call("gpar", c(list(fill = fill), gp))) if(!is.null(pch)){ l = !is.na(pch[, i]) grid.points(x[l], y = rep((nc-i +0.5)/nc, sum(l)), pch = pch[l, i], size = {if(length(pt_size) == 1) pt_size else pt_size[i]}, gp = subset_gp(pt_gp, i)) } } } else { fill = map_to_colors(color_mapping, value[index]) grid.rect(x, y = 0.5, width = 1/n, height = 1, gp = do.call("gpar", c(list(fill = fill), gp))) if(!is.null(pch)) { pch = pch[index] pt_size = pt_size[index] pt_gp = subset_gp(pt_gp, index) l = !is.na(pch) grid.points(x[l], y = rep(0.5, sum(l)), pch = pch[l], size = pt_size[l], gp = subset_gp(pt_gp, which(l))) } } if(border) grid.rect(gp = gpar(fill = "transparent")) } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_simple", which = which, width = anno_size$width, height = anno_size$height, n = n, data_scale = c(0.5, nc + 0.5), var_import = list(value, gp, border, color_mapping, pt_gp, pt_size, pch) ) anno@subset_rule = list() if(input_is_matrix) { anno@subset_rule$value = subset_matrix_by_row if(!is.null(pch)) { anno@subset_rule$pch = subset_matrix_by_row } } else { anno@subset_rule$value = subset_vector if(!is.null(pch)) { anno@subset_rule$pch = subset_vector anno@subset_rule$pt_size = subset_vector anno@subset_rule$pt_gp = subset_gp } } anno@subsetable = TRUE return(anno) } # == title # Image Annotation # # == param # -image A vector of file paths of images. The format of the image is inferred from the suffix name of the image file. # NA values or empty strings in the vector means no image to drawn. # -which Whether it is a column annotation or a row annotation? # -border Wether draw borders of the annotation region? # -gp Graphic parameters for annotation grids. If the image has transparent background, the ``fill`` parameter # can be used to control the background color in the annotation grids. # -space The space around the image to the annotation grid borders. The value should be a `grid::unit` object. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == details # This function supports image formats in ``png``, ``svg``, ``pdf``, ``eps``, ``jpeg/jpg``, ``tiff``. # ``png``, ``jpeg/jpg`` and ``tiff`` images are imported by `png::readPNG`, `jpeg::readJPEG` and # `tiff::readTIFF`, and drawn by `grid::grid.raster`. ``svg`` images are firstly reformatted by ``rsvg::rsvg_svg`` # and then imported by `grImport2::readPicture` and drawn by `grImport2::grid.picture`. ``pdf`` and ``eps`` # images are imported by `grImport::PostScriptTrace` and `grImport::readPicture`, later drawn by `grImport::grid.picture`. # # Different image formats can be mixed in the ``image`` vector. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#image-annotation # # == example # # download the free icons from https://github.com/Keyamoon/IcoMoon-Free # \dontrun{ # image = sample(dir("~/Downloads/IcoMoon-Free-master/PNG/64px", full.names = TRUE), 10) # anno = anno_image(image) # draw(anno, test = "png") # image[1:5] = "" # anno = anno_image(image) # draw(anno, test = "some of png") # } anno_image = function(image, which = c("column", "row"), border = TRUE, gp = gpar(fill = NA, col = NA), space = unit(1, "mm"), width = NULL, height = NULL) { image[is.na(image)] = "" l = grepl("^\\s*$", image) image[l] = "" allowed_image_type = c("png", "svg", "pdf", "eps", "jpeg", "jpg", "tiff") if(inherits(image, "character")) { ## they are file path image_type = tolower(gsub("^.*\\.(\\w+)$", "\\1", image)) if(! all(image_type[image_type != ""] %in% allowed_image_type)) { stop_wrap("image file should be of png/svg/pdf/eps/jpeg/jpg/tiff.") } } else { stop_wrap("`image` should be a vector of path.") } n_image = length(image) image_list = vector("list", n_image) image_class = vector("character", n_image) for(i in seq_along(image)) { if(image[i] == "") { image_list[[i]] = NA image_class[i] = NA } else if(image_type[i] == "png") { if(!requireNamespace("png")) { stop_wrap("Need png package to read png images.") } image_list[[i]] = png::readPNG(image[i]) image_class[i] = "raster" } else if(image_type[i] %in% c("jpeg", "jpg")) { if(!requireNamespace("jpeg")) { stop_wrap("Need jpeg package to read jpeg/jpg images.") } image_list[[i]] = jpeg::readJPEG(image[i]) image_class[i] = "raster" } else if(image_type[i] == "tiff") { if(!requireNamespace("tiff")) { stop_wrap("Need tiff package to read tiff images.") } image_list[[i]] = tiff::readTIFF(image[i]) image_class[i] = "raster" } else if(image_type[i] %in% c("pdf", "eps")) { if(!requireNamespace("grImport")) { stop_wrap("Need grImport package to read pdf/eps images.") } temp_file = tempfile() getFromNamespace("PostScriptTrace", ns = "grImport")(image[[i]], temp_file) image_list[[i]] = grImport::readPicture(temp_file) file.remove(temp_file) image_class[i] = "grImport::Picture" } else if(image_type[i] == "svg") { if(!requireNamespace("grImport2")) { stop_wrap("Need grImport2 package to read svg images.") } # if(!requireNamespace("rsvg")) { # stop_wrap("Need rsvg package to convert svg images.") # } temp_file = tempfile() # get it work on bioconductor build server oe = try(getFromNamespace("rsvg_svg", ns = "rsvg")(image[i], temp_file)) if(inherits(oe, "try-error")) { stop_wrap("Need rsvg package to convert svg images.") } image_list[[i]] = grImport2::readPicture(temp_file) file.remove(temp_file) image_class[i] = "grImport2::Picture" } } yx_asp = sapply(image_list, function(x) { if(inherits(x, "array")) { nrow(x)/ncol(x) } else if(inherits(x, "Picture")) { max(x@summary@yscale)/max(x@summary@xscale) } else { 1 } }) if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] } else { which = .ENV$current_annotation_which } space = space[1] anno_size = anno_width_and_height(which, width, height, unit(1, "cm")) gp = recycle_gp(gp, n_image) column_fun = function(index) { n = length(index) pushViewport(viewport()) asp = convertHeight(unit(1, "npc") - space*2, "mm", valueOnly = TRUE)/convertWidth(unit(1/n, "npc") - space*2, "mm", valueOnly = TRUE) grid.rect(x = (1:n - 0.5)/n, width = 1/n, gp = subset_gp(gp, index)) for(i in seq_len(n)) { if(identical(image_list[[i]], NA)) next if(yx_asp[ index[i] ] > asp) { height = unit(1, "npc") - space*2 width = convertHeight(height, "mm")*yx_asp[ index[i] ] } else { width = unit(1/n, "npc") - space*2 height = yx_asp[ index[i] ]*convertWidth(width, "mm") } if(image_class[ index[i] ] == "raster") { grid.raster(image_list[[i]], x = (i-0.5)/n, width = width, height = height) } else if(image_class[ index[i] ] == "grImport::Picture") { grid.picture = getFromNamespace("grid.picture", ns = "grImport") grid.picture(image_list[[i]], x = (i-0.5)/n, width = width, height = height) } else if(image_class[ index[i] ] == "grImport2::Picture") { grid.picture = getFromNamespace("grid.picture", ns = "grImport2") grid.picture(image_list[[i]], x = (i-0.5)/n, width = width, height = height) } } if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } row_fun = function(index) { n = length(index) pushViewport(viewport()) asp = convertHeight(unit(1/n, "npc") - space*2, "mm", valueOnly = TRUE)/convertWidth(unit(1, "npc") - space*2, "mm", valueOnly = TRUE) grid.rect(y = (n - 1:n + 0.5)/n, height = 1/n, gp = subset_gp(gp, index)) for(i in seq_len(n)) { if(identical(image_list[[i]], NA)) next if(yx_asp[ index[i] ] > asp) { height = unit(1/n, "npc") - space*2 width = convertHeight(height, "mm")*(1/yx_asp[ index[i] ]) } else { width = unit(1, "npc") - space*2 height = yx_asp[ index[i] ]*convertWidth(width, "mm") } if(image_class[ index[i] ] == "raster") { grid.raster(image_list[[i]], y = (n - i + 0.5)/n, width = width, height = height) } else if(image_class[ index[i] ] == "grImport::Picture") { grid.picture = getFromNamespace("grid.picture", ns = "grImport") grid.picture(image_list[[i]], y = (n - i + 0.5)/n, width = width, height = height) } else if(image_class[ index[i] ] == "grImport2::Picture") { grid.picture = getFromNamespace("grid.picture", ns = "grImport2") grid.picture(image_list[[i]], y = (n - i + 0.5)/n, width = width, height = height) } } if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_image", which = which, width = anno_size$width, height = anno_size$height, n = n_image, data_scale = c(0.5, 1.5), var_import = list(gp, border, space, yx_asp, image_list, image_class) ) anno@subset_rule$gp = subset_vector anno@subset_rule$image_list = subset_vector anno@subset_rule$image_class = subset_vector anno@subsetable = TRUE return(anno) } # == title # The Default Parameters for Annotation Axis # # == param # -which Whether it is for column annotation or row annotation? # # == details # There are following parameters for the annotation axis: # # -at The breaks of axis. By default it is automatically inferred. # -labels The corresponding axis labels. # -labels_rot The rotation of the axis labels. # -gp Graphc parameters of axis labels. The value should be a `grid::unit` object. # -side If it is for column annotation, the value should only be one of ``left`` and ``right``. If # it is for row annotation, the value should only be one of ``top`` and ``bottom``. # -facing Whether the axis faces to the outside of the annotation region or inside. Sometimes when # appending more than one heatmaps, the axes of column annotations of one heatmap might # overlap to the neighbouring heatmap, setting ``facing`` to ``inside`` may invoild it. # -direction The direction of the axis. Value should be "normal" or "reverse". # # All the parameters are passed to `annotation_axis_grob` to construct an axis grob. # # == example # default_axis_param("column") # default_axis_param("row") default_axis_param = function(which) { list( at = NULL, labels = NULL, labels_rot = ifelse(which == "column", 0, 90), gp = gpar(fontsize = 8), side = ifelse(which == "column", "left", "bottom"), facing = "outside", direction = "normal" ) } validate_axis_param = function(axis_param, which) { dft = default_axis_param(which) for(nm in names(axis_param)) { dft[[nm]] = axis_param[[nm]] } if(which == "row") { if(dft$side %in% c("left", "right")) { stop_wrap("axis side can only be set to 'top' or 'bottom' for row annotations.") } } if(which == "column") { if(dft$side %in% c("top", "bottom")) { stop_wrap("axis side can only be set to 'left' or 'right' for row annotations.") } } return(dft) } construct_axis_grob = function(axis_param, which, data_scale) { axis_param_default = default_axis_param(which) for(nm in setdiff(names(axis_param_default), names(axis_param))) { axis_param[[nm]] = axis_param_default[[nm]] } if(is.null(axis_param$at)) { at = pretty_breaks(data_scale) axis_param$at = at axis_param$labels = at } if(is.null(axis_param$labels)) { axis_param$labels = axis_param$at } axis_param$scale = data_scale axis_grob = do.call(annotation_axis_grob, axis_param) return(axis_grob) } # == title # Points Annotation # # == param # -x The value vector. The value can be a vector or a matrix. The length of the vector # or the number of rows of the matrix is taken as the number of the observations of the annotation. # -which Whether it is a column annotation or a row annotation? # -border Wether draw borders of the annotation region? # -gp Graphic parameters for points. The length of each graphic parameter can be 1, length of ``x`` if ``x`` # is a vector, or number of columns of ``x`` is ``x`` is a matrix. # -pch Point type. The length setting is the same as ``gp``. # -size Point size, the value should be a `grid::unit` object. The length setting is the same as ``gp``. # -ylim Data ranges. By default it is ``range(x)``. # -extend The extension to both side of ``ylim``. The value is a percent value corresponding to ``ylim[2] - ylim[1]``. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # -... Other arguments. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#points-annotation # # == example # anno = anno_points(runif(10)) # draw(anno, test = "anno_points") # anno = anno_points(matrix(runif(20), nc = 2), pch = 1:2) # draw(anno, test = "matrix") anno_points = function(x, which = c("column", "row"), border = TRUE, gp = gpar(), pch = 16, size = unit(2, "mm"), ylim = NULL, extend = 0.05, axis = TRUE, axis_param = default_axis_param(which), width = NULL, height = NULL, ...) { other_args = list(...) if(length(other_args)) { if("axis_gp" %in% names(other_args)) { stop_wrap("`axis_gp` is removed from the arguments. Use `axis_param = list(gp = ...)` instead.") } if("axis_direction" %in% names(other_args)) { stop_wrap("`axis_direction` is not supported any more.") } } ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) if(is.data.frame(x)) x = as.matrix(x) if(is.matrix(x)) { if(ncol(x) == 1) { x = x[, 1] } } input_is_matrix = is.matrix(x) anno_size = anno_width_and_height(which, width, height, unit(1, "cm")) if(is.matrix(x)) { n = nrow(x) nr = n nc = ncol(x) } else { n = length(x) nr = n nc = 1 } if(input_is_matrix) { gp = recycle_gp(gp, nc) if(length(pch) == 1) pch = rep(pch, nc) if(length(size) == 1) size = rep(size, nc) } else if(is.atomic(x)) { gp = recycle_gp(gp, n) if(length(pch) == 1) pch = rep(pch, n) if(length(size) == 1) size = rep(size, n) } if(is.null(ylim)) { data_scale = range(x, na.rm = TRUE) } else { data_scale = ylim } data_scale = data_scale + c(-extend, extend)*(data_scale[2] - data_scale[1]) value = x axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, data_scale) else NULL row_fun = function(index, k = 1, N = 1) { n = length(index) if(axis_param$direction == "reverse") { value = data_scale[2] - value + data_scale[1] } pushViewport(viewport(xscale = data_scale, yscale = c(0.5, n+0.5))) if(is.matrix(value)) { for(i in seq_len(ncol(value))) { grid.points(value[index, i], n - seq_along(index) + 1, gp = subset_gp(gp, i), default.units = "native", pch = pch[i], size = size[i]) } } else { grid.points(value[index], n - seq_along(index) + 1, gp = subset_gp(gp, index), default.units = "native", pch = pch[index], size = size[index]) } if(axis_param$side == "top") { if(k > 1) axis = FALSE } else if(axis_param$side == "bottom") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } column_fun = function(index, k = 1, N = 1) { n = length(index) if(axis_param$direction == "reverse") { value = data_scale[2] - value + data_scale[1] } pushViewport(viewport(yscale = data_scale, xscale = c(0.5, n+0.5))) if(is.matrix(value)) { for(i in seq_len(ncol(value))) { grid.points(seq_along(index), value[index, i], gp = subset_gp(gp, i), default.units = "native", pch = pch[i], size = size[i]) } } else { grid.points(seq_along(index), value[index], gp = subset_gp(gp, index), default.units = "native", pch = pch[index], size = size[index]) } if(axis_param$side == "left") { if(k > 1) axis = FALSE } else if(axis_param$side == "right") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_points", which = which, width = anno_size$width, height = anno_size$height, n = n, data_scale = data_scale, var_import = list(value, gp, border, pch, size, axis, axis_param, axis_grob, data_scale) ) anno@subset_rule$gp = subset_vector if(input_is_matrix) { anno@subset_rule$value = subset_matrix_by_row } else { anno@subset_rule$value = subset_vector anno@subset_rule$gp = subset_gp anno@subset_rule$size = subset_vector anno@subset_rule$pch = subset_vector } anno@subsetable = TRUE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } update_anno_extend = function(anno, axis_grob, axis_param) { extended = anno@extended if(is.null(axis_grob)) { return(extended) } if(axis_param$facing == "outside") { if(axis_param$side == "left") { extended[[2]] = convertWidth(grobWidth(axis_grob), "mm", valueOnly = TRUE) } else if(axis_param$side == "right") { extended[[4]] = convertWidth(grobWidth(axis_grob), "mm", valueOnly = TRUE) } else if(axis_param$side == "top") { extended[[3]] = convertHeight(grobHeight(axis_grob), "mm", valueOnly = TRUE) } else if(axis_param$side == "bottom") { extended[[1]] = convertHeight(grobHeight(axis_grob), "mm", valueOnly = TRUE) } } return(extended) } # == title # Lines Annotation # # == param # -x The value vector. The value can be a vector or a matrix. The length of the vector # or the number of rows of the matrix is taken as the number of the observations of the annotation. # -which Whether it is a column annotation or a row annotation? # -border Wether draw borders of the annotation region? # -gp Graphic parameters for lines. The length of each graphic parameter can be 1, or number of columns of ``x`` is ``x`` is a matrix. # -add_points Whether to add points on the lines? # -smooth If it is ``TRUE``, smoothing by `stats::loess` is performed. If it is ``TRUE``, ``add_points`` is set to ``TRUE`` by default. # -pch Point type. The length setting is the same as ``gp``. # -size Point size, the value should be a `grid::unit` object. The length setting is the same as ``gp``. # -pt_gp Graphic parameters for points. The length setting is the same as ``gp``. # -ylim Data ranges. By default it is ``range(x)``. # -extend The extension to both side of ``ylim``. The value is a percent value corresponding to ``ylim[2] - ylim[1]``. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#lines-annotation # # == example # anno = anno_lines(runif(10)) # draw(anno, test = "anno_lines") # anno = anno_lines(cbind(c(1:5, 1:5), c(5:1, 5:1)), gp = gpar(col = 2:3)) # draw(anno, test = "matrix") # anno = anno_lines(cbind(c(1:5, 1:5), c(5:1, 5:1)), gp = gpar(col = 2:3), # add_points = TRUE, pt_gp = gpar(col = 5:6), pch = c(1, 16)) # draw(anno, test = "matrix") anno_lines = function(x, which = c("column", "row"), border = TRUE, gp = gpar(), add_points = smooth, smooth = FALSE, pch = 16, size = unit(2, "mm"), pt_gp = gpar(), ylim = NULL, extend = 0.05, axis = TRUE, axis_param = default_axis_param(which), width = NULL, height = NULL) { ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) if(is.data.frame(x)) x = as.matrix(x) if(is.matrix(x)) { if(ncol(x) == 1) { x = x[, 1] } } input_is_matrix = is.matrix(x) anno_size = anno_width_and_height(which, width, height, unit(1, "cm")) if(is.matrix(x)) { n = nrow(x) nr = n nc = ncol(x) } else { n = length(x) nr = n nc = 1 } if(input_is_matrix) { gp = recycle_gp(gp, nc) pt_gp = recycle_gp(pt_gp, nc) if(length(pch) == 1) pch = rep(pch, nc) if(length(size) == 1) size = rep(size, nc) } else if(is.atomic(x)) { gp = recycle_gp(gp, 1) pt_gp = recycle_gp(pt_gp, n) if(length(pch) == 1) pch = rep(pch, n) if(length(size) == 1) size = rep(size, n) } if(is.null(ylim)) { data_scale = range(x, na.rm = TRUE) } else { data_scale = ylim } data_scale = data_scale + c(-extend, extend)*(data_scale[2] - data_scale[1]) value = x axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, data_scale) else NULL row_fun = function(index, k = 1, N = 1) { n = length(index) if(axis_param$direction == "reverse") { value = data_scale[2] - value + data_scale[1] } pushViewport(viewport(xscale = data_scale, yscale = c(0.5, n+0.5))) if(is.matrix(value)) { for(i in seq_len(ncol(value))) { x = n - seq_along(index) + 1 y = value[index, i] if(smooth) { fit = loess(y ~ x) x2 = seq(x[1], x[length(x)], length = 100) y2 = predict(fit, x2) grid.lines(y2, x2, gp = subset_gp(gp, i), default.units = "native") } else { grid.lines(y, x, gp = subset_gp(gp, i), default.units = "native") } if(add_points) { grid.points(y, x, gp = subset_gp(pt_gp, i), default.units = "native", pch = pch[i], size = size[i]) } } } else { x = n - seq_along(index) + 1 y = value[index] if(smooth) { fit = loess(y ~ x) x2 = seq(x[1], x[length(x)], length = 100) y2 = predict(fit, x2) grid.lines(y2, x2, gp = gp, default.units = "native") } else { grid.lines(y, x, gp = gp, default.units = "native") } if(add_points) { grid.points(y, x, gp = subset_gp(pt_gp, index), default.units = "native", pch = pch[index], size = size[index]) } } if(axis_param$side == "top") { if(k > 1) axis = FALSE } else if(axis_param$side == "bottom") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } column_fun = function(index, k = 1, N = 1) { n = length(index) if(axis_param$direction == "reverse") { value = data_scale[2] - value + data_scale[1] } pushViewport(viewport(yscale = data_scale, xscale = c(0.5, n+0.5))) if(is.matrix(value)) { for(i in seq_len(ncol(value))) { x = seq_along(index) y = value[index, i] if(smooth) { fit = loess(y ~ x) x2 = seq(x[1], x[length(x)], length = 100) y2 = predict(fit, x2) grid.lines(x2, y2, gp = subset_gp(gp, i), default.units = "native") } else { grid.lines(x, y, gp = subset_gp(gp, i), default.units = "native") } if(add_points) { grid.points(x, y, gp = subset_gp(pt_gp, i), default.units = "native", pch = pch[i], size = size[i]) } } } else { x = seq_along(index) y = value[index] if(smooth) { fit = loess(y ~ x) x2 = seq(x[1], x[length(x)], length = 100) y2 = predict(fit, x2) grid.lines(x2, y2, gp = gp, default.units = "native") } else { grid.lines(x, y, gp = gp, default.units = "native") } if(add_points) { grid.points(seq_along(index), value[index], gp = subset_gp(pt_gp, index), default.units = "native", pch = pch[index], size = size[index]) } } if(axis_param$side == "left") { if(k > 1) axis = FALSE } else if(axis_param$side == "right") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_points", which = which, width = anno_size$width, height = anno_size$height, n = n, data_scale = data_scale, var_import = list(value, gp, border, pch, size, pt_gp, axis, axis_param, axis_grob, data_scale, add_points, smooth) ) anno@subset_rule$gp = subset_vector if(input_is_matrix) { anno@subset_rule$value = subset_matrix_by_row } else { anno@subset_rule$value = subset_vector anno@subset_rule$gp = subset_gp anno@subset_rule$pt_gp = subset_gp anno@subset_rule$size = subset_vector anno@subset_rule$pch = subset_vector } anno@subsetable = TRUE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } # == title # Barplot Annotation # # == param # -x The value vector. The value can be a vector or a matrix. The length of the vector # or the number of rows of the matrix is taken as the number of the observations of the annotation. # If ``x`` is a vector, the barplots will be represented as stacked barplots. # -baseline baseline of bars. The value should be "min" or "max", or a numeric value. It is enforced to be zero # for stacked barplots. # -which Whether it is a column annotation or a row annotation? # -border Wether draw borders of the annotation region? # -bar_width Relative width of the bars. The value should be smaller than one. # -gp Graphic parameters for points. The length of each graphic parameter can be 1, length of ``x`` if ``x`` # is a vector, or number of columns of ``x`` is ``x`` is a matrix. # -ylim Data ranges. By default it is ``range(x)`` if ``x`` is a vector, or ``range(rowSums(x))`` if ``x`` is a matrix. # -extend The extension to both side of ``ylim``. The value is a percent value corresponding to ``ylim[2] - ylim[1]``. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # -... Other arguments. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#barplot_annotation # # == example # anno = anno_barplot(1:10) # draw(anno, test = "a vector") # # m = matrix(runif(4*10), nc = 4) # m = t(apply(m, 1, function(x) x/sum(x))) # anno = anno_barplot(m, gp = gpar(fill = 2:5), bar_width = 1, height = unit(6, "cm")) # draw(anno, test = "proportion matrix") anno_barplot = function(x, baseline = 0, which = c("column", "row"), border = TRUE, bar_width = 0.6, gp = gpar(fill = "#CCCCCC"), ylim = NULL, extend = 0.05, axis = TRUE, axis_param = default_axis_param(which), width = NULL, height = NULL, ...) { other_args = list(...) if(length(other_args)) { if("axis_gp" %in% names(other_args)) { stop_wrap("`axis_gp` is removed from the arguments. Use `axis_param = list(gp = ...)` instead.") } if("axis_side" %in% names(other_args)) { stop_wrap("`axis_side` is removed from the arguments. Use `axis_param = list(side = ...)` instead.") } if("axis_direction" %in% names(other_args)) { stop_wrap("`axis_direction` is not supported any more.") } } if(inherits(x, "list")) x = do.call("cbind", x) if(inherits(x, "data.frame")) x = as.matrix(x) if(inherits(x, "matrix")) { sg = apply(x, 1, function(xx) all(sign(xx) %in% c(1, 0)) || all(sign(xx) %in% c(-1, 0))) if(!all(sg)) { stop_wrap("Since `x` is a matrix, the sign of each row should be either all positive or all negative.") } } # convert everything to matrix if(is.null(dim(x))) x = matrix(x, ncol = 1) nc = ncol(x) if(missing(gp)) { gp = gpar(fill = grey(seq(0, 1, length = nc+2))[-c(1, nc+2)]) } data_scale = range(rowSums(x, na.rm = TRUE), na.rm = TRUE) if(!is.null(ylim)) data_scale = ylim if(baseline == "min") { data_scale = data_scale + c(0, extend)*(data_scale[2] - data_scale[1]) baseline = min(x) } else if(baseline == "max") { data_scale = data_scale + c(-extend, 0)*(data_scale[2] - data_scale[1]) baseline = max(x) } else { if(is.numeric(baseline)) { if(baseline == 0 && all(abs(rowSums(x) - 1) < 1e-6)) { data_scale = c(0, 1) } else if(baseline <= data_scale[1]) { data_scale = c(baseline, extend*(data_scale[2] - baseline) + data_scale[2]) } else if(baseline >= data_scale[2]) { data_scale = c(-extend*(baseline - data_scale[1]) + data_scale[1], baseline) } else { data_scale = data_scale + c(-extend, extend)*(data_scale[2] - data_scale[1]) } } } ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) anno_size = anno_width_and_height(which, width, height, unit(1, "cm")) if(nc == 1) { gp = recycle_gp(gp, nrow(x)) } else { gp = recycle_gp(gp, nc) } value = x axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, data_scale) else NULL row_fun = function(index, k = 1, N = 1) { n = length(index) if(axis_param$direction == "reverse") { value_origin = value value = data_scale[2] - value + data_scale[1] baseline = data_scale[2] - baseline + data_scale[1] } pushViewport(viewport(xscale = data_scale, yscale = c(0.5, n+0.5))) if(ncol(value) == 1) { width = value[index] - baseline x_coor = width/2+baseline grid.rect(x = x_coor, y = n - seq_along(index) + 1, width = abs(width), height = 1*bar_width, default.units = "native", gp = subset_gp(gp, index)) } else { for(i in seq_len(ncol(value))) { if(axis_param$direction == "normal") { width = abs(value[index, i]) x_coor = rowSums(value[index, seq_len(i-1), drop = FALSE]) + width/2 grid.rect(x = x_coor, y = n - seq_along(index) + 1, width = abs(width), height = 1*bar_width, default.units = "native", gp = subset_gp(gp, i)) } else { width = value_origin[index, i] # the original width x_coor = rowSums(value_origin[index, seq_len(i-1), drop = FALSE]) + width/2 #distance to the right x_coor = data_scale[2] - x_coor + data_scale[1] grid.rect(x = x_coor, y = n - seq_along(index) + 1, width = abs(width), height = 1*bar_width, default.units = "native", gp = subset_gp(gp, i)) } } } if(axis_param$side == "top") { if(k > 1) axis = FALSE } else if(axis_param$side == "bottom") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } column_fun = function(index, k = 1, N = 1) { n = length(index) if(axis_param$direction == "reverse") { value_origin = value value = data_scale[2] - value + data_scale[1] baseline = data_scale[2] - baseline + data_scale[1] } pushViewport(viewport(yscale = data_scale, xscale = c(0.5, n+0.5))) if(ncol(value) == 1) { height = value[index] - baseline y_coor = height/2+baseline grid.rect(y = y_coor, x = seq_along(index), height = abs(height), width = 1*bar_width, default.units = "native", gp = subset_gp(gp, index)) } else { for(i in seq_len(ncol(value))) { if(axis_param$direction == "normal") { height = value[index, i] y_coor = rowSums(value[index, seq_len(i-1), drop = FALSE]) + height/2 grid.rect(y = y_coor, x = seq_along(index), height = abs(height), width = 1*bar_width, default.units = "native", gp = subset_gp(gp, i)) } else { height = value_origin[index, i] y_coor = rowSums(value_origin[index, seq_len(i-1), drop = FALSE]) + height/2 y_coor = data_scale[2] - y_coor + data_scale[1] grid.rect(y = y_coor, x = seq_along(index), height = abs(height), width = 1*bar_width, default.units = "native", gp = subset_gp(gp, i)) } } } if(axis_param$side == "left") { if(k > 1) axis = FALSE } else if(axis_param$side == "right") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } n = nrow(value) anno = AnnotationFunction( fun = fun, fun_name = "anno_barplot", which = which, width = anno_size$width, height = anno_size$height, n = n, data_scale = data_scale, var_import = list(value, gp, border, bar_width, baseline, axis, axis_param, axis_grob, data_scale) ) anno@subset_rule$value = subset_matrix_by_row if(ncol(value) == 1) { anno@subset_rule$gp = subset_gp } anno@subsetable = TRUE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } # == title # Boxplot Annotation # # == param # -x A matrix or a list. If ``x`` is a matrix and if ``which`` is ``column``, statistics for boxplots # are calculated by columns, if ``which`` is ``row``, the calculation is done by rows. # -which Whether it is a column annotation or a row annotation? # -border Wether draw borders of the annotation region? # -gp Graphic parameters for the boxes. The length of the graphic parameters should be one or the number of observations. # -ylim Data ranges. # -extend The extension to both side of ``ylim``. The value is a percent value corresponding to ``ylim[2] - ylim[1]``. # -outline Whether draw outline of boxplots? # -box_width Relative width of boxes. The value should be smaller than one. # -pch Point style. # -size Point size. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # -... Other arguments. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#box-annotation # # == example # set.seed(123) # m = matrix(rnorm(100), 10) # anno = anno_boxplot(m, height = unit(4, "cm")) # draw(anno, test = "anno_boxplot") # anno = anno_boxplot(m, height = unit(4, "cm"), gp = gpar(fill = 1:10)) # draw(anno, test = "anno_boxplot with gp") anno_boxplot = function(x, which = c("column", "row"), border = TRUE, gp = gpar(fill = "#CCCCCC"), ylim = NULL, extend = 0.05, outline = TRUE, box_width = 0.6, pch = 1, size = unit(2, "mm"), axis = TRUE, axis_param = default_axis_param(which), width = NULL, height = NULL, ...) { other_args = list(...) if(length(other_args)) { if("axis_gp" %in% names(other_args)) { stop_wrap("`axis_gp` is removed from the arguments. Use `axis_param = list(gp = ...)` instead.") } if("axis_side" %in% names(other_args)) { stop_wrap("`axis_side` is removed from the arguments. Use `axis_param = list(side = ...)` instead.") } if("axis_direction" %in% names(other_args)) { stop_wrap("`axis_direction` is not supported any more.") } } ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) anno_size = anno_width_and_height(which, width, height, unit(2, "cm")) ## convert matrix all to list (or data frame) if(is.matrix(x)) { if(which == "column") { value = as.data.frame(x) } else if(which == "row") { value = as.data.frame(t(x)) } } else { value = x } if(is.null(ylim)) { if(!outline) { boxplot_stats = boxplot(value, plot = FALSE)$stats data_scale = range(boxplot_stats) } else { data_scale = range(value, na.rm = TRUE) } } else { data_scale = ylim } data_scale = data_scale + c(-extend, extend)*(data_scale[2] - data_scale[1]) n = length(value) gp = recycle_gp(gp, n) if(length(pch) == 1) pch = rep(pch, n) if(length(size) == 1) size = rep(size, n) axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, data_scale) else NULL row_fun = function(index, k = 1, N = 1) { if(axis_param$direction == "reverse") { value = lapply(value, function(x) data_scale[2] - x + data_scale[1]) } n_all = length(value) value = value[index] boxplot_stats = boxplot(value, plot = FALSE)$stats n = length(index) gp = subset_gp(gp, index) pch = pch[index] size = size[index] pushViewport(viewport(xscale = data_scale, yscale = c(0.5, n+0.5))) grid.rect(x = boxplot_stats[2, ], y = n - seq_along(index) + 1, height = 1*box_width, width = boxplot_stats[4, ] - boxplot_stats[2, ], just = "left", default.units = "native", gp = gp) grid.segments(boxplot_stats[5, ], n - seq_along(index) + 1 - 0.5*box_width, boxplot_stats[5, ], n - seq_along(index) + 1 + 0.5*box_width, default.units = "native", gp = gp) grid.segments(boxplot_stats[5, ], n - seq_along(index) + 1, boxplot_stats[4, ], n - seq_along(index) + 1, default.units = "native", gp = gp) grid.segments(boxplot_stats[1, ], n - seq_along(index) + 1, boxplot_stats[2, ], n - seq_along(index) + 1, default.units = "native", gp = gp) grid.segments(boxplot_stats[1, ], n - seq_along(index) + 1 - 0.5*box_width, boxplot_stats[1, ], n - seq_along(index) + 1 + 0.5*box_width, default.units = "native", gp = gp) grid.segments(boxplot_stats[3, ], n - seq_along(index) + 1 - 0.5*box_width, boxplot_stats[3, ], n - seq_along(index) + 1 + 0.5*box_width, default.units = "native", gp = gp) if(outline) { for(i in seq_along(value)) { l1 = value[[i]] > boxplot_stats[5,i] l1[is.na(l1)] = FALSE if(sum(l1)) grid.points(y = rep(n - i + 1, sum(l1)), x = value[[i]][l1], default.units = "native", gp = subset_gp(gp, i), pch = pch[i], size = size[i]) l2 = value[[i]] < boxplot_stats[1,i] l2[is.na(l2)] = FALSE if(sum(l2)) grid.points(y = rep(n - i + 1, sum(l2)), x = value[[i]][l2], default.units = "native", gp = subset_gp(gp, i), pch = pch[i], size = size[i]) } } if(axis_param$side == "top") { if(k > 1) axis = FALSE } else if(axis_param$side == "bottom") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } column_fun = function(index, k = 1, N = 1) { if(axis_param$direction == "reverse") { value = lapply(value, function(x) data_scale[2] - x + data_scale[1]) } value = value[index] boxplot_stats = boxplot(value, plot = FALSE)$stats n = length(index) gp = subset_gp(gp, index) pch = pch[index] size = size[index] pushViewport(viewport(xscale = c(0.5, n+0.5), yscale = data_scale)) grid.rect(x = seq_along(index), y = boxplot_stats[2, ], height = boxplot_stats[4, ] - boxplot_stats[2, ], width = 1*box_width, just = "bottom", default.units = "native", gp = gp) grid.segments(seq_along(index) - 0.5*box_width, boxplot_stats[5, ], seq_along(index) + 0.5*box_width, boxplot_stats[5, ], default.units = "native", gp = gp) grid.segments(seq_along(index), boxplot_stats[5, ], seq_along(index), boxplot_stats[4, ], default.units = "native", gp = gp) grid.segments(seq_along(index), boxplot_stats[1, ], seq_along(index), boxplot_stats[2, ], default.units = "native", gp = gp) grid.segments(seq_along(index) - 0.5*box_width, boxplot_stats[1, ], seq_along(index) + 0.5*box_width, boxplot_stats[1, ], default.units = "native", gp = gp) grid.segments(seq_along(index) - 0.5*box_width, boxplot_stats[3, ], seq_along(index) + 0.5*box_width, boxplot_stats[3, ], default.units = "native", gp = gp) if(outline) { for(i in seq_along(value)) { l1 = value[[i]] > boxplot_stats[5,i] l1[is.na(l1)] = FALSE if(sum(l1)) grid.points(x = rep(i, sum(l1)), y = value[[i]][l1], default.units = "native", gp = subset_gp(gp, i), pch = pch[i], size = size[i]) l2 = value[[i]] < boxplot_stats[1,i] l2[is.na(l2)] = FALSE if(sum(l2)) grid.points(x = rep(i, sum(l2)), y = value[[i]][l2], default.units = "native", gp = subset_gp(gp, i), pch = pch[i], size = size[i]) } } if(axis_param$side == "left") { if(k > 1) axis = FALSE } else if(axis_param$side == "right") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_boxplot", which = which, n = n, width = anno_size$width, height = anno_size$height, data_scale = data_scale, var_import = list(value, gp, border, box_width, axis, axis_param, axis_grob, data_scale, pch, size, outline) ) anno@subset_rule$value = subset_vector anno@subset_rule$gp = subset_gp anno@subset_rule$pch = subset_vector anno@subset_rule$size = subset_vector anno@subsetable = TRUE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } # == title # Histogram Annotation # # == param # -x A matrix or a list. If ``x`` is a matrix and if ``which`` is ``column``, statistics for boxplots # are calculated by columns, if ``which`` is ``row``, the calculation is done by rows. # -which Whether it is a column annotation or a row annotation? # -n_breaks Number of breaks for calculating histogram. # -border Wether draw borders of the annotation region? # -gp Graphic parameters for the boxes. The length of the graphic parameters should be one or the number of observations. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#histogram-annotation # # == example # m = matrix(rnorm(1000), nc = 10) # anno = anno_histogram(t(m), which = "row") # draw(anno, test = "row histogram") # anno = anno_histogram(t(m), which = "row", gp = gpar(fill = 1:10)) # draw(anno, test = "row histogram with color") # anno = anno_histogram(t(m), which = "row", n_breaks = 20) # draw(anno, test = "row histogram with color") anno_histogram = function(x, which = c("column", "row"), n_breaks = 11, border = FALSE, gp = gpar(fill = "#CCCCCC"), axis = TRUE, axis_param = default_axis_param(which), width = NULL, height = NULL) { ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) anno_size = anno_width_and_height(which, width, height, unit(4, "cm")) ## convert matrix all to list (or data frame) if(is.matrix(x)) { if(which == "column") { value = as.data.frame(x) } else if(which == "row") { value = as.data.frame(t(x)) } } else { value = x } n = length(value) x_range =range(unlist(value), na.rm = TRUE) histogram_stats = lapply(value, hist, plot = FALSE, breaks = seq(x_range[1], x_range[2], length = n_breaks)) histogram_breaks = lapply(histogram_stats, function(x) x$breaks) histogram_counts = lapply(histogram_stats, function(x) x$counts) xscale = range(unlist(histogram_breaks), na.rm = TRUE) xscale = xscale + c(0, 0.05)*(xscale[2] - xscale[1]) yscale = c(0, max(unlist(histogram_counts))) yscale[2] = yscale[2]*1.05 gp = recycle_gp(gp, n) axis_param$direction = "normal" axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, xscale) else NULL row_fun = function(index, k = 1, N = 1) { n_all = length(value) value = value[index] n = length(index) histogram_breaks = histogram_breaks[index] histogram_counts = histogram_counts[index] gp = subset_gp(gp, index) for(i in seq_len(n)) { n_breaks = length(histogram_breaks[[i]]) pushViewport(viewport(x = unit(0, "npc"), y = unit((n-i)/n, "npc"), height = unit(1/n, "npc"), just = c("left", "bottom"), xscale = xscale, yscale = yscale)) grid.rect(x = histogram_breaks[[i]][-1], y = 0, width = histogram_breaks[[i]][-1] - histogram_breaks[[i]][-n_breaks], height = histogram_counts[[i]], just = c("right", "bottom"), default.units = "native", gp = subset_gp(gp, i)) popViewport() } pushViewport(viewport(xscale = xscale)) if(axis_param$side == "top") { if(k > 1) axis = FALSE } else if(axis_param$side == "bottom") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } column_fun = function(index, k = 1, N = 1) { n_all = length(value) value = value[index] foo = yscale yscale = xscale xscale = foo histogram_breaks = histogram_breaks[index] histogram_counts = histogram_counts[index] n = length(index) gp = subset_gp(gp, index) for(i in seq_len(n)) { n_breaks = length(histogram_breaks[[i]]) pushViewport(viewport(y = unit(0, "npc"), x = unit(i/n, "npc"), width = unit(1/n, "npc"), just = c("right", "bottom"), xscale = xscale, yscale = yscale)) grid.rect(y = histogram_breaks[[i]][-1], x = 0, height = histogram_breaks[[i]][-1] - histogram_breaks[[i]][-n_breaks], width = histogram_counts[[i]], just = c("left", "top"), default.units = "native", gp = subset_gp(gp, i)) popViewport() } pushViewport(viewport(yscale = yscale)) if(axis_param$side == "left") { if(k > 1) axis = FALSE } else if(axis_param$side == "right") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_histogram", which = which, width = anno_size$width, height = anno_size$height, n = n, data_scale = xscale, var_import = list(value, gp, border, axis, axis_param, axis_grob, xscale, yscale, histogram_breaks, histogram_counts) ) anno@subset_rule$value = subset_vector anno@subset_rule$gp = subset_gp anno@subset_rule$histogram_breaks = subset_vector anno@subset_rule$histogram_counts = subset_vector anno@subsetable = TRUE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } # == title # Density Annotation # # == param # -x A matrix or a list. If ``x`` is a matrix and if ``which`` is ``column``, statistics for boxplots # are calculated by columns, if ``which`` is ``row``, the calculation is done by rows. # -which Whether it is a column annotation or a row annotation? # -type Type of graphics to represent density distribution. "lines" for normal density plot; "violine" for violin plot # and "heatmap" for heatmap visualization of density distribution. # -heatmap_colors A vector of colors for interpolating density values. # -joyplot_scale Relative height of density distribution. A value higher than 1 increases the height of the density # distribution and the plot will represented as so-called "joyplot". # -border Wether draw borders of the annotation region? # -gp Graphic parameters for the boxes. The length of the graphic parameters should be one or the number of observations. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#density-annotation # # == example # m = matrix(rnorm(100), 10) # anno = anno_density(m, which = "row") # draw(anno, test = "normal density") # anno = anno_density(m, which = "row", type = "violin") # draw(anno, test = "violin") # anno = anno_density(m, which = "row", type = "heatmap") # draw(anno, test = "heatmap") # anno = anno_density(m, which = "row", type = "heatmap", # heatmap_colors = c("white", "orange")) # draw(anno, test = "heatmap, colors") anno_density = function(x, which = c("column", "row"), type = c("lines", "violin", "heatmap"), heatmap_colors = rev(brewer.pal(name = "RdYlBu", n = 11)), joyplot_scale = 1, border = TRUE, gp = gpar(fill = "#CCCCCC"), axis = TRUE, axis_param = default_axis_param(which), width = NULL, height = NULL) { ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) anno_size = anno_width_and_height(which, width, height, unit(4, "cm")) ## convert matrix all to list (or data frame) if(is.matrix(x)) { if(which == "column") { value = as.data.frame(x) } else if(which == "row") { value = as.data.frame(t(x)) } } else { value = x } n = length(value) gp = recycle_gp(gp, n) type = match.arg(type)[1] n_all = length(value) density_stats = lapply(value, density, na.rm = TRUE) density_x = lapply(density_stats, function(x) x$x) density_y = lapply(density_stats, function(x) x$y) min_density_x = min(unlist(density_x)) max_density_x = max(unlist(density_x)) xscale = range(unlist(density_x), na.rm = TRUE) xscale = xscale + c(0, 0.05)*(xscale[2] - xscale[1]) if(type == "lines") { yscale = c(0, max(unlist(density_y))) yscale[2] = yscale[2]*1.05 } else if(type == "violin") { yscale = max(unlist(density_y)) yscale = c(-yscale*1.05, yscale*1.05) } else if(type == "heatmap") { xscale = range(unlist(density_x), na.rm = TRUE) yscale = c(0, 1) min_y = min(unlist(density_y)) max_y = max(unlist(density_y)) col_fun = colorRamp2(seq(min_y, max_y, length = length(heatmap_colors)), heatmap_colors) } axis_param$direction = "normal" axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, xscale) else NULL row_fun = function(index, k = 1, N = 1) { n = length(index) value = value[index] gp = subset_gp(gp, index) density_x = density_x[index] density_y = density_y[index] for(i in seq_len(n)) { pushViewport(viewport(x = unit(0, "npc"), y = unit((n-i)/n, "npc"), just = c("left", "bottom"), height = unit(1/n, "npc"), xscale = xscale, yscale = yscale)) if(type == "lines") { grid.polygon(x = density_x[[i]], y = density_y[[i]]*joyplot_scale, default.units = "native", gp = subset_gp(gp, i)) } else if(type == "violin") { grid.polygon(x = c(density_x[[i]], rev(density_x[[i]])), y = c(density_y[[i]], -rev(density_y[[i]])), default.units = "native", gp = subset_gp(gp, i)) box_stat = boxplot(value[[i]], plot = FALSE)$stat grid.lines(box_stat[1:2, 1], c(0, 0), default.units = "native", gp = subset_gp(gp, i)) grid.lines(box_stat[4:5, 1], c(0, 0), default.units = "native", gp = subset_gp(gp, i)) grid.points(box_stat[3, 1], 0, default.units = "native", pch = 3, size = unit(1, "mm"), gp = subset_gp(gp, i)) } else if(type == "heatmap") { n_breaks = length(density_x[[i]]) grid.rect(x = density_x[[i]][-1], y = 0, width = density_x[[i]][-1] - density_x[[i]][-n_breaks], height = 1, just = c("right", "bottom"), default.units = "native", gp = gpar(fill = col_fun((density_y[[i]][-1] + density_y[[i]][-n_breaks])/2), col = NA)) grid.rect(x = density_x[[i]][1], y = 0, width = density_x[[i]][1] - min_density_x, height = 1, just = c("right", "bottom"), default.units = "native", gp = gpar(fill = col_fun(0), col = NA)) grid.rect(x = density_x[[i]][n_breaks], y = 0, width = max_density_x - density_x[[i]][n_breaks], height = 1, just = c("left", "bottom"), default.units = "native", gp = gpar(fill = col_fun(0), col = NA)) } popViewport() } pushViewport(viewport(xscale = xscale)) if(axis_param$side == "top") { if(k > 1) axis = FALSE } else if(axis_param$side == "bottom") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } column_fun = function(index, k = 1, N = 1) { n_all = length(value) value = value[index] foo = yscale yscale = xscale xscale = foo density_x = density_x[index] density_y = density_y[index] yscale = range(unlist(density_x), na.rm = TRUE) yscale = yscale + c(0, 0.05)*(yscale[2] - yscale[1]) if(type == "lines") { xscale = c(0, max(unlist(density_y))) xscale[2] = xscale[2]*1.05 } else if(type == "violin") { xscale = max(unlist(density_y)) xscale = c(-xscale*1.05, xscale*1.05) } else if(type == "heatmap") { yscale = range(unlist(density_x), na.rm = TRUE) xscale = c(0, 1) min_y = min(unlist(density_y)) max_y = max(unlist(density_y)) col_fun = colorRamp2(seq(min_y, max_y, length = length(heatmap_colors)), heatmap_colors) } n = length(index) gp = subset_gp(gp, index) for(i in rev(seq_len(n))) { pushViewport(viewport(y = unit(0, "npc"), x = unit(i/n, "npc"), width = unit(1/n, "npc"), just = c("right", "bottom"), xscale = xscale, yscale = yscale)) if(type == "lines") { grid.polygon(y = density_x[[i]], x = density_y[[i]]*joyplot_scale, default.units = "native", gp = subset_gp(gp, i)) } else if(type == "violin") { grid.polygon(y = c(density_x[[i]], rev(density_x[[i]])), x = c(density_y[[i]], -rev(density_y[[i]])), default.units = "native", gp = subset_gp(gp, i)) box_stat = boxplot(value[[i]], plot = FALSE)$stat grid.lines(y = box_stat[1:2, 1], x = c(0, 0), default.units = "native", gp = subset_gp(gp, i)) grid.lines(y = box_stat[4:5, 1], x = c(0, 0), default.units = "native", gp = subset_gp(gp, i)) grid.points(y = box_stat[3, 1], x = 0, default.units = "native", pch = 3, size = unit(1, "mm"), gp = subset_gp(gp, i)) } else if(type == "heatmap") { n_breaks = length(density_x[[i]]) grid.rect(y = density_x[[i]][-1], x = 0, height = density_x[[i]][-1] - density_x[[i]][-n_breaks], width = 1, just = c("left", "top"), default.units = "native", gp = gpar(fill = col_fun((density_y[[i]][-1] + density_y[[i]][-n_breaks])/2), col = NA)) grid.rect(y = density_x[[i]][1], x = 0, height = density_x[[i]][1] - min_density_x, width = 1, just = c("left", "top"), default.units = "native", gp = gpar(fill = col_fun(0), col = NA)) grid.rect(y = density_x[[i]][n_breaks], x = 0, height = max_density_x - density_x[[i]][n_breaks], width = 1, just = c("left", "bottom"), default.units = "native", gp = gpar(fill = col_fun(0), col = NA)) } popViewport() } pushViewport(viewport(yscale = yscale)) if(axis_param$side == "left") { if(k > 1) axis = FALSE } else if(axis_param$side == "right") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_density", which = which, width = anno_size$width, height = anno_size$height, n = n, data_scale = xscale, var_import = list(value, gp, border, type, axis, axis_param, axis_grob, xscale, yscale, density_x, density_y, min_density_x, max_density_x, joyplot_scale, heatmap_colors) ) if(type == "heatmap") { anno@var_env$col_fun = col_fun } anno@subset_rule$value = subset_vector anno@subset_rule$gp = subset_gp anno@subset_rule$density_x = subset_vector anno@subset_rule$density_y = subset_vector anno@subsetable = TRUE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } # == title # Text Annotation # # == param # -x A vector of text. # -which Whether it is a column annotation or a row annotation? # -gp Graphic parameters. # -rot Rotation of the text, pass to `grid::grid.text`. # -just Justification of text, pass to `grid::grid.text`. # -offset Depracated, use ``location`` instead. # -location Position of the text. By default ``rot``, ``just`` and ``location`` are automatically # inferred according to whether it is a row annotation or column annotation. The value # of ``location`` should be a `grid::unit` object, normally in ``npc`` unit. E.g. ``unit(0, 'npc')`` # means the most left of the annotation region and ``unit(1, 'npc')`` means the most right of # the annotation region. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#text-annotation # # == example # anno = anno_text(month.name) # draw(anno, test = "month names") # anno = anno_text(month.name, gp = gpar(fontsize = 16)) # draw(anno, test = "month names with fontsize") # anno = anno_text(month.name, gp = gpar(fontsize = 1:12+4)) # draw(anno, test = "month names with changing fontsize") # anno = anno_text(month.name, which = "row") # draw(anno, test = "month names on rows") # anno = anno_text(month.name, location = 0, rot = 45, # just = "left", gp = gpar(col = 1:12)) # draw(anno, test = "with rotations") # anno = anno_text(month.name, location = 1, # rot = 45, just = "right", gp = gpar(fontsize = 1:12+4)) # draw(anno, test = "with rotations") anno_text = function(x, which = c("column", "row"), gp = gpar(), rot = guess_rot(), just = guess_just(), offset = guess_location(), location = guess_location(), width = NULL, height = NULL) { ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) n = length(x) gp = recycle_gp(gp, n) guess_rot = function() { ifelse(which == "column", 90, 0) } guess_just = function() { ifelse(which == "column", "right", "left") } guess_location = function() { unit(ifelse(which == "column", 1, 0), "npc") } rot = rot[1] %% 360 just = just[1] if(!missing(offset)) { warning_wrap("`offset` is deprecated, use `location` instead.") if(missing(location)) { location = offset } } location = location[1] if(!inherits(location, "unit")) { location = unit(location, "npc") } if(which == "column") { if("right" %in% just) { if(rot < 180) { location = location - 0.5*grobHeight(textGrob("A", gp = gp))*abs(cos(rot/180*pi)) } else { location = location + 0.5*grobHeight(textGrob("A", gp = gp))*abs(cos(rot/180*pi)) } } else if("left" %in% just) { if(rot < 180) { location = location + 0.5*grobHeight(textGrob("A", gp = gp))*abs(cos(rot/180*pi)) } else { location = location - 0.5*grobHeight(textGrob("A", gp = gp))*abs(cos(rot/180*pi)) } } } if(which == "column") { if(missing(height)) { height = max_text_width(x, gp = gp)*abs(sin(rot/180*pi)) + grobHeight(textGrob("A", gp = gp))*abs(cos(rot/180*pi)) height = convertHeight(height, "mm") } if(missing(width)) { width = unit(1, "npc") } } if(which == "row") { if(missing(width)) { width = max_text_width(x, gp = gp)*abs(cos(rot/180*pi)) + grobHeight(textGrob("A", gp = gp))*abs(sin(rot/180*pi)) width = convertWidth(width, "mm") } if(missing(height)) { height = unit(1, "npc") } } anno_size = list(width = width, height = height) value = x row_fun = function(index) { n = length(index) gp = subset_gp(gp, index) gp2 = gp if("border" %in% names(gp2)) gp2$col = gp2$border if("fill" %in% names(gp2)) { if(!"border" %in% names(gp2)) gp2$col = gp2$fill } if(any(c("border", "fill") %in% names(gp2))) { grid.rect(y = (n - seq_along(index) + 0.5)/n, height = 1/n, gp = gp2) } grid.text(value[index], location, (n - seq_along(index) + 0.5)/n, gp = gp, just = just, rot = rot) } column_fun = function(index, k = NULL, N = NULL, vp_name = NULL) { n = length(index) gp = subset_gp(gp, index) gp2 = gp if("border" %in% names(gp2)) gp2$col = gp2$border if("fill" %in% names(gp2)) { if(!"border" %in% names(gp2)) gp2$col = gp2$fill } if(any(c("border", "fill") %in% names(gp2))) { grid.rect(x = (seq_along(index) - 0.5)/n, width = 1/n, gp = gp2) } grid.text(value[index], (seq_along(index) - 0.5)/n, location, gp = gp, just = just, rot = rot) } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_text", which = which, width = width, height = height, n = n, var_import = list(value, gp, just, rot, location), show_name = FALSE ) anno@subset_rule$value = subset_vector anno@subset_rule$gp = subset_gp anno@subsetable = TRUE return(anno) } # == title # Joyplot Annotation # # == param # -x A matrix or a list. If ``x`` is a matrix or a data frame, columns correspond to observations. # -which Whether it is a column annotation or a row annotation? # -gp Graphic parameters for the boxes. The length of the graphic parameters should be one or the number of observations. # -scale Relative height of the curve. A value higher than 1 increases the height of the curve. # -transparency Transparency of the filled colors. Value should be between 0 and 1. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#joyplot-annotation # # == example # m = matrix(rnorm(1000), nc = 10) # lt = apply(m, 2, function(x) data.frame(density(x)[c("x", "y")])) # anno = anno_joyplot(lt, width = unit(4, "cm"), which = "row") # draw(anno, test = "joyplot") # anno = anno_joyplot(lt, width = unit(4, "cm"), which = "row", gp = gpar(fill = 1:10)) # draw(anno, test = "joyplot + col") # anno = anno_joyplot(lt, width = unit(4, "cm"), which = "row", scale = 1) # draw(anno, test = "joyplot + scale") # # m = matrix(rnorm(5000), nc = 50) # lt = apply(m, 2, function(x) data.frame(density(x)[c("x", "y")])) # anno = anno_joyplot(lt, width = unit(4, "cm"), which = "row", gp = gpar(fill = NA), scale = 4) # draw(anno, test = "joyplot") anno_joyplot = function(x, which = c("column", "row"), gp = gpar(fill = "#000000"), scale = 2, transparency = 0.6, axis = TRUE, axis_param = default_axis_param(which), width = NULL, height = NULL) { ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) anno_size = anno_width_and_height(which, width, height, unit(4, "cm")) ## convert matrix all to list (or data frame) if(is.matrix(x) || is.data.frame(x)) { value = vector("list", ncol(x)) for(i in seq_len(ncol(x))) { value[[i]] = cbind(seq_len(nrow(x)), x[, i]) } } else if(inherits(x, "list")){ if(all(sapply(x, is.atomic))) { if(length(unique(sapply(x, length))) == 1) { value = vector("list", length(x)) for(i in seq_len(length(x))) { value[[i]] = cbind(seq_along(x[[i]]), x[[i]]) } } else { stop_wrap("Since x is a list, x need to be a list of two-column matrices.") } } else { value = x } } else { stop_wrap("The input should be a list of two-column matrices or a matrix/data frame.") } xscale = range(lapply(value, function(x) x[, 1]), na.rm = TRUE) xscale = xscale + c(-0.05, 0.05)*(xscale[2] - xscale[1]) yscale = range(lapply(value, function(x) x[, 2]), na.rm = TRUE) yscale[1] = 0 yscale[2] = yscale[2]*1.05 n = length(value) if(!"fill" %in% names(gp)) { gp$fill = "#000000" } gp = recycle_gp(gp, n) gp$fill = add_transparency(gp$fill, transparency) axis_param$direction = "normal" axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, xscale) else NULL row_fun = function(index, k = 1, N = 1) { n_all = length(value) value = value[index] n = length(index) gp = subset_gp(gp, index) for(i in seq_len(n)) { pushViewport(viewport(x = unit(0, "npc"), y = unit((n-i)/n, "npc"), just = c("left", "bottom"), height = unit(1/n, "npc"), xscale = xscale, yscale = yscale)) x0 = value[[i]][, 1] y0 = value[[i]][, 2]*scale x0 = c(x0[1], x0, x0[length(x0)]) y0 = c(0, y0, 0) gppp = subset_gp(gp, i); gppp$col = NA grid.polygon(x = x0, y = y0, default.units = "native", gp = gppp) grid.lines(x = x0, y = y0, default.units = "native", gp = subset_gp(gp, i)) popViewport() } pushViewport(viewport(xscale = xscale)) if(axis_param$side == "top") { if(k > 1) axis = FALSE } else if(axis_param$side == "bottom") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) popViewport() } column_fun = function(index, k = 1, N = 1) { n_all = length(value) value = value[index] foo = yscale yscale = xscale xscale = foo n = length(index) gp = subset_gp(gp, index) for(i in seq_len(n)) { pushViewport(viewport(y = unit(0, "npc"), x = unit(i/n, "npc"), width = unit(1/n, "npc"), just = c("right", "bottom"), xscale = xscale, yscale = yscale)) x0 = value[[i]][, 2]*scale y0 = value[[i]][ ,1] x0 = c(0, x0, 0) y0 = c(y0[1], y0, y0[length(y0)]) gppp = subset_gp(gp, i); gppp$col = NA grid.polygon(y = y0, x = x0, default.units = "native", gp = gppp) grid.lines(y = y0, x = x0, default.units = "native", gp = subset_gp(gp, i)) popViewport() } pushViewport(viewport(yscale = yscale)) if(axis_param$side == "left") { if(k > 1) axis = FALSE } else if(axis_param$side == "right") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_joyplot", which = which, width = anno_size$width, height = anno_size$height, n = n, data_scale = xscale, var_import = list(value, gp, axis, axis_param, axis_grob, scale, yscale, xscale) ) anno@subset_rule$value = subset_vector anno@subset_rule$gp = subset_gp anno@subsetable = TRUE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } # == title # Horizon chart Annotation # # == param # -x A matrix or a list. If ``x`` is a matrix or a data frame, columns correspond to observations. # -which Whether it is a column annotation or a row annotation? # -gp Graphic parameters for the boxes. The length of the graphic parameters should be one or the number of observations. # There are two unstandard parameters specificly for horizon chart: ``pos_fill`` and ``neg_fill`` controls the filled # color for positive values and negative values. # -n_slice Number of slices on y-axis. # -slice_size Height of the slice. If the value is not ``NULL``, ``n_slice`` will be recalculated. # -negative_from_top Whether the areas for negative values start from the top or the bottom of the plotting region? # -normalize Whether normalize ``x`` by max(abs(x)). # -gap Gap size of neighbouring horizon chart. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == detail # Horizon chart as row annotation is only supported. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#horizon-chart-annotation # # == example # lt = lapply(1:20, function(x) cumprod(1 + runif(1000, -x/100, x/100)) - 1) # anno = anno_horizon(lt, which = "row") # draw(anno, test = "horizon chart") # anno = anno_horizon(lt, which = "row", # gp = gpar(pos_fill = "orange", neg_fill = "darkgreen")) # draw(anno, test = "horizon chart, col") # anno = anno_horizon(lt, which = "row", negative_from_top = TRUE) # draw(anno, test = "horizon chart + negative_from_top") # anno = anno_horizon(lt, which = "row", gap = unit(1, "mm")) # draw(anno, test = "horizon chart + gap") # anno = anno_horizon(lt, which = "row", # gp = gpar(pos_fill = rep(c("orange", "red"), each = 10), # neg_fill = rep(c("darkgreen", "blue"), each = 10))) # draw(anno, test = "horizon chart, col") anno_horizon = function(x, which = c("column", "row"), gp = gpar(pos_fill = "#D73027", neg_fill = "#313695"), n_slice = 4, slice_size = NULL, negative_from_top = FALSE, normalize = TRUE, gap = unit(0, "mm"), axis = TRUE, axis_param = default_axis_param(which), width = NULL, height = NULL) { ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) anno_size = anno_width_and_height(which, width, height, unit(4, "cm")) ## convert matrix all to list (or data frame) if(is.matrix(x) || is.data.frame(x)) { value = vector("list", ncol(x)) for(i in seq_len(ncol(x))) { value[[i]] = cbind(seq_len(nrow(x)), x[, i]) } } else if(inherits(x, "list")){ if(all(sapply(x, is.atomic))) { if(length(unique(sapply(x, length))) == 1) { value = vector("list", length(x)) for(i in seq_len(length(x))) { value[[i]] = cbind(seq_along(x[[i]]), x[[i]]) } } else { stop_wrap("Since x is a list, x need to be a list of two-column matrices.") } } else { value = x } } else { stop_wrap("The input should be a list of two-column matrices or a matrix/data frame.") } if(is.null(gp$pos_fill)) gp$pos_fill = "#D73027" if(is.null(gp$neg_fill)) gp$neg_fill = "#313695" if("fill" %in% names(gp)) { foo = unlist(lapply(value, function(x) x[, 2])) if(all(foo >= 0)) { gp$pos_fill = gp$fill } else if(all(foo <= 0)) { gp$neg_fill = gp$fill } else { gp = gpar(pos_fill = "#D73027", neg_fill = "#313695") } } if(which == "column") { stop_wrap("anno_horizon() does not support column annotation.") } if(normalize) { value = lapply(value, function(m) { m[, 2] = m[, 2]/max(abs(m[, 2])) m }) } n = length(value) xscale = range(lapply(value, function(x) x[, 1]), na.rm = TRUE) yscale = range(lapply(value, function(x) abs(x[, 2])), na.rm = TRUE) axis_param$direction = "normal" axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, xscale) else NULL row_fun = function(index, k = 1, N = 1) { n_all = length(value) value = value[index] if(is.null(slice_size)) { slice_size = yscale[2]/n_slice } n_slice = ceiling(yscale[2]/slice_size) n = length(index) gp = subset_gp(gp, index) for(i in seq_len(n)) { pushViewport(viewport(x = unit(0, "npc"), y = unit((n-i)/n, "npc"), just = c("left", "bottom"), height = unit(1/n, "npc") - gap)) sgp = subset_gp(gp, i) horizon_chart(value[[i]][, 1], value[[i]][, 2], n_slice = n_slice, slice_size = slice_size, negative_from_top = negative_from_top, pos_fill = sgp$pos_fill, neg_fill = sgp$neg_fill) grid.rect(gp = gpar(fill = "transparent")) popViewport() } pushViewport(viewport(xscale = xscale)) if(axis_param$side == "top") { if(k > 1) axis = FALSE } else if(axis_param$side == "bottom") { if(k < N) axis = FALSE } if(axis) grid.draw(axis_grob) popViewport() } column_fun = function(index) { } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_horizon", which = which, width = anno_size$width, height = anno_size$height, n = n, data_scale = xscale, var_import = list(value, gp, axis, axis_param, axis_grob, n_slice, slice_size, negative_from_top, xscale, yscale, gap) ) anno@subset_rule$value = subset_vector anno@subset_rule$gp = subset_gp anno@subsetable = TRUE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } horizon_chart = function(x, y, n_slice = 4, slice_size, pos_fill = "#D73027", neg_fill = "#313695", negative_from_top = FALSE) { if(missing(slice_size)) { slice_size = max(abs(y))/n_slice } n_slice = ceiling(max(abs(y))/slice_size) if(n_slice == 0) { return(invisible(NULL)) } pos_col_fun = colorRamp2(c(0, n_slice), c("white", pos_fill)) neg_col_fun = colorRamp2(c(0, n_slice), c("white", neg_fill)) pushViewport(viewport(xscale = range(x), yscale = c(0, slice_size))) for(i in seq_len(n_slice)) { l1 = y >= (i-1)*slice_size & y < i*slice_size l2 = y < (i-1)*slice_size l3 = y >= i*slice_size if(any(l1)) { x2 = x y2 = y y2[l1] = y2[l1] - slice_size*(i-1) y2[l3] = slice_size x2[l2] = NA y2[l2] = NA add_horizon_polygon(x2, y2, gp = gpar(fill = pos_col_fun(i), col = NA), default.units = "native") } } y = -y for(i in seq_len(n_slice)) { l1 = y >= (i-1)*slice_size & y < i*slice_size l2 = y < (i-1)*slice_size l3 = y >= i*slice_size if(any(l1)) { x2 = x y2 = y y2[l1] = y2[l1] - slice_size*(i-1) y2[l3] = slice_size x2[l2] = NA y2[l2] = NA add_horizon_polygon(x2, y2, slice_size = slice_size, from_top = negative_from_top, gp = gpar(fill = neg_col_fun(i), col = NA), default.units = "native") } } popViewport() } # x and y may contain NA, split x and y by NA gaps, align the bottom to y = 0 add_horizon_polygon = function(x, y, slice_size = NULL, from_top = FALSE, ...) { ltx = split_vec_by_NA(x) lty = split_vec_by_NA(y) for(i in seq_along(ltx)) { x0 = ltx[[i]] y0 = lty[[i]] if(from_top) { x0 = c(x0[1], x0, x0[length(x0)]) y0 = c(slice_size, slice_size - y0, slice_size) } else { x0 = c(x0[1], x0, x0[length(x0)]) y0 = c(0, y0, 0) } grid.polygon(x0, y0, ...) } } # https://stat.ethz.ch/pipermail/r-help/2010-April/237031.html split_vec_by_NA = function(x) { idx = 1 + cumsum(is.na(x)) not.na = !is.na(x) split(x[not.na], idx[not.na]) } # == title # Points as Row Annotation # # == param # -... pass to `anno_points`. # # == details # A wrapper of `anno_points` with pre-defined ``which`` to ``row``. # # You can directly use `anno_points` for row annotation if you call it in `rowAnnotation`. # # == value # See help page of `anno_points`. # row_anno_points = function(...) { if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { message_wrap("From version 1.99.0, you can directly use `anno_points()` for row annotation if you call it in `rowAnnotation()`.") } anno_points(..., which = "row") } # == title # Barplots as Row Annotation # # == param # -... pass to `anno_barplot`. # # == details # A wrapper of `anno_barplot` with pre-defined ``which`` to ``row``. # # You can directly use `anno_barplot` for row annotation if you call it in `rowAnnotation`. # # == value # See help page of `anno_barplot`. # row_anno_barplot = function(...) { if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { message_wrap("From version 1.99.0, you can directly use `anno_barplot()` for row annotation if you call it in `rowAnnotation()`.") } anno_barplot(..., which = "row") } # == title # Boxplots as Row Annotation # # == param # -... pass to `anno_boxplot`. # # == details # A wrapper of `anno_boxplot` with pre-defined ``which`` to ``row``. # # You can directly use `anno_boxplot` for row annotation if you call it in `rowAnnotation`. # # == value # See help page of `anno_boxplot`. # row_anno_boxplot = function(...) { if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { message_wrap("From version 1.99.0, you can directly use `anno_boxplot()` for row annotation if you call it in `rowAnnotation()`.") } anno_boxplot(..., which = "row") } # == title # Histograms as Row Annotation # # == param # -... pass to `anno_histogram`. # # == details # A wrapper of `anno_histogram` with pre-defined ``which`` to ``row``. # # You can directly use `anno_histogram` for row annotation if you call it in `rowAnnotation`. # # == value # See help page of `anno_histogram`. # row_anno_histogram = function(...) { if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { message_wrap("From version 1.99.0, you can directly use `anno_histogram()` for row annotation if you call it in `rowAnnotation()`.") } anno_histogram(..., which = "row") } # == title # Density as Row Annotation # # == param # -... pass to `anno_density`. # # == details # A wrapper of `anno_density` with pre-defined ``which`` to ``row``. # # You can directly use `anno_density` for row annotation if you call it in `rowAnnotation`. # # == value # See help page of `anno_density`. # row_anno_density = function(...) { if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { message_wrap("From version 1.99.0, you can directly use `anno_density()` for row annotation if you call it in `rowAnnotation()`.") } anno_density(..., which = "row") } # == title # Text as Row Annotation # # == param # -... pass to `anno_text`. # # == details # A wrapper of `anno_text` with pre-defined ``which`` to ``row``. # # You can directly use `anno_text` for row annotation if you call it in `rowAnnotation`. # # == value # See help page of `anno_text`. # row_anno_text = function(...) { if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { message_wrap("From version 1.99.0, you can directly use `anno_text()` for row annotation if you call it in `rowAnnotation()`.") } anno_text(..., which = "row") } # == title # Link annotation with labels # # == param # -at Numeric index from the original matrix. # -labels Corresponding labels. # -which Whether it is a column annotation or a row annotation? # -side Side of the labels. If it is a column annotation, valid values are "top" and "bottom"; # If it is a row annotation, valid values are "left" and "right". # -lines_gp Please use ``link_gp`` instead. # -link_gp Graphic settings for the segments. # -labels_gp Graphic settings for the labels. # -labels_rot Rotations of labels, scalar. # -padding Padding between neighbouring labels in the plot. # -link_width Width of the segments. # -link_height Similar as ``link_width``, used for column annotation. # -extend By default, the region for the labels has the same width (if it is a column annotation) or # same height (if it is a row annotation) as the heatmap. The size can be extended by this options. # The value can be a proportion number or a `grid::unit` object. The length can be either one or two. # # == details # Sometimes there are many rows or columns in the heatmap and we want to mark some of the rows. # This annotation function is used to mark these rows and connect labels and corresponding rows # with links. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#mark-annotation # # == example # anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row") # draw(anno, index = 1:100, test = "anno_mark") # # m = matrix(1:1000, byrow = TRUE, nr = 100) # anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row") # Heatmap(m, cluster_rows = FALSE, cluster_columns = FALSE) + rowAnnotation(mark = anno) # Heatmap(m) + rowAnnotation(mark = anno) anno_mark = function(at, labels, which = c("column", "row"), side = ifelse(which == "column", "top", "right"), lines_gp = gpar(), labels_gp = gpar(), labels_rot = ifelse(which == "column", 90, 0), padding = unit(1, "mm"), link_width = unit(5, "mm"), link_height = link_width, link_gp = lines_gp, extend = unit(0, "mm")) { if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] } else { which = .ENV$current_annotation_which } if(!is.numeric(at)) { stop_wrap(paste0("`at` should be numeric ", which, " index corresponding to the matrix.")) } n = length(at) link_gp = recycle_gp(link_gp, n) labels_gp = recycle_gp(labels_gp, n) labels2index = structure(seq_along(at), names = labels) at2labels = structure(labels, names = at) if(length(extend) == 1) extend = rep(extend, 2) if(length(extend) > 2) extend = extend[1:2] if(!inherits(extend, "unit")) extend = unit(extend, "npc") if(which == "row") { height = unit(1, "npc") width = link_width + max_text_width(labels, gp = labels_gp, rot = labels_rot) } else { height = link_width + max_text_height(labels, gp = labels_gp, rot = labels_rot) width = unit(1, "npc") } .pos = NULL .scale = NULL labels_rot = labels_rot %% 360 if(!inherits(padding, "unit")) { padding = convertHeight(padding*grobHeight(textGrob("a", gp = subset_gp(labels_gp, 1))), "mm") } # a map between row index and positions # pos_map = row_fun = function(index) { n = length(index) # adjust at and labels at = intersect(index, at) if(length(at) == 0) { return(NULL) } labels = rev(at2labels[as.character(at)]) labels_gp = subset_gp(labels_gp, labels2index[labels]) link_gp = subset_gp(link_gp, labels2index[labels]) if(is.null(.scale)) { .scale = c(0.5, n+0.5) } pushViewport(viewport(xscale = c(0, 1), yscale = .scale)) if(inherits(extend, "unit")) extend = convertHeight(extend, "native", valueOnly = TRUE) if(labels_rot %in% c(90, 270)) { text_height = convertHeight(text_width(labels, gp = labels_gp) + padding, "native", valueOnly = TRUE) } else { text_height = convertHeight(text_height(labels, gp = labels_gp) + padding, "native", valueOnly = TRUE) } if(is.null(.pos)) { i2 = rev(which(index %in% at)) pos = n-i2+1 # position of rows } else { pos = .pos[rev(which(index %in% at))] } h1 = pos - text_height*0.5 h2 = pos + text_height*0.5 pos_adjusted = smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2])) h = (pos_adjusted[, 1] + pos_adjusted[, 2])/2 n2 = length(labels) if(side == "right") { if(labels_rot == 90) { just = c("center", "top") } else if(labels_rot == 270) { just = c("center", "bottom") } else if(labels_rot > 90 & labels_rot < 270 ) { just = c("right", "center") } else { just = c("left", "center") } } else { if(labels_rot == 90) { just = c("center", "bottom") } else if(labels_rot == 270) { just = c("center", "top") } else if(labels_rot > 90 & labels_rot < 270 ) { just = c("left", "center") } else { just = c("right", "center") } } if(side == "right") { grid.text(labels, rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = just) link_width = link_width - unit(1, "mm") grid.segments(unit(rep(0, n2), "npc"), pos, rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp) grid.segments(rep(link_width*(1/3), n2), pos, rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp) grid.segments(rep(link_width*(2/3), n2), h, rep(link_width, n2), h, default.units = "native", gp = link_gp) } else { grid.text(labels, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = just) link_width = link_width - unit(1, "mm") grid.segments(unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp) grid.segments(unit(1, "npc")-rep(link_width*(1/3), n2), pos, unit(1, "npc")-rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp) grid.segments(unit(1, "npc")-rep(link_width*(2/3), n2), h, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = link_gp) } upViewport() } column_fun = function(index) { n = length(index) # adjust at and labels at = intersect(index, at) if(length(at) == 0) { return(NULL) } labels = at2labels[as.character(at)] labels_gp = subset_gp(labels_gp, labels2index[labels]) link_gp = subset_gp(link_gp, labels2index[labels]) if(is.null(.scale)) { .scale = c(0.5, n+0.5) } pushViewport(viewport(yscale = c(0, 1), xscale = .scale)) if(inherits(extend, "unit")) extend = convertWidth(extend, "native", valueOnly = TRUE) if(labels_rot %in% c(0, 180)) { text_height = convertWidth(text_width(labels, gp = labels_gp) + padding, "native", valueOnly = TRUE) } else { text_height = convertWidth(text_height(labels, gp = labels_gp) + padding, "native", valueOnly = TRUE) } if(is.null(.pos)) { i2 = which(index %in% at) pos = i2 # position of rows } else { pos = .pos[which(index %in% at)] } h1 = pos - text_height*0.5 h2 = pos + text_height*0.5 pos_adjusted = smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2])) h = (pos_adjusted[, 1] + pos_adjusted[, 2])/2 n2 = length(labels) if(side == "top") { if(labels_rot == 0) { just = c("center", "bottom") } else if(labels_rot == 180) { just = c("center", "top") } else if(labels_rot > 0 & labels_rot < 180 ) { just = c("left", "center") } else { just = c("right", "center") } } else { if(labels_rot == 0) { just = c("center", "top") } else if(labels_rot == 180) { just = c("center", "bottom") } else if(labels_rot > 0 & labels_rot < 180 ) { just = c("right", "center") } else { just = c("left", "center") } } if(side == "top") { grid.text(labels, h, rep(link_height, n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = just) link_height = link_height - unit(1, "mm") grid.segments(pos, unit(rep(0, n2), "npc"), pos, rep(link_height*(1/3), n2), default.units = "native", gp = link_gp) grid.segments(pos, rep(link_height*(1/3), n2), h, rep(link_height*(2/3), n2), default.units = "native", gp = link_gp) grid.segments(h, rep(link_height*(2/3), n2), h, rep(link_height, n), default.units = "native", gp = link_gp) } else { grid.text(labels, h, unit(1, "npc")-rep(link_height, n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = just) link_height = link_height - unit(1, "mm") grid.segments(pos, unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_height*(1/3), n2), default.units = "native", gp = link_gp) grid.segments(pos, unit(1, "npc")-rep(link_height*(1/3), n2), h, unit(1, "npc")-rep(link_height*(2/3), n2), default.units = "native", gp = link_gp) grid.segments(h, unit(1, "npc")-rep(link_height*(2/3), n2), h, unit(1, "npc")-rep(link_height, n2), default.units = "native", gp = link_gp) } upViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_mark", which = which, width = width, height = height, n = -1, var_import = list(at, labels2index, at2labels, link_gp, labels_gp, labels_rot, padding, .pos, .scale, side, link_width, link_height, extend), show_name = FALSE ) anno@subset_rule$at = subset_by_intersect anno@subsetable = TRUE return(anno) } subset_by_intersect = function(x, i) { intersect(x, i) } # == title # Label Markers Annotation # # == param # -... Pass to `anno_mark`. # # == details # `anno_link` is deprecated, please use `anno_mark` instead. # anno_link = function(...) { warning_wrap("anno_link() is deprecated, please use anno_mark() instead.") anno_mark(...) } # == title # Label Markers as Row Annotation # # == param # -... pass to `anno_link`. # # == details # A wrapper of `anno_link` with pre-defined ``which`` to ``row``. # # You can directly use `anno_link` for row annotation if you call it in `rowAnnotation`. # # == value # See help page of `anno_link`. # row_anno_link = function(...) { if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { message_wrap("From version 1.99.0, you can directly use `anno_mark()` for row annotation if you call it in `rowAnnotation()`.") } anno_link(..., which = "row") } # == title # Summary Annotation # # == param # -which Whether it is a column annotation or a row annotation? # -border Wether draw borders of the annotation region? # -bar_width Relative width of the bars. The value should be smaller than one. # -axis Whether to add axis? # -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. # -ylim Data ranges. ``ylim`` for barplot is enforced to be ``c(0, 1)``. # -extend The extension to both side of ``ylim``. The value is a percent value corresponding to ``ylim[2] - ylim[1]``. This argument is only for boxplot. # -outline Whether draw outline of boxplots? # -box_width Relative width of boxes. The value should be smaller than one. # -pch Point style. # -size Point size. # -gp Graphic parameters. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == detail # ``anno_summary`` is a special annotation function that it only works for one-column or one-row heatmap. # It shows the summary of the values in the heatmap. If the values in the heatmap is discrete, # the proportion of each level (the sum is normalized to 1) is visualized as stacked barplot. If the heatmap # is split into multiple slices, multiple bars are put in the annotation. If the value is continuous, boxplot is used. # # In the barplot, the color schema is used as the same as the heatmap, while for the boxplot, the color needs # to be controlled by ``gp``. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#summary-annotation # # == example # ha = HeatmapAnnotation(summary = anno_summary(height = unit(4, "cm"))) # v = sample(letters[1:2], 50, replace = TRUE) # split = sample(letters[1:2], 50, replace = TRUE) # Heatmap(v, top_annotation = ha, width = unit(1, "cm"), split = split) # # ha = HeatmapAnnotation(summary = anno_summary(gp = gpar(fill = 2:3), height = unit(4, "cm"))) # v = rnorm(50) # Heatmap(v, top_annotation = ha, width = unit(1, "cm"), split = split) # anno_summary = function(which = c("column", "row"), border = TRUE, bar_width = 0.8, axis = TRUE, axis_param = default_axis_param(which), ylim = NULL, extend = 0.05, outline = TRUE, box_width = 0.6, pch = 1, size = unit(2, "mm"), gp = gpar(), width = NULL, height = NULL) { ef = function() NULL if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] dev.null() ef = dev.off2 } else { which = .ENV$current_annotation_which } on.exit(ef()) anno_size = anno_width_and_height(which, width, height, unit(2, "cm")) axis_param = validate_axis_param(axis_param, which) if(is.null(ylim)) { axis_grob = if(axis) construct_axis_grob(axis_param, which, c(0, 1)) else NULL } else { axis_grob = if(axis) construct_axis_grob(axis_param, which, ylim) else NULL } row_fun = function(index) { ht = get("object", envir = parent.frame(7)) mat = ht@matrix cm = ht@matrix_color_mapping order_list = ht@column_order_list ng = length(order_list) if(cm@type == "discrete") { tl = lapply(order_list, function(od) table(mat[1, od])) tl = lapply(tl, function(x) x/sum(x)) pushViewport(viewport(yscale = c(0.5, ng+0.5), xscale = c(0, 1))) for(i in 1:ng) { x = i y = cumsum(tl[[i]]) grid.rect(y, x, height = bar_width, width = tl[[i]], just = "right", gp = gpar(fill = map_to_colors(cm, names(y))), default.units = "native") } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } else { } } column_fun = function(index) { ht = get("object", envir = parent.frame(7)) mat = ht@matrix cm = ht@matrix_color_mapping order_list = ht@row_order_list ng = length(order_list) if(cm@type == "discrete") { if(!is.null(ylim)) { stop_wrap("For discrete matrix, `ylim` is not allowed to set. It is always c(0, 1).") } tl = lapply(order_list, function(od) table(mat[od, 1])) tl = lapply(tl, function(x) x/sum(x)) pushViewport(viewport(xscale = c(0.5, ng+0.5), yscale = c(0, 1))) for(i in 1:ng) { x = i y = cumsum(tl[[i]]) grid.rect(x, y, width = bar_width, height = tl[[i]], just = "top", gp = gpar(fill = map_to_colors(cm, names(y))), default.units = "native") } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } else { vl = lapply(order_list, function(od) mat[od, 1]) nv = length(vl) if(is.null(ylim)) { if(!outline) { boxplot_stats = boxplot(vl, plot = FALSE)$stats data_scale = range(boxplot_stats) } else { data_scale = range(vl, na.rm = TRUE) } } else { data_scale = ylim } data_scale = data_scale + c(-extend, extend)*(data_scale[2] - data_scale[1]) if(is.null(ylim)) { axis_param = validate_axis_param(axis_param, which) axis_grob = if(axis) construct_axis_grob(axis_param, which, data_scale) else NULL } gp = recycle_gp(gp, nv) if(length(pch) == 1) pch = rep(pch, nv) if(length(size) == 1) size = rep(size, nv) pushViewport(viewport(xscale = c(0.5, ng+0.5), yscale = data_scale)) for(i in 1:ng) { x = i v = vl[[i]] grid.boxplot(v, pos = x, box_width = box_width, gp = subset_gp(gp, i), pch = pch, size = size, outline = outline) } if(axis) grid.draw(axis_grob) if(border) grid.rect(gp = gpar(fill = "transparent")) popViewport() } } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_summary", which = which, width = width, height = height, var_import = list(bar_width, border, axis, axis_grob, axis_param, which, ylim, extend, outline, box_width, pch, size, gp), n = 1, show_name = FALSE ) anno@subsetable = FALSE anno@extended = update_anno_extend(anno, axis_grob, axis_param) return(anno) } # == title # Block annotation # # == param # -gp Graphic parameters. # -labels Labels put on blocks. # -labels_gp Graphic parameters for labels. # -labels_rot Rotation for labels. # -which Is it a row annotation or a column annotation? # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == details # The block annotation is used for representing slices. The length of all arguments should be 1 or the number of slices. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#block-annotation # # == example # Heatmap(matrix(rnorm(100), 10), # top_annotation = HeatmapAnnotation(foo = anno_block(gp = gpar(fill = 2:4), # labels = c("group1", "group2", "group3"), labels_gp = gpar(col = "white"))), # column_km = 3, # left_annotation = rowAnnotation(foo = anno_block(gp = gpar(fill = 2:4), # labels = c("group1", "group2", "group3"), labels_gp = gpar(col = "white"))), # row_km = 3) anno_block = function(gp = gpar(), labels = NULL, labels_gp = gpar(), labels_rot = ifelse(which == "row", 90, 0), which = c("column", "row"), width = NULL, height = NULL) { if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] } else { which = .ENV$current_annotation_which } if(length(labels)) { if(which == "column") { height = grobHeight(textGrob(labels, rot = labels_rot, gp = labels_gp)) height = height + unit(5, "mm") } else { width = grobWidth(textGrob(labels, rot = labels_rot, gp = labels_gp)) width = width + unit(5, "mm") } } anno_size = anno_width_and_height(which, width, height, unit(5, "mm")) fun = function(index, k, n) { gp = subset_gp(recycle_gp(gp, n), k) grid.rect(gp = gp) if(length(labels)) { if(length(labels) != n) { stop_wrap("Length of `labels` should be as same as number of slices.") } label = labels[k] labels_gp = subset_gp(recycle_gp(labels_gp, n), k) grid.text(label, gp = labels_gp, rot = labels_rot) } } anno = AnnotationFunction( fun = fun, n = NA, fun_name = "anno_block", which = which, var_import = list(gp, labels, labels_gp, labels_rot), subset_rule = list(), subsetable = TRUE, height = anno_size$height, width = anno_size$width, show_name = FALSE ) return(anno) } # == title # Zoom annotation # # == param # -align_to It defines how the boxes correspond to the rows or the columns in the heatmap. # If the value is a list of indices, each box corresponds to the rows or columns with indices # in one vector in the list. If the value is a categorical variable (e.g. a factor or a character vector) # that has the same length as the rows or columns in the heatmap, each box corresponds to the rows/columns # in each level in the categorical variable. # -panel_fun A self-defined function that defines how to draw graphics in the box. The function must have # a ``index`` argument which is the indices for the rows/columns that the box corresponds to. It can # have second argument ``nm`` which is the "name" of the selected part in the heatmap. The corresponding # value for ``nm`` comes from ``align_to`` if it is specified as a categorical variable or a list with names. # -which Whether it is a column annotation or a row annotation? # -side Side of the boxes If it is a column annotation, valid values are "top" and "bottom"; # If it is a row annotation, valid values are "left" and "right". # -size The size of boxes. It can be pure numeric that they are treated as relative fractions of the total # height/width of the heatmap. The value of ``size`` can also be absolute units. # -gap Gaps between boxes. # -link_gp Graphic settings for the segments. # -link_width Width of the segments. # -link_height Similar as ``link_width``, used for column annotation. # -extend By default, the region for the labels has the same width (if it is a column annotation) or # same height (if it is a row annotation) as the heatmap. The size can be extended by this options. # The value can be a proportion number or a `grid::unit` object. The length can be either one or two. # -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation. # -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation. # # == details # `anno_zoom` creates several plotting regions (boxes) which can be corresponded to subsets of rows/columns in the # heatmap. # # == value # An annotation function which can be used in `HeatmapAnnotation`. # # == seealso # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#zoom-annotation # # == example # set.seed(123) # m = matrix(rnorm(100*10), nrow = 100) # subgroup = sample(letters[1:3], 100, replace = TRUE, prob = c(1, 5, 10)) # rg = range(m) # panel_fun = function(index, nm) { # pushViewport(viewport(xscale = rg, yscale = c(0, 2))) # grid.rect() # grid.xaxis(gp = gpar(fontsize = 8)) # grid.boxplot(m[index, ], pos = 1, direction = "horizontal") # grid.text(paste("distribution of group", nm), mean(rg), y = 1.9, # just = "top", default.units = "native", gp = gpar(fontsize = 10)) # popViewport() # } # anno = anno_zoom(align_to = subgroup, which = "row", panel_fun = panel_fun, # size = unit(2, "cm"), gap = unit(1, "cm"), width = unit(4, "cm")) # Heatmap(m, right_annotation = rowAnnotation(foo = anno), row_split = subgroup) # anno_zoom = function(align_to, panel_fun = function(index, nm = NULL) { grid.rect() }, which = c("column", "row"), side = ifelse(which == "column", "top", "right"), size = NULL, gap = unit(1, "mm"), link_width = unit(5, "mm"), link_height = link_width, link_gp = gpar(), extend = unit(0, "mm"), width = NULL, height = NULL) { if(is.null(.ENV$current_annotation_which)) { which = match.arg(which)[1] } else { which = .ENV$current_annotation_which } anno_size = anno_width_and_height(which, width, height, unit(2, "cm") + link_width) # align_to should be # 1. a vector of class labels that the length should be same as the nrow of the matrix # 2. a list of numeric indices if(is.list(align_to)) { if(!any(sapply(align_to, is.numeric))) { stop_wrap(paste0("`at` should be numeric ", which, " index corresponding to the matrix.")) } } .pos = NULL # position of the rows if(length(as.list(formals(panel_fun))) == 1) { formals(panel_fun) = alist(index = , nm = NULL) } if(length(extend) == 1) extend = rep(extend, 2) if(length(extend) > 2) extend = extend[1:2] if(!inherits(extend, "unit")) extend = unit(extend, "npc") # anno_zoom is always executed in one-slice mode (which means mulitple slices # are treated as one big slilce) row_fun = function(index) { n = length(index) if(is.atomic(align_to)) { if(length(setdiff(align_to, index)) == 0 && !any(duplicated(align_to))) { align_to = list(align_to) } else { if(length(align_to) != n) { stop_wrap("If `align_to` is a vector with group labels, the length should be the same as the number of rows in the heatmap.") } lnm = as.character(unique(align_to[index])) align_to = as.list(tapply(seq_along(align_to), align_to, function(x) x)) align_to = align_to[lnm] } } nrl = sapply(align_to, length) align_to_df = lapply(align_to, function(x) { ind = which(index %in% x) n = length(ind) s = NULL e = NULL s[1] = ind[1] if(n > 1) { ind2 = which(ind[2:n] - ind[1:(n-1)] > 1) if(length(ind2)) s = c(s, ind[ ind2 + 1 ]) k = length(s) e[k] = ind[length(ind)] if(length(ind2)) e[1:(k-1)] = ind[1:(n-1)][ ind2 ] } else { e = ind[1] } data.frame(s = s, e = e) }) # pos is from top to bottom if(is.null(.pos)) { pos = (n:1 - 0.5)/n # position of rows } else { pos = .pos } .scale = c(0, 1) pushViewport(viewport(xscale = c(0, 1), yscale = .scale)) if(inherits(extend, "unit")) extend = convertHeight(extend, "native", valueOnly = TRUE) # the position of boxes initially are put evenly # add the gap n_boxes = length(align_to) if(length(gap) == 1) gap = rep(gap, n_boxes) if(is.null(size)) size = nrl if(length(size) == 1) size = rep(size, length(align_to)) if(length(size) != length(align_to)) { stop_wrap("Length of `size` should be the same as the number of groups of indices.") } if(!inherits(size, "unit")) { size_is_unit = FALSE if(n_boxes == 1) { h = data.frame(bottom = .scale[1] - extend[1], top = .scale[2] + extend[2]) } else { size = as.numeric(size) gap = convertHeight(gap, "native", valueOnly = TRUE) box_height = size/sum(size) * (1 + sum(extend) - sum(gap[1:(n_boxes-1)])) h = data.frame( top = cumsum(box_height) + cumsum(gap) - gap[length(gap)] - extend[1] ) h$bottom = h$top - box_height h = 1 - h[, 2:1] colnames(h) = c("top", "bottom") } } else { size_is_unit = TRUE box_height = size box_height2 = box_height # box_height2 adds the gap for(i in 1:n_boxes) { if(i == 1 || i == n_boxes) { if(n_boxes > 1) { box_height2[i] = box_height2[i] + gap[i]*0.5 } } else { box_height2[i] = box_height2[i] + gap[i] } } box_height2 = convertHeight(box_height2, "native", valueOnly = TRUE) # the original positions of boxes mean_pos = sapply(align_to_df, function(df) mean((pos[df[, 1]] + pos[df[, 2]])/2)) h1 = mean_pos - box_height2*0.5 h2 = mean_pos + box_height2*0.5 h = smartAlign2(rev(h1), rev(h2), c(.scale[1] - extend[1], .scale[2] + extend[2])) colnames(h) = c("bottom", "top") h = h[nrow(h):1, , drop = FALSE] # recalcualte h to remove gaps gap_height = convertHeight(gap, "native", valueOnly = TRUE) if(n_boxes > 1) { for(i in 1:n_boxes) { if(i == 1) { h[i, "bottom"] = h[i, "bottom"] + gap_height[i]/2 } else if(i == n_boxes) { h[i, "top"] = h[i, "top"] - gap_height[i]/2 } else { h[i, "bottom"] = h[i, "bottom"] + gap_height[i]/2 h[i, "top"] = h[i, "top"] - gap_height[i]/2 } } } } popViewport() # draw boxes if(side == "right") { pushViewport(viewport(x = link_width, just = "left", width = anno_size$width - link_width)) } else { pushViewport(viewport(x = 0, just = "left", width = anno_size$width - link_width)) } for(i in 1:n_boxes) { current_vp_name = current.viewport()$name pushViewport(viewport(y = (h[i, "top"] + h[i, "bottom"])/2, height = h[i, "top"] - h[i, "bottom"], default.units = "native")) if(is.function(panel_fun)) panel_fun(align_to[[i]], names(align_to)[i]) popViewport() if(current.viewport()$name != current_vp_name) { stop_wrap("If you push viewports `panel_fun`, you need to pop all them out.") } } popViewport() # draw the links link_gp = recycle_gp(link_gp, n_boxes) if(side == "right") { pushViewport(viewport(x = unit(0, "npc"), just = "left", width = link_width)) } else { pushViewport(viewport(x = unit(1, "npc"), just = "right", width = link_width)) } for(i in 1:n_boxes) { df = align_to_df[[i]] for(j in 1:nrow(df)) { # draw each polygon if(side == "right") { grid.polygon(unit.c(unit(c(0, 0), "npc"), rep(link_width, 2)), c(pos[df[j, 2]] - 0.5/n, pos[df[j, 1]] + 0.5/n, h[i, "top"], h[i, "bottom"]), default.units = "native", gp = subset_gp(link_gp, i)) } else { grid.polygon(unit.c(rep(link_width, 2), unit(c(0, 0), "npc")), c(pos[df[j, 2]] - 0.5/n, pos[df[j, 1]] + 0.5/n, h[i, "top"], h[i, "bottom"]), default.units = "native", gp = subset_gp(link_gp, i)) } } } popViewport() } column_fun = function(index) { n = length(index) if(is.atomic(align_to)) { if(length(setdiff(align_to, index)) == 0 && !any(duplicated(align_to))) { align_to = list(align_to) } else { if(length(align_to) != n) { stop_wrap("If `align_to` is a vector with group labels, the length should be the same as the number of columns in the heatmap.") } lnm = as.character(unique(align_to[index])) align_to = as.list(tapply(seq_along(align_to), align_to, function(x) x)) align_to = align_to[lnm] } } nrl = sapply(align_to, length) align_to_df = lapply(align_to, function(x) { ind = which(index %in% x) n = length(ind) s = NULL e = NULL s[1] = ind[1] if(n > 1) { ind2 = which(ind[2:n] - ind[1:(n-1)] > 1) if(length(ind2)) s = c(s, ind[ ind2 + 1 ]) k = length(s) e[k] = ind[length(ind)] if(length(ind2)) e[1:(k-1)] = ind[1:(n-1)][ ind2 ] } else { e = ind[1] } data.frame(s = s, e = e) }) if(is.null(.pos)) { pos = (1:n - 0.5)/n } else { pos = .pos } .scale = c(0, 1) pushViewport(viewport(yscale = c(0, 1), xscale = .scale)) if(inherits(extend, "unit")) extend = convertWidth(extend, "native", valueOnly = TRUE) # the position of boxes initially are put evenly # add the gap n_boxes = length(align_to) if(length(gap) == 1) gap = rep(gap, n_boxes) if(is.null(size)) size = nrl if(length(size) == 1) size = rep(size, length(align_to)) if(length(size) != length(align_to)) { stop_wrap("Length of `size` should be the same as the number of groups of indices.") } if(!inherits(size, "unit")) { size_is_unit = FALSE if(n_boxes == 1) { h = data.frame(left = .scale[1] - extend[1], right = .scale[2] + extend[2]) } else { size = as.numeric(size) gap = convertWidth(gap, "native", valueOnly = TRUE) box_width = size/sum(size) * (1 + sum(extend) - sum(gap[1:(n_boxes-1)])) h = data.frame( right = cumsum(box_width) + cumsum(gap) - gap[length(gap)] - extend[1] ) h$left = h$right - box_width } } else { size_is_unit = TRUE box_width = size box_width2 = box_width for(i in 1:n_boxes) { if(i == 1 || i == n_boxes) { if(n_boxes > 1) { box_width2[i] = box_width2[i] + gap[i]*0.5 } } else { box_width2[i] = box_width2[i] + gap[i] } } box_width2 = convertWidth(box_width2, "native", valueOnly = TRUE) # the original positions of boxes mean_pos = sapply(align_to_df, function(df) mean((pos[df[, 1]] + pos[df[, 2]])/2)) h1 = mean_pos - box_width2*0.5 h2 = mean_pos + box_width2*0.5 h = smartAlign2(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2])) colnames(h) = c("left", "right") # recalcualte h to remove gaps gap_width = convertWidth(gap, "native", valueOnly = TRUE) if(n_boxes > 1) { for(i in 1:n_boxes) { if(i == 1) { h[i, "left"] = h[i, "left"] + gap_width[i]/2 } else if(i == n_boxes) { h[i, "right"] = h[i, "right"] - gap_width[i]/2 } else { h[i, "left"] = h[i, "left"] + gap_width[i]/2 h[i, "right"] = h[i, "right"] - gap_width[i]/2 } } } } popViewport() # draw boxes if(side == "top") { pushViewport(viewport(y = link_height, just = "bottom", height = anno_size$height - link_height)) } else { pushViewport(viewport(y = 0, just = "bottom", height = anno_size$height - link_height)) } for(i in 1:n_boxes) { current_vp_name = current.viewport()$name pushViewport(viewport(x = (h[i, "right"] + h[i, "left"])/2, width = h[i, "right"] - h[i, "left"], default.units = "native")) if(is.function(panel_fun)) panel_fun(align_to[[i]], names(align_to)[i]) popViewport() if(current.viewport()$name != current_vp_name) { stop_wrap("If you push viewports `panel_fun`, you need to pop all them out.") } } popViewport() # draw the links link_gp = recycle_gp(link_gp, n_boxes) if(side == "top") { pushViewport(viewport(y = unit(0, "npc"), just = "bottom", height = link_height)) } else { pushViewport(viewport(y = unit(1, "npc"), just = "top", height = link_height)) } for(i in 1:n_boxes) { df = align_to_df[[i]] for(j in 1:nrow(df)) { # draw each polygon if(side == "top") { grid.polygon( c(pos[df[j, 2]] + 0.5/n, pos[df[j, 1]] - 0.5/n, h[i, "left"], h[i, "right"]), unit.c(unit(c(0, 0), "npc"), rep(link_width, 2)), default.units = "native", gp = subset_gp(link_gp, i)) } else { grid.polygon( c(pos[df[j, 2]] + 0.5/n, pos[df[j, 1]] - 0.5/n, h[i, "left"], h[i, "right"]), unit.c(rep(link_width, 2), unit(c(0, 0), "npc")), default.units = "native", gp = subset_gp(link_gp, i)) } } } popViewport() } if(which == "row") { fun = row_fun } else if(which == "column") { fun = column_fun } anno = AnnotationFunction( fun = fun, fun_name = "anno_zoom", which = which, height = anno_size$height, width = anno_size$width, n = -1, var_import = list(align_to, .pos, gap, size, panel_fun, side, anno_size, extend, link_width, link_height, link_gp), show_name = FALSE ) anno@subset_rule$align_to = function(x, i) { if(is.atomic(x)) { x[i] } else { x = lapply(x, function(x) intersect(x, i)) x = x[sapply(x, length) > 0] } } anno@subsetable = TRUE return(anno) }