TESE anexos v5 - ULisboa...126 Anexos A. Demonstração do Primeiro Resultado em 4.2.2.1 Neste anexo...
Transcript of TESE anexos v5 - ULisboa...126 Anexos A. Demonstração do Primeiro Resultado em 4.2.2.1 Neste anexo...
Anexos
126 Anexos
A. Demonstração do Primeiro Resultado em 4.2.2.1
Neste anexo podemos aceder à demonstração da relação exposta em (4.2.2.1)
�����∗������∗ = ��� , �∗ = � − ��� Ou seja, partindo da expressão à esquerda na equação anterior e multiplicando
à direita por ������ , resulta
�����∗������∗ = �����∗������∗������ Onde, segundo a relação estabelecida em (3.31), � = �����∗����, temos
�����∗���� Jogando novamente com a expressão ������ e tendo em consideração a
expressão definida em (3.32), = �����∗�� ����, obtemos
�����∗�� ������ �� = �� �� = ��� Cujos valores próprios associados são
� = ��
B. Demonstração do Segundo Resultado em 4.2.2.1
Neste anexo pretende-se demonstrar a segunda relação exposta em (4.2.2.1)
Desenvolvendo esta expressão e tendo em conta que �∗ = � − ���, temos
�2 � ���� 00 ����� � �
2� − 1� � 1
2 � � � �!� �" � �2� − 1
� � 12 � � � �! #$ = ��#� # ⟺
� 12� � ���� 0
0 ����� &�� − � � � ��'� (� − �) � �*+#$ = ��#� # ⟺
� 12� � ���� 0
0 ����� ���� − ���) � �* − � � � ��� + � � � ��� � � � �! #$ = ��#� # ⟺
Considerando a relação da massa da coluna �# = ��- ���
Análise de Correspondências Generalizada 127
� 12� ����� 0
0 ����� ���� − (2��#+) � �* − � � � �2� 12� � � �
�! + � � � � � � � �! #$= ��#� # ⟺
� 12� � ���� 0
0 ����� ���� − � � � � � � � � − � � � � � � � � + � � � � � � � �! #$ = ��#� # ⟺
� 12� � ���� 0
0 ����� ���� − � � � � � � � �! #$ = ��#� # ⟺
A matriz ��� é uma matriz de Burt. Portanto, para duas variáveis, apresenta a
seguinte estrutura
� 12� � ���� 0
0 ����� .������ ���������� ����� � − � /��� ���
��� ���01 #$ = ��#� #
Como ����� = ��� e ����� = �� e ����� = ��� e ainda ����� = ���, resulta
� 12� � ���� 0
0 ����� �/��� ����� ���0 − � /��� ���
��� ���0! #$ = ��#� # ⟺
�12 � ���� 0
0 ����� �/�� ��� ��0 − /��� ���
��� ���0! #$ = ��#� # ⟺
�12 � ���� 0
0 ����� .��� − ��� � − ����� − ��� �� − ����1
#$ = ��#� # ⟺
�12 � ���� 0
0 ����� .�" − ���2��� ���2�∗���2�∗� " − ���2����1
#$ = ��#� #
Sendo ���2� = � = ���2� , vem �1
2 � ���� 00 ����� .� " − ��� ���2�∗
���2�∗� " − ����1 #$ = ��#� #
Considerando a partição de # em
# = /#�#�0 A expressão anterior pode ser simplificada, originando as seguintes equações
(" − ���+#� + ���2�∗#� = 2#���#� (a)
���2�∗�#� + (" − ���+#� = 2#���#� (b)
128 Anexos
Multiplicando a primeira equação (a) à esquerda por �����∗�, temos
3�����∗�4(" − ���+#� + (�����∗�+ ���2�∗#� = 23�����∗�4#���#� ⟺ �����∗����2�∗#� = 2 �����∗�#���#� − �����∗�(" − ���+#� ⟺
�����∗����2�∗#� = 2 �����∗�#���#� − �����∗�#� + �����∗����#�
Como �∗�� = 0, resulta �����∗����2�∗#� = 2 �����∗�#���#� − �����∗�#� ⟺
�����∗����2�∗#� = (2 ��#� − "+ �����∗�#� (c)
Da segunda expressão deduzida (b), tiramos
���2�∗�#� = 2#���#� − (" − ���+#�
E substituindo na expressão deduzida em (c), adquirimos a expressão
�����∗����2�∗#� = (2 ��#� − "+ 52#���#� − (� − ���+#�6 Desenvolvendo a segunda parte da equação anterior, temos
(2 ��#� − "+ 52#���#� − �# + ���#�6 = (2 ��#� − "+ 5 32 ��#� − "4#� + ���#�6 =
#�(2��#� − "+� + ���#�32��#� − "4 = #�(2��#� − "+� + ���#�32��#� − ��#���#��4 Tendo em conta a expressão (b), ou seja
2#���#� = ���2�∗�#� + (" − ���+#�
Podemos escrever a expressão de outra forma, isto é, retomando o
desenvolvimento
#�(2��#� − "+� + ���(2#���#�+ − 12 ���(2#���#�+��#�� =
#�(2��#� − "+� + ��� 7�����∗�#� + (" − ���+#�8 − ���2 7�����∗�#� + (" − ���+#�8 ��#��
Formulando a expressão, sendo ������ = ��, resulta
#�(2��#� − "+� + ����∗�#� + ���(" − ���+#� − 12 7���∗�#� + ���(" − ���+#�8 ��#��
Onde ���∗� = 0, #�(2��#� − "+� + ���(" − ���+#� − 1
2 5���(" − ���+#�6��#�� =
Análise de Correspondências Generalizada 129
#�(2��#� − "+� + ���#� − ������#� − 12 5���#� − ������#�6��#��
Como ������ = ���, a expressão anterior resume-se a apenas
#�(2��#� − "+� + ���#� − ���#� − 12 5���#� − ���#�6��#�� = #�(2��#� − "+�
Logo,
�����∗����2�∗ #� = (2 ��#� − "+� #�
Multiplicando igualmente (b) à esquerda por �����∗ obtém-se
�����∗ ���2 �∗�#� = (2 ��#� − "+� #�
C. Demonstração do Resultado em 4.2.2.2
Retomando a igualdade demonstrada no anexo B,
��#���#∗���#���#∗ # = ��#� # , �∗ = � − ���
Temos,
��9��(�: − �9�9�+� ��#�� (�: − �9�9�+ # = ��#� # ⟺
��9��(�9� − �9 �9�+ �" (�: − �9�9�+ # = ��#� # ⟺
� ��9��(�9��: − �9� �9�9� − �9 �9��: + �9 �9� �9�9�+ # = ��#� # Substituindo �: e tendo em consideração que ��9�� = ��;�� e �# = �
- � , vem
� ��;�� .��<�
�<� − 1
���<� � �9� − 1
� �9 �� �<� + 1
�� �9 ��� �9�1 # = ��#� #
Logo, como �=>- � = �9 = �; e �; = @
>A- = �=�>A- e ��� = �, temos
� ��;�� .�;� – �; �;�� − �; �;�� + �; �;�� 1 # = ��#� # ⟺
��;��(�; – �; �;�+ # = ��#� #
130 Anexos
Como �; = �; , podemos reescrever a função anterior
��;��(�; – �; �;�+ # = ��#� # ⟺
��;���;∗ # = ��#� #
Onde, por outro lado, aplicando o mesmo desenvolvimento à matriz de Burt,
obtém-se facilmente
��;���;∗���;���;∗ ; = ��;� ; ⟺ 3 ��;���;∗43��;���;∗4 ; = ��;� ; ⟺ 3 ��;���;∗4C; = ��;� ;
Chegando assim à conclusão que λ;� = λ9� .
D. Rotinas em “R”.
D.1 Análise de Correspondências
ac <- function(dados){ # Matriz inicial de dados: K <- dados # Matriz de correspondências: F <- K / sum(K) # numero de linhas e colunas: n <- nrow(F) p <- ncol(F) # vectores unitários: ul(n*1) uc(p*1) ul <- matrix(c(rep(1,n)),n,1) uc <- matrix(c(rep(1,p)),p,1) # Totais marginais linha e coluna: l <- F %*% uc c <- t(F) %*% ul # Matrizes diagonais dos pesos: Dl <- diag(n) Dc <- diag(p) for (i in 1:n) Dl[i,i] <- l[i] for (i in 1:p) Dc[i,i] <- c[i] # Perfis linha e coluna: L <- solve(Dl) %*% F C <- solve(Dc) %*% t(F) # Matriz dos resíduos estandardizados: S <- sqrt(solve(Dl)) %*% {F - l%*%t(c)} %*% sqrt(solve(Dc))
Análise de Correspondências Generalizada 131
# Decomposição em valores singulares: dvs <- svd(S) # Valores próprios: lam <- dvs$d^2 # Matriz diagonal: Dlam <- matrix(0,p,p) for (i in 1:p) Dlam[i,i] <- lam[i] # % explicação de cada eixo: expl <- 100 * (lam / sum(lam)) # coordenadas das colunas: ro <- (solve(sqrt(Dc)) %*% dvs$v) %*% sqrt(Dlam) # coordenadas das linhas: fi <- (solve(sqrt(Dl)) %*% dvs$u) %*% sqrt(Dlam) # contribuicoes relativas: # colunas crc.1 <- 100 * (ro[,1]^2 / (ro[,1]^2+ro[,2]^2)) crc.2 <- 100 * (ro[,2]^2 / (ro[,1]^2+ro[,2]^2)) # linhas crl.1 <- 100 * (fi[,1]^2 / (fi[,1]^2+fi[,2]^2)) crl.2 <- 100 * (fi[,2]^2 / (fi[,1]^2+fi[,2]^2)) # contribuicoes absolutas: # colunas cac.1 <- 100 * dvs$v[,1]^2 cac.2 <- 100 * dvs$v[,2]^2 # linhas cal.1 <- 100 * dvs$u[,1]^2 cal.2 <- 100 * dvs$u[,2]^2 # Tabelas resumo: # Valores próprios e % explicação: print("Resumo", quote=FALSE) vpp <- data.frame(round(lam, 2), round(expl,1), round(cumsum(expl),1)) colnames(vpp) <- c("Valor pp","% expl", "% expl. acumulado") print(vpp) # colunas: print("Colunas:", quote=FALSE) col <- data.frame(round(c,3), round(ro1,3), round(ro2,3), round(cac.1,1), round(cac.2,1), round(crc.1,1), round(crc.2,1)) colnames(col) <- c("Peso", "CoordenadaX", "CoordenadaY", "CaX", "CaY", "CrX", "CrY") print(col) # linhas: print("Linhas:", quote=FALSE) lin <- data.frame(round(l,3), round(fi1,3), round(fi2,3), round(cal.1,1), round(cal.2,1), round(crl.1,1), round(crl.2,1)) colnames(lin) <- c("Peso", "CoordenadaX", "CoordenadaY", "CaX", "CaY", "CrX", "CrY") print(lin) # Gráfico: ac.biplot <- function(rx, ry, cx, cy, dados) { simbolos=c(21,22,24,25,23,15:20,0:2,5:7,9:14,8,3,4) pc <- simbolos limsupx <- 0 liminfx <- 0 if (max(rx)>max(cx)){limsupx <- max(rx)} else {limsupx <- max(cx)} if (min(rx)>min(cx)){liminfx <- min(cx)} else {liminfx <- min(rx)} limsupy <- 0 liminfy <- 0 if (max(ry)>max(cy)){limsupy <- max(ry)} else {limsupy <- max(cy)}
132 Anexos
if (min(ry)>min(cy)){liminfy <- min(cy)} else {liminfy <- min(ry)} par(mar=c(2,2,1,1)) plot.default(cx,cy, xlim=c(liminfx*1.1,limsupx*1.1), ylim=c(liminfy*1.1,limsupy*1.1), axes=FALSE, pch="", xlab=paste(""), ylab="", cex=2, panel.first = grid(9,9)) par(new=TRUE) matplot(rx, ry, xlim=c(liminfx*1.1,limsupx*1.1), ylim=c(liminfy*1.1,limsupy*1.1), axes=FALSE, xlab ="", ylab="" , pch=".", cex=2, col="transparent") for(i in 1:dim(dados)[1]) { points(rx[i],ry[i], pch=pc[1], cex=0.9, col="blue", bg="turquoise") text(rx[i], ry[i], labels = rownames(dados)[i], pos=3, cex=0.8) } axis(1, col="black", lwd = 1) axis(2, col="black", lwd = 1) box(col="black", lwd = 1) abline(h=0, v=0, lwd=0.5, lty="dotted", col="black") for(i in 1:dim(dados)[2]) { points(cx[i],cy[i], pch=pc[3], cex=1.3, col="maroon", bg="red") text(cx[i], cy[i], labels = colnames(dados)[i], pos=3, cex=1) } title(main=c(""), line=1,col.main = "blue3")
legend(liminfx*1.1, limsupy*1.1, legend= colnames(dados), col="blue", pch = simbolos[1:dim(dados)[2]], merge = FALSE, bg = 'transparent', pt.bg="turquoise", pt.cex=1.5)
text(limsupx,0-limsupy*0.1, labels=bquote(lambda[1] == .(round(lam[1],4))),cex= 0.9) text(limsupx*0.98,0-limsupy*0.175, labels=c(round(expl[1],2)," %"),cex= 1.1) text(0+limsupx*0.2,limsupy, labels=bquote(lambda[2] == .(round(lam[2],4))),cex= 0.9) text(0+limsupx*0.18,limsupy*0.93, labels=c(round(expl[2],2)," %"),cex= 1.1) text(limsupx*0.55,liminfy*1.1, labels=c(round(expl[2]+expl[1],2),"Qualidade = % "),cex= 0.8, col="black") } ac.biplot(fi[,1],fi[,2],ro[,1],ro[,2],dados)
}
D.2 Análise de Correspondências Múltiplas
acm <- function(base.dados, var.sup, tipo){ # tipo = "dc" > ACM via Matriz Disjuntiva Completa # tipo = "burt" > ACM via Matriz de Burt # var.sup = 0 > ausência de variáveis suplementares # Matriz inicial de dados: if (min(var.sup)!=0){ dados <- base.dados[, -var.sup] dados.sup <- base.dados[, var.sup] } else { dados <- base.dados } # número de indivídus: I I <- nrow(dados) # número de variáveis: Q Q <- ncol(dados) # Criar matrix disjuntiva completa (Z): # numero de J.q de resposta por variável: J.q <- unlist(lapply(base.dados, nlevels))
Análise de Correspondências Generalizada 133
# numero de J.q acumuladas J.q.cum <- cumsum(J.q) J <- sum(J.q) Q.t<-ncol(base.dados) Z<-matrix(0, nrow= I, ncol= J) basedados2<-lapply(base.dados, as.numeric) cat<-(c(0, J.q.cum[-length(J.q.cum)])) for (i in 1:Q.t) { Z[1:I + (I*(cat[i] + basedados2[[i]]-1))]<-1 } coluna.n<-rep(names(base.dados), unlist(lapply(base.dados, nlevels))) niveis <- unlist(lapply(base.dados, levels)) dimnames(Z)[[2]] <- paste(coluna.n, niveis, sep="") dimnames(Z)[[1]] <- as.character(1:I) if (min(var.sup)!=0){ cat.sup <- range(J.q.cum[var.sup]) Z.var.sup <- (cat.sup[1]-1):cat.sup[2] Z.dc <- Z[, -Z.var.sup] } else { Z.dc <- Z } J <- ncol(Z.dc) if (tipo=="dc"){ # Matriz de correspondencias: F <- Z.dc / sum(Z.dc) # Totais marginais coluna: c <- apply(F, 2, sum) # Totais marginais linha: l <- apply(F, 1, sum) # Aproximação de F: lc <- l %*% t(c) S <- (F - lc) / sqrt(lc) # Decomposição em valores singulares: dvs <- svd(S) # Valores próprios: lam <- dvs$d[1:(J-Q)]^2 # % explicação de cada eixo: expl <- 100*(lam / sum(lam)) # % inercia ajustada: lam.adj <- (Q / (Q-1))^2 * (lam[lam >= 1/Q] - 1/Q)^2 total.adj <- (Q / (Q-1)) * (sum(lam^2) - ((J-Q) / Q^2)) expl.adj <- 100 * (lam.adj / total.adj) # coordenadas das colunas: ro1 <- (dvs$v[,1] / sqrt(c)) * sqrt(lam[1]) ro2 <- (dvs$v[,2] / sqrt(c)) * sqrt(lam[2]) # coordenadas das linhas: fi1 <- (dvs$u[,1] / sqrt(l)) * sqrt(lam[1]) fi2 <- (dvs$u[,2] / sqrt(l)) * sqrt(lam[2]) # contribuicoes relativas: # colunas crc.1 <- 100 * (ro1^2 / (ro1^2+ro2^2)) crc.2 <- 100 * (ro2^2 / (ro1^2+ro2^2)) # linhas crl.1 <- 100 * (fi1^2 / (fi1^2+fi2^2)) crl.2 <- 100 * (fi2^2 / (fi1^2+fi2^2)) # contribuicoes absolutas: # colunas
134 Anexos
cac.1 <- 100 * dvs$v[,1]^2 cac.2 <- 100 * dvs$v[,2]^2 # linhas cal.1 <- 100 * dvs$u[,1]^2 cal.2 <- 100 * dvs$u[,2]^2 # Tabelas resumo: # Valores próprios e % explicação: aux <- length(expl.adj) print("Resumo", quote=FALSE) vpp <- data.frame(round(lam[1:aux], 2), round(expl[1:aux],1), round(cumsum(expl[1:aux]),1), round(expl.adj[1:aux],1), round(cumsum(expl.adj[1:aux]),1)) colnames(vpp) <- c("Valor pp","% expl", "% expl. acumulado", "% ajust.", "% ajust. acumulada") print(vpp) # colunas: print("Colunas:", quote=FALSE) col <- data.frame(round(c,3), round(ro1,3), round(ro2,3), round(cac.1,1), round(cac.2,1), round(crc.1,1), round(crc.2,1)) colnames(col) <- c("Peso", "CoordenadaX", "CoordenadaY", "CaX", "CaY", "CrX", "CrY") print(col) # linhas: print("Linhas:", quote=FALSE) lin <- data.frame(round(l,3), round(fi1,3), round(fi2,3), round(cal.1,1), round(cal.2,1), round(crl.1,1), round(crl.2,1)) colnames(lin) <- c("Peso", "CoordenadaX", "CoordenadaY", "CaX", "CaY", "CrX", "CrY") print(lin) # Coordenadas suplementares if (min(var.sup)!=0){ Z.star <- Z[, Z.var.sup] I.star <- nrow(Z.star) cs.star <- apply(Z.star, 2, sum) base <- Z.star / matrix(rep(cs.star, I.star), nrow = I.star, byrow = TRUE) b.star1 <- t(base) %*% cbind(fi1, fi2) } # Gráfico: acm.biplot <- function(rx, ry, cx, cy, Q, cat, cumcat, nomes, dados) { simbolos=c(21,22,24,25,23,15:20,0:2,5:7,9:14,8,3,4) pc <- rep(0, cumcat[Q]) pc[1:cumcat[1]] <- rep((simbolos[1]), J.q[1]) for(i in 1:(Q-1)) { pc[(1+cumcat[i]):(cumcat[i+1])] <- rep((simbolos[i+1]), J.q[i+1]) } limsupx <- 0 liminfx <- 0 if (max(rx)>max(cx)){limsupx <- max(rx)} else {limsupx <- max(cx)} if (min(rx)>min(cx)){liminfx <- min(cx)} else {liminfx <- min(rx)} limsupy <- 0 liminfy <- 0 if (max(ry)>max(cy)){limsupy <- max(ry)} else {limsupy <- max(cy)} if (min(ry)>min(cy)){liminfy <- min(cy)} else {liminfy <- min(ry)} #par(mar=c(5,4,3,1)) par(mar=c(2,2,1,1))
plot.default(cx,cy, axes=FALSE, pch="", xlim=c(liminfx*1.1,limsupx*1.1), ylim=c(liminfy*1.1,limsupy*1.1),
xlab=paste(""), ylab="", cex=2, panel.first = grid(9,9)) par(new=TRUE)
Análise de Correspondências Generalizada 135
matplot(rx, ry, axes=FALSE, xlim=c(liminfx*1.1,limsupx*1.1), ylim=c(liminfy*1.1,limsupy*1.1), xlab ="", ylab="" , pch=".", cex=2)
axis(1, col="black", lwd = 1) axis(2, col="black", lwd = 1) box(col="black", lwd = 1) abline(h=0, v=0, lwd=0.5, lty="dotted", col="black") for(i in 1:cumcat[Q]) { points(cx[i],cy[i], pch=pc[i], cex=1.5, col="blue", bg="turquoise") text(cx[i], cy[i], labels = nomes[i], pos=3, cex=1) } title(main="", line=1,col.main = "blue3") #mtext(side=3, line=-1.5, cex=0.8, bquote(lambda[2] == .(round(lam[2],4)))) #text(max(rx)-1,y = NULL, pos=4, cex=0.8, bquote(lambda[1] == .(round(lam[1],2))))
legend(locator(1), legend= names(dados), col="blue", pch = simbolos[1:Q], merge = FALSE, bg = 'transparent', pt.bg="turquoise", pt.cex=1.5)
text(locator(1), labels=bquote(lambda[1] == .(round(lam[1],4))),cex= 0.9) text(locator(1), labels=c(round(expl[1],2)," %"),cex= 1.1) text(locator(1), labels=bquote(lambda[2] == .(round(lam[2],4))),cex= 0.9) text(locator(1), labels=c(round(expl[2],2)," %"),cex= 1.1) text(locator(1), labels=c(round(expl.adj[1],2)," %"),cex= 1.1,col="darkred") text(locator(1), labels=c(round(expl.adj[2],2)," %"),cex= 1.1,col="darkred")
text(locator(1), labels=c(round(expl[2]+expl[1],2),"Qualidade = %"),cex= 0.8, col="black") text(locator(1), labels=c(round(sum(lam),6),"Inércia = "),cex= 0.8, col="black") text(locator(1), labels=c(round(expl.adj[2]+expl.adj[1],2)," ( %)"),cex= 1, col="darkred") } # Output do gráfico através da matriz disjuntiva completa: print("MCA através da matriz disjuntiva completa:", quote = FALSE) print("", quote=FALSE) # Alterar o tipo de plot: acm.biplot(fi1, fi2, ro1, ro2, Q, J.q, J.q.cum, dimnames(Z)[[2]], dados) if (min(var.sup)!=0){ nomes.sup <- c("S1","S2","Id1","Id2","Id3","Id4") pc2<-c(21,21,24,24,24,24) for(i in (J.q.cum[Q-2]+1):(J.q.cum[Q]+2)) { i<-(i-(J.q.cum[Q-2])) points(b.star1[,1][i],b.star1[,2][i], pch=pc2[i], cex=1.5, col="maroon", bg="red") text(b.star1[,1][i], b.star1[,2][i], labels = nomes.sup[i], pos=3, cex=1, col="darkred") i<-(i+(J.q.cum[Q-2])) } } # Fim do if sobre a AC de uma matriz disjuntiva completa: } if (tipo=="burt"){ # Matriz de Burt: Burt <- t(Z.dc) %*% Z.dc # Matriz de correspondências: F.b <- Burt / sum(Burt) # Totais marginais coluna: c.b <- apply(F.b, 2 , sum) # Aproximação de F.burt: lc.b <- c.b %*% t(c.b) S.b <- (F.b - lc.b) / sqrt(lc.b) # Decomposição em valores próprios: dvs.b <- eigen(S.b) # Valores próprios: alpha <- dvs.b$values[1:(J-Q)] # % explicação de cada eixo:
136 Anexos
expl.b <- 100 * (alpha / sum(alpha)) # % inercia ajustada: lam.adj <- (Q / (Q-1))^2 * (alpha[alpha >= 1/Q] - 1/Q)^2 total.adj <- (Q / (Q-1)) * (sum(alpha^2) - ((J-Q) / Q^2)) expl.adj <- 100 * round(lam.adj / total.adj, 3) # coordenadas das colunas (ou linhas): ro1 <- (dvs.b$vectors[,1] / sqrt(c.b)) * sqrt(alpha[1]^2) ro2 <- (dvs.b$vectors[,2] / sqrt(c.b)) * sqrt(alpha[2]^2) # contribuicoes relativas: crb.1 <- 100 * (ro1^2 / (ro1^2+ro2^2)) crb.2 <- 100 * (ro2^2 / (ro1^2+ro2^2)) # contribuicoes absolutas: cab.1 <- 100 * dvs.b$vectors[,1]^2 cab.2 <- 100 * dvs.b$vectors[,2]^2 # Tabelas resumo: # Valores próprios e % explicação: aux <- length(expl.adj) print("Resumo", quote=FALSE) vpp <- data.frame(round(alpha[1:aux], 2), round(expl.b[1:aux],1), round(cumsum(expl.b[1:aux]),1), round(expl.adj[1:aux],1), round(cumsum(expl.adj[1:aux]),1)) colnames(vpp) <- c("Valor pp","% expl", "% expl. acumulado", "% ajust.", "% ajust. acumulada") print(vpp) # colunas (ou linhas): print("Colunas (ou linhas):", quote=FALSE) col <- data.frame(round(c.b,3), round(ro1,3), round(ro2,3), round(cab.1,1), round(cab.2,1), round(crb.1,1), round(crb.2,1)) colnames(col) <- c("Peso", "CoordenadaX", "CoordenadaY", "CaX", "CaY", "CrX", "CrY") print(col) # Coordenadas suplementares if (min(var.sup)!=0){ Z.star <- Z[, Z.var.sup] ct.star <- t(Z.star) %*% Z.dc I.star2 <- dim(ct.star)[2] cs.star2 <- apply(ct.star, 1, sum) base2 <- ct.star / matrix(rep(cs.star2, I.star2), ncol = I.star2) b.star2 <- base2 %*% cbind(ro1, ro2) } # Gráfico: acm.biplot.burt <- function(cx, cy, Q, cat, cumcat, nomes, dados) {
plot.default(cx,cy, pch="", axes=FALSE, xlim=range(cx)*1.2, ylim=range(cy)*1.2, xlab=paste(""), ylab="", cex=2, panel.first = grid(9,9))
axis(1, col="black", lwd = 1) axis(2, col="black", lwd = 1) box(col="black", lwd = 1) par(new=TRUE) abline(h=0, v=0, lwd=0.5, lty="dotted", col="black") simbolos=c(21,22,24,25,23,15:20,0:2,5:7,9:14,8,3,4) pc <- rep(0, cumcat[Q]) pc[1:cumcat[1]] <- rep((simbolos[1]), J.q[1]) for(i in 1:(Q-1)) { pc[(1+cumcat[i]):(cumcat[i+1])] <- rep((simbolos[i+1]), J.q[i+1]) } for(i in 1:cumcat[Q]) { points(cx[i],cy[i], pch=pc[i], cex=1.5, col="blue", bg="turquoise") #text(cx[i] -0.1, cy[i], labels = nomes[i], adj=c(0.5, 0.5))
Análise de Correspondências Generalizada 137
text(cx[i], cy[i], labels = nomes[i], pos=3, cex=0.8) } title(main="", line=1,col.main = "blue3")
legend(locator(1), legend= names(dados), col="blue", pch = simbolos[1:Q], merge = FALSE, bg = 'transparent', pt.bg="turquoise", pt.cex=1.5)
text(locator(1), labels=bquote(lambda[1] == .(round(alpha[1],4))),cex= 0.9) text(locator(1), labels=c(round(expl.b[1],2)," %"),cex= 1.1) text(locator(1), labels=bquote(lambda[2] == .(round(alpha[2],4))),cex= 0.9) text(locator(1), labels=c(round(expl.b[2],2)," %"),cex= 1.1) # Ajustados: text(locator(1), labels=c(round(expl.adj[1],2)," %"),cex= 1.1,col="darkred") text(locator(1), labels=c(round(expl.adj[2],2)," %"),cex= 1.1,col="darkred")
text(locator(1), labels=c(round(expl.b[2]+expl.b[1],2),"Qualidade = % "),cex= 0.8, col="black")
text(locator(1), labels=c(round(sum(alpha),4),"Inércia = "),cex= 0.8, col="black") text(locator(1), labels=c(round(expl.adj[2]+expl.adj[1],2)," ( %)"),cex= 1, col="darkred") } # Output do gráfico através da matriz disjuntiva completa: print("MCA através da matriz de burt:", quote = FALSE) print("", quote=FALSE) # Alterar o tipo de plot: acm.biplot.burt(ro1,ro2, Q, J.q, J.q.cum, dimnames(Z)[[2]], dados) if (min(var.sup)!=0){ nomes.sup <- c("S1","S2","Id1","Id2","Id3","Id4") pc2<-c(21,21,24,24,24,24) for(i in (J.q.cum[Q-2]+1):(J.q.cum[Q]+2)) { i<-(i-(J.q.cum[Q-2])) points(b.star2[,1][i],b.star2[,2][i], pch=pc2[i], cex=1.5, col="maroon", bg="red") text(b.star2[,1][i], b.star2[,2][i], labels = nomes.sup[i], pos=3, cex=0.8) i<-(i+(J.q.cum[Q-2])) } } # Fim da AC sobre uma matriz de Burt: } # Fim da função:
}
D.3 Análise de Correspondências Conjuntas
Adapatado de Greenacre (2005): acc <- function(base.dados){
# Matriz inicial de dados: dados <- base.dados # número de indivídus: I I <- nrow(dados) # número de variáveis: Q Q <- ncol(dados) # Criar matrix disjuntiva completa (Z): # numero de J.q de resposta por variável: J.q <- unlist(lapply(base.dados, nlevels)) # numero de J.q acumuladas
138 Anexos
J.q.cum <- cumsum(J.q) J <- sum(J.q) Q.t<-ncol(base.dados) Z<-matrix(0, nrow= I, ncol= J) basedados2<-lapply(base.dados, as.numeric) cat<-(c(0, J.q.cum[-length(J.q.cum)])) for (i in 1:Q.t) { Z[1:I + (I*(cat[i] + basedados2[[i]]-1))]<-1 } coluna.n<-rep(names(base.dados), unlist(lapply(base.dados, nlevels))) niveis <- unlist(lapply(base.dados, levels)) dimnames(Z)[[2]] <- paste(coluna.n, niveis, sep="") dimnames(Z)[[1]] <- as.character(1:I) Z.dc <- Z J <- ncol(Z.dc) # Matriz de Burt: Burt <- t(Z.dc) %*% Z.dc # Actualização da matrix de burt (JCA) nd <- 2 maxit <- 1000 epsilon <- 0.0001 lev <- J.q n <- sum(Burt) li <- as.vector(c(0, cumsum(lev))) dummy <- matrix(0, J, J) for (i in 1:(length(li)-1)) { ind.lo <- li[i] + 1 ind.up <- li[i + 1] ind.ti <- diff(li)[1] dummy[rep(ind.lo:ind.up, ind.ti) + (rep(ind.lo:ind.up, each = ind.ti) -1) * J] <- 1 } iterate <- function(obj, dummy, nd, adj = FALSE) { Bp <- obj / n cm <- apply(Bp, 2, sum) eP <- cm %*% t(cm) cm.mat <- diag(cm^(-0.5)) S <- cm.mat %*% (Bp - eP) %*% cm.mat dec <- eigen(S) lam <- dec$values u <- dec$vectors phi <- u[, 1:nd] / matrix(rep(sqrt(cm), nd), ncol = nd) if (adj) lam <- (Q / (Q-1))^2 * (lam[lam >= 1 / Q])^2 for (s in 1:nd) { if (exists("coord")) { coord <- coord + lam[s] * (phi[, s] %*% t(phi[, s])) } else { coord <- lam[s] * (phi[, s] %*% t(phi[, s])) } } obj * (1 - dummy) + n * eP * dummy * (1 + coord) } # first iteration (adjusted lambda) B.star <- iterate(Burt, dummy, 2, adj=TRUE) # subsequent iterations k <- 1 it <- TRUE
Análise de Correspondências Generalizada 139
while(it) { temp <-iterate(B.star, dummy, 2) delta.B <- max(B.star - temp) B.star <- temp if (delta.B <= epsilon | k >= maxit) it <- FALSE k <- k+1 } # Matriz de correspondências: F.c <- B.star / sum(B.star) # Totais marginais coluna: c.c <- apply(F.c, 2, sum) # Aproximação de F.c (Através da matriz de Burt actualizada): lc.c <- c.c %*% t(c.c) S.c <- (F.c - lc.c) / sqrt(lc.c) # Decomposição em valores próprios: dvs.c <- eigen(S.c) # Valores próprios: alpha.c <- eigen(S.c)$values lam.c <- alpha.c^2 # % explicação de cada eixo: expl.c <- 100 * (lam.c / sum(lam.c)) # coordenadas das colunas (ou linhas): ro1 <- (dvs.c$vectors[,1] / sqrt(c.c)) * sqrt(lam.c[1]) ro2 <- (dvs.c$vectors[,2] / sqrt(c.c)) * sqrt(lam.c[2]) # contribuicoes relativas: cr.c1 <- 100 * (ro1^2 / (ro1^2+ro2^2)) cr.c2 <- 100 * (ro2^2 / (ro1^2+ro2^2)) # contribuicoes absolutas: ca.c1 <- 100 * dvs.c$vectors[,1]^2 ca.c2 <- 100 * dvs.c$vectors[,2]^2 # Tabelas resumo: # Valores próprios e % explicação: aux <- length(expl.c) print("Resumo", quote=FALSE) vpp <- data.frame(round(lam.c[1:length(lam.c)], 2), round(expl.c[1:length(lam.c)],1), round(cumsum(expl.c[1:length(lam.c)]),1)) colnames(vpp) <- c("Valor pp","% expl", "% expl. acumulado") print(vpp) # colunas (ou linhas): print("Colunas (ou linhas):", quote=FALSE) col <- data.frame(round(c.c,3), round(ro1,3), round(ro2,3), round(ca.c1,1), round(ca.c2,1), round(cr.c1,1), round(cr.c2,1)) colnames(col) <- c("Peso", "CoordenadaX", "CoordenadaY", "CaX", "CaY", "CrX", "CrY") print(col) # subinr <- function(Burt, ind) { nn <- length(ind) subi <- matrix(NA, nrow= nn, ncol = nn) ind2 <- c(0, cumsum(ind)) for (i in 1:nn) { for (j in 1:nn) { tempmat <- Burt[(ind2[i] + 1):(ind2[i + 1]), (ind2[j] + 1):(ind2[j + 1])] tempmat <- tempmat / sum(tempmat) ec <- apply(tempmat, 2, sum) ex <- ec %*% t(ec) subi[i, j] <- sum((tempmat - ex)^2 / ex) }
140 Anexos
} subi / nn^2 } si <- subinr(B.star, lev) print( round(si, 5)) # Gráfico: mca.biplot.burt2 <- function(cx, cy, Q, cat, cumcat, nomes, dados) { par(mar=c(2,2,1,1))
plot.default(cx,cy, pch="",axes=FALSE, xlim=range(cx)*1.2, ylim=range(cy)*1.2, xlab=paste(""), ylab="", cex=2, panel.first = grid(9,9))
axis(1, col="black", lwd = 1) axis(2, col="black", lwd = 1) box(col="black", lwd = 1) abline(h=0, v=0, lwd=0.5, lty="dotted", col="black") simbolos=c(21,22,24,25,23,15:20,0:2,5:7,9:14,8,3,4) pc <- rep(0, cumcat[Q]) pc[1:cumcat[1]] <- rep((simbolos[1]), J.q[1]) for(i in 1:(Q-1)) { pc[(1+cumcat[i]):(cumcat[i+1])] <- rep((simbolos[i+1]), J.q[i+1]) } for(i in 1:cumcat[Q]) { points(cx[i],cy[i], pch=pc[i], cex=1.5, col="blue", bg="turquoise") #text(cx[i] -0.1, cy[i], labels = nomes[i], adj=c(0.5, 0.5)) text(cx[i], cy[i], labels = nomes[i], pos=3, cex=0.8) } title(main=c(""), line=1,col.main = "blue3") legend(locator(1), legend= colnames(dados), col="blue", pch = simbolos[1:dim(dados)[2]], merge = FALSE, bg = 'transparent', pt.bg="turquoise", pt.cex=1.5) text(locator(1), labels=bquote(lambda[1] == .(round(lam.c[1],4))),cex= 0.9) text(locator(1), labels=c(round(expl.c[1],2)," %"),cex= 1.1) text(locator(1), labels=bquote(lambda[2] == .(round(lam.c[2],4))),cex= 0.9) text(locator(1), labels=c(round(expl.c[2],2)," %"),cex= 1.1) text(locator(1), labels=c(round(expl.c[2]+expl.c[1],2),"Qualidade = % "),cex= 0.8, col="black") inercia <- {(lam.c[1]+lam.c[2])-sum(diag(si))}/{sum(lam.c)-sum(diag(si))}*100 text(locator(1), labels=c(round(inercia,2),"( %)"),cex= 1.1, col="darkred") } mca.biplot.burt2(ro1,ro2, Q, J.q, J.q.cum, dimnames(Z)[[2]], dados)
}
D.4 Análise de Correspondências Generalizada
acg <- function(dados, A, B){ # Matriz inicial de dados: K <- dados # Matriz de correspondencias: F <- K / sum(K) # numero de linhas e colunas: n <- nrow(F) p <- ncol(F) # vectores unitários: ul(n*1) uc(p*1) ul <- matrix(c(rep(1,n)),n,1) uc <- matrix(c(rep(1,p)),p,1)
Análise de Correspondências Generalizada 141
# Totais marginais linha e coluna: l <- F %*% uc c <- t(F) %*% ul # Matrizes diagonais dos pesos: Dl <- diag(n) Dc <- diag(p) for (i in 1:n) Dl[i,i] <- l[i] for (i in 1:p) Dc[i,i] <- c[i] # Perfis linha e coluna: L <- solve(Dl) %*% F C <- solve(Dc) %*% t(F) #================================================================= # Matriz dos resíduos estandardizados: Q <- {(1/(A*(1+B)))*(solve(Dl) %*% F %*% solve(Dc))^A - B*ul%*%t(uc)} if (A==0){Q <- log(K)} S <- sqrt(Dl) %*% {diag(length(l)) - (1-B)*ul%*%t(l)} %*% Q %*% t(diag(length(c)) - (1-B)*uc%*%t(c)) %*% sqrt(Dc) #================================================================= # Decomposição em valores singulares: dvs <- svd(S) # Valores próprios: lam <- dvs$d^2 # Matriz diagonal: Dlam <- matrix(0,p,p) for (i in 1:p) Dlam[i,i] <- lam[i] # % explicação de cada eixo: expl <- 100 * (lam / sum(lam)) # coordenadas das colunas: ro <- (solve(sqrt(Dc)) %*% dvs$v) %*% sqrt(Dlam) # coordenadas das linhas: fi <- (solve(sqrt(Dl)) %*% dvs$u) %*% sqrt(Dlam) # contribuicoes relativas: # colunas crc.1 <- 100 * (ro[,1]^2 / (ro[,1]^2+ro[,2]^2)) crc.2 <- 100 * (ro[,2]^2 / (ro[,1]^2+ro[,2]^2)) # linhas crl.1 <- 100 * (fi[,1]^2 / (fi[,1]^2+fi[,2]^2)) crl.2 <- 100 * (fi[,2]^2 / (fi[,1]^2+fi[,2]^2)) # contribuicoes absolutas: # colunas cac.1 <- 100 * dvs$v[,1]^2 cac.2 <- 100 * dvs$v[,2]^2 # linhas cal.1 <- 100 * dvs$u[,1]^2 cal.2 <- 100 * dvs$u[,2]^2 # Tabelas resumo: # Valores próprios e % explicação: print("Resumo", quote=FALSE) vpp <- data.frame(round(lam, 2), round(expl,1), round(cumsum(expl),1)) colnames(vpp) <- c("Valor pp","% expl", "% expl. acumulado") print(vpp) # colunas: print("Colunas:", quote=FALSE) col <- data.frame(round(c,3), round(ro[,1],3), round(ro[,2],3), round(cac.1,1), round(cac.2,1), round(crc.1,1), round(crc.2,1)) colnames(col) <- c("Peso", "CoordenadaX", "CoordenadaY", "CaX", "CaY", "CrX", "CrY") print(col)
142 Anexos
# linhas: print("Linhas:", quote=FALSE) lin <- data.frame(round(l,3), round(fi[,1],3), round(fi[,2],3), round(cal.1,1), round(cal.2,1), round(crl.1,1), round(crl.2,1)) colnames(lin) <- c("Peso", "CoordenadaX", "CoordenadaY", "CaX", "CaY", "CrX", "CrY") print(lin) # Gráfico: acg.biplot <- function(rx, ry, cx, cy, dados) { simbolos=c(21,22,24,25,23,15:20,0:2,5:7,9:14,8,3,4) pc <- simbolos limsupx <- 0 liminfx <- 0 if (max(rx)>max(cx)){limsupx <- max(rx)} else {limsupx <- max(cx)} if (min(rx)>min(cx)){liminfx <- min(cx)} else {liminfx <- min(rx)} limsupy <- 0 liminfy <- 0 if (max(ry)>max(cy)){limsupy <- max(ry)} else {limsupy <- max(cy)} if (min(ry)>min(cy)){liminfy <- min(cy)} else {liminfy <- min(ry)} par(mar=c(2,2,1,1)) plot.default(cx,cy, xlim=c(liminfx*1.1,limsupx*1.1), ylim=c(liminfy*1.1,limsupy*1.1), axes=FALSE, pch="", xlab=paste(""), ylab="", cex=2, panel.first = grid(9,9)) par(new=TRUE) matplot(rx, ry, xlim=c(liminfx*1.1,limsupx*1.1), ylim=c(liminfy*1.1,limsupy*1.1), axes=FALSE, xlab ="", ylab="" , pch=".", cex=2, col="transparent") for(i in 1:dim(dados)[1]) { points(rx[i],ry[i], pch=pc[1], cex=0.9, col="blue", bg="turquoise") text(rx[i], ry[i], labels = rownames(dados)[i], pos=3, cex=0.8) } axis(1, col="black", lwd = 1) axis(2, col="black", lwd = 1) box(col="black", lwd = 1) abline(h=0, v=0, lwd=0.5, lty="dotted", col="black") for(i in 1:dim(dados)[2]) { points(cx[i],cy[i], pch=pc[3], cex=1.3, col="maroon", bg="red") text(cx[i], cy[i], labels = colnames(dados)[i], pos=3, cex=1) } title(main=c(""), line=1,col.main = "blue3")
legend(liminfx*1.1, limsupy*1.1, legend= colnames(dados), col="blue", pch = simbolos[1:dim(dados)[2]], merge = FALSE, bg = 'transparent', pt.bg="turquoise", pt.cex=1.5)
text(limsupx,0-limsupy*0.1, labels=bquote(lambda[1] == .(round(lam[1],4))),cex= 0.9) text(limsupx*0.98,0-limsupy*0.175, labels=c(round(expl[1],2)," %"),cex= 1.1) text(0+limsupx*0.2,limsupy, labels=bquote(lambda[2] == .(round(lam[2],4))),cex= 0.9) text(0+limsupx*0.18,limsupy*0.93, labels=c(round(expl[2],2)," %"),cex= 1.1)
text(limsupx*0.55,liminfy*1.1, labels=c(round(expl[2]+expl[1],2),"Qualidade = % "),cex= 0.8, col="black")
} acg.biplot(fi[,1],fi[,2],ro[,1],ro[,2],dados)
}
#----------------------------------------------------------------------------------------------------------
# Método/Parâmetros | A (alpha) B(beta) |
#----------------------------------------------------------------------------------------------------------
# Para a AC simples | 1 0 |
# Para a AC via distancia de Hellinger | 1/2 1 |
# Para o SM | 0 0 |
#----------------------------------------------------------------------------------------------------------
Análise de Correspondências Generalizada 143
D.5 Transição da Análise de Correspondências para o Spectral Mapping
# Matriz inicial de dados: K <- dados # Matriz de correspondencias: F <- K / sum(K) # numero de linhas e colunas: n <- nrow(F) p <- ncol(F) # vectores unitários: ul(n*1) uc(p*1) ul <- matrix(c(rep(1,n)),n,1) uc <- matrix(c(rep(1,p)),p,1) # Totais marginais linha e coluna: l <- F %*% uc c <- t(F) %*% ul # Matrizes diagonais dos pesos: Dl <- diag(n) Dc <- diag(p) for (i in 1:n) Dl[i,i] <- l[i] for (i in 1:p) Dc[i,i] <- c[i] # Perfis linha e coluna: L <- solve(Dl) %*% F C <- solve(Dc) %*% t(F) # Gráfico: acg.biplot <- function(rx, ry, cx, cy, dados) { simbolos=c(21,22,24,25,23,15:20,0:2,5:7,9:14,8,3,4) pc <- simbolos limsupx <- 0 liminfx <- 0 if (max(rx)>max(cx)){limsupx <- max(rx)} else {limsupx <- max(cx)} if (min(rx)>min(cx)){liminfx <- min(cx)} else {liminfx <- min(rx)} limsupy <- 0 liminfy <- 0 if (max(ry)>max(cy)){limsupy <- max(ry)} else {limsupy <- max(cy)} if (min(ry)>min(cy)){liminfy <- min(cy)} else {liminfy <- min(ry)} par(mar=c(2,2,1,1)) plot.default(cx,cy, xlim=c(liminfx*1.1,limsupx*1.1), ylim=c(liminfy*1.1,limsupy*1.1), axes=FALSE, pch="", xlab=paste(""), ylab="", cex=2, panel.first = grid(9,9)) par(new=TRUE) matplot(rx, ry, xlim=c(liminfx*1.1,limsupx*1.1), ylim=c(liminfy*1.1,limsupy*1.1), axes=FALSE, xlab ="", ylab="" , pch=".", cex=2, col="transparent") for(i in 1:dim(dados)[1]) { points(rx[i],ry[i], pch=pc[1], cex=0.9, col="blue", bg="turquoise") text(rx[i], ry[i], labels = rownames(dados)[i], pos=3, cex=0.8) } axis(1, col="black", lwd = 1) axis(2, col="black", lwd = 1) box(col="black", lwd = 1) abline(h=0, v=0, lwd=0.5, lty="dotted", col="black") for(i in 1:dim(dados)[2]) { points(cx[i],cy[i], pch=pc[3], cex=1.3, col="maroon", bg="red") text(cx[i], cy[i], labels = colnames(dados)[i], pos=3, cex=1) }
144 Anexos
title(main=c(""), line=1,col.main = "blue3") legend(liminfx*1.1, limsupy*1.1, legend= colnames(dados), col="blue", pch = simbolos[1:dim(dados)[2]], merge = FALSE, bg = 'transparent', pt.bg="turquoise", pt.cex=1.5)
text(limsupx,0-limsupy*0.1, labels=bquote(lambda[1] == .(round(lam[1],4))),cex= 0.9) text(limsupx*0.98,0-limsupy*0.175, labels=c(round(expl[1],2)," %"),cex= 1.1) text(0+limsupx*0.2,limsupy, labels=bquote(lambda[2] == .(round(lam[2],4))),cex= 0.9) text(0+limsupx*0.18,limsupy*0.93, labels=c(round(expl[2],2)," %"),cex= 1.1) text(limsupx*0.55,liminfy*1.1, labels=c(round(expl[2]+expl[1],2),"Qualidade = % "),cex= 0.8, col="black") } for (i in 100:1){ alpha <- i/100 # Matriz dos resíduos estandardizados: Q <- (1/alpha)*{(solve(Dl) %*% F %*% solve(Dc))^alpha} S <- sqrt(Dl) %*% {diag(length(l)) - ul%*%t(l)} %*% Q %*% t(diag(length(c)) - uc%*%t(c)) %*% sqrt(Dc) # Decomposição em valores singulares: dvs <- svd(S) # Valores próprios: lam <- dvs$d^2 # Matriz diagonal: Dlam <- matrix(0,p,p) for (i in 1:p) Dlam[i,i] <- lam[i] # % explicação de cada eixo: (expl <- 100 * (lam / sum(lam))) # coordenadas das colunas: ro <- (solve(sqrt(Dc)) %*% dvs$v) %*% sqrt(Dlam) # coordenadas das linhas: fi <- (solve(sqrt(Dl)) %*% dvs$u) %*% sqrt(Dlam) acg.biplot(fi[,1],fi[,2],ro[,1],ro[,2],dados) if (i==100) Sys.sleep(2) Sys.sleep(0.1) }
E. ACM via Distância de Hellinger
No capítulo seis optou-se por utilizar a técnica da ACM tradicional (via
distância do qui-quadrado), pois o resultado gráfico da abordagem que utiliza a
distância de Hellinger não permitia uma investigação conjunta das variáveis em
análise com as pré-seleccionadas para apoiar as conclusões (variáveis
suplementares).
Em seguida mostra-se o resultado da análise com a distância de Hellinger:
Análise de Correspondências Generalizada 145
Olhando para a disposição das variáveis suplementares (a vermelho),
verificamos que esta análise produz uma representação diferente. Todavia, é
necessário realizar uma rotação nos eixos para poder comparar estes resultados
com os expostos no capítulo seis.
Apesar da alteração da distância, é curioso verificar que as principais relações
analisadas no capítulo seis mantêm-se.
146 Anexos
F. Inércias e Contribuições das Colunas
Inércia % Expl. % Expl. Acumulada % Expl. Ajustada % Expl. Aj. Acumulado
1 0.149 8.0 8.0 30.7 30.7
2 0.120 6.5 14.6 11.1 41.8
3 0.110 6.0 20.5 6.5 48.3
4 0.108 5.8 26.3 5.6 53.9
5 0.102 5.5 31.8 3.6 57.5
6 0.097 5.2 37.1 2.4 59.9
7 0.091 4.9 42.0 1.2 61.1
8 0.089 4.8 46.9 0.9 62.0
9 0.085 4.6 51.5 0.4 62.4
10 0.081 4.4 55.9 0.1 62.5
11 0.079 4.3 60.1 0.0 62.5
12 0.076 4.1 64.2 0.0 62.5
13 0.074 4.0 68.2 0.0 62.5
14 0.070 3.8 72.0 0.0 62.5
15 0.067 3.6 75.7 0.0 62.5
16 0.065 3.5 79.2 0.0 62.5
17 0.063 3.4 82.6 0.0 62.5
18 0.057 3.1 85.7 0.0 62.5
19 0.054 2.9 88.6 0.0 62.5
20 0.049 2.6 91.3 0.0 62.5
21 0.048 2.6 93.9 0.0 62.5
22 0.042 2.2 96.1 0.0 62.5
23 0.039 2.1 98.2 0.0 62.5
24 0.033 1.8 100.0 0.0 62.5
25 0.000 0.0 100.0 0.0 62.5
26 0.000 0.0 100.0 0.0 62.5
27 0.000 0.0 100.0 0.0 62.5
28 0.000 0.0 100.0 0.0 62.5
29 0.000 0.0 100.0 0.0 62.5
30 0.000 0.0 100.0 0.0 62.5
31 0.000 0.0 100.0 0.0 62.5
32 0.000 0.0 100.0 0.0 62.5
33 0.000 0.0 100.0 0.0 62.5
34 0.000 0.0 100.0 0.0 62.5
35 0.000 0.0 100.0 0.0 62.5
36 0.000 0.0 100.0 0.0 62.5
37 0.000 0.0 100.0 0.0 62.5
Análise de Correspondências Generalizada 147
Categorias Peso eixo-X eixo-Y eixo-X eixo-Y
dur1 0.010 0.3 0.9 27.0 73.0
dur2 0.020 1.2 1.3 53.6 46.4
dur3 0.024 1.3 1.3 55.6 44.4
dur4 0.018 0.0 6.6 0.6 99.4
dur5 0.005 0.3 1.3 25.0 75.0
tipoPrec1 0.006 1.2 0.2 86.8 13.2
tipoPrec2 0.011 1.7 1.2 63.6 36.4
tipoPrec3 0.008 8.7 0.0 100.0 0.0
tipoPrec4 0.007 0.0 0.1 18.9 81.1
tipoPrec5 0.008 0.2 0.3 45.4 54.6
tipoPrec6 0.010 0.0 9.0 0.0 100.0
tipoPrec7 0.003 2.4 0.3 90.6 9.4
tipoPrec8 0.001 0.0 8.0 0.0 100.0
tipoPrec9 0.023 0.0 1.8 0.3 99.7
vom1 0.009 14.8 1.6 92.1 7.9
vom2 0.068 2.0 0.2 92.1 7.9
sono1 0.005 2.6 0.5 87.0 13.0
sono2 0.072 0.2 0.0 87.0 13.0
cef1 0.021 14.4 0.1 99.7 0.3
cef2 0.056 5.4 0.0 99.7 0.3
Out1 0.011 8.7 8.7 55.4 44.6
Out2 0.066 1.4 1.4 55.4 44.6
hta1 0.040 2.1 0.7 78.5 21.5
hta2 0.037 2.4 0.8 78.5 21.5
fum1 0.007 3.2 14.1 21.8 78.2
fum2 0.070 0.3 1.3 21.8 78.2
fumP1 0.014 3.6 4.8 48.5 51.5
fumP2 0.063 0.8 1.1 48.5 51.5
card1 0.010 4.4 0.1 98.2 1.8
card2 0.067 0.7 0.0 98.2 1.8
dPsiq1 0.011 1.7 6.7 24.1 75.9
dPsiq2 0.066 0.3 1.1 24.1 75.9
mig1 0.025 7.6 0.1 99.0 1.0
mig2 0.052 3.7 0.0 99.0 1.0
ecoD1 0.018 0.7 0.4 67.5 32.5
ecoD2 0.039 0.1 6.7 2.1 97.9
ecoD3 0.020 1.5 17.4 9.8 90.2
Contribuições RelativasContribuições Absolutas