In [1]:
# rm(list=ls()) 
options(OutDec = ",")
#==============================================================================
# Dados da bolsa de valores de 'New York' em d07_acoes.txt
#==============================================================================
dados  <- read.table("../dados/d07_acoes.txt",header=F,sep="	", # Tab
          col.names=c("JP","Citi","Fargo","Royal","Exxon"))
print(head(dados))
          JP       Citi      Fargo      Royal      Exxon
1  0,0130338 -0,0078431 -0,0031889 -0,0447693  0,0052151
2  0,0084862  0,0166886 -0,0062100  0,0119560  0,0134890
3 -0,0179153 -0,0086393  0,0100360  0,0000000 -0,0061428
4  0,0215589 -0,0034858  0,0174353 -0,0285917 -0,0069534
5  0,0108225  0,0037167 -0,0101345  0,0291900  0,0409751
6  0,0101713 -0,0121978 -0,0083768  0,0137083  0,0029895
In [2]:
#==============================================================================
# Correlação amostral
#==============================================================================
n      <- dim(dados)[1]
p      <- dim(dados)[2]
R      <- cor(dados)
In [3]:
#==============================================================================
# Analise fatorial via componentes principais
#==============================================================================
AF      <- prcomp(dados,scale=T)
delta   <- AF$sdev^2
P       <- AF$rotation 
print("==== Autovalores ====")
print(delta)
print("==== Autovetores ====")
print(P)
print("==== Proporcao da variabilidade ====")
print(delta/p)
print("==== Proporcao da variabilidade acumulada ====")
print(cumsum(delta)/p)
# Escolhemos m=2
[1] "==== Autovalores ===="
[1] 2,4372731 1,4070127 0,5005127 0,4000316 0,2551699
[1] "==== Autovetores ===="
             PC1        PC2         PC3        PC4         PC5
JP    -0,4690832 -0,3680070 -0,60431522 -0,3630228  0,38412160
Citi  -0,5324055 -0,2364624 -0,13610618  0,6292079 -0,49618794
Fargo -0,4651633 -0,3151795  0,77182810 -0,2889658  0,07116948
Royal -0,3873459  0,5850373  0,09336192  0,3812515  0,59466408
Exxon -0,3606821  0,6058463 -0,10882629 -0,4934145 -0,49755167
[1] "==== Proporcao da variabilidade ===="
[1] 0,48745462 0,28140253 0,10010255 0,08000632 0,05103398
[1] "==== Proporcao da variabilidade acumulada ===="
[1] 0,4874546 0,7688572 0,8689597 0,9489660 1,0000000
In [4]:
#==============================================================================
# Estimacao da matriz de cargas dos fatores
#==============================================================================
ell.1 <- sqrt(delta[1])*P[,1]
ell.2 <- sqrt(delta[2])*P[,2]
L.1   <- ell.1               # um fator
L.2   <- cbind(ell.1,ell.2)  # dois fatores
print(L.1)
print(L.2)
        JP       Citi      Fargo      Royal      Exxon 
-0,7323218 -0,8311791 -0,7262022 -0,6047155 -0,5630885 
           ell.1      ell.2
JP    -0,7323218 -0,4365209
Citi  -0,8311791 -0,2804859
Fargo -0,7262022 -0,3738582
Royal -0,6047155  0,6939569
Exxon -0,5630885  0,7186401
In [5]:
#==============================================================================
# Estimacao das comunalidades 
#==============================================================================
sum2  <- function(x){return(sum(x^2))}
h.1   <- L.1^2                 # um fator
h.2   <- apply(L.2,1,"sum2")   # dois fatores
print(h.1)
print(h.2)
       JP      Citi     Fargo     Royal     Exxon 
0,5362953 0,6908587 0,5273697 0,3656808 0,3170686 
       JP      Citi     Fargo     Royal     Exxon 
