Datos de Panel

# Instalar paquetes y llamar librerías
#install.packages("plm", repos = "https://cloud.r-project.org")
#install.packages("gplots", repos = "https://cloud.r-project.org")
#install.packages("dplyr", repos = "https://cloud.r-project.org")

library(plm)
library(gplots)
library(dplyr)

Ejercicio 1 - PATENTES

Genera el mejor modelo de la Base de Datos “Patentes” y genera predicciones. Incluye conclusiones.

# Cargamos la base de datos (ajusta la ruta a donde la tengas guardada)
df_patentes <- read.csv("/Users/sharontorres/Downloads/Actividad1/PATENT3.csv")

# Convertimos a formato de panel: identificador = cusip, tiempo = year
df_patentes <- pdata.frame(df_patentes, index = c("cusip", "year"))


modelo_regresion_stckpr <- lm(stckpr ~ patents, df_patentes)
summary(modelo_regresion_stckpr)

## 
## Call:
## lm(formula = stckpr ~ patents, data = df_patentes)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -126.556  -12.190   -4.857    6.143  301.143 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 18.856675   0.502270   37.54   <2e-16 ***
## patents      0.166508   0.006838   24.35   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 22.68 on 2256 degrees of freedom
##   (2 observations deleted due to missingness)
## Multiple R-squared:  0.2081, Adjusted R-squared:  0.2078 
## F-statistic:   593 on 1 and 2256 DF,  p-value: < 2.2e-16

# Prueba de Heterogeneidad (agrupamos por empresa, cusip)
plotmeans(stckpr ~ cusip, data = df_patentes)

# INTERPRETACIÓN: Buscamos línea quebrada que una los promedios (Hay heterogeneidad)
# para elegir entre Modelo de Efectos Fijos o Aleatorios. Si sale una línea horizontal
# no hay heterogeneidad, probablemente la mejor opción sea el Modelo Agrupado.

# Opción 1 - Modelo de Regresión Agrupada (Pooled)
modelo_pooled_stckpr <- plm(stckpr ~ patents, data = df_patentes, model = "pooling")
summary(modelo_pooled_stckpr)

## Pooling Model
## 
## Call:
## plm(formula = stckpr ~ patents, data = df_patentes, model = "pooling")
## 
## Unbalanced Panel: n = 226, T = 8-10, N = 2258
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -126.56  -12.19   -4.86    6.14  301.14 
## 
## Coefficients:
##               Estimate Std. Error t-value  Pr(>|t|)    
## (Intercept) 18.8566751  0.5022700  37.543 < 2.2e-16 ***
## patents      0.1665081  0.0068377  24.352 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1464800
## Residual Sum of Squares: 1159900
## R-Squared:      0.20814
## Adj. R-Squared: 0.20779
## F-statistic: 593.001 on 1 and 2256 DF, p-value: < 2.22e-16

# Opción 2 - Modelo de Efectos Fijos (within)
modelo_within_stckpr <- plm(stckpr ~ patents, data = df_patentes, model = "within")
summary(modelo_within_stckpr)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = stckpr ~ patents, data = df_patentes, model = "within")
## 
## Unbalanced Panel: n = 226, T = 8-10, N = 2258
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -150.27   -5.32   -1.16    3.55  186.59 
## 
## Coefficients:
##         Estimate Std. Error t-value  Pr(>|t|)    
## patents 0.063251   0.014058  4.4994 7.199e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    442430
## Residual Sum of Squares: 438060
## R-Squared:      0.0098695
## Adj. R-Squared: -0.10031
## F-statistic: 20.2448 on 1 and 2031 DF, p-value: 7.1991e-06

# Prueba F
# INTERPRETACIÓN: Si p< 0.05 No usar POOLED. Si p> 0.05 Usar POOLED.
pFtest(modelo_within_stckpr, modelo_pooled_stckpr) #Siempre va primero within, NO POOLED.

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

# Opción 3 - Modelo de Efectos Aleatorios (Random)
modelo_random_stckpr <- plm(stckpr ~ patents, data = df_patentes, model = "random")
summary(modelo_random_stckpr)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = stckpr ~ patents, data = df_patentes, model = "random")
## 
## Unbalanced Panel: n = 226, T = 8-10, N = 2258
## 
## Effects:
##                  var std.dev share
## idiosyncratic 215.69   14.69 0.422
## individual    295.20   17.18 0.578
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.7107  0.7391  0.7391  0.7390  0.7391  0.7391 
## 
## Residuals:
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1.17e+02 -6.48e+00 -2.96e+00  1.89e-03  3.06e+00  2.19e+02 
## 
## Coefficients:
##              Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept) 20.205603   1.217228 16.5997 < 2.2e-16 ***
## patents      0.107063   0.011111  9.6358 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    512040
## Residual Sum of Squares: 491850
## R-Squared:      0.039427
## Adj. R-Squared: 0.039001
## Chisq: 92.848 on 1 DF, p-value: < 2.22e-16

# Prueba de Hausman
# INTERPRETACIÓN: Si p< 0.05 Usar Efectos Fijos. Si p> 0.05 Usar Efectos Aleatorios.
phtest(modelo_random_stckpr, modelo_within_stckpr) #Siempre va primero random, NO WITHIN

