Base de datos

Se procede a importar base de datos

library(readxl)
GPA_Mexico <- read_excel("C:/Users/hogar/Downloads/GPA_Mexico.xlsx")
View(GPA_Mexico)
names(GPA_Mexico)
##  [1] "Prom_Licenciatura"        "Edad"                    
##  [3] "Genero"                   "Tiempo_Traslado"         
##  [5] "Prom_Prepa"               "Actividades_Extras"      
##  [7] "Horas_Menos_19"           "Horas_Mas_20"            
##  [9] "Llega_Coche"              "Llega_Bicicleta"         
## [11] "Llega_Caminando"          "Llega_Transporte_Publico"
## [13] "Tiene_PC"                 "Tiene_Novia"             
## [15] "Horas_Perdidas"           "Consume_Alcohol"         
## [17] "Padre_Licenciatura"       "Madre_Licenciatura"

Promedio de licenciatura

m_bach<-mean(GPA_Mexico$Prom_Licenciatura)
m_bach
## [1] 7.97712
sd_bach<-sd(GPA_Mexico$Prom_Licenciatura)
sd_bach
## [1] 1.18345
max_bach<-max(GPA_Mexico$Prom_Licenciatura)
min_bach<-min(GPA_Mexico$Prom_Licenciatura)
max_bach
## [1] 9.99
min_bach
## [1] 6
par(mar = c(5, 4, 4, 2))  # Márgenes más pequeños
GPA_grouped <-cut(GPA_Mexico$Prom_Licenciatura,breaks=seq(min(GPA_Mexico$Prom_Licenciatura),max(GPA_Mexico$Prom_Licenciatura), by = 0.5), include.lowest = TRUE)
barplot(table(GPA_grouped), las = 2, cex.names = 0.8,  col = "skyblue", main = "Promedios de Licenciatura")

#Desviación estandar
sd_prom<-sd(GPA_Mexico$Prom_Licenciatura)
sd_prom
## [1] 1.18345

Los estudiantes de esta universidad reportan una media muestral de 7.977, con una desviación estandar de 1.18345, así como un valor máximo de 9.99 y un valor mínimo de 6.00. Por último podemos observar en la gráfica que la moda se encuentra entre 6 y 6.5.

EDAD

m_bach<-mean(GPA_Mexico$Edad)
m_bach
## [1] 24.066
sd_bach<-sd(GPA_Mexico$Edad)
sd_bach
## [1] 3.687389
max_bach<-max(GPA_Mexico$Edad)
min_bach<-min(GPA_Mexico$Edad)
max_bach
## [1] 30
min_bach
## [1] 18
par(mar = c(5, 4, 4, 2))  # Márgenes más pequeños
GPA_grouped <-cut(GPA_Mexico$Edad,breaks=seq(min(GPA_Mexico$Edad),max(GPA_Mexico$Edad), by = 0.5), include.lowest = TRUE)
barplot(table(GPA_grouped), las = 2, cex.names = 0.8,  col = "skyblue", main = "Promedios de Edad")

#Desviación estandar
sd_prom<-sd(GPA_Mexico$Edad)
sd_prom
## [1] 3.687389

Los estudiantes de esta universidad reportan una media muestral de 24.066, con una desviacion estandar de 3.6873890052, con un valor maximo de 30 y un valor minimo de 18. Como se observa en la grafica la moda se situa en 28.5-29 años años.

GENERO

table(GPA_Mexico$Genero)
## 
##   0   1 
## 243 257
tabla_1<-round(table(GPA_Mexico$Genero)/length(GPA_Mexico$Genero)*100,2)
knitr::kable(tabla_1)
Var1 Freq
0 48.6
1 51.4 
barplot(tabla_1)

Tiempo Traslado

m_bach<-mean(GPA_Mexico$Tiempo_Traslado)
m_bach
## [1] 82.802
sd_bach<-sd(GPA_Mexico$Tiempo_Traslado)
sd_bach
## [1] 56.54277
max_bach<-max(GPA_Mexico$Tiempo_Traslado)
min_bach<-min(GPA_Mexico$Tiempo_Traslado)
max_bach
## [1] 236
min_bach
## [1] 15
par(mar = c(5, 4, 4, 2))  # Márgenes más pequeños
GPA_grouped <-cut(GPA_Mexico$Tiempo_Traslado,breaks=seq(min(GPA_Mexico$Tiempo_Traslado),max(GPA_Mexico$Tiempo_Traslado), by = 0.5), include.lowest = TRUE)
barplot(table(GPA_grouped), las = 2, cex.names = 0.8,  col = "skyblue", main = "Promedios de Tiempo de traslado")

