Actividad 1. Análisis y aplicación de datos panel (actividad individual)

#Importar paquetes

library(plm)
library(gplots)

## 
## ---------------------
## 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))
## ---------------------

## 
## Attaching package: 'gplots'

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

library(readxl)
library(WDI)

#Parte 1. Patentes

##Importar base de datos

df1 <- read_excel("C:/Users/Rafael Navarro/Desktop/PATENT 3.xls", sheet="Sheet1")

df1 <- pdata.frame(df1, index=c("cusip","year"))

##Regresion lineal

modelo_regresion1 <- lm(patents ~ year, data=df1)
summary(modelo_regresion1)

## 
## Call:
## lm(formula = patents ~ year, data = df1)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -27.42 -24.04 -19.04  -3.94 879.96 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  26.2434     4.6307   5.667 1.64e-08 ***
## year2013     -0.2080     6.5488  -0.032  0.97467    
## year2014      0.4646     6.5488   0.071  0.94345    
## year2015      1.1814     6.5488   0.180  0.85685    
## year2016     -0.5796     6.5488  -0.089  0.92948    
## year2017     -0.5310     6.5488  -0.081  0.93539    
## year2018     -1.8274     6.5488  -0.279  0.78023    
## year2019     -2.7345     6.5488  -0.418  0.67631    
## year2020     -7.8673     6.5488  -1.201  0.22975    
## year2021    -21.3009     6.5488  -3.253  0.00116 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 69.61 on 2250 degrees of freedom
## Multiple R-squared:  0.008572,   Adjusted R-squared:  0.004606 
## F-statistic: 2.161 on 9 and 2250 DF,  p-value: 0.022

##Prueba de Heterogeneidad

plotmeans(patents ~ year, data=df1)

##Modelo Agrupado

# Opcion 1 - Modelo de Regresion Agrupada (Pooled)
pooled1 <- plm(patents ~ year, data=df1, model="pooling")
summary(pooled1)

## Pooling Model
## 
## Call:
## plm(formula = patents ~ year, data = df1, model = "pooling")
## 
## Balanced Panel: n = 226, T = 10, N = 2260
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -27.42  -24.04  -19.04   -3.94  879.96 
## 
## Coefficients:
##              Estimate Std. Error t-value  Pr(>|t|)    
## (Intercept)  26.24336    4.63072  5.6672 1.637e-08 ***
## year2013     -0.20796    6.54882 -0.0318   0.97467    
## year2014      0.46460    6.54882  0.0709   0.94345    
## year2015      1.18142    6.54882  0.1804   0.85685    
## year2016     -0.57965    6.54882 -0.0885   0.92948    
## year2017     -0.53097    6.54882 -0.0811   0.93539    
## year2018     -1.82743    6.54882 -0.2790   0.78023    
## year2019     -2.73451    6.54882 -0.4176   0.67631    
## year2020     -7.86726    6.54882 -1.2013   0.22975    
## year2021    -21.30088    6.54882 -3.2526   0.00116 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    10998000
## Residual Sum of Squares: 10904000
## R-Squared:      0.0085716
## Adj. R-Squared: 0.0046059
## F-statistic: 2.16143 on 9 and 2250 DF, p-value: 0.022004

##Modelo de Efectos Fijos

# Opcion 2 - Modelo de Efectos Fijos (Within)
within1 <- plm(patents ~ year, data=df1, model="within")
summary(within1)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = patents ~ year, data = df1, model = "within")
## 
## Balanced Panel: n = 226, T = 10, N = 2260
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -570.94   -3.92   -1.91    3.40  179.28 
## 
## Coefficients:
##           Estimate Std. Error  t-value  Pr(>|t|)    
## year2013  -0.20796    2.08752  -0.0996 0.9206537    
## year2014   0.46460    2.08752   0.2226 0.8238994    
## year2015   1.18142    2.08752   0.5659 0.5714961    
## year2016  -0.57965    2.08752  -0.2777 0.7812927    
## year2017  -0.53097    2.08752  -0.2544 0.7992465    
## year2018  -1.82743    2.08752  -0.8754 0.3814558    
## year2019  -2.73451    2.08752  -1.3099 0.1903672    
## year2020  -7.86726    2.08752  -3.7687 0.0001688 ***
## year2021 -21.30088    2.08752 -10.2039 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1091400
## Residual Sum of Squares: 997160
## R-Squared:      0.086375
## Adj. R-Squared: -0.019199
## F-statistic: 21.2718 on 9 and 2025 DF, p-value: < 2.22e-16

