Browse code

print message when the number of colors is the same as the number of unique values in the matrix

Zuguang Gu authored on 29/09/2022 07:58:52
Showing1 changed files
... ...
@@ -597,6 +597,9 @@ Heatmap = function(matrix, col, name,
597 597
 
598 598
             if(is.null(names(col))) {
599 599
                 if(length(col) == length(unique(as.vector(matrix)))) {
600
+                    if(length(col) >= 50) {
601
+                        message_wrap(qq("There are @{length(col)} unique colors in the vector `col` and @{length(col)} unique values in `matrix`. `Heatmap()` will treat it as an exact discrete one-to-one mapping. If this is not what you want, slightly change the number of colors, e.g. by adding one more color or removing a color."))
602
+                    }
600 603
                     if(is.null(fa_level)) {
601 604
                         if(is.numeric(matrix)) {
602 605
                             names(col) = sort(unique(as.vector(matrix)))
Browse code

comb_col is now correctly assigned when the combination matrix is transposed

Zuguang Gu authored on 27/07/2022 09:51:25
Showing1 changed files
... ...
@@ -626,14 +626,14 @@ Heatmap = function(matrix, col, name,
626 626
                     col = col[intersect(c(fa_level, "_NA_"), names(col))]
627 627
                 }
628 628
                 if(!is.null(heatmap_legend_param) && !identical(.Object@matrix_param$gp$type, "none")) {
629
-                    if(!is.null(heatmap_legend_param$at) && !is.null(heatmap_legend_param$labels)) {
629
+                    if(!is.null(heatmap_legend_param$at) && !is.null(heatmap_legend_param[["labels"]])) {
630 630
                         l = heatmap_legend_param$at %in% names(col)
631 631
                         heatmap_legend_param$at = heatmap_legend_param$at[l]
632
-                        heatmap_legend_param$labels = heatmap_legend_param$labels[l]
632
+                        heatmap_legend_param[["labels"]] = heatmap_legend_param[["labels"]][l]
633 633
                     } else if(is.null(heatmap_legend_param$at) && !is.null(heatmap_legend_param$labels)) {
634
-                        l = heatmap_legend_param$labels %in% names(col)
635
-                        heatmap_legend_param$labels = heatmap_legend_param$labels[l]
636
-                    } else if(!is.null(heatmap_legend_param$at) && is.null(heatmap_legend_param$labels)) {
634
+                        l = heatmap_legend_param[["labels"]] %in% names(col)
635
+                        heatmap_legend_param[["labels"]] = heatmap_legend_param[["labels"]][l]
636
+                    } else if(!is.null(heatmap_legend_param$at) && is.null(heatmap_legend_param[["labels"]])) {
637 637
                         l = heatmap_legend_param$at %in% names(col)
638 638
                         heatmap_legend_param$at = heatmap_legend_param$at[l]
639 639
                     }
... ...
@@ -644,7 +644,7 @@ Heatmap = function(matrix, col, name,
644 644
         }
645 645
         .Object@matrix_legend_param = heatmap_legend_param
646 646
     }
647
-    
647
+
648 648
     ##### titles, should also consider titles after row splitting #####
649 649
     if(identical(row_title, NA) || identical(row_title, "")) {
650 650
         row_title = character(0)
Browse code

column_title_rot can be any degree value

Zuguang Gu authored on 31/05/2022 09:48:27
Showing1 changed files
... ...
@@ -102,11 +102,11 @@ Heatmap = setClass("Heatmap",
102 102
 # -row_title Title on the row.
103 103
 # -row_title_side Will the title be put on the left or right of the heatmap?
104 104
 # -row_title_gp Graphic parameters for row title.
105
-# -row_title_rot Rotation of row title. Only 0, 90, 270 are allowed to set.
105
+# -row_title_rot Rotation of row title.
106 106
 # -column_title Title on the column.
107 107
 # -column_title_side Will the title be put on the top or bottom of the heatmap?
108 108
 # -column_title_gp Graphic parameters for column title.
109
-# -column_title_rot Rotation of column titles. Only 0, 90, 270 are allowed to set.
109
+# -column_title_rot Rotation of column titles.
110 110
 # -cluster_rows If the value is a logical, it controls whether to make cluster on rows. The value can also
111 111
 #               be a `stats::hclust` or a `stats::dendrogram` which already contains clustering.
112 112
 #               Check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#clustering .
Browse code

do not adjust cols when rect_gp = gpar(type='none')

Zuguang Gu authored on 19/05/2022 19:54:44
Showing1 changed files
... ...
@@ -559,7 +559,7 @@ Heatmap = function(matrix, col, name,
559 559
             warning_wrap("You defined `cell_fun` for a heatmap with more than 100 rows or columns, which might be very slow to draw. Consider to use the vectorized version `layer_fun`.")
560 560
         }
561 561
     }
562
-    
562
+
563 563
     ### color for main matrix #########
564 564
     if(ncol(matrix) > 0 && nrow(matrix) > 0) {
565 565
         if(missing(col)) {
... ...
@@ -625,7 +625,7 @@ Heatmap = function(matrix, col, name,
625 625
                 } else {
626 626
                     col = col[intersect(c(fa_level, "_NA_"), names(col))]
627 627
                 }
628
-                if(!is.null(heatmap_legend_param)) {
628
+                if(!is.null(heatmap_legend_param) && !identical(.Object@matrix_param$gp$type, "none")) {
629 629
                     if(!is.null(heatmap_legend_param$at) && !is.null(heatmap_legend_param$labels)) {
630 630
                         l = heatmap_legend_param$at %in% names(col)
631 631
                         heatmap_legend_param$at = heatmap_legend_param$at[l]
Browse code

reduce at and label for heatmap_legend_param according to col

Zuguang Gu authored on 12/04/2022 16:11:28
Showing1 changed files
... ...
@@ -619,11 +619,25 @@ Heatmap = function(matrix, col, name,
619 619
                 }
620 620
             } else {
621 621
                 full_col = col
622
+                # note here col can be reduced
622 623
                 if(is.null(fa_level)) {
623 624
                     col = col[intersect(c(names(col), "_NA_"), as.character(matrix))]
624 625
                 } else {
625 626
                     col = col[intersect(c(fa_level, "_NA_"), names(col))]
626 627
                 }
628
+                if(!is.null(heatmap_legend_param)) {
629
+                    if(!is.null(heatmap_legend_param$at) && !is.null(heatmap_legend_param$labels)) {
630
+                        l = heatmap_legend_param$at %in% names(col)
631
+                        heatmap_legend_param$at = heatmap_legend_param$at[l]
632
+                        heatmap_legend_param$labels = heatmap_legend_param$labels[l]
633
+                    } else if(is.null(heatmap_legend_param$at) && !is.null(heatmap_legend_param$labels)) {
634
+                        l = heatmap_legend_param$labels %in% names(col)
635
+                        heatmap_legend_param$labels = heatmap_legend_param$labels[l]
636
+                    } else if(!is.null(heatmap_legend_param$at) && is.null(heatmap_legend_param$labels)) {
637
+                        l = heatmap_legend_param$at %in% names(col)
638
+                        heatmap_legend_param$at = heatmap_legend_param$at[l]
639
+                    }
640
+                }
627 641
                 .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col, full_col = full_col)
628 642
                 if(verbose) qqcat("input color is a named vector\n")
629 643
             }
Browse code

global variables in cell_fun are automatically saved

Zuguang Gu authored on 02/04/2022 15:52:11
Showing1 changed files
... ...
@@ -531,6 +531,26 @@ Heatmap = function(matrix, col, name,
531 531
     if(!missing(border_gp) && missing(border)) border = TRUE
532 532
     .Object@matrix_param$border = border
533 533
     .Object@matrix_param$border_gp = border_gp
534
+
535
+    if(!is.null(cell_fun)) {
536
+        global_vars = codetools::findGlobals(cell_fun, merge = FALSE)$variables
537
+
538
+        ee = new.env(parent = environment(cell_fun))
539
+        for(v in global_vars) {
540
+            assign(v, value = get(v, envir = environment(cell_fun)), envir = ee)
541
+        }
542
+        environment(cell_fun) = ee
543
+    }
544
+    if(!is.null(layer_fun)) {
545
+        global_vars = codetools::findGlobals(layer_fun, merge = FALSE)$variables
546
+
547
+        ee = new.env(parent = environment(layer_fun))
548
+        for(v in global_vars) {
549
+            assign(v, value = get(v, envir = environment(layer_fun)), envir = ee)
550
+        }
551
+        environment(layer_fun) = ee
552
+    }
553
+
534 554
     .Object@matrix_param$cell_fun = cell_fun
535 555
     .Object@matrix_param$layer_fun = layer_fun
536 556
 
Browse code

add na.rm = TRUE in quantile()

Zuguang Gu authored on 23/03/2022 16:30:55
Showing1 changed files
... ...
@@ -557,12 +557,24 @@ Heatmap = function(matrix, col, name,
557 557
             if(verbose) qqcat("color is not specified, use randomly generated colors\n")
558 558
         }
559 559
         if(is.function(col)) {
560
-            .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
560
+            if(is.null(attr(col, "breaks"))) {
561
+                breaks = seq(min(matrix, na.rm = TRUE), max(matrix, na.rm = TRUE), length.out = 5)
562
+                rg = range(breaks)
563
+                diff = rg[2] - rg[1]
564
+                rg[1] = rg[1] + diff*0.05
565
+                rg[2] = rg[2] - diff*0.05
566
+
567
+                le = pretty(rg, n = 3)
568
+                .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, breaks = le, na_col = na_col)
569
+            } else {
570
+                .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
571
+            }
561 572
             if(verbose) qqcat("input color is a color mapping function\n")
562 573
         } else if(inherits(col, "ColorMapping")){
563 574
             .Object@matrix_color_mapping = col
564 575
             if(verbose) qqcat("input color is a ColorMapping object\n")
565 576
         } else {
577
+
566 578
             if(is.null(names(col))) {
567 579
                 if(length(col) == length(unique(as.vector(matrix)))) {
568 580
                     if(is.null(fa_level)) {
Browse code

add show_name in anno_empty()

Zuguang Gu authored on 03/02/2022 09:53:48
Showing1 changed files
... ...
@@ -974,7 +974,17 @@ Heatmap = function(matrix, col, name,
974 974
     .Object@heatmap_param$height = heatmap_height
975 975
     .Object@heatmap_param$show_heatmap_legend = show_heatmap_legend
976 976
     .Object@heatmap_param$use_raster = use_raster
977
-    .Object@heatmap_param$raster_device = match.arg(raster_device)[1]
977
+
978
+    if(missing(raster_device)) {
979
+        if(requireNamespace("Cairo", quietly = TRUE)) {
980
+            raster_device = "CairoPNG"
981
+        } else {
982
+            raster_device = "png"
983
+        }
984
+    } else {
985
+        raster_device = match.arg(raster_device)[1]
986
+    }
987
+    .Object@heatmap_param$raster_device = raster_device
978 988
     .Object@heatmap_param$raster_quality = raster_quality
979 989
     .Object@heatmap_param$raster_device_param = raster_device_param
980 990
     .Object@heatmap_param$raster_resize_mat = raster_resize_mat
Browse code

change argument length to length.out in seq()

Zuguang Gu authored on 26/11/2021 14:06:31
Showing1 changed files
... ...
@@ -578,7 +578,7 @@ Heatmap = function(matrix, col, name,
578 578
                     .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col)
579 579
                     if(verbose) qqcat("input color is a vector with no names, treat it as discrete color mapping\n")
580 580
                 } else if(is.numeric(matrix)) {
581
-                    col = colorRamp2(seq(min(matrix, na.rm = TRUE), max(matrix, na.rm = TRUE), length = length(col)),
581
+                    col = colorRamp2(seq(min(matrix, na.rm = TRUE), max(matrix, na.rm = TRUE), length.out = length(col)),
582 582
                                      col, space = color_space)
583 583
                     .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
584 584
                     if(verbose) qqcat("input color is a vector with no names, treat it as continuous color mapping\n")
Browse code

recycle_gp(): now consider n = 0

Zuguang Gu authored on 13/11/2021 10:42:20
Showing1 changed files
... ...
@@ -360,7 +360,7 @@ Heatmap = function(matrix, col, name,
360 360
 
361 361
     if(is.data.frame(matrix)) {
362 362
         if(verbose) qqcat("convert data frame to matrix\n")
363
-        warning_wrap("The input is a data frame, convert it to a matrix.")
363
+        warning_wrap("The input is a data frame-like object, convert it to a matrix.")
364 364
         if(!all(sapply(matrix, is.numeric))) {
365 365
             warning_wrap("Note: not all columns in the data frame are numeric. The data frame will be converted into a character matrix.")
366 366
         }
Browse code

update

Zuguang Gu authored on 25/10/2021 10:18:45
Showing1 changed files
... ...
@@ -360,7 +360,10 @@ Heatmap = function(matrix, col, name,
360 360
 
361 361
     if(is.data.frame(matrix)) {
362 362
         if(verbose) qqcat("convert data frame to matrix\n")
363
-        warning_wrap("The input is a data frame, convert it to the matrix.")
363
+        warning_wrap("The input is a data frame, convert it to a matrix.")
364
+        if(!all(sapply(matrix, is.numeric))) {
365
+            warning_wrap("Note: not all columns in the data frame are numeric. The data frame will be converted into a character matrix.")
366
+        }
364 367
         matrix = as.matrix(matrix)
365 368
     }
366 369
     fa_level = NULL
Browse code

restrict the size of the temp raster image

Zuguang Gu authored on 28/09/2021 09:20:28
Showing1 changed files
... ...
@@ -293,7 +293,7 @@ Heatmap = function(matrix, col, name,
293 293
     heatmap_legend_param = list(title = name),
294 294
 
295 295
     use_raster = NULL, 
296
-    raster_device = c("CairoPNG", "CairoJPEG", "CairoTIFF", "png", "jpeg", "tiff", "agg_png"),
296
+    raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF", "agg_png"),
297 297
     raster_quality = 1,
298 298
     raster_device_param = list(),
299 299
     raster_resize_mat = FALSE,
Browse code

check dimension names of matrices and annotations

Zuguang Gu authored on 13/07/2021 15:43:05
Showing1 changed files
... ...
@@ -803,6 +803,9 @@ Heatmap = function(matrix, col, name,
803 803
             }
804 804
         }
805 805
     }
806
+    if(!is.null(top_annotation)) {
807
+        validate_anno_names_with_matrix(matrix, top_annotation, "column")
808
+    }
806 809
     
807 810
     .Object@bottom_annotation = bottom_annotation # a `HeatmapAnnotation` object
808 811
     if(is.null(bottom_annotation)) {
... ...
@@ -826,6 +829,9 @@ Heatmap = function(matrix, col, name,
826 829
             }
827 830
         }
828 831
     }
832
+    if(!is.null(bottom_annotation)) {
833
+        validate_anno_names_with_matrix(matrix, bottom_annotation, "column")
834
+    }
829 835
 
830 836
     .Object@left_annotation = left_annotation # a `rowAnnotation` object
831 837
     if(is.null(left_annotation)) {
... ...
@@ -849,6 +855,9 @@ Heatmap = function(matrix, col, name,
849 855
             }
850 856
         }
851 857
     }
858
+    if(!is.null(left_annotation)) {
859
+        validate_anno_names_with_matrix(matrix, left_annotation, "row")
860
+    }
852 861
 
853 862
     .Object@right_annotation = right_annotation # a `rowAnnotation` object
854 863
     if(is.null(right_annotation)) {
... ...
@@ -872,6 +881,9 @@ Heatmap = function(matrix, col, name,
872 881
             }
873 882
         }
874 883
     }
884
+    if(!is.null(right_annotation)) {
885
+        validate_anno_names_with_matrix(matrix, right_annotation, "row")
886
+    }
875 887
 
876 888
     .Object@layout = list(
877 889
         layout_size = list(
Browse code

use github action

Zuguang Gu authored on 01/07/2021 11:29:17
Showing1 changed files
... ...
@@ -530,6 +530,12 @@ Heatmap = function(matrix, col, name,
530 530
     .Object@matrix_param$border_gp = border_gp
531 531
     .Object@matrix_param$cell_fun = cell_fun
532 532
     .Object@matrix_param$layer_fun = layer_fun
533
+
534
+    if(nrow(matrix) > 100 || ncol(matrix) > 100) {
535
+        if(!is.null(cell_fun)) {
536
+            warning_wrap("You defined `cell_fun` for a heatmap with more than 100 rows or columns, which might be very slow to draw. Consider to use the vectorized version `layer_fun`.")
537
+        }
538
+    }
533 539
     
534 540
     ### color for main matrix #########
535 541
     if(ncol(matrix) > 0 && nrow(matrix) > 0) {
Browse code

update

Zuguang authored on 28/03/2021 08:14:55
Showing1 changed files
... ...
@@ -467,6 +467,7 @@ Heatmap = function(matrix, col, name,
467 467
         column_km = 1
468 468
         if(verbose) qqcat("matrix is character. Do not cluster unless distance method is provided.\n")
469 469
     }
470
+    class(matrix) = "matrix"
470 471
     .Object@matrix = matrix
471 472
 
472 473
     .Object@matrix_param$row_km = row_km
Browse code

add 'graphics' argument in 'anno_block()'

Zuguang Gu authored on 11/03/2021 09:41:22
Showing1 changed files
... ...
@@ -179,7 +179,7 @@ Heatmap = setClass("Heatmap",
179 179
 # -use_raster Whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge. If number of rows or columns is more than 2000, it is by default turned on. Note if ``cell_fun``
180 180
 #       is set, ``use_raster`` is enforced to be ``FALSE``.
181 181
 # -raster_device Graphic device which is used to generate the raster image.
182
-# -raster_quality Ignored now.
182
+# -raster_quality A value larger than 1.
183 183
 # -raster_device_param A list of further parameters for the selected graphic device. For raster image support, please check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#heatmap-as-raster-image .
184 184
 # -raster_resize_mat Whether resize the matrix to let the dimension of the matrix the same as the dimension of the raster image?
185 185
 #          The value can be logical. If it is ``TRUE``, `base::mean` is used to summarize the sub matrix which corresponds to a single pixel.
... ...
@@ -294,7 +294,7 @@ Heatmap = function(matrix, col, name,
294 294
 
295 295
     use_raster = NULL, 
296 296
     raster_device = c("CairoPNG", "CairoJPEG", "CairoTIFF", "png", "jpeg", "tiff", "agg_png"),
297
-    raster_quality = 2,
297
+    raster_quality = 1,
298 298
     raster_device_param = list(),
299 299
     raster_resize_mat = FALSE,
300 300
     raster_by_magick = requireNamespace("magick", quietly = TRUE),
Browse code

class labels are kept for cluster_between_groups and cluster_within_group

Zuguang Gu authored on 04/03/2021 18:57:30
Showing1 changed files
... ...
@@ -1204,7 +1204,11 @@ make_cluster = function(object, which = c("row", "column")) {
1204 1204
             slot(object, paste0(which, "_dend_slice")) = dend_slice
1205 1205
 
1206 1206
             if(!is.null(split)) {
1207
-                split = data.frame(rep(seq_along(order_list), times = sapply(order_list, length)))
1207
+                if(is.null(attr(dend_list[[1]], ".class_label"))) {
1208
+                    split = data.frame(rep(seq_along(order_list), times = sapply(order_list, length)))
1209
+                } else {
1210
+                    split = data.frame(rep(sapply(dend_list, function(x) attr(x, ".class_label")), times = sapply(order_list, length)))
1211
+                }
1208 1212
                 object@matrix_param[[ paste0(which, "_split") ]] = split
1209 1213
 
1210 1214
                 # adjust row_names_param$gp if the length of some elements is the same as row slices
... ...
@@ -1231,7 +1235,7 @@ make_cluster = function(object, which = c("row", "column")) {
1231 1235
                     stop_wrap(qq("Length of `gap` should be 1 or number of @{which} slices."))
1232 1236
                 }
1233 1237
                 object@matrix_param[[ paste0(which, "_gap") ]] = gap # adjust title
1234
-                
1238
+
1235 1239
                 title = slot(object, paste0(which, "_title"))
1236 1240
                 if(!is.null(split)) {
1237 1241
                     if(length(title) == 0 && !is.null(title)) { ## default title
Browse code

number of split can be the same as number of matrix rows/columns

Zuguang Gu authored on 09/02/2021 20:14:10
Showing1 changed files
... ...
@@ -1145,7 +1145,7 @@ make_cluster = function(object, which = c("row", "column")) {
1145 1145
                 dend_slice = ct$upper
1146 1146
                 sth = tapply(order.dendrogram(dend_param$obj), 
1147 1147
                     rep(seq_along(dend_list), times = sapply(dend_list, nobs)), 
1148
-                    function(x) x)
1148
+                    function(x) x, simplify = FALSE)
1149 1149
                 attributes(sth) = NULL
1150 1150
                 order_list = sth
1151 1151
                 if(verbose) qqcat("cut @{which} dendrogram into @{split} slices.\n")
... ...
@@ -1579,9 +1579,9 @@ make_cluster = function(object, which = c("row", "column")) {
1579 1579
     }
1580 1580
     slot(object, paste0(which, "_title")) = title
1581 1581
     # check whether height of the dendrogram is zero
1582
-    if(all(sapply(dend_list, dend_heights) == 0)) {
1583
-        slot(object, paste0(which, "_dend_param"))$show = FALSE
1584
-    }
1582
+    # if(all(sapply(dend_list, dend_heights) == 0)) {
1583
+    #     slot(object, paste0(which, "_dend_param"))$show = FALSE
1584
+    # }
1585 1585
     return(object)
1586 1586
 
1587 1587
 }
Browse code

remove zoom argument from anno_empty()

Zuguang Gu authored on 26/01/2021 16:10:51
Showing1 changed files
... ...
@@ -556,7 +556,12 @@ Heatmap = function(matrix, col, name,
556 556
             if(is.null(names(col))) {
557 557
                 if(length(col) == length(unique(as.vector(matrix)))) {
558 558
                     if(is.null(fa_level)) {
559
-                        names(col) = sort(unique(as.vector(matrix)))
559
+                        if(is.numeric(matrix)) {
560
+                            names(col) = sort(unique(as.vector(matrix)))
561
+                            col = rev(col)
562
+                        } else {
563
+                            names(col) = sort(unique(as.vector(matrix)))
564
+                        }
560 565
                     } else {
561 566
                         names(col) = fa_level
562 567
                     }
Browse code

col can be set as NULL in Heatmap()

Zuguang Gu authored on 27/11/2020 09:57:23
Showing1 changed files
... ...
@@ -539,6 +539,13 @@ Heatmap = function(matrix, col, name,
539 539
             }
540 540
             if(verbose) qqcat("color is not specified, use randomly generated colors\n")
541 541
         }
542
+        if(is.null(col)) {
543
+            col = default_col(matrix, main_matrix = TRUE)
544
+            if(!is.null(fa_level)) {
545
+                col = col[fa_level]
546
+            }
547
+            if(verbose) qqcat("color is not specified, use randomly generated colors\n")
548
+        }
542 549
         if(is.function(col)) {
543 550
             .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
544 551
             if(verbose) qqcat("input color is a color mapping function\n")
Browse code

print message if directly setting anno_*() for 'top_annotation' argument

Zuguang Gu authored on 24/11/2020 08:23:47
Showing1 changed files
... ...
@@ -766,6 +766,9 @@ Heatmap = function(matrix, col, name,
766 766
     if(is.null(top_annotation)) {
767 767
         .Object@top_annotation_param$height = unit(0, "mm")    
768 768
     } else {
769
+        if(inherits(top_annotation, "AnnotationFunction")) {
770
+            stop_wrap("The annotation function `anno_*()` should be put inside `HeatmapAnnotation()`.")
771
+        }
769 772
         .Object@top_annotation_param$height = height(top_annotation) + ht_opt$COLUMN_ANNO_PADDING  # append the gap
770 773
     }
771 774
     if(!is.null(top_annotation)) {
... ...
@@ -786,6 +789,9 @@ Heatmap = function(matrix, col, name,
786 789
     if(is.null(bottom_annotation)) {
787 790
         .Object@bottom_annotation_param$height = unit(0, "mm")
788 791
     } else {
792
+        if(inherits(bottom_annotation, "AnnotationFunction")) {
793
+            stop_wrap("The annotation function `anno_*()` should be put inside `HeatmapAnnotation()`.")
794
+        }
789 795
         .Object@bottom_annotation_param$height = height(bottom_annotation) + ht_opt$COLUMN_ANNO_PADDING  # append the gap
790 796
     }
791 797
     if(!is.null(bottom_annotation)) {
... ...
@@ -806,6 +812,9 @@ Heatmap = function(matrix, col, name,
806 812
     if(is.null(left_annotation)) {
807 813
         .Object@left_annotation_param$width = unit(0, "mm")
808 814
     } else {
815
+        if(inherits(left_annotation, "AnnotationFunction")) {
816
+            stop_wrap("The annotation function `anno_*()` should be put inside `rowAnnotation()`.")
817
+        }
809 818
         .Object@left_annotation_param$width = width(left_annotation) + ht_opt$ROW_ANNO_PADDING  # append the gap
810 819
     }
811 820
     if(!is.null(left_annotation)) {
... ...
@@ -826,6 +835,9 @@ Heatmap = function(matrix, col, name,
826 835
     if(is.null(right_annotation)) {
827 836
         .Object@right_annotation_param$width = unit(0, "mm")
828 837
     } else {
838
+        if(inherits(right_annotation, "AnnotationFunction")) {
839
+            stop_wrap("The annotation function `anno_*()` should be put inside `rowAnnotation()`.")
840
+        }
829 841
         .Object@right_annotation_param$width = width(right_annotation) + ht_opt$ROW_ANNO_PADDING  # append the gap
830 842
     }
831 843
     if(!is.null(right_annotation)) {
Browse code

ignore NAs when clustering slices

Alex Saltzman authored on 01/11/2020 00:10:46
Showing1 changed files
... ...
@@ -1,4 +1,3 @@
1
-
2 1
 ###############################
3 2
 # class for single heatmap
4 3
 #
... ...
@@ -1275,14 +1274,14 @@ make_cluster = function(object, which = c("row", "column")) {
1275 1274
             # cl = km.fit$cluster
1276 1275
             cl = consensus_kmeans(mat, km, km_repeats)
1277 1276
             meanmat = lapply(sort(unique(cl)), function(i) {
1278
-                colMeans(mat[cl == i, , drop = FALSE])
1277
+                colMeans(mat[cl == i, , drop = FALSE], na.rm = TRUE)
1279 1278
             })
1280 1279
         } else {
1281 1280
             # km.fit = kmeans(t(mat), centers = km)
1282 1281
             # cl = km.fit$cluster
1283 1282
             cl = consensus_kmeans(t(mat), km, km_repeats)
1284 1283
             meanmat = lapply(sort(unique(cl)), function(i) {
1285
-                rowMeans(mat[, cl == i, drop = FALSE])
1284
+                rowMeans(mat[, cl == i, drop = FALSE], na.rm = TRUE)
1286 1285
             })
1287 1286
         }
1288 1287
 
... ...
@@ -1451,9 +1450,9 @@ make_cluster = function(object, which = c("row", "column")) {
1451 1450
 
1452 1451
         if(length(order_list) > 1 && cluster_slices) {
1453 1452
             if(which == "row") {
1454
-                slice_mean = sapply(order_list, function(ind) colMeans(mat[ind, , drop = FALSE]))
1453
+                slice_mean = sapply(order_list, function(ind) colMeans(mat[ind, , drop = FALSE], na.rm = TRUE))
1455 1454
             } else {
1456
-                slice_mean = sapply(order_list, function(ind) rowMeans(mat[, ind, drop = FALSE]))
1455
+                slice_mean = sapply(order_list, function(ind) rowMeans(mat[, ind, drop = FALSE], na.rm = TRUE))
1457 1456
             }
1458 1457
             if(!is.matrix(slice_mean)) {
1459 1458
                 slice_mean = matrix(slice_mean, nrow = 1)
... ...
@@ -1680,4 +1679,3 @@ setMethod(f = "prepare",
1680 1679
     return(object)
1681 1680
 
1682 1681
 })
1683
-
Browse code

finally adjust the space of column title according to ggplot2

Zuguang Gu authored on 30/10/2020 15:10:21
Showing1 changed files
... ...
@@ -223,11 +223,11 @@ Heatmap = function(matrix, col, name,
223 223
 
224 224
     row_title = character(0), 
225 225
     row_title_side = c("left", "right"), 
226
-    row_title_gp = gpar(fontsize = 13), 
226
+    row_title_gp = gpar(fontsize = 13.2), 
227 227
     row_title_rot = switch(row_title_side[1], "left" = 90, "right" = 270),
228 228
     column_title = character(0), 
229 229
     column_title_side = c("top", "bottom"), 
230
-    column_title_gp = gpar(fontsize = 13), 
230
+    column_title_gp = gpar(fontsize = 13.2), 
231 231
     column_title_rot = 0,
232 232
 
233 233
     cluster_rows = TRUE, 
Browse code

adjust spacings according to ggplot2

Zuguang Gu authored on 21/10/2020 07:52:11
Showing1 changed files
... ...
@@ -223,11 +223,11 @@ Heatmap = function(matrix, col, name,
223 223
 
224 224
     row_title = character(0), 
225 225
     row_title_side = c("left", "right"), 
226
-    row_title_gp = gpar(fontsize = 14), 
226
+    row_title_gp = gpar(fontsize = 13), 
227 227
     row_title_rot = switch(row_title_side[1], "left" = 90, "right" = 270),
228 228
     column_title = character(0), 
229 229
     column_title_side = c("top", "bottom"), 
230
-    column_title_gp = gpar(fontsize = 14), 
230
+    column_title_gp = gpar(fontsize = 13), 
231 231
     column_title_rot = 0,
232 232
 
233 233
     cluster_rows = TRUE, 
Browse code

col argument can be a super set of the elements in the character matrix

Zuguang Gu authored on 20/10/2020 19:30:27
Showing1 changed files
... ...
@@ -565,12 +565,13 @@ Heatmap = function(matrix, col, name,
565 565
                     stop_wrap("`col` should have names to map to values in `mat`.")
566 566
                 }
567 567
             } else {
568
+                full_col = col
568 569
                 if(is.null(fa_level)) {
569 570
                     col = col[intersect(c(names(col), "_NA_"), as.character(matrix))]
570 571
                 } else {
571 572
                     col = col[intersect(c(fa_level, "_NA_"), names(col))]
572 573
                 }
573
-                .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col)
574
+                .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col, full_col = full_col)
574 575
                 if(verbose) qqcat("input color is a named vector\n")
575 576
             }
576 577
         }
Browse code

change default raster device to CairoPNG

Zuguang Gu authored on 20/10/2020 13:15:35
Showing1 changed files
... ...
@@ -294,7 +294,7 @@ Heatmap = function(matrix, col, name,
294 294
     heatmap_legend_param = list(title = name),
295 295
 
296 296
     use_raster = NULL, 
297
-    raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF", "agg_png"),
297
+    raster_device = c("CairoPNG", "CairoJPEG", "CairoTIFF", "png", "jpeg", "tiff", "agg_png"),
298 298
     raster_quality = 2,
299 299
     raster_device_param = list(),
300 300
     raster_resize_mat = FALSE,
Browse code

fixed a bug when there is no clustering but with set split variables

Zuguang Gu authored on 20/10/2020 10:06:07
Showing1 changed files
... ...
@@ -1352,6 +1352,7 @@ make_cluster = function(object, which = c("row", "column")) {
1352 1352
         names(order_list) = level
1353 1353
     }
1354 1354
 
1355
+    slice_od = seq_along(order_list)
1355 1356
     # make dend in each slice
1356 1357
     if(cluster) {
1357 1358
         if(verbose) qqcat("apply clustering on each slice (@{length(order_list)} slices)\n")
Browse code

fixed a typo

Zuguang Gu authored on 20/10/2020 07:49:49
Showing1 changed files
... ...
@@ -98,7 +98,8 @@ Heatmap = setClass("Heatmap",
98 98
 # -jitter Random shifts added to the matrix. The value can be logical or a single numeric value. It it is ``TRUE``, random 
99 99
 #      values from uniform distribution between 0 and 1e-10 are generated. If it is a numeric value,
100 100
 #      the range for the uniform distribution is (0, ``jitter``). It is mainly to solve the problem of "Error: node stack overflow"
101
-#      when there are too many identical rows/columns for plotting the dendrograms.
101
+#      when there are too many identical rows/columns for plotting the dendrograms. ADD: From version 2.5.6, the error of node stack overflow
102
+#      has been fixed, now this argument is ignored.
102 103
 # -row_title Title on the row.
103 104
 # -row_title_side Will the title be put on the left or right of the heatmap?
104 105
 # -row_title_gp Graphic parameters for row title.
Browse code

support agg_png for writing temporary png files

Zuguang Gu authored on 09/10/2020 13:12:56
Showing1 changed files
... ...
@@ -293,7 +293,7 @@ Heatmap = function(matrix, col, name,
293 293
     heatmap_legend_param = list(title = name),
294 294
 
295 295
     use_raster = NULL, 
296
-    raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),
296
+    raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF", "agg_png"),
297 297
     raster_quality = 2,
298 298
     raster_device_param = list(),
299 299
     raster_resize_mat = FALSE,
Browse code

update

Zuguang Gu authored on 13/07/2020 18:14:56
Showing1 changed files
... ...
@@ -909,6 +909,16 @@ Heatmap = function(matrix, col, name,
909 909
             use_raster = FALSE
910 910
         }
911 911
     }
912
+
913
+    if(use_raster) {
914
+        if(missing(raster_by_magick)) {
915
+            if(!raster_by_magick) {
916
+                if(ht_opt$message) {
917
+                    message_wrap("'magick' package is suggested to install to give better rasterization.\n\nSet `ht_opt$message = FALSE` to turn off this message.")
918
+                }
919
+            }
920
+        }
921
+    }
912 922
     
913 923
     .Object@matrix_param$width = width
914 924
     .Object@matrix_param$height = height
Browse code

bug fixed

Zuguang Gu authored on 10/07/2020 09:02:24
Showing1 changed files
... ...
@@ -294,7 +294,7 @@ Heatmap = function(matrix, col, name,
294 294
 
295 295
     use_raster = NULL, 
296 296
     raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),
297
-    raster_quality = 1,
297
+    raster_quality = 2,
298 298
     raster_device_param = list(),
299 299
     raster_resize_mat = FALSE,
300 300
     raster_by_magick = requireNamespace("magick", quietly = TRUE),
Browse code

fixed the bug of heatmap border

Zuguang Gu authored on 08/07/2020 09:40:06
Showing1 changed files
... ...
@@ -215,7 +215,7 @@ Heatmap = function(matrix, col, name,
215 215
     color_space = "LAB",
216 216
     rect_gp = gpar(col = NA), 
217 217
     border = NA,
218
-    border_gp = gpar(fill = NA, col = "black"),
218
+    border_gp = gpar(col = "black"),
219 219
     cell_fun = NULL,
220 220
     layer_fun = NULL,
221 221
     jitter = FALSE,
... ...
@@ -524,7 +524,7 @@ Heatmap = function(matrix, col, name,
524 524
     if(missing(border)) {
525 525
         if(!is.null(ht_opt$heatmap_border)) border = ht_opt$heatmap_border
526 526
     }
527
-    if(identical(border, TRUE)) border = "black"
527
+    if(!missing(border_gp) && missing(border)) border = TRUE
528 528
     .Object@matrix_param$border = border
529 529
     .Object@matrix_param$border_gp = border_gp
530 530
     .Object@matrix_param$cell_fun = cell_fun
Browse code

fixed a bug of the legend size due to R 4.0.0

Zuguang Gu authored on 01/07/2020 21:06:46
Showing1 changed files
... ...
@@ -179,9 +179,14 @@ Heatmap = setClass("Heatmap",
179 179
 # -use_raster Whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge. If number of rows or columns is more than 2000, it is by default turned on. Note if ``cell_fun``
180 180
 #       is set, ``use_raster`` is enforced to be ``FALSE``.
181 181
 # -raster_device Graphic device which is used to generate the raster image.
182
-# -raster_quality A value set to larger than 1 will improve the quality of the raster image.
182
+# -raster_quality Ignored now.
183 183
 # -raster_device_param A list of further parameters for the selected graphic device. For raster image support, please check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#heatmap-as-raster-image .
184
-# -raster_resize Whether resize the matrix to let the dimension of the matrix the same as the dimension of the raster image?
184
+# -raster_resize_mat Whether resize the matrix to let the dimension of the matrix the same as the dimension of the raster image?
185
+#          The value can be logical. If it is ``TRUE``, `base::mean` is used to summarize the sub matrix which corresponds to a single pixel.
186
+#          The value can also be a summary function, e.g. `base::max`.
187
+# -raster_by_magick Whether to use `magick::image_resize` to scale the image.
188
+# -raster_magick_filter Pass to ``filter`` argument of `magick::image_resize`. A character scalar and all possible values
189
+#          are in `magick::filter_types`. The default is ``"Lanczos"``.
185 190
 # -post_fun A function which will be executed after the heatmap list is drawn.
186 191
 #
187 192
 # == details
... ...
@@ -289,9 +294,11 @@ Heatmap = function(matrix, col, name,
289 294
 
290 295
     use_raster = NULL, 
291 296
     raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),
292
-    raster_quality = 2,
297
+    raster_quality = 1,
293 298
     raster_device_param = list(),
294
-    raster_resize = FALSE,
299
+    raster_resize_mat = FALSE,
300
+    raster_by_magick = requireNamespace("magick", quietly = TRUE),
301
+    raster_magick_filter = NULL,
295 302
 
296 303
     post_fun = NULL) {
297 304
 
... ...
@@ -891,12 +898,12 @@ Heatmap = function(matrix, col, name,
891 898
         if(nrow(matrix) > 2000 && ncol(matrix) > 10) {
892 899
             use_raster = TRUE
893 900
             if(ht_opt$message) {
894
-                message_wrap("`use_raster` is automatically set to TRUE for a matrix with more than 2000 rows. You can control `use_raster` arugment by explicitly setting TRUE/FALSE to it. Set `ht_opt$message = FALSE` to turn off this message.")
901
+                message_wrap("`use_raster` is automatically set to TRUE for a matrix with more than 2000 rows. You can control `use_raster` argument by explicitly setting TRUE/FALSE to it.\n\nSet `ht_opt$message = FALSE` to turn off this message.")
895 902
             }
896 903
         } else if(ncol(matrix) > 2000 && nrow(matrix) > 10) {
897 904
             use_raster = TRUE
898 905
             if(ht_opt$message) {
899
-                message_wrap("`use_raster` is automatically set to TRUE for a matrix with more than 2000 columns You can control `use_raster` arugment by explicitly setting TRUE/FALSE to it. Set `ht_opt$message = FALSE` to turn off this message.")
906
+                message_wrap("`use_raster` is automatically set to TRUE for a matrix with more than 2000 columns You can control `use_raster` argument by explicitly setting TRUE/FALSE to it.\n\nSet `ht_opt$message = FALSE` to turn off this message.")
900 907
             }
901 908
         } else {
902 909
             use_raster = FALSE
... ...
@@ -913,7 +920,9 @@ Heatmap = function(matrix, col, name,
913 920
     .Object@heatmap_param$raster_device = match.arg(raster_device)[1]
914 921
     .Object@heatmap_param$raster_quality = raster_quality
915 922
     .Object@heatmap_param$raster_device_param = raster_device_param
916
-    .Object@heatmap_param$raster_resize = raster_resize
923
+    .Object@heatmap_param$raster_resize_mat = raster_resize_mat
924
+    .Object@heatmap_param$raster_by_magick = raster_by_magick
925
+    .Object@heatmap_param$raster_magick_filter = raster_magick_filter
917 926
     .Object@heatmap_param$verbose = verbose
918 927
     .Object@heatmap_param$post_fun = post_fun
919 928
     .Object@heatmap_param$calling_env = parent.frame()
Browse code

Merge branch 'master' of https://github.com/jokergoo/ComplexHeatmap

Zuguang Gu authored on 26/06/2020 11:48:43
Showing0 changed files
Browse code

fix a bug where slice dendrograms were wrongly reordered

Zuguang Gu authored on 26/06/2020 11:48:32
Showing1 changed files
... ...
@@ -88,6 +88,8 @@ Heatmap = setClass("Heatmap",
88 88
 # -color_space The color space in which colors are interpolated. Only used if ``matrix`` is numeric and 
89 89
 #            ``col`` is a vector of colors. Pass to `circlize::colorRamp2`.
90 90
 # -border Whether draw border. The value can be logical or a string of color.
91
+# -border_gp Graphic parameters for the borders. If you want to set different parameters for different heatmap slices,
92
+#           please consider to use `decorate_heatmap_body`.
91 93
 # -cell_fun Self-defined function to add graphics on each cell. Seven parameters will be passed into 
92 94
 #           this function: ``j``, ``i``, ``x``, ``y``, ``width``, ``height``, ``fill`` which are column index,
93 95
 #           row index in ``matrix``, coordinate of the cell,
... ...
@@ -174,7 +176,7 @@ Heatmap = setClass("Heatmap",
174 176
 # -heatmap_height Height of the whole heatmap (including heatmap components). Check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#size-of-the-heatmap .
175 177
 # -show_heatmap_legend Whether show heatmap legend?
176 178
 # -heatmap_legend_param A list contains parameters for the heatmap legends. See `color_mapping_legend,ColorMapping-method` for all available parameters.
177
-# -use_raster Whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge. Note if ``cell_fun``
179
+# -use_raster Whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge. If number of rows or columns is more than 2000, it is by default turned on. Note if ``cell_fun``
178 180
 #       is set, ``use_raster`` is enforced to be ``FALSE``.
179 181
 # -raster_device Graphic device which is used to generate the raster image.
180 182
 # -raster_quality A value set to larger than 1 will improve the quality of the raster image.
... ...
@@ -208,6 +210,7 @@ Heatmap = function(matrix, col, name,
208 210
     color_space = "LAB",
209 211
     rect_gp = gpar(col = NA), 
210 212
     border = NA,
213
+    border_gp = gpar(fill = NA, col = "black"),
211 214
     cell_fun = NULL,
212 215
     layer_fun = NULL,
213 216
     jitter = FALSE,
... ...
@@ -516,6 +519,7 @@ Heatmap = function(matrix, col, name,
516 519
     }
517 520
     if(identical(border, TRUE)) border = "black"
518 521
     .Object@matrix_param$border = border
522
+    .Object@matrix_param$border_gp = border_gp
519 523
     .Object@matrix_param$cell_fun = cell_fun
520 524
     .Object@matrix_param$layer_fun = layer_fun
521 525
     
... ...
@@ -1433,6 +1437,7 @@ make_cluster = function(object, which = c("row", "column")) {
1433 1437
                 slice_mean = matrix(slice_mean, nrow = 1)
1434 1438
             }
1435 1439
             dend_slice = as.dendrogram(hclust(dist(t(slice_mean))))
1440
+            dend_slice = reorder(dend_slice, slice_mean, mean)
1436 1441
             if(verbose) qqcat("perform clustering on mean of @{which} slices\n")
1437 1442
 
1438 1443
             slice_od = order.dendrogram(dend_slice)
Browse code

Typo Fixes

anntotion -> annotation in error messages :-)

Alexander Peltzer authored on 18/06/2020 10:05:45 • GitHub committed on 18/06/2020 10:05:45
Showing1 changed files
... ...
@@ -785,7 +785,7 @@ Heatmap = function(matrix, col, name,
785 785
         nb = nobs(bottom_annotation)
786 786
         if(!is.na(nb)) {
787 787
             if(nb != ncol(.Object@matrix)) {
788
-                stop_wrap("number of observations in bottom anntotion should be as same as ncol of the matrix.")
788
+                stop_wrap("number of observations in bottom annotation should be as same as ncol of the matrix.")
789 789
             }
790 790
         }
791 791
     }
... ...
@@ -805,7 +805,7 @@ Heatmap = function(matrix, col, name,
805 805
         nb = nobs(left_annotation)
806 806
         if(!is.na(nb)) {
807 807
             if(nb != nrow(.Object@matrix)) {
808
-                stop_wrap("number of observations in left anntotion should be same as nrow of the matrix.")
808
+                stop_wrap("number of observations in left annotation should be same as nrow of the matrix.")
809 809
             }
810 810
         }
811 811
     }
... ...
@@ -825,7 +825,7 @@ Heatmap = function(matrix, col, name,
825 825
         nb = nobs(right_annotation)
826 826
         if(!is.na(nb)) {
827 827
             if(nb != nrow(.Object@matrix)) {
828
-                stop_wrap("number of observations in right anntotion should be same as nrow of the matrix.")
828
+                stop_wrap("number of observations in right annotation should be same as nrow of the matrix.")
829 829
             }
830 830
         }
831 831
     }
Browse code

export heatmaps as a shiny app

Zuguang Gu authored on 17/05/2020 13:20:00
Showing1 changed files
... ...
@@ -531,6 +531,9 @@ Heatmap = function(matrix, col, name,
531 531
         if(is.function(col)) {
532 532
             .Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col)
533 533
             if(verbose) qqcat("input color is a color mapping function\n")
534
+        } else if(inherits(col, "ColorMapping")){
535
+            .Object@matrix_color_mapping = col
536
+            if(verbose) qqcat("input color is a ColorMapping object\n")
534 537
         } else {
535 538
             if(is.null(names(col))) {
536 539
                 if(length(col) == length(unique(as.vector(matrix)))) {
Browse code

translate pheatmap to Heatmap

Zuguang Gu authored on 06/05/2020 07:21:34
Showing1 changed files
... ...
@@ -301,6 +301,9 @@ Heatmap = function(matrix, col, name,
301 301
     if(missing(name)) {
302 302
         name = paste0("matrix_", get_heatmap_index() + 1)
303 303
         increase_heatmap_index()
304
+    } else if(is.null(name)) {
305
+        name = paste0("matrix_", get_heatmap_index() + 1)
306
+        increase_heatmap_index()
304 307
     }
305 308
     if(name == "") {
306 309
         stop_wrap("Heatmap name cannot be empty string.")
Browse code

remove browser()

Zuguang Gu authored on 28/04/2020 21:31:35
Showing1 changed files
... ...
@@ -1112,7 +1112,6 @@ make_cluster = function(object, which = c("row", "column")) {
1112 1112
             }
1113 1113
             if(identical(reorder, TRUE)) {
1114 1114
                 do_reorder = TRUE
1115
-                browser()
1116 1115
                 if(which == "row") {
1117 1116
                     reorder = -rowMeans(mat, na.rm = TRUE)
1118 1117
                 } else {
Browse code

increase version number

Zuguang Gu authored on 24/04/2020 16:54:43
Showing1 changed files
... ...
@@ -1112,6 +1112,7 @@ make_cluster = function(object, which = c("row", "column")) {
1112 1112
             }
1113 1113
             if(identical(reorder, TRUE)) {
1114 1114
                 do_reorder = TRUE
1115
+                browser()
1115 1116
                 if(which == "row") {
1116 1117
                     reorder = -rowMeans(mat, na.rm = TRUE)
1117 1118
                 } else {
Browse code

update

Zuguang Gu authored on 22/03/2020 13:30:22
Showing1 changed files
... ...
@@ -888,6 +888,8 @@ Heatmap = function(matrix, col, name,
888 888
             if(ht_opt$message) {
889 889
                 message_wrap("`use_raster` is automatically set to TRUE for a matrix with more than 2000 columns You can control `use_raster` arugment by explicitly setting TRUE/FALSE to it. Set `ht_opt$message = FALSE` to turn off this message.")
890 890
             }
891
+        } else {
892
+            use_raster = FALSE
891 893
         }
892 894
     }
893 895
     
Browse code

print important messages

Zuguang Gu authored on 22/03/2020 11:26:41
Showing1 changed files
... ...
@@ -284,7 +284,7 @@ Heatmap = function(matrix, col, name,
284 284
     show_heatmap_legend = TRUE,
285 285
     heatmap_legend_param = list(title = name),
286 286
 
287
-    use_raster = (nrow(matrix) > 2000 && ncol(matrix) > 10) || (ncol(matrix) > 2000 && nrow(matrix) > 10), 
287
+    use_raster = NULL, 
288 288
     raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),
289 289
     raster_quality = 2,
290 290
     raster_device_param = list(),
... ...
@@ -876,6 +876,20 @@ Heatmap = function(matrix, col, name,
876 876
             stop_wrap("`heatmap_height` and `height` should not all be the absolute units.")
877 877
         }
878 878
     }
879
+
880
+    if(is.null(use_raster)) {
881
+        if(nrow(matrix) > 2000 && ncol(matrix) > 10) {
882
+            use_raster = TRUE
883
+            if(ht_opt$message) {
884
+                message_wrap("`use_raster` is automatically set to TRUE for a matrix with more than 2000 rows. You can control `use_raster` arugment by explicitly setting TRUE/FALSE to it. Set `ht_opt$message = FALSE` to turn off this message.")
885
+            }
886
+        } else if(ncol(matrix) > 2000 && nrow(matrix) > 10) {
887
+            use_raster = TRUE
888
+            if(ht_opt$message) {
889
+                message_wrap("`use_raster` is automatically set to TRUE for a matrix with more than 2000 columns You can control `use_raster` arugment by explicitly setting TRUE/FALSE to it. Set `ht_opt$message = FALSE` to turn off this message.")
890
+            }
891
+        }
892
+    }
879 893
     
880 894
     .Object@matrix_param$width = width
881 895
     .Object@matrix_param$height = height
Browse code

row titles are in the correct order if they are set as 'template'

Zuguang Gu authored on 20/03/2020 20:52:46
Showing1 changed files
... ...
@@ -1462,7 +1462,7 @@ make_cluster = function(object, which = c("row", "column")) {
1462 1462
         stop_wrap(qq("Length of `gap` should be 1 or number of @{which} slices."))
1463 1463
     }
1464 1464
     object@matrix_param[[ paste0(which, "_gap") ]] = gap
1465
-    
1465
+
1466 1466
     # adjust title
1467 1467
     title = slot(object, paste0(which, "_title"))
1468 1468
     if(!is.null(split)) {
... ...
@@ -1474,9 +1474,9 @@ make_cluster = function(object, which = c("row", "column")) {
1474 1474
                     lt = lapply(x, function(x) x)
1475 1475
                     lt$fmt = title
1476 1476
                     do.call(sprintf, lt)
1477
-                })
1477
+                })[slice_od]
1478 1478
             } else if(grepl("@\\{.+\\}", title)) {
1479
-                title = apply(unique(split), 1, function(x) {
1479
+                title = apply(unique(split[order2, , drop = FALSE]), 1, function(x) {
1480 1480
                     x = x
1481 1481
                     envir = environment()
1482 1482
                     title = get("title")
... ...
@@ -1486,12 +1486,12 @@ make_cluster = function(object, which = c("row", "column")) {
1486 1486
                     title = GetoptLong::qq(title, envir = envir)
1487 1487
                     parent.env(envir) = op
1488 1488
                     return(title)
1489
-                })
1489
+                })[slice_od]
1490 1490
             } else if(grepl("\\{.+\\}", title)) {
1491 1491
                 if(!requireNamespace("glue")) {
1492 1492
                     stop_wrap("You need to install glue package.")
1493 1493
                 }
1494
-                title = apply(unique(split), 1, function(x) {
1494
+                title = apply(unique(split[order2, , drop = FALSE]), 1, function(x) {
1495 1495
                     x = x
1496 1496
                     envir = environment()
1497 1497
                     title = get("title")
... ...
@@ -1501,7 +1501,7 @@ make_cluster = function(object, which = c("row", "column")) {
1501 1501
                     title = glue::glue(title, envir = calling_env)
1502 1502
                     parent.env(envir) = op
1503 1503
                     return(title)
1504
-                })
1504
+                })[slice_od]
1505 1505
             }
1506 1506
         }
1507 1507
     }
Browse code

set cluster_row_slice and cluster_column_slice for character matrix

Zuguang Gu authored on 19/03/2020 21:00:22
Showing1 changed files
... ...
@@ -429,6 +429,12 @@ Heatmap = function(matrix, col, name,
429 429
         row_dend_reorder = FALSE
430 430
         cluster_row_slices = FALSE
431 431
 
432
+        if(inherits(cluster_rows, c("dendrogram", "hclust")) && length(row_split) == 1) {
433
+            if(!"cluster_row_slices" %in% called_args) {
434
+                cluster_row_slices = TRUE
435
+            }
436
+        }
437
+
432 438
         if("clustering_distance_columns" %in% called_args) {
433 439
         } else if(inherits(cluster_columns, c("dendrogram", "hclust"))) {
434 440
         } else {
... ...
@@ -437,6 +443,13 @@ Heatmap = function(matrix, col, name,
437 443
         }
438 444
         column_dend_reorder = FALSE
439 445
         cluster_column_slices = FALSE
446
+
447
+        if(inherits(cluster_columns, c("dendrogram", "hclust")) && length(column_split) == 1) {
448
+            if(!"cluster_column_slices" %in% called_args) {
449
+                cluster_column_slices = TRUE
450
+            }
451
+        }
452
+
440 453
         row_km = 1
441 454
         column_km = 1
442 455
         if(verbose) qqcat("matrix is character. Do not cluster unless distance method is provided.\n")
Browse code

add use_raster in draw()

jokergoo authored on 29/01/2020 13:14:26
Showing1 changed files
... ...
@@ -284,7 +284,7 @@ Heatmap = function(matrix, col, name,
284 284
     show_heatmap_legend = TRUE,
285 285
     heatmap_legend_param = list(title = name),
286 286
 
287
-    use_raster = (nrow(matrix) > 2000 && ncol(matrix) > 1) || (ncol(matrix) > 2000 && nrow(matrix) > 1), 
287
+    use_raster = (nrow(matrix) > 2000 && ncol(matrix) > 10) || (ncol(matrix) > 2000 && nrow(matrix) > 10), 
288 288
     raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),
289 289
     raster_quality = 2,
290 290
     raster_device_param = list(),
Browse code

draw row names if row_labels is set

Zuguang Gu authored on 27/01/2020 13:18:49
Showing1 changed files
... ...
@@ -567,7 +567,9 @@ Heatmap = function(matrix, col, name,
567 567
 
568 568
     ### row labels/column labels ###
569 569
     if(is.null(rownames(matrix))) {
570
-        show_row_names = FALSE
570
+        if(is.null(row_labels)) {
571
+            show_row_names = FALSE
572
+        }
571 573
     }
572 574
     .Object@row_names_param$labels = row_labels
573 575
     .Object@row_names_param$side = match.arg(row_names_side)[1]
... ...
@@ -594,7 +596,9 @@ Heatmap = function(matrix, col, name,
594 596
     }
595 597
 
596 598
     if(is.null(colnames(matrix))) {
597
-        show_column_names = FALSE
599
+        if(is.null(column_labels)) {
600
+            show_column_names = FALSE
601
+        }
598 602
     }
599 603
     .Object@column_names_param$labels = column_labels
600 604
     .Object@column_names_param$side = match.arg(column_names_side)[1]
Browse code

adjust the order of legend labels

Zuguang Gu authored on 20/10/2019 09:37:25
Showing1 changed files
... ...
@@ -350,8 +350,12 @@ Heatmap = function(matrix, col, name,
350 350
         warning_wrap("The input is a data frame, convert it to the matrix.")
351 351
         matrix = as.matrix(matrix)
352 352
     }
353
+    fa_level = NULL
353 354
     if(!is.matrix(matrix)) {
354 355
         if(is.atomic(matrix)) {
356
+            if(is.factor(matrix)) {
357
+                fa_level = levels(matrix)
358
+            }
355 359
             rn = names(matrix)
356 360
             matrix = matrix(matrix, ncol = 1)
357 361
             if(!is.null(rn)) rownames(matrix) = rn
... ...
@@ -503,6 +507,9 @@ Heatmap = function(matrix, col, name,
503 507
     if(ncol(matrix) > 0 && nrow(matrix) > 0) {
504 508
         if(missing(col)) {
505 509
             col = default_col(matrix, main_matrix = TRUE)
510
+            if(!is.null(fa_level)) {
511
+                col = col[fa_level]
512
+            }
506 513
             if(verbose) qqcat("color is not specified, use randomly generated colors\n")
507 514
         }
508 515
         if(is.function(col)) {
... ...
@@ -511,7 +518,11 @@ Heatmap = function(matrix, col, name,
511 518
         } else {
512 519
             if(is.null(names(col))) {
513 520
                 if(length(col) == length(unique(as.vector(matrix)))) {
514
-                    names(col) = sort(unique(as.vector(matrix)))
521
+                    if(is.null(fa_level)) {
522
+                        names(col) = sort(unique(as.vector(matrix)))
523
+                    } else {
524
+                        names(col) = fa_level
525
+                    }
515 526
                     .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col)
516 527
                     if(verbose) qqcat("input color is a vector with no names, treat it as discrete color mapping\n")
517 528
                 } else if(is.numeric(matrix)) {
... ...
@@ -523,7 +534,11 @@ Heatmap = function(matrix, col, name,
523 534
                     stop_wrap("`col` should have names to map to values in `mat`.")
524 535
                 }
525 536
             } else {
526
-                col = col[intersect(c(names(col), "_NA_"), as.character(matrix))]
537
+                if(is.null(fa_level)) {
538
+                    col = col[intersect(c(names(col), "_NA_"), as.character(matrix))]
539
+                } else {
540
+                    col = col[intersect(c(fa_level, "_NA_"), names(col))]
541
+                }
527 542
                 .Object@matrix_color_mapping = ColorMapping(colors = col, name = name, na_col = na_col)
528 543
                 if(verbose) qqcat("input color is a named vector\n")
529 544
             }
Browse code

heatmap name cannot be empty string

Zuguang Gu authored on 12/10/2019 09:50:31
Showing1 changed files
... ...
@@ -302,6 +302,9 @@ Heatmap = function(matrix, col, name,
302 302
         name = paste0("matrix_", get_heatmap_index() + 1)
303 303
         increase_heatmap_index()
304 304
     }
305
+    if(name == "") {
306
+        stop_wrap("Heatmap name cannot be empty string.")
307
+    }
305 308
     .Object@name = name
306 309
 
307 310
     # re-define some of the argument values according to global settings
Browse code

add jitter argument to Heatmap()

Zuguang Gu authored on 28/09/2019 08:37:13
Showing1 changed files
... ...
@@ -93,6 +93,10 @@ Heatmap = setClass("Heatmap",
93 93
 #           row index in ``matrix``, coordinate of the cell,
94 94
 #           the width and height of the cell and the filled color. ``x``, ``y``, ``width`` and ``height`` are all `grid::unit` objects.
95 95
 # -layer_fun Similar as ``cell_fun``, but is vectorized. Check https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#customize-the-heatmap-body .
96
+# -jitter Random shifts added to the matrix. The value can be logical or a single numeric value. It it is ``TRUE``, random 
97
+#      values from uniform distribution between 0 and 1e-10 are generated. If it is a numeric value,
98
+#      the range for the uniform distribution is (0, ``jitter``). It is mainly to solve the problem of "Error: node stack overflow"
99
+#      when there are too many identical rows/columns for plotting the dendrograms.
96 100
 # -row_title Title on the row.
97 101
 # -row_title_side Will the title be put on the left or right of the heatmap?
98 102
 # -row_title_gp Graphic parameters for row title.
... ...
@@ -206,6 +210,7 @@ Heatmap = function(matrix, col, name,
206 210
     border = NA,
207 211
     cell_fun = NULL,
208 212
     layer_fun = NULL,
213
+    jitter = FALSE,
209 214
 
210 215
     row_title = character(0), 
211 216
     row_title_side = c("left", "right"), 
... ...
@@ -437,6 +442,7 @@ Heatmap = function(matrix, col, name,
437 442
     .Object@matrix_param$column_km = column_km
438 443
     .Object@matrix_param$column_km_repeats = column_km_repeats
439 444
     .Object@matrix_param$column_gap = column_gap
445
+    .Object@matrix_param$jitter = jitter
440 446
 
441 447
     ### check row_split and column_split ###
442 448
     if(!is.null(row_split)) {
... ...
@@ -943,6 +949,17 @@ make_cluster = function(object, which = c("row", "column")) {
943 949
     }
944 950
 
945 951
     mat = object@matrix
952
+    jitter = object@matrix_param$jitter
953
+    if(is.numeric(mat)) {
954
+        if(is.logical(jitter)) {
955
+            if(jitter) {
956
+                mat = mat + runif(length(mat), min = 0, max = 1e-10)
957
+            }
958
+        } else {
959
+            mat = mat + runif(length(mat), min = 0, max = jitter + 0)
960
+        }
961
+    }
962
+
946 963
     distance = slot(object, paste0(which, "_dend_param"))$distance
947 964
     method = slot(object, paste0(which, "_dend_param"))$method
948 965
     order = slot(object, paste0(which, "_order"))  # pre-defined row order
Browse code

add cluster_row_slices and cluster_column_slices to draw()

Zuguang Gu authored on 02/09/2019 09:19:16
Showing1 changed files
... ...
@@ -832,7 +832,7 @@ Heatmap = function(matrix, col, name,
832 832
     }
833 833
     if(!is.null(height) && !is.null(heatmap_height)) {
834 834
         if(is_abs_unit(height) && is_abs_unit(heatmap_height)) {
835
-            stop_wrap("`heatmap_height` and `width` should not all be the absolute units.")
835
+            stop_wrap("`heatmap_height` and `height` should not all be the absolute units.")
836 836
         }
837 837
     }
838 838
     
Browse code

check consistency of clustering objects and matrix

Zuguang Gu authored on 08/06/2019 05:49:40
Showing1 changed files
... ...
@@ -964,6 +964,24 @@ make_cluster = function(object, which = c("row", "column")) {
964 964
 
965 965
     dend_param$split_by_cutree = FALSE
966 966
 
967
+    if(!is.null(dend_param$obj)) {
968
+        if(inherits(dend_param$obj, "hclust")) {
969
+            ncl = length(dend_param$obj$order)
970
+        } else {
971
+            ncl = nobs(dend_param$obj)
972
+        }
973
+
974
+        if(which == "row") {
975
+            if(ncl != nrow(mat)) {
976
+                stop_wrap("The length of the row clustering object is not the same as the number of matrix rows.")
977
+            }
978
+        } else {
979
+            if(ncl != ncol(mat)) {
980
+                stop_wrap("The length of the column clustering object is not the same as the number of matrix columns")
981
+            }
982
+        }
983
+    }
984
+
967 985
     if(cluster) {
968 986
 
969 987
         if(is.numeric(split) && length(split) == 1) {
Browse code

update

Zuguang Gu authored on 29/04/2019 07:51:08
Showing1 changed files
... ...
@@ -358,14 +358,15 @@ Heatmap = function(matrix, col, name,
358 358
     #     show_heatmap_legend = FALSE
359 359
     #     .Object@heatmap_param$show_heatmap_legend = FALSE
360 360
     # }
361
-    if(ncol(matrix) == 0 && (!is.null(left_annotation) || !is.null(right_annotation))) {
362
-        message_wrap("If you have row annotations for a zeor-column matrix, please directly use in form of `rowAnnotation(...) + NULL`")
363
-        return(invisible(NULL))
364
-    }
365
-    if(nrow(matrix) == 0 && (!is.null(top_annotation) || !is.null(bottom_annotation))) {
366
-        message_wrap("If you have column annotations for a zero-row matrix, please directly use in form of `HeatmapAnnotation(...) %v% NULL`")
367
-        return(invisible(NULL))
368
-    }
361
+    
362
+    # if(ncol(matrix) == 0 && (!is.null(left_annotation) || !is.null(right_annotation))) {
363
+    #     message_wrap("If you have row annotations for a zeor-column matrix, please directly use in form of `rowAnnotation(...) + NULL`")
364
+    #     return(invisible(NULL))
365
+    # }
366
+    # if(nrow(matrix) == 0 && (!is.null(top_annotation) || !is.null(bottom_annotation))) {
367
+    #     message_wrap("If you have column annotations for a zero-row matrix, please directly use in form of `HeatmapAnnotation(...) %v% NULL`")
368
+    #     return(invisible(NULL))
369
+    # }
369 370
 
370 371
     ### normalize km/split and row_km/row_split
371 372
     if(missing(row_km)) row_km = km
... ...
@@ -803,7 +804,7 @@ Heatmap = function(matrix, col, name,
803 804
             row_anno_right_width = unit(0, "mm")
804 805
         ),
805 806
 
806
-        layout_index = NULL,
807
+        layout_index = matrix(nrow = 0, ncol = 2),
807 808
         graphic_fun_list = list(),
808 809
         initialized = FALSE
809 810
     )
... ...
@@ -1488,7 +1489,8 @@ setMethod(f = "draw",
1488 1489
         upViewport()
1489 1490
     } else {
1490 1491
         if(internal) {  # a heatmap without legend
1491
-            if(ncol(object@matrix) == 0 || nrow(object@matrix) == 0) return(invisible(NULL))
1492
+            # if(ncol(object@matrix) == 0 || nrow(object@matrix) == 0) return(invisible(NULL))
1493
+            if(nrow(object@layout$layout_index) == 0) return(invisible(NULL))
1492 1494
             layout = grid.layout(nrow = length(HEATMAP_LAYOUT_COLUMN_COMPONENT), 
1493 1495
                 ncol = length(HEATMAP_LAYOUT_ROW_COMPONENT), widths = component_width(object), 
1494 1496
                 heights = component_height(object))
... ...
@@ -1507,9 +1509,9 @@ setMethod(f = "draw",
1507 1509
             }
1508 1510
             upViewport()
1509 1511
         } else {
1510
-            if(ncol(object@matrix) == 0) {
1511
-                stop_wrap("Single heatmap should contains a matrix with at least one column. Zero-column matrix can only be appended to the heatmap list.")
1512
-            }
1512
+            # if(ncol(object@matrix) == 0) {
1513
+            #     stop_wrap("Single heatmap should contains a matrix with at least one column. Zero-column matrix can only be appended to the heatmap list.")
1514
+            # }
1513 1515
             ht_list = new("HeatmapList")
1514 1516
             ht_list = add_heatmap(ht_list, object)
1515 1517
             draw(ht_list, ...)
Browse code

legend comes back if heatmap body is customized

Zuguang Gu authored on 09/04/2019 07:00:22
Showing1 changed files
... ...
@@ -366,9 +366,6 @@ Heatmap = function(matrix, col, name,
366 366
         message_wrap("If you have column annotations for a zero-row matrix, please directly use in form of `HeatmapAnnotation(...) %v% NULL`")
367 367
         return(invisible(NULL))
368 368
     }
369
-    if(identical(rect_gp$type, "none")) {
370
-        show_heatmap_legend = FALSE
371
-    }
372 369
 
373 370
     ### normalize km/split and row_km/row_split
374 371
     if(missing(row_km)) row_km = km
Browse code

version bump

Zuguang Gu authored on 26/03/2019 14:25:36
Showing1 changed files
... ...
@@ -354,9 +354,17 @@ Heatmap = function(matrix, col, name,
354 354
         }
355 355
     }
356 356
 
357
-    if(ncol(matrix) == 0) {
358
-        show_heatmap_legend = FALSE
359
-        .Object@heatmap_param$show_heatmap_legend = FALSE
357
+    # if(ncol(matrix) == 0 || nrow(matrix) == 0) {
358
+    #     show_heatmap_legend = FALSE
359
+    #     .Object@heatmap_param$show_heatmap_legend = FALSE
360
+    # }
361
+    if(ncol(matrix) == 0 && (!is.null(left_annotation) || !is.null(right_annotation))) {
362
+        message_wrap("If you have row annotations for a zeor-column matrix, please directly use in form of `rowAnnotation(...) + NULL`")
363
+        return(invisible(NULL))
364
+    }
365
+    if(nrow(matrix) == 0 && (!is.null(top_annotation) || !is.null(bottom_annotation))) {
366
+        message_wrap("If you have column annotations for a zero-row matrix, please directly use in form of `HeatmapAnnotation(...) %v% NULL`")
367
+        return(invisible(NULL))
360 368
     }
361 369
     if(identical(rect_gp$type, "none")) {
362 370
         show_heatmap_legend = FALSE
... ...
@@ -1430,6 +1438,10 @@ make_cluster = function(object, which = c("row", "column")) {
1430 1438
         }
1431 1439
     }
1432 1440
     slot(object, paste0(which, "_title")) = title
1441
+    # check whether height of the dendrogram is zero
1442
+    if(all(sapply(dend_list, dend_heights) == 0)) {
1443
+        slot(object, paste0(which, "_dend_param"))$show = FALSE
1444
+    }
1433 1445
     return(object)
1434 1446
 
1435 1447
 }
Browse code

gp in anno_text() supports fill and border

Zuguang Gu authored on 24/03/2019 22:20:59
Showing1 changed files
... ...
@@ -137,12 +137,14 @@ Heatmap = setClass("Heatmap",
137 137
 # -row_names_max_width Maximum width of row names viewport.
138 138
 # -row_names_gp Graphic parameters for row names.
139 139
 # -row_names_rot Rotation of row names.
140
+# -row_names_centered Should row names put centered?
140 141
 # -column_labels Optional column labels which are put as column names in the heatmap.
141 142
 # -column_names_side Should the column names be put on the top or bottom of the heatmap?
142 143
 # -column_names_max_height Maximum height of column names viewport.
143 144
 # -show_column_names Whether show column names.
144 145
 # -column_names_gp Graphic parameters for drawing text.
145 146
 # -column_names_rot Rotation of column names.
147
+# -column_names_centered Should column names put centered?
146 148
 # -top_annotation A `HeatmapAnnotation` object.
147 149
 # -bottom_annotation A `HeatmapAnnotation` object.
148 150
 # -left_annotation It should be specified by `rowAnnotation`.
... ...
@@ -242,12 +244,14 @@ Heatmap = function(matrix, col, name,
242 244
     row_names_max_width = unit(6, "cm"), 
243 245
     row_names_gp = gpar(fontsize = 12), 
244 246
     row_names_rot = 0,
247
+    row_names_centered = FALSE,
245 248
     column_labels = colnames(matrix),
246 249
     column_names_side = c("bottom", "top"), 
247 250
     show_column_names = TRUE, 
248 251
     column_names_max_height = unit(6, "cm"), 
249 252
     column_names_gp = gpar(fontsize = 12),
250 253
     column_names_rot = 90,
254
+    column_names_centered = FALSE,
251 255
 
252 256
     top_annotation = NULL,
253 257
     bottom_annotation = NULL,
... ...
@@ -257,10 +261,10 @@ Heatmap = function(matrix, col, name,
257 261
     km = 1, 
258 262
     split = NULL, 
259 263
     row_km = km,
260
-    row_km_repeats = 10,
264
+    row_km_repeats = 1,
261 265
     row_split = split,
262 266
     column_km = 1,
263
-    column_km_repeats = 10,
267
+    column_km_repeats = 1,
264 268
     column_split = NULL,
265 269
     gap = unit(1, "mm"),
266 270
     row_gap = unit(1, "mm"),
... ...
@@ -540,15 +544,22 @@ Heatmap = function(matrix, col, name,
540 544
     .Object@row_names_param$show = show_row_names
541 545
     .Object@row_names_param$gp = check_gp(row_names_gp)
542 546
     .Object@row_names_param$rot = row_names_rot
547
+    .Object@row_names_param$centered = row_names_centered
543 548
     .Object@row_names_param$max_width = row_names_max_width + unit(2, "mm")
544 549
     # we use anno_text to draw row/column names because it already takes care of text rotation
545 550
     if(show_row_names) {
546 551
         if(length(row_labels) != nrow(matrix)) {
547 552
             stop_wrap("Length of `row_labels` should be the same as the nrow of matrix.")
548 553
         }
549
-        row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
550
-            location = ifelse(.Object@row_names_param$side == "left", 1, 0), 
551
-            just = ifelse(.Object@row_names_param$side == "left", "right", "left"))
554
+        if(row_names_centered) {
555
+            row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
556
+                location = 0.5, 
557
+                just = "center")
558
+        } else {
559
+            row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
560
+                location = ifelse(.Object@row_names_param$side == "left", 1, 0), 
561
+                just = ifelse(.Object@row_names_param$side == "left", "right", "left"))
562
+        }
552 563
         .Object@row_names_param$anno = row_names_anno
553 564
     }
554 565
 
... ...
@@ -560,17 +571,24 @@ Heatmap = function(matrix, col, name,
560 571
     .Object@column_names_param$show = show_column_names
561 572
     .Object@column_names_param$gp = check_gp(column_names_gp)
562 573
     .Object@column_names_param$rot = column_names_rot
574
+    .Object@column_names_param$centered = column_names_centered
563 575
     .Object@column_names_param$max_height = column_names_max_height + unit(2, "mm")
564 576
     if(show_column_names) {
565 577
         if(length(column_labels) != ncol(matrix)) {
566 578
             stop_wrap("Length of `column_labels` should be the same as the ncol of matrix.")
567 579
         }
568
-        column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
569
-            location = ifelse(.Object@column_names_param$side == "top", 0, 1), 
570
-            just = ifelse(.Object@column_names_param$side == "top", 
571
-                     ifelse(.Object@column_names_param$rot >= 0, "left", "right"),
572
-                     ifelse(.Object@column_names_param$rot >= 0, "right", "left")
573
-                    ))
580
+        if(column_names_centered) {
581
+            column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
582
+            location = 0.5, 
583
+            just = "center")
584
+        } else {
585
+            column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
586
+                location = ifelse(.Object@column_names_param$side == "top", 0, 1), 
587
+                just = ifelse(.Object@column_names_param$side == "top", 
588
+                         ifelse(.Object@column_names_param$rot >= 0, "left", "right"),
589
+                         ifelse(.Object@column_names_param$rot >= 0, "right", "left")
590
+                        ))
591
+        }
574 592
         .Object@column_names_param$anno = column_names_anno
575 593
     }
576 594
 
... ...
@@ -1146,7 +1164,6 @@ make_cluster = function(object, which = c("row", "column")) {
1146 1164
         }
1147 1165
 
1148 1166
         meanmat = do.call("cbind", meanmat)
1149
-        hc = hclust(dist(t(meanmat)))
1150 1167
         # if `reorder` is a vector, the slice dendrogram is reordered by the mean of reorder in each slice
1151 1168
         # or else, weighted by the mean of `meanmat`.
1152 1169
         if(length(reorder) > 1) {
... ...
@@ -1154,7 +1171,12 @@ make_cluster = function(object, which = c("row", "column")) {
1154 1171
         } else {
1155 1172
             weight = colMeans(meanmat)
1156 1173
         }
1157
-        hc = as.hclust(reorder(as.dendrogram(hc), weight, mean))
1174
+        if(cluster_slices) {
1175
+            hc = hclust(dist(t(meanmat)))
1176
+            hc = as.hclust(reorder(as.dendrogram(hc), weight, mean))
1177
+        } else {
1178
+            hc = list(order = order(weight))
1179
+        }
1158 1180
 
1159 1181
         cl2 = numeric(length(cl))
1160 1182
         for(i in seq_along(hc$order)) {
Browse code

show_heatmap_legend is set to FALSE if rect_gp = gpar(type = 'none')

Zuguang Gu authored on 23/03/2019 16:18:16
Showing1 changed files
... ...
@@ -351,8 +351,12 @@ Heatmap = function(matrix, col, name,
351 351
     }
352 352
 
353 353
     if(ncol(matrix) == 0) {
354
+        show_heatmap_legend = FALSE
354 355
         .Object@heatmap_param$show_heatmap_legend = FALSE
355 356
     }
357
+    if(identical(rect_gp$type, "none")) {
358
+        show_heatmap_legend = FALSE
359
+    }
356 360
 
357 361
     ### normalize km/split and row_km/row_split
358 362
     if(missing(row_km)) row_km = km
Browse code

add consensus k-means

jokergoo authored on 22/03/2019 15:02:46
Showing1 changed files
... ...
@@ -152,10 +152,11 @@ Heatmap = setClass("Heatmap",
152 152
 # -split A vector or a data frame by which the rows are split. But if ``cluster_rows`` is a clustering object, ``split`` can be a single number
153 153
 #        indicating to split the dendrogram by `stats::cutree`.
154 154
 # -row_km Same as ``km``.
155
-# -row_km_repeats Number of k-means runs to get a consensus k-means clustering.
155
+# -row_km_repeats Number of k-means runs to get a consensus k-means clustering. Note if ``row_km_repeats`` is set to more than one, the final number
156
+#                of groups might be smaller than ``row_km``, but this might means the original ``row_km`` is not a good choice.
156 157
 # -row_split Same as ``split``.
157 158
 # -column_km K-means clustering on columns.
158
-# -column_km_repeats Number of k-means runs to get a consensus k-means clustering.
159
+# -column_km_repeats Number of k-means runs to get a consensus k-means clustering. Similar as ``row_km_repeats``.
159 160
 # -column_split Split on columns. For heatmap splitting, please refer to https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#heatmap-split .
160 161
 # -gap Gap between row slices if the heatmap is split by rows. The value should be a `grid::unit` object.
161 162
 # -row_gap Same as ``gap``.
Browse code

run multiple times k-means to get a consensus partition

jokergoo authored on 22/03/2019 10:40:01
Showing1 changed files
... ...
@@ -152,8 +152,10 @@ Heatmap = setClass("Heatmap",
152 152
 # -split A vector or a data frame by which the rows are split. But if ``cluster_rows`` is a clustering object, ``split`` can be a single number
153 153
 #        indicating to split the dendrogram by `stats::cutree`.
154 154
 # -row_km Same as ``km``.
155
+# -row_km_repeats Number of k-means runs to get a consensus k-means clustering.
155 156
 # -row_split Same as ``split``.
156 157
 # -column_km K-means clustering on columns.
158
+# -column_km_repeats Number of k-means runs to get a consensus k-means clustering.
157 159
 # -column_split Split on columns. For heatmap splitting, please refer to https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#heatmap-split .
158 160
 # -gap Gap between row slices if the heatmap is split by rows. The value should be a `grid::unit` object.
159 161
 # -row_gap Same as ``gap``.
... ...
@@ -254,8 +256,10 @@ Heatmap = function(matrix, col, name,
254 256
     km = 1, 
255 257
     split = NULL, 
256 258
     row_km = km,
259
+    row_km_repeats = 10,
257 260
     row_split = split,
258 261
     column_km = 1,
262
+    column_km_repeats = 10,
259 263
     column_split = NULL,
260 264
     gap = unit(1, "mm"),
261 265
     row_gap = unit(1, "mm"),
... ...
@@ -413,8 +417,10 @@ Heatmap = function(matrix, col, name,
413 417
     .Object@matrix = matrix
414 418
 
415 419
     .Object@matrix_param$row_km = row_km
420
+    .Object@matrix_param$row_km_repeats = row_km_repeats
416 421
     .Object@matrix_param$row_gap = row_gap
417 422
     .Object@matrix_param$column_km = column_km
423
+    .Object@matrix_param$column_km_repeats = column_km_repeats
418 424
     .Object@matrix_param$column_gap = column_gap
419 425
 
420 426
     ### check row_split and column_split ###
... ...
@@ -912,6 +918,7 @@ make_cluster = function(object, which = c("row", "column")) {
912 918
     method = slot(object, paste0(which, "_dend_param"))$method
913 919
     order = slot(object, paste0(which, "_order"))  # pre-defined row order
914 920
     km = getElement(object@matrix_param, paste0(which, "_km"))
921
+    km_repeats = getElement(object@matrix_param, paste0(which, "_km_repeats"))
915 922
     split = getElement(object@matrix_param, paste0(which, "_split"))
916 923
     reorder = slot(object, paste0(which, "_dend_param"))$reorder
917 924
     cluster = slot(object, paste0(which, "_dend_param"))$cluster
... ...
@@ -1108,16 +1115,26 @@ make_cluster = function(object, which = c("row", "column")) {
1108 1115
 
1109 1116
     if(verbose) qq("clustering object is not pre-defined, clustering is applied to each @{which} slice\n")
1110 1117
     # make k-means clustering to add a split column
1118
+    consensus_kmeans = function(mat, centers, km_repeats) {
1119
+        partition_list = lapply(seq_len(km_repeats), function(i) {
1120
+            as.cl_hard_partition(kmeans(mat, centers))
1121
+        })
1122
+        partition_list = cl_ensemble(list = partition_list)
1123
+        partition_consensus = cl_consensus(partition_list)