#Desviación estandar
sd_prom<-sd(GPA_Mexico$Tiempo_Traslado)
sd_prom
## [1] 56.54277

Los estudiantes de esta universidad reportan una media muestral de 82.802, con una desviacion estandar de 56.54277, con un valor maximo de 236 minnutos y un valor minimo de 15 minutos. Como se observa en la grafica la moda se situa entre 37 y 37.5

Actividades_Extras

m_bach<-mean(GPA_Mexico$Actividades_Extras,na.rm=TRUE)
m_bach
## [1] 5.162
sd_bach<-sd(GPA_Mexico$Actividades_Extras)
sd_bach
## [1] 3.190629
max_bach<-max(GPA_Mexico$Actividades_Extras)
min_bach<-min(GPA_Mexico$Actividades_Extras)
max_bach
## [1] 10
min_bach
## [1] 0
par(mar = c(5, 4, 4, 2))  # Márgenes más pequeños
GPA_grouped <-cut(GPA_Mexico$Actividades_Extras,breaks=seq(min(GPA_Mexico$Actividades_Extras),max(GPA_Mexico$Actividades_Extras), by = 0.5), include.lowest = TRUE)
barplot(table(GPA_grouped), las = 2, cex.names = 0.8,  col = "skyblue", main = "Actividades extras")

#Desviación estandar
sd_prom<-sd(GPA_Mexico$Actividades_Extras)
sd_prom
## [1] 3.190629

Los estudiantes de esta universidad reportan una media muestral de 5.162, con una desviacion estandar de 3.190629441, con un valor maximo de 10 y un valor minimo de 0. Como se observa en la grafica la moda se situa entre 0 y 0.5.

Horas_Menos_19

m_bach<-mean(GPA_Mexico$Horas_Menos_19,na.rm=TRUE)
m_bach
## [1] 3.41
sd_bach<-sd(GPA_Mexico$Horas_Menos_19)
sd_bach
## [1] 6.193757
max_bach<-max(GPA_Mexico$Horas_Menos_19)
min_bach<-min(GPA_Mexico$Horas_Menos_19)
max_bach
## [1] 19
min_bach
## [1] 0
par(mar = c(5, 4, 4, 2))  # Márgenes más pequeños
GPA_grouped <-cut(GPA_Mexico$Horas_Menos_19,breaks=seq(min(GPA_Mexico$Horas_Menos_19),max(GPA_Mexico$Horas_Menos_19), by = 0.5), include.lowest = TRUE)
barplot(table(GPA_grouped), las = 2, cex.names = 0.8,  col = "skyblue", main = "Horas menos de 19")

#Desviación estandar
sd_prom<-sd(GPA_Mexico$Horas_Menos_19)
sd_prom
## [1] 6.193757

Los estudiantes de esta universidad reportan una media muestral de 3.41, con una desviacion estandar de 6.1937569576, con un valor maximo de 19 y un valor minimo de 0. Como se observa en la grafica la moda se situa entre 0 y 2.

Horas_Mas_20

m_bach<-mean(GPA_Mexico$Horas_Mas_20,na.rm=TRUE)
m_bach
## [1] 6.358
sd_bach<-sd(GPA_Mexico$Horas_Mas_20)
sd_bach
## [1] 12.65013
max_bach<-max(GPA_Mexico$Horas_Mas_20)
min_bach<-min(GPA_Mexico$Horas_Mas_20)
max_bach
## [1] 40
min_bach
## [1] 0
par(mar = c(5, 4, 4, 2))  # Márgenes más pequeños
GPA_grouped <-cut(GPA_Mexico$Horas_Mas_20,breaks=seq(min(GPA_Mexico$Horas_Mas_20),max(GPA_Mexico$Horas_Mas_20), by = 0.5), include.lowest = TRUE)
barplot(table(GPA_grouped), las = 2, cex.names = 0.8,  col = "skyblue", main = "Horas mas de 20")

