## (GPL-3) Antonio Rivero Ostoic, multiplex@post.com
bundle.census <-
function (x, loops = FALSE) 
{
    if (isTRUE(is.array(x)) == FALSE) 
        stop(paste(sQuote(deparse(substitute(x))), " must be an array of square matrices.", 
            sep = ""))
    if (isTRUE(dim(x)[1] == dim(x)[2]) == FALSE) 
        stop(paste(sQuote(deparse(substitute(x))), " must be square.", 
            sep = ""))
    sep <- ", "
    if (any(grepl(",", dimnames(x)[[1]])) == TRUE) {
        lb2lb <- FALSE
    }
    else {
        lb2lb <- TRUE
    }
    ifelse(isTRUE(is.null(dimnames(x)[1]) == TRUE | is.null(dimnames(x)[1][[1]]) == 
        TRUE) == TRUE, LBS <- seq_len(nrow(x)), LBS <- dimnames(x)[[1]])
    lbs <- seq(LBS)
    xd <- dichot(x, c = 1L, diag = TRUE)
    ifelse(isTRUE(dim(xd)[3] == 1) == TRUE, xd <- xd[, , 1], 
        NA)
    if (is.na(dim(xd)[3]) == FALSE) {
        TRD <- TRUE
        r <- dim(x)[3]
        if (isTRUE(is.null(dimnames(x)[[3]]) == TRUE) | isTRUE(any(duplicated(dimnames(x)[[3]]))) == 
            TRUE) {
            dimnames(x)[[3]] <- seq_len(dim(x)[3])
        }
        mlt <- list()
        for (i in seq_len(dim(x)[3])) {
            mlt[[i]] <- trnl(xd[, , i], lbs = lbs, lb2lb = lb2lb, 
                sep = sep)
        }
        rm(i)
        m <- unlist(mlt)
    }
    else {
        TRD <- FALSE
        r <- 1L
        m <- trnl(xd, lbs = lbs, lb2lb = lb2lb, sep = sep)
    }
    bd <- bnd(x, xd, lbs, TRD, r, m, mlt, sep)
    Et <- vector()
    if (isTRUE(TRD == TRUE) == TRUE) {
        for (i in seq_len(length(bd$Eout))) {
            for (j in seq_len(length(bd$Eout[[i]]))) {
                if (isTRUE(length(bd$Eout[[i]]) != 0L) == TRUE) {
                  Et <- append(Et, paste(lbs[i], bd$Eout[[i]][j], 
                    sep = sep))
                }
            }
            rm(j)
        }
        rm(i)
        ENT <- list()
        for (k in seq_len(r)) {
            tmp <- vector()
            for (i in which(Et %in% trnl(xd[, , k], lbs = lbs, 
                lb2lb = lb2lb, sep = sep))) {
                tmp <- append(tmp, Et[i])
            }
            rm(i)
            ENT[[k]] <- as.character(tmp)
        }
        rm(k)
    }
    else {
        ENT <- as.character(Et)
    }
    if (loops) {
        if (isTRUE(is.na(dim(xd)[3])) == FALSE) {
            vec <- vector()
            for (i in seq_len(dim(xd)[3])) {
                vec <- append(vec, sum(diag(xd[, , i])))
            }
            rm(i)
            lop <- sum(vec)
        }
        else {
            lop <- sum(diag(xd))
        }
    }
    tbnd <- (length(unlist(bd$full))/2L + length(unlist(bd$asym))/2L + 
        length(unlist(bd$recp))/2L + length(unlist(bd$xchg))/2L + 
        length(unlist(bd$Eout))/1L + (length(unlist(bd$tripfl))/2L) - 
        (length(which(table(unlist(ENT)) > 2L))))
    ifelse(isTRUE(loops == FALSE) == TRUE, {
        bc <- cbind(abs(choose(nrow(xd), 2) - (choose(nrow(xd), 
            2)) - tbnd), (choose(nrow(xd), 2)) - tbnd, length(unlist(bd$asym))/2L, 
            length(unlist(bd$recp))/2L, length(unlist(bd$Eout))/1L, 
            length(unlist(bd$xchg))/2L, (length(unlist(bd$tripfl))/2L) - 
                (length(which(table(unlist(ENT)) > 2L))), length(unlist(bd$full))/2L)
        colnames(bc) <- c("BUNDLES", "NULL", "ASYMM", "RECIP", 
            "T.ENTR", "T.EXCH", "MIXED", "FULL")
        rownames(bc) <- "TOTAL"
    }, {
        bc <- cbind(abs(choose(nrow(xd), 2) - (choose(nrow(xd), 
            2)) - tbnd), (choose(nrow(xd), 2)) - tbnd, length(unlist(bd$asym))/2L, 
            length(unlist(bd$recp))/2L, length(unlist(bd$Eout))/1L, 
            length(unlist(bd$xchg))/2L, (length(unlist(bd$tripfl))/2L) - 
                (length(which(table(unlist(ENT)) > 2L))), length(unlist(bd$full))/2L, 
            lop)
        colnames(bc) <- c("BUNDLES", "NULL", "ASYMM", "RECIP", 
            "T.ENTR", "T.EXCH", "MIXED", "FULL", "LOOP")
        rownames(bc) <- "TOTAL"
    })
    return(bc)
}

