pkgs <- c(
"tidyverse","readxl","janitor","stringr","forcats","broom",
"tidytext","stopwords","nnet","ggplot2","writexl",
"apaTables","car","pscl","gt","officer","flextable",
"wordcloud","RColorBrewer","rpart","rpart.plot","caret","yardstick","glue"
)
to_install <- pkgs[!pkgs %in% rownames(installed.packages())]
if(length(to_install)) install.packages(to_install, repos = "https://cloud.r-project.org")
invisible(lapply(pkgs, library, character.only = TRUE))
# Ruta del archivo:
file_path <- "C:/Users/Quimica/Downloads/encuesta_limpia.xlsx"
df <- readxl::read_excel(file_path, sheet = 1) |>
janitor::clean_names() |>
mutate(across(where(is.character), ~str_squish(.x)))
# Normalizar "No aplica"
no_aplica_pat <- regex("^(no tengo|ninguna|6\\.?\\s*no aplica|no aplica)$", ignore_case = TRUE)
df <- df |> mutate(across(where(is.character), ~ if_else(str_detect(.x, no_aplica_pat), "No aplica", .x)))
# Matrícula a mayúsculas (si existe)
mat_cols <- names(df)[str_detect(names(df), "^matr[íi]cula")]
if (length(mat_cols) == 1) df <- df |> mutate("{mat_cols}" := toupper(.data[[mat_cols]]))
col_futuro <- names(df)[str_detect(names(df), "como_te_sientes_en_relacion_a_tu_futuro")]
col_beca <- names(df)[str_detect(names(df), "para_que_utilizas_principalmente_el_dinero_de_la_beca")]
col_genero <- names(df)[str_detect(names(df), "^x?1_\\.?genero|^genero$")]
col_edad <- names(df)[str_detect(names(df), "^x?2_\\.?edad|^edad$")]
col_cel <- names(df)[str_detect(names(df), "tienes_celular")]
col_compu <- names(df)[str_detect(names(df), "tienes_computadora_personal")]
stopifnot(length(col_futuro)==1, length(col_beca)==1, length(col_genero)==1,
length(col_edad)==1, length(col_cel)==1, length(col_compu)==1)
# Codificaciones
to_bin <- function(x) ifelse(str_to_lower(x) %in% c("sí","si"), 1L,
ifelse(str_to_lower(x)=="no", 0L, NA_integer_))
df <- df |>
mutate(
futuro_score = str_extract(.data[[col_futuro]], "^\\d+") |> as.integer(),
edad_num = str_extract(.data[[col_edad]], "\\d+") |> as.integer(),
genero = as.factor(.data[[col_genero]]),
cel_bin = to_bin(.data[[col_cel]]),
compu_bin = to_bin(.data[[col_compu]]),
beca_uso = as.factor(.data[[col_beca]])
)
model_df <- df |> select(futuro_score, beca_uso, genero, edad_num, cel_bin, compu_bin) |> drop_na()
summary(model_df)
## futuro_score beca_uso
## Min. :1.000 1. Transporte a la UNEVT : 4
## 1st Qu.:1.000 2. Comida durante mi estancia en la UNEVT: 2
## Median :2.000 3. Uniforme escolar UNEVT : 1
## Mean :1.917 4. Pago de colegiaturas : 2
## 3rd Qu.:3.000 No aplica :27
## Max. :5.000
## genero edad_num cel_bin compu_bin
## 1. Masculino:18 Min. :17.00 Min. :1 Min. :0.0000
## 2. Femenino :18 1st Qu.:18.00 1st Qu.:1 1st Qu.:1.0000
## Median :18.00 Median :1 Median :1.0000
## Mean :18.42 Mean :1 Mean :0.8333
## 3rd Qu.:19.00 3rd Qu.:1 3rd Qu.:1.0000
## Max. :25.00 Max. :1 Max. :1.0000
# Modelo base
mod_lin <- lm(futuro_score ~ genero + edad_num + cel_bin + compu_bin, data = model_df)
summary(mod_lin)
##
## Call:
## lm(formula = futuro_score ~ genero + edad_num + cel_bin + compu_bin,
## data = model_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.1166 -0.9328 0.0154 0.9561 2.8834
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.22569 2.47580 0.091 0.928
## genero2. Femenino -0.18374 0.34406 -0.534 0.597
## edad_num 0.08018 0.12728 0.630 0.533
## cel_bin NA NA NA NA
## compu_bin 0.36748 0.47490 0.774 0.445
##
## Residual standard error: 0.996 on 32 degrees of freedom
## Multiple R-squared: 0.03076, Adjusted R-squared: -0.06011
## F-statistic: 0.3385 on 3 and 32 DF, p-value: 0.7976
# --- BLOQUE SEGURO PARA VIF / ALIAS ---
model_df_vif <- model_df |> mutate(genero = forcats::fct_drop(genero))
X_check <- model.matrix(~ genero + edad_num + cel_bin + compu_bin, data = model_df_vif)[ , -1, drop = FALSE]
nzv_info <- caret::nearZeroVar(X_check, saveMetrics = TRUE)
# reconstruir fórmula con predictores conservados (a nivel de variables originales)
keep_vars <- c("genero","edad_num","cel_bin","compu_bin")
if (any(nzv_info$zeroVar)) {
# si hubo columnas dummy de varianza cero, intentamos mantener la variable madre igualmente
keep_vars <- keep_vars
}
form_lin_safe <- as.formula(paste("futuro_score ~", paste(keep_vars, collapse = " + ")))
mod_lin_safe <- lm(form_lin_safe, data = model_df_vif)
# Remover términos alias si existen
if (any(is.na(coef(mod_lin_safe)))) {
bad_terms <- names(coef(mod_lin_safe))[is.na(coef(mod_lin_safe))]
good_terms <- setdiff(attr(terms(mod_lin_safe), "term.labels"), bad_terms)
if (length(good_terms) >= 1) {
form_lin_safe2 <- as.formula(paste("futuro_score ~", paste(good_terms, collapse = " + ")))
mod_lin_safe <- lm(form_lin_safe2, data = model_df_vif)
}
}
cat("\n=== Modelo lineal (seguro) ===\n")
##
## === Modelo lineal (seguro) ===
summary(mod_lin_safe)
##
## Call:
## lm(formula = form_lin_safe2, data = model_df_vif)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.1166 -0.9328 0.0154 0.9561 2.8834
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.22569 2.47580 0.091 0.928
## genero2. Femenino -0.18374 0.34406 -0.534 0.597
## edad_num 0.08018 0.12728 0.630 0.533
## compu_bin 0.36748 0.47490 0.774 0.445
##
## Residual standard error: 0.996 on 32 degrees of freedom
## Multiple R-squared: 0.03076, Adjusted R-squared: -0.06011
## F-statistic: 0.3385 on 3 and 32 DF, p-value: 0.7976
# Tabla APA
apaTables::apa.reg.table(mod_lin_safe, filename = "tabla_regresion_futuro_APA.doc", table.number = 1)
##
##
## Table 1
##
## Regression results using futuro_score as the criterion
##
##
## Predictor b b_95%_CI sr2 sr2_95%_CI Fit
## (Intercept) 0.23 [-4.82, 5.27]
## genero2. Femenino -0.18 [-0.88, 0.52] .01 [-.05, .07]
## edad_num 0.08 [-0.18, 0.34] .01 [-.06, .08]
## compu_bin 0.37 [-0.60, 1.33] .02 [-.07, .10]
## R2 = .031
## 95% CI[.00,.13]
##
##
## Note. A significant b-weight indicates the semi-partial correlation is also significant.
## b represents unstandardized regression weights.
## sr2 represents the semi-partial correlation squared.
## Square brackets are used to enclose the lower and upper limits of a confidence interval.
## * indicates p < .05. ** indicates p < .01.
##
# Diagnósticos
par(mfrow = c(2,2)); plot(mod_lin_safe); par(mfrow = c(1,1))
res_lin <- residuals(mod_lin_safe)
shapiro.test(sample(res_lin, min(500, length(res_lin)))) # referencia
##
## Shapiro-Wilk normality test
##
## data: sample(res_lin, min(500, length(res_lin)))
## W = 0.89637, p-value = 0.002719
if (length(coef(mod_lin_safe)) > 2) car::vif(mod_lin_safe)
## genero edad_num compu_bin
## 1.074053 1.188196 1.136785
## ---- multinom_setup, message=FALSE, warning=FALSE ----
library(nnet)
library(dplyr)
library(forcats)
library(broom)
# model_df debe existir con estas columnas:
# futuro_score, beca_uso, genero, edad_num, cel_bin, compu_bin
stopifnot(all(c("beca_uso","genero","edad_num","cel_bin","compu_bin") %in% names(model_df)))
# Asegurar tipos correctos y niveles válidos
model_df_mult <- model_df %>%
mutate(
beca_uso = fct_drop(as.factor(beca_uso)), # quita niveles vacíos
genero = fct_drop(as.factor(genero)),
# (opcional) agrupar categorías raras de beca_uso si hay muchas con muy pocos casos
beca_uso = fct_lump_min(beca_uso, min = 5, other_level = "Otras")
) %>%
filter(!is.na(beca_uso), !is.na(genero), !is.na(edad_num),
!is.na(cel_bin), !is.na(compu_bin))
# Verificar que haya al menos 2 niveles en la respuesta
stopifnot(nlevels(model_df_mult$beca_uso) >= 2)
set.seed(123)
## ---- multinom_fit ----
mod_mult <- nnet::multinom(
beca_uso ~ genero + edad_num + cel_bin + compu_bin,
data = model_df_mult,
trace = FALSE
)
# Resumen del modelo
summary(mod_mult)
## Call:
## nnet::multinom(formula = beca_uso ~ genero + edad_num + cel_bin +
## compu_bin, data = model_df_mult, trace = FALSE)
##
## Coefficients:
## Values Std. Err.
## (Intercept) 2.9748216 3.5687713
## genero2. Femenino 0.4054474 0.8026298
## edad_num -0.3625345 0.3820815
## cel_bin 2.9748216 3.5687713
## compu_bin -0.7587933 1.0442515
##
## Residual Deviance: 38.95916
## AIC: 46.95916
## ---- multinom_full, message=FALSE, warning=FALSE ----
library(nnet)
library(dplyr)
library(forcats)
library(broom)
library(officer)
library(flextable)
# 1. Preprocesamiento
stopifnot(all(c("beca_uso","genero","edad_num","cel_bin","compu_bin") %in% names(model_df)))
model_df_mult <- model_df %>%
mutate(
beca_uso = fct_drop(as.factor(beca_uso)),
genero = fct_drop(as.factor(genero)),
beca_uso = fct_lump_min(beca_uso, min = 5, other_level = "Otras")
) %>%
filter(!is.na(beca_uso), !is.na(genero), !is.na(edad_num),
!is.na(cel_bin), !is.na(compu_bin))
stopifnot(nlevels(model_df_mult$beca_uso) >= 2)
# 2. Ajustar modelo multinomial
set.seed(123)
mod_mult <- multinom(beca_uso ~ genero + edad_num + cel_bin + compu_bin,
data = model_df_mult, trace = FALSE)
# 3. Tabla de OR e IC95%
mult_or <- tidy(mod_mult, conf.int = TRUE, exponentiate = TRUE)
# Si broom devuelve "y.level" en lugar de "level"
if ("y.level" %in% names(mult_or) && !"level" %in% names(mult_or)) {
mult_or <- rename(mult_or, level = y.level)
}
if (!"level" %in% names(mult_or)) {
mult_or <- mutate(mult_or, level = NA_character_)
}
mult_or <- mult_or %>%
mutate(across(where(is.numeric), ~ round(.x, 3))) %>%
relocate(level, .before = everything()) %>%
arrange(level, term)
# 4. Exportar tabla a Word
doc <- read_docx()
ft <- regulartable(mult_or) |> autofit()
doc <- body_add_par(doc, "Regresión logística multinomial — Uso de beca (OR e IC95%)", style = "heading 1")
doc <- body_add_flextable(doc, ft)
print(doc, target = "tabla_multinomial_OR_APA.docx")
# 5. Matriz de confusión y exactitud
pred_class <- predict(mod_mult, type = "class")
conf_mx <- table(Real = model_df_mult$beca_uso, Predicho = pred_class)
conf_mx
## Predicho
## Real No aplica Otras
## No aplica 26 1
## Otras 9 0
mean(pred_class == model_df_mult$beca_uso)
## [1] 0.7222222
# --- Pseudo R² (McFadden) robusto para multinomial nnet::multinom ---
# Si pscl::pR2 falla, calculamos con logLik
mcfadden_safe <- function(model, data, formula_null) {
ll_full <- as.numeric(logLik(model))
mod_null <- nnet::multinom(formula_null, data = data, trace = FALSE)
ll_null <- as.numeric(logLik(mod_null))
# k = número de parámetros estimados
k <- length(unlist(coef(model)))
list(
McFadden = 1 - (ll_full / ll_null),
McFadden_adj = 1 - ((ll_full - k) / ll_null),
ll_full = ll_full,
ll_null = ll_null,
k = k
)
}
# Intento con pscl::pR2 y fallback a McFadden manual
pR2_out <- try(pscl::pR2(mod_mult), silent = TRUE)
## fitting null model for pseudo-r2
if (inherits(pR2_out, "try-error")) {
pR2_out <- mcfadden_safe(mod_mult, model_df, beca_uso ~ 1)
}
pR2_out
## llh llhNull G2 McFadden r2ML r2CU
## -19.47958244 -20.24406521 1.52896553 0.03776330 0.04158199 0.06158102
# --- Árboles de decisión (CORREGIDOS) ---
library(rpart)
library(rpart.plot)
library(caret)
library(yardstick)
# Revisa que existan las columnas correctas
stopifnot(all(c("futuro_score","beca_uso","genero","edad_num","cel_bin","compu_bin") %in% names(model_df)))
set.seed(123)
# =========================
# 1) Árbol de REGRESIÓN
# (predice futuro_score)
# =========================
# Partición 70/30
idx_reg <- caret::createDataPartition(model_df$futuro_score, p = 0.7, list = FALSE)
train_reg <- model_df[idx_reg, ]
test_reg <- model_df[-idx_reg, ]
# Entrenar árbol (método anova para variable numérica)
tree_reg <- rpart(
futuro_score ~ genero + edad_num + cel_bin + compu_bin,
data = train_reg,
method = "anova",
control = rpart.control(minsplit = 15, cp = 0.01)
)
# Elegir cp óptimo por xerror mínimo y podar
best_cp_reg <- tree_reg$cptable[which.min(tree_reg$cptable[, "xerror"]), "CP"]
tree_reg_pruned <- prune(tree_reg, cp = best_cp_reg)
# Graficar (usa paleta válida para rpart.plot)
rpart.plot(
tree_reg_pruned,
type = 2, extra = 101, under = TRUE, faclen = 0, fallen.leaves = TRUE,
box.palette = "Greens", branch.lty = 3, shadow.col = "gray", nn = TRUE,
main = "Árbol de regresión — Percepción de futuro (futuro_score)"
)
# Desempeño en prueba
pred_reg <- predict(tree_reg_pruned, newdata = test_reg)
rmse_reg <- yardstick::rmse_vec(truth = test_reg$futuro_score, estimate = pred_reg)
mae_reg <- yardstick::mae_vec(truth = test_reg$futuro_score, estimate = pred_reg)
cat(sprintf("REGRESIÓN — RMSE: %.3f | MAE: %.3f\n", rmse_reg, mae_reg))
## REGRESIÓN — RMSE: 0.738 | MAE: 0.580
# =========================
# 2) Árbol de CLASIFICACIÓN
# (predice beca_uso)
# =========================
# Asegurar que la variable objetivo es factor
train_cls <- train_reg
test_cls <- test_reg
train_cls$beca_uso <- as.factor(train_cls$beca_uso)
test_cls$beca_uso <- as.factor(test_cls$beca_uso)
tree_cls <- rpart(
beca_uso ~ genero + edad_num + cel_bin + compu_bin,
data = train_cls,
method = "class",
control = rpart.control(minsplit = 15, cp = 0.01)
)
best_cp_cls <- tree_cls$cptable[which.min(tree_cls$cptable[, "xerror"]), "CP"]
tree_cls_pruned <- prune(tree_cls, cp = best_cp_cls)
rpart.plot(
tree_cls_pruned,
type = 2, extra = 104, under = TRUE, faclen = 0, fallen.leaves = TRUE,
box.palette = "Blues", branch.lty = 3, shadow.col = "gray", nn = TRUE,
main = "Árbol de clasificación — Uso de beca (beca_uso)"
)
# Métricas
pred_class <- predict(tree_cls_pruned, newdata = test_cls, type = "class")
cm <- caret::confusionMatrix(pred_class, reference = test_cls$beca_uso)
cm
## Confusion Matrix and Statistics
##
## Reference
## Prediction 1. Transporte a la UNEVT
## 1. Transporte a la UNEVT 0
## 2. Comida durante mi estancia en la UNEVT 0
## 3. Uniforme escolar UNEVT 0
## 4. Pago de colegiaturas 0
## No aplica 0
## Reference
## Prediction 2. Comida durante mi estancia en la UNEVT
## 1. Transporte a la UNEVT 0
## 2. Comida durante mi estancia en la UNEVT 0
## 3. Uniforme escolar UNEVT 0
## 4. Pago de colegiaturas 0
## No aplica 2
## Reference
## Prediction 3. Uniforme escolar UNEVT
## 1. Transporte a la UNEVT 0
## 2. Comida durante mi estancia en la UNEVT 0
## 3. Uniforme escolar UNEVT 0
## 4. Pago de colegiaturas 0
## No aplica 0
## Reference
## Prediction 4. Pago de colegiaturas No aplica
## 1. Transporte a la UNEVT 0 0
## 2. Comida durante mi estancia en la UNEVT 0 0
## 3. Uniforme escolar UNEVT 0 0
## 4. Pago de colegiaturas 0 0
## No aplica 1 6
##
## Overall Statistics
##
## Accuracy : 0.6667
## 95% CI : (0.2993, 0.9251)
## No Information Rate : 0.6667
## P-Value [Acc > NIR] : 0.6503
##
## Kappa : 0
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 1. Transporte a la UNEVT
## Sensitivity NA
## Specificity 1
## Pos Pred Value NA
## Neg Pred Value NA
## Prevalence 0
## Detection Rate 0
## Detection Prevalence 0
## Balanced Accuracy NA
## Class: 2. Comida durante mi estancia en la UNEVT
## Sensitivity 0.0000
## Specificity 1.0000
## Pos Pred Value NaN
## Neg Pred Value 0.7778
## Prevalence 0.2222
## Detection Rate 0.0000
## Detection Prevalence 0.0000
## Balanced Accuracy 0.5000
## Class: 3. Uniforme escolar UNEVT
## Sensitivity NA
## Specificity 1
## Pos Pred Value NA
## Neg Pred Value NA
## Prevalence 0
## Detection Rate 0
## Detection Prevalence 0
## Balanced Accuracy NA
## Class: 4. Pago de colegiaturas Class: No aplica
## Sensitivity 0.0000 1.0000
## Specificity 1.0000 0.0000
## Pos Pred Value NaN 0.6667
## Neg Pred Value 0.8889 NaN
## Prevalence 0.1111 0.6667
## Detection Rate 0.0000 0.6667
## Detection Prevalence 0.0000 1.0000
## Balanced Accuracy 0.5000 0.5000
cat(sprintf("CLASIFICACIÓN — Accuracy: %.3f\n", cm$overall["Accuracy"]))
## CLASIFICACIÓN — Accuracy: 0.667
col_herr <- names(df)[str_detect(names(df), "que_herramientas_digitales_dominas")]
if (length(col_herr) == 1) {
texto_df <- df |> select(texto = all_of(col_herr)) |> filter(!is.na(texto), texto != "No aplica")
palabras <- texto_df |>
unnest_tokens(word, texto) |>
filter(!str_detect(word, "^\\d+$")) |>
mutate(word = str_remove_all(word, "[[:punct:]]")) |>
filter(nchar(word) > 2)
sw <- stopwords::stopwords("es", source = "snowball")
palabras <- palabras |> filter(!word %in% sw)
top_pal <- palabras |> count(word, sort = TRUE) |> slice_max(n, n = 30)
ggplot(top_pal, aes(x = reorder(word, n), y = n)) +
geom_col() + coord_flip() +
labs(title = "Top 30 palabras (Herramientas digitales)", x = NULL, y = "Frecuencia")
set.seed(123)
wordcloud(words = top_pal$word, freq = top_pal$n, min.freq = 1,
colors = RColorBrewer::brewer.pal(8, "Dark2"), scale = c(3,0.7))
bigramas <- texto_df |>
unnest_tokens(bigram, texto, token = "ngrams", n = 2) |>
separate(bigram, into = c("w1","w2"), sep = " ", remove = TRUE) |>
mutate(across(c(w1,w2), ~str_remove_all(.x, "[[:punct:]]"))) |>
filter(!w1 %in% sw, !w2 %in% sw, nchar(w1)>2, nchar(w2)>2) |>
unite(bigram, w1, w2, sep = " ")
top_bi <- bigramas |> count(bigram, sort = TRUE) |> slice_max(n, n = 20)
ggplot(top_bi, aes(x = reorder(bigram, n), y = n)) +
geom_col() + coord_flip() +
labs(title = "Top 20 bigramas (Herramientas digitales)", x = NULL, y = "Frecuencia")
} else {
message("Ajusta el patrón de columna 'col_herr' si el nombre difiere.")
}
df_riesgo <- df |>
mutate(
riesgo_nivel = case_when(
futuro_score <= 2 ~ "Riesgo alto",
futuro_score == 3 ~ "Riesgo medio",
futuro_score >= 4 ~ "Sin riesgo",
TRUE ~ "Sin datos"
),
riesgo_nivel = case_when(
riesgo_nivel == "Sin riesgo" & (cel_bin == 0 & compu_bin == 0) ~ "Riesgo alto",
riesgo_nivel == "Sin riesgo" & (cel_bin == 0 | compu_bin == 0) ~ "Riesgo medio",
TRUE ~ riesgo_nivel
)
)
tabla_riesgo <- df_riesgo |> count(riesgo_nivel) |> mutate(prop = round(n/sum(n)*100,1))
tabla_riesgo
## # A tibble: 3 × 3
## riesgo_nivel n prop
## <chr> <int> <dbl>
## 1 Riesgo alto 26 72.2
## 2 Riesgo medio 9 25
## 3 Sin riesgo 1 2.8
ggplot(tabla_riesgo, aes(x = riesgo_nivel, y = n, fill = riesgo_nivel)) +
geom_col() +
scale_fill_manual(values = c("Riesgo alto"="red","Riesgo medio"="gold","Sin riesgo"="forestgreen","Sin datos"="grey70")) +
labs(title = "Distribución de niveles de riesgo", x = NULL, y = "Número de alumnos") +
theme_minimal()
alumnos_riesgo_alto <- df_riesgo |> filter(riesgo_nivel == "Riesgo alto")
writexl::write_xlsx(alumnos_riesgo_alto, "alumnos_riesgo_alto.xlsx")
lin_tidy <- broom::tidy(mod_lin_safe, conf.int = TRUE)
lin_glance <- broom::glance(mod_lin_safe)
top_terms <- lin_tidy %>% filter(term != "(Intercept)", p.value < .05) %>%
arrange(p.value) %>% pull(term) %>% paste(collapse = ", ")
glue("
**Modelo lineal (futuro_score)**
R² = {round(lin_glance$r.squared,3)}; Ajustado = {round(lin_glance$adj.r.squared,3)}; p = {signif(lin_glance$p.value,3)}.
Predictores significativos: {ifelse(nchar(top_terms)>0, top_terms, 'ninguno a α=0.05')}.
")
## **Modelo lineal (futuro_score)**
## R² = 0.031; Ajustado = -0.06; p = 0.798.
## Predictores significativos: ninguno a α=0.05.
resultados <- list(
coef_lineal_seguro = broom::tidy(mod_lin_safe, conf.int = TRUE),
ajuste_lineal_seguro = broom::glance(mod_lin_safe),
multinomial_OR = mult_or,
conteo_riesgo = tabla_riesgo
)
writexl::write_xlsx(resultados, "resultados_finales.xlsx")
cat("Archivos exportados:\n- tabla_regresion_futuro_APA.doc\n- tabla_multinomial_OR_APA.docx\n- alumnos_riesgo_alto.xlsx\n- resultados_finales.xlsx\n")
## Archivos exportados:
## - tabla_regresion_futuro_APA.doc
## - tabla_multinomial_OR_APA.docx
## - alumnos_riesgo_alto.xlsx
## - resultados_finales.xlsx
library(dplyr)
library(ggplot2)
# 1) Intentar importancia del árbol podado y, si no hay, la del árbol sin podar
imp_vec <- tree_cls_pruned$variable.importance
if (is.null(imp_vec) || length(imp_vec) == 0) {
imp_vec <- tree_cls$variable.importance
}
# 2) Si sigue vacía, refitar con hiperparámetros más permisivos para forzar splits
if (is.null(imp_vec) || length(imp_vec) == 0) {
message("El árbol no generó splits con los parámetros actuales. Reajustando con cp=0.001 y minsplit=5...")
tree_cls_alt <- rpart(
beca_uso ~ genero + edad_num + cel_bin + compu_bin,
data = train_cls,
method = "class",
control = rpart.control(minsplit = 5, cp = 0.001, maxdepth = 10)
)
best_cp_alt <- tree_cls_alt$cptable[which.min(tree_cls_alt$cptable[, "xerror"]), "CP"]
tree_cls_pruned_alt <- prune(tree_cls_alt, cp = best_cp_alt)
imp_vec <- tree_cls_pruned_alt$variable.importance
}
# 3) Construir el data frame y graficar solo si hay importancia
if (!is.null(imp_vec) && length(imp_vec) > 0) {
imp_cls <- tibble(
Variable = names(imp_vec),
Importancia = as.numeric(imp_vec)
) %>% arrange(desc(Importancia))
ggplot(imp_cls, aes(x = reorder(Variable, Importancia), y = Importancia)) +
geom_col() +
coord_flip() +
labs(
title = "Importancia de variables — Árbol de clasificación",
x = "Variable", y = "Importancia"
) +
theme_minimal()
} else {
message("No hay importancia de variables disponible (el modelo no generó divisiones útiles).
Intenta bajar cp, bajar minsplit o revisar que las variables tengan variación y niveles suficientes.")
}
library(reshape2)
cm_table <- as.data.frame(cm$table)
ggplot(cm_table, aes(Prediction, Reference, fill = Freq)) +
geom_tile() +
geom_text(aes(label = Freq), color = "white", size = 5) +
scale_fill_gradient(low = "lightblue", high = "darkblue") +
labs(
title = "Matriz de confusión — Árbol de clasificación",
x = "Predicho",
y = "Real"
) +
theme_minimal()
library(pROC)
# Solo si es binaria
if (nlevels(test_cls$beca_uso) == 2) {
probas <- predict(tree_cls_pruned, newdata = test_cls, type = "prob")[,2]
roc_obj <- roc(test_cls$beca_uso, probas)
plot(roc_obj, col = "blue", main = "Curva ROC — Árbol de clasificación")
auc_val <- auc(roc_obj)
cat("AUC:", auc_val, "\n")
}
# Dispersión por edad y futuro_score
ggplot(model_df, aes(x = edad_num, y = futuro_score, color = genero)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = FALSE) +
labs(title = "Relación entre edad y percepción de futuro",
x = "Edad", y = "Futuro (score)") +
theme_minimal()
# Densidad de futuro_score según uso de beca
ggplot(model_df, aes(x = futuro_score, fill = beca_uso)) +
geom_density(alpha = 0.4) +
labs(title = "Distribución de futuro_score por uso de beca") +
theme_minimal()
library(caret)
pred_class <- predict(tree_cls_pruned, newdata = test_cls, type = "class")
conf_mat <- confusionMatrix(pred_class, test_cls$beca_uso)
conf_mat
## Confusion Matrix and Statistics
##
## Reference
## Prediction 1. Transporte a la UNEVT
## 1. Transporte a la UNEVT 0
## 2. Comida durante mi estancia en la UNEVT 0
## 3. Uniforme escolar UNEVT 0
## 4. Pago de colegiaturas 0
## No aplica 0
## Reference
## Prediction 2. Comida durante mi estancia en la UNEVT
## 1. Transporte a la UNEVT 0
## 2. Comida durante mi estancia en la UNEVT 0
## 3. Uniforme escolar UNEVT 0
## 4. Pago de colegiaturas 0
## No aplica 2
## Reference
## Prediction 3. Uniforme escolar UNEVT
## 1. Transporte a la UNEVT 0
## 2. Comida durante mi estancia en la UNEVT 0
## 3. Uniforme escolar UNEVT 0
## 4. Pago de colegiaturas 0
## No aplica 0
## Reference
## Prediction 4. Pago de colegiaturas No aplica
## 1. Transporte a la UNEVT 0 0
## 2. Comida durante mi estancia en la UNEVT 0 0
## 3. Uniforme escolar UNEVT 0 0
## 4. Pago de colegiaturas 0 0
## No aplica 1 6
##
## Overall Statistics
##
## Accuracy : 0.6667
## 95% CI : (0.2993, 0.9251)
## No Information Rate : 0.6667
## P-Value [Acc > NIR] : 0.6503
##
## Kappa : 0
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 1. Transporte a la UNEVT
## Sensitivity NA
## Specificity 1
## Pos Pred Value NA
## Neg Pred Value NA
## Prevalence 0
## Detection Rate 0
## Detection Prevalence 0
## Balanced Accuracy NA
## Class: 2. Comida durante mi estancia en la UNEVT
## Sensitivity 0.0000
## Specificity 1.0000
## Pos Pred Value NaN
## Neg Pred Value 0.7778
## Prevalence 0.2222
## Detection Rate 0.0000
## Detection Prevalence 0.0000
## Balanced Accuracy 0.5000
## Class: 3. Uniforme escolar UNEVT
## Sensitivity NA
## Specificity 1
## Pos Pred Value NA
## Neg Pred Value NA
## Prevalence 0
## Detection Rate 0
## Detection Prevalence 0
## Balanced Accuracy NA
## Class: 4. Pago de colegiaturas Class: No aplica
## Sensitivity 0.0000 1.0000
## Specificity 1.0000 0.0000
## Pos Pred Value NaN 0.6667
## Neg Pred Value 0.8889 NaN
## Prevalence 0.1111 0.6667
## Detection Rate 0.0000 0.6667
## Detection Prevalence 0.0000 1.0000
## Balanced Accuracy 0.5000 0.5000
library(pROC)
# Probabilidades por clase
probs <- predict(tree_cls_pruned, newdata = test_cls, type = "prob")
y <- droplevels(factor(test_cls$beca_uso))
# Alinear niveles del factor con columnas de probas (intersección común)
common <- intersect(colnames(probs), levels(y))
if (length(common) < 2) {
stop("No hay al menos 2 clases en común entre las columnas de probabilidad y los niveles de la respuesta.")
}
probs <- probs[, common, drop = FALSE]
y <- factor(y, levels = common)
# Clases con soporte en el set de prueba
tab <- table(y)
# válidas para ROC binaria: al menos un positivo y un negativo
valid_bin <- names(tab)[tab > 0 & (length(y) - tab) > 0]
cat("Clases detectadas:", paste(common, collapse = " | "), "\n")
## Clases detectadas: 2. Comida durante mi estancia en la UNEVT | 4. Pago de colegiaturas | No aplica
cat("Clases con soporte para ROC binaria:", paste(valid_bin, collapse = " | "), "\n")
## Clases con soporte para ROC binaria: 2. Comida durante mi estancia en la UNEVT | 4. Pago de colegiaturas | No aplica
# --- AUC multiclass (Hand & Till) si hay >= 2 clases con soporte ---
if (length(valid_bin) >= 2) {
# pROC acepta una matriz de probabilidades con columnas por clase
mroc <- multiclass.roc(response = y, predictor = as.matrix(probs[, valid_bin, drop = FALSE]))
cat("AUC (multiclase, Hand & Till) =", as.numeric(mroc$auc), "\n")
} else {
cat("No es posible calcular AUC multiclase: hay menos de 2 clases con soporte en el set de prueba.\n")
}
## AUC (multiclase, Hand & Till) = 0.5
# --- Curvas ROC One-vs-Rest por cada clase válida ---
if (length(valid_bin) >= 1) {
cols <- grDevices::rainbow(length(valid_bin))
first <- TRUE
for (i in seq_along(valid_bin)) {
cls <- valid_bin[i]
y_bin <- as.numeric(y == cls)
# seguridad extra: debe haber 0 y 1
if (all(y_bin == 0) || all(y_bin == 1)) {
message("Se omite la clase '", cls, "' por falta de positivos o negativos en test.")
next
}
roc_i <- roc(response = y_bin, predictor = probs[, cls], quiet = TRUE)
plot(roc_i, col = cols[i], add = !first,
main = "Curvas ROC One-vs-Rest — Árbol de clasificación")
first <- FALSE
}
if (!first) legend("bottomright", legend = valid_bin, col = cols, lwd = 2, cex = .8)
} else {
cat("No hay clases con soporte suficiente para trazar ROC One-vs-Rest.\n")
}
## ---- comparacion_modelos_segura, message=FALSE, warning=FALSE ----
library(dplyr)
library(forcats)
library(caret)
# Requisitos previos:
# - model_df con: beca_uso, genero, edad_num, cel_bin, compu_bin
# - (ideal) ya tener tree_cls_pruned, train_cls, test_cls
# - (ideal) ya tener mod_mult (nnet::multinom)
# 1) Si NO existe el split train/test para clasificación, créalo
if (!exists("train_cls") || !exists("test_cls")) {
stopifnot(all(c("beca_uso","genero","edad_num","cel_bin","compu_bin") %in% names(model_df)))
set.seed(123)
idx2 <- caret::createDataPartition(as.factor(model_df$beca_uso), p = 0.7, list = FALSE)
train_cls <- model_df[idx2, ]
test_cls <- model_df[-idx2, ]
}
# Asegurar tipos correctos en train/test
train_cls <- train_cls %>%
mutate(
beca_uso = fct_drop(as.factor(beca_uso)),
genero = fct_drop(as.factor(genero))
)
test_cls <- test_cls %>%
mutate(
beca_uso = fct_drop(as.factor(beca_uso)),
genero = fct_drop(as.factor(genero))
)
# 2) Si NO existe el árbol podado, ajústalo y pódalo
if (!exists("tree_cls_pruned")) {
library(rpart)
tree_cls <- rpart(
beca_uso ~ genero + edad_num + cel_bin + compu_bin,
data = train_cls, method = "class",
control = rpart.control(minsplit = 15, cp = 0.01)
)
best_cp_cls <- tree_cls$cptable[which.min(tree_cls$cptable[, "xerror"]), "CP"]
tree_cls_pruned <- prune(tree_cls, cp = best_cp_cls)
}
# 3) Si NO existe la multinomial, ajústala sobre el mismo split (para que prediga bien en test_cls)
if (!exists("mod_mult")) {
library(nnet)
mod_mult <- nnet::multinom(
beca_uso ~ genero + edad_num + cel_bin + compu_bin,
data = train_cls, trace = FALSE
)
}
# 4) Preparar newdata para predicción (asegurar columnas y tipos)
vars_x <- c("genero","edad_num","cel_bin","compu_bin")
newdata_test <- test_cls[, vars_x, drop = FALSE]
# Alinear niveles de factores con los del entrenamiento
newdata_test$genero <- factor(newdata_test$genero, levels = levels(train_cls$genero))
# 5) Predicciones de ambos modelos (crea pred_tree y pred_mult)
pred_tree <- predict(tree_cls_pruned, newdata = newdata_test, type = "class")
pred_mult <- try(predict(mod_mult, newdata = newdata_test, type = "class"), silent = TRUE)
# Si la predicción multinomial falló por niveles, reintenta alineando beca_uso del entrenamiento
if (inherits(pred_mult, "try-error")) {
# re-entrena multinomial con niveles "definitivos"
library(nnet)
train_tmp <- train_cls %>%
mutate(
beca_uso = fct_drop(beca_uso),
genero = factor(genero)
)
mod_mult <- nnet::multinom(beca_uso ~ genero + edad_num + cel_bin + compu_bin,
data = train_tmp, trace = FALSE)
pred_mult <- predict(mod_mult, newdata = newdata_test, type = "class")
}
# 6) Alinear niveles de las predicciones con el "ground truth"
lvl_ref <- levels(test_cls$beca_uso)
pred_tree <- factor(pred_tree, levels = lvl_ref)
pred_mult <- factor(pred_mult, levels = lvl_ref)
# 7) Métricas y comparación
cm_tree <- caret::confusionMatrix(pred_tree, reference = test_cls$beca_uso)
cm_mult <- caret::confusionMatrix(pred_mult, reference = test_cls$beca_uso)
comp <- data.frame(
Modelo = c("Árbol (rpart)", "Reg. Multinomial"),
Accuracy = c(cm_tree$overall["Accuracy"], cm_mult$overall["Accuracy"]),
Kappa = c(cm_tree$overall["Kappa"], cm_mult$overall["Kappa"])
)
comp
## Modelo Accuracy Kappa
## 1 Árbol (rpart) 0.6666667 0
## 2 Reg. Multinomial 0.6666667 0
# Mostrar matrices de confusión
cm_tree
## Confusion Matrix and Statistics
##
## Reference
## Prediction 2. Comida durante mi estancia en la UNEVT
## 2. Comida durante mi estancia en la UNEVT 0
## 4. Pago de colegiaturas 0
## No aplica 2
## Reference
## Prediction 4. Pago de colegiaturas No aplica
## 2. Comida durante mi estancia en la UNEVT 0 0
## 4. Pago de colegiaturas 0 0
## No aplica 1 6
##
## Overall Statistics
##
## Accuracy : 0.6667
## 95% CI : (0.2993, 0.9251)
## No Information Rate : 0.6667
## P-Value [Acc > NIR] : 0.6503
##
## Kappa : 0
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 2. Comida durante mi estancia en la UNEVT
## Sensitivity 0.0000
## Specificity 1.0000
## Pos Pred Value NaN
## Neg Pred Value 0.7778
## Prevalence 0.2222
## Detection Rate 0.0000
## Detection Prevalence 0.0000
## Balanced Accuracy 0.5000
## Class: 4. Pago de colegiaturas Class: No aplica
## Sensitivity 0.0000 1.0000
## Specificity 1.0000 0.0000
## Pos Pred Value NaN 0.6667
## Neg Pred Value 0.8889 NaN
## Prevalence 0.1111 0.6667
## Detection Rate 0.0000 0.6667
## Detection Prevalence 0.0000 1.0000
## Balanced Accuracy 0.5000 0.5000
cm_mult
## Confusion Matrix and Statistics
##
## Reference
## Prediction 2. Comida durante mi estancia en la UNEVT
## 2. Comida durante mi estancia en la UNEVT 0
## 4. Pago de colegiaturas 0
## No aplica 2
## Reference
## Prediction 4. Pago de colegiaturas No aplica
## 2. Comida durante mi estancia en la UNEVT 0 0
## 4. Pago de colegiaturas 0 0
## No aplica 1 6
##
## Overall Statistics
##
## Accuracy : 0.6667
## 95% CI : (0.2993, 0.9251)
## No Information Rate : 0.6667
## P-Value [Acc > NIR] : 0.6503
##
## Kappa : 0
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 2. Comida durante mi estancia en la UNEVT
## Sensitivity 0.0000
## Specificity 1.0000
## Pos Pred Value NaN
## Neg Pred Value 0.7778
## Prevalence 0.2222
## Detection Rate 0.0000
## Detection Prevalence 0.0000
## Balanced Accuracy 0.5000
## Class: 4. Pago de colegiaturas Class: No aplica
## Sensitivity 0.0000 1.0000
## Specificity 1.0000 0.0000
## Pos Pred Value NaN 0.6667
## Neg Pred Value 0.8889 NaN
## Prevalence 0.1111 0.6667
## Detection Rate 0.0000 0.6667
## Detection Prevalence 0.0000 1.0000
## Balanced Accuracy 0.5000 0.5000
# Alinear niveles de pred_mult y test_cls$beca_uso
pred_mult <- factor(pred_mult, levels = levels(test_cls$beca_uso))
pred_tree <- factor(pred_tree, levels = levels(test_cls$beca_uso))
# Comparación de modelos
data.frame(
Modelo = c("Árbol", "Reg. Multinomial"),
Accuracy = c(
mean(pred_tree == test_cls$beca_uso, na.rm = TRUE),
mean(pred_mult == test_cls$beca_uso, na.rm = TRUE)
)
)
## Modelo Accuracy
## 1 Árbol 0.6666667
## 2 Reg. Multinomial 0.6666667
library(ggplot2)
res <- residuals(mod_mult, type = "deviance")
ggplot(data.frame(Residuos = res), aes(x = Residuos)) +
geom_histogram(bins = 30, fill = "skyblue", color = "white") +
theme_minimal() +
labs(title = "Distribución de residuos — Reg. Logística Multinomial")
library(DALEX)
explainer <- explain(tree_cls_pruned, data = train_cls[, -1], y = train_cls$beca_uso)
## Preparation of a new explainer is initiated
## -> model label : rpart ( default )
## -> data : 27 rows 5 cols
## -> data : tibble converted into a data.frame
## -> target variable : 27 values
## -> predict function : yhat.rpart will be used ( default )
## -> predicted values : No value for predict function target column. ( default )
## -> model_info : package rpart , ver. 4.1.24 , task multiclass ( default )
## -> predicted values : predict function returns multiple columns: 5 ( default )
## -> residual function : difference between 1 and probability of true class ( default )
## -> residuals : numerical, min = 0.2222222 , mean = 0.3703704 , max = 0.962963
## A new explainer has been created!
vi <- model_parts(explainer)
plot(vi)
library(rpart.plot)
rpart.plot(tree_cls_pruned, type = 2, extra = 101, under = TRUE, box.palette = "GnBu")
## ---- estadisticos_centrales, message=FALSE ----
library(dplyr)
# Función para calcular moda
moda <- function(x) {
ux <- unique(na.omit(x))
ux[which.max(tabulate(match(x, ux)))]
}
# Seleccionamos solo variables numéricas
datos_numericos <- model_df %>%
select(where(is.numeric))
# Calculamos media, mediana y moda
estadisticos <- datos_numericos %>%
summarise(across(everything(),
list(
Media = ~mean(., na.rm = TRUE),
Mediana = ~median(., na.rm = TRUE),
Moda = ~moda(.)
),
.names = "{.col}_{.fn}"
))
estadisticos
## # A tibble: 1 × 12
## futuro_score_Media futuro_score_Mediana futuro_score_Moda edad_num_Media
## <dbl> <dbl> <int> <dbl>
## 1 1.92 2 1 18.4
## # ℹ 8 more variables: edad_num_Mediana <dbl>, edad_num_Moda <int>,
## # cel_bin_Media <dbl>, cel_bin_Mediana <dbl>, cel_bin_Moda <int>,
## # compu_bin_Media <dbl>, compu_bin_Mediana <dbl>, compu_bin_Moda <int>
## ---- graficas_generales, message=FALSE, warning=FALSE ----
library(tidyverse)
library(forcats)
# 0) Carpeta de salida
dir.create("graficas", showWarnings = FALSE)
# 1) Funciones de utilería ---------------------------------------------
etiquetas_pct <- function(n) scales::percent(n / sum(n), accuracy = 0.1)
plot_barras <- function(data, var, top_n = Inf, titulo = NULL) {
v <- rlang::ensym(var)
dfp <- data %>%
mutate({{var}} := fct_explicit_na(as.factor(!!v), na_level = "No aplica")) %>%
count({{var}}, name = "n") %>%
mutate(pct = n / sum(n),
label = scales::percent(pct, accuracy = 0.1)) %>%
arrange(desc(n)) %>%
{ if (is.finite(top_n)) slice_head(., n = top_n) else . }
ggplot(dfp, aes(x = reorder(!!v, n), y = n)) +
geom_col() +
geom_text(aes(label = label), hjust = -0.1, size = 3) +
coord_flip() +
labs(title = titulo %||% rlang::as_string(v),
x = NULL, y = "Frecuencia") +
theme_minimal() +
expand_limits(y = max(dfp$n) * 1.15)
}
plot_pastel <- function(data, var, top_n = Inf, titulo = NULL) {
v <- rlang::ensym(var)
dfp <- data %>%
mutate({{var}} := fct_explicit_na(as.factor(!!v), na_level = "No aplica")) %>%
count({{var}}, name = "n") %>%
arrange(desc(n)) %>%
{ if (is.finite(top_n)) slice_head(., n = top_n) else . } %>%
mutate(pct = n / sum(n),
label = paste0(scales::percent(pct, accuracy = 0.1), " ", as.character(!!v)))
ggplot(dfp, aes(x = "", y = pct, fill = !!v)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
labs(title = titulo %||% paste0("Pastel: ", rlang::as_string(v)), x = NULL, y = NULL, fill = NULL) +
theme_void() +
geom_text(aes(label = scales::percent(pct, accuracy = 0.1)),
position = position_stack(vjust = 0.5), size = 3)
}
# 2) Detectar tipos de variables ----------------------------------------
# Criterio: variable "categórica" si es factor/character con <= 20 categorías únicas
# (evita graficar texto libre muy disperso)
MAX_NIVELES <- 20
es_categorica <- function(x) {
is.factor(x) ||
(is.character(x) && dplyr::n_distinct(x, na.rm = TRUE) <= MAX_NIVELES)
}
vars_cat <- names(df)[vapply(df, es_categorica, logical(1))]
vars_num <- names(df)[vapply(df, is.numeric, logical(1))]
cat("Variables categóricas detectadas (máx 20 niveles):\n")
## Variables categóricas detectadas (máx 20 niveles):
print(vars_cat)
## [1] "plantel_al_que_perteneces"
## [2] "licenciatura_que_cursas"
## [3] "semestre"
## [4] "grupo"
## [5] "x1_genero"
## [6] "a_que_municipio_perteneces"
## [7] "si_no_eres_originario_del_estado_de_mexico_a_que_estado_o_pais_perteneces"
## [8] "x3_cual_es_tu_estado_civil"
## [9] "tienes_una_relacion_sentimental"
## [10] "tiempo_de_relacion_con_tu_pareja"
## [11] "x4_tienes_hijos"
## [12] "cuantos"
## [13] "alguien_depende_de_ti_economicamente"
## [14] "x5_sales_a_fiestas_o_reuniones_con_tus_amigas_os"
## [15] "en_reuniones_y_o_actividades_sociales_ingieres_bebidas_alcoholicas_y_o_tabaco"
## [16] "te_expulsaron_y_o_suspendieron_en_alguna_ocasion"
## [17] "tuviste_problemas_con_algun_maestro_a_o_algun_companero_a"
## [18] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_la_bibliografia_del_programa_de_estudio_de_la_licenciatura"
## [19] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_bibliografia_que_busco_por_mi_cuenta"
## [20] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_antologias"
## [21] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_revistas_especializadas"
## [22] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_enciclopedias"
## [23] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_diccionarios"
## [24] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_libros_de_texto"
## [25] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_paginas_web"
## [26] "que_tipo_de_lecturas_acostumbras_a_utilizar_al_cursar_tus_estudios_redes_sociales"
## [27] "donde_obtienes_los_materiales_para_realizar_tus_actividades_academicas_biblioteca"
## [28] "donde_obtienes_los_materiales_para_realizar_tus_actividades_academicas_los_compro"
## [29] "donde_obtienes_los_materiales_para_realizar_tus_actividades_academicas_los_fotocopio"
## [30] "donde_obtienes_los_materiales_para_realizar_tus_actividades_academicas_los_pido_prestados"
## [31] "donde_obtienes_los_materiales_para_realizar_tus_actividades_academicas_via_internet"
## [32] "cuales_son_las_formas_de_estudio_y_o_realizacion_de_trabajos_escolares_que_empleas_regularmente_individual"
## [33] "cuales_son_las_formas_de_estudio_y_o_realizacion_de_trabajos_escolares_que_empleas_regularmente_grupal"
## [34] "en_promedio_cuantas_horas_a_la_semana_dedicas_para_el_desarrollo_de_actividades_extraclases_comprende_lecturas_trabajos_y_tareas"
## [35] "a_lo_largo_de_tu_trayectoria_en_la_unevt_que_opinion_tienes_sobre_los_trabajos_y_evidencias_que_te_piden_tus_docentes_marca_una_opcion_por_renglon_las_y_los_profesores_revisan_los_trabajos"
## [36] "a_lo_largo_de_tu_trayectoria_en_la_unevt_que_opinion_tienes_sobre_los_trabajos_y_evidencias_que_te_piden_tus_docentes_marca_una_opcion_por_renglon_las_y_los_profesores_regresan_los_trabajos"
## [37] "a_lo_largo_de_tu_trayectoria_en_la_unevt_que_opinion_tienes_sobre_los_trabajos_y_evidencias_que_te_piden_tus_docentes_marca_una_opcion_por_renglon_las_y_los_profesores_regresan_los_trabajos_con_correcciones_y_comentarios"
## [38] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_presentacion"
## [39] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_uso_de_bibliografia"
## [40] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_ortografia"
## [41] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_redaccion"
## [42] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_extension"
## [43] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_dominio_de_la_materia"
## [44] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_ideas_originales"
## [45] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_capacidad_de_analisis"
## [46] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_capacidad_de_critica"
## [47] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_capacidad_de_sintesis"
## [48] "que_aspectos_fueron_revisados_en_tus_trabajos_marca_una_opcion_por_cada_renglon_orden_y_coherencia"
## [49] "con_que_frecuencia_asistes_a_los_siguientes_eventos_marca_una_opcion_por_renglon_musica"
## [50] "con_que_frecuencia_asistes_a_los_siguientes_eventos_marca_una_opcion_por_renglon_exposiciones_artisticas"
## [51] "con_que_frecuencia_asistes_a_los_siguientes_eventos_marca_una_opcion_por_renglon_cine"
## [52] "con_que_frecuencia_asistes_a_los_siguientes_eventos_marca_una_opcion_por_renglon_presentacion_de_libros"
## [53] "con_que_frecuencia_asistes_a_los_siguientes_eventos_marca_una_opcion_por_renglon_danza"
## [54] "con_que_frecuencia_asistes_a_los_siguientes_eventos_marca_una_opcion_por_renglon_eventos_deportivos"
## [55] "con_que_frecuencia_asistes_a_los_siguientes_eventos_marca_una_opcion_por_renglon_teatro"
## [56] "con_que_frecuencia_asistes_a_los_siguientes_eventos_marca_una_opcion_por_renglon_museos"
## [57] "realizas_alguna_de_las_siguientes_actividades_socio_recreativas_a_deportiva"
## [58] "realizas_alguna_de_las_siguientes_actividades_socio_recreativas_b_culturales"
## [59] "hablas_algun_dialecto_o_lengua_indigena"
## [60] "tus_papas_o_tus_abuelos_as_son_indigenas"
## [61] "tus_papas_o_tus_abuelos_as_hablan_o_entienden_alguna_lengua_indigena"
## [62] "actualmente_vive_con"
## [63] "cual_es_tu_lugar_de_residencia_mientras_estudias_en_la_unevt"
## [64] "selecciona_los_servicios_con_los_que_cuenta_la_casa_donde_vives_servicios"
## [65] "que_lugar_ocupan_tus_estudios_dentro_de_las_prioridades_de_tu_familia"
## [66] "cuanto_tiempo_haces_diariamente_para_trasladarte_de_tu_lugar_de_residencia_a_la_escuela"
## [67] "tienes_alguna_discapacidad"
## [68] "padeces_o_padeciste_alguna_enfermedad"
## [69] "cual"
## [70] "algun_familiar_de_linea_directa_padece_alguna_enfermedad"
## [71] "presentas_alguna_de_las_siguientes_condiciones_usas_lentes"
## [72] "presentas_alguna_de_las_siguientes_condiciones_estas_en_tratamiento_dental"
## [73] "presentas_alguna_de_las_siguientes_condiciones_tienes_alguna_discapacidad_auditiva"
## [74] "presentas_alguna_de_las_siguientes_condiciones_estas_en_algun_tratamiento_medico"
## [75] "presentas_alguna_de_las_siguientes_condiciones_tienes_algun_padecimiento_cronico"
## [76] "presentas_alguna_de_las_siguientes_condiciones_tienes_alguna_alergia"
## [77] "haz_llevado_algun_seguimiento_de_atencion_psicologica"
## [78] "actualmente_continuas_con_un_plan_de_atencion_psicologica"
## [79] "en_cual_de_las_siguientes_instituciones_de_salud_tienes_derecho_a_recibir_servicio_medico_senale_todas_las_opciones_que_aplica"
## [80] "la_licenciatura_estas_estudiando_fue_tu_primera_opcion"
## [81] "asistes_a_la_universidad_porque_crees_que_te_sera_de_utilidad"
## [82] "te_gusta_la_universidad"
## [83] "que_tanto_dominas_el_idioma_ingles"
## [84] "en_que_areas_considera_utilizar_el_idioma_ingles_areas"
## [85] "que_nivel_de_idioma_ingles_tienes"
## [86] "con_que_documento_probatorio_compruebas_tu_nivel_de_idioma_ingles"
## [87] "en_la_actualidad_en_cual_de_las_siguientes_situaciones_te_encuentras"
## [88] "cual_es_la_principal_razon_por_la_que_dejarias_de_estudiar"
## [89] "los_recursos_economicos_con_los_que_cuentas_para_desarrollar_tus_actividades_academicas_son"
## [90] "cual_es_el_medio_de_transporte_que_utilizas_regularmente_para_trasladarte_a_la_unevt_puedes_marcar_mas_de_una_opcion"
## [91] "a_cuanto_ascienden_tus_gastos_escolares_sepanles"
## [92] "quien_cubre_tus_gastos_escolares"
## [93] "cual_fue_la_escolaridad_maxima_alcanzada_por_tu_padre"
## [94] "cual_fue_la_escolaridad_maxima_alcanzada_por_tu_madre"
## [95] "recibes_alguna_beca_para_apoyar_tus_estudios"
## [96] "cual_beca_recibes"
## [97] "en_caso_de_tener_otra_beca_especifica"
## [98] "para_que_utilizas_principalmente_el_dinero_de_la_beca"
## [99] "como_te_sientes_en_relacion_a_tu_futuro"
## [100] "tienes_celular"
## [101] "tienes_computadora_personal"
## [102] "principalmente_en_donde_usas_internet"
## [103] "de_las_siguientes_redes_sociales_selecciona_en_las_que_estas_registrado"
## [104] "genero"
## [105] "beca_uso"
cat("\nVariables numéricas detectadas:\n")
##
## Variables numéricas detectadas:
print(vars_num)
## [1] "x2_edad" "futuro_score" "edad_num" "cel_bin" "compu_bin"
# 3) Graficar categóricas: Barras + Pastel ------------------------------
for (v in vars_cat) {
titulo <- stringr::str_to_sentence(gsub("_", " ", v))
p_bar <- plot_barras(df, !!rlang::sym(v), titulo = titulo)
p_pie <- plot_pastel(df, !!rlang::sym(v), titulo = titulo)
# Mostrar en el documento
print(p_bar)
print(p_pie)
# Guardar (PNG)
ggsave(filename = file.path("graficas", paste0("barra_", v, ".png")),
plot = p_bar, width = 7, height = 5, dpi = 150)
ggsave(filename = file.path("graficas", paste0("pastel_", v, ".png")),
plot = p_pie, width = 6, height = 6, dpi = 150)
}
# 4) Graficar numéricas: Histograma + Boxplot ---------------------------
for (v in vars_num) {
titulo <- stringr::str_to_sentence(gsub("_", " ", v))
p_hist <- ggplot(df, aes(x = .data[[v]])) +
geom_histogram(bins = 20, color = "white") +
labs(title = paste0("Histograma: ", titulo), x = v, y = "Frecuencia") +
theme_minimal()
p_box <- ggplot(df, aes(y = .data[[v]])) +
geom_boxplot(outlier.alpha = 0.5) +
labs(title = paste0("Boxplot: ", titulo), x = NULL, y = v) +
theme_minimal()
print(p_hist)
print(p_box)
ggsave(filename = file.path("graficas", paste0("hist_", v, ".png")),
plot = p_hist, width = 7, height = 5, dpi = 150)
ggsave(filename = file.path("graficas", paste0("box_", v, ".png")),
plot = p_box, width = 5, height = 5, dpi = 150)
}
