问封装中的prediction.strength

EN

pred <- function (distance, Gmin = 2, Gmax = 10, M = 50, 
classification = "centroid", cutoff = 0.8, nnk = 1, ...) 
{
require(cluster)
require(class)
xdata <- as.matrix(distance)
n <- nrow(xdata)
nf <- c(floor(n/2), n - floor(n/2))
indvec <- clcenters <- clusterings <- jclusterings <- classifications <- list()
prederr <- list()
dist <- as.matrix(distance)
for (k in Gmin:Gmax) {
    prederr[[k]] <- numeric(0)
    for (l in 1:M) {
        nperm <- sample(n, n)
        indvec[[l]] <- list()
        indvec[[l]][[1]] <- nperm[1:nf[1]]
        indvec[[l]][[2]] <- nperm[(nf[1] + 1):n]
        for (i in 1:2) {
            clusterings[[i]] <- as.vector(pam(as.dist(dist[indvec[[l]][[i]],indvec[[l]][[i]]]), k, diss=TRUE))
            jclusterings[[i]] <- rep(-1, n)
            jclusterings[[i]][indvec[[l]][[i]]] <- clusterings[[i]]$clustering
    centroids <- clusterings[[i]]$medoids
            j <- 3 - i
            classifications[[j]] <- classifdist(as.dist(dist), jclusterings[[i]], 
              method = classification, centroids = centroids, 
              nnk = nnk)[indvec[[l]][[j]]]
        }
        ps <- matrix(0, nrow = 2, ncol = k)
        for (i in 1:2) {
            for (kk in 1:k) {
              nik <- sum(clusterings[[i]]$clustering == kk)
              if (nik > 1) {
                for (j1 in (1:(nf[i] - 1))[clusterings[[i]]$clustering[1:(nf[i] - 
                  1)] == kk]) {
                  for (j2 in (j1 + 1):nf[i]) if (clusterings[[i]]$clustering[j2] == 
                    kk) 
                    ps[i, kk] <- ps[i, kk] + (classifications[[i]][j1] == 
                      classifications[[i]][j2])
                }
                ps[i, kk] <- 2 * ps[i, kk]/(nik * (nik - 
                  1))
              }
            }
        }
        prederr[[k]][l] <- mean(c(min(ps[1, ]), min(ps[2, 
            ])))
    }
}
mean.pred <- numeric(0)
if (Gmin > 1) 
    mean.pred <- c(1)
if (Gmin > 2) 
    mean.pred <- c(mean.pred, rep(NA, Gmin - 2))
for (k in Gmin:Gmax) mean.pred <- c(mean.pred, mean(prederr[[k]]))
optimalk <- max(which(mean.pred > cutoff))
out <- list(predcorr = prederr, mean.pred = mean.pred, optimalk = optimalk, 
    cutoff = cutoff, method = clusterings[[1]]$clustermethod, 
    Gmax = Gmax, M = M)
class(out) <- "predstr"
out
}