## 
##  Hausman Test
## 
## data:  stckpr ~ patents
## chisq = 25.881, df = 1, p-value = 3.631e-07
## alternative hypothesis: one model is inconsistent

CONCLUSIÓN MEJOR MODELO:

Afirmación: El modelo más adecuado para este análisis es el de Efectos Fijos.

Razón: Las pruebas estadísticas diseñadas para esta decisión —la Prueba F y la Prueba de Hausman— descartaron tanto el Modelo Agrupado como el de Efectos Aleatorios.

Evidencia: Ambas pruebas arrojaron un p-value prácticamente igual a cero, muy por debajo del umbral de 0.05, lo que confirma con claridad la elección del Modelo de Efectos Fijos.

ultimo_anio <- as.data.frame(df_patentes)
ultimo_anio <- ultimo_anio[ultimo_anio$year == 2021, ]

pendiente_fe <- coef(modelo_within_stckpr)["patents"]
efectos_fijos <- fixef(modelo_within_stckpr)

patents_2022 <- 1.1 * ultimo_anio$patents   # +10% respecto a 2021
nombres_empresas <- as.character(ultimo_anio$cusip)

pronostico_fe <- efectos_fijos[nombres_empresas] + pendiente_fe * patents_2022

df_pronostico_fe <- data.frame(
  cusip = nombres_empresas,
  stckpr_pronostico = as.numeric(pronostico_fe)
)

head(df_pronostico_fe, 10)

##    cusip stckpr_pronostico
## 1    800         37.643130
## 2   4626         15.734344
## 3   4671          6.911448
## 4   7500          3.249399
## 5   7603          1.474699
## 6  20753          8.662049
## 7  21367          3.149399
## 8  23519         17.946107
## 9  29069          7.618975
## 10 38213          7.567172

CONCLUSIÓN:

Afirmación: Si las empresas logran 10% más patentes en 2022, el precio de sus acciones va a subir, pero no todas van a subir lo mismo.

Razón: Porque cada empresa ya arranca desde un lugar distinto. El modelo capta dos cosas: el “boost” que dan las patentes nuevas, y el punto de partida que ya trae cada empresa por su propia historia.

Evidencia: Lo vemos clarito en los números: con el mismo aumento del 10% en patentes para todas, unas terminan en 1.47 y otras en 37.64. O sea, el efecto de innovar sí jala el precio para arriba en todos los casos, pero el resultado final depende de dónde estaba parada cada empresa antes — no es que todas lleguen al mismo lugar solo por hacer el mismo esfuerzo.

Ejercicio 2 - CUIDADO DE LA PIEL

INSTRUCCIONES: Genera el mejor modelo de la Base de Datos “Market sizes” y genera predicciones. Incluye conclusiones. Si tuvieras que invertir en alguna sub-categoría, ¿en cuál lo harías? Justifica ampliamente tu respuesta.

# Instalar paquetes si es necesario
# install.packages(c("dplyr", "tidyr", "plm", "ggplot2"))

library(dplyr)
library(tidyr)
library(plm)
library(ggplot2)

# Cargar la base original
df_market <- read.csv(
  "/Users/sharontorres/Downloads/Actividad1/Market_sizes_clean.csv",
  stringsAsFactors = FALSE
)

# Categorías que vamos a analizar
cats <- c(
  "Bath and Shower",
  "Deodorants",
  "Depilatories",
  "Fragrances",
  "Hair Care",
  "Men's Grooming",
  "Skin Care",
  "Sun Care"
)

df_long <- df_market %>%
  filter(Category %in% cats) %>%
  select(Category, X2011:X2025) %>%
  mutate(
    across(X2011:X2025, ~ as.numeric(gsub(",", "", .)))
  ) %>%
  pivot_longer(
    cols = X2011:X2025,
    names_to = "Año",
    values_to = "Valor"
  ) %>%
  mutate(
    Año_num = as.numeric(gsub("X", "", Año)),
    Año_centrado = Año_num - 2011
  ) %>%
  arrange(Category, Año_num)

head(df_long)

## # A tibble: 6 × 5
##   Category        Año    Valor Año_num Año_centrado
##   <chr>           <chr>  <dbl>   <dbl>        <dbl>
## 1 Bath and Shower X2011  8410.    2011            0
## 2 Bath and Shower X2012  9085     2012            1
## 3 Bath and Shower X2013  9711.    2013            2
## 4 Bath and Shower X2014 10227.    2014            3
## 5 Bath and Shower X2015 10815.    2015            4
## 6 Bath and Shower X2016 11482.    2016            5

df_panel <- pdata.frame(
  df_long,
  index = c("Category", "Año_num")
)

pdim(df_panel)

## Balanced Panel: n = 8, T = 15, N = 120

str(df_long$Año_num)

##  num [1:120] 2011 2012 2013 2014 2015 ...

str(df_long$Año_centrado)

##  num [1:120] 0 1 2 3 4 5 6 7 8 9 ...

modelo_pooled <- plm(
  log(Valor) ~ Año_centrado,
  data = df_panel,
  model = "pooling"
)

summary(modelo_pooled)

