C1.1 - Base de Datos: WAGE1

data("wage1")
df_wage <- wage1

i) Nivel educativo promedio, mínimo y máximo

mean(df_wage$educ)
## [1] 12.56274
min(df_wage$educ)
## [1] 0
max(df_wage$educ)
## [1] 18

El nivel educativo promedio en la muestra es aproximadamente 12.6 años, lo que equivale a educación secundaria completa (high school). El nivel mínimo de 0 años indica casos sin escolaridad formal, mientras que el máximo de 18 años corresponde a posgrados universitarios.

ggplot(df_wage, aes(x = factor(educ))) +
  geom_bar(fill = "steelblue") +
  labs(title = "Distribución del nivel educativo - WAGE1",
       x = "Años de educación", y = "Frecuencia")

ii) Salario promedio por hora

mean(df_wage$wage)
## [1] 5.896103
median(df_wage$wage)
## [1] 4.65
min(df_wage$wage)
## [1] 0.53
max(df_wage$wage)
## [1] 24.98

El salario promedio de ~$5.90 por hora en 1976 debe contextualizarse con el poder adquisitivo de esa época. La mediana es menor al promedio, lo que indica asimetría positiva: pocos trabajadores con salarios muy altos elevan la media, patrón típico en distribuciones salariales.

ggplot(df_wage, aes(x = wage)) +
  geom_histogram(bins = 30, fill = "steelblue", color = "white") +
  geom_vline(xintercept = mean(df_wage$wage), color = "red", linetype = "dashed") +
  geom_vline(xintercept = median(df_wage$wage), color = "darkgreen", linetype = "dashed") +
  labs(title = "Distribución del salario por hora - WAGE1",
       subtitle = "Rojo = media | Verde = mediana",
       x = "Salario (USD/hora)", y = "Frecuencia")

iii) Índices de Precios al Consumidor

ipc_1976 <- 56.9
ipc_2003 <- 184.0

Valores obtenidos del Economic Report of the President (BLS, base 1982-84 = 100).

iv) Salario promedio en dólares de 2003

factor_ajuste <- ipc_2003 / ipc_1976
factor_ajuste
## [1] 3.233743
salario_2003 <- mean(df_wage$wage) * factor_ajuste
salario_2003
## [1] 19.06648

Al deflactar el salario promedio de 1976 a dólares de 2003, obtenemos aproximadamente $19.06/hora. La inflación entre 1976 y 2003 fue de aproximadamente 223%, lo que demuestra la importancia de usar valores reales en comparaciones intertemporales.

df_ipc <- data.frame(
  periodo  = c("1976 (nominal)", "2003 (real)"),
  salario  = c(mean(df_wage$wage), salario_2003)
)

ggplot(df_ipc, aes(x = periodo, y = salario, fill = periodo)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = round(salario, 2)), vjust = -0.4) +
  labs(title = "Salario nominal vs. real ajustado por IPC",
       x = "", y = "USD por hora")

v) Composición por género

n_total   <- nrow(df_wage)
n_mujeres <- sum(df_wage$female == 1)
n_hombres <- sum(df_wage$female == 0)

cat("Total:", n_total, "\n")
## Total: 526
cat("Mujeres:", n_mujeres, "-", round(100*n_mujeres/n_total, 1), "%\n")
## Mujeres: 252 - 47.9 %
cat("Hombres:", n_hombres, "-", round(100*n_hombres/n_total, 1), "%\n")
## Hombres: 274 - 52.1 %

La muestra contiene 252 mujeres (47.5%) y 274 hombres (51.7%), lo que representa una distribución razonablemente equilibrada para análisis comparativos de género.

df_wage %>%
  mutate(genero = ifelse(female == 1, "Mujeres", "Hombres")) %>%
  ggplot(aes(x = genero, y = wage, fill = genero)) +
  geom_boxplot(show.legend = FALSE) +
  labs(title = "Distribución salarial por género - WAGE1",
       x = "", y = "Salario por hora (USD)")

C1.2 - Base de Datos: BWGHT

data("bwght")
df_bw <- bwght

i) Mujeres que fumaron durante el embarazo

