Ejercicios en Clase

Instalar paquetes y llamara librerías

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

Ejercicio 1

Valor del Mercado de la Industria de la Piel en México.

INSTRUCCIONES: Genera el modelo de regresión lineal simple y calcula el coeficiente de determinación. ¿Cuál es el pronóstico para 2026?

df <- data.frame(
  Año = c(2020,2021,2022,2023,2024,2025),
  Valor = c(2.00, 2.22, 2.35, 2.46, 2.53, 2.6)
)
modelo_regresion <- lm(Valor ~ Año, data=df)
summary(modelo_regresion)

## 
## Call:
## lm(formula = Valor ~ Año, data = df)
## 
## Residuals:
##         1         2         3         4         5         6 
## -0.071429  0.033143  0.047714  0.042286 -0.003143 -0.048571 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)   
## (Intercept) -231.09429   27.17159  -8.505  0.00105 **
## Año            0.11543    0.01343   8.592  0.00101 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.0562 on 4 degrees of freedom
## Multiple R-squared:  0.9486, Adjusted R-squared:  0.9357 
## F-statistic: 73.82 on 1 and 4 DF,  p-value: 0.001008

df_pronostico <- data.frame(Año=2026)
predict(modelo_regresion, df_pronostico)

##     1 
## 2.764

CONCLUSIÓN:

• Afirmación: El mercado del cuidado de la piel en México muestra un crecimiento constante y predecible, con un pronóstico de 2.764 M USD para 2026.
• Razón: La relación entre el año y el valor del mercado es prácticamente lineal, con un crecimiento promedio de 0.115 M USD por año.
• Evidencia: El coeficiente de determinación es R² = 0.9486, es decir que el modelo explica el 94.86% de la variación del valor del mercado.

Ejercicio 2

Sueldo de los CEO y ventas de la empresa

INSTRUCCIONES: Genera el modelo de elasticidad constante y calcula el coeficiente de determinación. ¿Cuál es el pronóstico de sueldo de un CEO si la empresa vende 500M USD?

df2 <- data.frame(
  Ventas = c(2.72, 7.39, 20.09, 54.60, 148.41, 403.43),
  Sueldo = c(375.31, 38.09, 627.50, 347.23, 448.99, 580.56)
)
modelo_elasticidad <- lm(log(Sueldo) ~ log(Ventas), data = df2)
summary(modelo_elasticidad)

## 
## Call:
## lm(formula = log(Sueldo) ~ log(Ventas), data = df2)
## 
## Residuals:
##          1          2          3          4          5          6 
##  8.482e-01 -1.696e+00  8.485e-01 -1.822e-04 -8.569e-05 -3.028e-05 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)   4.8224     0.9673   4.986  0.00757 **
## log(Ventas)   0.2569     0.2484   1.034  0.35935   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.039 on 4 degrees of freedom
## Multiple R-squared:  0.2111, Adjusted R-squared:  0.01384 
## F-statistic:  1.07 on 1 and 4 DF,  p-value: 0.3593

df2_pronostico <- data.frame(Ventas = 500)
prediccion_log <- predict(modelo_elasticidad, df2_pronostico)
prediccion <- exp(prediccion_log)
prediccion

##        1 
## 613.4889

CONCLUSIÓN:

• Afirmación: La relación entre las ventas de la empresa y el sueldo de los CEO es inelástica, y el pronóstico para una empresa que vende 500 M USD es de 613.49 mil USD.
• Razón: La elasticidad estimada es 0.2569, por lo que un aumento de 1% en las ventas se asocia con un aumento de apenas 0.26% en el sueldo del CEO: el sueldo reacciona mucho menos que proporcionalmente.
• Evidencia: El R² es 0.2111, es decir que el modelo solo explica el 21% de la variación de los sueldos, por lo que el pronóstico debe tomarse con reservas.

Método ARE para argumentos claros y convincentes:

• A — Afirmación: idea principal.
• R — Razón: razonamiento lógico.
• E — Evidencia: pruebas que apoyan la razón.

Ejercicio 3