## Pooling Model
## 
## Call:
## plm(formula = log(Valor) ~ Año_centrado, data = df_panel, model = "pooling")
## 
## Balanced Panel: n = 8, T = 15, N = 120
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -2.386  -0.416   0.395   0.937   1.282 
## 
## Coefficients:
##              Estimate Std. Error t-value Pr(>|t|)    
## (Intercept)  8.977539   0.215534 41.6525  < 2e-16 ***
## Año_centrado 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.01135

modelo_fixed <- plm(
  log(Valor) ~ Año_centrado,
  data = df_panel,
  model = "within"
)

summary(modelo_fixed)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = log(Valor) ~ Año_centrado, data = df_panel, model = "within")
## 
## Balanced Panel: n = 8, T = 15, N = 120
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -0.25125 -0.04400  0.00802  0.04081  0.24915 
## 
## Coefficients:
##               Estimate Std. Error t-value  Pr(>|t|)    
## Año_centrado 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-16

modelo_random <- plm(
  log(Valor) ~ Año_centrado,
  data = df_panel,
  model = "random"
)

summary(modelo_random)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = log(Valor) ~ Año_centrado, data = df_panel, 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.23757 -0.03954  0.00409  0.04301  0.22468 
## 
## Coefficients:
##               Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)  8.9775395  0.4639214  19.351 < 2.2e-16 ***
## Año_centrado 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

pFtest(
  modelo_fixed,
  modelo_pooled
)

## 
##  F test for individual effects
## 
## data:  log(Valor) ~ Año_centrado
## F = 3539.4, df1 = 7, df2 = 111, p-value < 2.2e-16
## alternative hypothesis: significant effects

phtest(
  modelo_random,
  modelo_fixed
)

## 
##  Hausman Test
## 
## data:  log(Valor) ~ Año_centrado
## chisq = 2.4253e-13, df = 1, p-value = 1
## alternative hypothesis: one model is inconsistent

# Seleccionamos el modelo final según las pruebas
modelo_final <- modelo_random

summary(modelo_final)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = log(Valor) ~ Año_centrado, data = df_panel, 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.23757 -0.03954  0.00409  0.04301  0.22468 
## 
## Coefficients:
##               Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)  8.9775395  0.4639214  19.351 < 2.2e-16 ***
## Año_centrado 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

CONCLUSIÓN MEJOR MODELO:

A : Afirmación

El modelo de efectos aleatorios (Random Effects) es el modelo más adecuado para analizar la relación entre el valor de mercado y el tiempo.

R : Razón

Se selecciona porque el Hausman Test no encontró diferencias sistemáticas entre los estimadores de efectos fijos y aleatorios. Al obtener un p-value = 1, no se rechaza la hipótesis nula, por lo que es válido utilizar el modelo de efectos aleatorios. Además, este modelo presenta un R² de 92.20%, indicando un alto poder explicativo.

E : Evidencia Hausman Test: p-value = 1 R² Random Effects: 0.9220 R² Fixed Effects: 0.9263 Variable Año_centrado: p-value < 2.2e-16 Coeficiente de Año_centrado: 0.06739

Aunque el modelo de efectos fijos tiene un R² ligeramente mayor, el Hausman Test indica que no hay evidencia para preferir efectos fijos, por lo que se elige Random Effects como modelo final.

nuevo <- data.frame(
  Año_centrado = 15
)

prediccion_log <- predict(modelo_final, newdata = nuevo)
prediccion_log

##        1 
## 9.988424

nuevo_2026 <- data.frame(
  Category = unique(df_panel$Category),
  Año_centrado = 15
)

nuevo_2026$Category <- factor(
  nuevo_2026$Category,
  levels = levels(df_panel$Category)
)

prediccion_2026 <- predict(
  modelo_final,
  newdata = nuevo_2026
)

nuevo_2026$Prediccion_2026 <- exp(prediccion_2026)

nuevo_2026

##          Category Año_centrado Prediccion_2026
## 1 Bath and Shower           15        21772.95
## 2      Deodorants           15        21772.95
## 3    Depilatories           15        21772.95
## 4      Fragrances           15        21772.95
## 5       Hair Care           15        21772.95
## 6  Men's Grooming           15        21772.95
## 7       Skin Care           15        21772.95
## 8        Sun Care           15        21772.95

efectos_categoria <- ranef(modelo_final)

efectos_categoria

## Bath and Shower      Deodorants    Depilatories      Fragrances       Hair Care 
##      0.03145824      0.12990868     -2.26023173      0.81401791      1.03776410 
##  Men's Grooming       Skin Care        Sun Care 
##      0.86382624      1.14666744     -1.76341088

nuevo_2026 <- data.frame(
  Category = names(efectos_categoria),
  Año_centrado = 15,
  efecto = as.numeric(efectos_categoria)
)

nuevo_2026$Prediccion_log <- 
  coef(modelo_final)["Año_centrado"] * nuevo_2026$Año_centrado +
  nuevo_2026$efecto

nuevo_2026$Prediccion_2026 <- 
  exp(nuevo_2026$Prediccion_log)

nuevo_2026

