U2A2: análisis de correlación, significancia, normalidad y regresion lineal

EQUIPO 6: Angélica Payán Serna, Karen Gutiérrez Velásquez y Andrea Higuera Chávez

24/04/2021

Tema: Educación en México

Acerca de este documento

Datos obtenidos de: https://inegi.org.mx/temas/educacion/

Descarga de este código

xfun::embed_file("U2A3.Rmd")

Download U2A3.Rmd

Importación de datos

setwd("~/Estadistica")
library(readxl)
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --
## v ggplot2 3.3.3     v purrr   0.3.4
## v tibble  3.1.0     v dplyr   1.0.5
## v tidyr   1.1.3     v stringr 1.4.0
## v readr   1.4.0     v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(prettydoc)
library(readr)
library(DT)
library(pacman)
p_load("base64enc","htmltools","mime","xfun","prettydoc","readr","knitr","DT","dplyr","ggplot2","plotly","gganimate","gifski","scales", "MASS", "class")
tasa <- read.csv("EducacionTasa.csv")

Tabla de datos

datatable(tasa)

Hipótesis

Podemos decir que la tasa de educación aumenta año con año, ya que, cada vez hay más acceso a la educación.

En base a un analisis de correlacion, significancia, normalidad y regresion lineal, determinaremos si la hipótesis es correcta o no.

Análisis de correlación

pairs(x = tasa, lower.panel = NULL)

cor(x = tasa, method = "pearson")
##              periodo preescolar  primaria secundaria
## periodo    1.0000000  0.9692545 0.4297579  0.9786243
## preescolar 0.9692545  1.0000000 0.3423277  0.9575203
## primaria   0.4297579  0.3423277 1.0000000  0.3965081
## secundaria 0.9786243  0.9575203 0.3965081  1.0000000

Como se puede observar, los datos tienen una correlación alta, a excepción de la primeria, que es la que más varía.

Diagrama de dispersión para preescolar

data("tasa")
## Warning in data("tasa"): data set 'tasa' not found
#Se emplea el log del precio porque mejora la linealidad
ggplot(data = tasa, aes(x = periodo, y = preescolar)) + 
  geom_point(colour = "red4") +
  ggtitle("Diagrama de dispersión") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))

En este gráfico podemos observar que la tasa de preescolar, mayormente aumenta conforme aumenta el período

Diagrama de dispersión para primaria

data("tasa")
## Warning in data("tasa"): data set 'tasa' not found
#Se emplea el log del precio porque mejora la linealidad
ggplot(data = tasa, aes(x = periodo, y = primaria)) + 
  geom_point(colour = "red4") +
  ggtitle("Diagrama de dispersión") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))

En este caso, la tasa de educación en primaria, es muy cambiante conforme pasan los años, y los datos se encuentran más dispersos

Diagrama de dispersión para secundaria

data("tasa")
## Warning in data("tasa"): data set 'tasa' not found
#Se emplea el log del precio porque mejora la linealidad
ggplot(data = tasa, aes(x = periodo, y = secundaria)) + 
  geom_point(colour = "red4") +
  ggtitle("Diagrama de dispersión") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))

Hablando de secundaria, los datos están un poco más uniformes, y van aumentando conforme pasan los años

Regresión lineal simple

Para preescolar

modelo_lineal <- lm(periodo ~ preescolar, tasa)
summary(modelo_lineal)
## 
## Call:
## lm(formula = periodo ~ preescolar, data = tasa)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.6066 -0.8491 -0.1697  1.6563  3.3913 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 1966.4766     1.8841 1043.75   <2e-16 ***
## preescolar     0.6408     0.0319   20.09   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.063 on 26 degrees of freedom
## Multiple R-squared:  0.9395, Adjusted R-squared:  0.9371 
## F-statistic: 403.4 on 1 and 26 DF,  p-value: < 2.2e-16
ggplot(data = tasa, mapping = aes(x = periodo, y = preescolar)) +
  geom_point(color = "firebrick", size = 2) +
  labs(title  =  'Periodo ~  Preescolar', x  =  'Periodo') +
  geom_smooth(method = "lm", se = FALSE, color = "black") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))
## `geom_smooth()` using formula 'y ~ x'

Para primaria

modelo_lineal <- lm(periodo ~ primaria, tasa)
summary(modelo_lineal)
## 
## Call:
## lm(formula = periodo ~ primaria, data = tasa)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -9.5512 -6.1197 -0.6804  6.5138 14.1202 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 1622.952    156.811  10.350 1.03e-10 ***
## primaria       3.854      1.588   2.427   0.0225 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.569 on 26 degrees of freedom
## Multiple R-squared:  0.1847, Adjusted R-squared:  0.1533 
## F-statistic:  5.89 on 1 and 26 DF,  p-value: 0.02246
ggplot(data = tasa, mapping = aes(x = periodo, y = primaria)) +
  geom_point(color = "firebrick", size = 2) +
  labs(title  =  'Periodo ~  Primaria', x  =  'Periodo') +
  geom_smooth(method = "lm", se = FALSE, color = "black") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))
## `geom_smooth()` using formula 'y ~ x'

Para secundaria

modelo_lineal <- lm(periodo ~ secundaria, tasa)
summary(modelo_lineal)
## 
## Call:
## lm(formula = periodo ~ secundaria, data = tasa)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -2.586 -1.415  0.039  1.036  4.669 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 1.958e+03  1.899e+00 1031.21   <2e-16 ***
## secundaria  6.422e-01  2.647e-02   24.26   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.724 on 26 degrees of freedom
## Multiple R-squared:  0.9577, Adjusted R-squared:  0.9561 
## F-statistic: 588.7 on 1 and 26 DF,  p-value: < 2.2e-16
ggplot(data = tasa, mapping = aes(x = periodo, y = secundaria)) +
  geom_point(color = "firebrick", size = 2) +
  labs(title  =  'Periodo ~  Secundaria', x  =  'Periodo') +
  geom_smooth(method = "lm", se = FALSE, color = "black") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5))
## `geom_smooth()` using formula 'y ~ x'

Análisis de normalidad

par(mfrow = c(1, 2))
hist(tasa$preescolar, breaks = 10, main = "", xlab = "Preescolar", border = "darkred")
hist(tasa$primaria, breaks = 10, main = "", xlab = "Primaria",
     border = "blue")

qqnorm(tasa$preescolar, main = "Preescolar", col = "darkred")
qqline(tasa$preescolar)

qqnorm(tasa$primaria, main = "Primaria", col = "darkred")
qqline(tasa$primaria)

qqnorm(tasa$secundaria, main = "Secundaria", col = "darkred")
qqline(tasa$secundaria)

Comprobación de hipótesis

shapiro.test(tasa$preescolar)
## 
##  Shapiro-Wilk normality test
## 
## data:  tasa$preescolar
## W = 0.85964, p-value = 0.001472
shapiro.test(tasa$primaria)
## 
##  Shapiro-Wilk normality test
## 
## data:  tasa$primaria
## W = 0.9491, p-value = 0.1881
shapiro.test(tasa$secundaria)
## 
##  Shapiro-Wilk normality test
## 
## data:  tasa$secundaria
## W = 0.92022, p-value = 0.03513

  • En base a las gráficas y las pruebas realizadas, nos podemos dar cuenta que a nivel primaria, los datos se encuentran más dispersos al pasar los años, en cambio, en secundaria, conforme pasan los años, la tasa aumenta. Esto se puede deber a que muchos niños de primaria no logran entrar a la escuela, o tuvieron que abandonarla debido a COVID-19.

  • Se necesita realizar un estudio más profundo para determinar si esto es correcto o no.