fixed heatmap seriation code.

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!

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]]
   }
 
 

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.")
 

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
 )

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() +

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)