Browse code

move heatmap() as a private function

Zuguang Gu authored on 21/12/2020 16:03:30
Showing9 changed files

... ...
@@ -1,8 +1,8 @@
1 1
 Package: ComplexHeatmap
2 2
 Type: Package
3 3
 Title: Make Complex Heatmaps
4
-Version: 2.7.2
5
-Date: 2020-12-18
4
+Version: 2.7.2.1000
5
+Date: 2020-12-21
6 6
 Author: Zuguang Gu
7 7
 Maintainer: Zuguang Gu <z.gu@dkfz.de>
8 8
 Depends: R (>= 3.1.2), methods, grid, graphics, stats, grDevices
... ...
@@ -183,7 +183,6 @@ export("grid.annotation_axis")
183 183
 export("grid.boxplot")
184 184
 export("grid.dendrogram")
185 185
 export("gt_render")
186
-export("heatmap")
187 186
 export("heatmap.2")
188 187
 export("ht_global_opt")
189 188
 export("ht_opt")
... ...
@@ -244,8 +244,17 @@ AnnotationFunction = function(fun, fun_name = "", which = c("column", "row"),
244 244
 		}
245 245
 		x = copy_all(x)
246 246
 		if(x@fun_name == "anno_mark") {
247
-			ind_at = which(x@var_env[["at"]] %in% i)
247
+			called_args = attr(x, "called_args")
248
+			i = sort(i)
249
+			l = called_args$at %in% i
250
+			called_args$at = which(i %in% called_args$at)
251
+			called_args$labels = called_args$labels[l]
252
+			called_args$link_gp = subset_gp(called_args$link_gp, l)
253
+			called_args$labels_gp = subset_gp(called_args$labels_gp, l)
254
+			x2 = do.call(anno_mark, called_args)
255
+			return(x2)
248 256
 		}
