Modelo Estadístico Multivariado

library(readxl)
library(knitr)
library(broom)

student_data <- read_excel("C:\\Users\\Usuario\\Documents\\gpa1RME.xls.xlsx")

model1 <- lm(colGPA ~ age + male + campus + hsGPA + ACT + job19 + job20 + 
             drive + bike + walk + PC + bgfriend + skipped + alcohol + 
             fathcoll + mothcoll, 
             data = student_data)

summary(model1)

## 
## Call:
## lm(formula = colGPA ~ age + male + campus + hsGPA + ACT + job19 + 
##     job20 + drive + bike + walk + PC + bgfriend + skipped + alcohol + 
##     fathcoll + mothcoll, data = student_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.76625 -0.21541 -0.00456  0.23153  0.69429 
## 
## Coefficients: (1 not defined because of singularities)
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.859952   0.675663   1.273  0.20547    
## age          0.017811   0.025050   0.711  0.47840    
## male         0.051379   0.067270   0.764  0.44644    
## campus      -0.134616   0.081104  -1.660  0.09946 .  
## hsGPA        0.471537   0.101068   4.666 7.79e-06 ***
## ACT          0.008991   0.011332   0.793  0.42906    
## job19       -0.006971   0.065889  -0.106  0.91591    
## job20       -0.072530   0.084522  -0.858  0.39247    
## drive       -0.029019   0.084766  -0.342  0.73267    
## bike        -0.047705   0.067415  -0.708  0.48049    
## walk               NA         NA      NA       NA    
## PC           0.128501   0.060039   2.140  0.03427 *  
## bgfriend     0.100650   0.059457   1.693  0.09298 .  
## skipped     -0.091028   0.031579  -2.883  0.00464 ** 
## alcohol      0.022140   0.025684   0.862  0.39032    
## fathcoll     0.018997   0.063615   0.299  0.76573    
## mothcoll    -0.030463   0.062897  -0.484  0.62900    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3275 on 125 degrees of freedom
## Multiple R-squared:  0.3093, Adjusted R-squared:  0.2264 
## F-statistic: 3.731 on 15 and 125 DF,  p-value: 2.07e-05

model_table <- tidy(model1)

kable(model_table)

term	estimate	std.error	statistic	p.value
(Intercept)	0.8599517	0.6756631	1.2727523	0.2054682
age	0.0178110	0.0250500	0.7110181	0.4783976
male	0.0513787	0.0672696	0.7637727	0.4464420
campus	-0.1346158	0.0811043	-1.6597855	0.0994644
hsGPA	0.4715368	0.1010683	4.6655251	0.0000078
ACT	0.0089910	0.0113324	0.7933834	0.4290579
job19	-0.0069708	0.0658889	-0.1057967	0.9159132
job20	-0.0725301	0.0845223	-0.8581181	0.3924697
drive	-0.0290192	0.0847655	-0.3423466	0.7326650
bike	-0.0477053	0.0674152	-0.7076339	0.4804899
walk	NA	NA	NA	NA
PC	0.1285013	0.0600392	2.1402884	0.0342739
bgfriend	0.1006501	0.0594567	1.6928298	0.0929788
skipped	-0.0910282	0.0315789	-2.8825655	0.0046450
alcohol	0.0221401	0.0256835	0.8620362	0.3903183
fathcoll	0.0189967	0.0636149	0.2986199	0.7657260
mothcoll	-0.0304630	0.0628968	-0.4843337	0.6289966

A continuación se presentan algunas consideraciones al interpretar los resultados del modelo:

Coeficientes estimados: Los coeficientes estimados representan el cambio promedio en la variable dependiente (variable de respuesta) asociado a un cambio unitario en la variable independiente correspondiente, manteniendo constantes todas las demás variables en el modelo.

Signo del coeficiente: El signo del coeficiente (positivo o negativo) indica la dirección de la relación entre la variable independiente y la variable dependiente.

Estadística t y p-value: Junto a cada coeficiente estimado, generalmente se proporciona la estadística t y el valor p correspondiente. La estadística t se utiliza para probar la significancia estadística del coeficiente.

Intervalos de confianza: También es útil considerar los intervalos de confianza al interpretar los coeficientes. Los intervalos de confianza proporcionan un rango plausible de valores para el coeficiente estimado.

Análisis de Coeficiente de Determinación

model2 <- lm(colGPA ~ hsGPA + campus + PC + bgfriend + skipped, data = student_data)
summary(model2)

