Práctica análisis ANOVA
2023-10-01
ANÁLISIS ANOVA
# Carga de la base de datos
library(readxl) ## Warning: package 'readxl' was built under R version 4.3.1#file.choose() para copiar la ruta
ruta <- "E:\\OneDrive\\UNIR\\2023\\Actividades\\act1\\act1.xls"
act1 <- read_excel(ruta)
act1$Localización <- as.factor(act1$Localización)Visualizamos la base de datos
head(act1)## # A tibble: 6 × 3
## Edad Coste_euros Localización
## <dbl> <dbl> <fct>
## 1 23 1136. 0
## 2 65 1292 0
## 3 20 1326. 0
## 4 30 1783. 0
## 5 72 1795. 0
## 6 63 1860. 0Existen 288 registros y 3 variables, 1 de ellas es categórica (Localización)
Estudiamos los datos estadísticos descriptivos mediante 2 librerías distintas
library(psych)## Warning: package 'psych' was built under R version 4.3.1describe(act1[, c("Edad", "Coste_euros")])## vars n mean sd median trimmed mad min max
## Edad 1 288 44.83 19.90 48.00 44.26 22.24 10.00 85.0
## Coste_euros 2 288 12935.32 13523.05 5084.85 10693.43 2114.42 1135.68 75314.9
## range skew kurtosis se
## Edad 75.00 0.03 -1.16 1.17
## Coste_euros 74179.22 1.45 1.22 796.85library(pastecs)## Warning: package 'pastecs' was built under R version 4.3.1stat.desc(act1)## Edad Coste_euros Localización
## nbr.val 2.880000e+02 2.880000e+02 NA
## nbr.null 0.000000e+00 0.000000e+00 NA
## nbr.na 0.000000e+00 0.000000e+00 NA
## min 1.000000e+01 1.135680e+03 NA
## max 8.500000e+01 7.531490e+04 NA
## range 7.500000e+01 7.417922e+04 NA
## sum 1.291100e+04 3.725371e+06 NA
## median 4.800000e+01 5.084850e+03 NA
## mean 4.482986e+01 1.293532e+04 NA
## SE.mean 1.172752e+00 7.968531e+02 NA
## CI.mean.0.95 2.308285e+00 1.568417e+03 NA
## var 3.960999e+02 1.828728e+08 NA
## std.dev 1.990226e+01 1.352305e+04 NA
## coef.var 4.439509e-01 1.045436e+00 NAEvaluación sobre la normalidad de la muestra
library(ggplot2)##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alphaggplot(data = act1, aes(x = Edad)) +
geom_histogram(aes(y = ..density.., fill = ..count..)) +
scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
stat_function(fun = dnorm, colour = "firebrick",
args = list(mean = mean(act1$Edad),
sd = sd(act1$Edad))) +
ggtitle("Histograma con curva normal teórica") +
theme_bw()## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(data = act1, aes(x = Coste_euros)) +
geom_histogram(aes(y = ..density.., fill = ..count..)) +
scale_fill_gradient(low = "#DCDCDC", high = "#7C7C7C") +
stat_function(fun = dnorm, colour = "firebrick",
args = list(mean = mean(act1$Coste_euros),
sd = sd(act1$Coste_euros))) +
ggtitle("Histograma con curva normal teórica") +
theme_bw()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Análisis analítico
Se realiza el test de normalidad, para p<0.05 no se da la normalidad.
La prueba de normalidad de Shapiro-Wilk es aplicable cuando se analizan muestras compuestas por menos de 50 elementos (muestras pequeñas).
shapiro.test(x = act1$Edad)##
## Shapiro-Wilk normality test
##
## data: act1$Edad
## W = 0.94214, p-value = 3.318e-09shapiro.test(x = act1$Coste_euros)##
## Shapiro-Wilk normality test
##
## data: act1$Coste_euros
## W = 0.7237, p-value < 2.2e-16El test de Kolmogorov-Smirnov (con la corrección Lilliefors) se utiliza para contrastar si un conjunto de datos se ajustan o no a una distribución normal. Es similar en este caso al test de Shapiro Wilk, pero la principal diferencia con éste radica en el número de muestras. Mientras que el test de Shapiro Wilk se puede utilizar con hasta 50 datos, el test de Kolmogorov Smirnov es recomendable utilizarlo con más de 50 observaciones. Igualmente, si el p-value < 0.05 se confirma la falta de normalidad de la muestra.
ks.test(x = act1$Edad,"pnorm")## Warning in ks.test.default(x = act1$Edad, "pnorm"): ties should not be present
## for the Kolmogorov-Smirnov test##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: act1$Edad
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sidedks.test(x = act1$Coste_euros,"pnorm")## Warning in ks.test.default(x = act1$Coste_euros, "pnorm"): ties should not be
## present for the Kolmogorov-Smirnov test##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: act1$Coste_euros
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sidedConfirmamos con el dibujo Q-Q
qqnorm(act1$Edad, pch = 19, col = "gray50", main = "Normal Q-Q Plot Edad")
qqline(act1$Edad)
qqnorm(act1$Coste_euros, pch = 19, col = "gray50", , main = "Normal Q-Q Plot Coste Euros")
qqline(act1$Coste_euros)
Estudiamos la posible diferencia significativa entre grupos mediante los
box-plots.
ggplot(data = act1, mapping = aes(x = Localización, y = Coste_euros, colour = Localización)) +
ggtitle("Box Plot Coste Euros por Localización") +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = act1, mapping = aes(x = Localización, y = Edad, colour = Localización)) +
ggtitle("Box Plot Edad por Localización") +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
Homocedasticidad: la varianza debe de ser constante entre todos los grupos.
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:psych':
##
## logitleveneTest(Edad+Coste_euros ~ Localización, data = act1, center = "median")## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 2 8.6021 0.0002358 ***
## 285
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Para un p-value < 0.05, existe heterocedasticidad.
Resumen
1- Las variables numéricas con registros de casi 300, no responden a una distribución normal ni tampoco la homocedasticidad. 2-Para una n de 288 y para los 3 grupos analizados (96 cada grupo) se debe evaluar ANOVA y también modelos no paramétricos, y no deberían diferir en el resultado. 3- Para una n< 30 la normalidad y homocedasticidad son más estrictos.
Evaluación Krustal- Wallis
kruskal.test(Edad ~ Localización, data = act1)##
## Kruskal-Wallis rank sum test
##
## data: Edad by Localización
## Kruskal-Wallis chi-squared = 2.3373, df = 2, p-value = 0.3108Para edad no ofrece significancia entre los grupos.
kruskal.test(Coste_euros ~ Localización, data = act1)##
## Kruskal-Wallis rank sum test
##
## data: Coste_euros by Localización
## Kruskal-Wallis chi-squared = 53.463, df = 2, p-value = 2.459e-12Para la variable Coste-Euros sí, puesto que p-value < 0.05
Comparaciones post-hoc para saber que dos grupos difieren
Existen diferentes métodos de corrección del nivel de significancia, entre ellos destacan el de Bonferroni que es muy estricto y el de holm, este último parece ser más recomendado.
pairwise.wilcox.test(x = act1$Coste_euros, g = act1$Localización, p.adjust.method = "holm" )##
## Pairwise comparisons using Wilcoxon rank sum test with continuity correction
##
## data: act1$Coste_euros and act1$Localización
##
## 0 1
## 1 0.00056 -
## 2 0.16820 3.8e-16
##
## P value adjustment method: holmpairwise.wilcox.test(x = act1$Coste_euros, g = act1$Localización, p.adjust.method = "bonferroni" )##
## Pairwise comparisons using Wilcoxon rank sum test with continuity correction
##
## data: act1$Coste_euros and act1$Localización
##
## 0 1
## 1 0.00084 -
## 2 0.50460 3.8e-16
##
## P value adjustment method: bonferroniComparativa de los resultados con modelos ANOVA
anova <- aov(act1$Coste_euros ~ act1$Localización)
summary(anova)## Df Sum Sq Mean Sq F value Pr(>F)
## act1$Localización 2 3.281e+09 1.640e+09 9.501 0.000101 ***
## Residuals 285 4.920e+10 1.726e+08
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Confirma los resultados anteriores y evaluamos el detalle posterior.
TukeyHSD(anova)## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = act1$Coste_euros ~ act1$Localización)
##
## $`act1$Localización`
## diff lwr upr p adj
## 1-0 3353.463 -1114.777 7821.7027 0.1821922
## 2-0 -4867.367 -9335.607 -399.1271 0.0289664
## 2-1 -8220.830 -12689.070 -3752.5898 0.0000601anova1 <- aov(act1$Edad ~ act1$Localización)
summary(anova1)## Df Sum Sq Mean Sq F value Pr(>F)
## act1$Localización 2 684 342.0 0.863 0.423
## Residuals 285 112997 396.5plot(anova)
## CONCLUSION
No existen diferencias significativas entre la localización respecto de la edad. Existen diferencias significativas entre la localización (entre la zona 2 y el resto) en el caso de la variable Coste-Euro.