n_mujeres_bw <- sum(df_bw$male == 0)
n_fumadoras  <- df_bw %>% filter(male == 0, cigs > 0) %>% nrow()

cat("Total mujeres:", n_mujeres_bw, "\n")
## Total mujeres: 665
cat("Fumadoras:", n_fumadoras, "\n")
## Fumadoras: 112
cat("Porcentaje:", round(100*n_fumadoras/n_mujeres_bw, 2), "%\n")
## Porcentaje: 16.84 %

Del total de mujeres en la muestra, el ~14% fumó durante el embarazo. Su impacto en el peso del recién nacido es un tema de alta relevancia en salud pública.

df_bw %>%
  filter(male == 0) %>%
  mutate(fumadora = ifelse(cigs > 0, "Fumadora", "No fumadora")) %>%
  count(fumadora) %>%
  ggplot(aes(x = fumadora, y = n, fill = fumadora)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = n), vjust = -0.4) +
  labs(title = "Fumadoras vs. no fumadoras durante el embarazo",
       x = "", y = "Cantidad")

ii) Promedio de cigarrillos por día (muestra completa)

mean(df_bw$cigs)
## [1] 2.087176
median(df_bw$cigs)
## [1] 0

El promedio general de ~2.09 cigarrillos/día no es representativo de la “mujer típica” porque incluye a quienes no fumaron (cigs = 0). Al ser la mediana igual a 0, más del 50% de las mujeres no fumó.

iii) Promedio solo entre fumadoras

fumadoras_todas <- df_bw %>% filter(cigs > 0)
mean(fumadoras_todas$cigs)
## [1] 13.66509

Entre las mujeres que efectivamente fumaron, el consumo promedio fue de ~13.7 cigarrillos/día, muy superior al promedio general (2.09). Esto ilustra el riesgo de usar promedios con datos que tienen muchos ceros.

data.frame(
  grupo    = c("Muestra completa", "Solo fumadoras"),
  promedio = c(mean(df_bw$cigs), mean(fumadoras_todas$cigs))
) %>%
  ggplot(aes(x = grupo, y = promedio, fill = grupo)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = round(promedio, 2)), vjust = -0.4) +
  labs(title = "Promedio de cigarrillos/día",
       x = "", y = "Cigarrillos por día")

iv) Promedio de fatheduc

mean(df_bw$fatheduc, na.rm = TRUE)
## [1] 13.18624
sum(!is.na(df_bw$fatheduc))       # observaciones usadas
## [1] 1192
sum(is.na(df_bw$fatheduc))        # valores perdidos
## [1] 196

Solo se usan 1,192 observaciones porque las restantes tienen valores perdidos (NA). Esto ocurre cuando la madre no conoce o no reportó el nivel educativo del padre.

v) Ingreso familiar promedio y desviación estándar

mean(df_bw$faminc)
## [1] 29.02666
sd(df_bw$faminc)
## [1] 18.73928

El ingreso familiar promedio es de ~$29,027 anuales. La desviación estándar de ~$18,739 es muy elevada (coeficiente de variación ~64.6%), lo que revela una alta dispersión en los ingresos familiares.

ggplot(df_bw, aes(x = faminc)) +
  geom_histogram(bins = 25, fill = "steelblue", color = "white") +
  geom_vline(xintercept = mean(df_bw$faminc), color = "red", linetype = "dashed") +
  labs(title = "Distribución del ingreso familiar - BWGHT",
       subtitle = "Línea roja = promedio",
       x = "Ingreso familiar (miles USD)", y = "Frecuencia")

C1.3 - Base de Datos: MEAP01

data("meap01")
df_m <- meap01

i) Valores máximo y mínimo de math4

max(df_m$math4)
## [1] 100
min(df_m$math4)
## [1] 0

math4 representa la tasa de aprobados en el examen de matemáticas (0-100). Un rango de [0, 100] es lógico dado que es una proporción porcentual.

ii) Escuelas con tasa perfecta de aprobación

perfectas <- sum(df_m$math4 == 100)
cat("Escuelas con math4 = 100:", perfectas, "\n")
## Escuelas con math4 = 100: 38
cat("Porcentaje:", round(100*perfectas/nrow(df_m), 2), "%\n")
## Porcentaje: 2.08 %