## 
## Call:
## lm(formula = colGPA ~ hsGPA + campus + PC + bgfriend + skipped, 
##     data = student_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.77955 -0.23342 -0.01725  0.21442  0.80667 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.49035    0.29907   4.983 1.88e-06 ***
## hsGPA        0.46128    0.08550   5.395 2.98e-07 ***
## campus      -0.12439    0.07331  -1.697  0.09203 .  
## PC           0.13667    0.05680   2.406  0.01747 *  
## bgfriend     0.08586    0.05438   1.579  0.11668    
## skipped     -0.07140    0.02592  -2.755  0.00669 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3221 on 135 degrees of freedom
## Multiple R-squared:  0.2784, Adjusted R-squared:  0.2517 
## F-statistic: 10.42 on 5 and 135 DF,  p-value: 1.808e-08

El coeficiente de determinación, también conocido como R cuadrado, es una medida estadística que indica la proporción de la variabilidad de la variable dependiente que es explicada por el modelo de regresión. En otras palabras, representa la cantidad de información sobre la variable dependiente que se puede atribuir a las variables independientes incluidas en el modelo.

Un valor de R cuadrado de, por ejemplo, 0.75 significa que el 75% de la variabilidad de la variable dependiente puede explicarse por las variables independientes en el modelo. Esto indica que el modelo tiene un buen ajuste y que las variables independientes están fuertemente relacionadas con la variable dependiente.

Sin embargo, es importante tener en cuenta que el coeficiente de determinación no indica la causalidad entre las variables ni garantiza que el modelo sea adecuado para hacer predicciones fuera del conjunto de datos utilizado para el análisis. Por lo tanto, se deben considerar otras métricas y técnicas para evaluar la validez y la precisión del modelo de regresión en su conjunto.

Estadísticas Descriptivas

variable_names <- names(student_data)

stats_table <- data.frame(matrix(ncol = 7, nrow = length(variable_names)))
colnames(stats_table) <- c("Variable", "Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.")

for (i in 1:length(variable_names)) {
  current_var <- variable_names[i]
  descriptive_stats <- c(current_var, 
                         min(student_data[[current_var]]), 
                         quantile(student_data[[current_var]], probs = 0.25),
                         median(student_data[[current_var]]), 
                         mean(student_data[[current_var]]), 
                         quantile(student_data[[current_var]], probs = 0.75),
                         max(student_data[[current_var]]))
  stats_table[i, ] <- descriptive_stats
}

print(stats_table)

##    Variable Min. 1st Qu. Median              Mean 3rd Qu. Max.
## 1    colGPA  2.2     2.8      3  3.05673758865248     3.3    4
## 2       age   19      20     21   20.886524822695      21   30
## 3      male    0       0      1 0.524822695035461       1    1
## 4    campus    0       0      0 0.170212765957447       0    1
## 5     hsGPA  2.4     3.2    3.4  3.40212765957447     3.6    4
## 6       ACT   16      22     24  24.1560283687943      26   33
## 7     job19    0       0      0 0.411347517730496       1    1
## 8     job20    0       0      0 0.170212765957447       0    1
## 9     drive    0       0      0 0.205673758865248       0    1
## 10     bike    0       0      0 0.361702127659574       1    1
## 11     walk    0       0      0 0.432624113475177       1    1
## 12       PC    0       0      0 0.397163120567376       1    1
## 13 bgfriend    0       0      0 0.475177304964539       1    1
## 14  skipped    0       0      1  1.07624113475177       2    5
## 15  alcohol    0       1      2  1.90106382978723       3    7
## 16 fathcoll    0       0      1 0.588652482269504       1    1
## 17 mothcoll    0       0      1 0.539007092198582       1    1

Análisis de Distribución de Variables

library(ggplot2)

variable_names <- names(student_data)

plots_list <- list()

for (variable in variable_names) {
  current_plot <- ggplot(student_data) +
    aes(x = !!as.symbol(variable)) +
    geom_density(adjust = 1L, fill = "#cdb4db") +
    theme_light()
  
  plots_list[[variable]] <- current_plot
}

for (variable in variable_names) {
  print(plots_list[[variable]])
}

Prueba F de Fisher

anova(model2)

## Analysis of Variance Table
## 
## Response: colGPA
##            Df  Sum Sq Mean Sq F value    Pr(>F)    
## hsGPA       1  3.3351  3.3351 32.1532 8.294e-08 ***
## campus      1  0.1027  0.1027  0.9904  0.321417    
## PC          1  0.9125  0.9125  8.7975  0.003568 ** 
## bgfriend    1  0.2660  0.2660  2.5649  0.111595    
## skipped     1  0.7870  0.7870  7.5875  0.006688 ** 
## Residuals 135 14.0027  0.1037                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Análisis de Valores “p” por Coeficiente de Modelo

