Actividad 1. Análisis y aplicación de datos panel
Luis Aguilar A01569462
2026-08-17
Parte 1. Patentes
Base panel de 226 empresas observadas de 2012 a 2021. Quiero explicar
el número de patentes que solicita una empresa (patents)
con su gasto en I+D (rnd) y su tamaño
(employ). Uso logaritmos porque las variables son muy
asimétricas.
pat <- read_excel("PATENT_3.xls") # ajusta el nombre si tu archivo se llama distinto
pat <- pat %>%
transmute(cusip, year,
lpatents = log1p(patents),
lrnd = log1p(rnd),
lemploy = log1p(employ),
rnd, employ) %>%
filter(!is.na(lpatents), !is.na(lrnd), !is.na(lemploy))
pat <- pdata.frame(pat, index = c("cusip","year"))Estimo los tres modelos de datos panel:
pooled <- plm(lpatents ~ lrnd + lemploy, data = pat, model = "pooling")
fe <- plm(lpatents ~ lrnd + lemploy, data = pat, model = "within")
re <- plm(lpatents ~ lrnd + lemploy, data = pat, model = "random")Para elegir el mejor uso las pruebas:
pFtest(fe, pooled) # efectos fijos vs pooled##
## F test for individual effects
##
## data: lpatents ~ lrnd + lemploy
## F = 17.441, df1 = 224, df2 = 2012, p-value < 2.2e-16
## alternative hypothesis: significant effectsplmtest(pooled, type = "bp")# Breusch-Pagan: efectos aleatorios vs pooled##
## Lagrange Multiplier Test - (Breusch-Pagan)
##
## data: lpatents ~ lrnd + lemploy
## chisq = 1911.9, df = 1, p-value < 2.2e-16
## alternative hypothesis: significant effectsphtest(fe, re) # Hausman: efectos fijos vs aleatorios##
## Hausman Test
##
## data: lpatents ~ lrnd + lemploy
## chisq = 832.86, df = 2, p-value < 2.2e-16
## alternative hypothesis: one model is inconsistentEl pFtest y el Breusch-Pagan rechazan el modelo pooled (sí hay diferencias entre empresas) y el Hausman rechaza efectos aleatorios, así que me quedo con efectos fijos.
summary(fe)## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = lpatents ~ lrnd + lemploy, data = pat, model = "within")
##
## Unbalanced Panel: n = 225, T = 8-10, N = 2239
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -2.846609 -0.313672 0.034075 0.343038 1.691003
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## lrnd -0.666397 0.043277 -15.3984 < 2.2e-16 ***
## lemploy 0.559969 0.093108 6.0142 2.142e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 769.5
## Residual Sum of Squares: 686.05
## R-Squared: 0.10845
## Adj. R-Squared: 0.0083043
## F-statistic: 122.37 on 2 and 2012 DF, p-value: < 2.22e-16Predicciones
Efectos fijos no sirve para predecir empresas nuevas (no tienen efecto estimado), así que para el pronóstico uso el modelo pooled. Predigo las patentes para una empresa con I+D bajo, medio y alto:
nd <- data.frame(
lemploy = log1p(median(pat$employ, na.rm = TRUE)),
lrnd = log1p(quantile(pat$rnd, c(.25,.5,.75), na.rm = TRUE))
)
round(expm1(predict(pooled, newdata = nd)), 1)## 25% 50% 75%
## 1.7 2.9 7.2Conclusiones
El modelo que mejor se ajusta según las pruebas es el de efectos fijos. Un detalle: dentro de una misma empresa el coeficiente de I+D sale negativo, mientras que en el modelo pooled es positivo (~0.53). Esto pasa porque efectos fijos solo usa la variación dentro de cada empresa en 10 años, y ahí la relación es ruidosa; el efecto de la I+D sobre las patentes se ve más claro entre empresas y suele darse con rezago. Las predicciones dan entre ~2 y ~7 patentes según el nivel de gasto en I+D.
Parte 2. Cuidado de la Piel (Market sizes)
Tamaño de mercado del cuidado personal en México (Euromonitor, millones de pesos, 2011–2025). Uso las sub-categorías de producto como panel: cada sub-categoría es un individuo y los años son el tiempo.
mk <- read_excel("Market sizes.xlsx", skip = 5)
subcats <- c("Bath and Shower","Deodorants","Depilatories","Fragrances",
"Hair Care","Men's Grooming","Skin Care","Sun Care")
mk <- mk %>%
filter(Category %in% subcats) %>%
mutate(across(matches("^20"), as.numeric))
long <- mk %>%
pivot_longer(matches("^20"), names_to = "year", values_to = "value") %>%
mutate(year = as.integer(year), t = year - 2011, lvalue = log(value))
pmk <- pdata.frame(long, index = c("Category","year"))Modelo panel del crecimiento del mercado y pruebas de selección:
pooled2 <- plm(lvalue ~ t, data = pmk, model = "pooling")
fe2 <- plm(lvalue ~ t, data = pmk, model = "within")
re2 <- plm(lvalue ~ t, data = pmk, model = "random")
pFtest(fe2, pooled2)##
## F test for individual effects
##
## data: lvalue ~ t
## F = 3539.4, df1 = 7, df2 = 111, p-value < 2.2e-16
## alternative hypothesis: significant effectsplmtest(pooled2, type = "bp")##
## Lagrange Multiplier Test - (Breusch-Pagan)
##
## data: lvalue ~ t
## chisq = 831.99, df = 1, p-value < 2.2e-16
## alternative hypothesis: significant effectsphtest(fe2, re2)##
## Hausman Test
##
## data: lvalue ~ t
## chisq = 2.4253e-13, df = 1, p-value = 1
## alternative hypothesis: one model is inconsistent# crecimiento anual promedio
(exp(coef(fe2)["t"]) - 1) * 100## t
## 6.971503Hay diferencias por sub-categoría (pFtest y Breusch-Pagan significativos) y el Hausman no rechaza efectos aleatorios, así que el mejor modelo es efectos aleatorios. El mercado crece alrededor de 7% anual en promedio.
Predicciones
Pronostico cada sub-categoría a 2027 y 2029 con su tendencia:
pron <- long %>%
group_by(Category) %>%
do({
m <- lm(lvalue ~ t, data = .)
data.frame(crecimiento = round((exp(coef(m)["t"])-1)*100,1),
v2025 = round(exp(predict(m, data.frame(t = 14)))),
v2027 = round(exp(predict(m, data.frame(t = 16)))),
v2029 = round(exp(predict(m, data.frame(t = 18)))))
}) %>%
arrange(desc(v2025))
pron## # A tibble: 8 × 5
## # Groups: Category [8]
## Category crecimiento v2025 v2027 v2029
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Skin Care 7.7 67327 78134 90676
## 2 Hair Care 5.6 52400 58398 65083
## 3 Fragrances 7.7 48334 56113 65145
## 4 Men's Grooming 6.7 47509 54109 61627
## 5 Deodorants 5.8 21508 24092 26985
## 6 Bath and Shower 6.8 20704 23595 26888
## 7 Sun Care 9.2 4039 4820 5752
## 8 Depilatories 6.2 2021 2281 2574¿En qué sub-categoría invertiría?
No me quedo solo con la que más creció históricamente, porque el crecimiento pasado por sí solo no garantiza el futuro y conviene ver también qué tan grande es el segmento y qué tan estable fue. Comparo tamaño, crecimiento reciente y cómo aguantó el golpe de 2020:
mk %>%
transmute(Subcategoria = Category,
tam2025 = `2025`,
CAGR_16_25 = round((`2025`/`2016`)^(1/9)*100-100,1),
crec_reciente = round((`2025`/`2021`)^(1/4)*100-100,1),
cambio_2020 = round(`2020`/`2019`*100-100,1)) %>%
arrange(desc(tam2025))## # A tibble: 8 × 5
## Subcategoria tam2025 CAGR_16_25 crec_reciente cambio_2020
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Skin Care 71830 9 10.6 3.8
## 2 Fragrances 56742. 9.9 15.6 -10.4
## 3 Hair Care 56290. 6.3 9.2 -0.8
## 4 Men's Grooming 49508. 6.8 10.7 -9.2
## 5 Deodorants 21824. 5.3 9.7 -17.4
## 6 Bath and Shower 21342. 7.1 8.4 12.9
## 7 Sun Care 4326. 9.3 17.2 -16.4
## 8 Depilatories 1873. 5.2 4.6 -1.6Invertiría en Skin Care (cuidado de la piel). Es el segmento más grande (25% del gasto, ~71,800 millones), crece fuerte (9% anual, acelerando a 10.6% en los últimos años) y, a diferencia de casi todas las demás, no cayó en 2020: creció 3.8% cuando el mercado total bajó. Eso lo hace atractivo tanto si la economía va bien como si viene una caída.
Los segmentos con mayor crecimiento reciente (Fragrances, Sun Care, Men’s Grooming) son más riesgosos: cayeron entre 10% y 17% en 2020 y son los más volátiles, así que dependen mucho de que la economía siga fuerte. Como opción más agresiva estaría Dermocosmetics, que crece más rápido (~18%) y también aguantó 2020, pero es un mercado chico todavía. Por eso mi apuesta principal es Skin Care, y si se quisiera algo de mayor crecimiento, una parte menor a Dermocosmetics, que además es cuidado de la piel de posicionamiento más clínico.
Conclusiones
El mercado crece ~7% anual pero muy disparejo entre segmentos. Para decidir la inversión no basta el crecimiento histórico: hay que ver tamaño y estabilidad. Skin Care es la opción más sólida por ser grande, crecer bien y haber aguantado la crisis de 2020.
Parte 3. Banco Mundial
Importo datos del Banco Mundial con wbstats. Modelo el
consumo de los hogares en función del ingreso, para un panel de países
de Latinoamérica (2000–2022).
paises <- c("MEX","BRA","ARG","CHL","COL","PER","URY","CRI","BOL","PRY","ECU","DOM","GTM")
wb <- wb_data(indicator = c("NY.GDP.PCAP.KD","NE.CON.PRVT.PC.KD","SP.URB.TOTL.IN.ZS"),
country = paises, start_date = 2000, end_date = 2022)
wb <- wb %>%
rename(gdp_pc = `NY.GDP.PCAP.KD`,
cons_pc = `NE.CON.PRVT.PC.KD`,
urban = `SP.URB.TOTL.IN.ZS`) %>%
select(country, iso3c, date, gdp_pc, cons_pc, urban) %>%
filter(!is.na(gdp_pc), !is.na(cons_pc), !is.na(urban)) %>%
mutate(date = as.integer(date), lcons = log(cons_pc), lgdp = log(gdp_pc))
pwb <- pdata.frame(wb, index = c("iso3c","date"))pooled3 <- plm(lcons ~ lgdp + urban, data = pwb, model = "pooling")
fe3 <- plm(lcons ~ lgdp + urban, data = pwb, model = "within")
re3 <- plm(lcons ~ lgdp + urban, data = pwb, model = "random")
pFtest(fe3, pooled3)##
## F test for individual effects
##
## data: lcons ~ lgdp + urban
## F = 82.579, df1 = 12, df2 = 262, p-value < 2.2e-16
## alternative hypothesis: significant effectsplmtest(pooled3, type = "bp")##
## Lagrange Multiplier Test - (Breusch-Pagan)
##
## data: lcons ~ lgdp + urban
## chisq = 1278.2, df = 1, p-value < 2.2e-16
## alternative hypothesis: significant effectsphtest(fe3, re3)##
## Hausman Test
##
## data: lcons ~ lgdp + urban
## chisq = 35.519, df = 2, p-value = 1.937e-08
## alternative hypothesis: one model is inconsistentsummary(fe3)## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = lcons ~ lgdp + urban, data = pwb, model = "within")
##
## Unbalanced Panel: n = 13, T = 1-23, N = 277
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -0.1084239 -0.0192136 -0.0028346 0.0186189 0.1753226
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## lgdp 1.0390248 0.0218737 47.5010 < 2e-16 ***
## urban 0.0022760 0.0012221 1.8623 0.06367 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 9.0729
## Residual Sum of Squares: 0.37463
## R-Squared: 0.95871
## Adj. R-Squared: 0.9565
## F-statistic: 3041.65 on 2 and 262 DF, p-value: < 2.22e-16Las pruebas indican efectos por país y el Hausman prefiere
efectos fijos. La elasticidad del consumo respecto al
ingreso (lgdp) es cercana a 1: el gasto de los hogares
crece casi igual que el PIB per cápita.
Predicciones
elas <- coef(fe3)["lgdp"]
mex <- wb %>% filter(iso3c == "MEX") %>% slice_max(date)
data.frame(escenario = c("PIB actual","PIB +10%"),
consumo_pc = round(c(mex$cons_pc, mex$cons_pc * 1.10^elas)))## escenario consumo_pc
## PIB actual 7096
## lgdp PIB +10% 7834Gráficas
ggplot(wb, aes(lgdp, lcons)) +
geom_point(alpha = .5) +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "log PIB per cápita", y = "log consumo per cápita",
title = "Ingreso vs consumo del hogar")
wb$ajustado <- wb$lcons - residuals(fe3)
wb %>% filter(iso3c == "MEX") %>%
ggplot(aes(date)) +
geom_line(aes(y = cons_pc)) +
geom_point(aes(y = exp(ajustado))) +
labs(x = NULL, y = "consumo per cápita (US$ 2015)",
title = "México: observado (línea) vs ajustado (puntos)")
Conclusiones
El mejor modelo es el de efectos fijos. El consumo de los hogares crece casi uno a uno con el ingreso (elasticidad ~1), así que cuando sube el PIB per cápita sube el gasto de la gente en proporción parecida. La predicción para México muestra que un aumento de 10% en el PIB per cápita se traduce en cerca de 10% más de consumo.