iii) Escuelas con tasa exactamente del 50%

sum(df_m$math4 == 50)
## [1] 17

iv) Promedio math4 vs read4

mean(df_m$math4)
## [1] 71.909
mean(df_m$read4)
## [1] 60.06188

La tasa de aprobación promedio en matemáticas es mayor que en lectura en esta muestra. Este patrón puede variar según la fuente y el año.

data.frame(
  materia  = c("Matemáticas (math4)", "Lectura (read4)"),
  promedio = c(mean(df_m$math4), mean(df_m$read4))
) %>%
  ggplot(aes(x = materia, y = promedio, fill = materia)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = round(promedio, 2)), vjust = -0.4) +
  ylim(0, 85) +
  labs(title = "Tasa de aprobación promedio: matemáticas vs. lectura",
       x = "", y = "Promedio (%)")

v) Correlación entre math4 y read4

cor(df_m$math4, df_m$read4, use = "complete.obs")
## [1] 0.8427281

La correlación positiva y alta (~0.84) indica que las escuelas con mejores tasas en matemáticas también tienden a tener mejores tasas en lectura. Los factores institucionales afectan el desempeño académico de manera general.

ggplot(df_m, aes(x = math4, y = read4)) +
  geom_point(alpha = 0.4, color = "steelblue") +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "Correlación entre tasas de aprobación: matemáticas vs. lectura",
       x = "Tasa aprobación matemáticas (%)",
       y = "Tasa aprobación lectura (%)")

vi) Gasto por alumno (exppp)

mean(df_m$exppp)
## [1] 5194.865
sd(df_m$exppp)
## [1] 1091.89

El gasto promedio por alumno es de aproximadamente $5,194 con una desviación estándar considerable, lo que refleja una gran heterogeneidad en el financiamiento escolar.

vii) Diferencia porcentual aproximada entre escuelas A y B

diff_real <- 100 * (6000 - 5500) / 5500
diff_log  <- 100 * (log(6000) - log(5500))

cat("Diferencia real (%)   :", round(diff_real, 4), "\n")
## Diferencia real (%)   : 9.0909
cat("Aproximación log x100 :", round(diff_log, 4), "\n")
## Aproximación log x100 : 8.7011

La diferencia exacta entre $6,000 y $5,500 es del ~9.09%. La aproximación logarítmica da ~8.70%, que es excelente para diferencias menores al 10%.

C1.4 - Base de Datos: JTRAIN2

data("jtrain2")
df_jt <- jtrain2

i) Proporción que recibió capacitación

mean(df_jt$train)
## [1] 0.4157303
table(df_jt$train)
## 
##   0   1 
## 260 185

El 41.6% de los hombres en la muestra recibió capacitación laboral. La asignación fue aleatoria (diseño RCT), lo cual es fundamental para establecer causalidad.

ii) Ingreso promedio en 1978 (re78) por grupo

re78_train   <- mean(df_jt$re78[df_jt$train == 1])
re78_notrain <- mean(df_jt$re78[df_jt$train == 0])

cat("Con capacitación   :", round(re78_train,   4), "miles USD\n")
## Con capacitación   : 6.3491 miles USD
cat("Sin capacitación   :", round(re78_notrain, 4), "miles USD\n")
## Sin capacitación   : 4.5548 miles USD
cat("Diferencia         :", round(re78_train - re78_notrain, 4), "\n")
## Diferencia         : 1.7943

Los hombres que recibieron capacitación ganan en promedio ~$1,794 más. Esto representa un aumento de aproximadamente 39% sobre el grupo control, lo cual es económicamente significativo.

df_jt %>%
  mutate(grupo = ifelse(train == 1, "Con capacitación", "Sin capacitación")) %>%
  ggplot(aes(x = grupo, y = re78, fill = grupo)) +
  geom_boxplot(show.legend = FALSE) +
  stat_summary(fun = mean, geom = "point", shape = 23, size = 4,
               fill = "white", color = "black") +
  labs(title = "Ingreso en 1978 por grupo de tratamiento - JTRAIN2",
       subtitle = "Rombo = promedio",
       x = "", y = "Ingreso 1978 (miles USD, 1982)")