#Desviación estandar
sd_prom<-sd(GPA_Mexico$Horas_Mas_20)
sd_prom
## [1] 12.65013

Los estudiantes de esta universidad reportan una media muestral de 6.358, con una desviacion estandar de 12.6501339034633, con un valor maximo de 40 y un valor minimo de 0. Como se observa en la grafica la moda se situa entre 0 y 5.

Llega en coche

table(GPA_Mexico$Llega_Coche)
## 
##   0   1 
## 397 103
tabla_2<-round(table(GPA_Mexico$Llega_Coche)/length(GPA_Mexico$Llega_Coche)*100,2)
knitr::kable(tabla_2)
Var1 Freq
0 79.4
1 20.6 
barplot(tabla_2)

Llega en bicicleta

table(GPA_Mexico$Llega_Bicicleta)
## 
##   0   1 
## 464  36
tabla_3<-round(table(GPA_Mexico$Llega_Bicicleta)/length(GPA_Mexico$Llega_Bicicleta)*100,2)
knitr::kable(tabla_3)
Var1 Freq
0 92.8
1 7.2 
barplot(tabla_3)

Llega en camion

table(GPA_Mexico$Llega_Caminando)
## 
##   0   1 
## 368 132
tabla_4<-round(table(GPA_Mexico$Llega_Caminando)/length(GPA_Mexico$Llega_Caminando)*100,2)
knitr::kable(tabla_4)
Var1 Freq
0 73.6
1 26.4 
barplot(tabla_4)

Llega en transporte publico

table(GPA_Mexico$Llega_Transporte_Publico)
## 
##   0   1 
## 271 229
tabla_5<-round(table(GPA_Mexico$Llega_Transporte_Publico)/length(GPA_Mexico$Llega_Transporte_Publico)*100,2)
knitr::kable(tabla_5)
Var1 Freq
0 54.2
1 45.8 
barplot(tabla_5)

Tiene PC

table(GPA_Mexico$Tiene_PC)
## 
##   0   1 
##  76 424
tabla_6<-round(table(GPA_Mexico$Tiene_PC)/length(GPA_Mexico$Tiene_PC)*100,2)
knitr::kable(tabla_6)
Var1 Freq
0 15.2
1 84.8 
barplot(tabla_6)

Tiene Novia

table(GPA_Mexico$Tiene_Novia)
## 
##   0   1 
## 310 190
tabla_7<-round(table(GPA_Mexico$Tiene_Novia)/length(GPA_Mexico$Tiene_Novia)*100,2)
knitr::kable(tabla_7)
Var1 Freq
0 62
1 38 
barplot(tabla_7)

Horas perdidas

m_bach<-mean(GPA_Mexico$Horas_Perdidas,na.rm=TRUE)
m_bach
## [1] 3.884
sd_bach<-sd(GPA_Mexico$Horas_Perdidas)
sd_bach
## [1] 1.973406
max_bach<-max(GPA_Mexico$Horas_Perdidas)
min_bach<-min(GPA_Mexico$Horas_Perdidas)
max_bach
## [1] 12
min_bach
## [1] 0
par(mar = c(5, 4, 4, 2))  # Márgenes más pequeños
GPA_grouped <-cut(GPA_Mexico$Horas_Perdidas,breaks=seq(min(GPA_Mexico$Horas_Perdidas),max(GPA_Mexico$Horas_Perdidas), by = 0.5), include.lowest = TRUE)
barplot(table(GPA_grouped), las = 2, cex.names = 0.8,  col = "skyblue", main = "Horas perdidas")

#Desviación estandar
sd_prom<-sd(GPA_Mexico$Horas_perdidas)
## Warning: Unknown or uninitialised column: `Horas_perdidas`.
sd_prom
## [1] NA

Consume alcohol

table(GPA_Mexico$Consume_Alcohol)
## 
##   0   1 
## 235 265
tabla_8<-round(table(GPA_Mexico$Consume_Alcohol)/length(GPA_Mexico$Consume_Alcohol)*100,2)
knitr::kable(tabla_8)
Var1 Freq
0 47
1 53 
barplot(tabla_8)

Padre licenciatura

