Reto: Modelos de Datos en Panel
Luis Aguilar
Preparación
suppressPackageStartupMessages({
library(plm)
library(gplots)
library(readxl)
library(dplyr)
library(tidyr)
library(lmtest)
library(WDI)
})## Warning: package 'gplots' was built under R version 4.4.3options(timeout = 180)
directorio_datos <- "/Users/luisaguilarrodriguez/Downloads"Parte 1. Patentes generadas por las empresas
Objetivo: construir un modelo de datos en panel para explicar el número de patentes, seleccionar entre efectos fijos y aleatorios, detectar heterocedasticidad y autocorrelación serial, e interpretar la capacidad de pronóstico.
De acuerdo con el diccionario de Hoja1, patents representa las patentes solicitadas, rnd es el gasto anual en investigación y desarrollo, employ es el número de empleados en miles, sales son las ventas anuales y merger identifica una fusión importante.
La inversión en investigación y desarrollo no necesariamente produce patentes durante el mismo año. Por ello se crea lag_rnd, que representa el gasto en investigación y desarrollo del año anterior, el modelo también conserva empleados, ventas y fusiones para controlar por el tamaño y los cambios importantes de cada empresa.
Hall, Griliches y Hausman (1986) encontraron que la mayor parte de la relación entre investigación y desarrollo y patentes aparece durante el primer año, sin evidencia sólida de rezagos prolongados, debido a la corta dimensión temporal de este panel, utilizar más años de rezago también reduciría considerablemente las observaciones disponibles.
ruta_patentes <- file.path(directorio_datos, "PATENT 3.xls")
patentes <- as.data.frame(read_excel(ruta_patentes, sheet = "Sheet1"))
panel_patentes <- pdata.frame(patentes, index = c("cusip", "year"))
# Rezago de un año del gasto en investigación y desarrollo
panel_patentes$lag_rnd <- stats::lag(panel_patentes$rnd, k = 1)
pdim(panel_patentes)## Balanced Panel: n = 226, T = 10, N = 2260Prueba de heterogeneidad
Una línea que no sea horizontal indica que existen diferencias entre las empresas.
suppressWarnings(plotmeans(log(patents + 1) ~ cusip, data = panel_patentes,
bars = FALSE, n.label = FALSE, xaxt = "n",
main = "Media de log(patentes + 1) por empresa",
xlab = "Empresa", ylab = "log(patentes + 1)"))
Selección del modelo
Se estiman los tres modelos utilizados en clase, la prueba F compara el modelo pooled con efectos fijos, la prueba de Hausman compara efectos fijos con efectos aleatorios.
formula_patentes <- log(patents + 1) ~ log(lag_rnd + 1) +
log(employ) + log(sales) + merger
pooled1 <- plm(formula_patentes, data = panel_patentes, model = "pooling")
within1 <- plm(formula_patentes, data = panel_patentes, model = "within")
random1 <- plm(formula_patentes, data = panel_patentes, model = "random")
summary(pooled1)## Pooling Model
##
## Call:
## plm(formula = formula_patentes, data = panel_patentes, model = "pooling")
##
## Unbalanced Panel: n = 225, T = 8-9, N = 2015
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -3.426801 -0.576012 -0.038351 0.657729 2.480357
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## (Intercept) 1.645841 0.167076 9.8509 < 2.2e-16 ***
## log(lag_rnd + 1) 0.663279 0.026091 25.4222 < 2.2e-16 ***
## log(employ) 0.511443 0.046598 10.9757 < 2.2e-16 ***
## log(sales) -0.330520 0.043447 -7.6075 4.265e-14 ***
## merger 0.737132 0.171313 4.3028 1.767e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 4850.1
## Residual Sum of Squares: 1740.7
## R-Squared: 0.64109
## Adj. R-Squared: 0.64038
## F-statistic: 897.587 on 4 and 2010 DF, p-value: < 2.22e-16summary(within1)## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = formula_patentes, data = panel_patentes, model = "within")
##
## Unbalanced Panel: n = 225, T = 8-9, N = 2015
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -2.509890 -0.303493 0.035073 0.341951 1.548304
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## log(lag_rnd + 1) -0.330575 0.057948 -5.7047 1.361e-08 ***
## log(employ) 0.878742 0.082645 10.6328 < 2.2e-16 ***
## log(sales) -0.704897 0.060573 -11.6371 < 2.2e-16 ***
## merger -0.058031 0.129499 -0.4481 0.6541
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 684.53
## Residual Sum of Squares: 558.97
## R-Squared: 0.18343
## Adj. R-Squared: 0.079181
## F-statistic: 100.296 on 4 and 1786 DF, p-value: < 2.22e-16summary(random1)## Oneway (individual) effect Random Effect Model
## (Swamy-Arora's transformation)
##
## Call:
## plm(formula = formula_patentes, data = panel_patentes, model = "random")
##
## Unbalanced Panel: n = 225, T = 8-9, N = 2015
##
## Effects:
## var std.dev share
## idiosyncratic 0.3130 0.5594 0.441
## individual 0.3969 0.6300 0.559
## theta:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.7005 0.7162 0.7162 0.7155 0.7162 0.7162
##
## Residuals:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2.73705 -0.39829 0.04387 0.00018 0.44385 1.85482
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 4.159328 0.204993 20.2901 < 2.2e-16 ***
## log(lag_rnd + 1) 0.246249 0.043809 5.6210 1.899e-08 ***
## log(employ) 1.307620 0.057893 22.5867 < 2.2e-16 ***
## log(sales) -0.886018 0.053727 -16.4912 < 2.2e-16 ***
## merger 0.237874 0.138008 1.7236 0.08478 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 1019.9
## Residual Sum of Squares: 754.84
## R-Squared: 0.25989
## Adj. R-Squared: 0.25842
## Chisq: 708.218 on 4 DF, p-value: < 2.22e-16# Si p < 0.05, se rechaza el modelo pooled.
pFtest(within1, pooled1)##
## F test for individual effects
##
## data: formula_patentes
## F = 16.857, df1 = 224, df2 = 1786, p-value < 2.2e-16
## alternative hypothesis: significant effects# Si p < 0.05, se seleccionan efectos fijos.
phtest(within1, random1)##
## Hausman Test
##
## data: formula_patentes
## chisq = 5072, df = 4, p-value < 2.2e-16
## alternative hypothesis: one model is inconsistentLos resultados de ambas pruebas llevan a seleccionar el modelo de efectos fijos.
Heterocedasticidad y autocorrelación serial
En ambas pruebas, un valor p menor a 0.05 indica la presencia del problema evaluado.
# Heterocedasticidad
bptest(within1)##
## studentized Breusch-Pagan test
##
## data: within1
## BP = 210.83, df = 4, p-value < 2.2e-16# Autocorrelación serial
pbgtest(within1)##
## Breusch-Godfrey/Wooldridge test for serial correlation in panel models
##
## data: formula_patentes
## chisq = 198.09, df = 8, p-value < 2.2e-16
## alternative hypothesis: serial correlation in idiosyncratic errorsResultados y conclusión de la Parte 1
round(summary(within1)$coefficients, 4)## Estimate Std. Error t-value Pr(>|t|)
## log(lag_rnd + 1) -0.3306 0.0579 -5.7047 0.0000
## log(employ) 0.8787 0.0826 10.6328 0.0000
## log(sales) -0.7049 0.0606 -11.6371 0.0000
## merger -0.0580 0.1295 -0.4481 0.6541round(summary(within1)$r.squared, 4)## rsq adjrsq
## 0.1834 0.0792Pronóstico sencillo
El modelo de efectos fijos es el seleccionado para explicar los cambios dentro de las empresas observadas, para ilustrar un pronóstico de una empresa hipotética se utiliza el modelo pooled, ya que una empresa nueva no tiene un efecto fijo previamente estimado, se mantienen empleados y ventas en su mediana, se supone que no hay una fusión y se comparan tres niveles del gasto en investigación y desarrollo del año anterior.
escenarios_patentes <- data.frame(
Nivel_inversion = c("Bajo", "Medio", "Alto"),
lag_rnd = as.numeric(quantile(panel_patentes$lag_rnd,
c(0.25, 0.50, 0.75), na.rm = TRUE)),
employ = median(panel_patentes$employ, na.rm = TRUE),
sales = median(panel_patentes$sales, na.rm = TRUE),
merger = 0
)
escenarios_patentes$Patentes_pronosticadas <- round(
exp(predict(pooled1, newdata = escenarios_patentes)) - 1, 1
)
escenarios_patentes[, c("Nivel_inversion", "lag_rnd",
"Patentes_pronosticadas")]## Nivel_inversion lag_rnd Patentes_pronosticadas
## 1 Bajo 0.6222587 1.6
## 2 Medio 1.9920359 2.9
## 3 Alto 10.7930012 8.6CONCLUSIÓN: La prueba F rechaza el modelo pooled y la prueba de Hausman indica que corresponde utilizar efectos fijos, dentro de una misma empresa, el empleo presenta una relación positiva con las patentes, el gasto en investigación y desarrollo del año anterior y las ventas presentan coeficientes negativos al controlar simultáneamente por las demás variables, mientras que merger no resulta estadísticamente significativa, el coeficiente negativo del gasto rezagado no significa que invertir reduzca las patentes; indica que la variación anual dentro de una misma empresa no permite observar con claridad el efecto esperado, la relación puede requerir más tiempo o estar dominada por diferencias permanentes entre empresas.
El R² within es aproximadamente 0.183, por lo que el modelo explica cerca de 18.3% de los cambios de patentes dentro de cada empresa a través del tiempo, las pruebas detectan heterocedasticidad y autocorrelación serial. Por ello, los pronósticos deben tomarse con cautela, como referencia descriptiva, el modelo pooled pronostica aproximadamente 1.6, 2.9 y 8.6 patentes para niveles bajo, medio y alto del gasto rezagado, manteniendo constantes las demás variables.
Parte 2. Categoría del cuidado personal en la que conviene invertir
Objetivo: analizar el valor del mercado mexicano de belleza y cuidado personal por subcategoría y determinar en cuál conviene invertir.
ruta_mercado <- file.path(directorio_datos, "Market sizess.xls")
crudo <- suppressMessages(read_excel(
ruta_mercado, sheet = "Statistics Data",
col_names = FALSE, .name_repair = "minimal"
))
fila_encabezado <- which(crudo[[1]] == "Geography")
mercado <- read_excel(
ruta_mercado, sheet = "Statistics Data",
col_names = FALSE, col_types = "text"
)
fila_geo <- which(mercado[[1]] == "Geography")
names(mercado) <- as.character(unlist(mercado[fila_geo, ]))
mercado <- mercado[(fila_geo + 1):nrow(mercado), ]
agregados <- c(
"Beauty and Personal Care",
"Premium Beauty and Personal Care",
"Prestige Beauty and Personal Care",
"Mass Beauty and Personal Care",
"Dermocosmetics Beauty and Personal Care"
)
mercado_largo <- mercado %>%
filter(!Category %in% agregados) %>%
select(Categoria = Category, `2011`:`2025`) %>%
pivot_longer(-Categoria, names_to = "Anio", values_to = "Valor") %>%
mutate(Anio = as.numeric(Anio),
Valor = as.numeric(Valor),
Tiempo = Anio - 2010) %>%
as.data.frame()
panel_mercado <- pdata.frame(mercado_largo, index = c("Categoria", "Anio"))## Warning in pdata.frame(mercado_largo, index = c("Categoria", "Anio")): at least one NA in at least one index dimension in resulting pdata.frame
## to find out which, use, e.g., table(index(your_pdataframe), useNA = "ifany")pdim(panel_mercado)## Balanced Panel: n = 8, T = 15, N = 210Prueba de heterogeneidad
suppressWarnings(plotmeans(log(Valor) ~ Categoria, data = panel_mercado,
bars = FALSE,
main = "Media de log(valor de mercado) por subcategoría",
xlab = "Subcategoría", ylab = "log(MXN millones)"))
Selección del modelo
El logaritmo del valor permite interpretar el crecimiento del mercado en términos porcentuales.
formula_mercado <- log(Valor) ~ Tiempo
pooled2 <- plm(formula_mercado, data = panel_mercado, model = "pooling")
within2 <- plm(formula_mercado, data = panel_mercado, model = "within")
random2 <- plm(formula_mercado, data = panel_mercado, model = "random")
summary(pooled2)## Pooling Model
##
## Call:
## plm(formula = formula_mercado, data = panel_mercado, model = "pooling")
##
## Balanced Panel: n = 8, T = 15, N = 120
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -2.38584 -0.41554 0.39483 0.93743 1.28227
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## (Intercept) 8.910147 0.238229 37.4017 < 2e-16 ***
## Tiempo 0.067392 0.026202 2.5721 0.01135 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 191.64
## Residual Sum of Squares: 181.46
## R-Squared: 0.053087
## Adj. R-Squared: 0.045063
## F-statistic: 6.6155 on 1 and 118 DF, p-value: 0.01135summary(within2)## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = formula_mercado, data = panel_mercado, model = "within")
##
## Balanced Panel: n = 8, T = 15, N = 120
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -0.2512531 -0.0440033 0.0080207 0.0408130 0.2491496
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## Tiempo 0.0673923 0.0018042 37.353 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 10.983
## Residual Sum of Squares: 0.80937
## R-Squared: 0.92631
## Adj. R-Squared: 0.92099
## F-statistic: 1395.23 on 1 and 111 DF, p-value: < 2.22e-16summary(random2)## Oneway (individual) effect Random Effect Model
## (Swamy-Arora's transformation)
##
## Call:
## plm(formula = formula_mercado, data = panel_mercado, model = "random")
##
## Balanced Panel: n = 8, T = 15, N = 120
##
## Effects:
## var std.dev share
## idiosyncratic 0.007292 0.085391 0.004
## individual 1.720022 1.311496 0.996
## theta: 0.9832
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -0.2375666 -0.0395416 0.0040927 0.0430145 0.2246788
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) 8.9101472 0.4639740 19.204 < 2.2e-16 ***
## Tiempo 0.0673923 0.0018042 37.353 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 11.034
## Residual Sum of Squares: 0.86041
## R-Squared: 0.92202
## Adj. R-Squared: 0.92136
## Chisq: 1395.23 on 1 DF, p-value: < 2.22e-16# Si p < 0.05, se rechaza el modelo pooled.
pFtest(within2, pooled2)##
## F test for individual effects
##
## data: formula_mercado
## F = 3539.4, df1 = 7, df2 = 111, p-value < 2.2e-16
## alternative hypothesis: significant effects# Si p < 0.05, se seleccionan efectos fijos; de lo contrario, aleatorios.
phtest(within2, random2)##
## Hausman Test
##
## data: formula_mercado
## chisq = 1.6842e-14, df = 1, p-value = 1
## alternative hypothesis: one model is inconsistentLa prueba F rechaza el modelo pooled y la prueba de Hausman lleva a seleccionar el modelo de efectos aleatorios.
Diagnóstico y resultados
# Heterocedasticidad y autocorrelación serial
bptest(random2)##
## studentized Breusch-Pagan test
##
## data: random2
## BP = 0.022489, df = 1, p-value = 0.8808pbgtest(random2)##
## Breusch-Godfrey/Wooldridge test for serial correlation in panel models
##
## data: formula_mercado
## chisq = 65.624, df = 15, p-value = 2.656e-08
## alternative hypothesis: serial correlation in idiosyncratic errors# Comparación sencilla para justificar la decisión de inversión
comparacion_categorias <- mercado %>%
filter(Category %in% unique(mercado_largo$Categoria)) %>%
transmute(
Categoria = Category,
Valor_2025 = as.numeric(`2025`),
CAGR_2016_2025 = round(100 * ((as.numeric(`2025`) /
as.numeric(`2016`))^(1 / 9) - 1), 1),
Crecimiento_2021_2025 = round(100 * ((as.numeric(`2025`) /
as.numeric(`2021`))^(1 / 4) - 1), 1),
Cambio_2020 = round(100 * (as.numeric(`2020`) /
as.numeric(`2019`) - 1), 1)
) %>%
arrange(desc(Valor_2025))
comparacion_categorias## # A tibble: 14 × 5
## Categoria Valor_2025 CAGR_2016_2025 Crecimiento_2021_2025 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.6
## 9 <NA> NA NA NA NA
## 10 <NA> NA NA NA NA
## 11 <NA> NA NA NA NA
## 12 <NA> NA NA NA NA
## 13 <NA> NA NA NA NA
## 14 <NA> NA NA NA NA# Crecimiento anual común estimado
crecimiento_anual <- 100 * (exp(coef(random2)["Tiempo"]) - 1)
round(crecimiento_anual, 2)## Tiempo
## 6.97# Efecto individual de cada subcategoría
round(sort(ranef(random2), decreasing = TRUE), 3)## Skin Care Hair Care Men's Grooming Fragrances Deodorants
## 1.147 1.038 0.864 0.814 0.130
## Bath and Shower Sun Care Depilatories
## 0.031 -1.763 -2.260CONCLUSIÓN: Conviene invertir en Skin Care, es la subcategoría con el efecto individual más alto en el modelo de efectos aleatorios y también presenta el mayor valor observado en 2025, con aproximadamente 71,830 millones de pesos. Entre 2016 y 2025 creció alrededor de 9.0% anual, su crecimiento entre 2021 y 2025 fue de 10.6% anual y durante 2020 aumentó 3.8%. Estos resultados combinan tamaño, crecimiento y estabilidad.
El modelo estima un crecimiento común cercano a 6.97% anual, la prueba de heterocedasticidad no muestra evidencia de varianza desigual, aunque sí se detecta autocorrelación serial, por tanto, Skin Care es la alternativa más sólida, pero las estimaciones anuales deben interpretarse con prudencia.
Parte 3. Consumo de los hogares con datos del Banco Mundial
Objetivo: realizar un ejercicio similar con información obtenida desde R mediante la API del Banco Mundial, la variable dependiente es el consumo final de los hogares per cápita en dólares constantes de 2015. Las variables independientes son el PIB per cápita y el porcentaje de población urbana.
consumo_lat <- WDI(
country = c("MX", "BR", "CL", "CO", "AR", "PE", "CR"),
indicator = c(
consumo = "NE.CON.PRVT.PC.KD",
pib = "NY.GDP.PCAP.KD",
urbana = "SP.URB.TOTL.IN.ZS"
),
start = 2010, end = 2024
)
consumo_lat <- consumo_lat %>%
filter(!is.na(consumo), !is.na(pib), !is.na(urbana)) %>%
as.data.frame()
panel_consumo <- pdata.frame(consumo_lat, index = c("country", "year"))
pdim(panel_consumo)## Balanced Panel: n = 7, T = 15, N = 105Prueba de heterogeneidad
suppressWarnings(plotmeans(log(consumo) ~ country, data = panel_consumo,
bars = FALSE,
main = "Media de log(consumo per cápita) por país",
xlab = "País", ylab = "log(USD constantes de 2015)"))
Selección del modelo
formula_consumo <- log(consumo) ~ log(pib) + urbana
pooled3 <- plm(formula_consumo, data = panel_consumo, model = "pooling")
within3 <- plm(formula_consumo, data = panel_consumo, model = "within")
random3 <- plm(formula_consumo, data = panel_consumo, model = "random")
summary(pooled3)## Pooling Model
##
## Call:
## plm(formula = formula_consumo, data = panel_consumo, model = "pooling")
##
## Balanced Panel: n = 7, T = 15, N = 105
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -0.1038704 -0.0287773 -0.0046494 0.0314321 0.1238389
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## (Intercept) 0.11948858 0.13344484 0.8954 0.37267
## log(pib) 0.95896246 0.01627470 58.9235 < 2e-16 ***
## urbana -0.00195867 0.00089164 -2.1967 0.03031 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 9.5022
## Residual Sum of Squares: 0.22454
## R-Squared: 0.97637
## Adj. R-Squared: 0.97591
## F-statistic: 2107.28 on 2 and 102 DF, p-value: < 2.22e-16summary(within3)## Oneway (individual) effect Within Model
##
## Call:
## plm(formula = formula_consumo, data = panel_consumo, model = "within")
##
## Balanced Panel: n = 7, T = 15, N = 105
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -0.06344039 -0.01340317 0.00010155 0.01242358 0.07474611
##
## Coefficients:
## Estimate Std. Error t-value Pr(>|t|)
## log(pib) 1.1306867 0.0505095 22.3856 < 2e-16 ***
## urbana 0.0047885 0.0023837 2.0088 0.04736 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 0.76049
## Residual Sum of Squares: 0.06211
## R-Squared: 0.91833
## Adj. R-Squared: 0.91152
## F-statistic: 539.732 on 2 and 96 DF, p-value: < 2.22e-16summary(random3)## Oneway (individual) effect Random Effect Model
## (Swamy-Arora's transformation)
##
## Call:
## plm(formula = formula_consumo, data = panel_consumo, model = "random")
##
## Balanced Panel: n = 7, T = 15, N = 105
##
## Effects:
## var std.dev share
## idiosyncratic 0.000647 0.025436 0.25
## individual 0.001945 0.044097 0.75
## theta: 0.8527
##
## Residuals:
## Min. 1st Qu. Median 3rd Qu. Max.
## -0.07647457 -0.01201640 0.00081032 0.01030433 0.08473644
##
## Coefficients:
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept) -1.3711922 0.3072607 -4.4626 8.096e-06 ***
## log(pib) 1.0700702 0.0415567 25.7496 < 2.2e-16 ***
## urbana 0.0037547 0.0020487 1.8327 0.06684 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Total Sum of Squares: 0.95018
## Residual Sum of Squares: 0.076072
## R-Squared: 0.91994
## Adj. R-Squared: 0.91837
## Chisq: 1172.04 on 2 DF, p-value: < 2.22e-16# Si p < 0.05, se rechaza el modelo pooled.
pFtest(within3, pooled3)##
## F test for individual effects
##
## data: formula_consumo
## F = 41.843, df1 = 6, df2 = 96, p-value < 2.2e-16
## alternative hypothesis: significant effects# Si p < 0.05, se seleccionan efectos fijos.
phtest(within3, random3)##
## Hausman Test
##
## data: formula_consumo
## chisq = 33.491, df = 2, p-value = 5.34e-08
## alternative hypothesis: one model is inconsistentLas pruebas indican que corresponde utilizar el modelo de efectos fijos.
Diagnóstico, resultados y conclusión
# Heterocedasticidad y autocorrelación serial
bptest(within3)##
## studentized Breusch-Pagan test
##
## data: within3
## BP = 3.6113, df = 2, p-value = 0.1644pbgtest(within3)##
## Breusch-Godfrey/Wooldridge test for serial correlation in panel models
##
## data: formula_consumo
## chisq = 57.055, df = 15, p-value = 8.031e-07
## alternative hypothesis: serial correlation in idiosyncratic errorsround(summary(within3)$coefficients, 5)## Estimate Std. Error t-value Pr(>|t|)
## log(pib) 1.13069 0.05051 22.38564 0.00000
## urbana 0.00479 0.00238 2.00884 0.04736round(summary(within3)$r.squared, 4)## rsq adjrsq
## 0.9183 0.9115# Escenario sencillo para México con un aumento de 10% en el PIB per cápita
elasticidad_pib <- as.numeric(coef(within3)["log(pib)"])
mexico_reciente <- consumo_lat %>%
filter(iso2c == "MX") %>%
arrange(desc(year)) %>%
slice(1)
escenario_mexico <- data.frame(
Escenario = c("PIB actual", "PIB per capita +10%"),
Consumo_estimado = round(c(
mexico_reciente$consumo,
mexico_reciente$consumo * 1.10^elasticidad_pib
), 0)
)
escenario_mexico## Escenario Consumo_estimado
## 1 PIB actual 7451
## 2 PIB per capita +10% 8298CONCLUSIÓN: La prueba F rechaza el modelo pooled y la prueba de Hausman selecciona efectos fijos, el coeficiente de log(pib) es aproximadamente 1.13: manteniendo constante la urbanización, un aumento de 1% en el PIB per cápita se relaciona con un incremento aproximado de 1.13% en el consumo per cápita, el coeficiente de urbanización también es positivo; un punto porcentual adicional de población urbana se relaciona con un aumento cercano a 0.48% en el consumo.
El modelo explica aproximadamente 91.8% de la variación del consumo dentro de los países. No se encuentra evidencia de heterocedasticidad, pero sí de autocorrelación serial. En el escenario sencillo para México, un aumento de 10% en el PIB per cápita implica un crecimiento estimado del consumo cercano a 11.4%. En general, el ingreso es el principal determinante del consumo de los hogares en el panel analizado.
Referencias
Hall, B. H., Griliches, Z. y Hausman, J. A. (1986). Patents and R&D: Is There a Lag? International Economic Review, 27(2), 265–284. https://doi.org/10.2307/2526504