R/HeatmapAnnotation-class.R
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)
 })