##          Category Año_centrado      efecto Prediccion_log Prediccion_2026
## 1 Bath and Shower           15  0.03145824      1.0423426       2.8358524
## 2      Deodorants           15  0.12990868      1.1407930       3.1292488
## 3    Depilatories           15 -2.26023173     -1.2493474       0.2866918
## 4      Fragrances           15  0.81401791      1.8249022       6.2021886
## 5       Hair Care           15  1.03776410      2.0486484       7.7574092
## 6  Men's Grooming           15  0.86382624      1.8747106       6.5189320
## 7       Skin Care           15  1.14666744      2.1575518       8.6499346
## 8        Sun Care           15 -1.76341088     -0.7525266       0.4711746

nuevo_2026$Prediccion_2025 <- exp(
  coef(modelo_final)["Año_centrado"] * 14 +
  nuevo_2026$efecto
)

nuevo_2026$Crecimiento <- 
  nuevo_2026$Prediccion_2026 - nuevo_2026$Prediccion_2025

nuevo_2026$Crecimiento_pct <- 
  (nuevo_2026$Prediccion_2026 / nuevo_2026$Prediccion_2025 - 1) * 100

nuevo_2026

##          Category Año_centrado      efecto Prediccion_log Prediccion_2026
## 1 Bath and Shower           15  0.03145824      1.0423426       2.8358524
## 2      Deodorants           15  0.12990868      1.1407930       3.1292488
## 3    Depilatories           15 -2.26023173     -1.2493474       0.2866918
## 4      Fragrances           15  0.81401791      1.8249022       6.2021886
## 5       Hair Care           15  1.03776410      2.0486484       7.7574092
## 6  Men's Grooming           15  0.86382624      1.8747106       6.5189320
## 7       Skin Care           15  1.14666744      2.1575518       8.6499346
## 8        Sun Care           15 -1.76341088     -0.7525266       0.4711746
##   Prediccion_2025 Crecimiento Crecimiento_pct
## 1       2.6510354  0.18481701        6.971503
## 2       2.9253107  0.20393813        6.971503
## 3       0.2680077  0.01868416        6.971503
## 4       5.7979821  0.40420651        6.971503
## 5       7.2518465  0.50556271        6.971503
## 6       6.0940828  0.42484918        6.971503
## 7       8.0862046  0.56373001        6.971503
## 8       0.4404674  0.03070720        6.971503

nuevo_2026$Crecimiento <- 
  nuevo_2026$Prediccion_2026 - nuevo_2026$Prediccion_2025

nuevo_2026$Crecimiento_pct <- 
  (nuevo_2026$Prediccion_2026 / nuevo_2026$Prediccion_2025 - 1) * 100

nuevo_2026

##          Category Año_centrado      efecto Prediccion_log Prediccion_2026
## 1 Bath and Shower           15  0.03145824      1.0423426       2.8358524
## 2      Deodorants           15  0.12990868      1.1407930       3.1292488
## 3    Depilatories           15 -2.26023173     -1.2493474       0.2866918
## 4      Fragrances           15  0.81401791      1.8249022       6.2021886
## 5       Hair Care           15  1.03776410      2.0486484       7.7574092
## 6  Men's Grooming           15  0.86382624      1.8747106       6.5189320
## 7       Skin Care           15  1.14666744      2.1575518       8.6499346
## 8        Sun Care           15 -1.76341088     -0.7525266       0.4711746
##   Prediccion_2025 Crecimiento Crecimiento_pct
## 1       2.6510354  0.18481701        6.971503
## 2       2.9253107  0.20393813        6.971503
## 3       0.2680077  0.01868416        6.971503
## 4       5.7979821  0.40420651        6.971503
## 5       7.2518465  0.50556271        6.971503
## 6       6.0940828  0.42484918        6.971503
## 7       8.0862046  0.56373001        6.971503
## 8       0.4404674  0.03070720        6.971503

tabla_final <- nuevo_2026[, c(
  "Category",
  "Prediccion_2025",
  "Prediccion_2026",
  "Crecimiento",
  "Crecimiento_pct"
)]

tabla_final

##          Category Prediccion_2025 Prediccion_2026 Crecimiento Crecimiento_pct
## 1 Bath and Shower       2.6510354       2.8358524  0.18481701        6.971503
## 2      Deodorants       2.9253107       3.1292488  0.20393813        6.971503
## 3    Depilatories       0.2680077       0.2866918  0.01868416        6.971503
## 4      Fragrances       5.7979821       6.2021886  0.40420651        6.971503
## 5       Hair Care       7.2518465       7.7574092  0.50556271        6.971503
## 6  Men's Grooming       6.0940828       6.5189320  0.42484918        6.971503
## 7       Skin Care       8.0862046       8.6499346  0.56373001        6.971503
## 8        Sun Care       0.4404674       0.4711746  0.03070720        6.971503

CONCLUSIÓN — ¿En qué subcategoría invertiría?

Si tuvieramos que invertir en una subcategoría, elegiriamos Skin Care.

De acuerdo con el modelo de efectos aleatorios, Skin Care presenta la mayor predicción para 2026, con un valor estimado de 8.65, frente a 8.09 en 2025. Esto representa un crecimiento aproximado de 6.97%, igual que el resto de las categorías debido a la estructura del modelo, pero Skin Care parte del nivel de ventas proyectado más alto. Por lo tanto, aunque el porcentaje de crecimiento sea similar, el incremento absoluto esperado es el mayor, de aproximadamente 0.56 unidades, lo que representa un mayor potencial de generación de valor.

