R/cmeans.R In e1071: Misc Functions of the Department of Statistics, Probability Theory Group (Formerly: E1071), TU Wien

Documented in cmeansprint.fclust

```cmeans <-
function(x, centers, iter.max = 100, verbose = FALSE,
dist = "euclidean", method = "cmeans", m = 2,
rate.par = NULL, weights = 1, control = list())
{

x <- as.matrix(x)
xrows <- nrow(x)
xcols <- ncol(x)

if(missing(centers))
stop("Argument 'centers' must be a number or a matrix.")

dist <- pmatch(dist, c("euclidean", "manhattan"))
if(is.na(dist))
stop("invalid distance")
if(dist == -1)
stop("ambiguous distance")

method <- pmatch(method, c("cmeans", "ufcl"))
if(is.na(method))
stop("invalid clustering method")
if(method == -1)
stop("ambiguous clustering method")

if(length(centers) == 1) {
ncenters <- centers
centers <- x[sample(1 : xrows, ncenters), , drop = FALSE]
if(any(duplicated(centers))) {
cn <- unique(x)
mm <- nrow(cn)
if(mm < ncenters)
stop("More cluster centers than distinct data points.")
centers <- cn[sample(1 : mm, ncenters), , drop = FALSE]
}
}
else {
centers <- as.matrix(centers)
if(any(duplicated(centers)))
stop("Initial centers are not distinct.")
cn <- NULL
ncenters <- nrow(centers)
if (xrows < ncenters)
stop("More cluster centers than data points.")
}

if(xcols != ncol(centers))
stop("Must have same number of columns in 'x' and 'centers'.")

if(iter.max < 1)
stop("Argument 'iter.max' must be positive.")

if(method == 2) {
if(missing(rate.par)) {
rate.par <- 0.3
}
}

reltol <- control\$reltol
if(is.null(reltol))
reltol <- sqrt(.Machine\$double.eps)
if(reltol <= 0)
stop("Control parameter 'reltol' must be positive.")

if(any(weights < 0))
stop("Argument 'weights' has negative elements.")
if(!any(weights > 0))
stop("Argument 'weights' has no positive elements.")
weights <- rep_len(weights, xrows)
weights <- weights / sum(weights)

## <FIXME>
## Do we really want to do this?
perm <- sample(xrows)
x <- x[perm, ]
weights <- weights[perm]
## </FIXME>

initcenters <- centers
pos <- as.factor(1 : ncenters)
rownames(centers) <- pos

if(method == 1) {
retval <- .C(R_cmeans,
as.double(x),
as.integer(xrows),
as.integer(xcols),
centers = as.double(centers),
as.integer(ncenters),
as.double(weights),
as.double(m),
as.integer(dist - 1),
as.integer(iter.max),
as.double(reltol),
as.integer(verbose),
u = double(xrows * ncenters),
ermin = double(1),
iter = integer(1))
}
else if(method == 2) {
retval <- .C(R_ufcl,
x = as.double(x),
as.integer(xrows),
as.integer(xcols),
centers = as.double(centers),
as.integer(ncenters),
as.double(weights),
as.double(m),
as.integer(dist - 1),
as.integer(iter.max),
as.double(reltol),
as.integer(verbose),
as.double(rate.par),
u = double(xrows * ncenters),
ermin = double(1),
iter = integer(1)
)
}

centers <- matrix(retval\$centers, ncol = xcols,
dimnames = list(1 : ncenters,
colnames(initcenters)))
u <- matrix(retval\$u, ncol = ncenters,
dimnames = list(rownames(x), 1 : ncenters))
u <- u[order(perm), ]
iter <- retval\$iter - 1
withinerror <- retval\$ermin

cluster <- apply(u, 1, which.max)
clustersize <- as.integer(table(cluster))

retval <- list(centers = centers, size = clustersize,
cluster = cluster, membership = u, iter = iter,
withinerror = withinerror, call = match.call())
class(retval) <- c("fclust")
return(retval)
}

print.fclust <-
function(x, ...)
{
cat("Fuzzy c-means clustering with", length(x\$size), "clusters\n")
cat("\nCluster centers:\n")
print(x\$centers, ...)
cat("\nMemberships:\n")
print(x\$membership, ...)
cat("\nClosest hard clustering:\n")
print(x\$cluster, ...)
cat("\nAvailable components:\n")
print(names(x), ...)
invisible(x)
}
```

Try the e1071 package in your browser

Any scripts or data that you put into this service are public.

e1071 documentation built on Dec. 7, 2023, 8:15 p.m.