# == title # Class for a Single Annotation # # == details # The `SingleAnnotation-class` is used for storing data for a single annotation and provides # methods for drawing annotation graphics. # # == methods # The `SingleAnnotation-class` provides following methods: # # - `SingleAnnotation`: constructor method # - `draw,SingleAnnotation-method`: draw the single annotation. # # == seealso # The `SingleAnnotation-class` is always used internally. The public `HeatmapAnnotation-class` # contains a list of `SingleAnnotation-class` objects and is used to add annotation graphics on heatmaps. # # == author # Zuguang Gu <z.gu@dkfz.de> # SingleAnnotation = setClass("SingleAnnotation", slots = list( name = "character", color_mapping = "ANY", # a ColorMapping object or NULL legend_param = "ANY", # a list or NULL, it contains parameters for color_mapping_legend fun = "ANY", show_legend = "logical", which = "character", name_to_data_vp = "logical", name_param = "list", is_anno_matrix = "logical", color_is_random = "logical", width = "ANY", height = "ANY", extended = "ANY", subsetable = "logical" ), prototype = list( color_mapping = NULL, fun = function(index) NULL, show_legend = TRUE, color_is_random = FALSE, name_to_data_vp = FALSE, extended = unit(c(0, 0, 0, 0), "mm"), subsetable = FALSE ) ) # == title # Constructor Method for SingleAnnotation Class # # == param # -name Name for the annotation. If it is not specified, an internal name is assigned. # -value A vector or a matrix of discrete or continuous values. # -col Colors corresponding to ``value``. If the mapping is discrete, the value of ``col`` # should be a named vector; If the mapping is continuous, the value of ``col`` should be # a color mapping function. # -fun A user-defined function to add annotation graphics. The argument of this function should be at least # a vector of index that corresponds to rows or columns. Normally the function should be # constructed by `AnnotationFunction` if you want the annotation supports splitting. # See **Details** for more explanation. # -na_col Color for ``NA`` values in the simple annotations. # -which Whether the annotation is a row annotation or a column annotation? # -show_legend If it is a simple annotation, whether show legend in the final heatmap? # -gp Since simple annotation is represented as rows of grids. This argument controls graphic parameters for the simple annotation. # The ``fill`` parameter is ignored here. # -border border, only work for simple annotation # -legend_param Parameters for the legend. See `color_mapping_legend,ColorMapping-method` for all possible options. # -show_name Whether show annotation name? # -name_gp Graphic parameters for annotation name. # -name_offset Offset to the annotation, a `grid::unit` object. # -name_side 'right' and 'left' for column annotations and 'top' and 'bottom' for row annotations # -name_rot Rotation of the annotation name, it can only take values in ``c(0, 90, 180, 270)``. # -anno_simple_size size of the simple annotation. # -width The width of the plotting region (the viewport) that the annotation is drawn. If it is a row annotation, # the width must be an absolute unit. # -height The height of the plotting region (the viewport) that the annotation is drawn. If it is a column annotation, # the width must be an absolute unit. # # == details # A single annotation is a basic unit of complex heatmap annotations where the heamtap annotations # are always a list of single annotations. An annotation can be simply heatmap-like (here we call # it simple annotation) or more complex like points, lines, boxes (for which we call it complex annotation). # # In the `SingleAnnotation` constructor, ``value``, ``col``, ``na_col`` are used to construct a `anno_simple` # annotation funciton which is generated internally by `AnnotationFunction`. The legend of the simple annotation # can be automatcally generated, # # For construcing a complex annotation, users need to use ``fun`` which is a user-defind function. Normally it # is constucted by `AnnotationFunction`. One big advantage for using `AnnotationFunction` is the annotation function # or the graphics drawn by the annotation function can be split according to row splitting or column splitting of # the heatmap. Users can also provide a "pure" function which is a normal R function for the ``fun`` argument. # The function only needs one argument which is a vector of index for rows or columns depending whether it is # a row annotation or column annotation. The other two optional arguments are the current slice index and total # number of slices. See **Examples** section for an example. If it is a normal R function, it will be constructed # into the `AnnotationFunction-class` object internally. # # The `SingleAnnotation-class` is a simple wrapper on top of `AnnotationFunction-class` only with annotation # name added. # # The class also stored the "extended area" relative to the area for the annotation graphics. The extended areas # are those created by annotation names and axes. # # == seealso # There are following built-in annotation functions that can be directly used to generate complex annotations: # `anno_simple`, `anno_points`, `anno_lines`, `anno_barplot`, `anno_histogram`, `anno_boxplot`, `anno_density`, `anno_text`, # `anno_joyplot`, `anno_horizon`, `anno_image`, `anno_lines` and `anno_mark`. # # == value # A `SingleAnnotation-class` object. # # == author # Zuguang Gu <z.gu@dkfz.de> # # == example # ha = SingleAnnotation(value = 1:10) # draw(ha, test = "single column annotation") # # m = cbind(1:10, 10:1) # colnames(m) = c("a", "b") # ha = SingleAnnotation(value = m) # draw(ha, test = "matrix as column annotation") # # anno = anno_barplot(matrix(nc = 2, c(1:10, 10:1))) # ha = SingleAnnotation(fun = anno) # draw(ha, test = "anno_barplot as input") # # fun = local({ # # because there variables outside the function for use, we put it a local environment # value = 1:10 # function(index, k = 1, n = 1) { # pushViewport(viewport(xscale = c(0.5, length(index) + 0.5), yscale = range(value))) # grid.points(seq_along(index), value[index]) # grid.rect() # if(k == 1) grid.yaxis() # popViewport() # } # }) # ha = SingleAnnotation(fun = fun, height = unit(4, "cm")) # draw(ha, index = 1:10, test = "self-defined function") SingleAnnotation = function(name, value, col, fun, na_col = "grey", which = c("column", "row"), show_legend = TRUE, gp = gpar(col = NA), border = FALSE, legend_param = list(), show_name = TRUE, name_gp = gpar(fontsize = 12), name_offset = unit(1, "mm"), name_side = ifelse(which == "column", "right", "bottom"), name_rot = ifelse(which == "column", 0, 90), anno_simple_size = ht_opt$anno_simple_size, width = NULL, height = NULL) { .ENV$current_annotation_which = NULL which = match.arg(which)[1] .ENV$current_annotation_which = which on.exit(.ENV$current_annotation_which <- NULL) verbose = ht_opt$verbose # re-define some of the argument values according to global settings called_args = names(as.list(match.call())[-1]) if("legend_param" %in% called_args) { for(opt_name in setdiff(c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "border"), names(legend_param))) { opt_name2 = paste0("legend_", opt_name) if(!is.null(ht_opt(opt_name2))) legend_param[[opt_name]] = ht_opt(opt_name2) } } else { for(opt_name in c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "border")) { opt_name2 = paste0("legend_", opt_name) if(!is.null(ht_opt(opt_name2))) legend_param[[opt_name]] = ht_opt(opt_name2) } } .Object = new("SingleAnnotation") .Object@which = which if(missing(name)) { name = paste0("anno", get_annotation_index() + 1) increase_annotation_index() } .Object@name = name if(!name_rot %in% c(0, 90, 180, 270)) { stop_wrap(qq("@{name}: `name_rot` can only take values in c(0, 90, 180, 270)")) } if(verbose) qqcat("create a SingleAnnotation with name '@{name}'\n") .Object@is_anno_matrix = FALSE use_mat_column_names = FALSE if(!missing(value)) { if(verbose) qqcat("@{name}: annotation value is vector/matrix\n") if(is.logical(value)) { if(is.matrix(value)) { oa = attributes(value) value = as.character(value) attributes(value) = oa } else { value = as.character(value) } if(verbose) qqcat("@{name}: annotation value is logical, convert to character\n") } if(is.factor(value)) { value = as.vector(value) if(verbose) qqcat("@{name}: annotation value is factor, convert to character\n") } if(is.matrix(value)) { .Object@is_anno_matrix = TRUE attr(.Object@is_anno_matrix, "column_names") = colnames(value) attr(.Object@is_anno_matrix, "k") = ncol(value) if(length(colnames(value))) { use_mat_column_names = TRUE } use_mat_nc = ncol(value) if(verbose) qqcat("@{name}: annotation value is a matrix\n") } } is_name_offset_called = !missing(name_offset) is_name_rot_called = !missing(name_rot) anno_fun_extend = unit(c(0, 0, 0, 0), "mm") if(!missing(fun)) { if(inherits(fun, "AnnotationFunction")) { anno_fun_extend = fun@extended if(verbose) qqcat("@{name}: annotation is a AnnotationFunction object\n") show_name = fun@show_name } else { fun = AnnotationFunction(fun = fun) anno_fun_extend = fun@extended if(verbose) qqcat("@{name}: annotation is a user-defined function\n") } } anno_name = name if(which == "column") { if(verbose) qqcat("@{name}: it is a column annotation\n") if(!name_side %in% c("left", "right")) { stop_wrap(qq("@{name}: `name_side` should be 'left' or 'right' when it is a column annotation.")) } if(verbose) qqcat("@{name}: adjust positions of annotation names\n") if(name_side == "left") { if(anno_fun_extend[[2]] > 0) { if(!is_name_offset_called) { name_offset = name_offset + anno_fun_extend[2] } if(!is_name_rot_called) { name_rot = 90 } } if(use_mat_column_names) { name_x = unit(rep(0, use_mat_nc), "npc") - name_offset name_y = unit((use_mat_nc - seq_len(use_mat_nc) + 0.5)/use_mat_nc, "npc") anno_name = colnames(value) } else { name_x = unit(0, "npc") - name_offset name_y = unit(0.5, "npc") } if(name_rot == 0) { name_just = "right" } else if(name_rot == 90) { name_just = "bottom" } else if(name_rot == 180) { name_just = "left" } else { name_just = "top" } } else { if(anno_fun_extend[[4]] > 0) { if(!is_name_offset_called) { name_offset = name_offset + anno_fun_extend[4] } if(!is_name_rot_called) { name_rot = 90 } } if(use_mat_column_names) { name_x = unit(rep(1, use_mat_nc), "npc") + name_offset name_y = unit((use_mat_nc - seq_len(use_mat_nc) + 0.5)/use_mat_nc, "npc") anno_name = colnames(value) } else { name_x = unit(1, "npc") + name_offset name_y = unit(0.5, "npc") } if(name_rot == 0) { name_just = "left" } else if(name_rot == 90) { name_just = "top" } else if(name_rot == 180) { name_just = "right" } else { name_just = "bottom" } } } else if(which == "row") { if(verbose) qqcat("@{name}: it is a row annotation\n") if(!name_side %in% c("top", "bottom")) { stop_wrap(qq("@{name}: `name_side` should be 'left' or 'right' when it is a column annotation.")) } if(verbose) qqcat("@{name}: adjust positions of annotation names\n") if(name_side == "top") { if(anno_fun_extend[[3]] > 0) { if(!is_name_offset_called) { name_offset = name_offset + anno_fun_extend[3] } if(!is_name_rot_called) { name_rot = 0 } } if(use_mat_column_names) { name_x = unit((seq_len(use_mat_nc) - 0.5)/use_mat_nc, "npc") name_y = unit(rep(1, use_mat_nc), "npc") + name_offset anno_name = colnames(value) } else { name_x = unit(0.5, "npc") name_y = unit(1, "npc") + name_offset } if(name_rot == 0) { name_just = "bottom" } else if(name_rot == 90) { name_just = "left" } else if(name_rot == 180) { name_just = "top" } else { name_just = "right" } } else { if(anno_fun_extend[[1]] > 0) { if(!is_name_offset_called) { name_offset = name_offset + anno_fun_extend[1] } if(!is_name_rot_called) { name_rot = 0 } } if(use_mat_column_names) { name_x = unit((seq_len(use_mat_nc) - 0.5)/use_mat_nc, "npc") name_y = unit(rep(0, use_mat_nc), "npc") - name_offset anno_name = colnames(value) } else { name_x = unit(0.5, "npc") name_y = unit(0, "npc") - name_offset } if(name_rot == 0) { name_just = "top" } else if(name_rot == 90) { name_just = "right" } else if(name_rot == 180) { name_just = "bottom" } else { name_just = "left" } } } name_param = list(show = show_name, label = anno_name, x = name_x, y = name_y, offset = name_offset, just = name_just, gp = check_gp(name_gp), rot = name_rot, side = name_side) # get defaults for name settings if(verbose) qqcat("@{name}: calcualte extensions caused by annotation name\n") extended = unit(c(0, 0, 0, 0), "mm") if(name_param$show) { if(which == "column") { if(name_param$rot == 0) { text_width = convertWidth(grobWidth(textGrob(name_param$label, gp = name_gp)) + name_param$offset, "mm", valueOnly = TRUE) } else { text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp)) + name_param$offset, "mm", valueOnly = TRUE) } if(name_param$side == "left") { extended[[2]] = text_width } else if(name_param$side == "right") { extended[[4]] = text_width } } else if(which == "row") { if(name_param$rot == 0) { text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp, rot = name_param$rot)) + name_param$offset, "mm", valueOnly = TRUE) } else { text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp, rot = name_param$rot)) + name_param$offset, "mm", valueOnly = TRUE) } if(name_param$side == "bottom") { extended[[1]] = text_width } else if(name_param$side == "top") { extended[[3]] = text_width } } } for(i in 1:4) { extended[[i]] = max(anno_fun_extend[[i]], extended[[i]]) } .Object@extended = extended .Object@name_param = name_param gp = check_gp(gp) if(!is.null(gp$fill)) { stop_wrap(qq("@{name}: You should not set `fill`.")) } if(missing(fun)) { color_is_random = FALSE if(missing(col)) { col = default_col(value) color_is_random = TRUE if(verbose) qqcat("@{name}: use randomly generated colors\n") } if(is.atomic(col)) { if(is.null(names(col))) { if(is.factor(value)) { names(col) = levels(value) if(verbose) qqcat("@{names}: add names for discrete color mapping\n") } else if(length(col) == length(unique(value))) { names(col) = unique(value) if(verbose) qqcat("@{names}: add names for discrete color mapping\n") } else if(is.numeric(value)) { col = colorRamp2(seq(min(value, na.rm = TRUE), max(value, na.rm = TRUE), length = length(col)), col) if(verbose) qqcat("@{name}: assume as a continuous color mapping\n") } } if(is.function(col)) { color_mapping = ColorMapping(name = name, col_fun = col, na_col = na_col) } else { col = col[intersect(c(names(col), "_NA_"), as.character(value))] if("_NA_" %in% names(col)) { na_col = col["_NA_"] col = col[names(col) != "_NA_"] } color_mapping = ColorMapping(name = name, colors = col, na_col = na_col) } } else if(is.function(col)) { color_mapping = ColorMapping(name = name, col_fun = col, na_col = na_col) } .Object@color_mapping = color_mapping .Object@color_is_random = color_is_random if(is.null(legend_param)) legend_param = list() .Object@legend_param = legend_param value = value if(verbose) qqcat("@{name}: generate AnnotationFunction for simple annotation values by anno_simple()\n") .Object@fun = anno_simple(value, col = color_mapping, which = which, na_col = na_col, gp = gp, border = border, anno_simple_size = anno_simple_size) if(missing(width)) { .Object@width = .Object@fun@width } else { .Object@width = width .Object@fun@width = width } if(missing(height)) { .Object@height = .Object@fun@height } else { .Object@height = height .Object@fun@height = height } .Object@show_legend = show_legend .Object@subsetable = TRUE } else { f_which = fun@which if(!is.null(f_which)) { fun_name = fun@fun_name if(f_which != which) { stop_wrap(qq("You are putting @{fun_name} as @{which} annotations, you need to set 'which' argument to '@{which}' as well, or use the helper function @{which}_@{fun_name}().")) } } if(verbose) qqcat("@{name}: calcualte width/height of SingleAnnotation based on the annotation function\n") .Object@fun = fun .Object@show_legend = FALSE if(is.null(width)) { .Object@width = .Object@fun@width } else { .Object@width = width .Object@fun@width = width } if(is.null(height)) { .Object@height = .Object@fun@height } else { .Object@height = height .Object@fun@height = height } .Object@subsetable = .Object@fun@subsetable } return(.Object) } # == title # Draw the Single Annotation # # == param # -object A `SingleAnnotation-class` object. # -index A vector of indices. # -k The index of the slice. # -n Total number of slices. ``k`` and ``n`` are used to adjust annotation names. E.g. # if ``k`` is 2 and ``n`` is 3, the annotation names are not drawn. # -test Is it in test mode? The value can be logical or a text which is plotted as the title of plot. # # == value # No value is returned. # # == author # Zuguang Gu <z.gu@dkfz.de> # setMethod(f = "draw", signature = "SingleAnnotation", definition = function(object, index, k = 1, n = 1, test = FALSE) { if(is.character(test)) { test2 = TRUE } else { test2 = test test = "" } verbose = ht_opt$verbose ## it draws annotation names, create viewports with names if(test2) { grid.newpage() pushViewport(viewport(width = unit(1, "npc") - unit(4, "cm"), height = unit(1, "npc") - unit(4, "cm"))) } if(missing(index)) { if(has_AnnotationFunction(object)) { if(object@fun@n == 0) { stop_wrap("Cannot infer the number of Observations in the annotation function, you need to provide `index`.") } index = seq_len(object@fun@n) } } anno_height = object@height anno_width = object@width # names should be passed to the data viewport if(has_AnnotationFunction(object)) { if(object@which == "column") { data_scale = list(x = c(0.5, length(index) + 0.5), y = object@fun@data_scale) } else { data_scale = list(y = c(0.5, length(index) + 0.5), x = object@fun@data_scale) } } else { data_scale = list(x = c(0, 1), y = c(0, 1)) } pushViewport(viewport(width = anno_width, height = anno_height, name = paste("annotation", object@name, k, sep = "_"), xscale = data_scale$x, yscale = data_scale$y)) if(verbose) qqcat("execute annotation function\n") draw(object@fun, index = index, k = k, n = n) # add annotation name draw_name = object@name_param$show if(object@name_param$show && n > 1) { if(object@which == "row") { if(k == n && object@name_param$side == "bottom") { draw_name = TRUE } else if(k == 1 && object@name_param$side == "top") { draw_name = TRUE } else { draw_name = FALSE } } else if(object@which == "column") { if(k == 1 && object@name_param$side == "left") { draw_name = TRUE } else if(k == n && object@name_param$side == "right") { draw_name = TRUE } else { draw_name = FALSE } } } if(draw_name) { if(verbose) qqcat("draw annotation name\n") if(is_matrix_annotation(object)) { if(!is.null(attr(object@is_anno_matrix, "column_names"))) { anno_mat_column_names = attr(object@is_anno_matrix, "column_names") grid.text(anno_mat_column_names, x = object@name_param$x, y = object@name_param$y, just = object@name_param$just, rot = object@name_param$rot, gp = object@name_param$gp) } else { if(object@which == "column") { grid.text(object@name, x = object@name_param$x[1], y = unit(0.5, "npc"), just = object@name_param$just, rot = object@name_param$rot, gp = object@name_param$gp) } else { grid.text(object@name, x = unit(0.5, "npc"), y = object@name_param$y[1], just = object@name_param$just, rot = object@name_param$rot, gp = object@name_param$gp) } } } else { grid.text(object@name, x = object@name_param$x, y = object@name_param$y, just = object@name_param$just, rot = object@name_param$rot, gp = object@name_param$gp) } } if(test2) { grid.text(test, y = unit(1, "npc") + unit(2, "mm"), just = "bottom") grid.rect(unit(0, "npc") - object@extended[2], unit(0, "npc") - object@extended[1], width = unit(1, "npc") + object@extended[2] + object@extended[4], height = unit(1, "npc") + object@extended[1] + object@extended[3], just = c("left", "bottom"), gp = gpar(fill = "transparent", col = "red", lty = 2)) } upViewport() if(test2) { upViewport() } }) # == title # Print the SingleAnnotation object # # == param # -object A `SingleAnnotation-class` object. # # == value # No value is returned. # # == author # Zuguang Gu <z.gu@dkfz.de> # setMethod(f = "show", signature = "SingleAnnotation", definition = function(object) { if(is_fun_annotation(object)) { if(has_AnnotationFunction(object)) { fun_name = object@fun@fun_name fun_name = paste0(fun_name, "()") } else { fun_name = "self-defined" } cat("A single annotation with", fun_name, "function\n") cat(" name:", object@name, "\n") cat(" position:", object@which, "\n") cat(" no legend\n") if(has_AnnotationFunction(object)) { n = object@fun@n if(!is.null(n)) cat(" items:", n, "\n") } } else { cat("A single annotation with", object@color_mapping@type, "color mapping\n") cat(" name:", object@name, "\n") cat(" position:", object@which, "\n") cat(" show legend:", object@show_legend, "\n") cat(" items:", object@fun@n, "\n") if(is_matrix_annotation(object)) { cat(" a matrix with", attr(object@is_anno_matrix, "k"), "columns\n") } if(object@color_is_random) { cat(" color is randomly generated\n") } } cat(" width:", as.character(object@width), "\n") cat(" height:", as.character(object@height), "\n") cat(" this object is", ifelse(object@subsetable, "\b", "not"), "subsetable\n") dirt = c("bottom", "left", "top", "right") for(i in 1:4) { if(!identical(unit(0, "mm"), object@extended[i])) { cat(" ", as.character(object@extended[i]), "extension on the", dirt[i], "\n") } } }) is_simple_annotation = function(single_anno) { !is_fun_annotation(single_anno) && !is_matrix_annotation(single_anno) } is_matrix_annotation = function(single_anno) { single_anno@is_anno_matrix } is_fun_annotation = function(single_anno) { is.null(single_anno@color_mapping) } has_AnnotationFunction = function(single_anno) { if(is.null(single_anno@fun)) { FALSE } else { inherits(single_anno@fun, "AnnotationFunction") } } ## subset method for .SingleAnnotation-class ## column annotation only allows column subsetting and row annotaiton only allows row subsetting # == title # Subset an SingleAnnotation Object # # == param # -x An `SingleAnnotation-class` object. # -i A vector of indices. # # == details # The SingleAnnotation class object is subsetable only if the containing `AnnotationFunction-class` # object is subsetable. All the ``anno_*`` functions are subsetable, so if the SingleAnnotation object # is constructed by one of these functions, it is also subsetable. # # == example # ha = SingleAnnotation(value = 1:10) # ha[1:5] # draw(ha[1:5], test = "ha[1:5]") "[.SingleAnnotation" = function(x, i) { # only allow subsetting for anno_* functions defined in ComplexHeatmap if(nargs() == 2) { x2 = x if(inherits(x@fun, "AnnotationFunction")) { if(x@fun@subsetable) { x2@fun = x@fun[i] return(x2) } } stop_wrap("This SingleAnnotation object is not allowed for subsetting.") } else if(nargs() == 1) { return(x) } } # == title # Copy the SingleAnnotation object # # == param # -object The `SingleAnnotation-class` object. # # == details # Since the SingleAnnotation object always contains an `AnnotationFunction-class` object, # it calls `copy_all,AnnotationFunction-method` to hard copy the variable environment. setMethod(f = "copy_all", signature = "SingleAnnotation", definition = function(object) { x2 = object x2@fun = copy_all(object@fun) return(x2) }) # == title # Number of Observations # # == param # -object The `SingleAnnotation-class` object. # -... other arguments. # # == details # It returns the ``n`` slot of the annotaton function. If it does not exist, it returns ``NA``. nobs.SingleAnnotation = function(object, ...) { if(object@fun@n > 0) { object@fun@n } else { NA } }