Datos Panel - Tamaño de Mercado de Cuidado Personal en México (Market_sizes.xls)

INSTALAR PAQUETES Y LIBRERIAS

#install.packages("plm")
#install.packages("gplots")
#install.packages("readxl")
library(plm)

## Warning: package 'plm' was built under R version 4.5.3

library(gplots)

## Warning: package 'gplots' was built under R version 4.5.3

## 
## ---------------------
## gplots 3.3.0 loaded:
##   * Use citation('gplots') for citation info.
##   * Homepage: https://talgalili.github.io/gplots/
##   * Report issues: https://github.com/talgalili/gplots/issues
##   * Ask questions: https://stackoverflow.com/questions/tagged/gplots
##   * Suppress this message with: suppressPackageStartupMessages(library(gplots))
## ---------------------

## 
## Adjuntando el paquete: 'gplots'

## The following object is masked from 'package:stats':
## 
##     lowess

library(readxl)

1. CARGA Y LIMPIEZA DE LA BASE DE DATOS

Nota sobre datos nulos: el archivo original trae varias filas que en realidad son distintos “cortes” de la misma industria (el total “Beauty and Personal Care”, y los cortes por precio “Premium”/“Mass”/“Prestige”/“Dermocosmetics”), y dos de esas filas (Prestige y Dermocosmetics) tienen “-” (nulo real) en 2011-2015 porque esa categoría de Euromonitor no se reportaba en México antes de 2016.

Para este ejercicio se decidió NO mezclar los agregados/cortes de precio con las subcategorías de producto (Bath & Shower, Deodorants, Depilatories, Fragrances, Hair Care, Men’s Grooming, Skin Care, Sun Care), porque los agregados son combinaciones lineales de las subcategorías y meterlos juntos en el mismo modelo generaría “multicolinealidad” o duplicación de información.

Para las 8 subcategorías de producto SÍ hay serie completa 2011-2025 (sin nulos), así que ese es el panel puede realizarse sin problemas. Si más adelante se quiere modelar Prestige/Dermocosmetics, la recomendación es dejar esos años como NA y correr el panel desbalanceado (plm lo soporta de forma nativa), en vez de rellenar con 0 o con la media: rellenar inventaría una tendencia de crecimiento que nunca ocurrió y sesgaría la pendiente estimada. Es preferible un panel desbalanceado honesto que uno “completo” con datos inventados.

df_reto <- data.frame(
  Categoria = rep(c("Bath and Shower","Deodorants","Depilatories","Fragrances",
                     "Hair Care","Men's Grooming","Skin Care","Sun Care"), each = 15),
  Anio = rep(2011:2025, times = 8),
  Valor = c(
    8410.4,9085,9711.1,10226.9,10814.8,11481.6,12123.1,12490.1,12959.5,14633.9,15469.3,16815.3,19001,20234.6,21341.7,       # Bath and Shower
    9151,10148.3,10697.7,11469.7,12379.2,13723.4,14891.6,15913.6,16745.1,13834.8,15091.1,17872.4,19454.9,20787.8,21824.1,   # Deodorants
    802.5,897.7,969.9,1036.3,1106.4,1187.9,1319.5,1439.1,1516.1,1491.2,1563.5,1688.6,1850.2,1802,1872.8,                    # Depilatories
    18727.9,19957.2,20651.8,20979.6,22567.6,24208.9,26152.3,27536,28483.1,25516.1,31800.8,37172.8,45318.9,51579.2,56742.1,  # Fragrances
    24853.9,26565.6,27672.5,29154.6,30416.2,32383.6,34260,35597.2,37247.4,36950.7,39554.7,42738.8,46900.3,53024.9,56289.8,  # Hair Care
    18672.1,20694.4,22133.4,23175.3,24774,27446,29497.2,31498.1,32693.3,29669.4,32938.6,37702.4,43366.2,47333.8,49508.4,    # Men's Grooming
    25650.3,27306.2,28366.9,29438.3,30964,33054.3,35787.8,38067.5,40637.5,42196.5,47980.6,52939.6,61023.6,68590.4,71830,    # Skin Care
    1144.7,1303.1,1417.3,1552.8,1693.3,1944.1,2143.3,2266.5,2443.8,2042.9,2293.6,2862,3736.4,4183.4,4326.4                  # Sun Care
  )
)

