Análise de Correspondência Múltipla- perfil investidor aplicacao - ACM
Leoni, R. C. Professor Dr.
# install.packages("FactoMineR", "gglot2", "readxl")
# install.packages("devtools")
# devtools::install_github("kassambara/factoextra")
rm(list=ls(all=TRUE))
library("ggplot2")
library("FactoMineR")
library("factoextra")
library("readxl")
library("gplots")
library("corrplot")
library("graphics")
library("foreign")
library("readxl")
library("amap")Ler os dados e atribuir ordem para perfil x aplicação x estadocivil
# ler os dados
investidor <- read_excel("perfil investidor x aplicacao x estadocivil.xlsx")
investidor# atribuir níveis ao perfil e tipo sw aplicação
investidor$perfil <- factor(investidor$perfil, levels = c("Conservador", "Moderado", "Agressivo"))
investidor$aplicacao <-factor(investidor$aplicacao, levels = c("Poupança", "CDB", "Ações"))
investidor$estado_civil <-factor(investidor$estado_civil, levels = c("Solteiro", "Casado"))
dados <- investidor[,2:4]codificação binária e matriz de BURT
matbinaria <- matlogic(dados)
matbinaria perfil.Agressivo perfil.Conservador perfil.Moderado aplicacao.Ações aplicacao.CDB
1 1 0 0 1 0
2 1 0 0 1 0
3 1 0 0 1 0
4 1 0 0 1 0
5 1 0 0 1 0
6 1 0 0 1 0
7 1 0 0 1 0
8 1 0 0 1 0
9 1 0 0 0 1
10 1 0 0 0 1
11 1 0 0 0 1
12 1 0 0 0 1
13 1 0 0 0 0
14 1 0 0 0 0
15 1 0 0 0 0
16 1 0 0 0 0
17 1 0 0 0 0
18 0 1 0 1 0
19 0 1 0 1 0
20 0 1 0 1 0
21 0 1 0 1 0
22 0 1 0 1 0
23 0 1 0 0 1
24 0 1 0 0 1
25 0 1 0 0 1
26 0 1 0 0 1
27 0 1 0 0 1
28 0 1 0 0 1
29 0 1 0 0 1
30 0 1 0 0 1
31 0 1 0 0 1
32 0 1 0 0 1
33 0 1 0 0 1
34 0 1 0 0 1
35 0 1 0 0 1
36 0 1 0 0 1
37 0 1 0 0 1
38 0 1 0 0 1
39 0 1 0 0 0
40 0 1 0 0 0
41 0 1 0 0 0
42 0 1 0 0 0
43 0 0 1 1 0
44 0 0 1 1 0
45 0 0 1 0 1
46 0 0 1 0 1
47 0 0 1 0 1
48 0 0 1 0 1
49 0 0 1 0 1
50 0 0 1 0 1
51 0 0 1 0 1
52 0 0 1 0 1
53 0 0 1 0 1
54 0 0 1 0 1
55 0 0 1 0 1
56 0 0 1 0 1
57 0 0 1 0 1
58 0 0 1 0 1
59 0 0 1 0 1
60 0 0 1 0 1
61 0 0 1 0 1
62 0 0 1 0 1
63 0 0 1 0 1
64 0 0 1 0 1
65 0 0 1 0 0
66 0 0 1 0 0
67 0 0 1 0 0
68 0 0 1 0 0
69 0 0 1 0 0
70 0 0 1 0 0
71 0 0 1 0 0
72 0 0 1 0 0
73 0 0 1 0 0
74 0 0 1 0 0
75 0 0 1 0 0
76 0 0 1 0 0
77 0 0 1 0 0
78 0 0 1 0 0
79 0 0 1 0 0
80 0 0 1 0 0
81 0 0 1 0 0
82 0 0 1 0 0
83 0 0 1 0 0
84 0 0 1 0 0
85 0 0 1 0 0
86 0 0 1 0 0
87 0 0 1 0 0
88 0 0 1 0 0
89 0 0 1 0 0
90 0 0 1 0 0
91 0 0 1 0 0
92 0 0 1 0 0
93 0 0 1 0 0
94 0 0 1 0 0
95 0 0 1 0 0
96 0 0 1 0 0
97 0 0 1 0 0
98 0 0 1 0 0
99 0 0 1 0 0
100 0 0 1 0 0
aplicacao.Poupança estado_civil.Casado estado_civil.Solteiro
1 0 0 1
2 0 0 1
3 0 0 1
4 0 1 0
5 0 0 1
6 0 0 1
7 0 0 1
8 0 0 1
9 0 0 1
10 0 0 1
11 0 1 0
12 0 0 1
13 1 1 0
14 1 1 0
15 1 0 1
16 1 1 0
17 1 0 1
18 0 1 0
19 0 0 1
20 0 0 1
21 0 0 1
22 0 1 0
23 0 1 0
24 0 0 1
25 0 0 1
26 0 0 1
27 0 0 1
28 0 1 0
29 0 1 0
30 0 0 1
31 0 0 1
32 0 1 0
33 0 0 1
34 0 0 1
35 0 1 0
36 0 0 1
37 0 1 0
38 0 0 1
39 1 1 0
40 1 1 0
41 1 1 0
42 1 0 1
43 0 1 0
44 0 1 0
45 0 1 0
46 0 1 0
47 0 0 1
48 0 1 0
49 0 0 1
50 0 0 1
51 0 1 0
52 0 1 0
53 0 0 1
54 0 0 1
55 0 0 1
56 0 0 1
57 0 0 1
58 0 0 1
59 0 0 1
60 0 1 0
61 0 1 0
62 0 1 0
63 0 0 1
64 0 1 0
65 1 0 1
66 1 1 0
67 1 1 0
68 1 0 1
69 1 1 0
70 1 0 1
71 1 1 0
72 1 1 0
73 1 1 0
74 1 1 0
75 1 0 1
76 1 1 0
77 1 1 0
78 1 1 0
79 1 1 0
80 1 1 0
81 1 1 0
82 1 0 1
83 1 1 0
84 1 1 0
85 1 1 0
86 1 1 0
87 1 1 0
88 1 1 0
89 1 1 0
90 1 1 0
91 1 1 0
92 1 1 0
93 1 0 1
94 1 1 0
95 1 1 0
96 1 1 0
97 1 1 0
98 1 1 0
99 1 1 0
100 1 1 0dados.burt <-burt(dados)
dados.burt perfil.Agressivo perfil.Conservador perfil.Moderado
perfil.Agressivo 17 0 0
perfil.Conservador 0 25 0
perfil.Moderado 0 0 58
aplicacao.Ações 8 5 2
aplicacao.CDB 4 16 20
aplicacao.Poupança 5 4 36
estado_civil.Casado 5 11 41
estado_civil.Solteiro 12 14 17
aplicacao.Ações aplicacao.CDB aplicacao.Poupança
perfil.Agressivo 8 4 5
perfil.Conservador 5 16 4
perfil.Moderado 2 20 36
aplicacao.Ações 15 0 0
aplicacao.CDB 0 40 0
aplicacao.Poupança 0 0 45
estado_civil.Casado 5 16 36
estado_civil.Solteiro 10 24 9
estado_civil.Casado estado_civil.Solteiro
perfil.Agressivo 5 12
perfil.Conservador 11 14
perfil.Moderado 41 17
aplicacao.Ações 5 10
aplicacao.CDB 16 24
aplicacao.Poupança 36 9
estado_civil.Casado 57 0
estado_civil.Solteiro 0 43as coordenadas geradas pela matriz de BURT são conhecidas como coordenadas principais.
# MCA with function dudi.acm
library(ade4)
# apply dudi.acm
mca1 <- dudi.acm(dados, scannf = FALSE)
# eig eigenvalues, a vector with min(n,p) components
# c1 principal axes, data frame with p rows and nf columns
# co column coordinates, data frame with p rows and nf columns
summary(mca1)Class: acm dudi
Call: dudi.acm(df = dados, scannf = FALSE)
Total inertia: 1.667
Eigenvalues:
Ax1 Ax2 Ax3 Ax4 Ax5
0.6023 0.4360 0.2765 0.1798 0.1721
Projected inertia (%):
Ax1 Ax2 Ax3 Ax4 Ax5
36.14 26.16 16.59 10.79 10.32
Cumulative projected inertia (%):
Ax1 Ax1:2 Ax1:3 Ax1:4 Ax1:5
36.14 62.30 78.89 89.68 100.00 #coordenadas principais (BURT)
round(mca1$co, 3)# coordenadas padrão (geradas com a matriz binária)
round(mca1$c1, 3)# number of categories per variable
cats = apply(dados, 2, function(x) nlevels(as.factor(x)))
# data frame for ggplot
mca1_vars_df = data.frame(mca1$co, Variable = rep(names(cats), cats))
# plot
ggplot(data = mca1_vars_df,
aes(x = Comp1, y = Comp2, label = rownames(mca1_vars_df))) +
geom_hline(yintercept = 0, colour = "gray70") +
geom_vline(xintercept = 0, colour = "gray70") +
geom_text(aes(colour = Variable)) +
ggtitle("MCA plot of variables")
LS0tDQp0aXRsZTogJ0Fuw6FsaXNlIGRlIENvcnJlc3BvbmTDqm5jaWEgTcO6bHRpcGxhLSBwZXJmaWwgaW52ZXN0aWRvciBhcGxpY2FjYW8gLSBBQ00gJw0KYXV0aG9yOiAiTGVvbmksIFIuIEMuIFByb2Zlc3NvciBEci4iDQpvdXRwdXQ6DQogIGh0bWxfbm90ZWJvb2s6IGRlZmF1bHQNCiAgaHRtbF9kb2N1bWVudDogZGVmYXVsdA0KLS0tDQoqKioNCg0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IEYpDQpybShsaXN0PWxzKGFsbD1UUlVFKSkNCmBgYA0KDQpgYGB7ciBtZXNzYWdlPUZBTFNFfQ0KIyBpbnN0YWxsLnBhY2thZ2VzKCJGYWN0b01pbmVSIiwgImdnbG90MiIsICJyZWFkeGwiKQ0KIyBpbnN0YWxsLnBhY2thZ2VzKCJkZXZ0b29scyIpDQojIGRldnRvb2xzOjppbnN0YWxsX2dpdGh1Yigia2Fzc2FtYmFyYS9mYWN0b2V4dHJhIikNCnJtKGxpc3Q9bHMoYWxsPVRSVUUpKQ0KbGlicmFyeSgiZ2dwbG90MiIpDQpsaWJyYXJ5KCJGYWN0b01pbmVSIikNCmxpYnJhcnkoImZhY3RvZXh0cmEiKQ0KbGlicmFyeSgicmVhZHhsIikNCmxpYnJhcnkoImdwbG90cyIpDQpsaWJyYXJ5KCJjb3JycGxvdCIpDQpsaWJyYXJ5KCJncmFwaGljcyIpDQpsaWJyYXJ5KCJmb3JlaWduIikNCmxpYnJhcnkoInJlYWR4bCIpDQpsaWJyYXJ5KCJhbWFwIikNCmBgYA0KDQojIyMgTGVyIG9zIGRhZG9zIGUgYXRyaWJ1aXIgb3JkZW0gcGFyYSBwZXJmaWwgeCBhcGxpY2HDp8OjbyB4IGVzdGFkb2NpdmlsDQpgYGB7cn0NCiMgbGVyIG9zIGRhZG9zDQppbnZlc3RpZG9yIDwtIHJlYWRfZXhjZWwoInBlcmZpbCBpbnZlc3RpZG9yIHggYXBsaWNhY2FvIHggZXN0YWRvY2l2aWwueGxzeCIpDQppbnZlc3RpZG9yDQoNCiMgYXRyaWJ1aXIgbsOtdmVpcyBhbyBwZXJmaWwgZSB0aXBvIHN3IGFwbGljYcOnw6NvDQppbnZlc3RpZG9yJHBlcmZpbCA8LSBmYWN0b3IoaW52ZXN0aWRvciRwZXJmaWwsIGxldmVscyA9IGMoIkNvbnNlcnZhZG9yIiwgIk1vZGVyYWRvIiwgIkFncmVzc2l2byIpKQ0KaW52ZXN0aWRvciRhcGxpY2FjYW8gPC1mYWN0b3IoaW52ZXN0aWRvciRhcGxpY2FjYW8sIGxldmVscyA9IGMoIlBvdXBhbsOnYSIsICJDREIiLCAiQcOnw7VlcyIpKQ0KaW52ZXN0aWRvciRlc3RhZG9fY2l2aWwgPC1mYWN0b3IoaW52ZXN0aWRvciRlc3RhZG9fY2l2aWwsIGxldmVscyA9IGMoIlNvbHRlaXJvIiwgIkNhc2FkbyIpKQ0KDQpkYWRvcyA8LSBpbnZlc3RpZG9yWywyOjRdDQoNCmBgYA0KDQojIyMgY29kaWZpY2HDp8OjbyBiaW7DoXJpYSBlIG1hdHJpeiBkZSBCVVJUIA0KYGBge3J9DQptYXRiaW5hcmlhIDwtIG1hdGxvZ2ljKGRhZG9zKQ0KbWF0YmluYXJpYQ0KZGFkb3MuYnVydCA8LWJ1cnQoZGFkb3MpDQpkYWRvcy5idXJ0DQpgYGANCg0KDQojIyMgYXMgY29vcmRlbmFkYXMgZ2VyYWRhcyBwZWxhIG1hdHJpeiBkZSBCVVJUIHPDo28gY29uaGVjaWRhcyBjb21vIGNvb3JkZW5hZGFzIHByaW5jaXBhaXMuIA0KDQpgYGB7ciwgZmlnLmhlaWdodD05LCBmaWcud2lkdGg9MTJ9DQojIE1DQSB3aXRoIGZ1bmN0aW9uIGR1ZGkuYWNtDQpsaWJyYXJ5KGFkZTQpDQoNCiMgYXBwbHkgZHVkaS5hY20NCm1jYTEgPC0gZHVkaS5hY20oZGFkb3MsIHNjYW5uZiA9IEZBTFNFKQ0KDQojIGVpZwllaWdlbnZhbHVlcywgYSB2ZWN0b3Igd2l0aCBtaW4obixwKSBjb21wb25lbnRzDQojIGMxCXByaW5jaXBhbCBheGVzLCBkYXRhIGZyYW1lIHdpdGggcCByb3dzIGFuZCBuZiBjb2x1bW5zDQojIGNvCWNvbHVtbiBjb29yZGluYXRlcywgZGF0YSBmcmFtZSB3aXRoIHAgcm93cyBhbmQgbmYgY29sdW1ucw0KDQoNCnN1bW1hcnkobWNhMSkNCiNjb29yZGVuYWRhcyBwcmluY2lwYWlzIChCVVJUKQ0Kcm91bmQobWNhMSRjbywgMykNCiMgY29vcmRlbmFkYXMgcGFkcsOjbyAoZ2VyYWRhcyBjb20gYSBtYXRyaXogYmluw6FyaWEpDQpyb3VuZChtY2ExJGMxLCAzKQ0KDQoNCg0KDQojIG51bWJlciBvZiBjYXRlZ29yaWVzIHBlciB2YXJpYWJsZQ0KY2F0cyA9IGFwcGx5KGRhZG9zLCAyLCBmdW5jdGlvbih4KSBubGV2ZWxzKGFzLmZhY3Rvcih4KSkpDQojIGRhdGEgZnJhbWUgZm9yIGdncGxvdA0KbWNhMV92YXJzX2RmID0gZGF0YS5mcmFtZShtY2ExJGNvLCBWYXJpYWJsZSA9IHJlcChuYW1lcyhjYXRzKSwgY2F0cykpDQojIHBsb3QNCmdncGxvdChkYXRhID0gbWNhMV92YXJzX2RmLCANCiAgICAgICBhZXMoeCA9IENvbXAxLCB5ID0gQ29tcDIsIGxhYmVsID0gcm93bmFtZXMobWNhMV92YXJzX2RmKSkpICsNCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0ID0gMCwgY29sb3VyID0gImdyYXk3MCIpICsNCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gMCwgY29sb3VyID0gImdyYXk3MCIpICsNCiAgZ2VvbV90ZXh0KGFlcyhjb2xvdXIgPSBWYXJpYWJsZSkpICsNCiAgZ2d0aXRsZSgiTUNBIHBsb3Qgb2YgdmFyaWFibGVzIikNCg0KDQoNCg0KDQoNCmBgYA0KDQo=