0,7268458 0,7695311 0,6671396 0,8472571 0,8335122 
In [6]:
#==============================================================================
# Estimacao das variancias especificas
#==============================================================================
psi.1 <- 1 - h.1 # um fator
psi.2 <- 1 - h.2 # dois fatores
print(psi.1)
print(psi.2)
       JP      Citi     Fargo     Royal     Exxon 
0,4637047 0,3091413 0,4726303 0,6343192 0,6829314 
       JP      Citi     Fargo     Royal     Exxon 
0,2731542 0,2304689 0,3328604 0,1527429 0,1664878 
In [7]:
#==============================================================================
# Estimacao/Recomposicao de R para m=2
#==============================================================================
R.est.1  <- L.1%*%t(L.1)+diag(psi.1)
R.est.2  <- L.2%*%t(L.2)+diag(psi.2)
print(R.est.1)
print(R.est.2)
            JP      Citi     Fargo     Royal     Exxon
[1,] 1,0000000 0,6086906 0,5318137 0,4428464 0,4123620
[2,] 0,6086906 1,0000000 0,6036041 0,5026269 0,4680274
[3,] 0,5318137 0,6036041 1,0000000 0,4391457 0,4089161
[4,] 0,4428464 0,5026269 0,4391457 1,0000000 0,3405083
[5,] 0,4123620 0,4680274 0,4089161 0,3405083 1,0000000
              JP      Citi     Fargo     Royal      Exxon
JP    1,00000000 0,7311286 0,6950107 0,1399197 0,09866056
Citi  0,73112857 1,0000000 0,7084661 0,3079818 0,26645897
Fargo 0,69501067 0,7084661 1,0000000 0,1797042 0,14024657
Royal 0,13991966 0,3079818 0,1797042 1,0000000 0,83921362
Exxon 0,09866056 0,2664590 0,1402466 0,8392136 1,00000000
In [8]:
#==============================================================================
# Matriz residual
#==============================================================================
U <- R - R.est.2
print(U)
               JP        Citi        Fargo        Royal        Exxon
JP     0,00000000 -0,09884073 -0,184513342 -0,025317756  0,055802201
Citi  -0,09884073  0,00000000 -0,134323655  0,014310342 -0,053784258
Fargo -0,18451334 -0,13432365  0,000000000  0,002794963  0,005960127
Royal -0,02531776  0,01431034  0,002794963  0,000000000 -0,155835955
Exxon  0,05580220 -0,05378426  0,005960127 -0,155835955  0,000000000
In [9]:
#==============================================================================
# Comparacoes: note as entradas [1,3] das matrizes
#==============================================================================
print(R)
print(R.est.1)
print(R.est.2)
             JP      Citi     Fargo     Royal     Exxon
JP    1,0000000 0,6322878 0,5104973 0,1146019 0,1544628
Citi  0,6322878 1,0000000 0,5741424 0,3222921 0,2126747
Fargo 0,5104973 0,5741424 1,0000000 0,1824992 0,1462067
Royal 0,1146019 0,3222921 0,1824992 1,0000000 0,6833777
Exxon 0,1544628 0,2126747 0,1462067 0,6833777 1,0000000
            JP      Citi     Fargo     Royal     Exxon
[1,] 1,0000000 0,6086906 0,5318137 0,4428464 0,4123620
[2,] 0,6086906 1,0000000 0,6036041 0,5026269 0,4680274
[3,] 0,5318137 0,6036041 1,0000000 0,4391457 0,4089161
[4,] 0,4428464 0,5026269 0,4391457 1,0000000 0,3405083
[5,] 0,4123620 0,4680274 0,4089161 0,3405083 1,0000000
              JP      Citi     Fargo     Royal      Exxon
JP    1,00000000 0,7311286 0,6950107 0,1399197 0,09866056
Citi  0,73112857 1,0000000 0,7084661 0,3079818 0,26645897
Fargo 0,69501067 0,7084661 1,0000000 0,1797042 0,14024657
Royal 0,13991966 0,3079818 0,1797042 1,0000000 0,83921362
Exxon 0,09866056 0,2664590 0,1402466 0,8392136 1,00000000