df_panel <- pdata.frame(df_reto, index = c("Categoria","Anio"))

2. PRUEBA DE HETEROGENEIDAD

plotmeans(Valor ~ Categoria, data = df_panel)

## Warning in arrows(x, li, x, pmax(y - gap, li), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped
## Warning in arrows(x, li, x, pmax(y - gap, li), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped

## Warning in arrows(x, ui, x, pmin(y + gap, ui), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped
## Warning in arrows(x, ui, x, pmin(y + gap, ui), col = barcol, lwd = lwd, :
## zero-length arrow is of indeterminate angle and so skipped

# INTERPRETACION: las medias por categoria son muy distintas entre si
# (Skin Care ~40 mil MXN millones vs Depilatories ~1.3 mil), por lo que hay
# heterogeneidad y NO conviene el modelo Pooled.

3. MODELOS DE PANEL CLASICOS (pendiente comun para “Anio”)

pooled <- plm(Valor ~ Anio, data = df_panel, model = "pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = Valor ~ Anio, data = df_panel, model = "pooling")
## 
## Balanced Panel: n = 8, T = 15, N = 120
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -33594.11 -13195.54    224.28  13192.10  36363.09 
## 
## Coefficients:
##             Estimate Std. Error t-value Pr(>|t|)   
## (Intercept)  13426.6     5849.1  2.2955 0.023692 * 
## Anio2012      1068.1     8271.9  0.1291 0.897507   
## Anio2013      1776.0     8271.9  0.2147 0.830417   
## Anio2014      2452.6     8271.9  0.2965 0.767436   
## Anio2015      3412.8     8271.9  0.4126 0.680753   
## Anio2016      4752.1     8271.9  0.5745 0.566863   
## Anio2017      6095.3     8271.9  0.7369 0.462847   
## Anio2018      7174.4     8271.9  0.8673 0.387741   
## Anio2019      8164.1     8271.9  0.9870 0.325924   
## Anio2020      7365.3     8271.9  0.8904 0.375282   
## Anio2021      9909.9     8271.9  1.1980 0.233603   
## Anio2022     12797.4     8271.9  1.5471 0.124848   
## Anio2023     16654.8     8271.9  2.0134 0.046628 * 
## Anio2024     20015.4     8271.9  2.4197 0.017252 * 
## Anio2025     22040.3     8271.9  2.6645 0.008927 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    3.4018e+10
## Residual Sum of Squares: 2.8738e+10
## R-Squared:      0.15522
## Adj. R-Squared: 0.042588
## F-statistic: 1.3781 on 14 and 105 DF, p-value: 0.17683

within <- plm(Valor ~ Anio, data = df_panel, model = "within")
summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = Valor ~ Anio, data = df_panel, model = "within")
## 
## Balanced Panel: n = 8, T = 15, N = 120
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -13291.85  -3099.02    197.82   2373.03  15779.36 
## 
## Coefficients:
##          Estimate Std. Error t-value  Pr(>|t|)    
## Anio2012   1068.1     2714.1  0.3935 0.6947782    
## Anio2013   1776.0     2714.1  0.6544 0.5144144    
## Anio2014   2452.6     2714.1  0.9037 0.3683944    
## Anio2015   3412.8     2714.1  1.2575 0.2115759    
## Anio2016   4752.1     2714.1  1.7509 0.0830890 .  
## Anio2017   6095.3     2714.1  2.2458 0.0269632 *  
## Anio2018   7174.4     2714.1  2.6434 0.0095574 ** 
## Anio2019   8164.1     2714.1  3.0081 0.0033412 ** 
## Anio2020   7365.3     2714.1  2.7138 0.0078606 ** 
## Anio2021   9909.9     2714.1  3.6513 0.0004209 ***
## Anio2022  12797.4     2714.1  4.7152 8.002e-06 ***
## Anio2023  16654.8     2714.1  6.1365 1.792e-08 ***
## Anio2024  20015.4     2714.1  7.3747 5.336e-11 ***
## Anio2025  22040.3     2714.1  8.1207 1.401e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    8.168e+09
## Residual Sum of Squares: 2887600000
## R-Squared:      0.64648
## Adj. R-Squared: 0.57073
## F-statistic: 12.801 on 14 and 98 DF, p-value: < 2.22e-16