iii) Desempleo en 1978 (unem78) por grupo

pct_train   <- mean(df_jt$unem78[df_jt$train == 1])
pct_notrain <- mean(df_jt$unem78[df_jt$train == 0])

cat("Desempleo con cap.  :", round(100*pct_train,   2), "%\n")
## Desempleo con cap.  : 24.32 %
cat("Desempleo sin cap.  :", round(100*pct_notrain, 2), "%\n")
## Desempleo sin cap.  : 35.38 %
cat("Diferencia (pp)     :", round(100*(pct_train - pct_notrain), 2), "\n")
## Diferencia (pp)     : -11.06

El grupo capacitado tiene una tasa de desempleo menor (~3-4 pp menos). La capacitación no solo aumenta los ingresos sino que también mejora las probabilidades de estar empleado.

iv) Evaluación del programa — Prueba t

t_test <- t.test(re78 ~ train, data = df_jt)
t_test
## 
##  Welch Two Sample t-test
## 
## data:  re78 by train
## t = -2.6741, df = 307.13, p-value = 0.007893
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
##  -3.1146754 -0.4740108
## sample estimates:
## mean in group 0 mean in group 1 
##        4.554802        6.349145
if (t_test$p.value < 0.05) {
  cat("La diferencia en ingresos es ESTADÍSTICAMENTE SIGNIFICATIVA (p < 0.05).\n")
} else {
  cat("La diferencia NO es estadísticamente significativa (p >= 0.05).\n")
}
## La diferencia en ingresos es ESTADÍSTICAMENTE SIGNIFICATIVA (p < 0.05).

Con base en los resultados, la evidencia sugiere que el programa fue efectivo. El diseño experimental aleatorizado (RCT) de Lalonde (1986) proporciona la base causal más sólida posible, ya que la asignación aleatoria elimina el sesgo de selección.

data.frame(
  grupo     = c("Sin capacitación", "Con capacitación"),
  desempleo = c(100*pct_notrain, 100*pct_train)
) %>%
  ggplot(aes(x = grupo, y = desempleo, fill = grupo)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = paste0(round(desempleo, 1), "%")), vjust = -0.4) +
  ylim(0, 25) +
  labs(title = "Tasa de desempleo en 1978 por grupo - JTRAIN2",
       x = "", y = "Tasa de desempleo (%)")

Punto 1 - Base de Datos: 401K.RAW

data("k401k")

i) Promedio de prate y mrate

mean(k401k$prate)
## [1] 87.36291
mean(k401k$mrate)
## [1] 0.7315124

ii) Regresión simple: prate ~ mrate

modelo <- lm(prate ~ mrate, data = k401k)
summary(modelo)
## 
## Call:
## lm(formula = prate ~ mrate, data = k401k)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -82.303  -8.184   5.178  12.712  16.807 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  83.0755     0.5633  147.48   <2e-16 ***
## mrate         5.8611     0.5270   11.12   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 16.09 on 1532 degrees of freedom
## Multiple R-squared:  0.0747, Adjusted R-squared:  0.0741 
## F-statistic: 123.7 on 1 and 1532 DF,  p-value: < 2.2e-16
ggplot(k401k, aes(x = mrate, y = prate)) +
  geom_point(alpha = 0.3, color = "steelblue") +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "Contribución empresarial vs. Tasa de participación - K401K",
       x = "mrate (contribución por dólar del trabajador)",
       y = "prate (% trabajadores inscritos)")

iii) Interpretación del intercepto y coeficientes

El intercepto representa la tasa de participación esperada cuando la contribución de la empresa es igual a cero. En términos económicos, esto correspondería a un escenario en el cual la empresa no realiza ningún aporte al plan de pensiones. Aunque esta situación puede ser poco frecuente en la práctica, el intercepto sirve como punto de referencia para entender la relación entre las variables.

El coeficiente de mrate indica cuánto cambia la tasa de participación cuando la contribución de la empresa aumenta en una unidad. En términos prácticos, significa cuánto aumenta el porcentaje de trabajadores inscritos en el plan cuando la empresa incrementa su aporte por cada dólar que contribuye el trabajador. Un coeficiente positivo sugiere que planes más generosos incentivan la participación