Esta elección también está respaldada por la situación actual de la industria. McKinsey señala que Skin Care representa aproximadamente 40% del valor del mercado de belleza, y se espera que el sector de belleza continúe creciendo alrededor de 5% anual hasta 2030. Además, los consumidores muestran una mayor disposición a gastar en productos de cuidado de la piel que ofrecen beneficios claros y resultados visibles.

La tendencia también es relevante en México: Euromonitor identifica que el cuidado facial mantiene su liderazgo mientras los consumidores adoptan rutinas cada vez más enfocadas en el cuidado de la piel, además de observar mayor interés por productos con fórmulas funcionales y respaldo científico.

Por lo tanto, Skin Care representa la alternativa de inversión más atractiva, ya que combina el mejor nivel de ventas proyectado en nuestro modelo con una categoría que actualmente tiene una posición sólida y perspectivas favorables dentro de la industria de belleza. La inversión podría enfocarse especialmente en productos diferenciados, con ingredientes activos, beneficios comprobables y estrategias de personalización, aprovechando la tendencia hacia rutinas de cuidado más especializadas.

En conclusión, invertiriamos en Skin Care porque no solo presenta la mayor predicción de ventas para 2026 y el mayor incremento absoluto estimado dentro de nuestra base, sino que además coincide con una tendencia real del mercado, donde el cuidado de la piel continúa siendo uno de los principales motores de crecimiento de la industria de belleza.

Ejercicio 3 - BANCO MUNDIAL

INSTRUCCIONES: Importa datos del banco mundial y genera el mejor modelo, incluyendo predicciones. Incluye conclusiones y gráficas.

#install.packages("jsonlite", repos = "https://cloud.r-project.org")
#install.packages("dplyr", repos = "https://cloud.r-project.org")
#install.packages("plm", repos = "https://cloud.r-project.org")
#install.packages("ggplot2", repos = "https://cloud.r-project.org")

library(jsonlite)
library(dplyr)
library(plm)
library(ggplot2)

# Importar datos del banco mundial

obtener_WB <- function(indicador, nombre) {
  
  url <- paste0(
    "https://api.worldbank.org/v2/country/MEX;USA;CAN;BRA/indicator/",
    indicador,
    "?format=json&per_page=1000"
  )
  
  datos <- fromJSON(url, flatten = TRUE)
  
  datos[[2]] %>%
    select(
      country.value,
      countryiso3code,
      date,
      value
    ) %>%
    rename(
      country = country.value,
      iso3c = countryiso3code,
      year = date,
      !!nombre := value
    ) %>%
    mutate(year = as.numeric(year))
}

# Importar los Inidcadores

PIB <- obtener_WB(
  "NY.GDP.PCAP.CD",
  "PIB_pc"
)

Desempleo <- obtener_WB(
  "SL.UEM.TOTL.ZS",
  "Desempleo"
)

IED <- obtener_WB(
  "BX.KLT.DINV.CD.WD",
  "IED"
)

Exportaciones <- obtener_WB(
  "NE.EXP.GNFS.CD",
  "Exportaciones"
)

Esperanza <- obtener_WB(
  "SP.DYN.LE00.IN",
  "Esperanza_vida"
)

df <- PIB %>%
  select(country, iso3c, year, PIB_pc) %>%
  left_join(
    Desempleo %>% select(iso3c, year, Desempleo),
    by = c("iso3c", "year")
  ) %>%
  left_join(
    IED %>% select(iso3c, year, IED),
    by = c("iso3c", "year")
  ) %>%
  left_join(
    Exportaciones %>% select(iso3c, year, Exportaciones),
    by = c("iso3c", "year")
  ) %>%
  left_join(
    Esperanza %>% select(iso3c, year, Esperanza_vida),
    by = c("iso3c", "year")
  ) %>%
  filter(year >= 2010 & year <= 2024)

head(df)

##   country iso3c year    PIB_pc Desempleo         IED Exportaciones
## 1  Brazil   BRA 2024 10310.549     6.801 74090786050  392105346047
## 2  Brazil   BRA 2023 10377.589     7.947 62750364285  393731572888
## 3  Brazil   BRA 2022  9281.333     9.231 75501038733  383177602116
## 4  Brazil   BRA 2021  7972.537    13.158 46440503520  319251201403
## 5  Brazil   BRA 2020  7074.194    13.697 38270116307  242872071018
## 6  Brazil   BRA 2019  9029.833    11.936 69174411753  264562979421
##   Esperanza_vida
## 1         76.023
## 2         75.848
## 3         74.872
## 4         73.038
## 5         74.506
## 6         75.809

summary(df)

