Cargando los datos.

data("marketing")
glimpse(marketing)
## Rows: 200
## Columns: 4
## $ youtube   <dbl> 276.12, 53.40, 20.64, 181.80, 216.96, 10.44, 69.00, 144.24, …
## $ facebook  <dbl> 45.36, 47.16, 55.08, 49.56, 12.96, 58.68, 39.36, 23.52, 2.52…
## $ newspaper <dbl> 83.04, 54.12, 83.16, 70.20, 70.08, 90.00, 28.20, 13.92, 1.20…
## $ sales     <dbl> 26.52, 12.48, 11.16, 22.20, 15.48, 8.64, 14.16, 15.84, 5.76,…

Descripción de los datos:

Estadisticas Basicas.

basicStats(marketing) %>% 
  kable()
youtube facebook newspaper sales
nobs 200.000000 200.000000 200.000000 200.000000
NAs 0.000000 0.000000 0.000000 0.000000
Minimum 0.840000 0.000000 0.360000 1.920000
Maximum 355.680000 59.520000 136.800000 32.400000
1. Quartile 89.250000 11.970000 15.300000 12.450000
3. Quartile 262.590000 43.830000 54.120000 20.880000
Mean 176.451000 27.916800 36.664800 16.827000
Median 179.700000 27.480000 30.900000 15.480000
Sum 35290.200000 5583.360000 7332.960000 3365.400000
SE Mean 7.284974 1.259794 1.847977 0.442716
LCL Mean 162.085349 25.432542 33.020669 15.953984
UCL Mean 190.816651 30.401058 40.308931 17.700016
Variance 10614.167846 317.415950 683.003989 39.199468
Stdev 103.025084 17.816171 26.134345 6.260948
Skewness -0.068809 0.092767 0.881344 0.401478
Kurtosis -1.243594 -1.276329 0.567582 -0.454220

A continuación se presentan las estadísticas básicas para cada unas de las 4 variables que contiene la base de datos marketing del paquete datarium.

pairs(marketing,                     
      labels = colnames(marketing),  
      pch = 20,                 
      bg = rainbow(4),  
      col = rainbow(4), 
      main = "Marketing", 
      row1attop = TRUE,   
      gap = 1,            
      cex.labels = NULL,  
      font.labels = 1)

Existe una correlación significativa entre las ventas y la inversión en publicidad en los diferentes medios. Además, también destaca la correlación 35% entre newspaper y facebook. Podemos observar también que los datos no siguen una distribución normal, excepto de las ventas.

Modelo de Regresión Lineal:

Divido aleatoriamente el dataset en un grupo de train (70%) y otro grupo test (30%).

set.seed(123) 
index <- createDataPartition(marketing$sales, p = 0.7, 
                               list = FALSE)
train <- marketing[index, ]
test  <- marketing[-index, ]

Estimación por Mínimos Cuadrados Ordinarios MCO.

lm_lm  <- lm(sales~., data = train)
tidy(lm_lm, quick=TRUE)
## Warning: The `tidy()` method for objects of class `lmm` is not maintained by the broom team, and is only supported through the `lm` tidier method. Please be cautious in interpreting and reporting broom output.
## 
## This warning is displayed once per session.
## # A tibble: 4 × 5
##   term        estimate std.error statistic  p.value
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
## 1 (Intercept)  3.33      0.460       7.25  2.68e-11
## 2 youtube      0.0457    0.00165    27.6   4.55e-58
## 3 facebook     0.185     0.0104     17.7   2.51e-37
## 4 newspaper    0.00568   0.00733     0.774 4.40e- 1

En la salida anterior se pueden observar los coeficientes estimados por MCO del retorno de las ventas por unidades de inversión en publicidad, podemos apreciar que el coeficiente de newspaper no es significativo, por los que las inversiones en newspaper no representan un aumento en las ventas según la salida del modelo MCO.

Selección de variables de manera que sólo queden variables significativas con un α = 0.05.

Modelo <- backward(lm_lm, alpha=0.05)
## Backward elimination, alpha-to-remove: 0.05
## 
## Full model: sales ~ youtube + facebook + newspaper
## 
##           Step   RSS   AIC  R2pred     Cp F value Pr(>F)
## newspaper    1 572.2 203.9 0.88735 2.5995  0.5995 0.4401

Identificación de los posibles puntos influyentes:

influenceIndexPlot(Modelo, vars="Cook", las=1)

Las observaciones 6 y 131 tienen \(D_i\), se consideran observaciones influyentes.

Revisión de los residuos del modelo.

par(mfrow=c(2, 2))
plot(Modelo, col='deepskyblue4', pch=19)

Vemos que las observaciones 6, 36 y 131 son identificadas por tener valores de residuales grandes.

Minimizando el valor RMSE.

set.seed(123)  
(cv_modelo <- train(
  form = sales~ ., 
  data = train, 
  method = "lm",
  trControl = trainControl(method = "cv", number = 10)
))
## Linear Regression 
## 
## 142 samples
##   3 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 127, 128, 127, 127, 126, 129, ... 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   2.000807  0.8987324  1.576559
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE
df1 <- broom::augment(cv_modelo$finalModel, data = train)

ggplot(df1, aes(.fitted, .std.resid)) + 
  geom_point(size = 1, alpha = .4) +
  xlab("Valores predichos") +
  ylab("Residuals") +
  ggtitle("Modelo")

df1 <- mutate(df1, id = row_number())
ggplot(df1, aes(id, .std.resid)) + 
  geom_point(size = 1, alpha = .4) +
  ylab("Residuals") +
  ggtitle("Modelo", subtitle = "Residuos correlacionados.")