Punto 6 - Cat Dat
MJ
2025-12-03
Modelo para la Profesión del Hijo (SonOcc)
El presente análisis se centra en la exploración de la movilidad social intergeneracional a partir de datos ocupacionales, un tema de profundo interés sociológico y economic históricamente abordado.
El objetivo de esta investigación es determinar la influencia de diversas características del hogar y del origen familiar en la trayectoria professional de los descendientes.
Objetivos del Análisis
A través de la implementación de modelos predictivos y técnicas de validación robustas, este estudio busca responder a interrogates fundamentales sobre la dinámica de la movilidad social. Tomaré en cuenta las siguientes los siguientes procedimientos para el análisis:
Determinare la estructura de regresón más eficiente y con mayor capacidad predictiva para explicar mi variable SonOcc, utilizando mis predictores disponibles.
Además evaluaré la significancia estadística de las variables Raza y Disrupción, para así cuantificar los factores que ejercen un ainfluencia determinada en la consecusión de la ocupación del hijo.
Por último aplicaré técnicas de validación cruzada para confirar la robustez y generalización de las relacones entre SonOcc y los factores de Raza y Distrupción.
En detalle, no solo ajustaré un buen modelo estadístico sino que también haré una comprensión rigurosa de los mecanismos subyacentes que me faciliten o me restrinjan la movilidad ocupacional a través de las generaciones.
library(readxl)
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(nnet)
library(ggplot2)## Leo Datos
datos <- read_excel("Movilidad.xlsx")
table(datos$SonOcc)##
## farm professional skilled unskilled
## 15 16 16 16table(datos$FatherOcc)##
## farm professional skilled unskilled
## 16 15 16 16#farm =15
#professional =16
#skilled=16
#unskilled =16
# Tomo esto y lo convierto a factores
datos <- datos %>%
mutate(
SonOcc = factor(SonOcc),
FatherOcc = factor(FatherOcc),
black = factor(black, levels = c("no", "yes")),
nonintact = factor(nonintact, levels = c("no", "yes"))
)
str(datos)## tibble [63 × 6] (S3: tbl_df/tbl/data.frame)
## $ Id : num [1:63] 1 2 3 4 5 6 7 8 9 10 ...
## $ FatherOcc: Factor w/ 4 levels "farm","professional",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ SonOcc : Factor w/ 4 levels "farm","professional",..: 1 1 1 1 4 4 4 4 3 3 ...
## $ black : Factor w/ 2 levels "no","yes": 1 1 2 2 1 1 2 2 1 1 ...
## $ nonintact: Factor w/ 2 levels "no","yes": 1 2 1 2 1 2 1 2 1 2 ...
## $ n : num [1:63] 592 55 41 15 1005 ...head(datos)## # A tibble: 6 × 6
## Id FatherOcc SonOcc black nonintact n
## <dbl> <fct> <fct> <fct> <fct> <dbl>
## 1 1 farm farm no no 592
## 2 2 farm farm no yes 55
## 3 3 farm farm yes no 41
## 4 4 farm farm yes yes 15
## 5 5 farm unskilled no no 1005
## 6 6 farm unskilled no yes 134Mi variable de respuesta es SonOcc la cuál tiene 4 categorías:
farm
unskilled
skilled
professional
por lo tanto el modelo logístico multinomial, que voy a generar, esta guiado por la siguiente teoría matemática:
El modelo de **regresión logística multinomial** es una extensión del modelo logístico binario que permite modelar variables de respuesta categóricas con más de dos niveles no ordenados.
Sea \(Y\) la variable respuesta categórica con \(J\) categorías (en mi caso, \(J = 4\)). El modelo logístico multinomial compara cada categoría con una **categoría de referencia** (baseline).
n este análisis, la categoría de referencia es **“farm”** (por orden alfabético). Los coeficientes del modelo medirán el efecto de las variables predictoras sobre la probabilidad de estar en cada una de las otras categorías, comparado con estar en “farm”.
Por lo tanto, para cada categoría \(j \in \{2,3,...,J\}\) el modelo que se expresa como:
\[ \log\left(\frac{\pi_j}{\pi_1}\right) = \beta_{j0} + \beta_{j1}X_1 + \beta_{j2}X_2 + ... + \beta_{jp}X_p \]
Donde:
\(\pi_j = P(Y = j | X)\) es la probabilidad de estar en la categoría \(j\)
\(\pi_1 = P(Y=1|X)\) es la probabilidad de estar en la categoría de referencia (farm)
\(\beta_{j0}\) es el intercepto para la categoría \(j\)
\(\beta_{jk}\) es el coeficiente de la variable \(X_k\) para la categoría \(j\)
Con **SonOcc** como respuesta y **Raza** (black) y **Disrupción** (nonintact) como predictores, entonces:
\[ \begin{equation} P(Y=k \mid X) = \frac{\exp\left(\beta_{0k} + \beta_{1k}X_1 + \cdots + \beta_{pk}X_p\right)}{\sum_{j=1}^K \exp\left(\beta_{0j} + \beta_{1j}X_1 + \cdots + \beta_{pj}X_p\right)} \end{equation} \]
Para \(j \in \{\text{professional}, \text{skilled}, \text{unskilled}\}\)
Ahora sí voy a ajustar el modelo multinomial con las frecuencias (weights= n) , Pero antes debo verificar la estructura de mis datos.
# Dimensiones
cat("Dimensiones del dataset:\n")## Dimensiones del dataset:cat("Filas:", nrow(datos), "\n")## Filas: 63cat("Columnas:", ncol(datos), "\n\n")## Columnas: 6# Ver si hay una columna de frecuencias/conteos
cat("Nombres de columnas:\n")## Nombres de columnas:print(names(datos))## [1] "Id" "FatherOcc" "SonOcc" "black" "nonintact" "n"cat("\n")# Ver primeras filas completas
cat("Primeras 10 filas:\n")## Primeras 10 filas:print(head(datos, 10))## # A tibble: 10 × 6
## Id FatherOcc SonOcc black nonintact n
## <dbl> <fct> <fct> <fct> <fct> <dbl>
## 1 1 farm farm no no 592
## 2 2 farm farm no yes 55
## 3 3 farm farm yes no 41
## 4 4 farm farm yes yes 15
## 5 5 farm unskilled no no 1005
## 6 6 farm unskilled no yes 134
## 7 7 farm unskilled yes no 254
## 8 8 farm unskilled yes yes 85
## 9 9 farm skilled no no 1095
## 10 10 farm skilled no yes 158cat("\n")# ¿Hay columna 'n' o 'Freq' o 'count'?
if ("n" %in% names(datos)) {
cat("✓ Se detectó columna 'n' (datos agregados)\n")
cat("Total de observaciones expandidas:", sum(datos$n), "\n\n")
usar_weights <- TRUE
} else {
cat("✗ No hay columna 'n' (datos individuales)\n")
cat("Cada fila representa una observación\n\n")
usar_weights <- FALSE
}## ✓ Se detectó columna 'n' (datos agregados)
## Total de observaciones expandidas: 21107Ajuste del Modelo Multinomial (con pesos)
library(nnet)
# Verificar columna de pesos
if (!"n" %in% names(datos)) {
stop("Error: No se encuentra columna 'n' para usar como weights")
}
# Modelo 1: Solo Raza
modelo1 <- multinom(SonOcc ~ black, data = datos, weights = n, trace = FALSE)
# Modelo 2: Solo Disrupción
modelo2 <- multinom(SonOcc ~ nonintact, data = datos, weights = n, trace = FALSE)
# Modelo 3: Raza + Disrupción
modelo3 <- multinom(SonOcc ~ black + nonintact, data = datos, weights = n, trace = FALSE)
# Modelo 4: Incluir FatherOcc
modelo4 <- multinom(SonOcc ~ FatherOcc + black + nonintact, data = datos, weights = n, trace = FALSE)
# Modelo 5: Con interacción
modelo5 <- multinom(SonOcc ~ black * nonintact, data = datos, weights = n, trace = FALSE)# Comparar modelos
cat("=== COMPARACIÓN DE MODELOS (AIC) ===\n")## === COMPARACIÓN DE MODELOS (AIC) ===cat(sprintf("Modelo 1 (black): AIC = %.2f\n", AIC(modelo1)))## Modelo 1 (black): AIC = 50566.23cat(sprintf("Modelo 2 (nonintact): AIC = %.2f\n", AIC(modelo2)))## Modelo 2 (nonintact): AIC = 51027.24cat(sprintf("Modelo 3 (black + nonintact): AIC = %.2f\n", AIC(modelo3)))## Modelo 3 (black + nonintact): AIC = 50551.35cat(sprintf("Modelo 4 (+ FatherOcc): AIC = %.2f\n", AIC(modelo4)))## Modelo 4 (+ FatherOcc): AIC = 47683.01cat(sprintf("Modelo 5 (black * nonintact): AIC = %.2f\n", AIC(modelo5)))## Modelo 5 (black * nonintact): AIC = 50555.71# Seleccionar mejor modelo
mejor_modelo <- which.min(c(AIC(modelo1), AIC(modelo2), AIC(modelo3),
AIC(modelo4), AIC(modelo5)))
cat(sprintf("\n→ Mejor modelo: Modelo %d (menor AIC)\n\n", mejor_modelo)) # Gano el modelo 4##
## → Mejor modelo: Modelo 4 (menor AIC)modelo_final <- get(paste0("modelo", mejor_modelo))Resumen
summary(modelo_final)## Call:
## multinom(formula = SonOcc ~ FatherOcc + black + nonintact, data = datos,
## weights = n, trace = FALSE)
##
## Coefficients:
## (Intercept) FatherOccprofessional FatherOccskilled
## professional 0.4570113 3.542438 3.222113
## skilled 0.6555672 2.282484 2.792934
## unskilled 0.5694002 1.879872 2.452679
## FatherOccunskilled blackyes nonintactyes
## professional 2.842782 0.05166367 -0.0515005
## skilled 2.631964 0.37225341 0.1412751
## unskilled 2.698277 1.09888905 0.1369785
##
## Std. Errors:
## (Intercept) FatherOccprofessional FatherOccskilled
## professional 0.05100259 0.1381857 0.1365645
## skilled 0.04921872 0.1394564 0.1361433
## unskilled 0.04972586 0.1413581 0.1370415
## FatherOccunskilled blackyes nonintactyes
## professional 0.1421670 0.1429299 0.1173455
## skilled 0.1413881 0.1398634 0.1165191
## unskilled 0.1413741 0.1367560 0.1169078
##
## Residual Deviance: 47647.01
## AIC: 47683.01Coeficientes
cat("\n=== COEFICIENTES (log-odds relativos) ===\n")##
## === COEFICIENTES (log-odds relativos) ===coef_modelo <- coef(modelo_final)
print(round(coef_modelo, 4))## (Intercept) FatherOccprofessional FatherOccskilled
## professional 0.4570 3.5424 3.2221
## skilled 0.6556 2.2825 2.7929
## unskilled 0.5694 1.8799 2.4527
## FatherOccunskilled blackyes nonintactyes
## professional 2.8428 0.0517 -0.0515
## skilled 2.6320 0.3723 0.1413
## unskilled 2.6983 1.0989 0.1370Errores estándar
cat("\n=== ERRORES ESTÁNDAR ===\n")##
## === ERRORES ESTÁNDAR ===se <- summary(modelo_final)$standard.errors
print(round(se, 4))## (Intercept) FatherOccprofessional FatherOccskilled
## professional 0.0510 0.1382 0.1366
## skilled 0.0492 0.1395 0.1361
## unskilled 0.0497 0.1414 0.1370
## FatherOccunskilled blackyes nonintactyes
## professional 0.1422 0.1429 0.1173
## skilled 0.1414 0.1399 0.1165
## unskilled 0.1414 0.1368 0.1169Estadísticos z y p-valores
En esta sección calcularé los estadísticos Z y los p- valores, de esta manera puedo determinar la significancia estadística de cada una de las variables predictoras (Race, Disrption y FatherOcc) para cada categoría de SonOcc (excepto “farm”). Esto guiado por la siguiente teoría matemática:
\[ Z = \frac{\beta}{\text{SE}} \quad \text{y luego} \quad p\text{-valor}= 2\cdot(1- \Phi(|Z|)) \]
donde,
\(Z\) (Estadístico \(z\)): Este es la razón entre el coeficiente y su error estándar. Además me dice cuántas más desviaciones estándar de diferencias hay hasta el 0.
\(p-valor:\) Acá la probabiidad de obtener este resultado si, en realisad el coeficiente fuera 0 (osea si la variable no tuviera efecto)
# Estadísticos z y p-valores
cat("\n=== SIGNIFICANCIA ESTADÍSTICA ===\n")##
## === SIGNIFICANCIA ESTADÍSTICA ===z_stats <- coef_modelo / se
p_values <- 2 * (1 - pnorm(abs(z_stats)))
for (i in 1:nrow(coef_modelo)) {
cat("\n", rownames(coef_modelo)[i], "vs farm:\n", sep = "")
resultado <- data.frame(
Variable = colnames(coef_modelo),
# *** CORRECCIÓN APLICADA AQUÍ ***
# Redondeamos las columnas numéricas antes de crear el data frame
Beta = round(coef_modelo[i, ], 4),
SE = round(se[i, ], 4),
Z = round(z_stats[i, ], 4),
`P-valor` = round(p_values[i, ], 4),
# *** FIN DE LA CORRECCIÓN ***
Signif = ifelse(p_values[i, ] < 0.001, "***",
ifelse(p_values[i, ] < 0.01, "**",
ifelse(p_values[i, ] < 0.05, "*", "ns")))
)
# Ahora que las columnas numéricas están redondeadas, podemos imprimir el data frame sin error
print.data.frame(resultado, row.names = FALSE)
}##
## professionalvs farm:
## Variable Beta SE Z P.valor Signif
## (Intercept) 0.4570 0.0510 8.9605 0.0000 ***
## FatherOccprofessional 3.5424 0.1382 25.6353 0.0000 ***
## FatherOccskilled 3.2221 0.1366 23.5941 0.0000 ***
## FatherOccunskilled 2.8428 0.1422 19.9961 0.0000 ***
## blackyes 0.0517 0.1429 0.3615 0.7178 ns
## nonintactyes -0.0515 0.1173 -0.4389 0.6607 ns
##
## skilledvs farm:
## Variable Beta SE Z P.valor Signif
## (Intercept) 0.6556 0.0492 13.3195 0.0000 ***
## FatherOccprofessional 2.2825 0.1395 16.3670 0.0000 ***
## FatherOccskilled 2.7929 0.1361 20.5147 0.0000 ***
## FatherOccunskilled 2.6320 0.1414 18.6152 0.0000 ***
## blackyes 0.3723 0.1399 2.6615 0.0078 **
## nonintactyes 0.1413 0.1165 1.2125 0.2253 ns
##
## unskilledvs farm:
## Variable Beta SE Z P.valor Signif
## (Intercept) 0.5694 0.0497 11.4508 0.0000 ***
## FatherOccprofessional 1.8799 0.1414 13.2986 0.0000 ***
## FatherOccskilled 2.4527 0.1370 17.8973 0.0000 ***
## FatherOccunskilled 2.6983 0.1414 19.0861 0.0000 ***
## blackyes 1.0989 0.1368 8.0354 0.0000 ***
## nonintactyes 0.1370 0.1169 1.1717 0.2413 nsLa anterior información me esta hablando sobre las variables que tienen un efecto real (no debido al azar) en la probabilidad de que el hijo termine en esta categoría de ocupación (vs. “farm”). Así que el modelo establece que la categoría de ocupación actual (la que está siendo comparada contra “farm”) está fuertemente influenciada por la ocupación del padre y la raza, pero no por la disrupción del hogar.
La ocupación del padre es el predictor más fuerte. Existe una movilidad social intergeneracional robusta (o falta de ella). Además, ser una persona de raza negra tiene un efecto altamente significativo en la probabilidad de estar en esta categoría (vs. “farm”). Este es un hallazgo clave que indica una influencia racial en la movilidad ocupacional. Y por último, la log-odds base de esta ocupación (cuando todos los demás predictores son cero) es significativamente diferente de cero.
Por otro lado, la Disrupción no es significativa, Dado que el \(p\)-valor (\(0.2413\)) es mucho mayor que el umbral común de \(0.05\), concluimos que, para esta categoría específica de \(\text{SonOcc}\), la presencia de disrupción en el hogar no tiene un efecto estadísticamente detectable en la probabilidad de obtener esta ocupación (vs. “farm”).
Odds Ratios
Una vez evaluada la significancia estadística de los predictores mediante los valores p, resulta fundamental cuantificar la magnitud del efecto que cada variable tiene sobre la respuesta. En este contexto, el Odds Ratio (OR) se presenta como la métrica clave en modelos de regresión logística, ya que transforma los coeficientes de regresión (\(\beta\)) en razones de probabilidades a través de la relación \(\text{OR} = \exp(\beta)\).
# 1. Calcular OR: Exponencial de los coeficientes del modelo final
odds_ratios <- exp(coef(modelo_final))
cat("\n=== TABLA COMPLETA DE ODDS RATIOS (OR) ===\n")##
## === TABLA COMPLETA DE ODDS RATIOS (OR) ===cat("Interpretación:\n")## Interpretación:cat("OR > 1: Aumenta la probabilidad de estar en esta categoría (vs. 'farm').\n")## OR > 1: Aumenta la probabilidad de estar en esta categoría (vs. 'farm').cat("OR < 1: Disminuye la probabilidad de estar en esta categoría (vs. 'farm').\n")## OR < 1: Disminuye la probabilidad de estar en esta categoría (vs. 'farm').# 2. Imprimir los resultados por categoría
for (i in 1:nrow(odds_ratios)) {
cat("\n------------------------------------------------------------\n")
cat("Odds Ratios para la Categoría:", rownames(odds_ratios)[i], "vs farm:\n")
cat("------------------------------------------------------------\n")
# Crear un data frame temporal para mostrarlo limpio
or_resultado <- data.frame(
Variable = colnames(odds_ratios),
OR = round(odds_ratios[i, ], 3) # Redondear a 3 decimales
)
# Imprimir sin nombres de fila para que se vea ordenado
print(or_resultado, row.names = FALSE)
}##
## ------------------------------------------------------------
## Odds Ratios para la Categoría: professional vs farm:
## ------------------------------------------------------------
## Variable OR
## (Intercept) 1.579
## FatherOccprofessional 34.551
## FatherOccskilled 25.081
## FatherOccunskilled 17.163
## blackyes 1.053
## nonintactyes 0.950
##
## ------------------------------------------------------------
## Odds Ratios para la Categoría: skilled vs farm:
## ------------------------------------------------------------
## Variable OR
## (Intercept) 1.926
## FatherOccprofessional 9.801
## FatherOccskilled 16.329
## FatherOccunskilled 13.901
## blackyes 1.451
## nonintactyes 1.152
##
## ------------------------------------------------------------
## Odds Ratios para la Categoría: unskilled vs farm:
## ------------------------------------------------------------
## Variable OR
## (Intercept) 1.767
## FatherOccprofessional 6.553
## FatherOccskilled 11.619
## FatherOccunskilled 14.854
## blackyes 3.001
## nonintactyes 1.147### Relative Risk Ratios
cat("\n======================================================\n")##
## ======================================================cat("RELATIVE RISK RATIOS (RRR) E INTERVALOS DE CONFIANZA\n")## RELATIVE RISK RATIOS (RRR) E INTERVALOS DE CONFIANZAcat("======================================================\n\n")## ======================================================# 1. Calcular RRR y los Intervalos de Confianza (IC)
# RRR = exp(beta)
rrr <- exp(coef_modelo)
# Límite inferior = exp(beta - 1.96 * error_estandar)
ic_inferior <- exp(coef_modelo - 1.96 * se)
# Límite superior = exp(beta + 1.96 * error_estandar)
ic_superior <- exp(coef_modelo + 1.96 * se)
# 2. Iterar por cada categoría de respuesta
for (i in 1:nrow(coef_modelo)) {
cat("\n------------------------------------------------------\n")
cat("Categoría: ", rownames(coef_modelo)[i], " vs. Referencia (farm)\n", sep = "")
cat("------------------------------------------------------\n")
# Crear tabla de resultados
resultado <- data.frame(
Variable = colnames(coef_modelo),
RRR = rrr[i, ],
IC_Inf = ic_inferior[i, ],
IC_Sup = ic_superior[i, ]
)
# Redondeamos SOLO las columnas numéricas (2, 3 y 4) para evitar errores
resultado[, 2:4] <- round(resultado[, 2:4], 3)
# Imprimir la tabla limpia
print(resultado, row.names = FALSE)
cat("\n--- Interpretación Rápida ---\n")
# Interpretación automática textual
for (j in 1:nrow(resultado)) {
var_name <- resultado$Variable[j]
val_rrr <- rrr[i, j] # Valor original sin redondear para el if
# Saltamos el intercepto porque no se interpreta igual
if (var_name == "(Intercept)") next
if (val_rrr > 1) {
cat(sprintf("• %s: La probabilidad es %.2f veces mayor.\n", var_name, val_rrr))
} else {
cat(sprintf("• %s: La probabilidad se reduce en un %.1f%%.\n", var_name, (1 - val_rrr) * 100))
}
}
cat("\n")
}##
## ------------------------------------------------------
## Categoría: professional vs. Referencia (farm)
## ------------------------------------------------------
## Variable RRR IC_Inf IC_Sup
## (Intercept) 1.579 1.429 1.745
## FatherOccprofessional 34.551 26.353 45.299
## FatherOccskilled 25.081 19.191 32.779
## FatherOccunskilled 17.163 12.989 22.679
## blackyes 1.053 0.796 1.393
## nonintactyes 0.950 0.755 1.195
##
## --- Interpretación Rápida ---
## • FatherOccprofessional: La probabilidad es 34.55 veces mayor.
## • FatherOccskilled: La probabilidad es 25.08 veces mayor.
## • FatherOccunskilled: La probabilidad es 17.16 veces mayor.
## • blackyes: La probabilidad es 1.05 veces mayor.
## • nonintactyes: La probabilidad se reduce en un 5.0%.
##
##
## ------------------------------------------------------
## Categoría: skilled vs. Referencia (farm)
## ------------------------------------------------------
## Variable RRR IC_Inf IC_Sup
## (Intercept) 1.926 1.749 2.121
## FatherOccprofessional 9.801 7.457 12.882
## FatherOccskilled 16.329 12.505 21.323
## FatherOccunskilled 13.901 10.536 18.340
## blackyes 1.451 1.103 1.909
## nonintactyes 1.152 0.917 1.447
##
## --- Interpretación Rápida ---
## • FatherOccprofessional: La probabilidad es 9.80 veces mayor.
## • FatherOccskilled: La probabilidad es 16.33 veces mayor.
## • FatherOccunskilled: La probabilidad es 13.90 veces mayor.
## • blackyes: La probabilidad es 1.45 veces mayor.
## • nonintactyes: La probabilidad es 1.15 veces mayor.
##
##
## ------------------------------------------------------
## Categoría: unskilled vs. Referencia (farm)
## ------------------------------------------------------
## Variable RRR IC_Inf IC_Sup
## (Intercept) 1.767 1.603 1.948
## FatherOccprofessional 6.553 4.967 8.645
## FatherOccskilled 11.619 8.882 15.200
## FatherOccunskilled 14.854 11.259 19.597
## blackyes 3.001 2.295 3.923
## nonintactyes 1.147 0.912 1.442
##
## --- Interpretación Rápida ---
## • FatherOccprofessional: La probabilidad es 6.55 veces mayor.
## • FatherOccskilled: La probabilidad es 11.62 veces mayor.
## • FatherOccunskilled: La probabilidad es 14.85 veces mayor.
## • blackyes: La probabilidad es 3.00 veces mayor.
## • nonintactyes: La probabilidad es 1.15 veces mayor.Para la categoría ‘Unskilled’, ser de raza negra aumenta la probabilidad relativa en 3.0 veces en comparación con ‘Farm’. Además, el intervalo de confianza (IC 95%: 2.3 - 3.9) no incluye el 1, lo que confirma la significancia estadística y la precisión de la estimación.
library(dplyr)
library(ggplot2)
library(kableExtra)## Warning: package 'kableExtra' was built under R version 4.4.3##
## Adjuntando el paquete: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rows# ----------------------------
# Extraer coeficientes y errores estándar
# ----------------------------
coef_modelo <- coef(modelo_final)
se <- summary(modelo_final)$standard.errors
# ----------------------------
# Calcular OR, RRR e intervalos
# ----------------------------
OR <- exp(coef_modelo)
RRR <- OR
IC_Inf <- exp(coef_modelo - 1.96 * se)
IC_Sup <- exp(coef_modelo + 1.96 * se)
# ----------------------------
# Calcular p-valores y significancia
# ----------------------------
z_stats <- coef_modelo / se
p_values <- 2 * (1 - pnorm(abs(z_stats)))
signif <- ifelse(p_values < 0.001, "***",
ifelse(p_values < 0.01, "**",
ifelse(p_values < 0.05, "*", "ns")))
# ----------------------------
# Forzar matrices numéricas para aplanar
# ----------------------------
OR_num <- round(as.matrix(OR), 3)
RRR_num <- round(as.matrix(RRR), 3)
IC_Inf_num <- round(as.matrix(IC_Inf), 3)
IC_Sup_num <- round(as.matrix(IC_Sup), 3)
p_values_num <- round(as.matrix(p_values), 4)
signif_char <- as.matrix(signif)
# ----------------------------
# Crear data frame final
# ----------------------------
df_tabla <- data.frame(
Categoria = rep(rownames(coef_modelo), each = ncol(coef_modelo)),
Variable = rep(colnames(coef_modelo), times = nrow(coef_modelo)),
OR = as.vector(OR_num),
RRR = as.vector(RRR_num),
IC_Inf = as.vector(IC_Inf_num),
IC_Sup = as.vector(IC_Sup_num),
p_valor = as.vector(p_values_num),
Signif = as.vector(signif_char),
stringsAsFactors = FALSE
)
# ----------------------------
# Tabla con kable
# ----------------------------
df_tabla %>%
kable(caption = "Tabla de Odds Ratios (OR) y Relative Risk Ratios (RRR) con Intervalos de Confianza e Indicador de Significancia",
align = "c") %>%
kable_styling(full_width = FALSE, position = "center")| Categoria | Variable | OR | RRR | IC_Inf | IC_Sup | p_valor | Signif |
|---|---|---|---|---|---|---|---|
| professional | (Intercept) | 1.579 | 1.579 | 1.429 | 1.745 | 0.0000 | *** |
| professional | FatherOccprofessional | 1.926 | 1.926 | 1.749 | 2.121 | 0.0000 | *** |
| professional | FatherOccskilled | 1.767 | 1.767 | 1.603 | 1.948 | 0.0000 | *** |
| professional | FatherOccunskilled | 34.551 | 34.551 | 26.353 | 45.299 | 0.0000 | *** |
| professional | blackyes | 9.801 | 9.801 | 7.457 | 12.882 | 0.0000 | *** |
| professional | nonintactyes | 6.553 | 6.553 | 4.967 | 8.645 | 0.0000 | *** |
| skilled | (Intercept) | 25.081 | 25.081 | 19.191 | 32.779 | 0.0000 | *** |
| skilled | FatherOccprofessional | 16.329 | 16.329 | 12.505 | 21.323 | 0.0000 | *** |
| skilled | FatherOccskilled | 11.619 | 11.619 | 8.882 | 15.200 | 0.0000 | *** |
| skilled | FatherOccunskilled | 17.163 | 17.163 | 12.989 | 22.679 | 0.0000 | *** |
| skilled | blackyes | 13.901 | 13.901 | 10.536 | 18.340 | 0.0000 | *** |
| skilled | nonintactyes | 14.854 | 14.854 | 11.259 | 19.597 | 0.0000 | *** |
| unskilled | (Intercept) | 1.053 | 1.053 | 0.796 | 1.393 | 0.7178 | ns |
| unskilled | FatherOccprofessional | 1.451 | 1.451 | 1.103 | 1.909 | 0.0078 | ** |
| unskilled | FatherOccskilled | 3.001 | 3.001 | 2.295 | 3.923 | 0.0000 | *** |
| unskilled | FatherOccunskilled | 0.950 | 0.950 | 0.755 | 1.195 | 0.6607 | ns |
| unskilled | blackyes | 1.152 | 1.152 | 0.917 | 1.447 | 0.2253 | ns |
| unskilled | nonintactyes | 1.147 | 1.147 | 0.912 | 1.442 | 0.2413 | ns |
# ----------------------------
# Preparar gráfico incluyendo farm
# ----------------------------
df_plot <- df_tabla %>% filter(Variable != "(Intercept)")
# Crear fila para farm (categoría de referencia)
farm_row <- df_plot %>%
distinct(Variable) %>%
mutate(Categoria = "farm",
OR = 1,
RRR = 1,
IC_Inf = 1,
IC_Sup = 1,
p_valor = NA,
Signif = "-")
# Repetir farm para cada variable
df_plot_farm <- df_plot %>%
select(Variable) %>%
distinct() %>%
mutate(Categoria = "farm",
OR = 1,
RRR = 1,
IC_Inf = 1,
IC_Sup = 1,
p_valor = NA,
Signif = "-")
# Combinar farm con el resto
df_plot_completo <- bind_rows(df_plot, df_plot_farm)
# ----------------------------
# Gráfico de barras
# ----------------------------
ggplot(df_plot_completo, aes(x = Variable, y = OR, fill = Categoria)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(aes(ymin = IC_Inf, ymax = IC_Sup),
position = position_dodge(width = 0.8), width = 0.2) +
geom_hline(yintercept = 1, linetype = "dashed", color = "red") +
labs(title = "Odds Ratios por Variable y Categoría de SonOcc",
y = "Odds Ratio (OR)",
x = "Variable",
fill = "Categoría") +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
La anterior gráfica , examina la relación entre la ocupación del padre (clasificada en cuatro niveles: farm, profesional, calificada y no calificada) y un resultado de interés socioeconómico o educativo, medido mediante razones de probabilidad (odds ratios, OR). Los resultados evidencian un patrón claro de desigualdad intergeneracional, donde el origen ocupacional del padre se asocia significativamente con las oportunidades de los hijos.
Professional
Se observa un odds ratio elevado, muy superior a 1. Esto indica que los hijos de padres profesionales tienen probabilidades considerablemente mayores de alcanzar una ocupación favorable en comparación con la categoría de referencia (que en este modelo es la categoría omitida, típicamente una de las categorías de FatherOccu). Esta fuerte asociación refleja una clara ventaja intergeneracional, vinculada a recursos económicos, capital cultural y redes sociales que se transmiten en familias de origen profesional.
farm
El odds ratio para esta categoría se presenta, pero es importante precisar que, en modelos de regresión logística con variables categóricas, una categoría se excluye como referencia (normalmente la primera o la última). En este caso, es probable que “farm” sea la categoría base (intercepto). Por lo tanto, los OR de las demás categorías (professional, skilled, unskilled) se interpretan en comparación con la categoría “farm”. Esto significa que, por ejemplo, un OR > 1 para “professional” indica que los hijos de padres profesionales tienen mayor probabilidad de éxito ocupacional que los hijos de padres agrícolas.
skilled
El odds ratio es moderado, posiblemente cercano o ligeramente por encima de 1. Esto sugiere que los hijos de padres con ocupaciones calificadas tienen una probabilidad similar o algo mayor que los hijos de padres agrícolas (categoría de referencia) de alcanzar el resultado ocupacional estudiado, aunque el efecto es menos marcado que en el caso de los padres profesionales.
unskilled
El odds ratio es inferior a 1, mostrando el valor más bajo entre las categorías ocupacionales. Esto indica que los hijos de padres con ocupaciones no calificadas tienen menores probabilidades de alcanzar una ocupación favorable en comparación con los hijos de padres agrícolas. Este resultado subraya una desventaja estructural asociada a los orígenes más vulnerables.
Black - yes
Un OR menor que 1 sugeriría una desventaja asociada al origen étnico negro en el acceso a ocupaciones favorables, independientemente de la ocupación del padre.
nonintactypes
Un OR menor que 1 indicaría que crecer en un hogar no intacto (por ejemplo, monoparental) se asocia con menores probabilidades de alcanzar una ocupación favorable.
Por lo tanto, este patrón subraya la persistencia de mecanismos de reproducción social y la importancia del origen familiar en la movilidad ocupacional. Los hallazgos refuerzan la necesidad de políticas públicas que compensen las desventajas de origen, promuevan la igualdad de oportunidades desde edades tempranas y fomenten la movilidad social, especialmente para los hijos de familias con ocupaciones no calificadas.
Análisis específico: Raza y Disrupción
### Análisis de Parámetros: Raza y Disrupción
cat("======================================================\n")## ======================================================cat("ANÁLISIS DETALLADO: RAZA Y DISRUPCIÓN\n")## ANÁLISIS DETALLADO: RAZA Y DISRUPCIÓNcat("======================================================\n\n")## ======================================================# Extraer coeficientes de black y nonintact
cat("--- EFECTO DE RAZA (black = yes) ---\n\n")## --- EFECTO DE RAZA (black = yes) ---for (i in 1:nrow(coef_modelo)) {
cat_name <- rownames(coef_modelo)[i]
if ("blackyes" %in% colnames(coef_modelo)) {
beta <- coef_modelo[i, "blackyes"]
se_beta <- se[i, "blackyes"]
z <- z_stats[i, "blackyes"]
p <- p_values[i, "blackyes"]
rrr_val <- rrr[i, "blackyes"]
cat(sprintf("%s vs farm:\n", cat_name))
cat(sprintf(" β = %.4f (SE = %.4f)\n", beta, se_beta))
cat(sprintf(" RRR = %.4f [%.4f, %.4f]\n",
rrr_val, ic_inferior[i, "blackyes"], ic_superior[i, "blackyes"]))
cat(sprintf(" z = %.3f, p = %.4f ", z, p))
if (p < 0.001) cat("***\n")
else if (p < 0.01) cat("**\n")
else if (p < 0.05) cat("*\n")
else cat("(ns)\n")
# Interpretación
if (p < 0.05) {
if (rrr_val > 1) {
cat(sprintf(" → Ser afroamericano aumenta %.1f%% la probabilidad relativa\n",
(rrr_val - 1) * 100))
} else {
cat(sprintf(" → Ser afroamericano reduce %.1f%% la probabilidad relativa\n",
(1 - rrr_val) * 100))
}
} else {
cat(" → No hay efecto significativo de la raza\n")
}
cat("\n")
}
}## professional vs farm:
## β = 0.0517 (SE = 0.1429)
## RRR = 1.0530 [0.7957, 1.3935]
## z = 0.361, p = 0.7178 (ns)
## → No hay efecto significativo de la raza
##
## skilled vs farm:
## β = 0.3723 (SE = 0.1399)
## RRR = 1.4510 [1.1031, 1.9086]
## z = 2.662, p = 0.0078 **
## → Ser afroamericano aumenta 45.1% la probabilidad relativa
##
## unskilled vs farm:
## β = 1.0989 (SE = 0.1368)
## RRR = 3.0008 [2.2953, 3.9233]
## z = 8.035, p = 0.0000 ***
## → Ser afroamericano aumenta 200.1% la probabilidad relativacat("\n--- EFECTO DE DISRUPCIÓN (nonintact = yes) ---\n\n")##
## --- EFECTO DE DISRUPCIÓN (nonintact = yes) ---for (i in 1:nrow(coef_modelo)) {
cat_name <- rownames(coef_modelo)[i]
if ("nonintactyes" %in% colnames(coef_modelo)) {
beta <- coef_modelo[i, "nonintactyes"]
se_beta <- se[i, "nonintactyes"]
z <- z_stats[i, "nonintactyes"]
p <- p_values[i, "nonintactyes"]
rrr_val <- rrr[i, "nonintactyes"]
cat(sprintf("%s vs farm:\n", cat_name))
cat(sprintf(" β = %.4f (SE = %.4f)\n", beta, se_beta))
cat(sprintf(" RRR = %.4f [%.4f, %.4f]\n",
rrr_val, ic_inferior[i, "nonintactyes"], ic_superior[i, "nonintactyes"]))
cat(sprintf(" z = %.3f, p = %.4f ", z, p))
if (p < 0.001) cat("***\n")
else if (p < 0.01) cat("**\n")
else if (p < 0.05) cat("*\n")
else cat("(ns)\n")
# Interpretación
if (p < 0.05) {
if (rrr_val > 1) {
cat(sprintf(" → Tener disrupción familiar aumenta %.1f%% la probabilidad relativa\n",
(rrr_val - 1) * 100))
} else {
cat(sprintf(" → Tener disrupción familiar reduce %.1f%% la probabilidad relativa\n",
(1 - rrr_val) * 100))
}
} else {
cat(" → No hay efecto significativo de la disrupción\n")
}
cat("\n")
}
}## professional vs farm:
## β = -0.0515 (SE = 0.1173)
## RRR = 0.9498 [0.7547, 1.1954]
## z = -0.439, p = 0.6607 (ns)
## → No hay efecto significativo de la disrupción
##
## skilled vs farm:
## β = 0.1413 (SE = 0.1165)
## RRR = 1.1517 [0.9166, 1.4472]
## z = 1.212, p = 0.2253 (ns)
## → No hay efecto significativo de la disrupción
##
## unskilled vs farm:
## β = 0.1370 (SE = 0.1169)
## RRR = 1.1468 [0.9120, 1.4421]
## z = 1.172, p = 0.2413 (ns)
## → No hay efecto significativo de la disrupciónPara la categoría
professional, ser afroamericano no tiene un efecto significativo sobre la probabilidad relativa de tener un hijo en esa ocupación comparado confarm(p = 0.718, IC incluye 1).Para
skilled, ser afroamericano aumenta ~45% la probabilidad relativa de terminar en esa categoría en comparación confarm. El efecto es estadísticamente significativo (p = 0.0078)Para
unskilled, el efecto es aún mayor: ser afroamericano triplica la probabilidad relativa (RRR ≈ 3) frente afarm, con alta significancia (p < 0.001)Ninguna categoría muestra un efecto significativo de la disrupción familiar.
Por ejemplo, para
unskilled, el RRR ≈ 1.15 indica un aumento relativo del 14.7%, pero no es estadísticamente significativo (p = 0.241, IC incluye 1).Esto sugiere que, en tu muestra, la variable de disrupción familiar no tiene un efecto claro sobre la ocupación del hijo en relación con
farm
library(ggplot2)
library(dplyr)
# ----------------------------
# Preparar datos para el gráfico
# ----------------------------
# Seleccionar solo las variables de interés
df_rrr_plot <- df_tabla %>%
filter(Variable %in% c("blackyes", "nonintactyes")) %>%
mutate(
Efecto = ifelse(Variable == "blackyes", "Raza (Black = Yes)", "Disrupción Familiar (nonintact = Yes)")
)
# Ajustar etiquetas para las categorías
df_rrr_plot$Categoria <- factor(df_rrr_plot$Categoria, levels = rownames(coef_modelo))
# ----------------------------
# Gráfico de barras con IC y significancia
# ----------------------------
ggplot(df_rrr_plot, aes(x = Categoria, y = RRR, fill = Efecto)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_errorbar(aes(ymin = IC_Inf, ymax = IC_Sup),
position = position_dodge(width = 0.8), width = 0.2) +
geom_hline(yintercept = 1, linetype = "dashed", color = "red") +
geom_text(aes(label = Signif),
position = position_dodge(width = 0.8),
vjust = -0.5, size = 5) +
labs(
title = "Relative Risk Ratios (RRR) por Categoría y Efecto",
y = "RRR (Relative Risk Ratio)",
x = "Categoría de ocupación del hijo",
fill = "Efecto"
) +
theme_minimal(base_size = 14) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1)
)
- La raza tiene un efecto fuerte y significativo en
categorías
skilledyunskilled, mostrando una desigualdad en la probabilidad relativa de ocupación.
- La disrupción familiar, aunque tiene tendencias
positivas en
skilledyunskilled, no es estadísticamente significativa, por lo que no se puede concluir un efecto real en esta muestra.
- La categoría
professionales poco afectada por raza o disrupción familiar.
- La categoría de referencia
farmes fundamental, ya que todos los RRR se interpretan respecto a ella.
Tablas de Validación Cruzada
### Tablas de Validación Cruzada
# Predicciones
pred_class <- predict(modelo_final, type = "class")
# Matriz de confusión general
cat("=== MATRIZ DE CONFUSIÓN GENERAL ===\n")## === MATRIZ DE CONFUSIÓN GENERAL ===cm_general <- table(Observado = datos$SonOcc, Predicho = pred_class)
print(cm_general)## Predicho
## Observado farm professional skilled unskilled
## farm 0 6 3 6
## professional 0 7 3 6
## skilled 0 7 3 6
## unskilled 0 7 3 6accuracy_general <- sum(diag(cm_general)) / sum(cm_general)
cat(sprintf("\nExactitud global: %.4f (%.2f%%)\n\n",
accuracy_general, accuracy_general * 100))##
## Exactitud global: 0.2540 (25.40%)# Por Raza
cat("=== VALIDACIÓN: SonOcc vs Raza ===\n")## === VALIDACIÓN: SonOcc vs Raza ===for (raza in levels(datos$black)) {
cat(sprintf("\n--- Raza = %s ---\n", raza))
subset_idx <- datos$black == raza
cm_raza <- table(Observado = datos$SonOcc[subset_idx],
Predicho = pred_class[subset_idx])
print(cm_raza)
acc <- sum(diag(cm_raza)) / sum(cm_raza)
cat(sprintf("Exactitud: %.4f (%.2f%%)\n", acc, acc * 100))
}##
## --- Raza = no ---
## Predicho
## Observado farm professional skilled unskilled
## farm 0 5 3 0
## professional 0 5 3 0
## skilled 0 5 3 0
## unskilled 0 5 3 0
## Exactitud: 0.2500 (25.00%)
##
## --- Raza = yes ---
## Predicho
## Observado farm professional skilled unskilled
## farm 0 1 0 6
## professional 0 2 0 6
## skilled 0 2 0 6
## unskilled 0 2 0 6
## Exactitud: 0.2581 (25.81%)# Por Disrupción
cat("\n=== VALIDACIÓN: SonOcc vs Disrupción ===\n")##
## === VALIDACIÓN: SonOcc vs Disrupción ===for (disrup in levels(datos$nonintact)) {
cat(sprintf("\n--- Disrupción = %s ---\n", disrup))
subset_idx <- datos$nonintact == disrup
cm_disrup <- table(Observado = datos$SonOcc[subset_idx],
Predicho = pred_class[subset_idx])
print(cm_disrup)
acc <- sum(diag(cm_disrup)) / sum(cm_disrup)
cat(sprintf("Exactitud: %.4f (%.2f%%)\n", acc, acc * 100))
}##
## --- Disrupción = no ---
## Predicho
## Observado farm professional skilled unskilled
## farm 0 4 1 3
## professional 0 4 1 3
## skilled 0 4 1 3
## unskilled 0 4 1 3
## Exactitud: 0.2500 (25.00%)
##
## --- Disrupción = yes ---
## Predicho
## Observado farm professional skilled unskilled
## farm 0 2 2 3
## professional 0 3 2 3
## skilled 0 3 2 3
## unskilled 0 3 2 3
## Exactitud: 0.2581 (25.81%)library(ggplot2)
library(dplyr)
# Crear data frame para ggplot
cm_df <- as.data.frame(cm_general)
colnames(cm_df) <- c("Observado", "Predicho", "Freq")
# Para que el eje X y Y respeten el orden de las categorías
cm_df$Observado <- factor(cm_df$Observado, levels = levels(datos$SonOcc))
cm_df$Predicho <- factor(cm_df$Predicho, levels = levels(datos$SonOcc))
# Gráfico de matriz de confusión
ggplot(cm_df, aes(x = Predicho, y = Observado, fill = Freq)) +
geom_tile(color = "white") +
geom_text(aes(label = Freq), color = "black", size = 5) +
scale_fill_gradient(low = "white", high = "steelblue") +
labs(title = "Matriz de Confusión: Predicciones de SonOcc",
x = "Predicho",
y = "Observado",
fill = "Frecuencia") +
theme_minimal(base_size = 14)
El modelo presentado muestra un desempeño muy limitado, con una
exactitud global de apenas 25 % y la incapacidad de predecir
correctamente la categoría farm. Esto se debe
principalmente a que farm tiene muy pocos casos en
comparación con las demás categorías, lo que hace que el modelo tienda a
predecir las categorías más frecuentes. Además, las variables incluidas
(black, nonintact y otras) no poseen
suficiente poder predictivo para diferenciar adecuadamente todas las
categorías de ocupación de los hijos. La combinación de una muestra
relativamente pequeña con un modelo multinomial de múltiples categorías
genera inestabilidad y predicciones sesgadas hacia las clases más
comunes. Como sugieren Arria et al., en futuras ocasiones es
recomendable agrupar categorías con pocos casos o aumentar el tamaño
muestral para garantizar que el modelo pueda aprender patrones
significativos y evitar problemas de predicción sesgada.
Finalmente, la movilidad ocupacional depende fuertemente de la ocupación del padre y la raza, mientras que la disrupción familiar no muestra un efecto estadísticamente significativo en esta muestra. La categoría farm requiere muestras mayores o agrupaciones para mejorar su predicción