[Vegan-commits] r2246 - pkg/vegan/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 13 17:14:44 CEST 2012
Author: jarioksa
Date: 2012-08-13 17:14:44 +0200 (Mon, 13 Aug 2012)
New Revision: 2246
Modified:
pkg/vegan/R/cIndexKM.R
Log:
remove unused internal functions from cIndexKM (one triggered a warning in R-devel CMD check)
Modified: pkg/vegan/R/cIndexKM.R
===================================================================
--- pkg/vegan/R/cIndexKM.R 2012-08-12 16:18:06 UTC (rev 2245)
+++ pkg/vegan/R/cIndexKM.R 2012-08-13 15:14:44 UTC (rev 2246)
@@ -1,75 +1,7 @@
-"cIndexKM" <- function (y, x, index = "all")
+`cIndexKM` <-
+ function (y, x, index = "all")
{
kmeans_res <- y
-#########################################
- withinss <- function(kmeans_res, x)
- {
- retval <- rep(0, nrow(kmeans_res$centers))
- x <- (x - kmeans_res$centers[kmeans_res$cluster, ])^2
- for (k in 1:nrow(kmeans_res$centers))
- {
- retval[k] <- sum(x[kmeans_res$cluster == k, ])
- }
- retval
- }
-##########################################
- varwithinss <- function(x, centers, cluster)
- {
- nrow <- dim(centers)[1]
- nvar <- dim(x)[2]
- varwithins <- matrix(0, nrow, nvar)
- x <- (x - centers[cluster, ])^2
- for (l in 1:nvar)
- {
- for (k in 1:nrow)
- {
- varwithins[k, l] <- sum(x[cluster == k, l])
- }
- }
- varwithins
- }
-##########################################
- maxmindist <- function(clsize, distscen)
- {
- ncl <- length(clsize)
- npairs <- 0
- for (i in 1:ncl) npairs <- npairs + clsize[i] * (clsize[i] - 1)/2
- mindw <- 0
- nfound <- distscen[1]
- i <- 1
- while (nfound < npairs)
- {
- if ((nfound + distscen[i + 1]) < npairs)
- {
- mindw <- mindw + i * distscen[i + 1]
- nfound <- nfound + distscen[i + 1]
- }
- else
- {
- mindw <- mindw + i * (npairs - nfound)
- nfound <- nfound + distscen[i + 1]
- }
- i <- i + 1
- }
- maxdw <- 0
- nfound <- 0
- i <- length(distscen) - 1
- while (nfound < npairs)
- {
- if ((nfound + distscen[i + 1]) < npairs)
- {
- maxdw <- maxdw + i * distscen[i + 1]
- nfound <- nfound + distscen[i + 1]
- }
- else
- {
- maxdw <- maxdw + i * (npairs - nfound)
- nfound <- nfound + distscen[i + 1]
- }
- i <- i - 1
- }
- list(mindw = mindw, maxdw = maxdw)
- }
#############################################
gss <- function(x, clsize, withins)
{
@@ -83,39 +15,7 @@
list(wgss = wgss, bgss = bgss)
}
#############################################
- vargss <- function(x, clsize, varwithins)
- {
- nvar <- dim(x)[2]
- n <- sum(clsize)
- k <- length(clsize)
- varallmean <- rep(0, nvar)
- varallmeandist <- rep(0, nvar)
- varwgss <- rep(0, nvar)
- for (l in 1:nvar) varallmean[l] <- mean(x[, l])
- vardmean <- sweep(x, 2, varallmean, "-")
- for (l in 1:nvar)
- {
- varallmeandist[l] <- sum((vardmean[, l])^2)
- varwgss[l] <- sum(varwithins[, l])
- }
- varbgss <- varallmeandist - varwgss
- vartss <- varbgss + varwgss
- list(vartss = vartss, varbgss = varbgss)
- }
-
-#################################################
- count <- function(x)
- {
- nr <- nrow(x)
- nc <- ncol(x)
- d <- integer(nc + 1)
- retval <- .C("count", xrows = nr, xcols = nc, x = as.integer(x),
- d = d, PACKAGE = "cclust")
- d <- retval$d
- names(d) <- 0:nc
- d
- }
-################################################
+
### Function modified by SD and PL from the original "cIndexKM" in "cclust"
### to accommodate a single response variable as well as singleton groups
### and remove unwanted index.
More information about the Vegan-commits
mailing list