File: seriate_dendrogram.R

package info (click to toggle)
r-cran-dendextend 1.9.0%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 2,880 kB
  • sloc: sh: 13; makefile: 2
file content (81 lines) | stat: -rw-r--r-- 3,126 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
# Copyright (C) Tal Galili
#
# This file is part of dendextend.
#
# dendextend is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# dendextend is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  http://www.r-project.org/Licenses/
#









#' @title Rotates a dendrogram based on a seriation of a distance matrix
#' @export
#' @description
#' Rotates a dendrogram so it confirms to an order of a provided distance object.
#' The seriation algorithm is based on \link[seriation]{seriate}, which tries to find
#' a linear order for objects using data in form of a dissimilarity matrix (one mode data).
#'
#' This is useful for heatmap visualization.
#'
#' @param dend An object of class \link{dendrogram} or \link{hclust}
#' @param x a \link{dist} object.
#' @param method a character vector of either "OLO" or "GW":
#' "OLO" - Optimal leaf ordering, optimzes the Hamiltonian path length that is restricted by the dendrogram structure - works in O(n^4)
#' "GW" - Gruvaeus and Wainer heuristic to optimze the Hamiltonian path length that is restricted by the dendrogram structure
#'
#' @param ... parameters passed to \link[seriation]{seriate}
#' @return
#' A dendrogram that is rotated based on the optimal ordering of the distance matrix
#' @seealso \code{\link[dendextend]{rotate}}, \link[seriation]{seriate}
#' @examples
#' \dontrun{
#' # library(dendextend)
#' d <- dist(USArrests)
#' hc <- hclust(d, "ave")
#' dend <- as.dendrogram(hc)
#'
#' heatmap(as.matrix(USArrests))
#'
#' dend2 <- seriate_dendrogram(dend, d)
#' heatmap(as.matrix(USArrests), Rowv = dend)
#'
#'
#' }
seriate_dendrogram <- function(dend, x, method = c("OLO", "GW"), ...) {

   if(!requireNamespace("seriation")) stop("Please first install seriation:\n install.packages('seriaten') ")

   if(!is.dendrogram(dend) & !is.hclust(dend)) stop("dend must be either a dendrogram or an hclust object")
   if(!is.dist(x)) stop("x must be a dist object")
   if(!identical(sort(labels(x)), sort(labels(dend)))) stop("The labels of dend and x must be identical.")
   method <- match.arg(method)

   # o <- seriate(d, method = "GW", control = list(hclust = as.hclust(dend)) )
   # get_order(o)
   # library(seriation)
   # hmap(sqrt(d2), Colv = "none", trace = "none", col = viridis(200))
   # Error in (function (x, Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE,  :
   #                       formal argument "Colv" matched by multiple actual arguments
   o <- seriation::seriate(x, method = method, control = list(hclust = as.hclust(dend)), ... )
   # library(dendextend)
   dend <- rotate(dend, order = rev(labels(x)[seriation::get_order(o)]))
   dend
}