Nothing
partana <- function (c, dist)
{
UseMethod("partana")
}
partana.default <- function (c, dist)
{
c <- as.integer(clustify(c))
numclu <- max(c)
call <- match.call()
if (!inherits(dist,'dist')) {
stop("The second argument must be an object of class 'dist'")
}
x <- (max(1,max(dist)) - as.matrix(dist)) / max(1,max(dist))
num <- 0
sumnum <- 0
den <- 0
sumden <- 0
card <- rep(0,numclu)
for (i in 1:numclu) {
card[i] <- sum(c==i)
}
numplt <- nrow(x)
simptc <- matrix(0, nrow = numplt, ncol = numclu)
simctc <- matrix(0, nrow = numclu, ncol = numclu)
for (i in 1:numplt) {
for (j in 1:numclu) {
if (c[i] == j) {
if (card[j] > 1) {
simptc[i, j] <- (sum(x[i, c == j]) - 1)/(card[j] -
1)
}
else {
simptc[i, j] <- 1
}
}
else {
if (card[j] > 0) {
simptc[i, j] <- sum(x[i, c == j])/card[j]
}
else {
simptc[i, j] <- 0
}
}
}
}
for (i in 1:numclu) {
for (j in 1:numclu) {
if (i == j) {
if (card[i] > 1) {
simctc[i, j] <- (sum(x[c == i, c == i]) - card[i])/(card[i]^2 -
card[i])
sumnum <- sumnum + simctc[i, i] * ((card[i]^2 -
card[i])/2)
num <- num + ((card[i]^2 - card[i])/2)
}
}
else {
if (card[i] != 0 & card[j] != 0) {
simctc[i, j] <- sum(x[c == i, c == j])/(card[i] *
card[j])
sumden <- sumden + sum(x[c == i, c == j])
den <- den + (card[i] * card[j])
}
}
}
}
distname <- deparse(substitute(dist))
out <- list(ptc = simptc, ctc = simctc, ratio = (sumnum/num)/(sumden/den),
clustering = c, distname=distname, names=attr(dist,'Labels'))
attr(out,"call") <- call
attr(out,"class") <- "partana"
attr(out,'timestamp') <- date()
out
}
partana.partition <- function (c,dist=NULL)
{
if (!is.null(c$dist)) {
tmp <- c$dist
} else if (!is.null(dist)) {
tmp <- dist
} else {
stop('Your partition object did not contain the dissimilarity object, and you did not provide one')
}
attr(tmp, "class") <- "dist"
out <- partana(c$clustering, tmp)
out
}
partana.stride <- function(c,dist)
{
if (class(c) != 'stride')
stop("The first argument must be of class 'stride'")
res <- rep(NA,ncol(c$clustering))
for (i in 1:ncol(c$clustering)) {
res[i] <- partana(c$clustering[,i],dist)$ratio
}
clusters <- c$seq
ratio <- res
out <- data.frame(clusters,ratio)
out
}
plot.partana <- function(x,panel='all',zlim=range(x$ptc),col=heat.colors(12), ...)
{
numclu <- ncol(x$ptc)
numplt <- nrow(x$ptc)
set <- matrix(nrow=0,ncol=numclu)
card <- rep(0,numclu)
for (i in 1:numclu) {
card[i] <- sum(x$clustering==i)
}
for (i in 1:numclu) {
if (card[i] > 0) {
tmp <- x$ptc[x$clustering==i,]
if (card[i] > 1) {
tmp <- tmp[rev(order(tmp[,i])),]
}
set <- rbind(set,tmp)
}
}
if (panel == 'all' || panel == 1) {
image(seq(1:numplt),seq(1:numclu),set,zlim=zlim,col=col,
main="Plot-to-Set Similarity",xlab="Plots",ylab="Set")
if (panel == 'all')
readline("Hit return to continue\n")
}
if (panel == 'all' || panel == 2) {
image(seq(1:numclu),seq(1:numclu),x$ctc,zlim=zlim,col=col,
main="Set-to-Set Similarity",xlab="Set",ylab="Set")
if ((panel == 'all' || panel ==3) && length(x$ratio) > 1)
readline("Hit return to continue\n")
}
if ((panel == 'all' || panel ==3) && length(x$ratio) > 1) {
plot(x$ratio,type='b')
}
}
summary.partana <- function (object, ...)
{
cat(paste("Number of clusters = ", nrow(object$ctc), "\n"))
print(table(object$clustering))
cat("\n")
if (nrow(object$ctc) < 11) {
print(object$ctc)
}
else {
cat("Mean Within-cluster similarities\n\n")
for (i in 1:nrow(object$ctc)) {
cat(paste(i, format(object$ctc[i, i], digits = 4),
"\n"))
}
}
if (length(object$ratio) > 1) {
cat(paste("\nRatio of Within-cluster similarity/Among-cluster similarity = ",
format(object$ratio[object$numitr],digits=4),"in",object$numitr,"iterations\n"))
}
else {
cat(paste("\nRatio of Within-cluster similarity/Among-cluster similarity = ",
format(object$ratio,digits=4),"\n"))
}
}
print.partana <- function (x, ...)
{
cat(paste("Number of clusters = ", nrow(x$ctc), "\n"))
print(table(x$clustering))
cat("\n")
if (nrow(x$ctc) < 11) {
print(x$ctc)
}
else {
cat("Mean Within-cluster similarities\n\n")
for (i in 1:nrow(x$ctc)) {
cat(paste(i, format(x$ctc[i, i], digits = 4),
"\n"))
}
}
if (length(x$ratio) > 1) {
cat(paste("\nRatio of Within-cluster similarity/Among-cluster similarity = ",
format(x$ratio[x$numitr],digits=4),"in",x$numitr,"iterations\n"))
}
else {
cat(paste("\nRatio of Within-cluster similarity/Among-cluster similarity = ",
format(x$ratio,digits=4),"\n"))
}
}
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.