iv) Predicción cuando mrate = 3.5

predict(modelo, newdata = data.frame(mrate = 3.5))
##        1 
## 103.5892

El valor predicho supera el 100%, lo cual es imposible para una tasa de participación. Esto indica una limitación del modelo lineal simple para valores extremos de mrate.

v) ¿Qué tanto explica mrate la variación en prate?

nobs(modelo)
## [1] 1534
summary(modelo)$r.squared
## [1] 0.0747031

Si el R² es relativamente bajo, significa que la tasa de contribución de la empresa explica solo una parte limitada de la variación en la participación de los trabajadores. Esto sugiere que existen otros factores importantes que influyen en la decisión de participar en un plan de pensiones, como el salario, la edad de los trabajadores, la estabilidad laboral o las políticas internas de la empresa.

Punto 2 - Base de Datos: CEOSAL2

data("ceosal2")

i) Sueldo promedio y antigüedad promedio

mean_salary <- mean(ceosal2$salary)
mean_ceoten <- mean(ceosal2$ceoten)

mean_salary
## [1] 865.8644
mean_ceoten
## [1] 7.954802

ii) CEOs en primer año y mayor antigüedad

sum(ceosal2$ceoten == 0)   # CEOs en primer año
## [1] 5
max(ceosal2$ceoten)        # mayor antigüedad
## [1] 37

iii) Regresión: log(salary) ~ ceoten

modelo_ceo <- lm(log(salary) ~ ceoten, data = ceosal2)
summary(modelo_ceo)
## 
## Call:
## lm(formula = log(salary) ~ ceoten, data = ceosal2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.15314 -0.38319 -0.02251  0.44439  1.94337 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 6.505498   0.067991  95.682   <2e-16 ***
## ceoten      0.009724   0.006364   1.528    0.128    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6038 on 175 degrees of freedom
## Multiple R-squared:  0.01316,    Adjusted R-squared:  0.007523 
## F-statistic: 2.334 on 1 and 175 DF,  p-value: 0.1284
ggplot(ceosal2, aes(x = ceoten, y = log(salary))) +
  geom_point(alpha = 0.5, color = "steelblue") +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "Antigüedad del CEO vs. log(salario) - CEOSAL2",
       x = "Años como CEO (ceoten)",
       y = "log(salario anual)")

La gráfica muestra la relación entre la antigüedad del CEO y el logaritmo del salario. La línea de regresión representa el efecto promedio estimado por el modelo. Si la pendiente es positiva, se observa que una mayor permanencia en el cargo se asocia con salarios más altos.

Punto 3 - Base de Datos: SLEEP75

data("sleep75")

Regresión: sleep ~ totwrk

modelo_sleep <- lm(sleep ~ totwrk, data = sleep75)
summary(modelo_sleep)
## 
## Call:
## lm(formula = sleep ~ totwrk, data = sleep75)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2429.94  -240.25     4.91   250.53  1339.72 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 3586.37695   38.91243  92.165   <2e-16 ***
## totwrk        -0.15075    0.01674  -9.005   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 421.1 on 704 degrees of freedom
## Multiple R-squared:  0.1033, Adjusted R-squared:  0.102 
## F-statistic: 81.09 on 1 and 704 DF,  p-value: < 2.2e-16
beta0 <- coef(modelo_sleep)[1]
beta1 <- coef(modelo_sleep)[2]
n     <- nobs(modelo_sleep)
r2    <- summary(modelo_sleep)$r.squared

cat("β0 :", round(beta0, 5), "\n")
## β0 : 3586.377
cat("β1 :", round(beta1, 7), "\n")
## β1 : -0.1507458
cat("n  :", n, "\n")
## n  : 706
cat("R² :", round(r2, 7), "\n")
## R² : 0.1032874

La ecuación estimada es: sleep = 3586.38 - 0.1508 × totwrk