##Prueba F

# Prueba F
# INTERPRETACION: Si P < 0.05 No usar pooled, Si P > usar pooled.
pFtest(within1,pooled1) #ojo: El primer argumento es el modelo within.

## 
##  F test for individual effects
## 
## data:  patents ~ year
## F = 89.416, df1 = 225, df2 = 2025, p-value < 2.2e-16
## alternative hypothesis: significant effects

##Modelo de Efectos Aleatorios

#Opcion 3 - Modelo de Efectos Aleaotrios (Random)
Random1 <- plm(patents ~ year, data=df1, model="random")
summary(Random1)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = patents ~ year, data = df1, model = "random")
## 
## Balanced Panel: n = 226, T = 10, N = 2260
## 
## Effects:
##                   var std.dev share
## idiosyncratic  492.43   22.19 0.102
## individual    4353.81   65.98 0.898
## theta: 0.8942
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -493.32   -5.84   -3.72    2.11  223.59 
## 
## Coefficients:
##              Estimate Std. Error  z-value  Pr(>|z|)    
## (Intercept)  26.24336    4.63072   5.6672 1.451e-08 ***
## year2013     -0.20796    2.08752  -0.0996 0.9206439    
## year2014      0.46460    2.08752   0.2226 0.8238769    
## year2015      1.18142    2.08752   0.5659 0.5714334    
## year2016     -0.57965    2.08752  -0.2777 0.7812643    
## year2017     -0.53097    2.08752  -0.2544 0.7992207    
## year2018     -1.82743    2.08752  -0.8754 0.3813519    
## year2019     -2.73451    2.08752  -1.3099 0.1902186    
## year2020     -7.86726    2.08752  -3.7687 0.0001641 ***
## year2021    -21.30088    2.08752 -10.2039 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1202200
## Residual Sum of Squares: 1108000
## R-Squared:      0.078415
## Adj. R-Squared: 0.074729
## Chisq: 191.446 on 9 DF, p-value: < 2.22e-16

##Prueba de Hausman

# Prueba de Hausman
# INTERPRETACION: Si P < 0.05 usar efectos fijos, Si P > usar efectos aleatorios.
phtest(Random1,within1) #Ojo: El primer argumento es el modelo random

## 
##  Hausman Test
## 
## data:  patents ~ year
## chisq = 2.1163e-12, df = 9, p-value = 1
## alternative hypothesis: one model is inconsistent

# Por lo tanto, el mejor modelo para este panel es el de EFECTOS ALEATORIOS.

##Predicciones de Patentes

df1_pronostico <- data.frame(
  cusip = unique(as.character(df1$cusip)),
  year = 2022
)

intercepto1 <- coef(Random1)["(Intercept)"]
pendiente1 <- coef(Random1)["year"]

theta1 <- as.numeric(ercomp(Random1)$theta)

residuos1 <- df1$patents -
             (intercepto1 + pendiente1*df1$year)

## Warning in Ops.factor(e1, e2): '*' not meaningful for factors

media_residuos1 <- tapply(residuos1, df1$cusip, mean)

efectos1 <- (1 - (1 - theta1)^2) * media_residuos1

efecto_empresa1 <- efectos1[as.character(df1_pronostico$cusip)]

df1_pronostico$patents <- intercepto1 + efecto_empresa1 +
                           pendiente1*df1_pronostico$year

df1_pronostico[,c("cusip","patents")]

