... | ... |
@@ -1016,7 +1016,7 @@ anno_barplot = function(x, baseline = 0, which = c("column", "row"), border = TR |
1016 | 1016 |
baseline = max(x) |
1017 | 1017 |
} else { |
1018 | 1018 |
if(is.numeric(baseline)) { |
1019 |
- if(baseline == 0 && all(rowSums(x) == 1)) { |
|
1019 |
+ if(baseline == 0 && all(abs(rowSums(x) - 1) < 1e-6)) { |
|
1020 | 1020 |
data_scale = c(0, 1) |
1021 | 1021 |
} else if(baseline <= min(x)) { |
1022 | 1022 |
data_scale = c(baseline, extend*(data_scale[2] - baseline) + data_scale[2]) |
... | ... |
@@ -2074,7 +2074,7 @@ anno_joyplot = function(x, which = c("column", "row"), gp = gpar(fill = "#000000 |
2074 | 2074 |
# -n_slice Number of slices on y-axis. |
2075 | 2075 |
# -slice_size Height of the slice. If the value is not ``NULL``, ``n_slice`` will be recalculated. |
2076 | 2076 |
# -negative_from_top Whether the areas for negative values start from the top or the bottom of the plotting region? |
2077 |
-# -normalize Whether normalize ``x`` to let data range of each observation in (0, 1)? |
|
2077 |
+# -normalize Whether normalize ``x`` by max(abs(x)). |
|
2078 | 2078 |
# -gap Gap size of neighbouring horizon chart. |
2079 | 2079 |
# -axis Whether to add axis? |
2080 | 2080 |
# -axis_param parameters for controlling axis. See `default_axis_param` for all possible settings and default parameters. |
... | ... |
@@ -649,7 +649,7 @@ setMethod(f = "show", |
649 | 649 |
cat(" items:", ifelse(length(len), len[1], "unknown"), "\n") |
650 | 650 |
cat(" width:", as.character(object@width), "\n") |
651 | 651 |
cat(" height:", as.character(object@height), "\n") |
652 |
- cat(" this object is", ifelse(object@subsetable, "\b", "not"), "subsetable\n") |
|
652 |
+ cat(" this object is", ifelse(object@subsetable, "", "not"), "subsetable\n") |
|
653 | 653 |
dirt = c("bottom", "left", "top", "right") |
654 | 654 |
for(i in 1:4) { |
655 | 655 |
if(!identical(unit(0, "mm"), object@extended[i])) { |
... | ... |
@@ -47,11 +47,10 @@ oncoPrint = function(mat, |
47 | 47 |
alter_fun_is_vectorized = NULL, |
48 | 48 |
col, |
49 | 49 |
|
50 |
- top_annotation = HeatmapAnnotation(column_barplot = anno_oncoprint_barplot(), |
|
51 |
- show_annotation_name = FALSE), |
|
50 |
+ top_annotation = HeatmapAnnotation(column_barplot = anno_oncoprint_barplot()), |
|
52 | 51 |
right_annotation = rowAnnotation(row_barplot = anno_oncoprint_barplot( |
53 |
- axis_param = list(side = "top", labels_rot = 0)), |
|
54 |
- show_annotation_name = FALSE), |
|
52 |
+ axis_param = list(side = "top", labels_rot = 0))), |
|
53 |
+ bottom_annotation = NULL, |
|
55 | 54 |
|
56 | 55 |
show_pct = TRUE, |
57 | 56 |
pct_gp = gpar(fontsize = 10), |
... | ... |
@@ -70,11 +69,13 @@ oncoPrint = function(mat, |
70 | 69 |
heatmap_legend_param = list(title = "Alterations"), |
71 | 70 |
...) { |
72 | 71 |
|
73 |
- .in_oncoprint = TRUE |
|
74 |
- |
|
75 | 72 |
arg_list = list(...) |
76 | 73 |
arg_names = names(arg_list) |
77 | 74 |
|
75 |
+ oe = environment(anno_oncoprint_barplot) |
|
76 |
+ environment(anno_oncoprint_barplot) = environment() |
|
77 |
+ on.exit(environment(anno_oncoprint_barplot) <- oe) |
|
78 |
+ |
|
78 | 79 |
# convert mat to mat_list |
79 | 80 |
if(inherits(mat, "data.frame")) { |
80 | 81 |
mat = as.matrix(mat) |
... | ... |
@@ -247,17 +248,16 @@ oncoPrint = function(mat, |
247 | 248 |
|
248 | 249 |
col = col[intersect(names(col), all_type)] |
249 | 250 |
|
250 |
- |
|
251 | 251 |
count_matrix = apply(arr, c(1, 2), sum) |
252 | 252 |
n_mut = rowSums(apply(arr, 1:2, any)) |
253 | 253 |
|
254 |
- if(!"row_order" %in% arg_names) { |
|
254 |
+ if(is.null(row_order)) { |
|
255 | 255 |
row_order = oncoprint_row_order() |
256 | 256 |
} |
257 |
- if(!"column_order" %in% arg_names) { |
|
257 |
+ if(is.null(column_order)) { |
|
258 | 258 |
column_order = oncoprint_column_order() |
259 | 259 |
} |
260 |
- |
|
260 |
+ |
|
261 | 261 |
if(is.null(row_order)) row_order = seq_len(nrow(count_matrix)) |
262 | 262 |
if(is.null(column_order)) column_order = seq_len(ncol(count_matrix)) |
263 | 263 |
if(is.character(column_order)) { |
... | ... |
@@ -286,6 +286,12 @@ oncoPrint = function(mat, |
286 | 286 |
pct = paste0(round(pct_num * 100, digits = pct_digits), "%") |
287 | 287 |
|
288 | 288 |
### now the annotations |
289 |
+ err = try(top_annotation <- eval(substitute(top_annotation)), silent = TRUE) |
|
290 |
+ if(inherits(err, "try-error")) { |
|
291 |
+ stop_wrap("find an error when executing top_annotation. ") |
|
292 |
+ } |
|
293 |
+ right_annotation = eval(substitute(right_annotation)) |
|
294 |
+ |
|
289 | 295 |
if("left_annotation" %in% arg_names) { |
290 | 296 |
stop("'left_annotation' are not allowed to specify, you can add...") |
291 | 297 |
} |
... | ... |
@@ -297,7 +303,7 @@ oncoPrint = function(mat, |
297 | 303 |
if(show_row_names) { |
298 | 304 |
ha_row_names = rowAnnotation(rownames = anno_text(dimnames(arr)[[1]], gp = pct_gp, just = "left", location = unit(0, "npc")), |
299 | 305 |
show_annotation_name = FALSE) |
300 |
- right_annotation = c(ha_row_names, right_annotation) |
|
306 |
+ right_annotation = c(ha_row_names, right_annotation, gap = unit(2, "mm")) |
|
301 | 307 |
} |
302 | 308 |
|
303 | 309 |
##################################################################### |
... | ... |
@@ -388,18 +394,17 @@ anno_oncoprint_barplot = function(type = all_type, which = c("column", "row"), |
388 | 394 |
} |
389 | 395 |
|
390 | 396 |
anno_size = anno_width_and_height(which, width, height, unit(2, "cm")) |
391 |
- |
|
392 | 397 |
# get variables fron oncoPrint() function |
393 |
- pf = parent.frame() |
|
394 |
- if(!exists(".in_oncoprint", envir = pf, inherits = FALSE)) { |
|
395 |
- stop_wrap("`anno_oncoprint_barplot()` should only be used with `oncoPrint()`.") |
|
396 |
- } |
|
397 |
- arr = get("arr", envir = pf, inherits = FALSE) |
|
398 |
- all_type = get("all_type", envir = pf, inherits = FALSE) |
|
399 |
- col = get("col", envir = pf, inherits = FALSE) |
|
398 |
+ pf = parent.env(environment()) |
|
399 |
+ arr = pf$arr |
|
400 |
+ all_type = pf$all_type |
|
401 |
+ col = pf$col |
|
400 | 402 |
|
401 | 403 |
type = type |
402 | 404 |
all_type = intersect(all_type, type) |
405 |
+ if(length(all_type) == 0) { |
|
406 |
+ stop_wrap("find no overlap, check your `type` argument.") |
|
407 |
+ } |
|
403 | 408 |
arr = arr[, , all_type, drop = FALSE] |
404 | 409 |
col = col[all_type] |
405 | 410 |
|
... | ... |
@@ -417,6 +422,7 @@ anno_oncoprint_barplot = function(type = all_type, which = c("column", "row"), |
417 | 422 |
return(fun) |
418 | 423 |
} |
419 | 424 |
|
425 |
+ |
|
420 | 426 |
guess_alter_fun_is_vectorized = function(alter_fun) { |
421 | 427 |
n = 50 |
422 | 428 |
if(is.list(alter_fun)) { |