Relación de la Publicidad en las Ventas de las Principales Aerolíneas de México INSTRUCCIONES: Genera el mejor modelo de predicción. ¿Cuál es el pronóstico de ventas para cada aerolínea si en 2026 gastaran 6 M USD en publicidad?

df3 <- data.frame(
  Empresa    = c("Aeromexico","Aeromexico","Aeromexico",
                 "Volaris","Volaris","Volaris",
                 "Viva","Viva","Viva"),
  Año       = c(2023,2024,2025, 2023,2024,2025, 2023,2024,2025),
  Publicidad = c(1,2,3, 2,3,4, 3,4,5),
  Ventas     = c(12,14,16, 8,10,12, 4,6,8)
)
df3 <- pdata.frame(df3, index = c("Empresa", "Año") )
# Lo siguiente es explicación:
modelo_regresion2 <- lm(Ventas ~ Publicidad, data=df3)
summary(modelo_regresion2)

## 
## Call:
## lm(formula = Ventas ~ Publicidad, data = df3)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##     -6     -3      0      3      6 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)   13.000      3.645   3.567  0.00914 **
## Publicidad    -1.000      1.134  -0.882  0.40708   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.928 on 7 degrees of freedom
## Multiple R-squared:    0.1,  Adjusted R-squared:  -0.02857 
## F-statistic: 0.7778 on 1 and 7 DF,  p-value: 0.4071

# La pendiente sale negativa (-1) porque son datos de panel: el modelo confunde
# las diferencias entre aerolíneas con el efecto de la publicidad dentro de cada
# una. Se corrige con efectos fijos.
# Fin de la explicación

# Prueba de Heterogeneidad
plotmeans(Ventas ~ Publicidad, data=df3)

## Warning in qt((1 + p)/2, ns - 1): Se han producido NaNs

# 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)
pooled <- plm(Ventas ~ Publicidad, data=df3, model="pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = Ventas ~ Publicidad, data = df3, model = "pooling")
## 
## Balanced Panel: n = 3, T = 3, N = 9
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##      -6      -3       0       3       6 
## 
## Coefficients:
##             Estimate Std. Error t-value Pr(>|t|)   
## (Intercept)  13.0000     3.6450  3.5666 0.009139 **
## Publicidad   -1.0000     1.1339 -0.8819 0.407084   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    120
## Residual Sum of Squares: 108
## R-Squared:      0.1
## Adj. R-Squared: -0.028571
## F-statistic: 0.777778 on 1 and 7 DF, p-value: 0.40708

#Opción 2 - Modelo de Efectos Fijos (Within)
within <- plm(Ventas ~ Publicidad, data=df3, model="within")

## Warning in summary.lm(object, ...): essentially perfect fit: summary may be
## unreliable

summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = Ventas ~ Publicidad, data = df3, model = "within")
## 
## Balanced Panel: n = 3, T = 3, N = 9
## 
## Residuals:
## Aeromexico-2023 Aeromexico-2024 Aeromexico-2025       Viva-2023       Viva-2024 
##     -9.0649e-16      0.0000e+00     -1.8130e-16      1.8130e-16      0.0000e+00 
##       Viva-2025    Volaris-2023    Volaris-2024    Volaris-2025 
##     -1.8130e-16      1.8130e-16      0.0000e+00     -1.8130e-16 
## 
## Coefficients:
##             Estimate Std. Error    t-value  Pr(>|t|)    
## Publicidad 2.000e+00  1.813e-16 1.1032e+16 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    24
## Residual Sum of Squares: 9.8608e-31
## R-Squared:      1
## Adj. R-Squared: 1
## F-statistic: 1.21694e+32 on 1 and 5 DF, p-value: < 2.22e-16

# Prueba F
# INTERPRETACIÓN: Si p<0.05 No usar POOLED. Si p>0.05 usar Pooled.
pFtest(within,pooled) #Ojo: El primer argumento es el modelo within!

## 
##  F test for individual effects
## 
## data:  Ventas ~ Publicidad
## F = 2.7381e+32, df1 = 2, df2 = 5, p-value < 2.2e-16
## alternative hypothesis: significant effects

# Opción 3 - Modelo de Efectos Aleatorios (Random)
random <- plm(Ventas ~ Publicidad, data=df3, model="random")