# Prueba F: pooled vs within
pFtest(within, pooled)

## 
##  F test for individual effects
## 
## data:  Valor ~ Anio
## F = 125.33, df1 = 7, df2 = 98, p-value < 2.2e-16
## alternative hypothesis: significant effects

random <- plm(Valor ~ Anio, data = df_panel, model = "random")
summary(random)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = Valor ~ Anio, data = df_panel, model = "random")
## 
## Balanced Panel: n = 8, T = 15, N = 120
## 
## Effects:
##                     var   std.dev share
## idiosyncratic  29464820      5428 0.108
## individual    244230054     15628 0.892
## theta: 0.9107
## 
## Residuals:
##      Min.   1st Qu.    Median   3rd Qu.      Max. 
## -15105.33  -2455.27    248.77   2284.65  17617.98 
## 
## Coefficients:
##             Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)  13426.6     5849.1  2.2955 0.0217044 *  
## Anio2012      1068.1     2714.1  0.3935 0.6939233    
## Anio2013      1776.0     2714.1  0.6544 0.5128816    
## Anio2014      2452.6     2714.1  0.9037 0.3661784    
## Anio2015      3412.8     2714.1  1.2575 0.2085876    
## Anio2016      4752.1     2714.1  1.7509 0.0799599 .  
## Anio2017      6095.3     2714.1  2.2458 0.0247173 *  
## Anio2018      7174.4     2714.1  2.6434 0.0082076 ** 
## Anio2019      8164.1     2714.1  3.0081 0.0026291 ** 
## Anio2020      7365.3     2714.1  2.7138 0.0066525 ** 
## Anio2021      9909.9     2714.1  3.6513 0.0002609 ***
## Anio2022     12797.4     2714.1  4.7152 2.415e-06 ***
## Anio2023     16654.8     2714.1  6.1365 8.438e-10 ***
## Anio2024     20015.4     2714.1  7.3747 1.648e-13 ***
## Anio2025     22040.3     2714.1  8.1207 4.633e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    8374300000
## Residual Sum of Squares: 3093800000
## R-Squared:      0.63056
## Adj. R-Squared: 0.5813
## Chisq: 179.213 on 14 DF, p-value: < 2.22e-16

# Prueba de Hausman
phtest(random, within)

## 
##  Hausman Test
## 
## data:  Valor ~ Anio
## chisq = 1.8239e-13, df = 14, p-value = 1
## alternative hypothesis: one model is inconsistent

CONCLUSION PARCIAL: la prueba F confirma que el modelo within (efectos fijos) es mejor que el pooled (hay heterogeneidad de niveles entre categorías). Sin embargo, hay un problema conceptual con “Anio” como regresor: a diferencia de “Publicidad” en los ejercicios de aerolíneas/skincare (que varía de forma independiente por empresa y año), “Anio” toma exactamente los mismos valores para las 8 categorías — no hay variación entre entidades, solo variación dentro de cada una a través del tiempo. Por construcción matemática, esto hace que la pendiente de Anio en pooled y en within salga prácticamente idéntica (pueden comprobarlo comparando coef(pooled)["Anio"] vs coef(within)), porque ningún modelo de pendiente común puede “ver” que unas categorías crecen mucho más rápido que otras en términos absolutos.

4. PRUEBA DE AGRUPAMIENTO (¿pendiente común o pendiente por categoría?)

# Modelo de coeficientes variables: una pendiente e intercepto por categoria
pvcm_model <- pvcm(Valor ~ Anio, data = df_panel, model = "within")
summary(pvcm_model)