table(GPA_Mexico$Padre_Licenciatura)
## 
##   0   1 
## 348 152
tabla_9<-round(table(GPA_Mexico$Padre_Licenciatura)/length(GPA_Mexico$Padre_Licenciatura)*100,2)
knitr::kable(tabla_9)
Var1 Freq
0 69.6
1 30.4 
barplot(tabla_9)

Madre licenciatura

table(GPA_Mexico$Madre_Licenciatura)
## 
##   0   1 
## 310 190
tabla_10<-round(table(GPA_Mexico$Madre_Licenciatura)/length(GPA_Mexico$Madre_Licenciatura)*100,2)
knitr::kable(tabla_10)
Var1 Freq
0 62
1 38 
barplot(tabla_10)

Al importar los datos, procedemos a observar el resumen descriptivo de todas las variables.

summary(GPA_Mexico) 
##  Prom_Licenciatura      Edad           Genero      Tiempo_Traslado
##  Min.   :6.000     Min.   :18.00   Min.   :0.000   Min.   : 15.0  
##  1st Qu.:6.920     1st Qu.:21.00   1st Qu.:0.000   1st Qu.: 36.0  
##  Median :7.970     Median :24.00   Median :1.000   Median : 65.0  
##  Mean   :7.977     Mean   :24.07   Mean   :0.514   Mean   : 82.8  
##  3rd Qu.:8.992     3rd Qu.:27.00   3rd Qu.:1.000   3rd Qu.:127.0  
##  Max.   :9.990     Max.   :30.00   Max.   :1.000   Max.   :236.0  
##    Prom_Prepa    Actividades_Extras Horas_Menos_19   Horas_Mas_20   
##  Min.   :6.010   Min.   : 0.000     Min.   : 0.00   Min.   : 0.000  
##  1st Qu.:7.110   1st Qu.: 3.000     1st Qu.: 0.00   1st Qu.: 0.000  
##  Median :8.020   Median : 5.000     Median : 0.00   Median : 0.000  
##  Mean   :8.063   Mean   : 5.162     Mean   : 3.41   Mean   : 6.358  
##  3rd Qu.:9.092   3rd Qu.: 8.000     3rd Qu.: 0.00   3rd Qu.: 0.000  
##  Max.   :9.990   Max.   :10.000     Max.   :19.00   Max.   :40.000  
##   Llega_Coche    Llega_Bicicleta Llega_Caminando Llega_Transporte_Publico
##  Min.   :0.000   Min.   :0.000   Min.   :0.000   Min.   :0.000           
##  1st Qu.:0.000   1st Qu.:0.000   1st Qu.:0.000   1st Qu.:0.000           
##  Median :0.000   Median :0.000   Median :0.000   Median :0.000           
##  Mean   :0.206   Mean   :0.072   Mean   :0.264   Mean   :0.458           
##  3rd Qu.:0.000   3rd Qu.:0.000   3rd Qu.:1.000   3rd Qu.:1.000           
##  Max.   :1.000   Max.   :1.000   Max.   :1.000   Max.   :1.000           
##     Tiene_PC      Tiene_Novia   Horas_Perdidas   Consume_Alcohol
##  Min.   :0.000   Min.   :0.00   Min.   : 0.000   Min.   :0.00   
##  1st Qu.:1.000   1st Qu.:0.00   1st Qu.: 2.000   1st Qu.:0.00   
##  Median :1.000   Median :0.00   Median : 4.000   Median :1.00   
##  Mean   :0.848   Mean   :0.38   Mean   : 3.884   Mean   :0.53   
##  3rd Qu.:1.000   3rd Qu.:1.00   3rd Qu.: 5.000   3rd Qu.:1.00   
##  Max.   :1.000   Max.   :1.00   Max.   :12.000   Max.   :1.00   
##  Padre_Licenciatura Madre_Licenciatura
##  Min.   :0.000      Min.   :0.00      
##  1st Qu.:0.000      1st Qu.:0.00      
##  Median :0.000      Median :0.00      
##  Mean   :0.304      Mean   :0.38      
##  3rd Qu.:1.000      3rd Qu.:1.00      
##  Max.   :1.000      Max.   :1.00

Esta función proporciona estadísticas como el mínimo, el primer cuartil, la mediana, la media, el tercer cuartil y el máximo para cada variable numérica.

Modelo de regresión

