Calculating p-values for divisive hierarchical clustering in R (pvclust package) - r

Question

Would anyone know how to calculate significance values for clusters in the R package pvclust using a divisive hierarchical clustering method (e.g. diana from the cluster package)? The pvclust package supports only agglomerative hierarchical clustering methods (implemented by the hclust function), but I have been hoping that forcing pvclust to use diana instead of hclust might be possible. I tried modifying some of the internal pvclust functions as follows, but the only result was an error:
library(pvclust)
library(cluster)
pvclust.nonparallel <- function (data, method.hclust, method.dist, use.cor, nboot, r,
store, weight, iseed, quiet)
{
if (!is.null(iseed))
set.seed(seed = iseed)
n <- nrow(data)
p <- ncol(data)
if (is.function(method.dist)) {
distance <- method.dist(data)
}
else {
distance <- pvclust:::dist.pvclust(data, method = method.dist,
use.cor = use.cor)
}
####### replace hclust with diana
# data.hclust <- hclust(distance, method = method.hclust) # original version
data.hclust <- diana(distance, diss = T)
if (method.hclust == "ward" && getRversion() >= "3.1.0") {
method.hclust <- "ward.D"
}
size <- floor(n * r)
rl <- length(size)
if (rl == 1) {
if (r != 1)
warning("Relative sample size r is set to 1.0. AU p-values are not calculated\n")
r <- list(1)
}
else r <- as.list(size/n)
mboot <- lapply(r, boot.hclust, data = data, object.hclust = data.hclust,
nboot = nboot, method.dist = method.dist, use.cor = use.cor,
method.hclust = method.hclust, store = store, weight = weight,
quiet = quiet)
result <- pvclust:::pvclust.merge(data = data, object.hclust = data.hclust,
mboot = mboot)
return(result)
}
boot.hclust <- function (r, data, object.hclust, method.dist, use.cor, method.hclust,
nboot, store, weight = FALSE, quiet = FALSE)
{
n <- nrow(data)
size <- round(n * r, digits = 0)
if (size == 0)
stop("invalid scale parameter(r)")
r <- size/n
pattern <- pvclust:::hc2split(object.hclust)$pattern
edges.cnt <- table(factor(pattern)) - table(factor(pattern))
st <- list()
rp <- as.character(round(r, digits = 2))
if (r == 1)
rp <- paste(rp, ".0", sep = "")
if (!quiet)
cat(paste("Bootstrap (r = ", rp, ")... ",
sep = ""))
w0 <- rep(1, n)
na.flag <- 0
for (i in 1:nboot) {
if (weight && r > 10) {
w1 <- as.vector(rmultinom(1, size, w0))
suppressWarnings(distance <- distw.pvclust(data,
w1, method = method.dist, use.cor = use.cor))
}
else {
smpl <- sample(1:n, size, replace = TRUE)
if (is.function(method.dist)) {
suppressWarnings(distance <- method.dist(data[smpl,
]))
}
else {
suppressWarnings(distance <- pvclust:::dist.pvclust(data[smpl,
], method = method.dist, use.cor = use.cor))
}
}
if (all(is.finite(distance))) {
####### replace hclust with diana
# x.hclust <- hclust(distance, method = method.hclust) # original version
x.hclust <- diana(distance, diss = T)
pattern.i <- pvclust:::hc2split(x.hclust)$pattern
edges.cnt <- edges.cnt + table(factor(pattern.i,
levels = pattern))
}
else {
x.hclust <- NULL
na.flag <- 1
}
if (store)
st[[i]] <- x.hclust
}
if (!quiet)
cat("Done.\n")
if (na.flag == 1)
warning(paste("inappropriate distance matrices are omitted in computation: r = ",
r), call. = FALSE)
boot <- list(edges.cnt = edges.cnt, method.dist = method.dist,
use.cor = use.cor, method.hclust = method.hclust, nboot = nboot,
size = size, r = r, store = st)
class(boot) <- "boot.hclust"
return(boot)
}
assignInNamespace("pvclust.nonparallel",pvclust.nonparallel,ns="pvclust")
assignInNamespace("boot.hclust",boot.hclust,ns="pvclust")
data(lung)
res.pv <- pvclust(t(lung), method.dist = "euclidean")
plot(res.pv)
# Error in barplot.default(w, xlab = xlab, horiz = TRUE, space = 0, axes = FALSE, :
# argument 9 matches multiple formal arguments