#setwd("C:/Users/erald/Desktop/Faculdade/Multivariada II")
setwd("C:/Users/Pessoal/Desktop/ESTATÍSTICA/UFPB/8º PERÍODO/ANÁLISE MULTIVARIADA II/PROVA")
banco <- read.csv2("heart.csv", header = T, sep = ",")
attach(banco)Prova - Análise Multivariada II
Questão 1
- O conjunto de dados disponibilizado para a realização da primeira questão tratam-se de 11 características clínicas utilizadas para a previsão de possíveis eventos relacionados a doenças cardiovasculares.
Mais sobre o banco de dados
As doenças cardiovasculares (DCVs) são a causa número 1 de morte no mundo, levando cerca de 17,9 milhões de vidas a cada ano, o que representa 31% de todas as mortes em todo o mundo. Quatro em cada 5 mortes por DCV são devidas a ataques cardíacos e derrames, e um terço dessas mortes ocorre prematuramente em pessoas com menos de 70 anos de idade. A insuficiência cardíaca é um evento comum causado por DCVs e este conjunto de dados contém 11 recursos que podem ser usados para prever uma possível doença cardíaca.
Pessoas com doenças cardiovasculares ou com alto risco cardiovascular (devido à presença de um ou mais fatores de risco, como hipertensão, diabetes, hiperlipidemia ou doença já estabelecida) precisam de detecção e gerenciamento precoces, em que um modelo de aprendizado de máquina pode ser de grande ajuda.
Sobre as variáveis dependentes:
Idade: idade do paciente em anos
Sexo: sexo do paciente [M: Masculino, F: Feminino]
ChestPainType: tipo de dor no peito [TA: Angina Típica, ATA: Angina Atípica, NAP: Dor Não Anginosa, ASY: Assintomática]
RestingBP: pressão arterial em repouso [mm Hg]
Colesterol: colesterol sérico [mm/dl]
JejumBS: açúcar no sangue em jejum [1: se JejumBS > 120 mg/dl, 0: caso contrário]
ECG em repouso: resultados do eletrocardiograma em repouso [Normal: Normal, ST: com anormalidade da onda ST-T (inversões da onda T e/ou elevação ou depressão do ST > 0,05 mV), HVE: mostrando hipertrofia ventricular esquerda provável ou definitiva pelos critérios de Estes]
MaxHR: frequência cardíaca máxima alcançada [Valor numérico entre 60 e 202]
ExerciseAngina: angina induzida por exercício [S: Sim, N: Não]
Oldpeak: oldpeak = ST [Valor numérico medido na depressão]
ST_Slope: a inclinação do segmento ST do exercício de pico [Up: ascendente, Flat: plano, Down: descendente]
Sobre a variável resposta:
HeartDisease: classe de saída [1: doença cardíaca, 0: normal]
Letra A
- Realize uma análise exploratória de dados:
Iniciando o tratamento do banco de dados
Verificando a categoria das variáveis
glimpse(banco)Rows: 918
Columns: 12
$ Age <int> 40, 49, 37, 48, 54, 39, 45, 54, 37, 48, 37, 58, 39, 49,…
$ Sex <chr> "M", "F", "M", "F", "M", "M", "F", "M", "M", "F", "F", …
$ ChestPainType <chr> "ATA", "NAP", "ATA", "ASY", "NAP", "NAP", "ATA", "ATA",…
$ RestingBP <int> 140, 160, 130, 138, 150, 120, 130, 110, 140, 120, 130, …
$ Cholesterol <int> 289, 180, 283, 214, 195, 339, 237, 208, 207, 284, 211, …
$ FastingBS <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ RestingECG <chr> "Normal", "Normal", "ST", "Normal", "Normal", "Normal",…
$ MaxHR <int> 172, 156, 98, 108, 122, 170, 170, 142, 130, 120, 142, 9…
$ ExerciseAngina <chr> "N", "N", "N", "Y", "N", "N", "N", "N", "Y", "N", "N", …
$ Oldpeak <chr> "0", "1", "0", "1.5", "0", "0", "0", "0", "1.5", "0", "…
$ ST_Slope <chr> "Up", "Flat", "Up", "Flat", "Up", "Up", "Up", "Up", "Fl…
$ HeartDisease <int> 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1…Realizando alteração no tipo das variáveis com a finalidade de ficar como descrita acima no dicionário das variáveis
banco$Sex <- factor(banco$Sex, levels = c("M","F"), labels = c("Masculino", "Feminino"))
banco$ChestPainType <- factor(banco$ChestPainType, levels = c("TA", "ATA", "NAP", "ASY"), labels = c("Angina Típica", "Angina Atípica", "Dor Não Anginosa", "Assintomática"))
banco$FastingBS <- factor(banco$FastingBS, levels = c(0,1),labels = c("C.C", "JejumBS > 120 mg/dl"))
banco$RestingECG <- factor(banco$RestingECG, levels = c("Normal", "ST", "LVH"), labels = c("Normal", "anormalidade da onda", "hipertrofia ventricular"))
banco$ExerciseAngina <- factor(banco$ExerciseAngina, levels = c("N", "Y"), labels = c("Não", "Sim"))
banco$ST_Slope <- factor(banco$ST_Slope, levels = c("Up", "Flat", "Down"), labels = c("Ascendente", "Plano", "Descendente"))
banco$HeartDisease <- factor(banco$HeartDisease, levels = c(0,1),labels = c("Normal", "Doença cardiaca"))
banco$Oldpeak <- as.numeric(banco$Oldpeak)Prosseguindo com a análise exploratória dos dados
skimr::skim(banco)| Name | banco |
| Number of rows | 918 |
| Number of columns | 12 |
| _______________________ | |
| Column type frequency: | |
| factor | 7 |
| numeric | 5 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| Sex | 0 | 1 | FALSE | 2 | Mas: 725, Fem: 193 |
| ChestPainType | 0 | 1 | FALSE | 4 | Ass: 496, Dor: 203, Ang: 173, Ang: 46 |
| FastingBS | 0 | 1 | FALSE | 2 | C.C: 704, Jej: 214 |
| RestingECG | 0 | 1 | FALSE | 3 | Nor: 552, hip: 188, ano: 178 |
| ExerciseAngina | 0 | 1 | FALSE | 2 | Não: 547, Sim: 371 |
| ST_Slope | 0 | 1 | FALSE | 3 | Pla: 460, Asc: 395, Des: 63 |
| HeartDisease | 0 | 1 | FALSE | 2 | Doe: 508, Nor: 410 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| Age | 0 | 1 | 53.51 | 9.43 | 28.0 | 47.00 | 54.0 | 60.0 | 77.0 | ▁▅▇▆▁ |
| RestingBP | 0 | 1 | 132.40 | 18.51 | 0.0 | 120.00 | 130.0 | 140.0 | 200.0 | ▁▁▃▇▁ |
| Cholesterol | 0 | 1 | 198.80 | 109.38 | 0.0 | 173.25 | 223.0 | 267.0 | 603.0 | ▃▇▇▁▁ |
| MaxHR | 0 | 1 | 136.81 | 25.46 | 60.0 | 120.00 | 138.0 | 156.0 | 202.0 | ▁▃▇▆▂ |
| Oldpeak | 0 | 1 | 0.89 | 1.07 | -2.6 | 0.00 | 0.6 | 1.5 | 6.2 | ▁▇▆▁▁ |
Acima podemos visualizar um resumo das informações presente em nosso banco de dados, que consiste em 12 caracteristicas clínicas de 918 indivíduos diferentes. Das 12 características clínicas, 7 são variáveis categóricas e 5 variáveis numéricas.
Observando a idade dos homens e mulheres
banco %>%
ggplot2::ggplot(ggplot2::aes(x=Sex, y = Age, fill = Sex))+
ggplot2::geom_boxplot(alpha = 0.5)+
ggplot2::labs(title = "Boxplot da idade com relação ao sexo",fill = "Sexo")+
ggplot2::xlab("Sexo") + ggplot2::ylab("Idade")
Com o auxilio gráfico do boxplot acima, podemos constatar que não existe diferença significante entre a idade dos pacientes masculinos e femininos.
Observando a idade dos que tiveram doença cardíaca e dos que não tiveram
banco %>%
ggplot2::ggplot(ggplot2::aes(x=HeartDisease, y = Age, fill = HeartDisease))+
ggplot2::geom_boxplot(alpha = 0.5,outlier.colour = "red", notch = F)+
ggplot2::labs(title = "Boxplot da idade com relação a presença ou não de doença cardíaca",fill = "Situação do paciente")+
ggplot2::xlab("Situação do paciente") + ggplot2::ylab("Idade")
No boxplot acima, pacientes que apresentaram doenças cardíacas possuem uma variabilidade menor de idade quando comparado com pacientes que não apresentaram. Além disso nota-se a presença de 4 outliers referentes a pacientes que apresentaram doenças cardiovasculares antes dos 35 anos. Também podemos observar 75% dos pacientes que não apresentaram doenças cardiovasculares são mais novos que a idade mediana dos pacientes que apresentaram doenças cardiovasculares. Isto é, pode-se levantar a hipótese de que a idade talvez tenha uma contribuição significativa para o desenvolvimento de doenças cardíacas.
Observando o boxplot da frequência máxima cardíaca do grupo de saudáveis e do grupo com doenças cardíacas
banco %>%
ggplot2::ggplot(ggplot2::aes(x=HeartDisease, y = MaxHR, fill = HeartDisease))+
ggplot2::geom_boxplot(alpha = 0.5,outlier.colour = "red", notch = F)+
ggplot2::labs(title = "Boxplot do máximo da frequência cardíaca alcançada",fill = "Situação")+
ggplot2::xlab("Situação") + ggplot2::ylab("MaxHR")
Como o coração de pessoas com doenças cardíacas não estão funcionando de maneira adequada, quando se é necessária uma carga maior de trabalho o coração desse indivíduo não consegue trabalhar de forma tão eficiente quanto o coração de uma pessoa saudável. Por conta disso, 75% dos indíviduos doentes possuem a frequência máxima cardíaca abaixo da mediana da frequência máxima cardíaca do grupo de pessoas saudáveis.
Observando o boxplot da pressão arterial em repouso do grupo de saudáveis e do grupo com doenças cardíacas
banco %>%
ggplot2::ggplot(ggplot2::aes(x=HeartDisease, y = RestingBP, fill = HeartDisease))+
ggplot2::geom_boxplot(alpha = 0.5, outlier.colour = "red", notch = F)+
ggplot2::labs(title = "Boxplot da pressão arterial em repouso",fill = "Situação")+
ggplot2::xlab("Situação") + ggplot2::ylab("Pressão arterial em repouso [mm HG]")
Apesar de ambos os grupos apresentarem dados semelhantes, o grupo que possui doenças cardiovasculares é ligeiramente maior que o grupo de indivíduos saudáveis. Afinal, o coração doente por não apresentar os batimentos tão eficientes quanto um coração saudável, as artérias tendem a compensar esses batimentos cardíacos aumentando sua pressão.
Observando o boxplot do colesterol sérico do grupo de saudáveis e do grupo com doenças cardíacas
banco %>%
ggplot2::ggplot(ggplot2::aes(x=HeartDisease, y = Cholesterol, fill = HeartDisease))+
ggplot2::geom_boxplot(alpha = 0.5, outlier.colour = "red", notch = F)+
ggplot2::labs(title = "Boxplot do Colesterol Sérico",fill = "Situação")+
ggplot2::xlab("Situação") + ggplot2::ylab("colesterol sérico [mm/dl]")
Devem existir inúmeros fatores que podem implicar uma maior variabilidade do colesterol no grupo de pessoas que possuem doenças cardíacas, uma delas pode estar relacionada com o fato do uso de medicações para diminuir e tentar controlar esse nível do colesterol.
Agora, vamos observar a relação entre o eletrocardiograma em repouso, RestingECG, relacionando com a presença de doença cardíaca ou não, HeartDisease.
banco %>%
count(HeartDisease, RestingECG) %>%
group_by(HeartDisease) %>%
mutate(percent = n / sum(n) *100,
percent = round(percent, 2)) %>%
gt::gt() %>%
gt::tab_header(
title = "Situação dos pacientes quanto a presença de doença cardíaca",
subtitle = "Com relação ao eletrocardiograma em repouso"
) %>%
gt::cols_label(
RestingECG = "ECG em Repouso",
n = "Frequência",
percent = "Percentual"
) %>%
gt::fmt_number(
columns = vars(n),
suffixing = TRUE
) | Situação dos pacientes quanto a presença de doença cardíaca | ||
| Com relação ao eletrocardiograma em repouso | ||
| ECG em Repouso | Frequência | Percentual |
|---|---|---|
| Normal | ||
| Normal | 267.00 | 65.12 |
| anormalidade da onda | 61.00 | 14.88 |
| hipertrofia ventricular | 82.00 | 20.00 |
| Doença cardiaca | ||
| Normal | 285.00 | 56.10 |
| anormalidade da onda | 117.00 | 23.03 |
| hipertrofia ventricular | 106.00 | 20.87 |
Quando aplicado o teste ECG nos pacientes em repouso, os que possuiam doenças cardiovasculares apresentaram uma frequência absoluta maior da normalidade no teste do que os pacientes que não possuiam doenças, 285 e 267 respectivamente. Entretanto, analisando a niveis percentuais a ordem se inverte, 65% do grupo que não apresentam DCVs tiveram a normalidade do teste, para o outro grupo apenas 56% apresentaram a normalidade do teste ECG. Para o grupo que não apresentam DCVs os outros 35% dos indivíduos estão distribuidos entre aqueles que apresentaram anormalidade da onda e hipertrofia ventricular no teste ECG. Para o grupo dos que apresentam DCVs os outros 44% estão distribuídos entre aqueles que apresentaram anormalidade da onda e hipertrofia ventricular no teste ECG.
Letra B
- Utilizando as variáveis quantitativas, realize uma análise de componentes principais. Quantas componentes principais devem ser mantidas e qual o percentual da variação total explicada por elas. As componentes mantidas são interpretáveis? Se sim, qual a interpreteção dessas componentes principais? Analise as componentes principais graficamente. Há possíveis outliers?
correlação <- banco %>%
select(Age, RestingBP,Cholesterol,MaxHR, Oldpeak) %>%
cor()
corrplot::corrplot(correlação, method = "number")
Podemos observar que talvez duas componentes sejam formadas.
- Como tem variáveis em escalas diferentes, será adotado a padronização
pca <- banco %>%
select(Age, RestingBP,Cholesterol,MaxHR, Oldpeak) %>%
prcomp(center = TRUE, scale = TRUE)
summary(pca)Importance of components:
PC1 PC2 PC3 PC4 PC5
Standard deviation 1.3066 1.0927 0.9118 0.8315 0.7591
Proportion of Variance 0.3414 0.2388 0.1663 0.1383 0.1152
Cumulative Proportion 0.3414 0.5802 0.7465 0.8848 1.0000É importante observar que com três componentes principais temos uma boa proporção de variabilidade que consegue ser explicada, sendo igual a 74.65% da variabilidade explicada pelas três componentes, diminuindo assim em 40% da metade da dimensão.
Visualização gráfica através do Scree Plot
factoextra::fviz_eig(pca) +
ggplot2::labs( y = "Porcentagem de Variância Explicada",
x = "Componentes Principais")
Resposta: Em nossa problemática manteremos três componentes principais com uma proporção de variabilidade explicada de 74.65%.
Explicação das componentes
pcaStandard deviations (1, .., p=5):
[1] 1.3065648 1.0926990 0.9117941 0.8314805 0.7590579
Rotation (n x k) = (5 x 5):
PC1 PC2 PC3 PC4 PC5
Age 0.6026536 0.009353273 0.07505093 -0.3172132 0.7283298
RestingBP 0.3742414 0.474166841 0.64215210 0.4299469 -0.1946676
Cholesterol -0.1779956 0.743454901 -0.06375770 -0.6283270 -0.1293543
MaxHR -0.5391946 0.343937374 -0.03735596 0.4329406 0.6341477
Oldpeak 0.4175389 0.322583657 -0.75930727 0.3637157 -0.11297961ª Componente: A primeira componente é visto um certo equilíbrio entre as magnitudes dos coeficientes das variáveis padronizadas. A variável Age, que representa a idade dos pacientes, foi a que apresentou o maior coeficiente em valor absoluto. A primeira componente principal se constitui em um índice comparativo entre a idade a pressão arterial em repouso e valor medido na depressão, com relação à Colesterol sérico e a Frequência máxima cardíaca alcançada, estas com o sinal negativo. Para essa primeira componente, a análise dos boxplots na questão anterior parece ter uma certa relação com a maneira na qual ela é constituída.2ª Componente:A segunda componente é observado uma certa proeminência em contribuição do Colesterol sérico, pois o valor absoluto do seu coeficiente é próximo do dobro do segundo (em valor absoluto). A segunda componente principal se constitui em uma soma ponderada de todas as variáveis.3ª Componente:A terceira componente é visto um certo equilibrio entre as magnitudes dos coeficientes das variáveis padronizadas. A variável Oldpeak, que representa o valor medido na depressão, foi a que apresentou o maior coeficiente em valor absoluto. A terceira componente principal se constitui em um índice comparativo entre a idade e pressão arterial em repouso, com relação à Colesterol sérico, Frequência máxima alcançada e o valor medido na depressão, estas com o sinal negativo.Analisando as componentes principais graficamente
factoextra::fviz_pca_ind(pca,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE,
legend.title = "Representation")
Verificando com relação à variável resposta
factoextra::fviz_pca_ind(pca,
col.ind = banco$HeartDisease,
palette = c("#00AFBB", "#FC4E07"),
addEllipses = TRUE,
ellipse.type = "confidence",
legend.title = "Situação do paciente",
repel = TRUE
)
Através do resultado da visualização gráfica, podemos observar que tem alguns possíveis outliers, pois estão um pouco distantes da massa de concentração das duas primeiras componentes principais, e até mesmo do seu próprio grupo de concentração.
Letra C
- Utilizando as variáveis quantitativas, proceda uma análise fatorial. Quantos fatores devem ser mantidas e qual o percentual da variação total explicada por esses fatores. Os fatores mantidos são interpretáveis? Se sim, qual a interpreteção desses fatores? É necessário aplicar algum tipo de rotação à matriz de cargas fatoriais? O que você pode dizer acerca das comunalidades e da matriz residual?
Verificando a possibilidade de utilizar a análise fatorial
psych::KMO(correlação)Kaiser-Meyer-Olkin factor adequacy
Call: psych::KMO(r = correlação)
Overall MSA = 0.6
MSA for each item =
Age RestingBP Cholesterol MaxHR Oldpeak
0.60 0.62 0.50 0.59 0.67 Resposta: Kaiser, Meyer & Olkin de adequaçao da amostra para analise fatorial. Um limiar comumente adotado para esta medida é igual a 60%. Sendo assim, podemos utilizar a análise fatorial, pois o valor calculado foi de 0.6, sendo o valor limite para a utilização da análise fatorial.
Considerando também o teste de esfericidade de Bartlett sobre a matriz de correlações amostrais, que testa a hipótese nula de que a matriz de correlações é igual a uma matriz identidade. Valores pequenos do p-valor indicam que uma análise fatorial pode ser útil aos dados.
psych::cortest.bartlett(correlação, n = nrow(banco))$chisq
[1] 359.4232
$p.value
[1] 3.981687e-71
$df
[1] 10Rejeitamos H_0, ou seja, com base na matriz de correlações amostrais e com 95% de confiança rejeitamos a hipótese de que a aplicação da análise fatorial não é adequada. O resultado do p-valor foi de 3.982 \times 10^{-71}.
Investigando o número de fatores
eigv <- eigen(correlação)
eigv <- data.frame(nfact = 1:5, eigval = eigv$values)
ggplot2::ggplot(data = eigv, mapping = ggplot2::aes(nfact, eigval)) +
ggplot2::geom_col(fill = "#4d4dff", colour = "black" ) +
ggplot2::geom_line() +
ggplot2::geom_point() +
ggplot2::geom_abline(slope = 0, intercept = 1, color = "red") +
ggplot2::labs(x = "Número de fatores",
y = "Autovalor",
title = "Scree plot") +
ggplot2::theme_minimal()
Resposta: De acordo com a visualização gráfica, dois fatores são suficientes para alcançar o objetivo de redução da dimensão.
mfo <-
banco %>%
select(Age, RestingBP, Cholesterol, MaxHR, Oldpeak) %>%
factanal(factors = 2, rotation = "none")
mfo
Call:
factanal(x = ., factors = 2, rotation = "none")
Uniquenesses:
Age RestingBP Cholesterol MaxHR Oldpeak
0.489 0.815 0.625 0.637 0.841
Loadings:
Factor1 Factor2
Age 0.705 0.121
RestingBP 0.303 0.305
Cholesterol -0.231 0.567
MaxHR -0.574 0.182
Oldpeak 0.334 0.217
Factor1 Factor2
SS loadings 1.083 0.510
Proportion Var 0.217 0.102
Cumulative Var 0.217 0.319
Test of the hypothesis that 2 factors are sufficient.
The chi square statistic is 0.3 on 1 degree of freedom.
The p-value is 0.585 Como podemos analisar através do resultado, o teste de que dois fatores são suficientes não foi rejeitado, sendo assim como é observado através da proporção da variabilidade explicada também temos que dois fatores não são suficientes, pois a proporção de variabilidade explicada é de 31.9%.
psych::fa.diagram(mfo$loadings,digits = 3)
Interpretação dos fatores
1ª Fator: Como podemos observar o primeiro fator é um contraste entre Colesterol sérico e Frequência máxima alcançada, com relação à Idade, pressão arterial em repouso e valor medido na depressão
2ª Fator: Como podemos observar o segundo fator é uma soma ponderada de todas as variáveis, onde destaca-se com peso maior o Colesterol sérico e pressão arterial em repouso.
Não foi necessário a aplicação de rotação à matriz de cargas fatoriais.
Comunalidades
O objetivo das comunalidades é resumir o percentual de explicação do modelo obtido para as variáveis descritas no banco.
comunalidades <- rowSums(mfo$loadings^2)
comunalidades Age RestingBP Cholesterol MaxHR Oldpeak
0.5112898 0.1850257 0.3751078 0.3629477 0.1587779 Segue abaixo uma tabela com o percentual da explicação da variabilidade das variáveis com o uso dos dois fatores:
| Nome da Variável | Percentual (%) |
|---|---|
| Age | 51.13 |
| RestingBP | 18.5 |
| Cholesterol | 37.51 |
| MaxHR | 36.29 |
| Oldpeak | 15.88 |
A utilização da análise fatorial ortogonal com dois fatores não ficou bem ajustada nos dados, pois a variabilidade proporcional explicada das variáveis foram baixas, o que vai influenciar em uma matriz residual ruim.
Matriz residual
rho_til <- mfo$loadings%*%t(mfo$loadings)+diag(mfo$uniquenesses)
U <- correlação - rho_til
round(U, 4) Age RestingBP Cholesterol MaxHR Oldpeak
Age 0.0000 0.0040 -0.0009 0.0006 -0.0033
RestingBP 0.0040 0.0000 -0.0023 0.0061 -0.0027
Cholesterol -0.0009 -0.0023 0.0000 -0.0004 0.0046
MaxHR 0.0006 0.0061 -0.0004 0.0000 -0.0082
Oldpeak -0.0033 -0.0027 0.0046 -0.0082 0.0000Uma boa utilização da análise fatorial, vai implicar que todos os elementos fora da diagonal vão ser muito próximos a 0, o que não se aplica ao exemplo.
Letra D
- Utilizando as variáveis quantitativas e desconsiderando a existência de classes a priori, compare métodos de agrupamento com relação aos índices de Silhueta, Dunn e Conectividade. Considere ao menos os modelos de agrupamento vistos em sala de aula, mas, sintam-se livres para explorar outros métodos. Proceda uma análise descritiva do conjunto de dados de acordo com os grupos formados.
Selecionando as variáveis que vamos utilizar na modelagem
new_data <- banco %>%
select(Age, RestingBP, Cholesterol, MaxHR, Oldpeak)
glimpse(new_data)Rows: 918
Columns: 5
$ Age <int> 40, 49, 37, 48, 54, 39, 45, 54, 37, 48, 37, 58, 39, 49, 42…
$ RestingBP <int> 140, 160, 130, 138, 150, 120, 130, 110, 140, 120, 130, 136…
$ Cholesterol <int> 289, 180, 283, 214, 195, 339, 237, 208, 207, 284, 211, 164…
$ MaxHR <int> 172, 156, 98, 108, 122, 170, 170, 142, 130, 120, 142, 99, …
$ Oldpeak <dbl> 0.0, 1.0, 0.0, 1.5, 0.0, 0.0, 0.0, 0.0, 1.5, 0.0, 0.0, 2.0…Utilizando apenas o novo banco de dados agora só com variáveis quantitivas vamos continuar procedendo o método de agrupamento
- Utilizando a função criada pelo Professor Marcelo Ferreira para saber qual o número ótimo de grupos
Verificando qual o valor melhor de K para o método K-means
elbow.plot(new_data)+
ggplot2::ggtitle("Valor de K ótimo para o método K-means")
- De acordo com a análise gráfica podemos observar que o valor de K adequado é K=3, para o método K-means.
Prosseguindo para o agrupamento através do método K-means e com K=3
ajuste <- kmeans(new_data, 3)
factoextra::fviz_cluster(ajuste, data = new_data) +
ggplot2::ggtitle("Agrupamento com K=3 método K-Means")
Realizando para o método Fuzzy K-means
Verificando qual o valor melhor de K para o método Fuzzy K-means
elbow.plot(new_data, alg = "cmeans")+
ggplot2::ggtitle("Valor de K ótimo para o método Fuzzy K-means")
- De acordo com a análise gráfica podemos observar que o valor de K adequado é K=3, para o método K-means.
Prosseguindo para o agrupamento através do método Fuzzy K-means e com K=3
ajuste2 <- fanny(new_data, 3)
factoextra::fviz_cluster(ajuste2, data = new_data) +
ggplot2::ggtitle("Agrupamento com K=3 método Fuzzy K-Means")
Realizando para o método Hierárquico
Verificando qual o valor melhor de K para o método Hierárquico
elbow.plot(new_data, alg = "hclust")+
ggplot2::ggtitle("Valor de K ótimo para o método Hierárquico")
Medidas de Qualidade
- Para as medidas de qualidade analisaremos apenas os métodos Fuzzy k-means e k-means.
Indice de Conectividade
connectivity(clusters = ajuste$cluster, Data = new_data)[1] 87.09921connectivity(clusters = ajuste2$cluster, Data = new_data)[1] 88.87143Conectividade: Como o objetivo no índice de conectividade é o menor valor, o método K-means de agrupamento com K=3, mostrou-se mais preciso.
Indice de Dunn
dunn(clusters = ajuste$cluster, Data = new_data) #k-means[1] 0.01999135dunn(clusters = ajuste2$cluster, Data = new_data) #fuzzy k-means[1] 0.01803799Índice de Dunn: Como o objetivo no índice de Dunn é o maior valor, o método K-means de agrupamento com K=3, mostrou-se mais preciso.
Silhueta
s5 <- silhouette(ajuste$cluster, dist = dist(new_data)^2) # k-means
s6 <- silhouette(ajuste2$cluster, dist = dist(new_data)^2) # fuzzy k-means
summary(s5)$avg.width[1] 0.6419701summary(s6)$avg.width[1] 0.606999Silhueta: Como o objetivo no índice de Silhueta é o valor mais próximo de 1, o método K-means de agrupamento com K=3, mostrou-se mais preciso.
Resposta Final: Segue então que o melhor método de agrupamento foi o k-means, pois nos índices ele se mostrou o que teve melhor desempenho.
Depois de escolhido o melhor método, o k-means, podemos observar o centro para cada um dos clusters. Isto é, a observação fará parte do cluster em que suas características mais se aproximarem dos valores apresentados na tabela abaixo.
row.names(ajuste$centers) <- c("Cluster 1", "Cluster 2", "Cluster 3")
ajuste$centers Age RestingBP Cholesterol MaxHR Oldpeak
Cluster 1 53.81720 135.9534 302.207885 138.7778 1.0204301
Cluster 2 52.30819 131.3017 210.984914 141.1466 0.8327586
Cluster 3 56.21143 129.6286 1.628571 122.1714 0.8200000Questão 2
- Para este conjunto de dados, construa o gráfico do stress contra q, decida o número adequado de dimensões e aloque os sítios em duas dimensões usando os dois primeiros eixos advindos da solução com o valor escolhido de q. Compare a disposição das equipes em duas dimensões com a classificação final no campeonato.
Importando os dados:
library(smacof)
Serie_A_2022 <- read.csv("Serie_A_2022.csv")
t <- Serie_A_2022[,-3]
rownames(t) = t[,1]
t <- t[,-1]d = dist(t)
stress = c()
k = 6
for (q in 1:k) stress[q] = mds(d, ndim = q)$stress
plot(1:6, stress, type = "l", xlab = expression(q), ylab = "stress", bty = "n")
points(1:6, stress, pch = 15)
Através do gráfico de cotovelo 3 e 4 dimensões parecem ser suficientes.
fit2 = mds(d, ndim = 4)
fit1 = mds(d, ndim = 3)
c(fit1$stress , fit2$stress)[1] 0.02471679 0.01076481x = fit2$conf[,1]
y = fit2$conf[,2]
par(mfrow = c(1,1))
plot(x, y, xlab = "Coordinate 1", ylab = "Coordinate 2",
main = "Metric MDS", type = "n")
text(x, y, labels = Serie_A_2022[,2], cex = .7)
Serie_A_2022[,c(1,4)] %>%
slice_head(n=20) %>%
gt::gt()| Equipe | P |
|---|---|
| Palmeiras-SP | 81 |
| Internacional-RS | 73 |
| Fluminense-RJ | 70 |
| Corínthians-SP | 65 |
| Flamengo-RJ | 62 |
| Athlético Paranaense-PR | 58 |
| Atlético Mineiro-MG | 58 |
| Fortaleza-CE | 55 |
| São Paulo-SP | 54 |
| América-MG | 53 |
| Botafogo-RJ | 53 |
| Santos-SP | 47 |
| Goiás-GO | 46 |
| Red Bull Bragantino-SP | 44 |
| Coritiba-PR | 42 |
| Cuiabá-MT | 41 |
| Ceará-CE | 37 |
| Atlético-GO | 36 |
| Avaí-SC | 35 |
| Juventude-RS | 22 |
Após o procedimento de escalonamento multidimensional e a visualização em duas coordenadas, é observado que reflete o padrão da classificação final do campeonato brasileiro de 2022, pois em uma rápida análise é verificado que a equipe campeã é a primeira e fica um pouco mais isolada do vice-campeão e dos demais classificados a libertadores, refletindo a distância de 8 pontos do campeão para o vice, onde o procedimento de um possível agrupamento por similaridade aparece nos demais times pois a distância de um para o outro é pouca, o mesmo que aconteceu com o campeão foi observado na zona de rebaixamento, onde a equipe lanterna ficou isolada das demais equipes, refletindo a classificação final do campeonato, onde a diferença para 19º colocado foi de 13 pontos. Sendo assim, concluímos que o escalonamento aplicado preservou a ordem e coerência da classificação do campeonato brasileiro de 2022.
Questão 3
- Uma amostra de 901 pessoas foi classificada de acordo com a satisfação com o trabalho e o nível de renda, conforme a tabela a seguir. Realize uma análise de correspondência e interprete os resultados.
Satisfação com o Trabalho
| Renda | Muito Insatisfeito | Insatisfeito | Satisfeito | Muito Satisfeito |
|---|---|---|---|---|
| < R$ 2000 | 42 | 62 | 184 | 207 |
| R$ 2000 - R$ 5000 | 13 | 28 | 81 | 113 |
| > R$ 5000 | 7 | 18 | 54 | 92 |
satisfacao <- matrix(c(42, 62, 184, 207,
13, 28, 81, 113,
7, 18, 54, 92), ncol = 4, byrow = T)
rownames(satisfacao) = c("< 2000", "2000 - 5000", "> 5000")
colnames(satisfacao) = c("Muito Insatisfeito", "Insatisfeito", "Satisfeito", "Muito Satisfeito")
satisfacao <- as.table(satisfacao)
fitq3 = ca::ca(satisfacao)
summary(fitq3)
Principal inertias (eigenvalues):
dim value % cum% scree plot
1 0.011438 99.0 99.0 *************************
2 0.000113 1.0 100.0
-------- -----
Total: 0.011551 100.0
Rows:
name mass qlt inr k=1 cor ctr k=2 cor ctr
1 | 2000 | 549 1000 390 | -90 999 393 | 3 1 57 |
2 | 20005 | 261 1000 93 | 62 932 87 | -17 68 652 |
3 | 5000 | 190 1000 517 | 177 995 519 | 13 5 291 |
Columns:
name mass qlt inr k=1 cor ctr k=2 cor ctr
1 | MtIn | 69 1000 423 | -265 990 423 | 27 10 444 |
2 | Inst | 120 1000 41 | -60 916 38 | -18 84 352 |
3 | Stsf | 354 1000 115 | -61 992 116 | -6 8 100 |
4 | MtSt | 457 1000 421 | 103 998 424 | 5 2 105 |plot(fitq3)
A análise de correspondência é um procedimento gráfico usado para representar associações em uma tabela de contingência. No gráfico apresentado acima, os 3 pontos azuis representam os grupos de renda na amostra, enquanto os 4 pontos vermelhos representam o grau de satisfação dos indivíduos intrevistados.
Observando o gráfico de contingência acima, podemos perceber que os pontos azuis estão significantemente afastados, o que nos indica que esses grupos possuem perfis distintos ao longo do nível de satisfação. Já para os pontos vermelhos, o gráfico indica que o nível de satisfação existem perfis similares ao longo do grupo de renda.
Os grupos de insatisfação e satisfação próximos ao grupo de renda menor que R$ 2000, e o grupo de muita satisfação próximo aos grupos de renda entre 2000 - 5000 e maior que 5000 representam as combinações que ocorrem com mais frequência do que seria esperado.