File: coef.R

package info (click to toggle)
cluster 2.0.7-1-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,496 kB
  • sloc: ansic: 2,981; fortran: 123; sh: 18; makefile: 2
file content (43 lines) | stat: -rw-r--r-- 1,368 bytes parent folder | download | duplicates (5)
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
#### R-interface to  Agglomerative / Divisive coefficient
####
coef.twins <- function(object, ...)
{
    if(inherits(object, "agnes"))
	object$ac
    else if(inherits(object, "diana"))
	object$dc
    else
	stop("invalid 'twins' object")
}

coef.hclust <- function(object, ...)
{
    ## Author: Martin Maechler, Date: 27 Nov 2004
    ## Now "really" using $merge _and_ $height -- assuming they match!
    ht  <- object$height
    mrg <- object$merge
    nh <- length(ht)
    stopifnot(nh > 0, is.matrix(mrg), dim(mrg) == c(nh,2),
              is.numeric(ht), is.numeric(mrg),
              !is.unsorted(ht))# then they match with merge
    ## stopifnot(all.equal(1:n, sort(-mrg[mrg < 0])))

    1 - sum(rowSums(mrg < 0) * ht) / max(ht) / (nh+1)
}


## Note this is (the only!) direct interface to   bncoef(),
## ---- which is used internally both in agnes() and diana() :
coefHier <- function(object)
{
    ## Purpose: Compute agglomerative *or* divisive  coefficient from hclust/agnes/diana
    ## ----------------------------------------------------------------------
    ## Author: Martin Maechler, Date: 27 Nov 2004
    nh <- length(ht <- object$height)
    stopifnot(nh > 0, is.numeric(ht))
    .C(R_bncoef,
       n =  as.integer(nh + 1L),
       ban= as.double(c(0., ht)),# <-- is this really tbe  ban[]nner, as in ../src/twins.c ?
       cf = double(1))$cf
}