257
+
249 258
 		for(var in names(x@subset_rule)) {
250 259
 			
251 260
 			oe = try(x@var_env[[var]] <- x@subset_rule[[var]](x@var_env[[var]], i), silent = TRUE)
... ...
@@ -2813,11 +2813,20 @@ anno_mark = function(at, labels, which = c("column", "row"),
2813 2813
 	if(is.logical(at)) at = which(at)
2814 2814
 
2815 2815
 	n = length(at)
2816
+
2816 2817
 	if(n < 1) {
2817
-		stop_wrap("Length of `at` should be positive.")
2818
+		return(anno_empty(which = which, border = FALSE))
2818 2819
 	}
2820
+
2819 2821
 	link_gp = recycle_gp(link_gp, n)
2820 2822
 	labels_gp = recycle_gp(labels_gp, n)
2823
+	
2824
+	od = order(at)
2825
+	at = at[od]
2826
+	labels = labels[od]
2827
+	link_gp = subset_gp(link_gp, od)
2828
+	labels_gp = subset_gp(labels_gp, od)
2829
+
2821 2830
 	labels2index = structure(seq_along(at), names = as.character(labels))
2822 2831
 	at2labels = structure(labels, names = at)
2823 2832
 
... ...
@@ -3020,6 +3029,20 @@ anno_mark = function(at, labels, which = c("column", "row"),
3020 3029
 	anno@subset_rule$at = subset_by_intersect
3021 3030
 
3022 3031
 	anno@subsetable = TRUE
3032
+
3033
+	attr(anno, "called_args") = list(
3034
+		at = at, 
3035
+		labels = labels, 
3036
+		which = which, 
3037
+		side = side,
3038
+		labels_gp = labels_gp, 
3039
+		labels_rot = labels_rot, 
3040
+		padding = padding, 
3041
+		link_width = link_width, 
3042
+		link_height = link_height,
3043
+		link_gp = link_gp, 
3044
+		extend = extend
3045
+	)
3023 3046
 	return(anno)
3024 3047
 }
3025 3048
 
... ...
@@ -1058,12 +1058,16 @@ anno_type = function(ha) {
1058 1058
         for(nm in names(x2@anno_list)) {
1059 1059
         	x2@anno_list[[nm]] = x2@anno_list[[nm]][i]
1060 1060
         }
1061
+        x2@anno_size = do.call(unit.c, lapply(x2@anno_list, size))
1062
+        size(x2) = sum(x2@anno_size) + sum(x2@gap) - x2@gap[length(x2@gap)]
1061 1063
 
1062 1064
     } else if(nargs() == 2) { # ha[1:4]
1063 1065
     	x2 = x
1064 1066
         for(nm in names(x2@anno_list)) {
1065 1067
         	x2@anno_list[[nm]] = x2@anno_list[[nm]][i]
1066 1068
         }
1069
+        x2@anno_size = do.call(unit.c, lapply(x2@anno_list, size))
1070
+        size(x2) = sum(x2@anno_size) + sum(x2@gap) - x2@gap[length(x2@gap)]
1067 1071
 
1068 1072
     } else if (!missing(i) && !missing(j)) { # ha[1:4, "foo"]
1069 1073
     	x2 = x
... ...
@@ -1075,6 +1079,7 @@ anno_type = function(ha) {
1075 1079
         x2@gap = x@gap[j]
1076 1080
         x2@gap[length(x2@gap)] = unit(0, "mm")
1077 1081
 
1082
+        x2@anno_size = do.call(unit.c, lapply(x2@anno_list, size))
1078 1083
         size(x2) = sum(x2@anno_size) + sum(x2@gap) - x2@gap[length(x2@gap)]
1079 1084
     }
1080 1085
     
... ...
@@ -827,6 +827,11 @@ has_AnnotationFunction = function(single_anno) {
827 827
         if(inherits(x@fun, "AnnotationFunction")) {
828 828
             if(x@fun@subsetable) {
829 829
                 x2@fun = x@fun[i]
830
+                if(x@which == "row") {
831
+                    x2@width = x2@fun@width
832
+                } else {
833
+                    x2@height = x2@fun@height
834
+                }
830 835
                 return(x2)
831 836
             }
832 837
         }
... ...
@@ -1,4 +1,4 @@
1
-# == title
1
+
2 2
 # Translate stats::heatmap to ComplexHeatmap::Heatmap
3 3
 #
4 4
 # == alias
... ...
@@ -101,7 +101,7 @@ There are following blog posts focusing on specific topics:
101 101
 
102 102
 ### UpSet plot
103 103
 
104
-<img src="https://user-images.githubusercontent.com/449218/102615477-48c76a80-4136-11eb-98d9-3c528844fbe8.png" width=700 />
104
+<img src="https://user-images.githubusercontent.com/449218/102615477-48c76a80-4136-11eb-98d9-3c528844fbe8.png" width=500 />
105 105
 
106 106
 ## License
107 107
 
108 108
deleted file mode 100644
... ...
@@ -1,79 +0,0 @@
1
-\name{heatmap}
2
-\alias{stats_heatmap}
3
-\alias{heatmap}
4
-\title{
5
-Translate stats::heatmap to ComplexHeatmap::Heatmap
6
-}
7
-\description{
8
-Translate stats::heatmap to ComplexHeatmap::Heatmap
9
-}
10
-\usage{
11
-heatmap(x,
12
-    col = hcl.colors(12, "YlOrRd", rev = TRUE),
13
-    Rowv = NULL,
14
-    Colv = NULL,
15
-    distfun = dist,
16
-    hclustfun = hclust,
17
-    reorderfun = function(d, w) reorder(d, w),
18
-    add.expr,
19
-    symm = FALSE,
20
-    revC = identical(Colv, "Rowv"),
21
-    scale = c("row", "column", "none"),
22
-    na.rm = TRUE,
23
-    margins = c(5, 5),
24
-    ColSideColors,
25
-    RowSideColors,
26
-    cexRow = 0.6,
27
-    cexCol = 0.6,
28
-    labRow = NULL,
29
-    labCol = NULL,
30
-    main = NULL,
31
-    xlab = NULL,
32
-    ylab = NULL,
33
-    keep.dendro = FALSE,
34
-    verbose = getOption("verbose"),
35
-    ...)
36
-}
37
-\arguments{
38
-
39
-  \item{x}{The input matrix.}
40
-  \item{col}{A vector of colors.}
41
-  \item{Rowv}{The same as in \code{\link[stats]{heatmap}}.}
42
-  \item{Colv}{The same as in \code{\link[stats]{heatmap}}.}
43
-  \item{distfun}{The same as in \code{\link[stats]{heatmap}}.}
44
-  \item{hclustfun}{The same as in \code{\link[stats]{heatmap}}.}
45
-  \item{reorderfun}{The same as in \code{\link[stats]{heatmap}}.}
46
-  \item{add.expr}{Ignored.}
47
-  \item{symm}{Ignored.}
48
-  \item{revC}{Ignored.}
49
-  \item{scale}{The same as in \code{\link[stats]{heatmap}}.}
50
-  \item{na.rm}{Ignored.}
51
-  \item{margins}{Ignored.}
52
-  \item{ColSideColors}{The same as in \code{\link[stats]{heatmap}}.}
53
-  \item{RowSideColors}{The same as in \code{\link[stats]{heatmap}}.}
54
-  \item{cexRow}{The same as in \code{\link[stats]{heatmap}}.}
55
-  \item{cexCol}{The same as in \code{\link[stats]{heatmap}}.}
56
-  \item{labRow}{The same as in \code{\link[stats]{heatmap}}.}
57
-  \item{labCol}{The same as in \code{\link[stats]{heatmap}}.}
58
-  \item{main}{The same as in \code{\link[stats]{heatmap}}.}
59
-  \item{xlab}{The same as in \code{\link[stats]{heatmap}}.}
60
-  \item{ylab}{The same as in \code{\link[stats]{heatmap}}.}
61
-  \item{keep.dendro}{Ignored.}
62
-  \item{verbose}{Ignored.}
63
-  \item{...}{Other arguments passed to \code{\link{Heatmap}}.}
64
-
65
-}
66
-\details{
67
-This function aims to execute \code{stats::heatmap} code purely with ComplexHeatmap.
68
-}
69
-\value{
70
-A \code{\link{Heatmap-class}} object.
71
-}
72
-\seealso{
73
-\code{\link{compare_heatmap}} that compares heatmaps between \code{stats::heatmap()} and \code{ComplexHeatmap::heatmap()}.
74
-}
75
-\examples{
76
-# There is no example
77
-NULL
78
-
79
-}