##       country         iso3c         year          PIB_pc        Desempleo     
##  Length   :60   Length   :60   Min.   :2010   Min.   : 7074   Min.   : 2.678  
##  N.unique : 4   N.unique : 4   1st Qu.:2013   1st Qu.:10313   1st Qu.: 4.419  
##  N.blank  : 0   N.blank  : 0   Median :2017   Median :28151   Median : 6.388  
##  Min.nchar: 6   Min.nchar: 3   Mean   :2017   Mean   :33364   Mean   : 6.603  
##  Max.nchar:13   Max.nchar: 3   3rd Qu.:2021   3rd Qu.:52989   3rd Qu.: 7.974  
##                                Max.   :2024   Max.   :86170   Max.   :13.697  
##       IED            Exportaciones       Esperanza_vida 
##  Min.   :1.823e+10   Min.   :2.239e+11   Min.   :69.75  
##  1st Qu.:3.817e+10   1st Qu.:3.899e+11   1st Qu.:74.42  
##  Median :6.290e+10   Median :5.106e+11   Median :76.18  
##  Mean   :1.203e+11   Mean   :9.510e+11   Mean   :77.16  
##  3rd Qu.:1.111e+11   3rd Qu.:1.021e+12   3rd Qu.:79.44  
##  Max.   :5.114e+11   Max.   :3.215e+12   Max.   :82.16

colSums(is.na(df))

##        country          iso3c           year         PIB_pc      Desempleo 
##              0              0              0              0              0 
##            IED  Exportaciones Esperanza_vida 
##              0              0              0

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

head(df_panel)

##             country iso3c year    PIB_pc Desempleo          IED Exportaciones
## Brazil-2010  Brazil   BRA 2010 11403.282     8.420  82389932468  240003137742
## Brazil-2011  Brazil   BRA 2011 13396.624     7.578 102427228231  303016626326
## Brazil-2012  Brazil   BRA 2012 12521.721     7.251  92568388321  292808395454
## Brazil-2013  Brazil   BRA 2013 12458.891     7.071  75211029129  290364173325
## Brazil-2014  Brazil   BRA 2014 12274.994     6.755  87713983217  270458130850
## Brazil-2015  Brazil   BRA 2015  8936.197     8.538  64738153494  232488824445
##             Esperanza_vida
## Brazil-2010         73.779
## Brazil-2011         74.047
## Brazil-2012         74.335
## Brazil-2013         74.609
## Brazil-2014         74.823
## Brazil-2015         75.106

pdim(df_panel)

## Balanced Panel: n = 4, T = 15, N = 60

ggplot(df, aes(x = year, y = PIB_pc, color = country)) +
  geom_line(linewidth = 1) +
  geom_point() +
  labs(
    title = "PIB per cápita por país",
    x = "Año",
    y = "PIB per cápita (USD)",
    color = "País"
  ) +
  theme_minimal()

ggplot(df, aes(x = Desempleo, y = PIB_pc, color = country)) +
  geom_point(size = 2) +
  geom_smooth(method = "lm", se = FALSE) +
  labs(
    title = "Relación entre desempleo y PIB per cápita",
    x = "Desempleo (%)",
    y = "PIB per cápita (USD)"
  ) +
  theme_minimal()

ggplot(df, aes(x = IED, y = PIB_pc, color = country)) +
  geom_point(size = 2) +
  labs(
    title = "Relación entre inversión extranjera y PIB per cápita",
    x = "Inversión extranjera directa (USD)",
    y = "PIB per cápita (USD)"
  ) +
  theme_minimal()

modelo_pooled <- plm(
  PIB_pc ~ Desempleo + Esperanza_vida,
  data = df_panel,
  model = "pooling"
)

summary(modelo_pooled)

## Pooling Model
## 
## Call:
## plm(formula = PIB_pc ~ Desempleo + Esperanza_vida, data = df_panel, 
##     model = "pooling")
## 
## Balanced Panel: n = 4, T = 15, N = 60
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -17236  -10475   -5263   12026   40074 
## 
## Coefficients:
##                  Estimate Std. Error t-value  Pr(>|t|)    
## (Intercept)    -388632.51   47330.57 -8.2110 3.070e-11 ***
## Desempleo        -2169.84     736.95 -2.9444  0.004677 ** 
## Esperanza_vida    5654.54     612.28  9.2351 6.391e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    3.5106e+10
## Residual Sum of Squares: 1.3447e+10
## R-Squared:      0.61694
## Adj. R-Squared: 0.6035
## F-statistic: 45.9017 on 2 and 57 DF, p-value: 1.3273e-12

modelo_fixed <- plm(
  PIB_pc ~ Desempleo + Esperanza_vida,
  data = df_panel,
  model = "within"
)

summary(modelo_fixed)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = PIB_pc ~ Desempleo + Esperanza_vida, data = df_panel, 
##     model = "within")
## 
## Balanced Panel: n = 4, T = 15, N = 60
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##   -6959   -4195    -870    2844   20428 
## 
## Coefficients:
##                Estimate Std. Error t-value  Pr(>|t|)    
## Desempleo      -1865.28     412.57 -4.5211 3.401e-05 ***
## Esperanza_vida  -932.82     769.12 -1.2128    0.2305    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2344800000
## Residual Sum of Squares: 1.684e+09
## R-Squared:      0.28181
## Adj. R-Squared: 0.21531
## F-statistic: 10.5945 on 2 and 54 DF, p-value: 0.00013136

