Nothing
# using silhouette index as the measure of the strength of the clusters
clues_sil <- function(y, n0 = 5, alpha = 0.05, eps = 1.0e-4, itmax = 20,
K2.vec = NULL, s2 = -3, disMethod = "Euclidean", quiet = FALSE)
{
if(is.null(K2.vec))
{
K2.vec=n0
}
disMethod <- match.arg(disMethod, c("Euclidean", "1-corr"))
if(!is.matrix(y))
{ y <- matrix(y, ncol = 1) }
# first pass
second <- FALSE
res <- ChooseK_sil(y=y, y2 = y, n0=n0,
alpha=alpha, eps=eps, itmax=itmax, second=second,
K2.vec=K2.vec, s2=s2,
disMethod=disMethod, quiet=quiet)
# check if we need second pass
# if length(g.vec) = 1 or g.vec[pos-1]=g.vec[pos]+1=g.vec[pos+1]-1,
# then do NOT need second pass
len <- length(res$g.vec)
if(len > 1) # may need second pass
{ pos <- which(res$g.vec == res$g)
len2 <- length(pos)
len3 <- length(res$g.vec)
pos1 <- pos[1]
pos2 <- pos[len2]
g <- res$g
s2 <- res$avg.s
K12 <- res$K.vec[pos1]
K21 <- res$K.vec[pos2]
if(pos1 > 1)
{ g1 <- res$g.vec[pos1 - 1]
K11 <- res$K.vec[pos1 - 1]
}
if(pos2 < len3)
{ K22 <- res$K.vec[pos2 + 1]
g2 <- res$g.vec[pos2 + 1]
}
if(pos1 > 1 && g1 - g > 1) # need second pass
{ K2.vec <- c(K11, K12)
# second pass
second <- TRUE
res2 <- ChooseK_sil(y=y, y2 = res$y.old1, n0=n0, alpha=alpha,
eps=eps, itmax=itmax, second=second,
K2.vec=K2.vec, s2=s2, disMethod=disMethod, quiet=quiet)
if(res2$myupdate == TRUE) # update the final partition
{ s2 <- res2$avg.s
res <- res2
}
}
if(pos2 < len3 && (g - g2) > 1) # need second pass
{ K2.vec <- c(K21, K22)
# second pass
second <- TRUE
res3 <- ChooseK_sil(y=y, y2 = res$y.old2, n0=n0, alpha=alpha,
eps=eps, itmax=itmax, second=second,
K2.vec=K2.vec, s2=s2, disMethod=disMethod, quiet=quiet)
if(res3$myupdate == TRUE) { res <- res3 }
}
}
return(res)
}
## first pass
## if second = 1, then it is the first pass
## if second = 2, then it is the second pass
## y --- original data
## y2 --- data used to do shrinking and clustering
ChooseK_sil <- function(y, y2, n0 = 5, alpha = 0.05, eps = 1.0e-4, itmax = 20,
second = FALSE, K2.vec = NULL, s2 = -3, disMethod = "Euclidean",
quiet = FALSE)
{
if(is.null(K2.vec))
{
K2.vec=n0
}
disMethod <- match.arg(disMethod, c("Euclidean", "1-corr"))
if(!is.matrix(y))
{ y <- matrix(y, ncol = 1) }
# step 1
y <- as.matrix(y)
y2 <- as.matrix(y2)
dat <- y
dat2 <- y2
nObs <- nrow(dat)
nVars <- ncol(dat)
nClusters0 <- n0
if(disMethod == "Euclidean") {
disMethod2 <- 1
} else {
disMethod2 <- 2
}
# input
nObs1 <- nObs - 1
ITMAX <- itmax
nNeiVec2 <- K2.vec
# output
avgsFinal <- 0
sFinal <- rep(0, nObs)
memFinal <- rep(0, nObs)
nClustersFinal <- 0
clustSizeFinal <- rep(0, nObs)
nNeiFinal <- 0
nClustVec <- rep(0, nObs)
nNeiVec <- rep(0, nObs)
myt <- 0
datold1 <- matrix(0, nrow = nrow(dat), ncol = ncol(dat))
datold2 <- matrix(0, nrow = nrow(dat), ncol = ncol(dat))
indexFlag = TRUE
myupdate <- FALSE
res <- .Fortran("chooseK",
as.double(dat),
as.double(dat2),
as.integer(nObs),
as.integer(nObs1),
as.integer(nVars),
as.integer(nClusters0),
as.double(alpha),
as.double(eps),
as.integer(ITMAX),
as.logical(second),
as.integer(nNeiVec2),
as.double(s2),
as.integer(disMethod2),
as.logical(indexFlag),
as.logical(quiet),
indFinal = as.double(avgsFinal),
sFinal = as.double(sFinal),
memFinal = as.integer(memFinal),
nClustersFinal = as.integer(nClustersFinal),
clustSizeFinal = as.integer(clustSizeFinal),
nNeiFinal = as.integer(nNeiFinal),
nClustVec = as.integer(nClustVec),
nNeiVec = as.integer(nNeiVec),
myt = as.integer(myt),
datold1 = as.double(datold1),
datold2 = as.double(datold2),
myupdate = as.logical(myupdate),
PACKAGE = "clues")
resList <- list(K = res$nNeiFinal,
size = res$clustSizeFinal[1:res$nClustersFinal],
mem = res$memFinal,
g = res$nClustersFinal,
avg.s = res$indFinal,
s = res$sFinal,
K.vec = res$nNeiVec[1:res$myt],
g.vec = res$nClustVec[1:res$myt],
myupdate = res$myupdate,
y.old1 = matrix(res$datold1, nrow = nrow(dat), ncol = ncol(dat)),
y.old2 = matrix(res$datold2, nrow = nrow(dat), ncol = ncol(dat)))
return(resList)
}
get_Silhouette <- function(y, mem, disMethod = "Euclidean")
{
disMethod <- match.arg(disMethod, c("Euclidean", "1-corr"))
if(!is.matrix(y))
{ y <- matrix(y, ncol = 1) }
n <- nrow(y)
p <- ncol(y)
g <- length(unique(mem))
size <- tapply(mem, mem, length)
if(disMethod == "Euclidean") {
disMethod2 <- 1
} else { # disMethod == "corr"
disMethod2 <- 2
}
# output
avgs <- 0
memNei <- rep(0, n)
sIndex <- rep(0, n)
res <- .Fortran("silhouette",
as.double(y),
as.integer(n),
as.integer(p),
as.integer(mem),
as.integer(g),
as.integer(size),
as.integer(disMethod2),
memNei = as.integer(memNei),
sIndex = as.double(sIndex),
avgs = as.double(avgs),
PACKAGE = "clues")
avgs <- res$avgs
s <- res$sIndex
neighbor <- res$memNei
res <- list(avg.s = avgs, s = s, neighbor = neighbor)
}
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.