Nothing
optsil <- function(x, dist, maxitr)
{
UseMethod('optsil')
}
opts.core <- function (dist, clustering, maxitr = 100)
{
if (class(dist) != 'dist')
stop('You must pass an object of classs dist as the first argument')
if (max(dist) > 1) dist <- dist/max(dist)
sim <- 1 - as.matrix(dist)
clustering <- as.numeric(clustify(clustering))
numplt <- length(clustering)
numclu <- max(clustering)
sils <- rep(0, maxitr)
numitr <- 0
pltsil <- rep(0,numplt)
tmpclu <- rep(0,numplt)
simptc <- matrix(0,nrow=numplt,ncol=numclu)
nabor <- rep(0,numplt)
sumnum <- rep(0,numclu)
sumden <- rep(0,numclu)
res <- .Fortran('optsil',
as.double(sim),
clustering = as.integer(clustering),
as.integer(numplt),
as.integer(numclu),
as.integer(maxitr),
sils = as.double(sils),
numitr = as.integer(numitr),
as.double(simptc),
as.double(pltsil),
as.integer(tmpclu),
as.integer(nabor),
as.double(sumnum),
as.integer(sumden),
PACKAGE = 'optpart')
out <- list()
out$clustering <- as.numeric(factor(res$clustering))
out$sils <- (res$sils/numplt)[1:res$numitr]
out$numitr <- res$numitr
class(out) <- c('optsil', 'clustering')
attr(out,'call' ) <- match.call()
attr(out,'timestamp') <- date()
out
}
optsil.default <- function(x,dist,maxitr=100)
{
if (!inherits(dist,'dist'))
stop("The second argument must be an object of class 'dist'")
if (is.numeric(x) && length(x) == 1) {
out <- opts.core(dist,sample(1:x,attr(dist,'Size'),
replace=TRUE),maxitr)
} else {
clustering <- as.numeric(clustify(x))
out <- opts.core(dist,clustering,maxitr)
}
attr(out,'class') <- c('optsil','clustering')
attr(out,'call') <- match.call()
attr(out,'timestamp') <- date()
out
}
optsil.stride <- function(x,dist,maxitr=100)
{
if (!inherits(x,'stride'))
stop("The first argument must be an object of class 'stride'")
if (!inherits(dist,'dist'))
stop("The second argument must be an object of class 'dist'")
res <- matrix(NA,nrow=nrow(x$clustering),ncol=ncol(x$clustering))
for (i in 1:ncol(x$clustering)) {
tmp <- opts.core(dist,x$clustering[,i],maxitr)
res[,i] <- tmp$clustering
}
out <- data.frame(res)
names(out) <- as.character(x$seq)
row.names(out) <- row.names(x$clustering)
out <- list(clustering=out,seq=x$seq)
attr(out,'class') <- 'stride'
attr(out,'call') <- match.call()
attr(out,'timestamp') <- date()
out
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.