##      cusip patents
## 1      800      NA
## 2     4626      NA
## 3     4671      NA
## 4     7500      NA
## 5     7603      NA
## 6    20753      NA
## 7    21367      NA
## 8    23519      NA
## 9    29069      NA
## 10   38213      NA
## 11   54303      NA
## 12   67131      NA
## 13   67383      NA
## 14   74077      NA
## 15   77491      NA
## 16   87509      NA
## 17   87779      NA
## 18  105655      NA
## 19  118745      NA
## 20  125761      NA
## 21  126149      NA
## 22  134429      NA
## 23  147195      NA
## 24  149123      NA
## 25  158663      NA
## 26  165339      NA
## 27  171196      NA
## 28  172172      NA
## 29  189873      NA
## 30  200291      NA
## 31  202363      NA
## 32  212363      NA
## 33  212813      NA
## 34  229669      NA
## 35  235773      NA
## 36  235811      NA
## 37  244199      NA
## 38  252741      NA
## 39  266867      NA
## 40  268039      NA
## 41  277461      NA
## 42  278058      NA
## 43  286065      NA
## 44  296659      NA
## 45  296695      NA
## 46  303711      NA
## 47  316549      NA
## 48  345370      NA
## 49  345838      NA
## 50  350244      NA
## 51  351604      NA
## 52  361428      NA
## 53  361556      NA
## 54  361606      NA
## 55  362360      NA
## 56  368298      NA
## 57  368514      NA
## 58  369032      NA
## 59  369154      NA
## 60  369550      NA
## 61  369604      NA
## 62  369856      NA
## 63  370622      NA
## 64  370838      NA
## 65  372298      NA
## 66  375046      NA
## 67  375766      NA
## 68  377352      NA
## 69  383492      NA
## 70  383550      NA
## 71  383883      NA
## 72  384109      NA
## 73  390568      NA
## 74  402784      NA
## 75  404245      NA
## 76  413342      NA
## 77  413875      NA
## 78  415864      NA
## 79  421596      NA
## 80  422191      NA
## 81  423002      NA
## 82  423236      NA
## 83  428399      NA
## 84  428875      NA
## 85  429812      NA
## 86  439272      NA
## 87  449290      NA
## 88  449680      NA
## 89  451542      NA
## 90  451650      NA
## 91  456866      NA
## 92  457186      NA
## 93  457776      NA
## 94  459101      NA
## 95  459200      NA
## 96  459506      NA
## 97  459578      NA
## 98  459884      NA
## 99  460043      NA
## 100 461135      NA
## 101 462218      NA
## 102 465632      NA
## 103 479169      NA
## 104 481070      NA
## 105 481088      NA
## 106 481196      NA
## 107 486872      NA
## 108 487836      NA
## 109 489170      NA
## 110 493503      NA
## 111 494368      NA
## 112 495620      NA
## 113 501026      NA
## 114 501206      NA
## 115 503624      NA
## 116 505336      NA
## 117 513696      NA
## 118 513847      NA
## 119 524660      NA
## 120 530000      NA
## 121 538021      NA
## 122 539821      NA
## 123 540137      NA
## 124 540210      NA
## 125 541381      NA
## 126 543213      NA
## 127 551120      NA
## 128 551137      NA
## 129 552618      NA
## 130 562706      NA
## 131 574055      NA
## 132 574599      NA
## 133 575379      NA
## 134 576680      NA
## 135 580033      NA
## 136 580169      NA
## 137 580628      NA
## 138 585055      NA
## 139 589331      NA
## 140 597715      NA
## 141 601073      NA
## 142 608030      NA
## 143 608183      NA
## 144 620076      NA
## 145 629853      NA
## 146 637742      NA
## 147 670148      NA
## 148 670250      NA
## 149 680665      NA
## 150 690207      NA
## 151 690734      NA
## 152 690768      NA
## 153 704562      NA
## 154 707389      NA
## 155 717081      NA
## 156 718320      NA
## 157 724479      NA
## 158 727346      NA
## 159 727491      NA
## 160 736245      NA
## 161 737407      NA
## 162 739732      NA
## 163 739868      NA
## 164 740512      NA
## 165 746252      NA
## 166 746299      NA
## 167 749720      NA
## 168 749738      NA
## 169 750633      NA
## 170 754688      NA
## 171 754713      NA
## 172 755111      NA
## 173 756040      NA
## 174 758114      NA
## 175 760354      NA
## 176 760881      NA
## 177 760898      NA
## 178 761406      NA
## 179 766481      NA
## 180 767329      NA
## 181 768024      NA
## 182 770196      NA
## 183 770519      NA
## 184 770553      NA
## 185 775133      NA
## 186 775371      NA
## 187 776338      NA
## 188 776678      NA
## 189 776755      NA
## 190 784015      NA
## 191 784626      NA
## 192 794099      NA
## 193 799850      NA
## 194 809367      NA
## 195 809877      NA
## 196 810640      NA
## 197 817698      NA
## 198 817732      NA
## 199 820208      NA
## 200 822440      NA
## 201 826520      NA
## 202 828675      NA
## 203 831865      NA
## 204 832110      NA
## 205 832248      NA
## 206 832377      NA
## 207 833034      NA
## 208 847235      NA
## 209 847567      NA
## 210 847660      NA
## 211 848355      NA
## 212 853683      NA
## 213 853700      NA
## 214 853734      NA
## 215 853836      NA
## 216 853887      NA
## 217 857721      NA
## 218 859264      NA
## 219 866645      NA
## 220 866762      NA
## 221 870326      NA
## 222 871140      NA
## 223 871565      NA
## 224 871616      NA
## 225 878308      NA
## 226 878555      NA