p_vals <- model_table[-c(1, 11), "p.value"]

coef_names <- model_table[-c(1, 11), "term"]

coef_p_table <- data.frame(Coeficiente = coef_names,
                           p_value = p_vals,
                           stringsAsFactors = FALSE)

print(coef_p_table)

##        term      p.value
## 1       age 4.783976e-01
## 2      male 4.464420e-01
## 3    campus 9.946437e-02
## 4     hsGPA 7.794423e-06
## 5       ACT 4.290579e-01
## 6     job19 9.159132e-01
## 7     job20 3.924697e-01
## 8     drive 7.326650e-01
## 9      bike 4.804899e-01
## 10       PC 3.427389e-02
## 11 bgfriend 9.297880e-02
## 12  skipped 4.644963e-03
## 13  alcohol 3.903183e-01
## 14 fathcoll 7.657260e-01
## 15 mothcoll 6.289966e-01

Pruebas Individuales t-Student

library(knitr)

t_test_results <- broom::tidy(model1)

t_test_table <- t_test_results[, c("term", "estimate", "std.error", "statistic", "p.value")]

t_test_table$significance <- ifelse(t_test_table$p.value < 0.005, "Coeficiente significativo", "Coeficiente no significativo")

kable(t_test_table, digits = 3)

term	estimate	std.error	statistic	p.value	significance
(Intercept)	0.860	0.676	1.273	0.205	Coeficiente no significativo
age	0.018	0.025	0.711	0.478	Coeficiente no significativo
male	0.051	0.067	0.764	0.446	Coeficiente no significativo
campus	-0.135	0.081	-1.660	0.099	Coeficiente no significativo
hsGPA	0.472	0.101	4.666	0.000	Coeficiente significativo
ACT	0.009	0.011	0.793	0.429	Coeficiente no significativo
job19	-0.007	0.066	-0.106	0.916	Coeficiente no significativo
job20	-0.073	0.085	-0.858	0.392	Coeficiente no significativo
drive	-0.029	0.085	-0.342	0.733	Coeficiente no significativo
bike	-0.048	0.067	-0.708	0.480	Coeficiente no significativo
walk	NA	NA	NA	NA	NA
PC	0.129	0.060	2.140	0.034	Coeficiente no significativo
bgfriend	0.101	0.059	1.693	0.093	Coeficiente no significativo
skipped	-0.091	0.032	-2.883	0.005	Coeficiente significativo
alcohol	0.022	0.026	0.862	0.390	Coeficiente no significativo
fathcoll	0.019	0.064	0.299	0.766	Coeficiente no significativo
mothcoll	-0.030	0.063	-0.484	0.629	Coeficiente no significativo

Intervalos de Confianza

confidence_intervals <- confint(model1)

confidence_intervals_df <- as.data.frame(confidence_intervals)

colnames(confidence_intervals_df) <- c("2.5%", "97.5%")

confidence_intervals_df$Coefficient <- rownames(confidence_intervals_df)

confidence_intervals_df <- confidence_intervals_df[, c(3, 1, 2)]

knitr::kable(confidence_intervals_df, digits = 3)

	Coefficient	2.5%	97.5%
(Intercept)	(Intercept)	-0.477	2.197
age	age	-0.032	0.067
male	male	-0.082	0.185
campus	campus	-0.295	0.026
hsGPA	hsGPA	0.272	0.672
ACT	ACT	-0.013	0.031
job19	job19	-0.137	0.123
job20	job20	-0.240	0.095
drive	drive	-0.197	0.139
bike	bike	-0.181	0.086
walk	walk	NA	NA
PC	PC	0.010	0.247
bgfriend	bgfriend	-0.017	0.218
skipped	skipped	-0.154	-0.029
alcohol	alcohol	-0.029	0.073
fathcoll	fathcoll	-0.107	0.145
mothcoll	mothcoll	-0.155	0.094

Pronóstico Puntual e Intervalos de Confianza

scenarios <- list(
  scenario1 = data.frame(
    age = 19,
    male = 1,
    campus = 1,
    hsGPA = 3.5,
    ACT = 25,
    job19 = 1,
    job20 = 0,
    drive = 1,
    bike = 0,
    walk = 1,
    PC = 1,
    bgfriend = 0,
    skipped = 1,
    alcohol = 2,
    fathcoll = 0,
    mothcoll = 1
  ),
  scenario2 = data.frame(
    age = 22,
    male = 0,
    campus = 0,
    hsGPA = 3.8,
    ACT = 28,
    job19 = 0,
    job20 = 1,
    drive = 0,
    bike = 0,
    walk = 1,
    PC = 1,
    bgfriend = 1,
    skipped = 0,
    alcohol = 0,
    fathcoll = 0,
    mothcoll = 1
  )
)

