El documento se encuentra publicado aqui https://rpubs.com/psantizo/1191943

dataset[1:10,]
## # A tibble: 10 × 9
##    `Serial No.` `GRE Score` `TOEFL Score` `University Rating`   SOP   LOR  CGPA
##           <dbl>       <dbl>         <dbl>               <dbl> <dbl> <dbl> <dbl>
##  1            1         337           118                   4   4.5   4.5  9.65
##  2            2         324           107                   4   4     4.5  8.87
##  3            3         316           104                   3   3     3.5  8   
##  4            4         322           110                   3   3.5   2.5  8.67
##  5            5         314           103                   2   2     3    8.21
##  6            6         330           115                   5   4.5   3    9.34
##  7            7         321           109                   3   3     4    8.2 
##  8            8         308           101                   2   3     4    7.9 
##  9            9         302           102                   1   2     1.5  8   
## 10           10         323           108                   3   3.5   3    8.6 
## # ℹ 2 more variables: Research <dbl>, `Chance of Admit` <dbl>

Preguntas

Ejercicio 1. Cree un conjunto de columnas nuevas: día, mes, año, hora y minutos a partir de la comlumna datetime, para esto investigue como puede “desarmar” la variable datetime utilizando lubridate y mutate.

regresion <-  function(df) {
  # Introdución de variables
  X <- df[[1]]
  Y <- df[[2]]
  
  n <- length(X)
  
  # Estimadores de la regresión
  beta_1 <- sum((X - mean(X)) * (Y - mean(Y))) / sum((X - mean(X))^2)
  beta_0 <- mean(Y) - beta_1 * mean(X)
  betas <- c(beta_0, beta_1)
  
  # y estimado
  Y_pred <- beta_0 + beta_1 * X
  
  # residuo
  residuos <- Y - Y_pred
  
  # Coeficiente de determinación r^2
  ss_total <- sum((Y - mean(Y))^2)
  ss_res <- sum(residuos^2)
  r_cuadrado <- 1 - (ss_res / ss_total)
  
  # Coeficiente de correlación r
  r <- sqrt(r_cuadrado)
  
  # Gráfico
  library(ggplot2)
  p <- ggplot(df, aes(x = X, y = Y)) +
    geom_point() +
    geom_abline(intercept = beta_0, slope = beta_1, color = "blue") +
    labs(title = "Diagrama de dispersión y recta de regresión",
         x = "X",
         y = "Y")
  
  # Lista de resultados
  return(list(
    betas = betas,
    r_cuadrado = r_cuadrado,
    r = r,
    residuos = residuos,
    grafico = p
  ))
}

Ejemplo de uso

Se utilizará un gráfico de matriz de dispersión y correlación para seleccionar una posible variable explicativa.

pairs.panels(dataset[,-1]%>%relocate(`Chance of Admit`), pch=21,main="Matriz de Dispersión, Histograma y Correlación")

Se utilizará Chance of Admit como variable dependiente y variable independiente GRE score para hacer el ejemplo de la función

# Uso de función
ejemplo_reg <- regresion(dataset[,c("GRE Score","Chance of Admit")])
#Betas (beta_0, beta_1)
ejemplo_reg$betas
## [1] -2.48281467  0.01012587
#Residuo (primeras 10 observaciones)
ejemplo_reg$residuos[1:10]
##  [1] -0.009603881 -0.037967557  0.003039411  0.022284185 -0.046708847
##  [6]  0.041277216 -0.017589944  0.044046380 -0.075198394 -0.337841686
# R cuadrado
ejemplo_reg$r_cuadrado
## [1] 0.6566682
# Correlacion
ejemplo_reg$r
## [1] 0.8103506
#Gráfico
ejemplo_reg$grafico

Ejercicio #2: Para este ejercicio se le solicita que desarrolle las siguientes actividades utilizando RStudio Con el dataset Admissions adjunto a este laboratorio realice lo siguiente:

1. Realice un análisis estadístico sobre todas las variables del dataset, recuerde que pude usar la función summary().

#Estadísticas

