CAIV <- function (L, E = diag(1, dim(L)[1], dim(L)[1]), normE = TRUE)
{
    if (dim(L)[1] != dim(E)[1])
        return("Error in matrix dimension (row number)")
    for (i in 1:dim(L)[1]) for (j in 1:dim(L)[2]) if (L[i, j] <
                                                      0)
        return("Table L must contain non-negative numbers")
    res <- alist()
    Di <- apply(L, 1, sum)
    Di <- diag(Di/(sum(L)), dim(L)[1], dim(L)[1])
    if (sum(diag(Di) == 0) > 0)
        return("Error : row total=0")
    Dj <- apply(L, 2, sum)
    Dj <- diag(Dj/sum(L), dim(L)[2], dim(L)[2])
    if (sum(diag(Dj) == 0) > 0)
        return("Error : column total=0")
    DjInv <- diag((1/diag(Dj)), dim(L)[2], dim(L)[2])
    Centr <- function(Tab, Weights) {
        return(Tab - sum(Weights %*% Tab))
    }
    Ecentr <- apply(E, 2, Centr, Weights = Di)
    Norm <- function(Tab, Weights) {
        return(Tab/sqrt(t(Tab) %*% (Weights) %*% Tab))
    }
    if (normE == TRUE)
        Ecentr <- apply(Ecentr, 2, Norm, Weights = Di)
    T0 <- DjInv %*% (t(L)/sum(L)) %*% Ecentr
    covE <- t(Ecentr) %*% Di %*% Ecentr
    Esvd <- svd(covE)
    qrE <- qr(covE)
    rankE <- qrE$rank
    SemiCovEInv <- Esvd$u[, 1:rankE] %*% diag(Esvd$d[1:rankE]^(-0.5),
                                              rankE, rankE)
    triplet <- svd(t(SemiCovEInv) %*% t(T0) %*% Dj %*% T0 %*%
                   SemiCovEInv)
    res$ev <- triplet$d
    res$B <- SemiCovEInv %*% triplet$u
    res$D <- Esvd$u[, 1:rankE] %*% diag(Esvd$d[1:rankE]^(0.5),
                                        rankE, rankE) %*% triplet$u
    res$R <- Ecentr %*% res$B
    res$F <- T0 %*% res$B
    if (dim(E)[2] == dim(L)[1]) {
        if (sum(E == diag(1, dim(L)[1], dim(L)[1])) == dim(L)[1] *
            dim(L)[1])
            return(res[c("ev", "R", "F")])
    }
    return(res)
}
CAIV.plot <-
    function (obj, x = 1, y = 2, add.row = TRUE, add.col = TRUE,
              add.var = FALSE, row.names = "", col.names = "",
              var.names = "")
{
    opar <- par(mai = par("mai"))
    on.exit(par(opar))
    par(mai = c(1, 1, 0.5, 0.5))
    xmin <- min(obj$R[, x], obj$B[, x], obj$F[, x])
    xmax <- max(obj$R[, x], obj$B[, x], obj$F[, x])
    ymin <- min(obj$R[, y], obj$B[, y], obj$F[, y])
    ymax <- max(obj$R[, y], obj$B[, y], obj$F[, y])
    xet <- c(1.1 * xmin, 1.1 * xmax)
    yet <- c(1.1 * ymin, 1.1 * ymax)
    plot(obj$R[, x], obj$R[, y], type = "n", asp = 1, xlim = xet,
         ylim = yet, xlab = paste("A", x), ylab = paste("A", y),
         font.lab = 2)
    if (add.row == TRUE & row.names == "")
        text(obj$R[, x], obj$R[, y], paste("R", 1:length(obj$R[, x])),
             cex = 0.75, col = "blue")
    if (add.row == TRUE & row.names != "")
        text(obj$R[, x], obj$R[, y], row.names, cex = 0.75, col = "blue")
    if (add.col == TRUE & col.names == "")
        text(obj$F[, x], obj$F[, y], paste("C", 1:length(obj$F[, x])),
             cex = 0.75, col = "red")
    if (add.col == TRUE & col.names != "")
        text(obj$F[, x], obj$F[, y], col.names, cex = 0.75, col = "red")
    if (add.var == TRUE & var.names == "") {
        text(obj$B[, x], obj$B[, y], paste("Var", 1:length(obj$B[, x])),
             cex = 0.75, pos = 3)
        arrows(0, 0, obj$B[, x], obj$B[, y], length = 0.1)
    }
    if (add.var == TRUE & var.names != "") {
        text(obj$B[, x], obj$B[, y], var.names, cex = 0.75, pos = 3)
        arrows(0, 0, obj$B[, x], obj$B[, y], length = 0.1)
    }
}
