File: internal.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 (39 lines) | stat: -rw-r--r-- 1,343 bytes parent folder | download | duplicates (3)
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
#### Cluster - Internal Utilities
#### ============================ (new by Martin Maechler)

## This was size(); seems slightly useful in general
sizeDiss <- function(d)
{
    ## find 'n' for d == dissimilarity-like(<n obs.>), i.e. length(d)= n(n-1)/2
    discr <- 1 + 8 * length(d)
    sqrtdiscr <- round(sqrt(discr))
    if(sqrtdiscr^2 == discr) (1 + sqrtdiscr)/2 else NA
}

##' Return indices to *permute*  "dissimilarity" / "dist" entries for C (ex-Fortran) code setup
##'
##' Currently always used as:
##'   n <- attr(x, "Size")
##'   dv <- x[lower.to.upper.tri.inds(n)]
##' -->> FIXME: eventually do the above directly in C
##' @param n "Size" = number of objects, underlying the dist/dissimilarity
##' used in  ./agnes.q, ./clara.q,  ./diana.q  und ./pam.q :
##' *somewhat* related to Matrix:::indTri()
lower.to.upper.tri.inds <- function(n)
{
    n1 <- as.integer(n - 1)
    if(n1 < 1) stop("'n' must be >= 2")
    else if(n1 == 1) 1L
    else rep(seq_len(n1), seq_len(n1)) +
        c(0L, unlist(lapply(2:n1, function(k) cumsum(c(0L, (n - 2L):(n - k))))))
}

upper.to.lower.tri.inds <- function(n)
{
    if((n2 <- as.integer(n - 2L)) < 0) stop("'n' must be >= 2")
    rep(1L + cumsum(0:n2), (n - 1):1) +
	unlist(lapply(0:n2, function(k) cumsum(k:n2)))
}


meanabsdev <- function(y) mean(abs(y - mean(y, na.rm = TRUE)), na.rm = TRUE)