Actividad 1

Instalar paquetes y llamar librerías

#install.packages("readxl")
library(readxl)
#install.packages("plm")
library(plm)
#install.packages("gplots")
library(gplots)
#install.packages("dplyr")
library(dplyr)
#install.packages("tidyr")
library(tidyr)
#install.packages("jsonlite")
library(jsonlite)

Parte 1. Patentes

Patentes solicitadas por 226 empresas entre 2012 y 2021.

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

pat <- read_excel("C:/Users/focus/Downloads/PATENT 3.xlsx")
pat <- na.omit(as.data.frame(pat[,c("cusip","year","patents","rnd","employ","sales","merger")]))
pat <- pdata.frame(pat, index = c("cusip","year"))

# Prueba de Heterogeneidad
plotmeans(patents ~ cusip, data=pat, n.label=FALSE)

# Opción 1 - Modelo de Regresión Agrupada (Pooled)
pooled <- plm(patents ~ rnd + employ + sales + merger, data=pat, model="pooling")
summary(pooled)

## Pooling Model
## 
## Call:
## plm(formula = patents ~ rnd + employ + sales + merger, data = pat, 
##     model = "pooling")
## 
## Unbalanced Panel: n = 225, T = 8-10, N = 2236
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
## -335.55   -7.56   -4.06   -0.56  424.83 
## 
## Coefficients:
##                Estimate  Std. Error t-value  Pr(>|t|)    
## (Intercept)  3.56268010  1.10670497  3.2192  0.001304 ** 
## rnd         -0.10368797  0.01687922 -6.1429 9.565e-10 ***
## employ       1.41291979  0.04388232 32.1979 < 2.2e-16 ***
## sales       -0.00313312  0.00049408 -6.3413 2.749e-10 ***
## merger      -7.08042091  7.66595794 -0.9236  0.355785    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    10987000
## Residual Sum of Squares: 5115700
## R-Squared:      0.53437
## Adj. R-Squared: 0.53353
## F-statistic: 640.084 on 4 and 2231 DF, p-value: < 2.22e-16

# Opción 2 - Modelo de Efectos Fijos (Within)
within <- plm(patents ~ rnd + employ + sales + merger, data=pat, model="within")
summary(within)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = patents ~ rnd + employ + sales + merger, data = pat, 
##     model = "within")
## 
## Unbalanced Panel: n = 225, T = 8-10, N = 2236
## 
## Residuals:
##     Min.  1st Qu.   Median  3rd Qu.     Max. 
## -497.531   -1.607   -0.239    1.612  183.813 
## 
## Coefficients:
##           Estimate  Std. Error  t-value  Pr(>|t|)    
## rnd    -0.19747751  0.01415931 -13.9468 < 2.2e-16 ***
## employ  0.12934124  0.07177436   1.8021   0.07169 .  
## sales  -0.00312611  0.00041686  -7.4991  9.59e-14 ***
## merger  3.38818009  4.18383179   0.8098   0.41814    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1091400
## Residual Sum of Squares: 819360
## R-Squared:      0.24922
## Adj. R-Squared: 0.16393
## F-statistic: 166.559 on 4 and 2007 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:  patents ~ rnd + employ + sales + merger
## F = 46.981, df1 = 224, df2 = 2007, p-value < 2.2e-16
## alternative hypothesis: significant effects

