diff --git a/R/gghmap.R b/R/gghmap.R index 9522380..394d73f 100644 --- a/R/gghmap.R +++ b/R/gghmap.R @@ -24,6 +24,7 @@ gghmap <- function(x, prop = FALSE, ...) { + scale <- match.arg(scale) if (inherits(x, "dist")) { # scale and distFun are ignored! diff --git a/R/hmap.R b/R/hmap.R index 747481b..62ab814 100644 --- a/R/hmap.R +++ b/R/hmap.R @@ -61,9 +61,13 @@ hmap <- function(x, o_row <- seriate(dist_row, method = method, control = control)[[1]] + #o_row <- ser_align(list(ser_permutation_vector(order(rowMeans(x, na.rm = TRUE), decreasing = TRUE)), o_row))[[2]] + dist_col <- distfun(t(x)) o_col <- seriate(dist_col, method = method, control = control)[[1]] + + #o_col <- ser_align(list(ser_permutation_vector(order(colMeans(x, na.rm = TRUE), decreasing = FALSE)), o_col))[[2]] } diff --git a/R/seriate.array.R b/R/seriate.array.R index 52b813a..e126ac8 100644 --- a/R/seriate.array.R +++ b/R/seriate.array.R @@ -30,9 +30,6 @@ ## add ... to control control <- c(control, list(...)) - ## margin 1...rows, 2...cols, ... - #if(is.null(method)) method <- "PCA" - #else if (!is.character(method) || (length(method) != 1L)) stop("Argument 'method' must be a character string.") diff --git a/R/seriate_heatmap.R b/R/seriate_heatmap.R index c071933..fd5ce89 100644 --- a/R/seriate_heatmap.R +++ b/R/seriate_heatmap.R @@ -19,17 +19,28 @@ ## calculate distances for rows and columns, perform hclust and reorder. .heatmap_contr <- list( - dist_fun = dist, - seriation_method = "OLO", - seriation_control = NULL, - scale = c("none"), + dist_fun = list(row = dist, col = dist), + seriation_method = list(row = "OLO", col = "OLO"), + seriation_control = list(row = NULL, col = NULL), + scale = "none", verbose = FALSE ) seriate_matrix_heatmap <- function(x, control = NULL) { control <- .get_parameters(control, .heatmap_contr) - control$scale <- match.arg(control$scale, choices = c("none", "row", "column")) + if (length(control$dist_fun) == 1L) + control$dist_fun <- + list(row = control$dist_fun, + col = control$dist_fun) + if (length(control$seriation_method) == 1L) + control$seriation_method <- + list(row = control$seriation_method, + col = control$seriation_method) + if (length(control$seriation_control) == 1L) + control$seriation_control <- + list(row = control$seriation_control, + col = control$seriation_control) if (!is.null(control$scale)) { if (control$scale == "row") @@ -38,15 +49,15 @@ seriate_matrix_heatmap <- function(x, control = NULL) { x <- scale(x) } - dist_row <- control$dist_fun(x) - o_row <- seriate(dist_row, - method = control$seriation_method, - control = control$seriation_control)[[1]] + d <- control$dist_fun$row(x) + o_row <- seriate(d, + method = control$seriation_method$row, + control = control$seriation_control$row) - dist_col <- control$dist_fun(t(x)) - o_col <- seriate(dist_col, - method = control$seriation_method, - control = control$seriation_control)[[1]] + d <- control$dist_fun$col(t(x)) + o_col <- seriate(d, + method = control$seriation_method$col, + control = control$seriation_control$col) #names(row) <- rownames(x)[get_order(o_row)] #names(col) <- colnames(x)[get_order(o_col)] @@ -58,6 +69,6 @@ set_seriation_method( "matrix", "Heatmap", seriate_matrix_heatmap, - "Calculate distances for row and column vectors, perform hierarchical clustering and reorder the dentrograms.", + "Calculate distances for row and column vectors, and seriate. If only a single distance function or seriation method is specified, then it is used for rows and columns. The default seriation method is optimal leaf ordering (OLO) which perform hierarchical clustering and reorder the dentrograms.", .heatmap_contr ) diff --git a/man/bertinplot.Rd b/man/bertinplot.Rd index 7a2af7a..ff22af0 100644 --- a/man/bertinplot.Rd +++ b/man/bertinplot.Rd @@ -43,7 +43,7 @@ ggbertinplot(x, order = NULL, geom = "bar", highlight = TRUE, \code{panel.lines}. For circles and squares neg. values are represented by a dashed border. For blocks all blocks are the same size (can be used with \code{shading=TRUE}).} - \item{geom}{ visulization type. Available geometries are: "tile", "rectangle", "circle", "line", "bar", "none".} + \item{geom}{ visualization type. Available geometries are: "tile", "rectangle", "circle", "line", "bar", "none".} \item{highlight}{ a logical scalar indicating whether to use highlighting. If \code{TRUE}, all variables with values greater than the variable-wise mean are highlighted. To control highlighting, also a @@ -163,9 +163,9 @@ if (require("ggplot2")) { scale_fill_gradient2(low = "darkblue", high = "darkred", midpoint = mean(x)) # Custom geom (geom = "none"). Defined variables are row, col, and x for the value - ggbertinplot(x, order, geom = "none", prop = TRUE) + + ggbertinplot(x, order, geom = "none", prop = FALSE) + geom_point(aes(x = col, y = row, size = x, color = x > 30), pch = 15) + - scale_size(range = c(1, 12)) + scale_size(range = c(1, 10)) # Use a ggplot2 theme with theme_set() old_theme <- theme_set(theme_minimal() + diff --git a/man/hmap.Rd b/man/hmap.Rd index 523f499..67bb6bb 100644 --- a/man/hmap.Rd +++ b/man/hmap.Rd @@ -113,10 +113,10 @@ hmap(d, method = "OLO", main = "Wood (Euclidean distances)") # order-based with dissimilarity matrices hmap(Wood, method = "MDS_angle", showdist = "both", col = greenred(100), col_dist = greens(100), - key.lab = "norm. Expression", main = "Wood (reporderd with distances)") + keylab = "norm. Expression", main = "Wood (reporderd with distances)") # Manually seriate and plot as pimage. -o <- seriate(Wood, method = "heatmap", control = list(distfun = dist, seriationMethod = "OLO")) +o <- seriate(Wood, method = "heatmap", control = list(dist_fun = dist, seriation_method = "OLO")) o pimage(Wood, o, prop = FALSE) @@ -151,7 +151,8 @@ if (require("ggplot2")) { # Note: the ggplot2-based version cannot show distance matrices in the same plot. # Manually seriate and plot as pimage. - o <- seriate(Wood, method = "heatmap", control = list(distfun = dist, seriationMethod = "OLO")) + o <- seriate(Wood, method = "heatmap", control = list(dist_fun = dist, + seriation_method = "OLO")) o ggpimage(Wood, o, prop = FALSE)