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
|
midDend.local <-
function (x) if (is.null(mp <- attr(x, "midpoint"))) 0 else mp
memberDend.local <-
function (x) if (is.null(r <- attr(x, "members"))) 1 else r
isLeaf.local <-
function (x) (is.logical(L <- attr(x, "leaf"))) && L
midCacheDend.local <- function (x)
{
stopifnot(inherits(x, "dendrogram"))
setmid <- function(d)
{
if (isLeaf.local(d))
return(d)
k <- length(d)
if (k < 1)
stop("dendrogram node with non-positive #{branches}")
r <- d
midS <- 0
for (j in 1:k)
{
r[[j]] <- unclass(setmid(d[[j]]))
midS <- midS + midDend.local(r[[j]])
}
if (k == 2)
attr(r, "midpoint") <- (memberDend.local(d[[1]]) + midS) / 2
else
attr(r, "midpoint") <- midDend.local(d)
r
}
setmid(x)
}
revDend.local <- function (x)
{
if (isLeaf.local(x))
return(x)
k <- length(x)
if (k < 1)
stop("dendrogram non-leaf node with non-positive #{branches}")
r <- x
for (j in 1:k)
r[[j]] <- revDend.local(x[[k + 1 - j]])
midCacheDend.local(r)
}
|