# Opción 3 - Modelo de Efectos Aleatorios (Random)
random <- plm(patents ~ rnd + employ + sales + merger, data=pat, model="random")
summary(random)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = patents ~ rnd + employ + sales + merger, data = pat, 
##     model = "random")
## 
## Unbalanced Panel: n = 225, T = 8-10, N = 2236
## 
## Effects:
##                   var std.dev share
## idiosyncratic  408.25   20.21 0.184
## individual    1814.00   42.59 0.816
## theta:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.8346  0.8516  0.8516  0.8512  0.8516  0.8516 
## 
## Residuals:
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -436.7779   -3.5406   -2.2716    0.0062    0.0972  207.4421 
## 
## Coefficients:
##                Estimate  Std. Error  z-value  Pr(>|z|)    
## (Intercept) 14.01442176  3.17358852   4.4160 1.006e-05 ***
## rnd         -0.16581348  0.01440937 -11.5073 < 2.2e-16 ***
## employ       0.98584171  0.05280999  18.6677 < 2.2e-16 ***
## sales       -0.00381959  0.00042484  -8.9906 < 2.2e-16 ***
## merger       4.23723745  4.40565323   0.9618    0.3362    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    1309100
## Residual Sum of Squares: 1025600
## R-Squared:      0.21655
## Adj. R-Squared: 0.21515
## Chisq: 616.974 on 4 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:  patents ~ rnd + employ + sales + merger
## chisq = 307.54, df = 4, p-value < 2.2e-16
## alternative hypothesis: one model is inconsistent

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

Pronóstico: ¿cuántas patentes solicitarían las 5 empresas más grandes si suben 10% su gasto en I+D?

pat2 <- as.data.frame(pat)
pat2$cusip <- as.character(pat2$cusip)
pat2$year  <- as.numeric(as.character(pat2$year))

# 2021 viene incompleto, por eso el pronóstico parte de 2020
tapply(pat2$patents, pat2$year, mean)

##      2012      2013      2014      2015      2016      2017      2018      2019 
## 26.823529 26.258929 26.826667 27.647321 25.777778 26.130631 24.730942 23.718750 
##      2020      2021 
## 18.448889  5.008969

top5 <- names(sort(tapply(pat2$patents, pat2$cusip, mean), decreasing=TRUE))[1:5]
pat_pronostico <- pat2[pat2$cusip %in% top5 & pat2$year==2020, ]

intercepto <- fixef(within)
pendiente  <- coef(within)

pat_pronostico$Pronostico <- intercepto[pat_pronostico$cusip] +
                             pendiente["rnd"]*pat_pronostico$rnd*1.10 +
                             pendiente["employ"]*pat_pronostico$employ +
                             pendiente["sales"]*pat_pronostico$sales +
                             pendiente["merger"]*pat_pronostico$merger

pat_pronostico[,c("cusip","patents","Pronostico")]

##       cusip patents Pronostico
## 238  149123     140   221.3447
## 408  277461     214   193.0776
## 606  369604     667   667.8159
## 941  459200     333   287.5516
## 1429 620076     130   138.0716

CONCLUSIÓN: El mejor modelo para esta base es el de Efectos Fijos. La prueba F descarta el modelo agrupado y la de Hausman descarta el de efectos aleatorios, o sea que las características propias de cada empresa sí están relacionadas con cuánto invierte y cuánto vende. El problema es lo que dice el modelo: el gasto en I+D sale con signo negativo, y el pronóstico lo confirma, porque si estas 5 empresas suben 10% su gasto en I+D el modelo dice que solicitarían menos patentes, lo cual no tiene sentido. Eso pasa porque rnd, sales y employ terminan midiendo lo mismo, que es el tamaño de la empresa. Con un R² de 0.2492 el modelo explica apenas una cuarta parte de la variación dentro de cada empresa, así que los pronósticos no los usaría para tomar una decisión. Para que sirvieran habría que pasar las variables a logaritmos o usar un modelo de conteo, y quitar 2021, que viene incompleto: el promedio de patentes cae de 18.4 a 5 y 125 de las 226 empresas aparecen con cero.

Parte 2. Cuidado de la Piel

Valor del mercado de Beauty and Personal Care en México, 2011-2025.

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

market <- read_excel("C:/Users/focus/Downloads/Market sizes.xlsx", skip = 5)

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

panel <- market %>%
  filter(Category %in% subcats) %>%
  select(Category, matches("^[0-9]{4}$")) %>%
  mutate(across(everything(), as.character)) %>%   #Ojo: los "-" del Excel hacen que unos años se lean como texto
  pivot_longer(-Category, names_to="Anio", values_to="Valor") %>%
  mutate(Anio  = as.numeric(Anio),
         Valor = as.numeric(na_if(Valor,"-"))) %>%
  filter(!is.na(Valor)) %>%
  mutate(Tendencia = Anio - 2010,     # 1 = 2011, 15 = 2025, 16 = 2026
         logValor  = log(Valor))      # con log el coeficiente es la tasa de crecimiento