\[PU=\hat{beta}_1+\hat{\beta}_2Edad+\hat{\beta}_3Genero+\hat{\beta}_4Tiempo_Traslado+\hat{\beta}_5Prom_Prepa+\hat{\beta}_6Actividades_Extras+\hat{\beta}_7Horas_Menos_19+\hat{\beta}_8Horas_Mas_20+\hat{\beta}_9Llega_Coche+\hat{\beta}_10Llega_Bicicleta+\hat{\beta}_11Llega_Caminando+\hat{\beta}_12Llega_Transporte_Publico+\hat{\beta}_13Tiene_PC+\hat{\beta}_14Tiene_Novia+\hat{\beta}_15Horas_Perdidas+\hat{\beta}_16Consume_Alcohol+\hat{\beta}_17Padre_Licenciatura+\hat{\beta}_18Madre_Licenciatura\] El modelo plantea verificar que variables son las que impactan en la calificaión de un estudiante universitario. # Modelo 1

lm_1<-lm(Prom_Licenciatura~Edad+Genero+Tiempo_Traslado+Prom_Prepa+Actividades_Extras+Horas_Menos_19+Horas_Mas_20+Llega_Coche+Llega_Bicicleta+Llega_Caminando+Llega_Transporte_Publico+Tiene_PC+Tiene_Novia+Horas_Perdidas+Consume_Alcohol+Padre_Licenciatura+Madre_Licenciatura,data=GPA_Mexico)
modelo_1<-summary(lm_1)
modelo_1
## 
## Call:
## lm(formula = Prom_Licenciatura ~ Edad + Genero + Tiempo_Traslado + 
##     Prom_Prepa + Actividades_Extras + Horas_Menos_19 + Horas_Mas_20 + 
##     Llega_Coche + Llega_Bicicleta + Llega_Caminando + Llega_Transporte_Publico + 
##     Tiene_PC + Tiene_Novia + Horas_Perdidas + Consume_Alcohol + 
##     Padre_Licenciatura + Madre_Licenciatura, data = GPA_Mexico)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.73506 -1.06518  0.02973  0.99168  2.21232 
## 
## Coefficients: (1 not defined because of singularities)
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)               7.253672   0.547327  13.253   <2e-16 ***
## Edad                      0.008367   0.014567   0.574   0.5659    
## Genero                   -0.070840   0.107747  -0.657   0.5112    
## Tiempo_Traslado           0.001862   0.001261   1.477   0.1404    
## Prom_Prepa                0.061468   0.045596   1.348   0.1783    
## Actividades_Extras        0.001793   0.016735   0.107   0.9147    
## Horas_Menos_19           -0.004716   0.008948  -0.527   0.5984    
## Horas_Mas_20             -0.007199   0.004395  -1.638   0.1021    
## Llega_Coche              -0.149146   0.144439  -1.033   0.3023    
## Llega_Bicicleta           0.165042   0.228035   0.724   0.4696    
## Llega_Caminando           0.216805   0.157464   1.377   0.1692    
## Llega_Transporte_Publico        NA         NA      NA       NA    
## Tiene_PC                 -0.272879   0.148890  -1.833   0.0675 .  
## Tiene_Novia              -0.170048   0.109456  -1.554   0.1209    
## Horas_Perdidas            0.003819   0.026984   0.142   0.8875    
## Consume_Alcohol           0.155111   0.106194   1.461   0.1448    
## Padre_Licenciatura        0.186831   0.115417   1.619   0.1062    
## Madre_Licenciatura        0.171333   0.109854   1.560   0.1195    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.176 on 483 degrees of freedom
## Multiple R-squared:  0.04447,    Adjusted R-squared:  0.01281 
## F-statistic: 1.405 on 16 and 483 DF,  p-value: 0.1342

Podemos observar que muy pocas variables no son significativas

Pruebas de hipotesis

Demostrar que los errores suman cero

mean(modelo_1$residuals)
## [1] 8.35429e-17

Prueba de no autocorrelación de los errores (Durbi-Watson)

##H0:Los errores no están autocorrelacionados

##HA:Los errores están autocorrelacionados
library(lmtest)
## Cargando paquete requerido: zoo
## 
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
lm_1dw<-dwtest(lm_1)
lm_1dw
## 
##  Durbin-Watson test
## 
## data:  lm_1
## DW = 2.0431, p-value = 0.7609
## alternative hypothesis: true autocorrelation is greater than 0