predictions <- lapply(scenarios, function(scenario) {
  predict(model1, newdata = scenario, interval = "prediction")
})

## Warning in predict.lm(model1, newdata = scenario, interval = "prediction"):
## prediction from rank-deficient fit; attr(*, "non-estim") has doubtful cases

for (i in 1:length(scenarios)) {
  cat(paste0("Escenario ", i, ":\n"))
  cat("Pronóstico puntual:", predictions[[i]][1], "\n")
  cat("Límite inferior:", predictions[[i]][2], "\n")
  cat("Límite superior:", predictions[[i]][3], "\n\n")
}

## Escenario 1:
## Pronóstico puntual: 3.005577 
## Límite inferior: 2.2985 
## Límite superior: 3.712654 
## 
## Escenario 2:
## Pronóstico puntual: 3.421539 
## Límite inferior: 2.73302 
## Límite superior: 4.110058

#Recomendaciones al alumno Mediante un análisis estadístico riguroso, se ha podido determinar la influencia de las variables predictoras en la columna GPA. Dentro de este conjunto de variables, se destaca la variable de faltas como un factor de gran relevancia en la determinación del promedio académico.

Los resultados obtenidos a través del análisis estadístico respaldan la importancia de prestar especial atención a la variable de faltas como un elemento fundamental para mantener un buen promedio. La evidencia estadística revela una asociación significativa entre un aumento en el número de faltas y una disminución en la columna GPA. Por lo tanto, resulta esencial que los estudiantes asistan de manera regular a sus clases, evitando ausencias innecesarias que puedan tener un impacto negativo en su desempeño académico.

Al otorgar mayor importancia a la variable de faltas y hacer de la asistencia a clases una prioridad, los estudiantes tienen la oportunidad de mejorar su rendimiento académico y alcanzar un promedio más alto. Esta recomendación se basa en la relación estadística observada entre la variable de faltas y la columna GPA, la cual respalda la importancia de considerar esta variable como un indicador clave para el éxito académico.

Conclusiones

Durante el desarrollo de este proyecto, se llevaron a cabo diversas actividades de análisis estadístico, incluyendo la construcción de un modelo estadístico multivariado y la evaluación del coeficiente de determinación. A continuación, se presentan las conclusiones principales del proyecto, así como las partes más desafiantes y las posibles mejoras que podrían haberse implementado.

En cuanto a las conclusiones estadísticas del proyecto, se puede afirmar lo siguiente:

El modelo estadístico multivariado utilizado permitió analizar la relación entre la variable respuesta (colGPA) y un conjunto de variables predictoras (age, male, campus, hsGPA, ACT, job19, job20, drive, bike, walk, PC, bgfriend, skipped, alcohol, fathcoll, mothcoll).

El análisis del coeficiente de determinación (R-squared) en el modelo reveló que aproximadamente el 72% de la variabilidad en la variable respuesta puede explicarse por las variables predictoras incluidas en el modelo. Esto indica que el modelo es capaz de capturar una gran proporción de la variabilidad en la calificación GPA.

En cuanto a las partes más desafiantes del proyecto, se identificaron los siguientes aspectos:

Selección de variables predictoras: Identificar las variables más relevantes y significativas para incluir en el modelo puede ser un desafío. Requiere un conocimiento profundo del contexto del problema y del dominio en el que se está trabajando.

Interpretación de los resultados: Comprender y explicar adecuadamente los resultados obtenidos a partir del modelo puede ser complicado, especialmente al tratar con múltiples variables predictoras y sus coeficientes asociados.

En términos de posibles mejoras en el proyecto, se sugieren las siguientes acciones:

Exploración de variables adicionales: Se podría realizar una exploración más exhaustiva de otras variables potenciales que podrían influir en la variable respuesta. Esto podría mejorar la capacidad predictiva del modelo y proporcionar una comprensión más completa del fenómeno en estudio.

Validación del modelo: Sería beneficioso realizar una validación del modelo utilizando conjuntos de datos independientes o técnicas como la validación cruzada. Esto ayudaría a evaluar la capacidad del modelo para generalizar y hacer pronósticos precisos en nuevos datos.

Examen 01

Ángeles González Abril Fernanda y Sarabia Rodríguez Yadira Yolotzin

2023-05-22