| d1da987e |
# == title
|
| e27480b9 |
# Class for Heatmap Annotations
|
| d1da987e |
#
# == details
|
| b08d7ba4 |
# A complex heatmap contains a list of annotations which are represented as different graphics
# placed on rows and columns. The `HeatmapAnnotation-class` contains a list of single annotations which are
# represented as a list of `SingleAnnotation-class` objects with same number of rows or columns.
|
| d1da987e |
#
# == methods
# The `HeatmapAnnotation-class` provides following methods:
#
# - `HeatmapAnnotation`: constructor method
# - `draw,HeatmapAnnotation-method`: draw the annotations
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
HeatmapAnnotation = setClass("HeatmapAnnotation",
slots = list(
name = "character",
anno_list = "list", # a list of `SingleAnnotation` objects
anno_size = "ANY",
which = "character",
|
| 402ff791 |
width = "ANY",
height = "ANY",
|
| 261bfec2 |
gap = "ANY",
subsetable = "logical",
extended = "ANY"
|
| d1da987e |
),
prototype = list(
anno_list = list(),
|
| 261bfec2 |
which = "column",
gap = unit(0, "mm"),
subsetable = FALSE,
extended = unit(c(0, 0, 0, 0), "mm")
|
| d1da987e |
),
contains = "AdditiveUnit"
)
# == title
# Constructor method for HeatmapAnnotation class
#
# == param
|
| e27480b9 |
# -... Name-value pairs where the names correspond to annotation names and values can be a vector, a matrix and an
# annotation function. Each pair is sent to `SingleAnnotation` to contruct a single annotation.
# -df A data frame. Each column will be treated as a simple annotation. The data frame must have column names.
# -name Name of the heatmap annotation, optional.
|
| ad35494a |
# -col A list of colors which contain color mapping to columns in ``df`` and simple annotations define din ``...``.
|
| e27480b9 |
# See `SingleAnnotation` for how to set colors.
# -na_col Color for ``NA`` values in simple annotations.
# -annotation_legend_param A list which contains parameters for annotation legends. See `color_mapping_legend,ColorMapping-method` for all possible options.
# -show_legend Whether show annotation legend. The value can be one single value or a vector which corresponds to the simple annotations.
# -which Are the annotations row annotations or column annotations?
# -gp Graphic parameters for simple annotations (with ``fill`` parameter ignored).
|
| 1bba04a0 |
# -border border of single annotations.
|
| ad35494a |
# -gap Gap between each two annotation. It can be a single value or a vector of `grid::unit` objects.
|
| e27480b9 |
# -show_annotation_name Whether show annotation names? For column annotation, annotation names are drawn either on the left
|
| 4684fe02 |
# or the right, and for row annotations, names are draw either on top to at bottom. The value can be a vector.
|
| e27480b9 |
# -annotation_name_gp Graphic parameters for anntation names. Graphic paramters can be vectors.
# -annotation_name_offset Offset to the annotations, `grid::unit` object. The value can be a vector.
# -annotation_name_side Side of the annotation names.
# -annotation_name_rot Rotation of the annotation names, can only take values in ``c(00, 90, 180, 270)``. The value can be a vector.
|
| 1a56796e |
# -annotation_height Height of each annotation if annotations are column annotations.
# -annotation_width Width of each annotation if annotations are row annotations.
# -height Height of the complete column annotations.
# -width Width of the complete heatmap annotations.
# -anno_simple_size size of the simple annotation.
# -simple_anno_size_adjust whether also adjust the size of simple annotations when adjust the whole heatmap annotation.
|
| d1da987e |
#
# == details
|
| e27480b9 |
# There are three ways to specify heatmap annotations:
#
# 1. If the annotation is simply a vector or a matrix, it can be specified as ``HeatmapAnnotation(foo = 1:10)``.
# 2. If the annotations are already stored as a data frame, it can be specified as ``HeatmapAnnotation(df = df)``.
# 3. For complex annotation, users can use the pre-defined annotation functions such as `anno_points`: ``HeatmapAnnotation(foo = anno_points(1:10))``.
|
| d1da987e |
#
# == value
# A `HeatmapAnnotation-class` object.
#
|
| 67260f33 |
# == seealso
# There are two shortcut functions: `rowAnnotation` and `columnAnnotation`.
#
|
| d1da987e |
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
|
| 261bfec2 |
HeatmapAnnotation = function(...,
df, name, col, na_col = "grey",
|
| 12e85497 |
annotation_legend_param = list(),
|
| e8c250f0 |
show_legend = TRUE,
|
| 12e85497 |
which = c("column", "row"),
gp = gpar(col = NA),
|
| 1bba04a0 |
border = FALSE,
|
| 4684fe02 |
gap = unit(0, "mm"),
|
| 6849ddae |
|
| 261bfec2 |
show_annotation_name = TRUE,
|
| 4684fe02 |
annotation_name_gp = gpar(),
|
| 402ff791 |
annotation_name_offset = unit(1, "mm"),
|
| f6325167 |
annotation_name_side = ifelse(which == "column", "right", "bottom"),
|
| 6849ddae |
annotation_name_rot = ifelse(which == "column", 0, 90),
annotation_height = NULL,
annotation_width = NULL,
height = NULL,
width = NULL,
anno_simple_size = ht_opt$anno_simple_size,
simple_anno_size_adjust = FALSE
) {
|
| d1da987e |
|
| ad35494a |
.ENV$current_annotation_which = NULL
|
| 261bfec2 |
which = match.arg(which)[1]
.ENV$current_annotation_which = which
on.exit(.ENV$current_annotation_which <- NULL)
fun_args = names(as.list(environment()))
|
| 402ff791 |
|
| 1ee53830 |
verbose = ht_opt$verbose
|
| 261bfec2 |
|
| d1da987e |
.Object = new("HeatmapAnnotation")
anno_list = list()
|
| 261bfec2 |
|
| d1da987e |
if(missing(name)) {
name = paste0("heatmap_annotation_", get_row_annotation_index())
increase_row_annotation_index()
}
.Object@name = name
|
| e17d93af |
n_anno = 0
|
| d1da987e |
|
| 402ff791 |
#### check system calls ####
|
| 65fecf1c |
# HeatmapAnnotation is either called by `HeatmapAnnotation()` or by `rowAnnotation()`/`columnAnnotation()`
|
| 402ff791 |
sc = sys.calls()
|
| 65fecf1c |
nsc = length(sc)
if(nsc == 1) {
scl = as.list(sc[[1]])
arg_list = scl[-1]
} else {
scl = as.list(sc[[nsc-1]])
|
| 249fdfa0 |
if(any(as.character(scl[[1]]) %in% c("HeatmapAnnotation", "rowAnnotation", "columnAnnotation"))) {
|
| 402ff791 |
arg_list = scl[-1]
|
| 65fecf1c |
} else {
scl = as.list(sc[[nsc]])
arg_list = scl[-1]
|
| 402ff791 |
}
}
|
| 65fecf1c |
|
| e8c250f0 |
called_args = names(arg_list)
|
| 261bfec2 |
anno_args = setdiff(called_args, fun_args)
|
| e8c250f0 |
if(any(anno_args == "")) stop("annotations should have names.")
|
| 933e808c |
if(is.null(called_args)) {
stop_wrap("It seems you are putting only one argument to the function. If it is a simple vector annotation, specify it as HeatmapAnnotation(name = value). If it is a data frame annotation, specify it as HeatmapAnnotation(df = value)")
}
|
| 261bfec2 |
|
| 402ff791 |
##### pull all annotation to `anno_value_list`####
|
| 261bfec2 |
if("df" %in% called_args) {
if(is.matrix(df)) {
|
| c4a66bf9 |
warning_wrap("`df` should be a data frame while not a matrix. Convert it to data frame.")
|
| 261bfec2 |
df = as.data.frame(df)
} else if(!is.data.frame(df)) {
|
| e84ad9b4 |
oe = try(df <- as.data.frame(df), silent = TRUE)
if(inherits(oe, "try-errir")) {
|
| c4a66bf9 |
stop_wrap("`df` should be a data frame.")
|
| e84ad9b4 |
}
|
| 261bfec2 |
}
}
|
| e8c250f0 |
anno_arg_list = list(...)
|
| 261bfec2 |
if("df" %in% called_args && length(anno_arg_list)) {
if(any(duplicated(c(names(df), names(anno_arg_list))))) {
|
| c4a66bf9 |
stop_wrap("Annotation names are duplicated. Check the column names of `df`.")
|
| 261bfec2 |
}
|
| d1da987e |
}
|
| e8c250f0 |
|
| 261bfec2 |
anno_value_list = list()
for(nm in called_args) {
if(nm %in% names(anno_arg_list)) {
anno_value_list[[nm]] = anno_arg_list[[nm]]
} else if(nm == "df") {
for(nm2 in colnames(df))
anno_value_list[[nm2]] = df[, nm2]
}
}
|
| e8c250f0 |
|
| 261bfec2 |
l_simple_anno = sapply(anno_value_list, is.atomic)
n_simple_anno = sum(l_simple_anno)
simple_anno_name = names(anno_value_list[l_simple_anno])
|
| 402ff791 |
if(verbose) qqcat("in total there are @{length(anno_value_list)} annotations (@{n_simple_anno} simple annotations)\n")
|
| 261bfec2 |
|
| e8c250f0 |
# normalize `show_legend`
if(length(show_legend) == 1) {
show_legend = rep(show_legend, n_simple_anno)
|
| ebcd28d9 |
}
|
| d1da987e |
|
| 402ff791 |
###### normalize `heatmap_legend_param` #######
|
| e8c250f0 |
if(length(annotation_legend_param) == 0) {
annotation_legend_param = rep.list(NULL, n_simple_anno)
} else if(inherits(annotation_legend_param, "list")) {
if(all(sapply(annotation_legend_param, inherits, "list"))) { # if it is a list of lists
nl = length(annotation_legend_param)
if(nl > n_simple_anno) {
|
| c4a66bf9 |
stop_wrap("Amount of legend params is larger than the number of simple annotations.")
|
| e8c250f0 |
}
if(is.null(names(annotation_legend_param))) {
names(annotation_legend_param) = simple_anno_name[seq_len(nl)]
} else if(length(setdiff(names(annotation_legend_param), simple_anno_name))) {
|
| c4a66bf9 |
stop_wrap("Some names in 'annotation_legend_param' are not in names of simple annotations.")
|
| e8c250f0 |
} else {
annotation_legend_param = annotation_legend_param[ intersect(simple_anno_name, names(annotation_legend_param)) ]
}
lp = rep.list(NULL, n_simple_anno)
names(lp) = simple_anno_name
for(i in seq_along(lp)) {
|
| 7094a097 |
if(names(lp)[i] %in% names(annotation_legend_param)) {
lp[[i]] = annotation_legend_param[[names(lp)[i]]]
}
|
| e8c250f0 |
}
annotation_legend_param = lp
} else {
annotation_legend_param = rep.list(annotation_legend_param, n_simple_anno)
|
| d1da987e |
}
|
| e8c250f0 |
}
|
| d1da987e |
|
| 261bfec2 |
is_name_offset_called = !missing(annotation_name_offset)
is_name_rot_called = !missing(annotation_name_rot)
n_total_anno = length(anno_value_list)
|
| 1bba04a0 |
an = names(anno_value_list)
show_annotation_name = recycle_param(show_annotation_name, an, TRUE)
annotation_name_offset = recycle_param(annotation_name_offset, an, TRUE)
annotation_name_side = recycle_param(annotation_name_side, an, TRUE)
annotation_name_rot = recycle_param(annotation_name_rot, an, TRUE)
|
| 450fb543 |
if(missing(border)) {
if(!is.null(ht_opt$annotation_border)) border = ht_opt$annotation_border
}
|
| 1bba04a0 |
border = recycle_param(border, an, FALSE)
|
| 4684fe02 |
annotation_name_gp = recycle_gp(annotation_name_gp, n_total_anno)
|
| 1498834c |
if(!missing(col)) {
if(is.null(names(col))) {
|
| 1a56796e |
stop_wrap("`col` should be a named list.")
|
| 1498834c |
}
if(any(is.na(names(col)))) {
|
| 1a56796e |
stop_wrap("`col` should be a named list.")
|
| 1498834c |
}
|
| 4adce5f0 |
if(any(sapply(col, function(x) if(is.function(x)) FALSE else is.null(names(x))))) {
|
| 1a56796e |
stop_wrap("elements in `col` should be named vectors.")
|
| 1498834c |
}
|
| 4adce5f0 |
if(any(sapply(col, function(x) if(is.function(x)) FALSE else any(is.na(names(x)))))) {
|
| 1a56796e |
stop_wrap("elements in `col` should be named vectors.")
|
| 1498834c |
}
}
|
| 261bfec2 |
### check the length of annotations
len = sapply(anno_value_list, function(x) {
if(is.matrix(x)) {
nrow(x)
} else if(inherits(x, "AnnotationFunction")) {
x@n
} else if(is.atomic(x)) {
length(x)
} else {
NA
}
})
|
| 30d2c5b2 |
len = len[!is.na(len)]
len = len[len > 0]
if(length(len)) {
if(length(unique(len)) > 1) {
|
| 1a56796e |
stop_wrap("Length of annotations differs.")
|
| 30d2c5b2 |
}
}
|
| 261bfec2 |
|
| 402ff791 |
i_simple = 0
|
| 4684fe02 |
i_anno = 0
|
| e8c250f0 |
simple_length = NULL
|
| 57aebadf |
col_name_defined = NULL
|
| 261bfec2 |
for(ag in names(anno_value_list)) {
i_anno = i_anno + 1
arg_list = list(name = ag, which = which,
show_name = show_annotation_name[i_anno],
name_gp = subset_gp(annotation_name_gp, i_anno),
name_offset = annotation_name_offset[i_anno],
name_side = annotation_name_side[i_anno],
|
| 1bba04a0 |
name_rot = annotation_name_rot[i_anno],
border = border[i_anno])
|
| 261bfec2 |
if(!is_name_offset_called) {
arg_list$name_rot = NULL
}
if(!is_name_rot_called) {
arg_list$name_offset = NULL
}
if(inherits(anno_value_list[[ag]], c("function", "AnnotationFunction"))) {
|
| 30d2c5b2 |
arg_list$fun = anno_value_list[[ag]]
if(inherits(anno_value_list[[ag]], "function")) {
if(which == "row") {
arg_list$width = unit(1, "cm")
} else {
arg_list$height = unit(1, "cm")
}
}
|
| 261bfec2 |
anno_list[[ag]] = do.call(SingleAnnotation, arg_list)
} else if(is.atomic(anno_value_list[[ag]])) {
arg_list$show_legend = show_legend[i_simple + 1]
arg_list$gp = gp
arg_list$legend_param = annotation_legend_param[[i_simple + 1]]
arg_list$value = anno_value_list[[ag]]
arg_list$na_col = na_col
|
| 6320aa68 |
arg_list$anno_simple_size = anno_simple_size
|
| 261bfec2 |
if(missing(col)) {
anno_list[[ag]] = do.call(SingleAnnotation, arg_list)
|
| e8c250f0 |
} else {
|
| 261bfec2 |
if(is.null(col[[ ag ]])) { # if the color is not provided
anno_list[[ag]] = do.call(SingleAnnotation, arg_list)
} else {
|
| ad35494a |
arg_list$col = col[[ ag ]]
|
| 261bfec2 |
anno_list[[ag]] = do.call(SingleAnnotation, arg_list)
col_name_defined = c(col_name_defined, ag)
|
| e8c250f0 |
}
}
|
| 261bfec2 |
i_simple = i_simple + 1
|
| e8c250f0 |
} else {
|
| 1a56796e |
stop_wrap(paste0(ag, ": annotations should be vector/data frame (only `df`)/matrix/functions."))
|
| 261bfec2 |
}
|
| d1da987e |
}
|
| 4eeb59e2 |
if(!missing(col)) {
unused_col_name = setdiff(names(col), col_name_defined)
if(length(unused_col_name)) {
|
| 249fdfa0 |
# warning(paste0("Following are defined in `col` while have no corresponding annotations:\n", paste(unused_col_name, collapse = ", ")))
|
| 4eeb59e2 |
}
|
| 57aebadf |
}
|
| 4684fe02 |
n_total_anno = length(anno_list)
|
| d1da987e |
|
| 076c1ff2 |
if(is.null(gap)) gap = unit(0, "mm")
|
| baca76bd |
|
| 5b59131c |
# the nth gap does not really matter
|
| baca76bd |
if(length(gap) == 1) {
|
| 261bfec2 |
gap = rep(gap, n_total_anno)
|
| 4684fe02 |
} else if(length(gap) == n_total_anno - 1) {
|
| 261bfec2 |
gap = unit.c(gap, unit(0, "mm"))
|
| 4684fe02 |
} else if(length(gap) < n_total_anno - 1) {
|
| 1a56796e |
stop_wrap("Length of `gap` is wrong.")
|
| 261bfec2 |
}
.Object@gap = gap
### calualte the width/heigit of annotations
|
| 402ff791 |
global_height = NULL
global_width = NULL
|
| 261bfec2 |
if(which == "column") {
|
| 6849ddae |
anno_size = do.call("unit.c", lapply(anno_list, height))
height = sum(anno_size) + sum(gap) - gap[n_total_anno]
|
| 402ff791 |
# for width, only look at `width`
|
| 261bfec2 |
if(is.null(width)) {
|
| 402ff791 |
width = unit(1, "npc")
}
for(i in 1:n_total_anno) {
width(anno_list[[i]]) = width
}
} else if(which == "row") {
|
| 6849ddae |
anno_size = do.call("unit.c", lapply(anno_list, width))
width = sum(anno_size) + sum(gap) - gap[n_total_anno]
|
| 402ff791 |
if(is.null(height)) {
height = unit(1, "npc")
}
for(i in 1:n_total_anno) {
height(anno_list[[i]]) = height
}
}
if(is_abs_unit(width)) {
width = convertWidth(width, "mm")
}
if(is_abs_unit(height)) {
height = convertWidth(height, "mm")
|
| baca76bd |
}
|
| 402ff791 |
anno_size = convertWidth(anno_size, "mm")
|
| baca76bd |
|
| 261bfec2 |
names(anno_list) = sapply(anno_list, function(x) x@name)
.Object@anno_list = anno_list
.Object@anno_size = anno_size
.Object@which = which
|
| 402ff791 |
.Object@width = width
.Object@height = height
|
| 261bfec2 |
.Object@subsetable = all(sapply(anno_list, function(x) x@subsetable))
extended = unit(c(0, 0, 0, 0), "mm")
for(i in 1:4) {
extended[[i]] = max(sapply(anno_list, function(anno) {
anno@extended[[i]]
}))
}
.Object@extended = extended
|
| 6849ddae |
## adjust height/width if `width`/`annotation_width` is set
if(which == "column") {
.Object = resize(.Object, height = height, annotation_height = annotation_height,
anno_simple_size = anno_simple_size, simple_anno_size_adjust = simple_anno_size_adjust)
} else {
.Object = resize(.Object, width = width, annotation_width = annotation_width,
anno_simple_size = anno_simple_size, simple_anno_size_adjust = simple_anno_size_adjust)
}
|
| 402ff791 |
|
| 261bfec2 |
return(.Object)
}
|
| 67260f33 |
# == title
|
| e27480b9 |
# Construct Row Annotations
|
| 67260f33 |
#
# == param
|
| e27480b9 |
# -... Pass to `HeatmapAnnotation`
|
| 67260f33 |
#
# == details
# The function is identical to
#
|
| f6325167 |
# HeatmapAnnotation(..., which = "row")
|
| 67260f33 |
#
# == value
# A `HeatmapAnnotation-class` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
|
| f6325167 |
rowAnnotation = function(...) {
HeatmapAnnotation(..., which = "row")
|
| 67260f33 |
}
# == title
|
| e27480b9 |
# Construct Column Annotations
|
| 67260f33 |
#
# == param
|
| e27480b9 |
# -... Pass to `HeatmapAnnotation`
|
| 67260f33 |
#
# == details
# The function is identical to
#
# HeatmapAnnotation(..., which = "column")
#
# == value
# A `HeatmapAnnotation-class` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
columnAnnotation = function(...) {
HeatmapAnnotation(..., which = "column")
}
|
| d1da987e |
# == title
|
| e27480b9 |
# Get a List of ColorMapping objects
|
| d1da987e |
#
# == param
|
| e27480b9 |
# -object A `HeatmapAnnotation-class` object.
|
| d1da987e |
#
# == details
|
| e27480b9 |
# Color mappings for visible simple annotations are only returned.
|
| d1da987e |
#
# This function is only for internal use.
#
# == values
# A list of `ColorMapping-class` objects or an empty list.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "get_color_mapping_list",
signature = "HeatmapAnnotation",
definition = function(object) {
color_mapping_list = list()
for(i in seq_along(object@anno_list)) {
if(object@anno_list[[i]]@show_legend) {
|
| 5ab2cb81 |
color_mapping_list = c.list(color_mapping_list, object@anno_list[[i]]@color_mapping)
|
| d1da987e |
}
}
return(color_mapping_list)
})
|
| 5ab2cb81 |
# == title
|
| e27480b9 |
# Get a List of Annotation Legend Parameters
|
| 5ab2cb81 |
#
# == param
|
| e27480b9 |
# -object A `HeatmapAnnotation-class` object.
|
| 5ab2cb81 |
#
# == details
|
| e27480b9 |
# The annotation legend parameters for visible simple annotations are only returned.
|
| 5ab2cb81 |
#
# This function is only for internal use.
#
# == values
# A list.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
|
| d7a3c7af |
setMethod(f = "get_legend_param_list",
|
| 5ab2cb81 |
signature = "HeatmapAnnotation",
definition = function(object) {
color_mapping_param_list = list()
for(i in seq_along(object@anno_list)) {
if(object@anno_list[[i]]@show_legend) {
|
| 261bfec2 |
color_mapping_param_list = c.list(color_mapping_param_list, object@anno_list[[i]]@legend_param)
|
| 5ab2cb81 |
}
}
return(color_mapping_param_list)
})
|
| d1da987e |
# == title
|
| e27480b9 |
# Draw the Heatmap Annotations
|
| d1da987e |
#
# == param
|
| e27480b9 |
# -object A `HeatmapAnnotation-class` object.
# -index A vector of indices.
# -k The current slice index for the annotation if it is split.
# -n Total number of slices.
# -... Pass to `grid::viewport` which contains all the annotations.
# -test Is it in test mode? The value can be logical or a text which is plotted as the title of plot.
|
| d1da987e |
#
# == value
# No value is returned.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "draw",
signature = "HeatmapAnnotation",
|
| ad35494a |
definition = function(object, index, k = 1, n = 1, ...,
|
| 261bfec2 |
test = FALSE) {
|
| d1da987e |
which = object@which
n_anno = length(object@anno_list)
anno_size = object@anno_size
|
| 67260f33 |
gap = object@gap
|
| d1da987e |
|
| 261bfec2 |
if(is.character(test)) {
test2 = TRUE
} else {
test2 = test
|
| e84ad9b4 |
test = ""
|
| 261bfec2 |
}
if(test2) {
grid.newpage()
|
| c4a66bf9 |
if(which == "column") pushViewport(viewport(width = unit(1, "npc") - unit(3, "cm"), height = object@height))
if(which == "row") pushViewport(viewport(height = unit(1, "npc") - unit(3, "cm"), width = object@width))
|
| 261bfec2 |
} else {
pushViewport(viewport(...))
}
if(missing(index)) {
n_anno = length(object@anno_list)
len = sapply(seq_len(n_anno), function(i) {
if(inherits(object@anno_list[[i]]@fun, "AnnotationFunction")) {
object@anno_list[[i]]@fun@n
} else {
NA
}
})
len = len[!is.na(len)]
|
| 933e808c |
if(length(len)) {
index = seq_len(len[1])
}
if(!length(index)) {
stop("Cannot infer the number of observations of the annotation.")
}
|
| 261bfec2 |
}
|
| 5b59131c |
if(which == "column") {
|
| ad35494a |
# start from the last annoation which is put on bottom
for(i in seq_len(n_anno)) {
pushViewport(viewport(y = sum(anno_size[seq(i, n_anno)]) + sum(gap[seq(i, n_anno)]) - gap[n_anno],
height = anno_size[i], just = c("center", "top")))
oe = try(draw(object@anno_list[[i]], index, k, n))
if(inherits(oe, "try-error")) {
cat("Error when drawing annotation '", object@anno_list[[i]]@name, "'\n", sep = "")
|
| c4a66bf9 |
stop_wrap(oe)
|
| 5b59131c |
}
|
| ad35494a |
upViewport()
|
| 5b59131c |
}
} else if(which == "row") {
for(i in seq_len(n_anno)) {
|
| 67260f33 |
pushViewport(viewport(x = sum(anno_size[seq_len(i)]) + sum(gap[seq_len(i)]) - gap[i], width = anno_size[i], just = c("right", "center")))
|
| fcaccd8a |
oe = try(draw(object@anno_list[[i]], index, k, n))
|
| 7e9fdf62 |
if(inherits(oe, "try-error")) {
|
| fcaccd8a |
cat("Error when drawing annotation '", object@anno_list[[i]]@name, "'\n", sep = "")
|
| c4a66bf9 |
stop_wrap(oe)
|
| fcaccd8a |
}
|
| 5b59131c |
upViewport()
|
| d1da987e |
}
}
|
| 261bfec2 |
if(test2) {
grid.text(test, y = unit(1, "npc") + unit(2, "mm"), just = "bottom")
|
| 933e808c |
# 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))
|
| 261bfec2 |
}
|
| d1da987e |
upViewport()
})
# == title
|
| e27480b9 |
# Print the HeatmapAnnotation object
|
| d1da987e |
#
# == param
|
| e27480b9 |
# -object A `HeatmapAnnotation-class` object.
|
| d1da987e |
#
# == value
# No value is returned.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "show",
signature = "HeatmapAnnotation",
definition = function(object) {
n = length(object@anno_list)
if(n == 1) {
|
| 261bfec2 |
cat("A HeatmapAnnotation object with 1 annotation\n")
|
| d1da987e |
} else {
|
| 261bfec2 |
cat("A HeatmapAnnotation object with", length(object@anno_list), "annotations\n")
|
| d1da987e |
}
|
| 261bfec2 |
cat(" name:", object@name, "\n")
cat(" position:", object@which, "\n")
n_anno = length(object@anno_list)
len = sapply(seq_len(n_anno), function(i) {
if(inherits(object@anno_list[[i]]@fun, "AnnotationFunction")) {
object@anno_list[[i]]@fun@n
} else {
NA
}
})
len = len[!is.na(len)]
|
| 30d2c5b2 |
len = len[len > 0]
|
| 261bfec2 |
cat(" items:", ifelse(length(len), len[1], "unknown"), "\n")
|
| 402ff791 |
cat(" width:", as.character(object@width), "\n")
cat(" height:", as.character(object@height), "\n")
|
| 7db3856b |
cat(" this object is", ifelse(object@subsetable, "", "not"), "subsetable\n")
|
| 261bfec2 |
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")
}
}
|
| d1da987e |
cat("\n")
|
| 261bfec2 |
lt = list()
lt$name = names(object@anno_list)
lt$annotation_type = sapply(seq_len(n_anno), function(i) {
if(!is.null(object@anno_list[[i]]@color_mapping)) {
if(object@anno_list[[i]]@is_anno_matrix) {
paste0(object@anno_list[[i]]@color_mapping@type, " matrix")
} else {
paste0(object@anno_list[[i]]@color_mapping@type, " vector")
}
} else if(inherits(object@anno_list[[i]]@fun, "AnnotationFunction")) {
|
| c4a66bf9 |
if(object@anno_list[[i]]@fun@fun_name != "") {
paste0(object@anno_list[[i]]@fun@fun_name, "()")
} else {
"AnnotationFunction"
}
|
| 261bfec2 |
} else if(inherits(object@anno_list[[i]]@fun, "function")) {
"function"
} else {
""
}
})
lt$color_mapping = sapply(seq_len(n_anno), function(i) {
ifelse(object@anno_list[[i]]@color_is_random, "random",
ifelse(is.null(object@anno_list[[i]]@color_mapping), "", "user-defined"))
})
size_name = ifelse(object@which == "column", "height", "width")
lt[[size_name]] = sapply(seq_len(n_anno), function(i) {
if(size_name == "height") {
u = object@anno_list[[i]]@height
if(is_abs_unit(u)) {
as.character(convertHeight(u, "mm"))
} else {
as.character(u)
}
} else if(size_name == "width") {
u = object@anno_list[[i]]@width
if(is_abs_unit(u)) {
as.character(convertWidth(u, "mm"))
} else {
as.character(u)
}
}
})
df = as.data.frame(lt)
print(df, row.names = FALSE)
|
| d1da987e |
})
|
| e27480b9 |
# == title
# Number of Observations
#
# == param
|
| ad35494a |
# -object The `HeatmapAnnotation-class` object.
# -... other arguments.
|
| e27480b9 |
#
|
| ad35494a |
nobs.HeatmapAnnotation = function(object, ...) {
|
| 402ff791 |
n_anno = length(object@anno_list)
len = sapply(seq_len(n_anno), function(i) {
if(inherits(object@anno_list[[i]]@fun, "AnnotationFunction")) {
|
| 10fbf31c |
nobs(object@anno_list[[i]]@fun)
|
| 402ff791 |
} else {
NA
}
})
len = len[!is.na(len)]
|
| 30d2c5b2 |
len = len[len > 0]
|
| 402ff791 |
if(length(len)) {
return(len[1])
} else {
NA
}
}
|
| d1da987e |
# == title
# Add row annotations or heatmaps as a heatmap list
#
# == param
|
| ad35494a |
# -object A `HeatmapAnnotation-class` object.
# -x A `Heatmap-class` object, a `HeatmapAnnotation-class` object or a `HeatmapList-class` object.
# -direction Whether it is a horizontal add or a vertical add?
|
| d1da987e |
#
# == details
|
| ad35494a |
# There is a helper function ``+.AdditiveUnit`` for horizontal add or `\%v\%` for vertical add.
|
| d1da987e |
#
# == value
# A `HeatmapList-class` object.
#
# == author
# Zuguang Gu <z.gu@dkfz.de>
#
setMethod(f = "add_heatmap",
signature = "HeatmapAnnotation",
|
| e27480b9 |
definition = function(object, x, direction = c("horizontal", "vertical")) {
direction = match.arg(direction)[1]
|
| d1da987e |
ht_list = new("HeatmapList")
|
| e27480b9 |
ht_list@direction = direction
ht_list = add_heatmap(ht_list, object, direction = direction)
ht_list = add_heatmap(ht_list, x, direction = direction)
|
| d1da987e |
return(ht_list)
})
|
| 261bfec2 |
|
| e27480b9 |
# == title
# Concatenate Heatmap Annotations
#
# == param
# -... `HeatmapAnnotation-class` objects.
# -gap gap between the annotations.
#
# == details
# The heatmap annotations should be same number of observations.
#
# == example
# ha1 = HeatmapAnnotation(foo = 1:10)
# ha2 = HeatmapAnnotation(bar = anno_points(10:1))
# ha = c(ha1, ha2)
# ha
# ha3 = HeatmapAnnotation(sth = cbind(1:10, 10:1))
# ha = c(ha1, ha2, ha3, gap = unit(c(1, 4), "mm"))
# ha
|
| 261bfec2 |
c.HeatmapAnnotation = function(..., gap = unit(0, "mm")) {
anno_list = list(...)
n = length(anno_list)
if(length(unique(sapply(anno_list, function(x) x@which))) != 1) {
stop("All annotations should be all row annotation or all column annotation.")
}
if(length(gap) == 1) gap = rep(gap, n)
|
| e27480b9 |
if(length(gap) == n - 1) gap = unit.c(gap, unit(0, "mm"))
|
| 261bfec2 |
x = anno_list[[1]]
if(n > 1) {
x@gap[length(x@gap)] = gap[1]
}
for(i in seq_along(anno_list)[-1]) {
y = anno_list[[i]]
y@gap[length(y@gap)] = gap[i]
x@anno_list = c(x@anno_list, y@anno_list)
x@anno_size = unit.c(x@anno_size, y@anno_size)
x@gap = unit.c(x@gap, y@gap)
}
x@gap[length(x@gap)] = unit(0, "mm")
|
| 402ff791 |
if(x@which == "column") {
x@height = convertHeight(sum(x@anno_size) + sum(x@gap) - x@gap[length(x@gap)], "mm")
} else {
x@width = convertWidth(sum(x@anno_size) + sum(x@gap) - x@gap[length(x@gap)], "mm")
}
|
| 261bfec2 |
nm = names(x)
ld = duplicated(nm)
if(any(ld)) {
dup = unique(nm[ld])
warning(paste0("Following annotation names are duplicated:\n ", paste(dup, collapse = ", ")))
nm2 = nm
nm2[unlist(split(seq_along(nm), nm))] = unlist(lapply(split(nm, nm), seq_along))
l = nm %in% dup
nm[l] = paste0(nm[l], "_", nm2[l])
names(x) = nm
}
extended = unit(c(0, 0, 0, 0), "mm")
for(i in 1:4) {
extended[[i]] = max(sapply(x@anno_list, function(anno) {
anno@extended[[i]]
}))
}
x@extended = extended
return(x)
}
|
| e27480b9 |
# == title
# Annotation Names
#
# == param
# -x A `HeatmapAnnotation-class` object.
#
# == example
# ha = HeatmapAnnotation(foo = 1:10, bar = anno_points(10:1))
# names(ha)
|
| 261bfec2 |
names.HeatmapAnnotation = function(x) {
names(x@anno_list)
}
|
| e27480b9 |
# == title
# Assign Annotation Names
#
# == param
# -x A `HeatmapAnnotation-class` object.
# -value A vector of new names.
#
# == example
# ha = HeatmapAnnotation(foo = 1:10, bar = anno_points(10:1))
# names(ha) = c("A", "B")
# names(ha)
|
| ad35494a |
"names<-.HeatmapAnnotation" = function(x, value) {
|
| 261bfec2 |
if(length(value) != length(x@anno_list)) {
stop("Length of `value` should be same as number of annotations.")
}
if(any(duplicated(value))) {
stop("Annotation names should be unique.")
}
names(x@anno_list) = value
for(i in seq_along(value)) {
x@anno_list[[i]]@name = value[i]
}
return(x)
}
|
| e27480b9 |
# == title
# Subset the HeatmapAnnotation object
#
# == param
# -x A `HeatmapAnnotation-class` object.
# -i Index of observations.
# -j Index of annotations.
#
# == example
# ha = HeatmapAnnotation(foo = 1:10, bar = anno_points(10:1),
# sth = cbind(1:10, 10:1))
# ha[1:5, ]
# ha[, c("foo", "bar")]
# ha[, 1:2]
# ha[1:5, c("foo", "sth")]
|
| 261bfec2 |
"[.HeatmapAnnotation" = function(x, i, j) {
if(!missing(j)) {
if(is.character(j)) {
j = which(names(x@anno_list) %in% j)
}
}
if(nargs() == 1) { # ha[]
return(x)
} else if(nargs() == 3 && missing(i)) { # ha[, "foo"]
x2 = x
x2@anno_list = x@anno_list[j]
for(nm in names(x2@anno_list)) {
x2@anno_list[[nm]] = copy_all(x2@anno_list[[nm]])
}
x2@anno_size = x@anno_size[j]
x2@gap = x@gap[j]
x2@gap[length(x2@gap)] = unit(0, "mm")
|
| e27480b9 |
size(x2) = sum(x2@anno_size) + sum(x2@gap) - x2@gap[length(x2@gap)]
|
| 261bfec2 |
} else if(nargs() == 3 && missing(j)) { # ha[1:4, ]
x2 = x
for(nm in names(x2@anno_list)) {
x2@anno_list[[nm]] = x2@anno_list[[nm]][i]
}
} else if(nargs() == 2) { # ha[1:4]
x2 = x
for(nm in names(x2@anno_list)) {
x2@anno_list[[nm]] = x2@anno_list[[nm]][i]
}
} else if (!missing(i) && !missing(j)) { # ha[1:4, "foo"]
x2 = x
x2@anno_list = x@anno_list[j]
for(nm in names(x2@anno_list)) {
x2@anno_list[[nm]] = x2@anno_list[[nm]][i]
}
x2@anno_size = x@anno_size[j]
x2@gap = x@gap[j]
x2@gap[length(x2@gap)] = unit(0, "mm")
|
| e27480b9 |
size(x2) = sum(x2@anno_size) + sum(x2@gap) - x2@gap[length(x2@gap)]
|
| 261bfec2 |
}
extended = unit(c(0, 0, 0, 0), "mm")
for(i in 1:4) {
extended[[i]] = max(sapply(x2@anno_list, function(anno) {
anno@extended[[i]]
}))
}
x2@extended = extended
return(x2)
}
|
| 402ff791 |
|
| e27480b9 |
# == title
# Number of Annotations
#
# == param
# -x A `HeatmapAnnotation-class` object.
#
|
| 402ff791 |
length.HeatmapAnnotation = function(x) {
length(x@anno_list)
}
|
| e27480b9 |
# == title
# Resize the Width or Height of Heatmap Annotations
#
# == param
|
| ad35494a |
# -object A `HeatmapAnnotation-class` object.
# -annotation_height A vector of of annotation heights in `grid::unit` class.
# -annotation_width A vector of of annotation widths in `grid::unit` class.
|
| e27480b9 |
# -height The height of the complete heatmap annotation.
# -width The width of the complete heatmap annotation.
|
| 6849ddae |
# -anno_simple_size The size of one line of the simple annotation.
|
| e27480b9 |
# -simple_anno_size_adjust Whether adjust the size of the simple annotation?
#
# == details
# The function only adjust height for column annotations and width for row annotations.
#
# the basic rule is:
# 1. if ``annotation_height`` is set, it needs to be a vector and ``height`` is disabled. If all
# ``annotation_height`` are absolute units, ``height`` is ignored.
# 2. if ``annotation_height`` contains non-absolute units, ``height`` also need to be set and the
# non-absolute unit should be set in a simple form such as 1:10 or ``unit(1, "null")``.
|
| 6849ddae |
# 3. ``anno_simple_size`` is only used when ``annotation_height`` is NULL.
|
| e27480b9 |
# 4. if only ``height`` is set, non-simple annotation is adjusted while keep simple anntation unchanged.
# 5. if only ``height`` is set and all annotations are simple annotations, all anntations are adjusted.
|
| 6849ddae |
# and ``anno_simple_size`` is disabled.
|
| e27480b9 |
# 6. If ``simple_anno_size_adjust`` is ``FALSE``, the size of the simple annotations will not change.
#
|
| 402ff791 |
setMethod(f = "resize",
signature = "HeatmapAnnotation",
definition = function(object,
annotation_height = NULL,
annotation_width = NULL,
height = NULL,
width = NULL,
|
| 6849ddae |
anno_simple_size = ht_opt$anno_simple_size,
|
| 402ff791 |
simple_anno_size_adjust = FALSE) {
if(object@which == "column") {
if(!missing(width) || !missing(annotation_width)) {
stop("Please use width() directly")
}
}
if(object@which == "colrowumn") {
if(!missing(height) || !missing(annotation_height)) {
stop("Please use height() directly")
}
}
if(!simple_anno_size_adjust) {
if(all(sapply(object@anno_list, is_simple_annotation))) {
return(object)
}
}
which = object@which
if(which == "column") {
if(is.null(height)) {
is_size_set = FALSE
} else {
if(!inherits(height, "unit")) {
stop("`height` should be a `unit` object")
}
if(!is_abs_unit(height)) {
stop("`height` should be an absolute unit.")
}
is_size_set = TRUE
}
if(is.null(annotation_height)) {
is_annotation_size_set = FALSE
} else {
is_annotation_size_set = TRUE
annotation_size_adjusted = annotation_height
}
size_adjusted = height
size_name = "height"
} else if(which == "row") {
if(is.null(width)) {
is_size_set = FALSE
} else {
if(!inherits(width, "unit")) {
stop("`width` should be a `unit` object")
}
if(!is_abs_unit(width)) {
stop("`width` should be an absolute unit.")
}
is_size_set = TRUE
}
if(is.null(annotation_width)) {
is_annotation_size_set = FALSE
} else {
is_annotation_size_set = TRUE
annotation_size_adjusted = annotation_width
}
size_adjusted = width
size_name = "width"
}
if(which == "column") {
convertUnitFun = convertHeight
} else if(which == "row") {
convertUnitFun = convertWidth
}
anno_size = object@anno_size
size = slot(object, size_name)
gap = object@gap
gap = gap[-length(gap)]
n = length(object@anno_list)
# the basic rule is
# 1. if annotation_height is set, it needs to be a vector and height is disabled. If all
# annotation_height are absolute units, height is ignored
# 2. if annotation height contains non-absolute units, height also need to be set and the
# non-absolute unit should be set in a simple form such as 1:10 or unit(1, "null")
# 3. line_size is only used when annotation_height is NULL
# 4. if only height is set, non-simple annotation is adjusted while keep simple anntation unchanged
# 5. if only height is set and all annotations are simple annotations, all anntations are adjusted.
# and line_size is disabled.
if(is_annotation_size_set) {
if(length(annotation_size_adjusted) == 1) {
annotation_size_adjusted = rep(1, n)
}
if(length(annotation_size_adjusted) != n) {
stop(paste0("Length of annotation_", size_name, " should be same as number of annotations.", sep = ""))
}
if(!inherits(annotation_size_adjusted, "unit")) {
annotation_size_adjusted = unit(annotation_size_adjusted, "null")
}
l_rel_unit = !sapply(1:n, function(i) is_abs_unit(annotation_size_adjusted[i]))
if(any(l_rel_unit)) { # height/width must be set as an absolute unit
# height/width must be set
if(is_size_set) {
if(is_abs_unit(size_adjusted)) {
rel_num = sapply(which(l_rel_unit), function(i) {
if(identical(class(annotation_size_adjusted[i]), "unit")) {
if(attr(annotation_size_adjusted[i], "unit") != "null") {
stop("relative unit should be defined as `unit(..., 'null')")
}
} else {
stop("relative unit should be defined as `unit(..., 'null')")
}
annotation_size_adjusted[i][[1]]
})
rel_num = rel_num/sum(rel_num)
if(any(!l_rel_unit)) {
ts = size_adjusted - sum(gap) - sum(annotation_size_adjusted[!l_rel_unit])
} else {
ts = size_adjusted - sum(gap)
}
if(convertUnitFun(ts, "mm", valueOnly = TRUE) <= 0) {
stop(paste0(size_name, "is too small."))
}
ind = which(l_rel_unit)
for(i in seq_along(ind)) {
annotation_size_adjusted[ ind[i] ] = ts*rel_num[i]
}
} else {
stop(paste0("Since annotation_", size_name, " contains relative units, ", size_name, " must be set as an absolute unit."))
}
} else {
stop(paste0("Since annotation_", size_name, " contains relative units, ", size_name, " must be set."))
}
}
}
# from here `annotation_size_adjusted` contains absolute units if it is called.
gap = convertUnitFun(gap, "mm", valueOnly = TRUE)
if(is_size_set) {
size_adjusted = convertUnitFun(size_adjusted, "mm", valueOnly = TRUE)
}
if(is_annotation_size_set) {
annotation_size_adjusted = convertUnitFun(annotation_size_adjusted, "mm", valueOnly = TRUE)
}
if(is_annotation_size_set) {
# since annotation_size_adjusted has been recalculated, here we simply
# update the corresponding slots
|
| 30d2c5b2 |
slot(object, size_name) = unit(sum(annotation_size_adjusted) + sum(gap), "mm")
|
| 402ff791 |
object@anno_size = unit(annotation_size_adjusted, "mm")
} else {
size = convertUnitFun(size, "mm", valueOnly = TRUE)
anno_size = convertUnitFun(anno_size, "mm", valueOnly = TRUE)
l_simple_anno = sapply(seq_len(n), function(i) {
!is.null(object@anno_list[[i]]@color_mapping)
})
if(all(l_simple_anno)) {
anno_size2 = anno_size/sum(anno_size) * (size_adjusted - sum(gap))
size_adjusted = unit(size_adjusted, "mm")
anno_size2 = unit(anno_size2, "mm")
} else {
anno_size2 = anno_size
# size_adjusted = convertUnitFun(size_adjusted, "mm", valueOnly = TRUE)
|
| 6849ddae |
if(is.null(anno_simple_size)) {
anno_simple_size = 5
|
| 402ff791 |
} else {
|
| 6849ddae |
anno_simple_size = convertUnitFun(anno_simple_size, "mm", valueOnly = TRUE)
|
| 402ff791 |
}
if(size_adjusted <= sum(gap)) {
stop(paste0(size_name, " you set is smaller than sum of gaps."))
}
## fix the size of simple annotation and zoom function annotations
|
| 6849ddae |
ts = size_adjusted - sum(gap) - sum(anno_size[l_simple_anno]*anno_simple_size/5)
|
| 402ff791 |
if(ts < 0) {
stop(paste0(size_name, " you set is too small."))
}
anno_size2[!l_simple_anno] = anno_size[!l_simple_anno]/sum(anno_size[!l_simple_anno]) * ts
|
| 6849ddae |
anno_size2[l_simple_anno] = anno_size[l_simple_anno]*anno_simple_size/5
|
| 402ff791 |
size_adjusted = unit(size_adjusted, "mm")
anno_size2 = unit(anno_size2, "mm")
}
slot(object, size_name) = size_adjusted
object@anno_size = anno_size2
}
for(i in seq_along(object@anno_list)) {
if(size_name == "width") {
width(object@anno_list[[i]]) = object@anno_size[i]
} else {
height(object@anno_list[[i]]) = object@anno_size[i]
}
}
return(object)
})
|