modelo_random <- plm(
  PIB_pc ~ Desempleo + Esperanza_vida,
  data = df_panel,
  model = "random"
)

summary(modelo_random)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = PIB_pc ~ Desempleo + Esperanza_vida, data = df_panel, 
##     model = "random")
## 
## Balanced Panel: n = 4, T = 15, N = 60
## 
## Effects:
##                     var   std.dev share
## idiosyncratic  31184972      5584 0.049
## individual    607081936     24639 0.951
## theta: 0.9416
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##   -5629   -3967   -1622    2906   21986 
## 
## Coefficients:
##                Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)    97624.66   60421.86  1.6157    0.1062    
## Desempleo      -1854.45     415.70 -4.4611 8.155e-06 ***
## Esperanza_vida  -674.09     762.70 -0.8838    0.3768    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2456600000
## Residual Sum of Squares: 1813700000
## R-Squared:      0.26171
## Adj. R-Squared: 0.2358
## Chisq: 20.2051 on 2 DF, p-value: 4.0975e-05

pFtest(modelo_fixed, modelo_pooled)

## 
##  F test for individual effects
## 
## data:  PIB_pc ~ Desempleo + Esperanza_vida
## F = 125.74, df1 = 3, df2 = 54, p-value < 2.2e-16
## alternative hypothesis: significant effects

phtest(modelo_random, modelo_fixed)

## 
##  Hausman Test
## 
## data:  PIB_pc ~ Desempleo + Esperanza_vida
## chisq = 6.7613, df = 2, p-value = 0.03402
## alternative hypothesis: one model is inconsistent

CONCLUSIÓN MEJOR MODELO: A – Afirmación: El modelo de Efectos Fijos fue el modelo ganador para analizar y predecir el PIB per cápita de los países seleccionados, ya que permite tomar en cuenta las características particulares de cada economía y entender cómo los cambios en variables como el desempleo pueden impactar su desempeño económico.

R – Razón: Para una empresa, inversionista o gobierno, no sería adecuado analizar a todos los países como si fueran iguales. Cada economía tiene condiciones estructurales diferentes que influyen en sus resultados. El modelo de Efectos Fijos permite considerar estas diferencias y enfocarse en cómo los cambios dentro de cada país se relacionan con su PIB per cápita. Esto hace que el análisis sea más útil para identificar señales económicas y apoyar la toma de decisiones.

E – Evidencia: Las pruebas estadísticas respaldaron esta elección: la prueba F descartó el modelo Pooled y la prueba de Hausman descartó los Efectos Aleatorios, por lo que los Efectos Fijos fueron la alternativa más adecuada. Además, el modelo mostró que el desempleo tiene una relación negativa con el PIB per cápita, lo que refuerza la importancia de mantener niveles saludables de empleo para favorecer el desempeño económico.

modelo_final <- plm(
  PIB_pc ~ Desempleo + Esperanza_vida,
  data = df_panel,
  model = "within"
)

summary(modelo_final)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = PIB_pc ~ Desempleo + Esperanza_vida, data = df_panel, 
##     model = "within")
## 
## Balanced Panel: n = 4, T = 15, N = 60
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##   -6959   -4195    -870    2844   20428 
## 
## Coefficients:
##                Estimate Std. Error t-value  Pr(>|t|)    
## Desempleo      -1865.28     412.57 -4.5211 3.401e-05 ***
## Esperanza_vida  -932.82     769.12 -1.2128    0.2305    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    2344800000
## Residual Sum of Squares: 1.684e+09
## R-Squared:      0.28181
## Adj. R-Squared: 0.21531
## F-statistic: 10.5945 on 2 and 54 DF, p-value: 0.00013136

df_train <- subset(df, year <= 2023)
df_test <- subset(df, year == 2024)

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

modelo_final <- plm(
  PIB_pc ~ Desempleo + Esperanza_vida,
  data = df_train_panel,
  model = "within"
)

summary(modelo_final)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = PIB_pc ~ Desempleo + Esperanza_vida, data = df_train_panel, 
##     model = "within")
## 
## Balanced Panel: n = 4, T = 14, N = 56
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##   -6315   -3751    -669    2888   17574 
## 
## Coefficients:
##                Estimate Std. Error t-value Pr(>|t|)    
## Desempleo      -1678.19     372.68 -4.5031 4.03e-05 ***
## Esperanza_vida -1193.82     695.73 -1.7159  0.09236 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1724300000
## Residual Sum of Squares: 1.179e+09
## R-Squared:      0.31623
## Adj. R-Squared: 0.24785
## F-statistic: 11.5618 on 2 and 50 DF, p-value: 7.4611e-05

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

df_test$PIB_predicho <- predict(
  modelo_final,
  newdata = df_test_panel
)

df_test[, c(
  "country",
  "year",
  "PIB_pc",
  "PIB_predicho"
)]

##          country year   PIB_pc PIB_predicho
## 1         Brazil 2024 10310.55     13884.79
## 16        Canada 2024 55015.71     49581.70
## 31        Mexico 2024 13988.04     11090.87
## 46 United States 2024 86169.66     63765.73

df_test$Error <- df_test$PIB_pc - df_test$PIB_predicho