A partir de la prueba podemos decir que como el valor p=0.7609, no existe suficiente evidencia para rechazar la hipotesis de no autocorrelación

Prueba de homocedaticidad (Breusch-Pagan)

##H0:Los errores son homocedásticos

##HA:Los errores son no homocedásticos
lm_1bp<-bptest(lm_1)
lm_1bp
## 
##  studentized Breusch-Pagan test
## 
## data:  lm_1
## BP = 15.876, df = 16, p-value = 0.4616

Como el valor de p=0.4616, no existe suficiente evidencia para rechazar la hipótesis de homocedasticidad.

Prueba de Normalidad(Jarque-Bera)

##H0:Los errores se distribuyen de forma normal

##HA:Los errores no se distribuyen de forma normal
library(tseries)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
lm_1jb<-jarque.bera.test(modelo_1$residuals)
lm_1jb$p.value
## [1] 7.483868e-07

Como el valor de p=0.000000748, existe suficiente evidencia para rechazar la hipotesis nula.

Modelo 2

lm_2<-lm(Prom_Licenciatura~Tiempo_Traslado+Prom_Prepa+Horas_Mas_20+Llega_Coche+Llega_Caminando+Tiene_PC+Tiene_Novia+Consume_Alcohol+Padre_Licenciatura+Madre_Licenciatura,data=GPA_Mexico)
modelo_2<-summary(lm_2)
modelo_2
## 
## Call:
## lm(formula = Prom_Licenciatura ~ Tiempo_Traslado + Prom_Prepa + 
##     Horas_Mas_20 + Llega_Coche + Llega_Caminando + Tiene_PC + 
##     Tiene_Novia + Consume_Alcohol + Padre_Licenciatura + Madre_Licenciatura, 
##     data = GPA_Mexico)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.66138 -1.05898  0.01119  0.98851  2.22914 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         7.469621   0.407268  18.341   <2e-16 ***
## Tiempo_Traslado     0.001494   0.001170   1.276   0.2024    
## Prom_Prepa          0.062484   0.045297   1.379   0.1684    
## Horas_Mas_20       -0.006641   0.004171  -1.592   0.1120    
## Llega_Coche        -0.164439   0.142108  -1.157   0.2478    
## Llega_Caminando     0.172937   0.144807   1.194   0.2330    
## Tiene_PC           -0.278014   0.147208  -1.889   0.0595 .  
## Tiene_Novia        -0.162941   0.108223  -1.506   0.1328    
## Consume_Alcohol     0.158025   0.105164   1.503   0.1336    
## Padre_Licenciatura  0.200532   0.114180   1.756   0.0797 .  
## Madre_Licenciatura  0.166878   0.108583   1.537   0.1250    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.171 on 489 degrees of freedom
## Multiple R-squared:  0.04121,    Adjusted R-squared:  0.02161 
## F-statistic: 2.102 on 10 and 489 DF,  p-value: 0.02292
dwtest(lm_2)
## 
##  Durbin-Watson test
## 
## data:  lm_2
## DW = 2.0428, p-value = 0.6879
## alternative hypothesis: true autocorrelation is greater than 0
bptest(lm_2)
## 
##  studentized Breusch-Pagan test
## 
## data:  lm_2
## BP = 9.263, df = 10, p-value = 0.5073
jarque.bera.test(modelo_2$residuals)
## 
##  Jarque Bera Test
## 
## data:  modelo_2$residuals
## X-squared = 28.307, df = 2, p-value = 7.133e-07

Modelo 3