CONCLUSION: La base presenta heterogeneidad entre empresas, por lo que el modelo agrupado no es la mejor opcion. La prueba de Hausman favorece el modelo de efectos aleatorios. El modelo muestra una tendencia general a la baja en el numero de patentes a traves del tiempo, aunque cada empresa tiene un nivel diferente de patentes. Con el modelo de efectos aleatorios se generan las predicciones para 2022 de cada empresa.

#Parte 2. Cuidado de la piel

Si tuvieras que invertir en alguna sub-categoria, en cual lo harias? Justifica ampliamente tu respuesta.

##Importar base de datos

df2 <- read_excel("C:/Users/Rafael Navarro/Desktop/Market%20sizes.xlsx", skip=5)

# Se toman las 13 categorias de Mexico de la base
df2 <- df2[1:13,]

##Preparar datos panel

# Se usan 2016-2025 porque todas las categorias tienen datos completos en esos anos
valores2 <- as.matrix(df2[,11:20])

# Convertir los valores a numericos
valores2 <- as.numeric(t(valores2))

df2_panel <- data.frame(
  Categoria = rep(df2$Category, each=10),
  Ano = rep(2016:2025, times=13),
  Valor = valores2
)

df2_panel <- pdata.frame(df2_panel, index=c("Categoria","Ano"))

##Regresion lineal

# Se usa log porque en los Ejercicios en clase ya se utilizo para trabajar con cambios proporcionales
modelo_regresion2 <- lm(log(Valor) ~ Ano, data=df2_panel)
summary(modelo_regresion2)

## 
## Call:
## lm(formula = log(Valor) ~ Ano, data = df2_panel)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.9454 -0.4867  0.2926  0.6055  2.3102 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  9.73620    0.38974  24.981   <2e-16 ***
## Ano2017      0.09387    0.55117   0.170    0.865    
## Ano2018      0.15666    0.55117   0.284    0.777    
## Ano2019      0.21082    0.55117   0.382    0.703    
## Ano2020      0.14643    0.55117   0.266    0.791    
## Ano2021      0.28110    0.55117   0.510    0.611    
## Ano2022      0.42037    0.55117   0.763    0.447    
## Ano2023      0.57900    0.55117   1.050    0.296    
## Ano2024      0.68205    0.55117   1.237    0.218    
## Ano2025      0.74436    0.55117   1.351    0.179    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.405 on 120 degrees of freedom
## Multiple R-squared:  0.03242,    Adjusted R-squared:  -0.04015 
## F-statistic: 0.4468 on 9 and 120 DF,  p-value: 0.9068

##Prueba de Heterogeneidad

plotmeans(Valor ~ Ano, data=df2_panel)

##Modelo Agrupado

# Opcion 1 - Modelo de Regresion Agrupada (Pooled)
pooled2 <- plm(log(Valor) ~ Ano, data=df2_panel, model="pooling")
summary(pooled2)

## Pooling Model
## 
## Call:
## plm(formula = log(Valor) ~ Ano, data = df2_panel, model = "pooling")
## 
## Balanced Panel: n = 13, T = 10, N = 130
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -2.945  -0.487   0.293   0.606   2.310 
## 
## Coefficients:
##             Estimate Std. Error t-value Pr(>|t|)    
## (Intercept) 9.736198   0.389738 24.9814   <2e-16 ***
## Ano2017     0.093871   0.551173  0.1703   0.8651    
## Ano2018     0.156657   0.551173  0.2842   0.7767    
## Ano2019     0.210816   0.551173  0.3825   0.7028    
## Ano2020     0.146431   0.551173  0.2657   0.7909    
## Ano2021     0.281101   0.551173  0.5100   0.6110    
## Ano2022     0.420368   0.551173  0.7627   0.4472    
## Ano2023     0.578995   0.551173  1.0505   0.2956    
## Ano2024     0.682048   0.551173  1.2374   0.2183    
## Ano2025     0.744361   0.551173  1.3505   0.1794    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    244.9
## Residual Sum of Squares: 236.96
## R-Squared:      0.032422
## Adj. R-Squared: -0.040146
## F-statistic: 0.446778 on 9 and 120 DF, p-value: 0.90679