panel <- pdata.frame(panel, index = c("Category","Anio"))

# Prueba de Heterogeneidad
par(mar=c(9,5,3,1))
plotmeans(Valor ~ Category, data=panel, las=2, connect=FALSE, xlab="")

# Opción 1 - Modelo de Regresión Agrupada (Pooled)
pooled2 <- plm(logValor ~ Tendencia, data=panel, model="pooling")
summary(pooled2)

## Pooling Model
## 
## Call:
## plm(formula = logValor ~ Tendencia, data = 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.910147   0.238229 37.4017  < 2e-16 ***
## Tendencia   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

# Opción 2 - Modelo de Efectos Fijos (Within)
within2 <- plm(logValor ~ Tendencia, data=panel, model="within")
summary(within2)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = logValor ~ Tendencia, data = 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|)    
## Tendencia 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

# Prueba F
pFtest(within2,pooled2)

## 
##  F test for individual effects
## 
## data:  logValor ~ Tendencia
## F = 3539.4, df1 = 7, df2 = 111, p-value < 2.2e-16
## alternative hypothesis: significant effects

# Opción 3 - Modelo de Efectos Aleatorios (Random)
random2 <- plm(logValor ~ Tendencia, data=panel, model="random")
summary(random2)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = logValor ~ Tendencia, data = 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.9101472  0.4639740  19.204 < 2.2e-16 ***
## Tendencia   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

# Prueba de Hausman
phtest(random2,within2)

## 
##  Hausman Test
## 
## data:  logValor ~ Tendencia
## chisq = 1.6241e-14, df = 1, p-value = 1
## alternative hypothesis: one model is inconsistent

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

Pronóstico 2026 por subcategoría:

panel2 <- as.data.frame(panel)

pronostico <- panel2 %>%
  group_by(Category) %>%
  summarise(Crecimiento = coef(lm(logValor ~ Tendencia))[2],
            R2          = summary(lm(logValor ~ Tendencia))$r.squared,
            Pron2026    = exp(predict(lm(logValor ~ Tendencia),
                                      data.frame(Tendencia=16)))) %>%
  arrange(desc(Pron2026))

as.data.frame(pronostico)

##          Category Crecimiento        R2  Pron2026
## 1       Skin Care  0.07443372 0.9703365 72529.360
## 2       Hair Care  0.05418877 0.9728327 55317.968
## 3      Fragrances  0.07462101 0.9032801 52078.190
## 4  Men's Grooming  0.06504529 0.9616394 50701.874
## 5      Deodorants  0.05670968 0.9230642 22763.378
## 6 Bath and Shower  0.06533531 0.9865601 22102.258
## 7        Sun Care  0.08835282 0.9349442  4412.509
## 8    Depilatories  0.06045172 0.9689007  2147.434

# La sub-categoría que más crece y la que menos crece
pronostico[which.max(pronostico$Crecimiento), ]

## # A tibble: 1 × 4
##   Category Crecimiento    R2 Pron2026
##   <fct>          <dbl> <dbl>    <dbl>
## 1 Sun Care      0.0884 0.935    4413.

pronostico[which.min(pronostico$Crecimiento), ]

## # A tibble: 1 × 4
##   Category  Crecimiento    R2 Pron2026
##   <fct>           <dbl> <dbl>    <dbl>
## 1 Hair Care      0.0542 0.973   55318.

