Avaliação Multivariada 1
Gabriel Cardoso
1 Carregando a base de dados
dados1 = readxl::read_excel('multi1_tabelas.xlsx',sheet = 1) # carregar base
dados2 = readxl::read_excel('multi1_tabelas.xlsx',sheet = 2) # carregar base
dados1 <- as.matrix(dados1) # transformar em matriz
dados1 = scale(dados1,center = T,scale = F) # Padronizar
head(dados1)## N L S O
## [1,] 14.857143 13.7857143 21.428571 26.7142857
## [2,] 33.857143 26.7857143 44.428571 24.7142857
## [3,] 2.857143 0.7857143 11.428571 12.7142857
## [4,] -1.142857 15.7857143 -7.571429 -0.2857143
## [5,] -1.142857 4.7857143 9.428571 7.7142857
## [6,] 21.857143 12.7857143 15.428571 10.7142857head(dados2)## # A tibble: 6 × 3
## X1 X2 grupo
## <dbl> <dbl> <dbl>
## 1 5.4 3 1
## 2 4.5 3.2 1
## 3 6.3 3.5 1
## 4 6.9 4.6 1
## 5 6.2 5.6 1
## 6 6.9 5.2 12 Questão 1
2.1 Vetor de médias
medias <- colMeans(dados1)
medias## N L S O
## -3.045183e-15 -1.015061e-15 2.030122e-15 1.015061e-152.2 Matriz de variância/ Covariância
matriz_covariancia <- cov(dados1)
matriz_covariancia## N L S O
## N 405.5165 319.3516 393.6044 299.9560
## L 319.3516 310.7967 317.0220 242.6264
## S 393.6044 317.0220 440.1099 332.7473
## O 299.9560 242.6264 332.7473 279.14292.3 Matriz de Correlação
matriz_correlacao <- cor(dados1)
matriz_correlacao## N L S O
## N 1.0000000 0.8995529 0.9316979 0.8915385
## L 0.8995529 1.0000000 0.8571772 0.8237332
## S 0.9316979 0.8571772 1.0000000 0.9493375
## O 0.8915385 0.8237332 0.9493375 1.00000002.4 autovalores e autovetores
# Calcular os autovalores e autovetores
resultados <- eigen(matriz_covariancia)
# Acessar os autovetores
autovetores <- resultados$vectors
resultados## eigen() decomposition
## $values
## [1] 1327.18338 64.23398 28.74046 15.40812
##
## $vectors
## [,1] [,2] [,3] [,4]
## [1,] -0.5384383 0.1912646 0.77548549 0.26855958
## [2,] -0.4492035 0.7523405 -0.47887843 -0.05362391
## [3,] -0.5633535 -0.4138865 -0.04185584 -0.71384794
## [4,] -0.4369590 -0.4754994 -0.40932358 0.644531882.5 Biblop com a matriz de covariância.
f = dados1 %*% autovetores
biplot(f,autovetores)
Temos 4 variáveis, a soma dos autovalores é igual a 1435.566, a
dimenssão 1 possui 92,45% de informação, equanto a dimensão 2 possui
4,47%, ja a dimensão 3 possui 2,00% e por fim a dimensão 4 possui
1,07%.
2.6 Existe correlação entre as 4 direções?
matriz_correlacao## N L S O
## N 1.0000000 0.8995529 0.9316979 0.8915385
## L 0.8995529 1.0000000 0.8571772 0.8237332
## S 0.9316979 0.8571772 1.0000000 0.9493375
## O 0.8915385 0.8237332 0.9493375 1.0000000Dada a matriz de correlação podemos afirmar que existe correlação significativa entre as variáveis.
3 Questão 2
3.1 Verifique pelos diagramas de pontos de cada variável e o diagrama de dispersão das duas, se há sobreposição para os dois grupos em questão.
library(ggplot2)
# Diagrama de pontos (scatter plot) para a variável X1
ggplot(dados2, aes(x = grupo, y = X1, color = factor(grupo))) +
geom_jitter() +
labs(x = "Grupo", y = "X1") +
ggtitle("Diagrama de pontos para X1") +
theme_minimal()
# Diagrama de pontos (scatter plot) para a variável X2
ggplot(dados2, aes(x = grupo, y = X2, color = factor(grupo))) +
geom_jitter() +
labs(x = "Grupo", y = "X2") +
ggtitle("Diagrama de pontos para X2") +
theme_minimal()
# Diagrama de dispersão para as variáveis X1 e X2
ggplot(dados2, aes(x = X1, y = X2, color = factor(grupo))) +
geom_point() +
labs(x = "X1", y = "X2") +
ggtitle("Diagrama de Dispersão") +
theme_minimal()
Podemos ver graficamente que não há sobreposição dos grupos.
3.2 Faça as Anovas separadamente para cada variável, e verifique a significância a 5%.
# ANOVA para X1
anova_X1 <- aov(dados2$X1 ~ factor(dados2$grupo))
summary(anova_X1)## Df Sum Sq Mean Sq F value Pr(>F)
## factor(dados2$grupo) 1 1.533 1.533 1.22 0.284
## Residuals 18 22.616 1.256Como o p-valor foi de 0.284 ou seja, maior que 0,05, rejeitamos a hipótese nula ao nivel de 5% de segnificância. Não há diferença significativa entre as médias dos grupos para a variável X1.
# ANOVA para X2
anova_X2 <- aov(dados2$X2 ~ factor(dados2$grupo))
summary(anova_X2)## Df Sum Sq Mean Sq F value Pr(>F)
## factor(dados2$grupo) 1 10.14 10.141 4.682 0.0442 *
## Residuals 18 38.98 2.166
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Como o p-valor foi de 0.0442, ou seja, menor que 0,05, há fortes indicios para rejeitar a hipótese nula. Portanto, podemos comcluir que há diferenças siginificativas entre as médias dos grupos para variável X2, com um nível de significância de 5%.
3.3 Faça a Manova com os testes Lambda de Wilks, Traço de Pilai, Raiz de Roy e Traço de Hotelling)
# Realizar a MANOVA
manova_result <- manova(cbind(X1, X2) ~ as.factor(grupo), data = dados2)
print(manova_result)## Call:
## manova(cbind(X1, X2) ~ as.factor(grupo), data = dados2)
##
## Terms:
## as.factor(grupo) Residuals
## X1 1.53334 22.61616
## X2 10.14085 38.98465
## Deg. of Freedom 1 18
##
## Residual standard errors: 1.120916 1.47167
## Estimated effects may be unbalancedTeste de Lambda de Wilks
lambda_wilks <- summary(manova_result,test = 'Wilks')
lambda_wilks## Df Wilks approx F num Df den Df Pr(>F)
## as.factor(grupo) 1 0.49725 8.5939 2 17 0.002636 **
## Residuals 18
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Com base no teste Lambda de Wilks, podemos concluir que há diferenças significativas entre os grupos nos valores das variáveis X1 e X2.
Teste de Traço de Pillai
pillai_trace <- summary(manova_result,test = "Pillai")
pillai_trace## Df Pillai approx F num Df den Df Pr(>F)
## as.factor(grupo) 1 0.50275 8.5939 2 17 0.002636 **
## Residuals 18
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Com base no teste de Traço de Pillai, podemos concluir que existem diferenças significativas entre os grupos em relação aos valores das variáveis X1 e X2.
Teste de Raiz de Roy
roy_root <- summary(manova_result,test = "Roy")
roy_root## Df Roy approx F num Df den Df Pr(>F)
## as.factor(grupo) 1 1.011 8.5939 2 17 0.002636 **
## Residuals 18
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Podemos concluir que existem diferenças significativas entre os grupos em relação aos valores das variáveis X1 e X2.
Teste de Traço de Hotelling
hotelling_trace <- summary(manova_result,test = "Hotelling-Lawley")
hotelling_trace## Df Hotelling-Lawley approx F num Df den Df Pr(>F)
## as.factor(grupo) 1 1.011 8.5939 2 17 0.002636 **
## Residuals 18
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Com base no teste de Traço de Hotelling-Lawley, podemos concluir que existem diferenças significativas entre os grupos em relação aos valores das variáveis X1 e X2.
3.4 Teste a hipótese para H0 : μ = [5,0 6,0]t versus H1 : μ ≠ [5,0 6,0]t ao nível de 5% de significância.
# Vetor médio hipotético
mu_hipotetico <- c(5.0, 6.0)
# Estimativa de Hotelling's T-squared
t_squared <- (t(mu_hipotetico - colMeans(dados2[, c("X1", "X2")])) %*% solve(cov(dados2[, c("X1", "X2")]))) %*% (mu_hipotetico - colMeans(dados2[, c("X1", "X2")])) * ((nrow(dados2) - 1) / ncol(dados2))
# Graus de liberdade
df1 <- 2 # Número de variáveis
df2 <- nrow(dados2) - 1
# Valor crítico (nível de significância de 5%)
valor_critico <- qf(1 - 0.05, df1, df2)
# Teste de hipótese
if (t_squared > valor_critico) {
# Rejeitar H0
cat("Rejeitar H0: μ = [5.0, 6.0]ᵀ\n")
} else {
# Não rejeitar H0
cat("Não rejeitar H0: μ = [5.0, 6.0]ᵀ\n")
}## Rejeitar H0: μ = [5.0, 6.0]ᵀCom base nos dados e no teste estatístico realizado, temos evidências estatísticas suficientes para rejeitar a hipótese nula de que o vetor médio populacional das variáveis X1 e X2 seja igual a [5.0, 6.0]ᵀ.