df_test$Error_Porcentual <- 
  abs(df_test$Error / df_test$PIB_pc) * 100

df_test[, c(
  "country",
  "PIB_pc",
  "PIB_predicho",
  "Error",
  "Error_Porcentual"
)]

##          country   PIB_pc PIB_predicho     Error Error_Porcentual
## 1         Brazil 10310.55     13884.79 -3574.237        34.665832
## 16        Canada 55015.71     49581.70  5434.003         9.877184
## 31        Mexico 13988.04     11090.87  2897.172        20.711774
## 46 United States 86169.66     63765.73 22403.933        25.999791

df_comparacion <- rbind(
  data.frame(
    country = df_test$country,
    PIB = df_test$PIB_pc,
    Tipo = "Real"
  ),
  data.frame(
    country = df_test$country,
    PIB = df_test$PIB_predicho,
    Tipo = "Predicho"
  )
)

ggplot(
  df_comparacion,
  aes(x = country, y = PIB, fill = Tipo)
) +
  geom_col(
    position = position_dodge(width = 0.8),
    width = 0.7
  ) +
  labs(
    title = "PIB per cápita real vs. predicho para 2024",
    x = "País",
    y = "PIB per cápita (USD)",
    fill = "Valor"
  ) +
  theme_minimal()

ggplot(df, aes(x = year, y = PIB_pc, color = country)) +
  geom_line(linewidth = 1) +
  geom_point() +
  labs(
    title = "Evolución del PIB per cápita, 2010–2024",
    x = "Año",
    y = "PIB per cápita (USD)",
    color = "País"
  ) +
  theme_minimal()

df_test[, c(
  "country",
  "PIB_pc",
  "PIB_predicho",
  "Error_Porcentual"
)]

##          country   PIB_pc PIB_predicho Error_Porcentual
## 1         Brazil 10310.55     13884.79        34.665832
## 16        Canada 55015.71     49581.70         9.877184
## 31        Mexico 13988.04     11090.87        20.711774
## 46 United States 86169.66     63765.73        25.999791

summary(modelo_final)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = PIB_pc ~ Desempleo + Esperanza_vida, data = df_train_panel, 
##     model = "within")
## 
## Balanced Panel: n = 4, T = 14, N = 56
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##   -6315   -3751    -669    2888   17574 
## 
## Coefficients:
##                Estimate Std. Error t-value Pr(>|t|)    
## Desempleo      -1678.19     372.68 -4.5031 4.03e-05 ***
## Esperanza_vida -1193.82     695.73 -1.7159  0.09236 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1724300000
## Residual Sum of Squares: 1.179e+09
## R-Squared:      0.31623
## Adj. R-Squared: 0.24785
## F-statistic: 11.5618 on 2 and 50 DF, p-value: 7.4611e-05

PREDICCIÓN : ¿Cuál sería el PIB per cápita esperado para cada país en 2024, considerando su nivel de desempleo y esperanza de vida?

CONCLUSIÓN:

A – Afirmación: El modelo de Efectos Fijos permitió estimar el PIB per cápita de 2024 para los cuatro países analizados y, aunque las predicciones no fueron exactas en todos los casos, sí permitieron identificar diferencias importantes entre los mercados y evaluar qué tan bien el modelo logra representar su comportamiento económico.

R – Razón: Las predicciones permiten comparar el valor que el modelo esperaba obtener con el valor que realmente se observó en 2024. Esta comparación es útil porque no solo nos indica qué tan preciso es el modelo, sino que también permite identificar mercados donde existen factores económicos adicionales que el modelo no está capturando. Desde una perspectiva empresarial, estas diferencias son relevantes porque muestran que las condiciones de cada mercado pueden requerir un análisis más profundo antes de tomar decisiones de inversión o expansión.

E – Evidencia: Para 2024, el modelo pronosticó un PIB per cápita de $13,884.79 USD para Brasil, frente a un valor real de $10,310.55 USD, generando un error de 34.67%. Para Canadá, la predicción fue de $49,581.70 USD frente a $55,015.71 USD reales, con el menor error de la muestra (9.88%). En México, el modelo estimó $11,090.87 USD frente a $13,988.04 USD reales, con un error de 20.71%, mientras que para Estados Unidos estimó $63,765.73 USD frente a $86,169.66 USD reales, con un error de 26.00%.

A partir de estos resultados, el principal hallazgo es que Canadá fue el mercado donde el modelo tuvo mayor precisión, mientras que Brasil presentó la mayor diferencia entre lo esperado y lo observado. También se observa que el modelo tendió a subestimar el PIB per cápita de Canadá, México y Estados Unidos, mientras que sobreestimó el de Brasil. Esto indica que existen características económicas particulares de cada país que no están siendo capturadas completamente por las variables utilizadas.

Desde una perspectiva empresarial, esto significa que el modelo puede funcionar como una herramienta inicial para comparar mercados y detectar tendencias, pero no debería utilizarse como único criterio para tomar decisiones de inversión. Las diferencias entre las predicciones y los valores reales sugieren que sería conveniente incorporar variables adicionales, como inversión, exportaciones, inflación, consumo o crecimiento económico, para obtener un análisis más completo y mejorar la precisión de futuras predicciones.