## Warning in summary.lm(object, ...): essentially perfect fit: summary may be
## unreliable

## Warning in summary.lm(object, ...): essentially perfect fit: summary may be
## unreliable

summary(random)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = Ventas ~ Publicidad, data = df3, model = "random")
## 
## Balanced Panel: n = 3, T = 3, N = 9
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 4.207e-31 6.486e-16 0.017
## individual    2.440e-29 4.940e-15 0.983
## theta: 0.9244
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -0.485  -0.417   0.000   0.417   0.485 
## 
## Coefficients:
##             Estimate Std. Error z-value Pr(>|z|)    
## (Intercept)  4.10227    1.91588  2.1412  0.03226 *  
## Publicidad   1.96591    0.17045 11.5333  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    24.549
## Residual Sum of Squares: 1.2273
## R-Squared:      0.95001
## Adj. R-Squared: 0.94286
## Chisq: 133.018 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(random,within) #Ojo: El primer argumento es el modelo random!

## 
##  Hausman Test
## 
## data:  Ventas ~ Publicidad
## chisq = 0.04, df = 1, p-value = 0.8415
## alternative hypothesis: one model is inconsistent

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

df3_pronostico <- data.frame(
  Empresa = c("Aeromexico","Volaris","Viva"),
  Año = c(2026,2026,2026),
  Publicidad = c(6,6,6)
)

df3_pronostico <- pdata.frame(df3_pronostico, index = c("Empresa","Año"))

intercepto <- coef(random)["(Intercept)"]
pendiente  <- coef(random)["Publicidad"]
efectos    <- ranef(random)

df3_pronostico$Ventas <- predict(random, df3_pronostico)
print(df3_pronostico[,c("Empresa","Ventas")])

##                    Empresa   Ventas
## Aeromexico-2026 Aeromexico 15.89773
## Viva-2026             Viva 15.89773
## Volaris-2026       Volaris 15.89773

df3_pronostico$Ventas <- intercepto + efectos + pendiente*df3_pronostico$Publicidad
df3_pronostico[,c( "Ventas")]

## Aeromexico-2026       Viva-2026    Volaris-2026 
##       21.829545        9.965909       15.897727

CONCLUSIÓN: Existe una relación lineal perfecta y positiva entre la inversión de publicidad y las ventas en estas 3 aerolíneas, A través del Modelo de Efectos Aleatorios se determinó que el pronóstico de ventas, si invirtieran $6M USD en publicidad el próximo año, sería de 22 M USD para Aeroméxico, 10 para VIva t 16 para Volaris.

Ejercicio 4

Relación de la Publicidad en las Ventas de las Principales Empresas del Cuidado de la Piel en México

INSTRUCCIONES: Genera el mejor modelo de predicción. ¿Cuál es el pronóstico de ventas para cada empresa si en 2026 incrementan el 10% de su gasto en publicidad con respecto 2025?

df4 <- data.frame(
  Empresa    = c("Genomma Lab","Genomma Lab","Genomma Lab",
                 "LOreal","LOreal","LOreal",
                 "Beiersdorf","Beiersdorf","Beiersdorf",
                 "Natura","Natura","Natura"),
  Año        = c(2023,2024,2025, 2023,2024,2025, 2023,2024,2025, 2023,2024,2025),
  Publicidad = c(1920,2050,2010, 1580,1750,1890, 740,810,870, 560,610,640),
  Ventas     = c(7650,8100,7525, 13200,14500,15600, 5550,6020,6400, 6700,7150,7480)
)
df4 <- pdata.frame(df4, index = c("Empresa","Año"))

# Prueba de Heterogeneidad
plotmeans(Ventas ~ Empresa, data=df4)

# Opción 1 - Modelo de Regresión Agrupada (Pooled)
pooled4 <- plm(Ventas ~ Publicidad, data=df4, model="pooling")
summary(pooled4)