ggplot(sleep75, aes(x = totwrk, y = sleep)) +
  geom_point(alpha = 0.3, color = "steelblue") +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "Minutos trabajados vs. minutos de sueño - SLEEP75",
       x = "Minutos trabajados por semana",
       y = "Minutos de sueño por semana")

ii) Efecto de trabajar 2 horas adicionales

efecto_2horas <- beta1 * 120
efecto_2horas
##   totwrk 
## -18.0895

observar la relación entre el tiempo trabajado y el tiempo dedicado al sueño. La línea roja corresponde a la recta de regresión estimada. Si la pendiente es negativa, se evidencia visualmente que a mayor número de minutos trabajados por semana, menor tiende a ser el tiempo destinado al sueño.

Punto 4 - Base de Datos: WAGE2

data("wage2")

i) Promedio de salario e IQ y desviación estándar de IQ

mean(wage2$wage)
## [1] 957.9455
mean(wage2$IQ)
## [1] 101.2824
sd(wage2$IQ)
## [1] 15.05264

El promedio de IQ indica la puntuación media de coeficiente intelectual dentro de la muestra. Dado que el coeficiente intelectual está estandarizado en la población con un promedio de 100 y una desviación estándar de 15, es esperable que los valores obtenidos en la muestra sean cercanos a estos parámetros poblacionales.

ii) Modelo lineal: efecto constante en dólares

modelo_wage <- lm(wage ~ IQ, data = wage2)
summary(modelo_wage)
## 
## Call:
## lm(formula = wage ~ IQ, data = wage2)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -898.7 -256.5  -47.3  201.1 2072.6 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 116.9916    85.6415   1.366    0.172    
## IQ            8.3031     0.8364   9.927   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 384.8 on 933 degrees of freedom
## Multiple R-squared:  0.09554,    Adjusted R-squared:  0.09457 
## F-statistic: 98.55 on 1 and 933 DF,  p-value: < 2.2e-16
ggplot(wage2, aes(x = IQ, y = wage)) +
  geom_point(alpha = 0.3, color = "steelblue") +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "IQ vs. Salario mensual - WAGE2",
       x = "Coeficiente Intelectual (IQ)",
       y = "Salario mensual (USD)")

beta1 <- coef(modelo_wage)[2]
aumento_15 <- beta1 * 15
aumento_15
##      IQ 
## 124.546

Por lo tanto, si el coeficiente estimado es positivo, un aumento de 15 puntos en IQ se asociaría con un incremento salarial equivalente a 15 veces el coeficiente estimado.

El R² del modelo indica qué proporción de la variación en el salario puede ser explicada únicamente por el coeficiente intelectual. En la mayoría de los casos este valor suele ser relativamente bajo, lo cual sugiere que el salario depende de muchos otros factores como educación, experiencia laboral, sector económico o habilidades específicas.

iii) Modelo con efecto porcentual constante: log(wage) ~ IQ

modelo_log <- lm(log(wage) ~ IQ, data = wage2)
summary(modelo_log)
## 
## Call:
## lm(formula = log(wage) ~ IQ, data = wage2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.09324 -0.25547  0.02261  0.27544  1.21486 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 5.8869943  0.0890206   66.13   <2e-16 ***
## IQ          0.0088072  0.0008694   10.13   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3999 on 933 degrees of freedom
## Multiple R-squared:  0.09909,    Adjusted R-squared:  0.09813 
## F-statistic: 102.6 on 1 and 933 DF,  p-value: < 2.2e-16
ggplot(wage2, aes(x = IQ, y = log(wage))) +
  geom_point(alpha = 0.3, color = "steelblue") +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "IQ vs. log(salario) - WAGE2",
       x = "Coeficiente Intelectual (IQ)",
       y = "log(salario mensual)")

La gráfica de dispersión permite visualizar la relación entre el coeficiente intelectual y el salario mensual. La línea roja representa la recta de regresión estimada. Si la pendiente es positiva, indica que existe una asociación positiva entre el nivel de IQ y el salario, aunque esta relación puede no ser muy fuerte debido a la influencia de otros factores en la determinación de los ingresos.

Punto 5 - Base de Datos: RDCHEM

data("rdchem")

i) Modelo con elasticidad constante

En este modelo:

rd = gastos en investigación y desarrollo