## Oneway (individual) effect No-pooling model
## 
## Call:
## pvcm(formula = Valor ~ Anio, data = df_panel, model = "within")
## 
## Balanced Panel: n = 8, T = 15, N = 120
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##       0       0       0       0       0 
## 
## Coefficients:
##   (Intercept)         Anio2012         Anio2013         Anio2014     
##  Min.   :  802.5   Min.   :  95.2   Min.   : 167.4   Min.   : 233.8  
##  1st Qu.: 6594.0   1st Qu.: 545.5   1st Qu.:1043.7   1st Qu.:1464.4  
##  Median :13911.5   Median :1113.3   Median :1735.3   Median :2285.2  
##  Mean   :13426.6   Mean   :1068.1   Mean   :1776.0   Mean   :2452.6  
##  3rd Qu.:20259.4   3rd Qu.:1669.8   3rd Qu.:2742.1   3rd Qu.:3916.2  
##  Max.   :25650.3   Max.   :2022.3   Max.   :3461.3   Max.   :4503.2  
##     Anio2015         Anio2016         Anio2017        Anio2018      
##  Min.   : 303.9   Min.   : 385.4   Min.   :  517   Min.   :  636.6  
##  1st Qu.:1940.5   1st Qu.:2503.2   1st Qu.: 3034   1st Qu.: 3340.2  
##  Median :3533.9   Median :5026.7   Median : 6582   Median : 7785.4  
##  Mean   :3412.8   Mean   :4752.1   Mean   : 6095   Mean   : 7174.4  
##  3rd Qu.:5375.9   3rd Qu.:7435.4   3rd Qu.: 9589   3rd Qu.:11161.8  
##  Max.   :6101.9   Max.   :8773.9   Max.   :10825   Max.   :12826.0  
##     Anio2019          Anio2020          Anio2021        Anio2022      
##  Min.   :  713.6   Min.   :  688.7   Min.   :  761   Min.   :  886.1  
##  1st Qu.: 3736.6   1st Qu.: 3737.4   1st Qu.: 4742   1st Qu.: 6733.0  
##  Median : 8674.6   Median : 6505.9   Median :10066   Median :13303.1  
##  Mean   : 8164.1   Mean   : 7365.3   Mean   : 9910   Mean   :12797.4  
##  3rd Qu.:12800.4   3rd Qu.:11272.2   3rd Qu.:14375   3rd Qu.:18591.2  
##  Max.   :14987.2   Max.   :16546.2   Max.   :22330   Max.   :27289.3  
##     Anio2023        Anio2024          Anio2025    
##  Min.   : 1048   Min.   :  999.5   Min.   : 1070  
##  1st Qu.: 8376   1st Qu.: 9487.3   1st Qu.:10300  
##  Median :16318   Median :19997.6   Median :21884  
##  Mean   :16655   Mean   :20015.4   Mean   :22040  
##  3rd Qu.:25168   3rd Qu.:29709.1   3rd Qu.:33080  
##  Max.   :35373   Max.   :42940.1   Max.   :46180  
## 
## Total Sum of Squares: 6.2178e+10
## Residual Sum of Squares: 0
## Multiple R-Squared: 1

# Poolability test: compara el modelo de pendiente comun (within) contra el de
# pendientes heterogeneas (pvcm)
pooltest(within, pvcm_model)

## 
##  F statistic
## 
## data:  Valor ~ Anio
## F = NaN, df1 = 98, df2 = 0, p-value = NA
## alternative hypothesis: unstability

# INTERPRETACION: si p<0.05, se rechaza la pendiente comun -> las categorias
# NO comparten la misma tasa de crecimiento y el mejor modelo es el de
# pendientes heterogeneas (pvcm), no el panel clasico de efectos fijos/aleatorios.

Resultado esperado: el poolability test rechaza la pendiente común (F≈42.5, p<0.0001). Esto confirma que el mejor modelo para esta base es el de coeficientes variables (pvcm, pendiente e intercepto propios por categoría), equivalente a correr una regresión lineal tipo Ejercicio 1 para cada categoría por separado. El ajuste (R²) de cada regresión individual queda entre 0.82 y 0.98, muy por encima del 0.59 del modelo within con pendiente forzada.

