R/clusterSplitSB.R

Defines functions clusterSplitSB

Documented in clusterSplitSB

clusterSplitSB <-
function(cl=NULL, seq, size = 1)
{
    if (is.null(cl))
        stop("no cluster 'cl' supplied")
    if (!inherits(cl, "cluster"))
        stop("not a valid cluster")
    m <- length(seq)
    size <- rep(size, m)[1:m]
    ## equal size
    if (length(unique(size)) == 1)
        return(clusterSplit(cl, seq))
    ## unequal size
    n <- length(cl)
    id <- 1:m
    ord <- order(size, decreasing = TRUE)
    size <- size[ord]
    id <- id[ord]
    w <- matrix(0, max(1,m-n+1), n)
    s <- matrix(NA, max(1,m-n+1), n)
    w[1,1:n] <- size[1:n]
    s[1,1:n] <- id[1:n]
    if (n < m)
        for (i in 2:nrow(w)) {
            j <- which(colSums(w) == min(colSums(w)))[1]
            w[i, j] <- size[i+n-1]
            s[i, j] <- id[i+n-1]
        }
    spl <- lapply(1:n, function(i) s[!is.na(s[,i]),i])
    rval <- lapply(spl, function(z) seq[z])
    if (n > length(rval))
        for (i in (length(rval)+1):n) {
            rval[[i]] <- numeric(0)
        }
    rval
}

Try the dclone package in your browser

Any scripts or data that you put into this service are public.

dclone documentation built on July 10, 2023, 2:03 a.m.