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
|
#' Does a dendrogram has an edgePar/nodePar component?
#' @export
#' @aliases
#' has_edgePar
#' has_nodePar
#'
#' @param dend a \link{dendrogram} object.
#' @param component a character value to be checked if exists in the tree. For edgePar the list: "col", "lty" and "lwd" (for the segments),
#' "p.col", "p.lwd", and "p.lty" (for the polygon around the text) and "t.col" for the text color.
#' For edgePar "pch", "cex", "col", "xpd", and/or "bg".
#' @param the_attrib A character of the attribute for which to check the existence of the component.
#' Often either "edgePar" or "nodePar".
#' @param ... ignored
#'
#' @seealso \link{get_nodes_attr}, \link{set}
#' @return
#' Logical. TRUE if such a component is defined somewhere in the tree, FALSE otherwise.
#' If dend is not a dendrogram, the function will return FALSE.
#'
#' @examples
#'
#' dat <- iris[1:20,-5]
#' hca <- hclust(dist(dat))
#' hca2 <- hclust(dist(dat), method = "single")
#' dend <- as.dendrogram(hca)
#' dend2 <- as.dendrogram(hca2)
#'
#' dend %>% set("branches_lwd", 2) %>% set("branches_lty", 2) %>% plot
#' dend %>% set("branches_lwd", 2) %>% set("branches_lty", 2) %>% has_edgePar("lty")
#' dend %>% set("branches_lwd", 2) %>% has_edgePar("lty")
#' dend %>% set("branches_lwd", 2) %>% has_edgePar("lwd")
#'
#' dend %>% set("branches_lwd", 2) %>% set("clear_branches") %>% has_edgePar("lwd")
#'
has_component_in_attribute <- function(dend, component, the_attrib = "edgePar", ...) {
if(!is.dendrogram(dend)) return(FALSE)
list_of_names <- dend %>% get_nodes_attr(the_attrib, simplify = FALSE) %>% lapply(names)
has_component_fun <- function(node_names) any(node_names %in% component)
has_component <- list_of_names %>% lapply(has_component_fun) %>% unlist %>% any
has_component
}
#' @export
has_edgePar <- function(dend, component, the_attrib = "edgePar", ...) {
has_component_in_attribute(dend, component, the_attrib, ...)
}
#' @export
has_nodePar <- function(dend, component, the_attrib = "nodePar", ...) {
has_component_in_attribute(dend, component, the_attrib, ...)
}
|