stats_dataset <- summary(dataset)
stats_dataset
##    Serial No.      GRE Score      TOEFL Score    University Rating
##  Min.   :  1.0   Min.   :290.0   Min.   : 92.0   Min.   :1.000    
##  1st Qu.:125.8   1st Qu.:308.0   1st Qu.:103.0   1st Qu.:2.000    
##  Median :250.5   Median :317.0   Median :107.0   Median :3.000    
##  Mean   :250.5   Mean   :316.5   Mean   :107.2   Mean   :3.114    
##  3rd Qu.:375.2   3rd Qu.:325.0   3rd Qu.:112.0   3rd Qu.:4.000    
##  Max.   :500.0   Max.   :340.0   Max.   :120.0   Max.   :5.000    
##       SOP             LOR             CGPA          Research   
##  Min.   :1.000   Min.   :1.000   Min.   :6.800   Min.   :0.00  
##  1st Qu.:2.500   1st Qu.:3.000   1st Qu.:8.127   1st Qu.:0.00  
##  Median :3.500   Median :3.500   Median :8.560   Median :1.00  
##  Mean   :3.374   Mean   :3.484   Mean   :8.576   Mean   :0.56  
##  3rd Qu.:4.000   3rd Qu.:4.000   3rd Qu.:9.040   3rd Qu.:1.00  
##  Max.   :5.000   Max.   :5.000   Max.   :9.920   Max.   :1.00  
##  Chance of Admit 
##  Min.   :0.3400  
##  1st Qu.:0.6300  
##  Median :0.7200  
##  Mean   :0.7217  
##  3rd Qu.:0.8200  
##  Max.   :0.9700

2. Realice una gráfica de densidad para cada una de las variables numéricas en el dataset: GRE.Score, TOEFEL.Score, CGPA y Chance of Admit.

variables<- c("GRE Score", "TOEFL Score", "CGPA", "Chance of Admit")
colnames(dataset)
## [1] "Serial No."        "GRE Score"         "TOEFL Score"      
## [4] "University Rating" "SOP"               "LOR"              
## [7] "CGPA"              "Research"          "Chance of Admit"
dataset_long <- melt(dataset, measure.vars = variables)

p <- ggplot(dataset_long, aes(x = value, color = variable, fill = variable)) +
  geom_density(alpha = 0.5) +
  labs(title = "Densidad de Variables", x = "Valor", y = "Densidad") +
  theme_minimal() +
  facet_wrap(~variable, ncol = 2, scales = "free")

p

3. Realice una gráfica de correlación entre las variables del inciso anterior.

dataset_variables <- dataset[, variables]

correlation_plot <- ggpairs(dataset_variables, 
                            title = "Gráfica de Correlación",
                            upper = list(continuous = wrap("cor", size = 4)),
                            lower = list(continuous = wrap("points", alpha = 0.5, size = 1)))

print(correlation_plot)

4. Realice comentarios sobre el análisis estadístico de las variables numéricas y la gráfica de correlación.

En general las variables muetran una distribución muy similar entre ellas, por lo que podría ser que variables variables independientes estén mostrando una información muy parecida, es decir que exista multicolinealidad. La correlación es alta entre la el chance de admisión y las otras variables, por lo que existe una relación lineal fuerte entre estas variables, lo que es evidente en los graficos de dispersión, que muestran una relación positiva, a mayor puntajeen los examenes, mayor chance de admisión existe.

5. Realice un scatter plot (nube de puntos) de todas las variables numéricas contra la variable Chance of Admit.

variables <- c("GRE Score", "TOEFL Score", "CGPA")

dataset_long <- melt(dataset, id.vars = "Chance of Admit", measure.vars = variables)

p <- ggplot(dataset_long, aes(x = value, y = `Chance of Admit`)) +
  geom_point(alpha = 0.6) +
  facet_wrap(~variable, scales = "free_x") +
  labs(title = "Scatter Plots de Variables  con  Chance of Admit",
       x = "Valor de la Variable",
       y = "Chance of Admit") +
  theme_minimal()