lm_3<-lm(Prom_Licenciatura~Tiene_PC+Padre_Licenciatura,data=GPA_Mexico)
modelo_3<-summary(lm_3)
modelo_3
## 
## Call:
## lm(formula = Prom_Licenciatura ~ Tiene_PC + Padre_Licenciatura, 
##     data = GPA_Mexico)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.28076 -1.06161  0.00931  1.03703  2.08089 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          8.1376     0.1396  58.294   <2e-16 ***
## Tiene_PC            -0.2585     0.1468  -1.760   0.0790 .  
## Padre_Licenciatura   0.1932     0.1146   1.685   0.0925 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.179 on 497 degrees of freedom
## Multiple R-squared:  0.01179,    Adjusted R-squared:  0.007818 
## F-statistic: 2.966 on 2 and 497 DF,  p-value: 0.05243
dwtest(lm_3)
## 
##  Durbin-Watson test
## 
## data:  lm_3
## DW = 2.0589, p-value = 0.7467
## alternative hypothesis: true autocorrelation is greater than 0
bptest(lm_3)
## 
##  studentized Breusch-Pagan test
## 
## data:  lm_3
## BP = 1.813, df = 2, p-value = 0.4039

Al inicio, se construye un modelo que incluye todas las variables disponibles. Esto permite obtener un panorama general sobre cómo cada variable influye en el promedio de licenciatura. Sin embargo, no todas las variables son igualmente relevantes:

Se identifican las variables que no tienen significancia estadística (valores p altos). Esto indica que pueden no contribuir significativamente al modelo.

Con base en los resultados del modelo inicial, se decide eliminar variables que no son significativas. El nuevo modelo se centra en variables que se consideran más relevantes para el promedio de licenciatura.

Al final, este enfoque sistemático ayuda a construir un modelo más robusto y confiable para predecir el promedio de licenciatura, con variables que tienen un impacto estadísticamente significativo.

Interpretación del R cuadrado ajustado

r2_ajustado <- modelo_3$adj.r.squared
cat("El R cuadrado ajustado es:", r2_ajustado, "\n")
## El R cuadrado ajustado es: 0.007817787
cat("Esto indica que aproximadamente", round(r2_ajustado * 100, 2), 
    "% de la variabilidad en la calificación de los estudiantes es explicada por el modelo.\n")
## Esto indica que aproximadamente 0.78 % de la variabilidad en la calificación de los estudiantes es explicada por el modelo.

Pronósticos (mínimo, máximo y promedio)

pronosticos <- predict(lm_3)
min_pronostico <- min(pronosticos)
max_pronostico <- max(pronosticos)
mean_pronostico <- mean(pronosticos)

cat("Pronósticos:\n")
## Pronósticos:
cat("Mínimo pronóstico:", min_pronostico, "\n")
## Mínimo pronóstico: 7.87911
cat("Máximo pronóstico:", max_pronostico, "\n")
## Máximo pronóstico: 8.330755
cat("Promedio de pronósticos:", mean_pronostico, "\n")
## Promedio de pronósticos: 7.97712

Intervalo de confianza para las betas

conf_interval_betas <- confint(lm_3)
cat("Intervalos de confianza para las betas:\n")
## Intervalos de confianza para las betas:
print(conf_interval_betas)
##                          2.5 %     97.5 %
## (Intercept)         7.86332413 8.41186931
## Tiene_PC           -0.54698847 0.03001453
## Padre_Licenciatura -0.03201955 0.41833690

Intervalo de confianza pronóstico

#ronosticar el promedio de licenciatura utilizando el modelo

# Crear un dataframe con los valores de un estudiante promedio
new_data <- data.frame(
  Tiene_PC = 1,                    # Tiene PC
  Padre_Licenciatura = 1            # Padre con licenciatura
)

# Pronosticar el promedio de licenciatura utilizando el modelo lm_3
prediccion <- predict(lm_3, newdata = new_data, interval = "prediction")
prediccion_media <- predict(lm_3, newdata = new_data, interval = "confidence")

# Mostrar los resultados
prediccion
##        fit      lwr      upr
## 1 8.072268 5.748178 10.39636
prediccion_media
##        fit      lwr      upr
## 1 8.072268 7.879404 8.265132

Intervalo de confianza del pronóstico

predicciones <- predict(lm_3, newdata = new_data, interval = "prediction")
cat("Intervalo de confianza del pronóstico:\n")
## Intervalo de confianza del pronóstico:
print(predicciones)
##        fit      lwr      upr
## 1 8.072268 5.748178 10.39636

Intervalo de confianza de las medias

intervalo_media <- predict(lm_3, newdata = new_data, interval = "confidence")
cat("Intervalo de confianza de la media:\n")
## Intervalo de confianza de la media:
print(intervalo_media)
##        fit      lwr      upr
## 1 8.072268 7.879404 8.265132