Browse code

update

jokergoo authored on 10/10/2018 14:22:23
Showing5 changed files

... ...
@@ -2655,8 +2655,9 @@ row_anno_link = function(...) {
2655 2655
 
2656 2656
 # only allow for one-column/one-row heamtap
2657 2657
 # discrete: barplot; continuous: boxplot (maybe also barplot, e.g. pct overlap)
2658
-anno_summary = function(which = c("column", "row"), bar_width = 0.8,
2659
-	width = NULL, height = NULL, border = FALSE, ...) {
2658
+anno_summary = function(which = c("column", "row"), border = TRUE, bar_width = 0.8, 
2659
+	axis = TRUE, axis_param = default_axis_param(which), 
2660
+	width = NULL, height = NULL, ...) {
2660 2661
 
2661 2662
 	if(is.null(.ENV$current_annotation_which)) {
2662 2663
 		which = match.arg(which)[1]
... ...
@@ -2666,11 +2667,32 @@ anno_summary = function(which = c("column", "row"), bar_width = 0.8,
2666 2667
 
2667 2668
 	anno_size = anno_width_and_height(which, width, height, unit(2, "cm"))
2668 2669
 
2669
-	# get variables fron oncoPrint() function
2670
-	pf = parent.frame()
2671
-	# find where the heatmap object is.
2670
+	axis_param = validate_axis_param(axis_param, which)
2671
+	axis_grob = if(axis) construct_axis_grob(axis_param, which, c(0, 1)) else NULL
2672
+
2672 2673
 	row_fun = function(index) {
2674
+		ht = get("object", envir = parent.frame(7))
2675
+		mat = ht@matrix
2676
+		cm = ht@matrix_color_mapping
2677
+		order_list = ht@column_order_list
2678
+		ng = length(order_list)
2673 2679
 
2680
+		if(cm@type == "discrete") {
2681
+			tl = lapply(order_list, function(od) table(mat[1, od]))
2682
+			tl = lapply(tl, function(x) x/sum(x))
2683
+
2684
+			pushViewport(viewport(yscale = c(0.5, ng+0.5), xscale = c(0, 1)))
2685
+			for(i in 1:ng) {
2686
+				x = i
2687
+				y = cumsum(tl[[i]])
2688
+				grid.rect(y, x, height = bar_width, width = tl[[i]], just = "right", gp = gpar(fill = map_to_colors(cm, names(y))), default.units = "native")
2689
+			}
2690
+			if(axis) grid.draw(axis_grob)
2691
+			if(border) grid.rect(gp = gpar(fill = "transparent"))
2692
+			popViewport()
2693
+		} else {
2694
+			stop_wrap("`anno_summary()` currently only supports discrete matrix.")
2695
+		}
2674 2696
 	}
2675 2697
 	column_fun = function(index) {
2676 2698
 		ht = get("object", envir = parent.frame(7))
... ...
@@ -2682,16 +2704,19 @@ anno_summary = function(which = c("column", "row"), bar_width = 0.8,
2682 2704
 		if(cm@type == "discrete") {
2683 2705
 			tl = lapply(order_list, function(od) table(mat[od, 1]))
2684 2706
 			tl = lapply(tl, function(x) x/sum(x))
2707
+
2685 2708
 			pushViewport(viewport(xscale = c(0.5, ng+0.5), yscale = c(0, 1)))
2686 2709
 			for(i in 1:ng) {
2687 2710
 				x = i
2688 2711
 				y = cumsum(tl[[i]])
2689
-				grid.rect(x, y, w = bar_width, just = "top", gp = gpar(fill = map_to_colors(cm, names(y))))
2712
+				grid.rect(x, y, width = bar_width, height = tl[[i]], just = "top", gp = gpar(fill = map_to_colors(cm, names(y))), default.units = "native")
2690 2713
 			}
2691
-			# axis
2714
+			if(axis) grid.draw(axis_grob)
2715
+			if(border) grid.rect(gp = gpar(fill = "transparent"))
2692 2716
 			popViewport()
2717
+		} else {
2718
+			stop_wrap("`anno_summary()` currently only supports discrete matrix.")
2693 2719
 		}
2694
-
2695 2720
 	}
2696 2721
 
2697 2722
 	if(which == "row") {
... ...
@@ -2706,11 +2731,14 @@ anno_summary = function(which = c("column", "row"), bar_width = 0.8,
2706 2731
 		which = which,
2707 2732
 		width = width,
2708 2733
 		height = height,
2734
+		var_import = list(bar_width, border, axis, axis_grob),
2709 2735
 		n = 1,
2710 2736
 		show_name = FALSE
2711 2737
 	)
2712 2738
 
2713 2739
 	anno@subsetable = FALSE
2740
+	anno@extended = update_anno_extend(anno, axis_grob, axis_param)
2741
+
2714 2742
 	return(anno)
2715 2743
 }
2716 2744
 
... ...
@@ -339,7 +339,7 @@ setMethod(f = "adjust_heatmap_list",
339 339
         object@layout$max_right_component_width = max_right_component_width
340 340
         
341 341
         # and calcualte proper paddings
342
-        if(is.null(object@ht_list_param$padding)) {
342
+        if(TRUE) {
343 343
             object@ht_list_param$padding = GLOBAL_PADDING
344 344
             column_anno_max_left_extended = max(do.call("unit.c", lapply(object@ht_list, function(ht) {
345 345
                 if(inherits(ht, "HeatmapAnnotation")) {
... ...
@@ -146,12 +146,15 @@ setMethod(f = "make_layout",
146 146
     # i_main is aleays numeric index
147 147
     if(is.character(i_main)) {
148 148
         i_main = which(names(object@ht_list) == i_main)[1]
149
+        if(length(i_main) == 0) {
150
+            stop_wrap(qq("cannot find heatmap '@{main_heatmap}'"))
151
+        }
149 152
     }
150 153
 
151 154
     if(verbose) qqcat("@{n_ht} heatmaps/annotations, main heatmap: @{i_main}th\n")
152 155
 
153 156
     if(inherits(object@ht_list[[i_main]], "HeatmapAnnotation")) {
154
-        stop("the main heatmap can only be the heatmap.")
157
+        stop_wrap("the main heatmap can only be the heatmap.")
155 158
     }
156 159
 
157 160
     nr = nrow(object@ht_list[[i_main]]@matrix)
... ...
@@ -404,11 +404,11 @@ SingleAnnotation = function(name, value, col, fun,
404 404
                 extended[[3]] = text_width
405 405
             }
406 406
         }
407
-        for(i in 1:4) {
408
-            extended[[i]] = max(anno_fun_extend[[i]], extended[[i]])
409
-        }
410
-        .Object@extended = extended
411 407
     }
408
+    for(i in 1:4) {
409
+        extended[[i]] = max(anno_fun_extend[[i]], extended[[i]])
410
+    }
411
+    .Object@extended = extended
412 412
 
413 413
     .Object@name_param = name_param
414 414
 
... ...
@@ -364,19 +364,19 @@ dev.null = function(...) {
364 364
 }
365 365
 
366 366
 stop_wrap = function (...) {
367
-    x = qq(paste0(...))
367
+    x = paste0(...)
368 368
     x = paste(strwrap(x), collapse = "\n")
369 369
     stop(x, call. = FALSE)
370 370
 }
371 371
 
372 372
 warning_wrap = function (...) {
373
-    x = qq(paste0(...))
373
+    x = paste0(...)
374 374
     x = paste(strwrap(x), collapse = "\n")
375 375
     warning(x, call. = FALSE)
376 376
 }
377 377
 
378 378
 message_wrap = function (...) {
379
-    x = qq(paste0(...))
379
+    x = paste0(...)
380 380
     x = paste(strwrap(x), collapse = "\n")
381 381
     message(x)
382 382
 }
... ...
@@ -597,3 +597,41 @@ unit_with_vp = function(..., vp = current.viewport()$name) {
597 597
 }
598 598
 
599 599
 
600
+grid.boxplot = function(value, pos, outline = TRUE, box_width = 0.6,
601
+    pch = 1, size = unit(2, "mm"), gp = gpar(fill = "#CCCCCC"), 
602
+    direction = c("vertical", "horizontal"), ...) {
603
+
604
+    direction = match.args(direction)[1]
605
+    boxplot_stats = boxplot(value, plot = FALSE)$stats
606
+
607
+    if(direction == "vertical") {
608
+    grid.rect(x = pos, y = boxplot_stats[2, ], 
609
+            height = boxplot_stats[4, ] - boxplot_stats[2, ], width = 1*box_width, just = "bottom", 
610
+            default.units = "native", gp = gp)
611
+        
612
+        grid.segments(seq_along(index) - 0.5*box_width, boxplot_stats[5, ],
613
+                      seq_along(index) + 0.5*box_width, boxplot_stats[5, ], 
614
+                      default.units = "native", gp = gp)
615
+        grid.segments(seq_along(index), boxplot_stats[5, ],
616
+                      seq_along(index), boxplot_stats[4, ], 
617
+                      default.units = "native", gp = gp)
618
+        grid.segments(seq_along(index), boxplot_stats[1, ],
619
+                      seq_along(index), boxplot_stats[2, ], 
620
+                      default.units = "native", gp = gp)
621
+        grid.segments(seq_along(index) - 0.5*box_width, boxplot_stats[1, ],
622
+                      seq_along(index) + 0.5*box_width, boxplot_stats[1, ], 
623
+                      default.units = "native", gp = gp)
624
+        grid.segments(seq_along(index) - 0.5*box_width, boxplot_stats[3, ],
625
+                      seq_along(index) + 0.5*box_width, boxplot_stats[3, ], 
626
+                      default.units = "native", gp = gp)
627
+        if(outline) {   
628
+            for(i in seq_along(value)) {
629
+                l1 = value[[i]] > boxplot_stats[5,i]
630
+                if(sum(l1)) grid.points(x = rep(i, sum(l1)), y = value[[i]][l1], 
631
+                    default.units = "native", gp = subset_gp(gp, i), pch = pch[i], size = size[i])
632
+                l2 = value[[i]] < boxplot_stats[1,i]
633
+                if(sum(l2)) grid.points(x = rep(i, sum(l2)), y = value[[i]][l2], 
634
+                    default.units = "native", gp = subset_gp(gp, i), pch = pch[i], size = size[i])
635
+            }
636
+        }
637
+}
600 638
\ No newline at end of file