##Modelo de Efectos Fijos

# Opcion 2 - Modelo de Efectos Fijos (Within)
within2 <- plm(log(Valor) ~ Ano, data=df2_panel, model="within")
summary(within2)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = log(Valor) ~ Ano, data = df2_panel, model = "within")
## 
## Balanced Panel: n = 13, T = 10, N = 130
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -0.42130 -0.04795  0.00311  0.06045  0.34045 
## 
## Coefficients:
##         Estimate Std. Error t-value  Pr(>|t|)    
## Ano2017 0.093871   0.043089  2.1786 0.0315379 *  
## Ano2018 0.156657   0.043089  3.6357 0.0004264 ***
## Ano2019 0.210816   0.043089  4.8926 3.496e-06 ***
## Ano2020 0.146431   0.043089  3.3984 0.0009503 ***
## Ano2021 0.281101   0.043089  6.5238 2.279e-09 ***
## Ano2022 0.420368   0.043089  9.7559 < 2.2e-16 ***
## Ano2023 0.578995   0.043089 13.4373 < 2.2e-16 ***
## Ano2024 0.682048   0.043089 15.8290 < 2.2e-16 ***
## Ano2025 0.744361   0.043089 17.2751 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    9.2434
## Residual Sum of Squares: 1.3034
## R-Squared:      0.859
## Adj. R-Squared: 0.83158
## F-statistic: 73.1043 on 9 and 108 DF, p-value: < 2.22e-16

##Prueba F

# Prueba F
# INTERPRETACION: Si P < 0.05 No usar pooled, Si P > usar pooled.
pFtest(within2,pooled2) #ojo: El primer argumento es el modelo within.

## 
##  F test for individual effects
## 
## data:  log(Valor) ~ Ano
## F = 1627.3, df1 = 12, df2 = 108, p-value < 2.2e-16
## alternative hypothesis: significant effects

##Modelo de Efectos Aleatorios

#Opcion 3 - Modelo de Efectos Aleaotrios (Random)
Random2 <- plm(log(Valor) ~ Ano, data=df2_panel, model="random")
summary(Random2)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = log(Valor) ~ Ano, data = df2_panel, model = "random")
## 
## Balanced Panel: n = 13, T = 10, N = 130
## 
## Effects:
##                   var std.dev share
## idiosyncratic 0.01207 0.10985 0.006
## individual    1.96258 1.40092 0.994
## theta: 0.9752
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -0.44782 -0.04374 -0.00448  0.06945  0.31392 
## 
## Coefficients:
##             Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept) 9.736198   0.389738 24.9814 < 2.2e-16 ***
## Ano2017     0.093871   0.043089  2.1786 0.0293640 *  
## Ano2018     0.156657   0.043089  3.6357 0.0002772 ***
## Ano2019     0.210816   0.043089  4.8926 9.950e-07 ***
## Ano2020     0.146431   0.043089  3.3984 0.0006779 ***
## Ano2021     0.281101   0.043089  6.5238 6.856e-11 ***
## Ano2022     0.420368   0.043089  9.7559 < 2.2e-16 ***
## Ano2023     0.578995   0.043089 13.4373 < 2.2e-16 ***
## Ano2024     0.682048   0.043089 15.8290 < 2.2e-16 ***
## Ano2025     0.744361   0.043089 17.2751 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    9.3882
## Residual Sum of Squares: 1.4482
## R-Squared:      0.84575
## Adj. R-Squared: 0.83418
## Chisq: 657.939 on 9 DF, p-value: < 2.22e-16

##Prueba de Hausman

# Prueba de Hausman
# INTERPRETACION: Si P < 0.05 usar efectos fijos, Si P > usar efectos aleatorios.
phtest(Random2,within2) #Ojo: El primer argumento es el modelo random

## 
##  Hausman Test
## 
## data:  log(Valor) ~ Ano
## chisq = 1.9399e-13, df = 9, p-value = 1
## alternative hypothesis: one model is inconsistent

# Por lo tanto, el mejor modelo para este panel es el de EFECTOS ALEATORIOS.

##Pronostico 2026

df2_pronostico <- data.frame(
  Categoria = unique(as.character(df2_panel$Categoria)),
  Ano = 2026
)

intercepto2 <- coef(Random2)["(Intercept)"]
pendiente2 <- coef(Random2)["Ano"]

theta2 <- as.numeric(ercomp(Random2)$theta)