CONCLUSIÓN: Invertiría en Skin Care. El mejor modelo es el de Efectos Aleatorios y dice que el mercado completo crece 6.74% anual, pero al sacar la tasa de cada sub-categoría se ve que no todas van al mismo ritmo: la que más crece es Sun Care con 8.84% anual y la que menos crece es Hair Care con 5.42%. Lo importante es que ninguna de las dos es la respuesta automática. El mercado que más crece es también el que más competencia va a atraer, porque todas las marcas ven el mismo crecimiento y se meten; y el que menos crece suele ser el que menos competencia nueva tiene, porque ya está maduro y no le resulta atractivo a nadie. Sun Care además es diminuto, 4,413 millones contra los 55,318 de Hair Care, así que aunque crezca al doble de velocidad el volumen absoluto no compensa: funciona como apuesta de nicho, no como apuesta principal. Skin Care es el punto medio que sí conviene, porque crece 7.44% anual, casi tan rápido como Sun Care, y al mismo tiempo es el mercado más grande de los ocho con 72,529 millones pronosticados para 2026. Es además el que mejor se ajusta al modelo, con un R² de 0.9703, así que su pronóstico es el más confiable de todos. La única advertencia es que esta base solo mide tamaño de mercado y no dice nada de cuántos competidores hay en cada sub-categoría; para cerrar el argumento de la competencia habría que cruzarlo con la base de Company Shares.

Parte 3. Banco Mundial

Esperanza de vida en 12 países, 2000-2023.

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

# La API del Banco Mundial responde lenta desde esta red, por eso el timeout largo
options(timeout = 600)

paises <- "MX;US;CA;BR;CL;CO;AR;PE;ES;KR;JP;IN"

baja <- function(indicador) {
  u <- paste0("https://api.worldbank.org/v2/country/", paises,
              "/indicator/", indicador, "?format=json&per_page=2000&date=2000:2023")
  d <- fromJSON(u)[[2]]
  data.frame(Pais = d$country$value, Anio = as.numeric(d$date), Valor = d$value)
}

# La descarga tarda varios minutos, por eso se guarda y no se vuelve a bajar
if (file.exists("wdi.rds")) {
  wdi <- readRDS("wdi.rds")
} else {
  esperanza  <- baja("SP.DYN.LE00.IN")     # esperanza de vida al nacer
  pib        <- baja("NY.GDP.PCAP.CD")     # PIB per cápita
  salud      <- baja("SH.XPD.CHEX.GD.ZS")  # gasto en salud % del PIB
  urbana     <- baja("SP.URB.TOTL.IN.ZS")  # población urbana %
  fertilidad <- baja("SP.DYN.TFRT.IN")     # hijos por mujer

  wdi <- esperanza %>%
    rename(Esperanza = Valor) %>%
    left_join(rename(pib,        PIB        = Valor), by=c("Pais","Anio")) %>%
    left_join(rename(salud,      Salud      = Valor), by=c("Pais","Anio")) %>%
    left_join(rename(urbana,     Urbana     = Valor), by=c("Pais","Anio")) %>%
    left_join(rename(fertilidad, Fertilidad = Valor), by=c("Pais","Anio")) %>%
    mutate(PIB = PIB/1000) %>%          # PIB per cápita en miles de USD
    na.omit()

  saveRDS(wdi, "wdi.rds")
}

head(wdi)

##        Pais Anio Esperanza       PIB    Salud   Urbana Fertilidad
## 1 Argentina 2023    77.395 14.261847 10.26952 92.19451      1.500
## 2 Argentina 2022    75.806 13.962189 10.15950 92.11284      1.482
## 3 Argentina 2021    73.948 10.738018 11.00910 92.02928      1.585
## 4 Argentina 2020    75.878  8.535599 10.67246 91.94390      1.601
## 5 Argentina 2019    76.847  9.955975 10.11911 91.85678      1.882
## 6 Argentina 2018    76.770 11.752800 10.17289 91.76799      2.067

# Prueba de Heterogeneidad
par(mar=c(8,5,3,1))
plotmeans(Esperanza ~ Pais, data=wdi, las=2, connect=FALSE, xlab="", ylab="Años")

# Gráfica de ingreso contra esperanza de vida
plot(wdi$PIB, wdi$Esperanza,
     xlab="PIB per cápita (miles de USD)", ylab="Esperanza de vida (años)",
     pch=19, col="grey40")
abline(lm(Esperanza ~ PIB, data=wdi), col="red", lwd=2)

