testingDP/color_branches.R at master · darwinalexander/testingDP · GitHub

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
 color_branches <-  function (tree, k = NULL, h = NULL, col, groupLabels = NULL,
                     warn = dendextend_options("warn"), ...)
{
  old_labels <- labels(tree)
  labels_arent_unique <- !all_unique(old_labels)
  if (labels_arent_unique) {
    if (warn)
      warning("Your tree labels are NOT unique!\n This may cause an un expected issue with the color of the branches.\n Hence, your labels were temporarily turned unique (and then fixed as they were before).")
    labels(tree) <- seq_along(old_labels)
  }
  if (missing(col))
    col <- rainbow_fun
  if (is.null(k) & is.null(h)) {
    if (warn)
      warning("k (number of clusters) is missing, using the tree size as a default")
    k <- nleaves(tree)
  }
  if (!is.dendrogram(tree) && !is.hclust(tree))
    stop("tree needs to be either a dendrogram or an hclust object")
  g <- dendextend::cutree(tree, k = k, h = h, order_clusters_as_data = FALSE,
                          sort_cluster_numbers = TRUE)
  if (is.hclust(tree))
    tree <- as.dendrogram(tree)
  k <- max(g)
  if (k == 0L) {
    if (warn)
      warning("Tree has only one level - returning the dendrogram with no colors.")
    return(tree)
  }
  if (is.function(col)) {
    col <- col(k)
  }
  else {
    if (length(col) < k) {
      warning("Length of color vector was shorter than the number of clusters - color vector was recycled")
      col <- rep(col, length.out = k)
    }
    if (length(col) > k) {
      warning("Length of color vector was longer than the number of clusters - first k elements are used")
      col <- col[seq_len(k)]
    }
  }
  if (!is.null(groupLabels)) {
    if (length(groupLabels) == 1) {
      if (is.function(groupLabels))
        groupLabels = groupLabels(seq.int(length.out = k))
      else if (is.logical(groupLabels)) {
        if (groupLabels)
          groupLabels = seq.int(length.out = k)
        else groupLabels = NULL
      }
    }
    if (!is.null(groupLabels) && length(groupLabels) != k)
      stop("Must give same number of group labels as clusters")
  }
  addcol <- function(dend_node, col) {
    if (is.null(attr(dend_node, "edgePar"))) {
      attr(dend_node, "edgePar") <- list(col = col)
    }
    else {
      attr(dend_node, "edgePar")[["col"]] <- col
    }
    unclass(dend_node)
  }
  descendTree <- function(sd) {
    groupsinsubtree = unique(g[labels(sd)])
    if (length(groupsinsubtree) > 1) {
      for (i in seq(sd)) sd[[i]] <- descendTree(sd[[i]])
    }
    else {
      sd = dendrapply(sd, addcol, col[groupsinsubtree])
      if (!is.null(groupLabels)) {
        attr(sd, "edgetext") = groupLabels[groupsinsubtree]
        attr(sd, "edgePar") = c(attr(sd, "edgePar"),
                                list(p.border = col[groupsinsubtree]))
      }
    }
    unclass(sd)
  }
  if (!is.character(labels(tree)))
    labels(tree) <- as.character(labels(tree))
  tree <- descendTree(tree)
  class(tree) <- "dendrogram"
  if (labels_arent_unique)
    labels(tree) <- old_labels
  tree
}
# <environment: namespace:dendextend>


 ## Nuevas modificacioens

<<<<<<< HEAD
 1+2

 3+5

 5+5
 # DP
=======


 ##Wincho pelotas

1+1
>>>>>>> 6f173b9b99fb2a11baeeb1e9a4909c4ba71e9166