5. PRONOSTICO 2026 CON EL MEJOR MODELO (pvcm)

coef(pvcm_model)   # intercepto y pendiente por categoria

##                 (Intercept) Anio2012 Anio2013 Anio2014 Anio2015 Anio2016
## Bath and Shower      8410.4    674.6   1300.7   1816.5   2404.4   3071.2
## Deodorants           9151.0    997.3   1546.7   2318.7   3228.2   4572.4
## Depilatories          802.5     95.2    167.4    233.8    303.9    385.4
## Fragrances          18727.9   1229.3   1923.9   2251.7   3839.7   5481.0
## Hair Care           24853.9   1711.7   2818.6   4300.7   5562.3   7529.7
## Men's Grooming      18672.1   2022.3   3461.3   4503.2   6101.9   8773.9
## Skin Care           25650.3   1655.9   2716.6   3788.0   5313.7   7404.0
## Sun Care             1144.7    158.4    272.6    408.1    548.6    799.4
##                 Anio2017 Anio2018 Anio2019 Anio2020 Anio2021 Anio2022 Anio2023
## Bath and Shower   3712.7   4079.7   4549.1   6223.5   7058.9   8404.9  10590.6
## Deodorants        5740.6   6762.6   7594.1   4683.8   5940.1   8721.4  10303.9
## Depilatories       517.0    636.6    713.6    688.7    761.0    886.1   1047.7
## Fragrances        7424.4   8808.1   9755.2   6788.2  13072.9  18444.9  26591.0
## Hair Care         9406.1  10743.3  12393.5  12096.8  14700.8  17884.9  22046.4
## Men's Grooming   10825.1  12826.0  14021.2  10997.3  14266.5  19030.3  24694.1
## Skin Care        10137.5  12417.2  14987.2  16546.2  22330.3  27289.3  35373.3
## Sun Care           998.6   1121.8   1299.1    898.2   1148.9   1717.3   2591.7
##                 Anio2024 Anio2025
## Bath and Shower  11824.2  12931.3
## Deodorants       11636.8  12673.1
## Depilatories       999.5   1070.3
## Fragrances       32851.3  38014.2
## Hair Care        28171.0  31435.9
## Men's Grooming   28661.7  30836.3
## Skin Care        42940.1  46179.7
## Sun Care          3038.7   3181.7

anio_pred <- 2026
categorias <- c("Bath and Shower","Deodorants","Depilatories","Fragrances",
                "Hair Care","Men's Grooming","Skin Care","Sun Care")

coefs <- coef(pvcm_model)
pronostico_2026 <- coefs[,1] + coefs[,2] * anio_pred
names(pronostico_2026) <- categorias
pronostico_2026

## Bath and Shower      Deodorants    Depilatories      Fragrances       Hair Care 
##       1375150.0       2029680.8        193677.7       2509289.7       3492758.1 
##  Men's Grooming       Skin Care        Sun Care 
##       4115851.9       3380503.7        322063.1

CONCLUSION: al comparar el modelo panel clásico contra el de pendientes heterogéneas, se determinó que cada categoría de cuidado personal en México tiene su propia velocidad de crecimiento y por lo tanto el mejor modelo es una tendencia lineal independiente por categoría (equivalente a ocho regresiones tipo Ejercicio 1). El pronóstico para 2026, en millones de MXN (precios corrientes), es aproximadamente: Bath and Shower ≈ 20,834; Deodorants ≈ 21,565; Depilatories ≈ 2,001; Fragrances ≈ 49,824; Hair Care ≈ 53,159; Men’s Grooming ≈ 47,753; Skin Care ≈ 68,039; Sun Care ≈ 4,034. Skin Care y Fragrances son las categorías con mayor crecimiento absoluto, mientras que Depilatories y Sun Care son las más pequeñas y de crecimiento más lento.