print(p)

6 Utilizando la función train y trainControl para crear un crossvalidationy le permita evaluar los siguientes modelos:

  • Chance of Admit ~ TOEFEL.Score.
  • Chance of Admit ~ CGPA.
  • Chance of Admit ~ GRE.Score.
  • Chance of Admit ~ TOEFEL.Score + CGPA.
  • Chance of Admit ~ TOEFEL.Score + GRE.Score.
  • Chance of Admit ~ GRE.Score + CGPA.
  • Chance of Admit ~ TOEFEL.Score + CGPA + GRE.Score.

Posteriormente cree una lista ordenando de mejor a peor cual es el mejor modelo en predicción, recuerde que es necesario caclular el RMSE para poder armar correctamente la lista.

# Definir los modelos
models <- list(
  "TOEFL Score" = "`Chance of Admit` ~ `TOEFL Score`",
  "CGPA" = "`Chance of Admit` ~ CGPA",
  "GRE Score" = "`Chance of Admit` ~ `GRE Score`",
  "TOEFL Score + CGPA" = "`Chance of Admit` ~ `TOEFL Score` + CGPA",
  "TOEFL Score + GRE Score" = "`Chance of Admit` ~ `TOEFL Score` + `GRE Score`",
  "GRE Score + CGPA" = "`Chance of Admit` ~ `GRE Score` + CGPA",
  "TOEFL Score + CGPA + GRE Score" = "`Chance of Admit` ~ `TOEFL Score` + CGPA + `GRE Score`"
)

# Definir los posibles números de folds
n_folds <- seq(5, 30, by = 5)

# Lista para almacenar los resultados de RMSE
results_rmse <- vector("list", length(n_folds))

# Iterar sobre los números de folds
for (i in seq_along(n_folds)) {
  # función de control de entrenamiento con validación cruzada
  ctrl <- trainControl(method = "cv",  
                       number = n_folds[i],    
                       verboseIter = FALSE)  
  
  # Entrenar y evaluar 
  results <- lapply(models, function(formula) {
    model <- train(as.formula(formula), data = dataset, method = "lm", trControl = ctrl)
    return(data.frame(model = formula, RMSE = model$results$RMSE))
  })
  
  # Combinar los resultados 
  results_df <- do.call(rbind, results)
  
  # Almacenar el resultado RMSE 
  results_rmse[[i]] <- min(results_df$RMSE)
}

# Encontrar el número de folds que minimiza el RMSE
optimal_n_folds <- n_folds[which.min(unlist(results_rmse))]

# Número de folds óptimo
print(optimal_n_folds)
## [1] 20

Evaluación con número optimo de folds

ctrl <- trainControl(method = "cv",  
                     number = optimal_n_folds,    
                     verboseIter = FALSE)  

# Entrenar y evaluar 
results <- lapply(models, function(formula) {
  model <- train(as.formula(formula), data = dataset, method = "lm", trControl = ctrl)
  return(data.frame(model = formula, RMSE = model$results$RMSE))
})

# Guardar los resultados
results_df <- do.call(rbind, results)

# Ordenar por RMSE
results_sorted <- results_df[order(results_df$RMSE), ]

results_sorted
##                                                                                 model
## TOEFL Score + CGPA + GRE Score `Chance of Admit` ~ `TOEFL Score` + CGPA + `GRE Score`
## GRE Score + CGPA                               `Chance of Admit` ~ `GRE Score` + CGPA
## TOEFL Score + CGPA                           `Chance of Admit` ~ `TOEFL Score` + CGPA
## CGPA                                                         `Chance of Admit` ~ CGPA
## TOEFL Score + GRE Score               `Chance of Admit` ~ `TOEFL Score` + `GRE Score`
## GRE Score                                             `Chance of Admit` ~ `GRE Score`
## TOEFL Score                                         `Chance of Admit` ~ `TOEFL Score`
##                                      RMSE
## TOEFL Score + CGPA + GRE Score 0.06145264
## GRE Score + CGPA               0.06217108
## TOEFL Score + CGPA             0.06321045
## CGPA                           0.06574336
## TOEFL Score + GRE Score        0.07611191
## GRE Score                      0.08176625
## TOEFL Score                    0.08563956

