... | ... |
@@ -19,7 +19,7 @@ AnnotationFunction = setClass("AnnotationFunction", |
19 | 19 |
fun_name = "character", |
20 | 20 |
width = "ANY", |
21 | 21 |
height = "ANY", |
22 |
- n = "numeric", |
|
22 |
+ n = "ANY", |
|
23 | 23 |
var_env = "environment", |
24 | 24 |
fun = "function", |
25 | 25 |
subset_rule = "list", |
... | ... |
@@ -35,7 +35,7 @@ AnnotationFunction = setClass("AnnotationFunction", |
35 | 35 |
subset_rule = list(), |
36 | 36 |
subsetable = FALSE, |
37 | 37 |
data_scale = c(0, 1), |
38 |
- n = 0, |
|
38 |
+ n = NA_integer_, |
|
39 | 39 |
extended = unit(c(0, 0, 0, 0), "mm"), |
40 | 40 |
show_name = TRUE |
41 | 41 |
) |
... | ... |
@@ -50,7 +50,7 @@ anno_width_and_height = function(which, width = NULL, height = NULL, |
50 | 50 |
height = default |
51 | 51 |
} else { |
52 | 52 |
if(!is_abs_unit(height)) { |
53 |
- stop("height can only be an absolute unit.") |
|
53 |
+ stop_wrap("height of the annotation can only be an absolute unit.") |
|
54 | 54 |
} else { |
55 | 55 |
height = convertHeight(height, "mm") |
56 | 56 |
} |
... | ... |
@@ -64,7 +64,7 @@ anno_width_and_height = function(which, width = NULL, height = NULL, |
64 | 64 |
width = default |
65 | 65 |
} else { |
66 | 66 |
if(!is_abs_unit(width)) { |
67 |
- stop("width can only be an absolute unit.") |
|
67 |
+ stop_wrap("width of the annotation can only be an absolute unit.") |
|
68 | 68 |
} else { |
69 | 69 |
width = convertWidth(width, "mm") |
70 | 70 |
} |
... | ... |
@@ -174,7 +174,7 @@ anno_width_and_height = function(which, width = NULL, height = NULL, |
174 | 174 |
# `anno_density`, `anno_joyplot`, `anno_horizon`, `anno_text` and `anno_mark`. Thess built-in annotation functions |
175 | 175 |
# are all subsettable. |
176 | 176 |
AnnotationFunction = function(fun, fun_name = "", which = c("column", "row"), |
177 |
- var_import = list(), n = 0, data_scale = c(0, 1), subset_rule = list(), |
|
177 |
+ var_import = list(), n = NA, data_scale = c(0, 1), subset_rule = list(), |
|
178 | 178 |
subsetable = FALSE, show_name = TRUE, width = NULL, height = NULL) { |
179 | 179 |
|
180 | 180 |
which = match.arg(which)[1] |
... | ... |
@@ -213,7 +213,7 @@ AnnotationFunction = function(fun, fun_name = "", which = c("column", "row"), |
213 | 213 |
anno@var_env[[nm]] = var_import[[nm]] |
214 | 214 |
} |
215 | 215 |
} else { |
216 |
- stop_wrap("`var_import` needs to be a character vector which contains variable names or a list of variables") |
|
216 |
+ stop_wrap("`var_import` needs to be a character vector which contains variable names or a list of variables.") |
|
217 | 217 |
} |
218 | 218 |
environment(fun) = anno@var_env |
219 | 219 |
} else { |
... | ... |
@@ -275,14 +275,14 @@ AnnotationFunction = function(fun, fun_name = "", which = c("column", "row"), |
275 | 275 |
return(x) |
276 | 276 |
} else { |
277 | 277 |
if(!x@subsetable) { |
278 |
- stop("This object is not subsetable.") |
|
278 |
+ stop_wrap("This object is not subsetable.") |
|
279 | 279 |
} |
280 | 280 |
x = copy_all(x) |
281 | 281 |
for(var in names(x@subset_rule)) { |
282 | 282 |
oe = try(x@var_env[[var]] <- x@subset_rule[[var]](x@var_env[[var]], i), silent = TRUE) |
283 | 283 |
if(inherits(oe, "try-error")) { |
284 | 284 |
message(paste0("An error when subsetting ", var)) |
285 |
- stop(oe) |
|
285 |
+ stop_wrap(oe) |
|
286 | 286 |
} |
287 | 287 |
} |
288 | 288 |
if(is.logical(i)) { |
... | ... |
@@ -357,7 +357,7 @@ setMethod(f = "draw", |
357 | 357 |
} |
358 | 358 |
vp_name2 = current.viewport()$name |
359 | 359 |
if(vp_name1 != vp_name2) { |
360 |
- stop("Viewports are not the same before and after plotting the annotation graphics.") |
|
360 |
+ stop_wrap("Viewports should be the same before and after plotting the annotation graphics.") |
|
361 | 361 |
} |
362 | 362 |
popViewport() |
363 | 363 |
|
... | ... |
@@ -443,7 +443,9 @@ setMethod(f = "show", |
443 | 443 |
# anno = anno_points(1:10) |
444 | 444 |
# nobs(anno) |
445 | 445 |
nobs.AnnotationFunction = function(object, ...) { |
446 |
- if(object@n > 0) { |
|
446 |
+ if(is.na(object@n)) { |
|
447 |
+ return(NA) |
|
448 |
+ } else if(object@n > 0) { |
|
447 | 449 |
object@n |
448 | 450 |
} else { |
449 | 451 |
NA |
... | ... |
@@ -55,6 +55,7 @@ anno_empty = function(which = c("column", "row"), border = TRUE, width = NULL, h |
55 | 55 |
|
56 | 56 |
anno = AnnotationFunction( |
57 | 57 |
fun = fun, |
58 |
+ n = NA, |
|
58 | 59 |
fun_name = "anno_empty", |
59 | 60 |
which = which, |
60 | 61 |
var_import = list(border), |
... | ... |
@@ -236,6 +237,7 @@ anno_simple = function(x, col, na_col = "grey", |
236 | 237 |
fill = map_to_colors(color_mapping, value[index, i]) |
237 | 238 |
grid.rect(x, y = (nc-i +0.5)/nc, width = 1/n, height = 1/nc, gp = do.call("gpar", c(list(fill = fill), gp))) |
238 | 239 |
if(!is.null(pch)) { |
240 |
+ pch = pch[index, , drop = FALSE] |
|
239 | 241 |
l = !is.na(pch[, i]) |
240 | 242 |
grid.points(x[l], y = rep((nc-i +0.5)/nc, sum(l)), pch = pch[l, i], size = pt_size, gp = pt_gp) |
241 | 243 |
} |
... | ... |
@@ -244,6 +246,7 @@ anno_simple = function(x, col, na_col = "grey", |
244 | 246 |
fill = map_to_colors(color_mapping, value[index]) |
245 | 247 |
grid.rect(x, y = 0.5, width = 1/n, height = 1, gp = do.call("gpar", c(list(fill = fill), gp))) |
246 | 248 |
if(!is.null(pch)) { |
249 |
+ pch = pch[index] |
|
247 | 250 |
l = !is.na(pch) |
248 | 251 |
grid.points(x[l], y = rep(0.5, sum(l)), pch = pch[l], size = pt_size[l], gp = subset_gp(pt_gp, which(l))) |
249 | 252 |
} |
... | ... |
@@ -337,10 +340,10 @@ anno_image = function(image, which = c("column", "row"), border = TRUE, |
337 | 340 |
if(inherits(image, "character")) { ## they are file path |
338 | 341 |
image_type = tolower(gsub("^.*\\.(\\w+)$", "\\1", image)) |
339 | 342 |
if(! all(image_type[image_type != ""] %in% allowed_image_type)) { |
340 |
- stop("image file should be of png/svg/pdf/eps/jpeg/jpg/tiff.") |
|
343 |
+ stop_wrap("image file should be of png/svg/pdf/eps/jpeg/jpg/tiff.") |
|
341 | 344 |
} |
342 | 345 |
} else { |
343 |
- stop("`image` should be a vector of path.") |
|
346 |
+ stop_wrap("`image` should be a vector of path.") |
|
344 | 347 |
} |
345 | 348 |
|
346 | 349 |
n_image = length(image) |
... | ... |
@@ -352,25 +355,25 @@ anno_image = function(image, which = c("column", "row"), border = TRUE, |
352 | 355 |
image_class[i] = NA |
353 | 356 |
} else if(image_type[i] == "png") { |
354 | 357 |
if(!requireNamespace("png")) { |
355 |
- stop("Need png package to read png images.") |
|
358 |
+ stop_wrap("Need png package to read png images.") |
|
356 | 359 |
} |
357 | 360 |
image_list[[i]] = png::readPNG(image[i]) |
358 | 361 |
image_class[i] = "raster" |
359 | 362 |
} else if(image_type[i] %in% c("jpeg", "jpg")) { |
360 | 363 |
if(!requireNamespace("jpeg")) { |
361 |
- stop("Need jpeg package to read jpeg/jpg images.") |
|
364 |
+ stop_wrap("Need jpeg package to read jpeg/jpg images.") |
|
362 | 365 |
} |
363 | 366 |
image_list[[i]] = jpeg::readJPEG(image[i]) |
364 | 367 |
image_class[i] = "raster" |
365 | 368 |
} else if(image_type[i] == "tiff") { |
366 | 369 |
if(!requireNamespace("tiff")) { |
367 |
- stop("Need tiff package to read tiff images.") |
|
370 |
+ stop_wrap("Need tiff package to read tiff images.") |
|
368 | 371 |
} |
369 | 372 |
image_list[[i]] = tiff::readTIFF(image[i]) |
370 | 373 |
image_class[i] = "raster" |
371 | 374 |
} else if(image_type[i] %in% c("pdf", "eps")) { |
372 | 375 |
if(!requireNamespace("grImport")) { |
373 |
- stop("Need grImport package to read pdf/eps images.") |
|
376 |
+ stop_wrap("Need grImport package to read pdf/eps images.") |
|
374 | 377 |
} |
375 | 378 |
temp_file = tempfile() |
376 | 379 |
getFromNamespace("PostScriptTrace", ns = "grImport")(image[[i]], temp_file) |
... | ... |
@@ -379,10 +382,10 @@ anno_image = function(image, which = c("column", "row"), border = TRUE, |
379 | 382 |
image_class[i] = "grImport::Picture" |
380 | 383 |
} else if(image_type[i] == "svg") { |
381 | 384 |
if(!requireNamespace("grImport2")) { |
382 |
- stop("Need grImport2 package to read svg images.") |
|
385 |
+ stop_wrap("Need grImport2 package to read svg images.") |
|
383 | 386 |
} |
384 | 387 |
if(!requireNamespace("rsvg")) { |
385 |
- stop("Need rsvg package to convert svg images.") |
|
388 |
+ stop_wrap("Need rsvg package to convert svg images.") |
|
386 | 389 |
} |
387 | 390 |
temp_file = tempfile() |
388 | 391 |
rsvg::rsvg_svg(image[i], temp_file) |
... | ... |
@@ -1931,13 +1934,13 @@ anno_joyplot = function(x, which = c("column", "row"), gp = gpar(fill = "#000000 |
1931 | 1934 |
value[[i]] = cbind(seq_along(x[[i]]), x[[i]]) |
1932 | 1935 |
} |
1933 | 1936 |
} else { |
1934 |
- stop("Since x is a list, x need to be a list of two-column matrices.") |
|
1937 |
+ stop_wrap("Since x is a list, x need to be a list of two-column matrices.") |
|
1935 | 1938 |
} |
1936 | 1939 |
} else { |
1937 | 1940 |
value = x |
1938 | 1941 |
} |
1939 | 1942 |
} else { |
1940 |
- stop("The input should be a list of two-column matrices or a matrix/data frame.") |
|
1943 |
+ stop_wrap("The input should be a list of two-column matrices or a matrix/data frame.") |
|
1941 | 1944 |
} |
1942 | 1945 |
|
1943 | 1946 |
xscale = range(lapply(value, function(x) x[, 1]), na.rm = TRUE) |
... | ... |
@@ -2124,13 +2127,13 @@ anno_horizon = function(x, which = c("column", "row"), |
2124 | 2127 |
value[[i]] = cbind(seq_along(x[[i]]), x[[i]]) |
2125 | 2128 |
} |
2126 | 2129 |
} else { |
2127 |
- stop("Since x is a list, x need to be a list of two-column matrices.") |
|
2130 |
+ stop_wrap("Since x is a list, x need to be a list of two-column matrices.") |
|
2128 | 2131 |
} |
2129 | 2132 |
} else { |
2130 | 2133 |
value = x |
2131 | 2134 |
} |
2132 | 2135 |
} else { |
2133 |
- stop("The input should be a list of two-column matrices or a matrix/data frame.") |
|
2136 |
+ stop_wrap("The input should be a list of two-column matrices or a matrix/data frame.") |
|
2134 | 2137 |
} |
2135 | 2138 |
|
2136 | 2139 |
if(is.null(gp$pos_fill)) gp$pos_fill = "#D73027" |
... | ... |
@@ -2148,7 +2151,7 @@ anno_horizon = function(x, which = c("column", "row"), |
2148 | 2151 |
} |
2149 | 2152 |
|
2150 | 2153 |
if(which == "column") { |
2151 |
- stop("anno_horizon() does not support column annotation. If you want, please email me.") |
|
2154 |
+ stop_wrap("anno_horizon() does not support column annotation. If you want, please email me.") |
|
2152 | 2155 |
} |
2153 | 2156 |
|
2154 | 2157 |
if(normalize) { |
... | ... |
@@ -2323,7 +2326,7 @@ split_vec_by_NA = function(x) { |
2323 | 2326 |
# |
2324 | 2327 |
row_anno_points = function(...) { |
2325 | 2328 |
if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { |
2326 |
- message("From this version of ComplexHeatmap, you can directly use `anno_points()` for row annotation if you call it in `rowAnnotation()`.") |
|
2329 |
+ message_wrap("From this version of ComplexHeatmap, you can directly use `anno_points()` for row annotation if you call it in `rowAnnotation()`.") |
|
2327 | 2330 |
} |
2328 | 2331 |
anno_points(..., which = "row") |
2329 | 2332 |
} |
... | ... |
@@ -2345,7 +2348,7 @@ row_anno_points = function(...) { |
2345 | 2348 |
# |
2346 | 2349 |
row_anno_barplot = function(...) { |
2347 | 2350 |
if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { |
2348 |
- message("From this version of ComplexHeatmap, you can directly use `anno_barplot()` for row annotation if you call it in `rowAnnotation()`.") |
|
2351 |
+ message_wrap("From this version of ComplexHeatmap, you can directly use `anno_barplot()` for row annotation if you call it in `rowAnnotation()`.") |
|
2349 | 2352 |
} |
2350 | 2353 |
anno_barplot(..., which = "row") |
2351 | 2354 |
} |
... | ... |
@@ -2367,7 +2370,7 @@ row_anno_barplot = function(...) { |
2367 | 2370 |
# |
2368 | 2371 |
row_anno_boxplot = function(...) { |
2369 | 2372 |
if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { |
2370 |
- message("From this version of ComplexHeatmap, you can directly use `anno_boxplot()` for row annotation if you call it in `rowAnnotation()`.") |
|
2373 |
+ message_wrap("From this version of ComplexHeatmap, you can directly use `anno_boxplot()` for row annotation if you call it in `rowAnnotation()`.") |
|
2371 | 2374 |
} |
2372 | 2375 |
anno_boxplot(..., which = "row") |
2373 | 2376 |
} |
... | ... |
@@ -2388,7 +2391,7 @@ row_anno_boxplot = function(...) { |
2388 | 2391 |
# |
2389 | 2392 |
row_anno_histogram = function(...) { |
2390 | 2393 |
if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { |
2391 |
- message("From this version of ComplexHeatmap, you can directly use `anno_histogram()` for row annotation if you call it in `rowAnnotation()`.") |
|
2394 |
+ message_wrap("From this version of ComplexHeatmap, you can directly use `anno_histogram()` for row annotation if you call it in `rowAnnotation()`.") |
|
2392 | 2395 |
} |
2393 | 2396 |
anno_histogram(..., which = "row") |
2394 | 2397 |
} |
... | ... |
@@ -2409,7 +2412,7 @@ row_anno_histogram = function(...) { |
2409 | 2412 |
# |
2410 | 2413 |
row_anno_density = function(...) { |
2411 | 2414 |
if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { |
2412 |
- message("From this version of ComplexHeatmap, you can directly use `anno_density()` for row annotation if you call it in `rowAnnotation()`.") |
|
2415 |
+ message_wrap("From this version of ComplexHeatmap, you can directly use `anno_density()` for row annotation if you call it in `rowAnnotation()`.") |
|
2413 | 2416 |
} |
2414 | 2417 |
anno_density(..., which = "row") |
2415 | 2418 |
} |
... | ... |
@@ -2430,7 +2433,7 @@ row_anno_density = function(...) { |
2430 | 2433 |
# |
2431 | 2434 |
row_anno_text = function(...) { |
2432 | 2435 |
if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { |
2433 |
- message("From this version of ComplexHeatmap, you can directly use `anno_text()` for row annotation if you call it in `rowAnnotation()`.") |
|
2436 |
+ message_wrap("From this version of ComplexHeatmap, you can directly use `anno_text()` for row annotation if you call it in `rowAnnotation()`.") |
|
2434 | 2437 |
} |
2435 | 2438 |
anno_text(..., which = "row") |
2436 | 2439 |
} |
... | ... |
@@ -2482,7 +2485,7 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2482 | 2485 |
} |
2483 | 2486 |
|
2484 | 2487 |
if(!is.numeric(at)) { |
2485 |
- stop(paste0("`at` should be numeric ", which, " index corresponding to the matrix.")) |
|
2488 |
+ stop_wrap(paste0("`at` should be numeric ", which, " index corresponding to the matrix.")) |
|
2486 | 2489 |
} |
2487 | 2490 |
|
2488 | 2491 |
n = length(at) |
... | ... |
@@ -2623,7 +2626,7 @@ subset_by_intersect = function(x, i) { |
2623 | 2626 |
# `anno_link` is deprecated, please use `anno_mark` instead. |
2624 | 2627 |
# |
2625 | 2628 |
anno_link = function(...) { |
2626 |
- warning("anno_link() is deprecated, please use anno_mark() instead.") |
|
2629 |
+ warning_wrap("anno_link() is deprecated, please use anno_mark() instead.") |
|
2627 | 2630 |
anno_mark(...) |
2628 | 2631 |
} |
2629 | 2632 |
|
... | ... |
@@ -2644,7 +2647,7 @@ anno_link = function(...) { |
2644 | 2647 |
# |
2645 | 2648 |
row_anno_link = function(...) { |
2646 | 2649 |
if(exists(".__under_SingleAnnotation__", envir = parent.frame())) { |
2647 |
- message("From this version of ComplexHeatmap, you can directly use `anno_mark()` for row annotation if you call it in `rowAnnotation()`.") |
|
2650 |
+ message_wrap("From this version of ComplexHeatmap, you can directly use `anno_mark()` for row annotation if you call it in `rowAnnotation()`.") |
|
2648 | 2651 |
} |
2649 | 2652 |
anno_link(..., which = "row") |
2650 | 2653 |
} |
... | ... |
@@ -2659,7 +2662,7 @@ anno_summarize = function(which = c("column", "row"), |
2659 | 2662 |
} |
2660 | 2663 |
|
2661 | 2664 |
if(which == "column") { |
2662 |
- stop("`anno_summarize()` is only allowed as a column annotation.") |
|
2665 |
+ stop_wrap("`anno_summarize()` is only allowed as a column annotation.") |
|
2663 | 2666 |
} |
2664 | 2667 |
|
2665 | 2668 |
anno_size = anno_width_and_height(which, width, height, unit(2, "cm")) |
... | ... |
@@ -482,25 +482,6 @@ Heatmap = function(matrix, col, name, |
482 | 482 |
.Object@matrix_param$cell_fun = cell_fun |
483 | 483 |
.Object@matrix_param$layer_fun = layer_fun |
484 | 484 |
|
485 |
- if(!missing(width)) { |
|
486 |
- if(is_abs_unit(width)) { |
|
487 |
- heatmap_width = unit(1, "npc") # since width is a relative unit and all components are absolute, it will be refit |
|
488 |
- } |
|
489 |
- } |
|
490 |
- if(!missing(height)) { |
|
491 |
- if(is_abs_unit(height)) { |
|
492 |
- heatmap_height = unit(1, "npc") |
|
493 |
- } |
|
494 |
- } |
|
495 |
- if(is.null(width)) { |
|
496 |
- width = unit(ncol(matrix), "null") |
|
497 |
- } |
|
498 |
- if(is.null(height)) { |
|
499 |
- height = unit(nrow(matrix), "null") |
|
500 |
- } |
|
501 |
- .Object@matrix_param$width = width |
|
502 |
- .Object@matrix_param$height = height |
|
503 |
- |
|
504 | 485 |
### color for main matrix ######### |
505 | 486 |
if(ncol(matrix) > 0 && nrow(matrix) > 0) { |
506 | 487 |
if(missing(col)) { |
... | ... |
@@ -522,7 +503,7 @@ Heatmap = function(matrix, col, name, |
522 | 503 |
.Object@matrix_color_mapping = ColorMapping(col_fun = col, name = name, na_col = na_col) |
523 | 504 |
if(verbose) qqcat("input color is a vector with no names, treat it as continuous color mapping\n") |
524 | 505 |
} else { |
525 |
- stop("`col` should have names to map to values in `mat`.") |
|
506 |
+ stop_wrap("`col` should have names to map to values in `mat`.") |
|
526 | 507 |
} |
527 | 508 |
} else { |
528 | 509 |
col = col[intersect(c(names(col), "_NA_"), as.character(matrix))] |
... | ... |
@@ -534,13 +515,8 @@ Heatmap = function(matrix, col, name, |
534 | 515 |
} |
535 | 516 |
|
536 | 517 |
##### titles, should also consider titles after row splitting ##### |
537 |
- if(length(row_title) != 1) { |
|
538 |
- } else if(!inherits(row_title, c("expression", "call"))) { |
|
539 |
- if(is.na(row_title)) { |
|
540 |
- row_title = character(0) |
|
541 |
- } else if(row_title == "") { |
|
542 |
- row_title = character(0) |
|
543 |
- } |
|
518 |
+ if(identical(row_title, NA) || identical(row_title, "")) { |
|
519 |
+ row_title = character(0) |
|
544 | 520 |
} |
545 | 521 |
.Object@row_title = row_title |
546 | 522 |
.Object@row_title_param$rot = row_title_rot %% 360 |
... | ... |
@@ -548,13 +524,8 @@ Heatmap = function(matrix, col, name, |
548 | 524 |
.Object@row_title_param$gp = check_gp(row_title_gp) # if the number of settings is same as number of row-splits, gp will be adjusted by `make_row_dend` |
549 | 525 |
.Object@row_title_param$just = get_text_just(rot = row_title_rot, side = .Object@row_title_param$side) |
550 | 526 |
|
551 |
- if(length(column_title) != 1) { |
|
552 |
- } else if(!inherits(column_title, c("expression", "call"))) { |
|
553 |
- if(is.na(column_title)) { |
|
554 |
- column_title = character(0) |
|
555 |
- } else if(column_title == "") { |
|
556 |
- column_title = character(0) |
|
557 |
- } |
|
527 |
+ if(identical(column_title, NA) || identical(column_title, "")) { |
|
528 |
+ column_title = character(0) |
|
558 | 529 |
} |
559 | 530 |
.Object@column_title = column_title |
560 | 531 |
.Object@column_title_param$rot = column_title_rot %% 360 |
... | ... |
@@ -574,6 +545,9 @@ Heatmap = function(matrix, col, name, |
574 | 545 |
.Object@row_names_param$max_width = row_names_max_width + unit(2, "mm") |
575 | 546 |
# we use anno_text to draw row/column names because it already takes care of text rotation |
576 | 547 |
if(length(row_labels)) { |
548 |
+ if(length(row_labels) != nrow(matrix)) { |
|
549 |
+ stop_wrap("Length of `row_labels` should be the same as the nrow of matrix.") |
|
550 |
+ } |
|
577 | 551 |
row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot, |
578 | 552 |
location = ifelse(.Object@row_names_param$side == "left", 1, 0), |
579 | 553 |
just = ifelse(.Object@row_names_param$side == "left", "right", "left")) |
... | ... |
@@ -590,6 +564,9 @@ Heatmap = function(matrix, col, name, |
590 | 564 |
.Object@column_names_param$rot = column_names_rot |
591 | 565 |
.Object@column_names_param$max_height = column_names_max_height + unit(2, "mm") |
592 | 566 |
if(length(column_labels)) { |
567 |
+ if(length(column_labels) != ncol(matrix)) { |
|
568 |
+ stop_wrap("Length of `column_labels` should be the same as the ncol of matrix.") |
|
569 |
+ } |
|
593 | 570 |
column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot, |
594 | 571 |
location = ifelse(.Object@column_names_param$side == "top", 0, 1), |
595 | 572 |
just = ifelse(.Object@column_names_param$side == "top", |
... | ... |
@@ -683,13 +660,13 @@ Heatmap = function(matrix, col, name, |
683 | 660 |
if(!is.null(top_annotation)) { |
684 | 661 |
if(length(top_annotation) > 0) { |
685 | 662 |
if(!.Object@top_annotation@which == "column") { |
686 |
- stop("`which` in `top_annotation` should only be `column`.") |
|
663 |
+ stop_wrap("`which` in `top_annotation` should only be `column`.") |
|
687 | 664 |
} |
688 | 665 |
} |
689 | 666 |
nb = nobs(top_annotation) |
690 | 667 |
if(!is.na(nb)) { |
691 | 668 |
if(nb != ncol(.Object@matrix)) { |
692 |
- stop("number of items in top anntotion should be same as number of columns of the matrix.") |
|
669 |
+ stop_wrap("number of observations in top annotation should be as same as ncol of the matrix.") |
|
693 | 670 |
} |
694 | 671 |
} |
695 | 672 |
} |
... | ... |
@@ -703,13 +680,13 @@ Heatmap = function(matrix, col, name, |
703 | 680 |
if(!is.null(bottom_annotation)) { |
704 | 681 |
if(length(bottom_annotation) > 0) { |
705 | 682 |
if(!.Object@bottom_annotation@which == "column") { |
706 |
- stop("`which` in `bottom_annotation` should only be `column`.") |
|
683 |
+ stop_wrap("`which` in `bottom_annotation` should only be `column`.") |
|
707 | 684 |
} |
708 | 685 |
} |
709 | 686 |
nb = nobs(bottom_annotation) |
710 | 687 |
if(!is.na(nb)) { |
711 | 688 |
if(nb != ncol(.Object@matrix)) { |
712 |
- stop("number of items in bottom anntotion should be same as number of columns of the matrix.") |
|
689 |
+ stop_wrap("number of observations in bottom anntotion should be as same as ncol of the matrix.") |
|
713 | 690 |
} |
714 | 691 |
} |
715 | 692 |
} |
... | ... |
@@ -723,13 +700,13 @@ Heatmap = function(matrix, col, name, |
723 | 700 |
if(!is.null(left_annotation)) { |
724 | 701 |
if(length(left_annotation) > 0) { |
725 | 702 |
if(!.Object@left_annotation@which == "row") { |
726 |
- stop("`which` in `left_annotation` should only be `row`, or consider using `rowAnnotation()`.") |
|
703 |
+ stop_wrap("`which` in `left_annotation` should only be `row`, or consider using `rowAnnotation()`.") |
|
727 | 704 |
} |
728 | 705 |
} |
729 | 706 |
nb = nobs(left_annotation) |
730 | 707 |
if(!is.na(nb)) { |
731 | 708 |
if(nb != nrow(.Object@matrix)) { |
732 |
- stop("number of items in left anntotion should be same as number of rows of the matrix.") |
|
709 |
+ stop_wrap("number of observations in left anntotion should be same as nrow of the matrix.") |
|
733 | 710 |
} |
734 | 711 |
} |
735 | 712 |
} |
... | ... |
@@ -743,13 +720,13 @@ Heatmap = function(matrix, col, name, |
743 | 720 |
if(!is.null(right_annotation)) { |
744 | 721 |
if(length(right_annotation) > 0) { |
745 | 722 |
if(!.Object@right_annotation@which == "row") { |
746 |
- stop("`which` in `right_annotation` should only be `row`, or consider using `rowAnnotation()`.") |
|
723 |
+ stop_wrap("`which` in `right_annotation` should only be `row`, or consider using `rowAnnotation()`.") |
|
747 | 724 |
} |
748 | 725 |
} |
749 | 726 |
nb = nobs(right_annotation) |
750 | 727 |
if(!is.na(nb)) { |
751 | 728 |
if(nb != nrow(.Object@matrix)) { |
752 |
- stop("number of items in right anntotion should be same as number of rows of the matrix.") |
|
729 |
+ stop_wrap("number of observations in right anntotion should be same as nrow of the matrix.") |
|
753 | 730 |
} |
754 | 731 |
} |
755 | 732 |
} |
... | ... |
@@ -780,6 +757,36 @@ Heatmap = function(matrix, col, name, |
780 | 757 |
initialized = FALSE |
781 | 758 |
) |
782 | 759 |
|
760 |
+ if(is.null(width)) { |
|
761 |
+ width = unit(ncol(matrix), "null") |
|
762 |
+ } else if(is.numeric(width) && !inherits(width, "unit")) { |
|
763 |
+ width = unit(width, "null") |
|
764 |
+ } else if(!inherits(width, "unit")) { |
|
765 |
+ stop_wrap("`width` should be a `unit` object or a single number.") |
|
766 |
+ } |
|
767 |
+ |
|
768 |
+ if(is.null(height)) { |
|
769 |
+ height = unit(nrow(matrix), "null") |
|
770 |
+ } else if(is.numeric(height) && !inherits(height, "unit")) { |
|
771 |
+ height = unit(height, "null") |
|
772 |
+ } else if(!inherits(height, "unit")) { |
|
773 |
+ stop_wrap("`height` should be a `unit` object or a single number.") |
|
774 |
+ } |
|
775 |
+ |
|
776 |
+ if(!is.null(width) && !is.null(heatmap_width)) { |
|
777 |
+ if(is_abs_unit(width) && is_abs_unit(heatmap_width)) { |
|
778 |
+ stop_wrap("`heatmap_width` and `width` should not all be the absolute units.") |
|
779 |
+ } |
|
780 |
+ } |
|
781 |
+ if(!is.null(height) && !is.null(heatmap_height)) { |
|
782 |
+ if(is_abs_unit(height) && is_abs_unit(heatmap_height)) { |
|
783 |
+ stop_wrap("`heatmap_height` and `width` should not all be the absolute units.") |
|
784 |
+ } |
|
785 |
+ } |
|
786 |
+ |
|
787 |
+ .Object@matrix_param$width = width |
|
788 |
+ .Object@matrix_param$height = height |
|
789 |
+ |
|
783 | 790 |
.Object@heatmap_param$width = heatmap_width |
784 | 791 |
.Object@heatmap_param$height = heatmap_height |
785 | 792 |
.Object@heatmap_param$show_heatmap_legend = show_heatmap_legend |
... | ... |
@@ -791,11 +798,9 @@ Heatmap = function(matrix, col, name, |
791 | 798 |
.Object@heatmap_param$post_fun = post_fun |
792 | 799 |
|
793 | 800 |
if(nrow(matrix) == 0) { |
794 |
- .Object@heatmap_param$height = unit(0, "mm") |
|
795 | 801 |
.Object@matrix_param$height = unit(0, "mm") |
796 | 802 |
} |
797 | 803 |
if(ncol(matrix) == 0) { |
798 |
- .Object@heatmap_param$width = unit(0, "mm") |
|
799 | 804 |
.Object@matrix_param$width = unit(0, "mm") |
800 | 805 |
} |
801 | 806 |
|
... | ... |
@@ -827,7 +832,13 @@ setMethod(f = "make_row_cluster", |
827 | 832 |
signature = "Heatmap", |
828 | 833 |
definition = function(object) { |
829 | 834 |
|
830 |
- make_cluster(object, "row") |
|
835 |
+ object = make_cluster(object, "row") |
|
836 |
+ if(length(object@row_title) > 1) { |
|
837 |
+ if(length(object@row_title) != length(object@row_order_list)) { |
|
838 |
+ stop_wrap("If `row_title` is set with length > 1, the length should be as same as the number of row slices.") |
|
839 |
+ } |
|
840 |
+ } |
|
841 |
+ return(object) |
|
831 | 842 |
}) |
832 | 843 |
|
833 | 844 |
# == title |
... | ... |
@@ -853,7 +864,13 @@ setMethod(f = "make_column_cluster", |
853 | 864 |
signature = "Heatmap", |
854 | 865 |
definition = function(object) { |
855 | 866 |
|
856 |
- make_cluster(object, "column") |
|
867 |
+ object = make_cluster(object, "column") |
|
868 |
+ if(length(object@column_title) > 1) { |
|
869 |
+ if(length(object@column_title) != length(object@column_order_list)) { |
|
870 |
+ stop_wrap("If `column_title` is set with length > 1, the length should be as same as the number of column slices.") |
|
871 |
+ } |
|
872 |
+ } |
|
873 |
+ return(object) |
|
857 | 874 |
}) |
858 | 875 |
|
859 | 876 |
make_cluster = function(object, which = c("row", "column")) { |
... | ... |
@@ -902,7 +919,7 @@ make_cluster = function(object, which = c("row", "column")) { |
902 | 919 |
|
903 | 920 |
if(!is.null(dend_param$obj)) { |
904 | 921 |
if(km > 1) { |
905 |
- stop("You can not make k-means partition since you have already specified a clustering object.") |
|
922 |
+ stop_wrap("You can not perform k-means clustering since you have already specified a clustering object.") |
|
906 | 923 |
} |
907 | 924 |
|
908 | 925 |
if(inherits(dend_param$obj, "hclust")) { |
... | ... |
@@ -916,10 +933,10 @@ make_cluster = function(object, which = c("row", "column")) { |
916 | 933 |
if(verbose) qqcat("since you provided a clustering object and @{which}_split is null, the entrie clustering object is taken as an one-element list.\n") |
917 | 934 |
} else { |
918 | 935 |
if(length(split) > 1 || !is.numeric(split)) { |
919 |
- stop(qq("Since you specified a clustering object, you can only split @{which}s by providing a number (number of @{which} slices).")) |
|
936 |
+ stop_wrap(qq("Since you specified a clustering object, you can only split @{which}s by providing a number (number of @{which} slices).")) |
|
920 | 937 |
} |
921 | 938 |
if(split < 2) { |
922 |
- stop("Here `split` should be equal or larger than 2.") |
|
939 |
+ stop_wrap("Here `split` should be equal or larger than 2.") |
|
923 | 940 |
} |
924 | 941 |
|
925 | 942 |
ct = cut_dendrogram(dend_param$obj, split) |
... | ... |
@@ -959,11 +976,11 @@ make_cluster = function(object, which = c("row", "column")) { |
959 | 976 |
|
960 | 977 |
if(which == "row") { |
961 | 978 |
if(length(reorder) != nrow(mat)) { |
962 |
- stop("weight of reordering should have same length as number of rows.\n") |
|
979 |
+ stop_wrap("weight of reordering should have same length as number of rows.\n") |
|
963 | 980 |
} |
964 | 981 |
} else { |
965 | 982 |
if(length(reorder) != ncol(mat)) { |
966 |
- stop("weight of reordering should have same length as number of columns\n") |
|
983 |
+ stop_wrap("weight of reordering should have same length as number of columns\n") |
|
967 | 984 |
} |
968 | 985 |
} |
969 | 986 |
|
... | ... |
@@ -1010,9 +1027,9 @@ make_cluster = function(object, which = c("row", "column")) { |
1010 | 1027 |
} else if(length(gap) == n_slice - 1) { |
1011 | 1028 |
gap = unit.c(gap, unit(0, "mm")) |
1012 | 1029 |
} else if(length(gap) != n_slice) { |
1013 |
- stop(qq("Length of `gap` should be 1 or number of @{which} slices.")) |
|
1030 |
+ stop_wrap(qq("Length of `gap` should be 1 or number of @{which} slices.")) |
|
1014 | 1031 |
} |
1015 |
- object@matrix_param[[ paste0(which, "_gap") ]] = gap# adjust title |
|
1032 |
+ object@matrix_param[[ paste0(which, "_gap") ]] = gap # adjust title |
|
1016 | 1033 |
|
1017 | 1034 |
title = slot(object, paste0(which, "_title")) |
1018 | 1035 |
if(!is.null(split)) { |
... | ... |
@@ -1032,7 +1049,7 @@ make_cluster = function(object, which = c("row", "column")) { |
1032 | 1049 |
}) |
1033 | 1050 |
} else if(grepl("\\{.+\\}", title)) { |
1034 | 1051 |
if(!requireNamespace("glue")) { |
1035 |
- stop("You need to install glue package.") |
|
1052 |
+ stop_wrap("You need to install glue package.") |
|
1036 | 1053 |
} |
1037 | 1054 |
title = apply(unique(split), 1, function(x) { |
1038 | 1055 |
x = x |
... | ... |
@@ -1097,7 +1114,7 @@ make_cluster = function(object, which = c("row", "column")) { |
1097 | 1114 |
order_list[[1]] = order |
1098 | 1115 |
} else { |
1099 | 1116 |
|
1100 |
- if(verbose) qqcat("process `split` data frame\n") |
|
1117 |
+ if(verbose) cat("process `split` data frame\n") |
|
1101 | 1118 |
if(is.null(ncol(split))) split = data.frame(split) |
1102 | 1119 |
if(is.matrix(split)) split = as.data.frame(split) |
1103 | 1120 |
|
... | ... |
@@ -1147,7 +1164,7 @@ make_cluster = function(object, which = c("row", "column")) { |
1147 | 1164 |
} else { |
1148 | 1165 |
oe = try(obj <- as.dendrogram(obj), silent = TRUE) |
1149 | 1166 |
if(inherits(oe, "try-error")) { |
1150 |
- stop("the clustering function must return a `dendrogram` object or a object that can be coerced to `dendrogram` class.") |
|
1167 |
+ stop_wrap("the clustering function must return a `dendrogram` object or a object that can be coerced to `dendrogram` class.") |
|
1151 | 1168 |
} |
1152 | 1169 |
dend_list[[i]] = obj |
1153 | 1170 |
} |
... | ... |
@@ -1201,11 +1218,11 @@ make_cluster = function(object, which = c("row", "column")) { |
1201 | 1218 |
|
1202 | 1219 |
if(which == "row") { |
1203 | 1220 |
if(length(reorder) != nrow(mat)) { |
1204 |
- stop("weight of reordering should have same length as number of rows\n") |
|
1221 |
+ stop_wrap("weight of reordering should have same length as number of rows\n") |
|
1205 | 1222 |
} |
1206 | 1223 |
} else { |
1207 | 1224 |
if(length(reorder) != ncol(mat)) { |
1208 |
- stop("weight of reordering should have same length as number of columns\n") |
|
1225 |
+ stop_wrap("weight of reordering should have same length as number of columns\n") |
|
1209 | 1226 |
} |
1210 | 1227 |
} |
1211 | 1228 |
for(i in seq_along(dend_list)) { |
... | ... |
@@ -1240,11 +1257,11 @@ make_cluster = function(object, which = c("row", "column")) { |
1240 | 1257 |
|
1241 | 1258 |
if(which == "row") { |
1242 | 1259 |
if(nrow(mat) != length(order)) { |
1243 |
- stop(qq("Number of rows in the matrix are not the same as the length of the cluster or the @{which} orders.")) |
|
1260 |
+ stop_wrap(qq("Number of rows in the matrix are not the same as the length of the cluster or the @{which} orders.")) |
|
1244 | 1261 |
} |
1245 | 1262 |
} else { |
1246 | 1263 |
if(ncol(mat) != length(order)) { |
1247 |
- stop(qq("Number of columns in the matrix are not the same as the length of the cluster or the @{which} orders.")) |
|
1264 |
+ stop_wrap(qq("Number of columns in the matrix are not the same as the length of the cluster or the @{which} orders.")) |
|
1248 | 1265 |
} |
1249 | 1266 |
} |
1250 | 1267 |
|
... | ... |
@@ -1269,7 +1286,7 @@ make_cluster = function(object, which = c("row", "column")) { |
1269 | 1286 |
} else if(length(gap) == n_slice - 1) { |
1270 | 1287 |
gap = unit.c(gap, unit(0, "mm")) |
1271 | 1288 |
} else if(length(gap) != n_slice) { |
1272 |
- stop(qq("Length of `gap` should be 1 or number of @{which} slices.")) |
|
1289 |
+ stop_wrap(qq("Length of `gap` should be 1 or number of @{which} slices.")) |
|
1273 | 1290 |
} |
1274 | 1291 |
object@matrix_param[[ paste0(which, "_gap") ]] = gap |
1275 | 1292 |
|
... | ... |
@@ -1292,7 +1309,7 @@ make_cluster = function(object, which = c("row", "column")) { |
1292 | 1309 |
}) |
1293 | 1310 |
} else if(grepl("\\{.+\\}", title)) { |
1294 | 1311 |
if(!requireNamespace("glue")) { |
1295 |
- stop("You need to install glue package.") |
|
1312 |
+ stop_wrap("You need to install glue package.") |
|
1296 | 1313 |
} |
1297 | 1314 |
title = apply(unique(split), 1, function(x) { |
1298 | 1315 |
x = x |
... | ... |
@@ -1371,7 +1388,7 @@ setMethod(f = "draw", |
1371 | 1388 |
upViewport() |
1372 | 1389 |
} else { |
1373 | 1390 |
if(ncol(object@matrix) == 0) { |
1374 |
- stop("Single heatmap should contains a matrix with at least one column. Zero-column matrix can only be appended to the heatmap list.") |
|
1391 |
+ stop_wrap("Single heatmap should contains a matrix with at least one column. Zero-column matrix can only be appended to the heatmap list.") |
|
1375 | 1392 |
} |
1376 | 1393 |
ht_list = new("HeatmapList") |
1377 | 1394 |
ht_list = add_heatmap(ht_list, object) |
... | ... |
@@ -399,9 +399,6 @@ setMethod(f = "make_layout", |
399 | 399 |
object@heatmap_param$width = object@heatmap_param$width + sum(row_gap[seq_len(nr_slice-1)]) |
400 | 400 |
} |
401 | 401 |
} else { |
402 |
- if(!is.unit(object@heatmap_param$width)) { |
|
403 |
- warning("width of the heatmap can only be set as an absolute unit.") |
|
404 |
- } |
|
405 | 402 |
object@heatmap_param$width = unit(1, "npc") |
406 | 403 |
} |
407 | 404 |
|
... | ... |
@@ -145,12 +145,12 @@ HeatmapAnnotation = function(..., |
145 | 145 |
##### pull all annotation to `anno_value_list`#### |
146 | 146 |
if("df" %in% called_args) { |
147 | 147 |
if(is.matrix(df)) { |
148 |
- warning("`df` should be a data frame while not a matrix. Convert it to data frame.") |
|
148 |
+ warning_wrap("`df` should be a data frame while not a matrix. Convert it to data frame.") |
|
149 | 149 |
df = as.data.frame(df) |
150 | 150 |
} else if(!is.data.frame(df)) { |
151 | 151 |
oe = try(df <- as.data.frame(df), silent = TRUE) |
152 | 152 |
if(inherits(oe, "try-errir")) { |
153 |
- stop("`df` should be a data frame.") |
|
153 |
+ stop_wrap("`df` should be a data frame.") |
|
154 | 154 |
} |
155 | 155 |
} |
156 | 156 |
} |
... | ... |
@@ -158,7 +158,7 @@ HeatmapAnnotation = function(..., |
158 | 158 |
anno_arg_list = list(...) |
159 | 159 |
if("df" %in% called_args && length(anno_arg_list)) { |
160 | 160 |
if(any(duplicated(c(names(df), names(anno_arg_list))))) { |
161 |
- stop("Annotation names are duplicated. Check the column names of `df`.") |
|
161 |
+ stop_wrap("Annotation names are duplicated. Check the column names of `df`.") |
|
162 | 162 |
} |
163 | 163 |
} |
164 | 164 |
|
... | ... |
@@ -190,12 +190,12 @@ HeatmapAnnotation = function(..., |
190 | 190 |
if(all(sapply(annotation_legend_param, inherits, "list"))) { # if it is a list of lists |
191 | 191 |
nl = length(annotation_legend_param) |
192 | 192 |
if(nl > n_simple_anno) { |
193 |
- stop("Amount of legend params is larger than the number of simple annotations.") |
|
193 |
+ stop_wrap("Amount of legend params is larger than the number of simple annotations.") |
|
194 | 194 |
} |
195 | 195 |
if(is.null(names(annotation_legend_param))) { |
196 | 196 |
names(annotation_legend_param) = simple_anno_name[seq_len(nl)] |
197 | 197 |
} else if(length(setdiff(names(annotation_legend_param), simple_anno_name))) { |
198 |
- stop("Some names in 'annotation_legend_param' are not in names of simple annotations.") |
|
198 |
+ stop_wrap("Some names in 'annotation_legend_param' are not in names of simple annotations.") |
|
199 | 199 |
} else { |
200 | 200 |
annotation_legend_param = annotation_legend_param[ intersect(simple_anno_name, names(annotation_legend_param)) ] |
201 | 201 |
} |
... | ... |
@@ -539,8 +539,8 @@ setMethod(f = "draw", |
539 | 539 |
|
540 | 540 |
if(test2) { |
541 | 541 |
grid.newpage() |
542 |
- if(which == "column") pushViewport(viewport(width = unit(1, "npc") - unit(2, "cm"), height = object@height)) |
|
543 |
- if(which == "row") pushViewport(viewport(height = unit(1, "npc") - unit(2, "cm"), width = object@width)) |
|
542 |
+ if(which == "column") pushViewport(viewport(width = unit(1, "npc") - unit(3, "cm"), height = object@height)) |
|
543 |
+ if(which == "row") pushViewport(viewport(height = unit(1, "npc") - unit(3, "cm"), width = object@width)) |
|
544 | 544 |
} else { |
545 | 545 |
pushViewport(viewport(...)) |
546 | 546 |
} |
... | ... |
@@ -571,7 +571,7 @@ setMethod(f = "draw", |
571 | 571 |
oe = try(draw(object@anno_list[[i]], index, k, n)) |
572 | 572 |
if(inherits(oe, "try-error")) { |
573 | 573 |
cat("Error when drawing annotation '", object@anno_list[[i]]@name, "'\n", sep = "") |
574 |
- stop(oe) |
|
574 |
+ stop_wrap(oe) |
|
575 | 575 |
} |
576 | 576 |
upViewport() |
577 | 577 |
} |
... | ... |
@@ -581,7 +581,7 @@ setMethod(f = "draw", |
581 | 581 |
oe = try(draw(object@anno_list[[i]], index, k, n)) |
582 | 582 |
if(inherits(oe, "try-error")) { |
583 | 583 |
cat("Error when drawing annotation '", object@anno_list[[i]]@name, "'\n", sep = "") |
584 |
- stop(oe) |
|
584 |
+ stop_wrap(oe) |
|
585 | 585 |
} |
586 | 586 |
upViewport() |
587 | 587 |
} |
... | ... |
@@ -653,7 +653,11 @@ setMethod(f = "show", |
653 | 653 |
paste0(object@anno_list[[i]]@color_mapping@type, " vector") |
654 | 654 |
} |
655 | 655 |
} else if(inherits(object@anno_list[[i]]@fun, "AnnotationFunction")) { |
656 |
- "AnnotationFunction" |
|
656 |
+ if(object@anno_list[[i]]@fun@fun_name != "") { |
|
657 |
+ paste0(object@anno_list[[i]]@fun@fun_name, "()") |
|
658 |
+ } else { |
|
659 |
+ "AnnotationFunction" |
|
660 |
+ } |
|
657 | 661 |
} else if(inherits(object@anno_list[[i]]@fun, "function")) { |
658 | 662 |
"function" |
659 | 663 |
} else { |
... | ... |
@@ -86,6 +86,7 @@ setMethod(f = "make_layout", |
86 | 86 |
main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1], |
87 | 87 |
padding = NULL, |
88 | 88 |
|
89 |
+ auto_adjust = TRUE, |
|
89 | 90 |
row_dend_side = c("original", "left", "right"), |
90 | 91 |
row_sub_title_side = c("original", "left", "right"), |
91 | 92 |
column_dend_side = c("original", "top", "bottom"), |
... | ... |
@@ -423,6 +424,7 @@ setMethod(f = "make_layout", |
423 | 424 |
} |
424 | 425 |
} |
425 | 426 |
object@ht_list_param$padding = padding |
427 |
+ object@ht_list_param$auto_adjust = auto_adjust |
|
426 | 428 |
|
427 | 429 |
## orders of other heatmaps should be changed |
428 | 430 |
if(direction == "horizontal") { |
... | ... |
@@ -446,6 +448,30 @@ setMethod(f = "make_layout", |
446 | 448 |
} |
447 | 449 |
if(verbose) qqcat("adjust column order for all other heatmaps\n") |
448 | 450 |
} |
451 |
+ |
|
452 |
+ if(auto_adjust) { |
|
453 |
+ if(direction == "horizontal") { |
|
454 |
+ for(i in seq_len(n_ht)) { |
|
455 |
+ if(inherits(object@ht_list[[i]], "Heatmap")) { |
|
456 |
+ if(i == 1 && !is.null(object@ht_list[[i]]@row_names_param$anno) && object@ht_list[[i]]@row_names_param$side == "left") { |
|
457 |
+ } else if(i == n_ht && !is.null(object@ht_list[[i]]@row_names_param$anno) && object@ht_list[[i]]@row_names_param$side == "right") { |
|
458 |
+ } else { |
|
459 |
+ object@ht_list[[i]]@row_names_param$anno = NULL |
|
460 |
+ object@ht_list[[i]]@row_names_param$show = FALSE |
|
461 |
+ } |
|
462 |
+ } |
|
463 |
+ } |
|
464 |
+ } else { |
|
465 |
+ for(i in seq_len(n_ht)) { |
|
466 |
+ if(inherits(object@ht_list[[i]], "Heatmap") & i != i_main) { |
|
467 |
+ object@ht_list[[i]]@column_order_list = ht_main@column_order_list |
|
468 |
+ object@ht_list[[i]]@column_order = ht_main@column_order |
|
469 |
+ object@ht_list[[i]]@column_dend_param$show = FALSE |
|
470 |
+ object@ht_list[[i]]@column_dend_param$cluster = FALSE # don't do clustering because cluster was already done |
|
471 |
+ } |
|
472 |
+ } |
|
473 |
+ } |
|
474 |
+ } |
|
449 | 475 |
|
450 | 476 |
if(direction == "horizontal") { |
451 | 477 |
# update other heatmaps' row titles |
... | ... |
@@ -187,7 +187,7 @@ SingleAnnotation = function(name, value, col, fun, |
187 | 187 |
.Object@name = name |
188 | 188 |
|
189 | 189 |
if(!name_rot %in% c(0, 90, 180, 270)) { |
190 |
- stop("`name_rot` can only take values in c(0, 90, 180, 270)") |
|
190 |
+ stop_wrap("@{name}: `name_rot` can only take values in c(0, 90, 180, 270)") |
|
191 | 191 |
} |
192 | 192 |
|
193 | 193 |
if(verbose) qqcat("create a SingleAnnotation with name '@{name}'\n") |
... | ... |
@@ -242,7 +242,7 @@ SingleAnnotation = function(name, value, col, fun, |
242 | 242 |
if(which == "column") { |
243 | 243 |
if(verbose) qqcat("@{name}: it is a column annotation\n") |
244 | 244 |
if(!name_side %in% c("left", "right")) { |
245 |
- stop("`name_side` should be 'left' or 'right' when it is a column annotation.") |
|
245 |
+ stop_wrap("@{name}: `name_side` should be 'left' or 'right' when it is a column annotation.") |
|
246 | 246 |
} |
247 | 247 |
if(verbose) qqcat("@{name}: adjust positions of annotation names\n") |
248 | 248 |
if(name_side == "left") { |
... | ... |
@@ -305,7 +305,7 @@ SingleAnnotation = function(name, value, col, fun, |
305 | 305 |
} else if(which == "row") { |
306 | 306 |
if(verbose) qqcat("@{name}: it is a row annotation\n") |
307 | 307 |
if(!name_side %in% c("top", "bottom")) { |
308 |
- stop("`name_side` should be 'left' or 'right' when it is a column annotation.") |
|
308 |
+ stop_wrap("@{name}: `name_side` should be 'left' or 'right' when it is a column annotation.") |
|
309 | 309 |
} |
310 | 310 |
if(verbose) qqcat("@{name}: adjust positions of annotation names\n") |
311 | 311 |
if(name_side == "top") { |
... | ... |
@@ -413,7 +413,7 @@ SingleAnnotation = function(name, value, col, fun, |
413 | 413 |
|
414 | 414 |
gp = check_gp(gp) |
415 | 415 |
if(!is.null(gp$fill)) { |
416 |
- stop("You should not set `fill`.") |
|
416 |
+ stop_wrap("@{name}: You should not set `fill`.") |
|
417 | 417 |
} |
418 | 418 |
|
419 | 419 |
if(missing(fun)) { |
... | ... |
@@ -479,7 +479,7 @@ SingleAnnotation = function(name, value, col, fun, |
479 | 479 |
if(!is.null(f_which)) { |
480 | 480 |
fun_name = fun@fun_name |
481 | 481 |
if(f_which != which) { |
482 |
- stop(paste0("You are putting ", fun_name, "() as ", which, " annotations, you need to set 'which' argument to '", which, "' as well,\nor use the helper function ", which, "_", fun_name, "().")) |
|
482 |
+ stop_wrap("You are putting @{fun_name} as @{which} annotations, you need to set 'which' argument to '@{which}' as well, or use the helper function @{which}_@{fun_name}().") |
|
483 | 483 |
} |
484 | 484 |
} |
485 | 485 |
|
... | ... |
@@ -545,7 +545,7 @@ setMethod(f = "draw", |
545 | 545 |
if(missing(index)) { |
546 | 546 |
if(has_AnnotationFunction(object)) { |
547 | 547 |
if(object@fun@n == 0) { |
548 |
- stop("Cannot infer the number of Observations in the annotation function, you need to provide `index`.") |
|
548 |
+ stop_wrap("Cannot infer the number of Observations in the annotation function, you need to provide `index`.") |
|
549 | 549 |
} |
550 | 550 |
index = seq_len(object@fun@n) |
551 | 551 |
} |
... | ... |
@@ -737,7 +737,7 @@ has_AnnotationFunction = function(single_anno) { |
737 | 737 |
return(x2) |
738 | 738 |
} |
739 | 739 |
} |
740 |
- stop("This SingleAnnotation object is not allowed for subsetting.") |
|
740 |
+ stop_wrap("This SingleAnnotation object is not allowed for subsetting.") |
|
741 | 741 |
|
742 | 742 |
} else if(nargs() == 1) { |
743 | 743 |
return(x) |
... | ... |
@@ -141,8 +141,8 @@ ht_global_opt = ht_opt |
141 | 141 |
DENDROGRAM_PADDING = unit(0.5, "mm") |
142 | 142 |
DIMNAME_PADDING = unit(1, "mm") |
143 | 143 |
TITLE_PADDING = unit(2.5, "mm") |
144 |
-COLUMN_ANNO_PADDING = unit(0.5, "mm") |
|
145 |
-ROW_ANNO_PADDING = unit(0.5, "mm") |
|
144 |
+COLUMN_ANNO_PADDING = unit(1, "mm") |
|
145 |
+ROW_ANNO_PADDING = unit(1, "mm") |
|
146 | 146 |
|
147 | 147 |
GLOBAL_PADDING = unit(c(2, 2, 2, 2), "mm") |
148 | 148 |
|
... | ... |
@@ -364,19 +364,19 @@ dev.null = function(...) { |
364 | 364 |
} |
365 | 365 |
|
366 | 366 |
stop_wrap = function (...) { |
367 |
- x = paste0(...) |
|
367 |
+ x = qq(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 = paste0(...) |
|
373 |
+ x = qq(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 = paste0(...) |
|
379 |
+ x = qq(paste0(...)) |
|
380 | 380 |
x = paste(strwrap(x), collapse = "\n") |
381 | 381 |
message(x) |
382 | 382 |
} |
... | ... |
@@ -465,7 +465,7 @@ normalize_graphic_param_to_mat = function(x, nc, nr, name) { |
465 | 465 |
if(nrow(x) == nr && ncol(x) == nc) { |
466 | 466 |
return(x) |
467 | 467 |
} else { |
468 |
- stop(paste0(name, "needs to be a matrix with ", nc, " columns and ", nr, " rows.")) |
|
468 |
+ stop_wrap(paste0(name, "needs to be a matrix with ", nc, " columns and ", nr, " rows.")) |
|
469 | 469 |
} |
470 | 470 |
} else { |
471 | 471 |
if(length(x) == nc) { |
... | ... |
@@ -475,7 +475,7 @@ normalize_graphic_param_to_mat = function(x, nc, nr, name) { |
475 | 475 |
} else if(length(x) == 1) { |
476 | 476 |
return(matrix(x, ncol = nc, nrow = nr)) |
477 | 477 |
} else { |
478 |
- stop(paste0("Since ", name, " is a vector, it should have length of ", nc, " or ", nr, ".")) |
|
478 |
+ stop_wrap(paste0("Since ", name, " is a vector, it should have length of ", nc, " or ", nr, ".")) |
|
479 | 479 |
} |
480 | 480 |
} |
481 | 481 |
} |
... | ... |
@@ -585,7 +585,7 @@ pindex = function(m, i, j) { |
585 | 585 |
dim(v) = c(dm[1]*dm[2], dm[3]) |
586 | 586 |
v[ind, , drop = FALSE] |
587 | 587 |
} else { |
588 |
- stop("dimension of `m` can only be 2 and 3.") |
|
588 |
+ stop_wrap("dimension of `m` can only be 2 and 3.") |
|
589 | 589 |
} |
590 | 590 |
} |
591 | 591 |
|