wdi <- pdata.frame(wdi, index = c("Pais","Anio"))

# Opción 1 - Modelo de Regresión Agrupada (Pooled)
pooled3 <- plm(Esperanza ~ PIB + Salud + Urbana + Fertilidad, data=wdi, model="pooling")
summary(pooled3)

## Pooling Model
## 
## Call:
## plm(formula = Esperanza ~ PIB + Salud + Urbana + Fertilidad, 
##     data = wdi, model = "pooling")
## 
## Balanced Panel: n = 12, T = 24, N = 288
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -6.065  -0.595   0.250   0.971   3.527 
## 
## Coefficients:
##               Estimate Std. Error  t-value  Pr(>|t|)    
## (Intercept) 75.4130817  0.9534218  79.0973 < 2.2e-16 ***
## PIB          0.1278894  0.0109406  11.6894 < 2.2e-16 ***
## Salud       -0.3112481  0.0573162  -5.4304 1.212e-07 ***
## Urbana       0.1194947  0.0086605  13.7977 < 2.2e-16 ***
## Fertilidad  -4.3246340  0.2745273 -15.7530 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    6263.9
## Residual Sum of Squares: 811.36
## R-Squared:      0.87047
## Adj. R-Squared: 0.86864
## F-statistic: 475.457 on 4 and 283 DF, p-value: < 2.22e-16

# Opción 2 - Modelo de Efectos Fijos (Within)
within3 <- plm(Esperanza ~ PIB + Salud + Urbana + Fertilidad, data=wdi, model="within")
summary(within3)

## Oneway (individual) effect Within Model
## 
## Call:
## plm(formula = Esperanza ~ PIB + Salud + Urbana + Fertilidad, 
##     data = wdi, model = "within")
## 
## Balanced Panel: n = 12, T = 24, N = 288
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -5.187  -0.387   0.221   0.673   1.981 
## 
## Coefficients:
##             Estimate Std. Error t-value  Pr(>|t|)    
## PIB         0.068722   0.014465  4.7508 3.284e-06 ***
## Salud      -0.045645   0.084567 -0.5397    0.5898    
## Urbana      0.338864   0.042202  8.0296 2.967e-14 ***
## Fertilidad -2.302993   0.337533 -6.8230 5.776e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    795.01
## Residual Sum of Squares: 332.54
## R-Squared:      0.58171
## Adj. R-Squared: 0.55864
## F-statistic: 94.5665 on 4 and 272 DF, p-value: < 2.22e-16

# Prueba F
pFtest(within3,pooled3)

## 
##  F test for individual effects
## 
## data:  Esperanza ~ PIB + Salud + Urbana + Fertilidad
## F = 35.603, df1 = 11, df2 = 272, p-value < 2.2e-16
## alternative hypothesis: significant effects

# Opción 3 - Modelo de Efectos Aleatorios (Random)
random3 <- plm(Esperanza ~ PIB + Salud + Urbana + Fertilidad, data=wdi, model="random")
summary(random3)

## Oneway (individual) effect Random Effect Model 
##    (Swamy-Arora's transformation)
## 
## Call:
## plm(formula = Esperanza ~ PIB + Salud + Urbana + Fertilidad, 
##     data = wdi, model = "random")
## 
## Balanced Panel: n = 12, T = 24, N = 288
## 
## Effects:
##                 var std.dev share
## idiosyncratic 1.223   1.106 0.355
## individual    2.220   1.490 0.645
## theta: 0.8502
## 
## Residuals:
##    Min. 1st Qu.  Median 3rd Qu.    Max. 
##  -5.295  -0.450   0.206   0.687   2.515 
## 
## Coefficients:
##              Estimate Std. Error z-value  Pr(>|z|)    
## (Intercept) 65.275337   2.346653 27.8164 < 2.2e-16 ***
## PIB          0.075145   0.014225  5.2825 1.274e-07 ***
## Salud       -0.022270   0.081097 -0.2746    0.7836    
## Urbana       0.199977   0.027046  7.3939 1.426e-13 ***
## Fertilidad  -2.926314   0.321027 -9.1155 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Total Sum of Squares:    917.69
## Residual Sum of Squares: 371.22
## R-Squared:      0.59548
## Adj. R-Squared: 0.58977
## Chisq: 416.602 on 4 DF, p-value: < 2.22e-16