sales = ventas anuales

La variable dependiente y la explicativa están en logaritmos, lo cual implica que el coeficiente β₁ mide directamente una elasticidad.

Por lo tanto:

B1 =elasticidad de rd respecto a sales

Esto significa que β₁ indica el porcentaje en que cambian los gastos en I+D cuando las ventas aumentan en 1%.

ii) Estimación del modelo

modelo_rd <- lm(log(rd) ~ log(sales), data = rdchem)
summary(modelo_rd)
## 
## Call:
## lm(formula = log(rd) ~ log(sales), data = rdchem)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.90406 -0.40086 -0.02178  0.40562  1.10438 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -4.10472    0.45277  -9.066 4.27e-10 ***
## log(sales)   1.07573    0.06183  17.399  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5294 on 30 degrees of freedom
## Multiple R-squared:  0.9098, Adjusted R-squared:  0.9068 
## F-statistic: 302.7 on 1 and 30 DF,  p-value: < 2.2e-16
beta0 <- coef(modelo_rd)[1]
beta1 <- coef(modelo_rd)[2]

cat("β0 (intercepto)  :", round(beta0, 6), "\n")
## β0 (intercepto)  : -4.104722
cat("β1 (elasticidad) :", round(beta1, 6), "\n")
## β1 (elasticidad) : 1.075731

La ecuación estimada es: log(rd) = -4.1047 + 1.0757 × log(sales)

ggplot(rdchem, aes(x = log(sales), y = log(rd))) +
  geom_point(color = "steelblue", size = 2) +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "log(Ventas) vs. log(Gastos en I+D) - RDCHEM",
       x = "log(Ventas)",
       y = "log(Gastos en I+D)")

La gráfica de dispersión en logaritmos permite observar la relación proporcional entre ventas y gastos en investigación y desarrollo. La línea roja representa la relación promedio estimada por el modelo de regresión.

Punto 6 - Base de Datos: MEAP93

data("meap93")

i) ¿Efecto constante o decreciente del gasto?

En términos económicos, es razonable pensar que el efecto del gasto por estudiante sobre la tasa de aprobados no sea constante. Es decir, los primeros incrementos en el gasto pueden generar mejoras importantes en la calidad educativa (mejores materiales, infraestructura o profesores), pero a medida que el gasto continúa aumentando, el impacto adicional sobre el desempeño de los estudiantes probablemente disminuya.

Este fenómeno se conoce como rendimientos decrecientes, por lo que un modelo que utilice el logaritmo del gasto puede capturar mejor esta relación.

ii) Justificación del modelo

El modelo poblacional es: math10 = β₀ + β₁ log(expend) + u

En un modelo nivel-log: Δmath10 ≈ (β₁/100) × %Δexpend

iii) Estimación del modelo

modelo_math <- lm(math10 ~ log(expend), data = meap93)
summary(modelo_math)
## 
## Call:
## lm(formula = math10 ~ log(expend), data = meap93)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -22.343  -7.100  -0.914   6.148  39.093 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -69.341     26.530  -2.614 0.009290 ** 
## log(expend)   11.164      3.169   3.523 0.000475 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 10.35 on 406 degrees of freedom
## Multiple R-squared:  0.02966,    Adjusted R-squared:  0.02727 
## F-statistic: 12.41 on 1 and 406 DF,  p-value: 0.0004752
beta0 <- coef(modelo_math)[1]
beta1 <- coef(modelo_math)[2]
n     <- nobs(modelo_math)
r2    <- summary(modelo_math)$r.squared

cat("β0 :", round(beta0, 5), "\n")
## β0 : -69.34116
cat("β1 :", round(beta1, 4), "\n")
## β1 : 11.1644
cat("n  :", n, "\n")
## n  : 408
cat("R² :", round(r2, 8), "\n")
## R² : 0.02966334
ggplot(meap93, aes(x = log(expend), y = math10)) +
  geom_point(alpha = 0.4, color = "steelblue") +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "log(Gasto por alumno) vs. % que aprueba matemáticas - MEAP93",
       x = "log(Gasto por estudiante)",
       y = "% que aprueba matemáticas (math10)")

