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
|
`isomapdist` <-
function(dist, epsilon, k, path="shortest", fragmentedOK = FALSE, ...)
{
EPS <- 1e-5
op <- options(warn = 2)
on.exit(options(op))
if (!inherits(dist, "dist"))
dist <- as.dist(dist)
options(op)
method <- attr(dist, "method")
if (missing(epsilon) && missing(k))
stop("either epsilon or k must be given")
if (!missing(epsilon) && !missing(k))
message("both epsilon and k given, using epsilon")
if (!missing(epsilon))
dist[dist >= epsilon-EPS] <- NA
else {
dist <- as.matrix(dist)
diag(dist) <- NA
is.na(dist) <- apply(dist, 2, function(x)
x > x[order(x, na.last=TRUE)[k]])
dist <- pmax(as.dist(dist), as.dist(t(dist)), na.rm = TRUE)
}
fragm <- distconnected(dist, toolong=0, trace=FALSE)
take <- NULL
if (length(unique(fragm)) > 1) {
if (fragmentedOK) {
warning("data are fragmented: taking the largest fragment")
take <- fragm == as.numeric(names(which.max(table(fragm))))
dist <- as.dist(as.matrix(dist)[take,take])
} else {
stop("data are fragmented")
}
}
net <- which(!is.na(dist))
attr(dist, "method") <- method
dist <- stepacross(dist, path = path, toolong = 0, trace = FALSE)
if (any(is.na(dist))) {
grps <- distconnected(dist, toolong=0)
}
if (missing(epsilon)) {
attr(dist, "criterion") <-"k"
attr(dist, "critval") <- k
}
else {
attr(dist, "criterion") <- "epsilon"
attr(dist, "critval") <- epsilon
}
attr(dist, "method") <- paste(attr(dist, "method"), "isomap")
attr(dist, "net") <- net
attr(dist, "take") <- take
attr(dist, "call") <- match.call()
dist
}
|