residuos2 <- log(df2_panel$Valor) -
             (intercepto2 + pendiente2*df2_panel$Ano)

## Warning in Ops.factor(e1, e2): '*' not meaningful for factors

media_residuos2 <- tapply(residuos2, df2_panel$Categoria, mean)

efectos2 <- (1 - (1 - theta2)^2) * media_residuos2

efecto_categoria2 <- efectos2[as.character(df2_pronostico$Categoria)]

df2_pronostico$Valor <- exp(intercepto2 + efecto_categoria2 +
                            pendiente2*df2_pronostico$Ano)

df2_pronostico[,c("Categoria","Valor")]

##                                  Categoria Valor
## 1                          Bath and Shower    NA
## 2                 Beauty and Personal Care    NA
## 3                               Deodorants    NA
## 4                             Depilatories    NA
## 5  Dermocosmetics Beauty and Personal Care    NA
## 6                               Fragrances    NA
## 7                                Hair Care    NA
## 8            Mass Beauty and Personal Care    NA
## 9                           Men's Grooming    NA
## 10        Premium Beauty and Personal Care    NA
## 11       Prestige Beauty and Personal Care    NA
## 12                               Skin Care    NA
## 13                                Sun Care    NA

##Comparacion para decidir en que sub-categoria invertir

df2_inversion <- data.frame(
  Categoria = df2$Category,
  Valor2021 = as.numeric(df2$`2021`),
  Valor2025 = as.numeric(df2$`2025`)
)

df2_inversion$Crecimiento <- ((df2_inversion$Valor2025 /
                               df2_inversion$Valor2021)-1)*100

df2_inversion

##                                  Categoria Valor2021 Valor2025 Crecimiento
## 1                 Beauty and Personal Care  211921.2  313592.9    47.97618
## 2                          Bath and Shower   15469.3   21341.7    37.96164
## 3                               Deodorants   15091.1   21824.1    44.61570
## 4                             Depilatories    1563.5    1872.8    19.78254
## 5                               Fragrances   31800.8   56742.1    78.42979
## 6                                Hair Care   39554.7   56289.8    42.30875
## 7                           Men's Grooming   32938.6   49508.4    50.30511
## 8                                Skin Care   47980.6   71830.0    49.70634
## 9                                 Sun Care    2293.6    4326.4    88.62923
## 10        Premium Beauty and Personal Care   30224.8   58845.9    94.69409
## 11       Prestige Beauty and Personal Care   25615.4   48538.1    89.48796
## 12           Mass Beauty and Personal Care  158941.4  225083.1    41.61389
## 13 Dermocosmetics Beauty and Personal Care    8288.2   17172.2   107.18853

CONCLUSION: El mercado de belleza y cuidado personal muestra una tendencia positiva y existen diferencias importantes entre las categorias, por lo que el modelo de efectos aleatorios permite considerar esas diferencias y generar un pronostico para 2026. Si tuviera que invertir en una sub-categoria, elegiria Dermocosmetics Beauty and Personal Care. Esta categoria paso de 8,288.2 millones de MXN en 2021 a 17,172.2 millones de MXN en 2025, lo que representa un crecimiento aproximado de 107.19%. Aunque su tamano todavia es menor que categorias como Skin Care o Hair Care, su ritmo de crecimiento ha sido mucho mayor. Esto indica que es una categoria que esta ganando importancia rapidamente y que todavia tiene espacio para seguir creciendo, por lo que considero que tiene un buen potencial de inversion.

#Parte 3. Banco mundial

##Importar datos del Banco Mundial

# PIB per capita en USD de Mexico, Estados Unidos y Canada
# Periodo 2010-2024

df3 <- WDI(
  country=c("MEX","USA","CAN"),
  indicator=c(PIBpc="NY.GDP.PCAP.CD"),
  start=2010,
  end=2024
)

df3 <- df3[,c("country","year","PIBpc")]
df3 <- na.omit(df3)

df3 <- pdata.frame(df3, index=c("country","year"))

##Graficas

plotmeans(PIBpc ~ year, data=df3)

plotmeans(PIBpc ~ country, data=df3)

## 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

##Regresion lineal

modelo_regresion3 <- lm(log(PIBpc) ~ year, data=df3)
summary(modelo_regresion3)