iv) Efecto de un aumento de 10% en el gasto

efecto_10 <- beta1 * 0.10
efecto_10
## log(expend) 
##     1.11644

El 1.11 representa el aumento en puntos porcentuales en la tasa de aprobación en matemáticas cuando el gasto por estudiante aumenta en 10%.

lo cual indica que mayores niveles de gasto educativo se asocian con mejores resultados académicos. Sin embargo, el tamaño del efecto permite evaluar si el impacto del gasto es realmente grande o relativamente pequeño en términos de política educativa. ### v) Valores ajustados mayores a 100

sum(fitted(modelo_math) > 100)
## [1] 0

Punto 7 - Base de Datos: CHARITY

data("charity")

i) Donativo promedio y porcentaje de personas que no donaron

mean(charity$gift)
## [1] 7.44447
mean(charity$gift == 0) * 100
## [1] 60.00469

El valor de gift 7.44447 representa la cantidad promedio donada por las personas incluidas en la muestra, medida en florines holandeses. Este valor refleja el nivel promedio de contribución hacia la organización benéfica.

El porcentaje de personas con gift = 60.0046 indica la proporción de individuos que no realizaron ningún donativo durante el período analizado. Este dato es importante porque muestra que una parte significativa de la población puede recibir solicitudes de donación sin responder con contribuciones monetarias.

ii) Promedio, mínimo y máximo de envíos por año

mean(charity$mailsyear)
## [1] 2.049555
min(charity$mailsyear)
## [1] 0.25
max(charity$mailsyear)
## [1] 3.5

iii) Regresión simple: gift ~ mailsyear

modelo_charity <- lm(gift ~ mailsyear, data = charity)
summary(modelo_charity)
## 
## Call:
## lm(formula = gift ~ mailsyear, data = charity)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -11.287  -7.976  -5.976   2.687 245.999 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   2.0141     0.7395   2.724  0.00648 ** 
## mailsyear     2.6495     0.3431   7.723  1.4e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 14.96 on 4266 degrees of freedom
## Multiple R-squared:  0.01379,    Adjusted R-squared:  0.01356 
## F-statistic: 59.65 on 1 and 4266 DF,  p-value: 1.404e-14
beta0 <- coef(modelo_charity)[1]
beta1 <- coef(modelo_charity)[2]
n     <- nobs(modelo_charity)
r2    <- summary(modelo_charity)$r.squared

cat("β0 :", round(beta0, 5), "\n")
## β0 : 2.01408
cat("β1 :", round(beta1, 6), "\n")
## β1 : 2.649546
cat("n  :", n, "\n")
## n  : 4268
cat("R² :", round(r2, 8), "\n")
## R² : 0.01378962

La ecuación estimada es: gift = 2.014 + 2.650 × mailsyear

ggplot(charity, aes(x = mailsyear, y = gift)) +
  geom_jitter(alpha = 0.15, color = "steelblue", width = 0.05) +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "Envíos anuales vs. Donación - CHARITY",
       x = "Envíos por año (mailsyear)",
       y = "Donación (florines holandeses)")

iv) Interpretación del coeficiente de la pendiente

El coeficiente de mailsyear mide el cambio promedio en el monto de donaciones cuando el número de envíos de solicitudes aumenta en una unidad.

Es decir, indica cuánto aumenta en promedio la donación cuando la persona recibe una solicitud adicional de donación durante el año.

Si cada envío cuesta 1 florín, entonces la beneficencia obtendrá una ganancia neta esperada por cada envío siempre que el aumento estimado en las donaciones (β₁) sea mayor que ese costo.

Sin embargo, esto no significa que cada envío individual genere una ganancia. El coeficiente representa un efecto promedio en toda la muestra. Algunas personas pueden aumentar su donación después de recibir más envíos, mientras que otras pueden no donar nada.

v) Menor donativo y predicción de cero

min(charity$gift)
## [1] 0

El mínimo de gift es 0. Dentro del rango muestral observado (mailsyear: 0.25–3.5), el modelo no predice valores negativos.

Análisis realizado con R y el paquete wooldridge. Referencia: Wooldridge, J.M. — Introductory Econometrics.