## Pooling Model
## 
## Call:
## plm(formula = Ventas ~ Publicidad, data = df4, model = "pooling")
## 
## Balanced Panel: n = 4, T = 3, N = 12
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##   -3576   -1949    -477    1379    4877 
## 
## Coefficients:
##              Estimate Std. Error t-value Pr(>|t|)  
## (Intercept) 4778.6326  2081.2268  2.2961  0.04455 *
## Publicidad     3.1453     1.4681  2.1424  0.05780 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    134450000
## Residual Sum of Squares: 92152000
## R-Squared:      0.31459
## Adj. R-Squared: 0.24605
## F-statistic: 4.58984 on 1 and 10 DF, p-value: 0.057802

# Opción 2 - Modelo de Efectos Fijos (Within)
within4 <- plm(Ventas ~ Publicidad, data=df4, model="within")
summary(within4)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = Ventas ~ Publicidad, data = df4, model = "within")
## 
## Balanced Panel: n = 4, T = 3, N = 12
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -350.44  -68.75   -5.22   49.41  406.94 
## 
## Coefficients:
##            Estimate Std. Error t-value  Pr(>|t|)    
## Publicidad  7.02641    0.84282  8.3368 6.998e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    3738800
## Residual Sum of Squares: 342100
## R-Squared:      0.9085
## Adj. R-Squared: 0.85621
## F-statistic: 69.502 on 1 and 7 DF, p-value: 6.9984e-05

# Prueba F
# INTERPRETACIÓN: Si p<0.05 No usar POOLED. Si p>0.05 usar Pooled.
pFtest(within4, pooled4) #Ojo: El primer argumento es el modelo within!

## 
##  F test for individual effects
## 
## data:  Ventas ~ Publicidad
## F = 626.19, df1 = 3, df2 = 7, p-value = 7.247e-09
## alternative hypothesis: significant effects

# Opción 3 - Modelo de Efectos Aleatorios (Random)
random4 <- plm(Ventas ~ Publicidad, data=df4, model="random")
summary(random4)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = Ventas ~ Publicidad, data = df4, model = "random")
## 
## Balanced Panel: n = 4, T = 3, N = 12
## 
## Effects:
##                     var   std.dev share
## idiosyncratic 4.887e+04 2.211e+02 0.003
## individual    1.511e+07 3.887e+03 0.997
## theta: 0.9672
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -538.8   -31.6    23.5   117.0   232.3 
## 
## Coefficients:
##               Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept)  101.50041 2248.54561  0.0451     0.964    
## Publicidad     6.78270    0.83067  8.1654 3.205e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    3879600
## Residual Sum of Squares: 505990
## R-Squared:      0.86958
## Adj. R-Squared: 0.85653
## Chisq: 66.6732 on 1 DF, p-value: 3.2046e-16

# Prueba de Hausman
# INTERPRETACIÓN: Si p<0.05 usar Efectos Fijos. Si p>0.05 usar Efectos Aleatorios.
phtest(random4, within4) #Ojo: El primer argumento es el modelo random!

## 
##  Hausman Test
## 
## data:  Ventas ~ Publicidad
## chisq = 2.9203, df = 1, p-value = 0.08747
## alternative hypothesis: one model is inconsistent

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

# Publicidad de 2026 = la de 2025 mas 10%
df4_pronostico <- data.frame(
  Empresa = c("Genomma Lab","LOreal","Beiersdorf","Natura"),
  Año = c(2026,2026,2026,2026),
  Publicidad = c(2010,1890,870,640) * 1.10
)

intercepto4 <- coef(random4)["(Intercept)"]
pendiente4  <- coef(random4)["Publicidad"]
efectos4    <- ranef(random4)

df4_pronostico$Ventas <- intercepto4 +
                         efectos4[df4_pronostico$Empresa] +
                        pendiente4 * df4_pronostico$Publicidad

print(df4_pronostico[,c("Empresa","Publicidad","Ventas")])

##       Empresa Publicidad    Ventas
## 1 Genomma Lab       2211  9241.015
## 2      LOreal       2079 16729.942
## 3  Beiersdorf        957  7009.216
## 4      Natura        704  7789.651

CONCLUSIÓN: La publicidad en industria del cuidado de la piel en México genera un alto impacto en las ventas. Por cada 1 M USD adicional invertido en publicidad, las ventas aumentan 6.78 M USD.