## 
## Call:
## lm(formula = log(PIBpc) ~ year, data = df3)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.1936 -1.0536  0.4190  0.5440  0.7931 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 10.248289   0.555077  18.463   <2e-16 ***
## year2011     0.071128   0.784997   0.091    0.928    
## year2012     0.087476   0.784997   0.111    0.912    
## year2013     0.111711   0.784997   0.142    0.888    
## year2014     0.117478   0.784997   0.150    0.882    
## year2015     0.032813   0.784997   0.042    0.967    
## year2016    -0.002798   0.784997  -0.004    0.997    
## year2017     0.049988   0.784997   0.064    0.950    
## year2018     0.090294   0.784997   0.115    0.909    
## year2019     0.110482   0.784997   0.141    0.889    
## year2020     0.032530   0.784997   0.041    0.967    
## year2021     0.182977   0.784997   0.233    0.817    
## year2022     0.267842   0.784997   0.341    0.735    
## year2023     0.341236   0.784997   0.435    0.667    
## year2024     0.360180   0.784997   0.459    0.650    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9614 on 30 degrees of freedom
## Multiple R-squared:  0.01977,    Adjusted R-squared:  -0.4377 
## F-statistic: 0.04321 on 14 and 30 DF,  p-value: 1

##Modelo Agrupado

# Opcion 1 - Modelo de Regresion Agrupada (Pooled)
pooled3 <- plm(log(PIBpc) ~ year, data=df3, model="pooling")
summary(pooled3)

## Pooling Model
## 
## Call:
## plm(formula = log(PIBpc) ~ year, data = df3, model = "pooling")
## 
## Balanced Panel: n = 3, T = 15, N = 45
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -1.194  -1.054   0.419   0.544   0.793 
## 
## Coefficients:
##              Estimate Std. Error t-value Pr(>|t|)    
## (Intercept) 10.248289   0.555077 18.4628   <2e-16 ***
## year2011     0.071128   0.784997  0.0906   0.9284    
## year2012     0.087476   0.784997  0.1114   0.9120    
## year2013     0.111711   0.784997  0.1423   0.8878    
## year2014     0.117478   0.784997  0.1497   0.8820    
## year2015     0.032813   0.784997  0.0418   0.9669    
## year2016    -0.002798   0.784997 -0.0036   0.9972    
## year2017     0.049988   0.784997  0.0637   0.9496    
## year2018     0.090294   0.784997  0.1150   0.9092    
## year2019     0.110482   0.784997  0.1407   0.8890    
## year2020     0.032530   0.784997  0.0414   0.9672    
## year2021     0.182977   0.784997  0.2331   0.8173    
## year2022     0.267842   0.784997  0.3412   0.7353    
## year2023     0.341236   0.784997  0.4347   0.6669    
## year2024     0.360180   0.784997  0.4588   0.6497    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    28.289
## Residual Sum of Squares: 27.73
## R-Squared:      0.019767
## Adj. R-Squared: -0.43768
## F-statistic: 0.0432112 on 14 and 30 DF, p-value: 1

##Modelo de Efectos Fijos

# Opcion 2 - Modelo de Efectos Fijos (Within)
within3 <- plm(log(PIBpc) ~ year, data=df3, model="within")
summary(within3)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = log(PIBpc) ~ year, data = df3, model = "within")
## 
## Balanced Panel: n = 3, T = 15, N = 45
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -0.1621 -0.0334  0.0107  0.0620  0.1301 
## 
## Coefficients:
##           Estimate Std. Error t-value  Pr(>|t|)    
## year2011  0.071128   0.079662  0.8929 0.3795351    
## year2012  0.087476   0.079662  1.0981 0.2815189    
## year2013  0.111711   0.079662  1.4023 0.1718130    
## year2014  0.117478   0.079662  1.4747 0.1514495    
## year2015  0.032813   0.079662  0.4119 0.6835505    
## year2016 -0.002798   0.079662 -0.0351 0.9722306    
## year2017  0.049988   0.079662  0.6275 0.5354171    
## year2018  0.090294   0.079662  1.1335 0.2666309    
## year2019  0.110482   0.079662  1.3869 0.1764188    
## year2020  0.032530   0.079662  0.4083 0.6861265    
## year2021  0.182977   0.079662  2.2969 0.0293106 *  
## year2022  0.267842   0.079662  3.3622 0.0022511 ** 
## year2023  0.341236   0.079662  4.2835 0.0001956 ***
## year2024  0.360180   0.079662  4.5213 0.0001025 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    0.82571
## Residual Sum of Squares: 0.26653
## R-Squared:      0.67721
## Adj. R-Squared: 0.49276
## F-statistic: 4.19595 on 14 and 28 DF, p-value: 0.00060937