Ejercicio #3: A continuación se le muestran tres imágenes que muestran los resultados obtenidos de correr la función summary() a dos modelos de regresión lineal, para este ejercicio se le solicita que realice la interpretación de las tablas resultantes. Recuerde tomar en cuenta la signficancia de los parámetros (signfícancia local), la signficancia del modelo (signficancia global), el valor del 𝑟!: y cualquier observación que considere relevante para determinar si el modelo estructuralmente es adecuado o no.

Modelo 1

img <- readPNG("C:/Users/psantizo/Desktop/Maestría/Econometría_en_R/lab3/lab3/modelo1.png")  

plot.new()

# Establecer el rango de la gráfica para que se ajuste al tamaño de la imagen
plot.window(xlim=c(0, 1), ylim=c(0, 1))

rasterImage(img, 0, 0, 1, 1)

axis(1, labels=FALSE, tick=FALSE)
axis(2, labels=FALSE, tick=FALSE)
box()

En este primer modelo se observa el intercepto no es significativo y que la variable UNEM si es significativa para explicar la variable ROLL. Se observa que el R-2 ajustado es del 0.1218, quiere decir que este modelo solo explica el 12.18% de las variaciones de la variable Roll, un valor que se considera muy bajo. Asimismo, el modelo muestra ser significativo de forma conjunta para explicar el modelo. Parece ser de que se necesitan otras variables que ayuden explicar la variable Roll, dado que sería ingenuo pensar que solo una variable tendrá la capacidad de explicar el 100% de una variable dependiente, dado que generalmente en los distintos clases de fenomenos las variables estan sujetas a cambios de muchos factores, y los factores que no se puedan explicar se espera que tenga un comportamiento aleatorio y estable.

Modelo 2

img <- readPNG("C:/Users/psantizo/Desktop/Maestría/Econometría_en_R/lab3/lab3/modelo2.png")  

plot.new()

# Establecer el rango de la gráfica para que se ajuste al tamaño de la imagen
plot.window(xlim=c(0, 1), ylim=c(0, 1))

rasterImage(img, 0, 0, 1, 1)

axis(1, labels=FALSE, tick=FALSE)
axis(2, labels=FALSE, tick=FALSE)
box()

En este modelo se observa una mejora, el intercepto y las tres variables independientes (UNEM, HGRAD E INC), además el modelo tiene significancia conjunta. El R cuadrado es alto indicando que las variaciones de las variables independientes explican las variaciones de la variable dependiente en un 95.76%. Se observa que el modelo tiene 25 grados de libertad, indicando que el modelo tiene pocas observaciones, por lo que se podría considerar una sobre ajuste. La única forma de saberlo será utilizando mayores grados de libertad y observar que esta relaciones son robustas.

Modelo 3

img <- readPNG("C:/Users/psantizo/Desktop/Maestría/Econometría_en_R/lab3/lab3/modelo3.png")  

plot.new()

# Establecer el rango de la gráfica para que se ajuste al tamaño de la imagen
plot.window(xlim=c(0, 1), ylim=c(0, 1))

rasterImage(img, 0, 0, 1, 1)

axis(1, labels=FALSE, tick=FALSE)
axis(2, labels=FALSE, tick=FALSE)
box()

En este variables el intercepto y la variable meses es significativa, indicando que el modelo es una serie de tiempo, El modelo tambien es en su conjunto significativo. Se observan dos debilidades, el hecho de que sea una serie de tiempo puede ser que existan comportamientos estacionales, de tendencia y ciclicos que podrían no estarse considerando, y que la vairable meses solo este encontrando la tendencia. Por otro lado se observan solo 10 grados de libertad por lo que no se tiene la información suficiente para poder evaluar los estadíticos de la distribución t-studet, por lo que estos coeficientes podrían no ser validos. El R cuadrado es bastante alto, pero se puede deber a la muestra tan pequeña.