acc1 <- function(cont,nax=min(nrow(cont)-1,ncol(cont)-1),prec=6) { trans <- F # si la matrice a plus de colonnes que de lignes traitement normal if (ncol(cont)>nrow(cont)) { trans <- T # sinon transposition cont <- t(cont) } poil <- apply(cont,1,sum) # poids lignes poic <- apply(cont,2,sum) # poids colonnes nomlig <- rownames(cont) nomcol <- colnames(cont) B11 <- diag(poil) B22 <- diag(poic) B11inv <- diag(1/poil) B22inv <- diag(1/poic) B12 <- cont B21 <- t(cont) matrice <- B22inv %*% B21 %*% B11inv %*% B12 lim <- dim(matrice)[1] # nombre maxi de valeurs propres valp <- eigen(matrice)$values vecp <- eigen(matrice)$vectors diagnorm <- diag(sqrt(valp/diag((t(vecp) %*% B22 %*% vecp)))) vecp <- vecp %*% diagnorm rownames(vecp) <- nomcol vecp1 <- B11inv %*% B12 %*% vecp %*% diag(1/sqrt(valp)) rownames(vecp1) <- nomlig valp <- valp[2:lim] vecpc <- vecp vecpl <- vecp1 if (trans) { vecpc <- vecp1 vecpl <- vecp poi <- poil poil <- poic poic <- poi nom <- nomlig nomlig <- nomcol nomcol <- nom} vecpc <- vecpc[,2:lim] colnames(vecpc) <- paste("axe",1:dim(vecpc)[2]) vecpl <- vecpl[,2:lim] colnames(vecpl) <- paste("axe",1:dim(vecpl)[2]) #print(c(length(valp),dim(vecpl),dim(vecpc),length(poil),length(poic))) #print(c(nomlig,nomcol)) ctrl <- diag(poil) %*% vecpl^2 ctrl <- ctrl %*% diag(1/apply(ctrl,2,sum)) rownames(ctrl) <- nomlig colnames(ctrl) <- paste("axe",1:dim(vecpl)[2]) ctrc <- diag(poic) %*% vecpc^2 ctrc <- ctrc %*% diag(1/apply(ctrc,2,sum)) rownames(ctrc) <- nomcol colnames(ctrc) <- paste("axe",1:dim(vecpc)[2]) cor2l <- diag(1/apply(vecpl^2,1,sum)) %*% vecpl^2 rownames(cor2l) <- nomlig colnames(cor2l) <- paste("axe",1:dim(vecpl)[2]) cor2c <- diag(1/apply(vecpc^2,1,sum)) %*% vecpc^2 rownames(cor2c) <- nomcol colnames(cor2c) <- paste("axe",1:dim(vecpc)[2]) valp <- round(valp,prec) vecpl <- round(vecpl[,1:nax],prec) vecpc <- round(vecpc[,1:nax],prec) ctrl <- round(ctrl[,1:nax],prec) ctrc <- round(ctrc[,1:nax],prec) cor2l <- round(cor2l[,1:nax],prec) cor2c <- round(cor2c[,1:nax],prec) list(valp=round(valp,prec),vecpl=round(vecpl[,1:nax],prec),vecpc=round(vecpc[,1:nax],prec),ctrl=round(ctrl[,1:nax],prec),ctrc=round(ctrc[,1:nax],prec),cor2l=round(cor2l[,1:nax],prec),cor2c=round(cor2c[,1:nax],prec)) #list(axel1 = cbind(poil,vecpl[,1],sign(vecpl[,1])*ctrl[,1],cor2l[,1]),axel2 = cbind(poil,vecpl[,2],sign(vecpl[,2])*ctrl[,2],cor2l[,3]), #axec1 = cbind(poic,vecpc[,1],sign(vecpc[,1])*ctrc[,1],cor2c[,1]),axec2 = cbind(poic,vecpc[,2],sign(vecpc[,2])*ctrc[,2],cor2c[,3])) }