# Prueba de Hausman
phtest(random3,within3)

## 
##  Hausman Test
## 
## data:  Esperanza ~ PIB + Salud + Urbana + Fertilidad
## chisq = 34.163, df = 4, p-value = 6.9e-07
## alternative hypothesis: one model is inconsistent

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

Pronóstico: esperanza de vida de cada país si su PIB per cápita sube 10%.

wdi2 <- as.data.frame(wdi)
wdi2$Pais <- as.character(wdi2$Pais)
wdi2$Anio <- as.numeric(as.character(wdi2$Anio))

wdi_pronostico <- wdi2[wdi2$Anio == max(wdi2$Anio), ]

intercepto3 <- fixef(within3)
pendiente3  <- coef(within3)

wdi_pronostico$Ajustado <- intercepto3[wdi_pronostico$Pais] +
                           pendiente3["PIB"]*wdi_pronostico$PIB +
                           pendiente3["Salud"]*wdi_pronostico$Salud +
                           pendiente3["Urbana"]*wdi_pronostico$Urbana +
                           pendiente3["Fertilidad"]*wdi_pronostico$Fertilidad

wdi_pronostico$Pronostico <- intercepto3[wdi_pronostico$Pais] +
                             pendiente3["PIB"]*wdi_pronostico$PIB*1.10 +
                             pendiente3["Salud"]*wdi_pronostico$Salud +
                             pendiente3["Urbana"]*wdi_pronostico$Urbana +
                             pendiente3["Fertilidad"]*wdi_pronostico$Fertilidad

wdi_pronostico[,c("Pais","Esperanza","Ajustado","Pronostico")]

##              Pais Esperanza Ajustado Pronostico
## 24      Argentina  77.39500 77.90201   78.00002
## 48         Brazil  75.84800 75.02477   75.09609
## 72         Canada  81.62634 83.00841   83.38533
## 96          Chile  81.16700 81.12941   81.24680
## 120      Colombia  77.72500 75.98704   76.03523
## 144         India  72.00300 70.14654   70.16327
## 168         Japan  84.04122 84.22867   84.47068
## 192   Korea, Rep.  83.42927 81.82440   82.06956
## 216        Mexico  75.06900 75.51749   75.61254
## 240          Peru  77.74000 76.76254   76.81696
## 264         Spain  83.93415 83.17301   83.40318
## 288 United States  78.38537 80.46590   81.03345

CONCLUSIÓN: El mejor modelo para este panel es el de Efectos Fijos. La prueba F descarta el modelo agrupado y la de Hausman da un p de 6.9e-07, así que se queda con efectos fijos. El modelo explica el 58.17% de la variación dentro de cada país y salen significativas tres de las cuatro variables: por cada 1,000 dólares más de PIB per cápita la esperanza de vida sube 0.069 años, por cada punto porcentual más de población urbana sube 0.339 años, y por cada hijo más por mujer baja 2.303 años. El gasto en salud como porcentaje del PIB no resulta significativo, lo cual tiene sentido porque gastar más no garantiza gastar bien. El pronóstico deja ver que el ingreso mueve muy poco la aguja: subir 10% el PIB per cápita le suma a México menos de una décima de año (de 75.52 a 75.61) y al país que más le sube, Estados Unidos, apenas le agrega medio año. La gráfica de dispersión explica por qué, porque la relación entre ingreso y esperanza de vida no es una recta: los primeros miles de dólares suman muchos años y después el efecto se aplana. Comparando la columna Ajustado con la observada se ve que el modelo le atina bien a países como Chile y Japón y se equivoca por más de dos años en Estados Unidos, así que los pronósticos sirven para comparar tendencias entre países pero no para predecir la esperanza de vida exacta de uno solo.