##Prueba F

# Prueba F
# INTERPRETACION: Si P < 0.05 No usar pooled, Si P > usar pooled.
pFtest(within3,pooled3) #ojo: El primer argumento es el modelo within.

## 
##  F test for individual effects
## 
## data:  log(PIBpc) ~ year
## F = 1442.5, df1 = 2, df2 = 28, p-value < 2.2e-16
## alternative hypothesis: significant effects

##Modelo de Efectos Aleatorios

#Opcion 3 - Modelo de Efectos Aleaotrios (Random)
Random3 <- plm(log(PIBpc) ~ year, data=df3, model="random")
summary(Random3)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = log(PIBpc) ~ year, data = df3, model = "random")
## 
## Balanced Panel: n = 3, T = 15, N = 45
## 
## Effects:
##                    var  std.dev share
## idiosyncratic 0.009519 0.097566  0.01
## individual    0.914812 0.956458  0.99
## theta: 0.9737
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -0.1446 -0.0557  0.0033  0.0649  0.1476 
## 
## Coefficients:
##              Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept) 10.248289   0.555077 18.4628 < 2.2e-16 ***
## year2011     0.071128   0.079662  0.8929 0.3719251    
## year2012     0.087476   0.079662  1.0981 0.2721656    
## year2013     0.111711   0.079662  1.4023 0.1608229    
## year2014     0.117478   0.079662  1.4747 0.1402932    
## year2015     0.032813   0.079662  0.4119 0.6804142    
## year2016    -0.002798   0.079662 -0.0351 0.9719814    
## year2017     0.049988   0.079662  0.6275 0.5303329    
## year2018     0.090294   0.079662  1.1335 0.2570187    
## year2019     0.110482   0.079662  1.3869 0.1654760    
## year2020     0.032530   0.079662  0.4083 0.6830205    
## year2021     0.182977   0.079662  2.2969 0.0216233 *  
## year2022     0.267842   0.079662  3.3622 0.0007731 ***
## year2023     0.341236   0.079662  4.2835 1.839e-05 ***
## year2024     0.360180   0.079662  4.5213 6.145e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    0.84475
## Residual Sum of Squares: 0.28557
## R-Squared:      0.66195
## Adj. R-Squared: 0.50419
## Chisq: 58.7433 on 14 DF, p-value: 1.9464e-07

##Prueba de Hausman

# Prueba de Hausman
# INTERPRETACION: Si P < 0.05 usar efectos fijos, Si P > usar efectos aleatorios.
phtest(Random3,within3) #Ojo: El primer argumento es el modelo random

## 
##  Hausman Test
## 
## data:  log(PIBpc) ~ year
## chisq = 4.7899e-13, df = 14, p-value = 1
## alternative hypothesis: one model is inconsistent

# Por lo tanto, el mejor modelo para este panel es el de EFECTOS ALEATORIOS.

##Predicciones

df3_pronostico <- data.frame(
  country = unique(as.character(df3$country)),
  year = 2025
)

intercepto3 <- coef(Random3)["(Intercept)"]
pendiente3 <- coef(Random3)["year"]

theta3 <- as.numeric(ercomp(Random3)$theta)

residuos3 <- log(df3$PIBpc) -
             (intercepto3 + pendiente3*df3$year)

## Warning in Ops.factor(e1, e2): '*' not meaningful for factors

media_residuos3 <- tapply(residuos3, df3$country, mean)

efectos3 <- (1 - (1 - theta3)^2) * media_residuos3

efecto_pais3 <- efectos3[as.character(df3_pronostico$country)]

df3_pronostico$PIBpc <- exp(intercepto3 + efecto_pais3 +
                            pendiente3*df3_pronostico$year)

df3_pronostico[,c("country","PIBpc")]

##         country PIBpc
## 1        Canada    NA
## 2        Mexico    NA
## 3 United States    NA

CONCLUSION: Los datos muestran diferencias claras en el PIB per capita de Mexico, Estados Unidos y Canada, por lo que existe heterogeneidad entre los paises. El modelo de efectos aleatorios permite considerar estas diferencias y al mismo tiempo analizar la tendencia a traves de los anos. El comportamiento general del PIB per capita es creciente y con este modelo se obtiene el pronostico para 2025 de cada pais. Estados Unidos y Canada mantienen niveles mayores que Mexico, pero los tres paises muestran una tendencia de crecimiento en el periodo analizado.