library(readxl)## Warning: package 'readxl' was built under R version 4.3.3PD4 <- read_excel("PD4.xlsx")
View(PD4)1.Estime el modelo de R.L considerando todas las variables predictoras
str(PD4)## tibble [500 × 9] (S3: tbl_df/tbl/data.frame)
## $ Seguidores : num [1:500] 1.13 1.91 2.22 3.75 1.5 ...
## $ Publicaciones : num [1:500] 22 13 17 28 2 16 24 25 10 30 ...
## $ Interacción : num [1:500] 0.0712 0.0714 0.1163 0.0244 0.1241 ...
## $ Activo : num [1:500] 6 3 2 6 3 9 3 6 6 10 ...
## $ Plataforma : chr [1:500] "3" "1" "3" "2" ...
## $ Edad : num [1:500] 21 30 35 19 40 39 26 36 18 20 ...
## $ Estilo : chr [1:500] "1" "3" "3" "1" ...
## $ Patrocinadores: num [1:500] 3 2 4 2 4 2 4 5 2 3 ...
## $ Ingresos : num [1:500] 177 179 278 103 285 ...#a)Convierta a las variables predictoras cualitativas como variables indicadoras.
#Considere a la plataforma Tik Tok y al estilo cocina como categoría de referencia.
PD4$Plataforma<-factor(PD4$Plataforma,levels = c(2,1,3))
PD4$Estilo<-factor(PD4$Estilo,levels = c(3,1,2,4,5))
str(PD4)## tibble [500 × 9] (S3: tbl_df/tbl/data.frame)
## $ Seguidores : num [1:500] 1.13 1.91 2.22 3.75 1.5 ...
## $ Publicaciones : num [1:500] 22 13 17 28 2 16 24 25 10 30 ...
## $ Interacción : num [1:500] 0.0712 0.0714 0.1163 0.0244 0.1241 ...
## $ Activo : num [1:500] 6 3 2 6 3 9 3 6 6 10 ...
## $ Plataforma : Factor w/ 3 levels "2","1","3": 3 2 3 1 2 3 3 3 1 1 ...
## $ Edad : num [1:500] 21 30 35 19 40 39 26 36 18 20 ...
## $ Estilo : Factor w/ 5 levels "3","1","2","4",..: 2 1 1 2 2 1 3 3 2 4 ...
## $ Patrocinadores: num [1:500] 3 2 4 2 4 2 4 5 2 3 ...
## $ Ingresos : num [1:500] 177 179 278 103 285 ...#b)A un nivel de significación de 0.01, ¿Qué variables considera significativas si
# utiliza el análisis individual?
modelo<-lm(Ingresos~.,data=PD4)
summary(modelo)##
## Call:
## lm(formula = Ingresos ~ ., data = PD4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -13.3549 -3.0926 -0.1829 2.9165 16.1009
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 31.08894 1.44275 21.548 <2e-16 ***
## Seguidores 4.73000 0.14822 31.912 <2e-16 ***
## Publicaciones 0.22353 0.02573 8.688 <2e-16 ***
## Interacción 2004.01388 5.38449 372.183 <2e-16 ***
## Activo 0.06416 0.07372 0.870 0.385
## Plataforma1 -5.85719 0.51579 -11.356 <2e-16 ***
## Plataforma3 -10.00690 0.52170 -19.182 <2e-16 ***
## Edad -0.01941 0.03182 -0.610 0.542
## Estilo1 -0.72990 0.66520 -1.097 0.273
## Estilo2 -1.00798 0.68469 -1.472 0.142
## Estilo4 -0.91535 0.69911 -1.309 0.191
## Estilo5 -0.50473 0.66517 -0.759 0.448
## Patrocinadores 0.01248 0.15376 0.081 0.935
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.745 on 487 degrees of freedom
## Multiple R-squared: 0.9967, Adjusted R-squared: 0.9966
## F-statistic: 1.224e+04 on 12 and 487 DF, p-value: < 2.2e-16# c)A un nivel de significación de 0.01, ¿Qué variables considera significativas si
#utiliza el análisis anidado?
anova(modelo, test = "F")## Analysis of Variance Table
##
## Response: Ingresos
## Df Sum Sq Mean Sq F value Pr(>F)
## Seguidores 1 29492 29492 1.3099e+03 <2e-16 ***
## Publicaciones 1 11920 11920 5.2945e+02 <2e-16 ***
## Interacción 1 3255692 3255692 1.4460e+05 <2e-16 ***
## Activo 1 73 73 3.2510e+00 0.0720 .
## Plataforma 2 8550 4275 1.8987e+02 <2e-16 ***
## Edad 1 7 7 3.1480e-01 0.5750
## Estilo 4 62 16 6.9010e-01 0.5991
## Patrocinadores 1 0 0 6.6000e-03 0.9353
## Residuals 487 10965 23
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Para analizar si la inclusión de Edad, Estilo y Patrocinadores es significativo
modelo1 <- lm(Ingresos ~ Seguidores + Publicaciones + Interacción +
Activo + Plataforma, data = PD4)
anova(modelo1, modelo, test = "F")## Analysis of Variance Table
##
## Model 1: Ingresos ~ Seguidores + Publicaciones + Interacción + Activo +
## Plataforma
## Model 2: Ingresos ~ Seguidores + Publicaciones + Interacción + Activo +
## Plataforma + Edad + Estilo + Patrocinadores
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 493 11034
## 2 487 10965 6 69.385 0.5136 0.7981# d)Estime el modelo que considera solo a las variables significativas e interprete el
# coeficiente de la primera categoría de plataforma
modelof <- lm(Ingresos ~ Seguidores + Publicaciones + Interacción +
Plataforma, data = PD4)
summary(modelof)##
## Call:
## lm(formula = Ingresos ~ Seguidores + Publicaciones + Interacción +
## Plataforma, data = PD4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -13.4352 -3.1129 -0.3197 3.0398 16.0500
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 30.2951 0.7372 41.096 <2e-16 ***
## Seguidores 4.7345 0.1474 32.112 <2e-16 ***
## Publicaciones 0.2221 0.0255 8.708 <2e-16 ***
## Interacción 2004.4441 5.2581 381.214 <2e-16 ***
## Plataforma1 -5.8900 0.5131 -11.480 <2e-16 ***
## Plataforma3 -10.0635 0.5179 -19.431 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.73 on 494 degrees of freedom
## Multiple R-squared: 0.9967, Adjusted R-squared: 0.9966
## F-statistic: 2.955e+04 on 5 and 494 DF, p-value: < 2.2e-16🔍 PREGUNTA 2 - Selección de variables Responda las siguientes preguntas a un nivel de significación de 0.01,
# a) Determine el mejor modelo según la métrica de:
#▪ Raíz del cuadrado medio del error (RMSE)
#▪ Cp de Mallows
#▪ Sp de Hockings
library(olsrr)## Warning: package 'olsrr' was built under R version 4.3.3##
## Attaching package: 'olsrr'## The following object is masked from 'package:datasets':
##
## riversresul <- ols_step_all_possible(modelo)# RMSE
which.min(resul$result[,6])## [1] 255resul$result[255,]## mindex n
## 255 255 8
## predictors
## 255 Seguidores Publicaciones Interacción Activo Plataforma Edad Estilo Patrocinadores
## rsquare adjr rmse predrsq cp aic sbic sbc
## 255 0.9966942 0.9966127 4.682858 0.9965163 13 2990.847 1564.388 3049.852
## msep fpe apc hsp
## 255 11165.88 22.9198 0.003427 0.04594803# Cp-Mallows
which.min(resul$result[,8])## [1] 93resul$result[93,]## mindex n predictors rsquare adjr
## 94 93 4 Seguidores Publicaciones Interacción Plataforma 0.9966678 0.9966341
## rmse predrsq cp aic sbic sbc msep fpe
## 94 4.701516 0.9965857 2.888469 2980.824 1560.07 3010.326 11163.9 22.59645
## apc hsp
## 94 0.003399522 0.04528892# Sp de Hockings
which.min(resul$result[,15])## [1] 93resul$result[93,]## mindex n predictors rsquare adjr
## 94 93 4 Seguidores Publicaciones Interacción Plataforma 0.9966678 0.9966341
## rmse predrsq cp aic sbic sbc msep fpe
## 94 4.701516 0.9965857 2.888469 2980.824 1560.07 3010.326 11163.9 22.59645
## apc hsp
## 94 0.003399522 0.04528892Si los criterios anteriores seleccionan diferentes modelos ¿Qué modelo elegiría Ud.? Sustente su respuesta
⚡ PREGUNTA 3 - Métodos stepwise Utilice el método stepwise backward, forward y both Determine el mejor modelo de regresión lineal y evalúe los supuestos de normalidad y homogeneidad de varianzas.
# Backward
step(modelo, trace = TRUE, direction = "backward")## Start: AIC=1569.91
## Ingresos ~ Seguidores + Publicaciones + Interacción + Activo +
## Plataforma + Edad + Estilo + Patrocinadores
##
## Df Sum of Sq RSS AIC
## - Estilo 4 62 11026 1564.7
## - Patrocinadores 1 0 10965 1567.9
## - Edad 1 8 10973 1568.3
## - Activo 1 17 10982 1568.7
## <none> 10965 1569.9
## - Publicaciones 1 1699 12664 1639.9
## - Plataforma 2 8449 19414 1851.6
## - Seguidores 1 22929 33893 2132.2
## - Interacción 1 3118716 3129681 4394.9
##
## Step: AIC=1564.72
## Ingresos ~ Seguidores + Publicaciones + Interacción + Activo +
## Plataforma + Edad + Patrocinadores
##
## Df Sum of Sq RSS AIC
## - Patrocinadores 1 1 11027 1562.7
## - Edad 1 7 11033 1563.0
## - Activo 1 17 11043 1563.5
## <none> 11026 1564.7
## - Publicaciones 1 1683 12709 1633.7
## - Plataforma 2 8542 19568 1847.5
## - Seguidores 1 23000 34026 2126.1
## - Interacción 1 3192817 3203843 4398.6
##
## Step: AIC=1562.74
## Ingresos ~ Seguidores + Publicaciones + Interacción + Activo +
## Plataforma + Edad
##
## Df Sum of Sq RSS AIC
## - Edad 1 7 11034 1561.1
## - Activo 1 17 11044 1561.5
## <none> 11027 1562.7
## - Publicaciones 1 1682 12709 1631.7
## - Plataforma 2 8542 19569 1845.5
## - Seguidores 1 23013 34040 2124.3
## - Interacción 1 3245888 3256915 4404.8
##
## Step: AIC=1561.06
## Ingresos ~ Seguidores + Publicaciones + Interacción + Activo +
## Plataforma
##
## Df Sum of Sq RSS AIC
## - Activo 1 18 11052 1559.9
## <none> 11034 1561.1
## - Publicaciones 1 1678 12712 1629.9
## - Plataforma 2 8550 19584 1843.9
## - Seguidores 1 23031 34065 2122.7
## - Interacción 1 3247348 3258382 4403.1
##
## Step: AIC=1559.89
## Ingresos ~ Seguidores + Publicaciones + Interacción + Plataforma
##
## Df Sum of Sq RSS AIC
## <none> 11052 1559.9
## - Publicaciones 1 1696 12749 1629.3
## - Plataforma 2 8605 19657 1843.8
## - Seguidores 1 23070 34122 2121.5
## - Interacción 1 3251293 3262345 4401.7##
## Call:
## lm(formula = Ingresos ~ Seguidores + Publicaciones + Interacción +
## Plataforma, data = PD4)
##
## Coefficients:
## (Intercept) Seguidores Publicaciones Interacción Plataforma1
## 30.2951 4.7345 0.2221 2004.4441 -5.8900
## Plataforma3
## -10.0635# Forward
horizonte <- formula(Ingresos ~ Seguidores + Publicaciones + Interacción +
Activo + Plataforma + Edad + Estilo + Patrocinadores)
modelo0 <- lm(Ingresos ~ 1, data = PD4)
step(modelo0, trace = TRUE, direction = "forward", scope = horizonte)## Start: AIC=4401.95
## Ingresos ~ 1
##
## Df Sum of Sq RSS AIC
## + Interacción 1 3274195 42566 2226.1
## + Patrocinadores 1 56739 3260022 4395.3
## + Estilo 4 70114 3246647 4399.3
## + Seguidores 1 29492 3287269 4399.5
## + Publicaciones 1 13538 3303223 4401.9
## <none> 3316761 4401.9
## + Activo 1 2519 3314242 4403.6
## + Edad 1 1578 3315183 4403.7
## + Plataforma 2 9093 3307668 4404.6
##
## Step: AIC=2226.1
## Ingresos ~ Interacción
##
## Df Sum of Sq RSS AIC
## + Seguidores 1 21444.0 21121 1877.7
## + Plataforma 2 6208.9 36357 2151.3
## + Publicaciones 1 1967.5 40598 2204.4
## + Activo 1 170.1 42395 2226.1
## <none> 42566 2226.1
## + Edad 1 32.2 42533 2227.7
## + Patrocinadores 1 16.7 42549 2227.9
## + Estilo 4 153.3 42412 2232.3
##
## Step: AIC=1877.72
## Ingresos ~ Interacción + Seguidores
##
## Df Sum of Sq RSS AIC
## + Plataforma 2 8372.9 12749 1629.3
## + Publicaciones 1 1464.5 19657 1843.8
## + Activo 1 105.0 21017 1877.2
## <none> 21122 1877.7
## + Edad 1 11.9 21110 1879.4
## + Patrocinadores 1 0.0 21121 1879.7
## + Estilo 4 107.5 21014 1883.2
##
## Step: AIC=1629.28
## Ingresos ~ Interacción + Seguidores + Plataforma
##
## Df Sum of Sq RSS AIC
## + Publicaciones 1 1696.47 11052 1559.9
## <none> 12749 1629.3
## + Activo 1 36.48 12712 1629.8
## + Edad 1 4.32 12744 1631.1
## + Patrocinadores 1 0.19 12748 1631.3
## + Estilo 4 40.64 12708 1635.7
##
## Step: AIC=1559.89
## Ingresos ~ Interacción + Seguidores + Plataforma + Publicaciones
##
## Df Sum of Sq RSS AIC
## <none> 11052 1559.9
## + Activo 1 18.163 11034 1561.1
## + Edad 1 8.488 11044 1561.5
## + Patrocinadores 1 0.543 11052 1561.9
## + Estilo 4 60.490 10992 1565.1##
## Call:
## lm(formula = Ingresos ~ Interacción + Seguidores + Plataforma +
## Publicaciones, data = PD4)
##
## Coefficients:
## (Intercept) Interacción Seguidores Plataforma1 Plataforma3
## 30.2951 2004.4441 4.7345 -5.8900 -10.0635
## Publicaciones
## 0.2221# Both
step(modelo0, trace = TRUE, direction = "both", scope = horizonte)## Start: AIC=4401.95
## Ingresos ~ 1
##
## Df Sum of Sq RSS AIC
## + Interacción 1 3274195 42566 2226.1
## + Patrocinadores 1 56739 3260022 4395.3
## + Estilo 4 70114 3246647 4399.3
## + Seguidores 1 29492 3287269 4399.5
## + Publicaciones 1 13538 3303223 4401.9
## <none> 3316761 4401.9
## + Activo 1 2519 3314242 4403.6
## + Edad 1 1578 3315183 4403.7
## + Plataforma 2 9093 3307668 4404.6
##
## Step: AIC=2226.1
## Ingresos ~ Interacción
##
## Df Sum of Sq RSS AIC
## + Seguidores 1 21444 21121 1877.7
## + Plataforma 2 6209 36357 2151.3
## + Publicaciones 1 1968 40598 2204.4
## + Activo 1 170 42395 2226.1
## <none> 42566 2226.1
## + Edad 1 32 42533 2227.7
## + Patrocinadores 1 17 42549 2227.9
## + Estilo 4 153 42412 2232.3
## - Interacción 1 3274195 3316761 4401.9
##
## Step: AIC=1877.72
## Ingresos ~ Interacción + Seguidores
##
## Df Sum of Sq RSS AIC
## + Plataforma 2 8373 12749 1629.3
## + Publicaciones 1 1464 19657 1843.8
## + Activo 1 105 21017 1877.2
## <none> 21121 1877.7
## + Edad 1 12 21110 1879.4
## + Patrocinadores 1 0 21121 1879.7
## + Estilo 4 108 21014 1883.2
## - Seguidores 1 21444 42566 2226.1
## - Interacción 1 3266148 3287269 4399.5
##
## Step: AIC=1629.28
## Ingresos ~ Interacción + Seguidores + Plataforma
##
## Df Sum of Sq RSS AIC
## + Publicaciones 1 1696 11052 1559.9
## <none> 12749 1629.3
## + Activo 1 36 12712 1629.9
## + Edad 1 4 12744 1631.1
## + Patrocinadores 1 0 12748 1631.3
## + Estilo 4 41 12708 1635.7
## - Plataforma 2 8373 21121 1877.7
## - Seguidores 1 23608 36357 2151.3
## - Interacción 1 3262416 3275165 4401.6
##
## Step: AIC=1559.89
## Ingresos ~ Interacción + Seguidores + Plataforma + Publicaciones
##
## Df Sum of Sq RSS AIC
## <none> 11052 1559.9
## + Activo 1 18 11034 1561.1
## + Edad 1 8 11044 1561.5
## + Patrocinadores 1 1 11052 1561.9
## + Estilo 4 60 10992 1565.1
## - Publicaciones 1 1696 12749 1629.3
## - Plataforma 2 8605 19657 1843.8
## - Seguidores 1 23070 34122 2121.5
## - Interacción 1 3251293 3262345 4401.7##
## Call:
## lm(formula = Ingresos ~ Interacción + Seguidores + Plataforma +
## Publicaciones, data = PD4)
##
## Coefficients:
## (Intercept) Interacción Seguidores Plataforma1 Plataforma3
## 30.2951 2004.4441 4.7345 -5.8900 -10.0635
## Publicaciones
## 0.2221📈 PREGUNTA 3 - Supuestos del modelo
# Supuestos
# Normalidad
shapiro.test(modelof$residuals)##
## Shapiro-Wilk normality test
##
## data: modelof$residuals
## W = 0.99647, p-value = 0.3407# Homogeneidad
library(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericbptest(modelof)##
## studentized Breusch-Pagan test
##
## data: modelof
## BP = 2.1868, df = 5, p-value = 0.8227# Independencia
dwtest(modelof, alternative = "two.sided")##
## Durbin-Watson test
##
## data: modelof
## DW = 1.8377, p-value = 0.0689
## alternative hypothesis: true autocorrelation is not 0🎯 PREGUNTA 4 - Validación del modelo a) MSE
# a) Calcule el MSE.
mean(modelof$residuals^2)## [1] 22.10425# b) Utilice validación cruzada para estimar el valor de MSE considere una muestra
#de entrenamiento del 80% y una muestra de prueba del 20%
ne <- round(0.8 * nrow(PD4))
set.seed(40)
indices <- sample(500, 400)
me <- PD4[indices,]
mp <- PD4[-indices,]
modelome <- lm(Ingresos ~ Seguidores + Publicaciones + Interacción +
Plataforma, data = me)
estim <- predict(modelome, newdata = data.frame(mp[,-9]))
errores <- estim - mp[,9]
colMeans(errores^2)## Ingresos
## 25.15273Validación cruzada repetida
#c) Fije una semilla de 40, repita el proceso 100 veces
n <- nrow(PD4)
ne <- round(0.8 * nrow(PD4))
MSE <- c()
for(i in 1:100){
indices <- sample(n, ne)
me <- PD4[indices,]
mp <- PD4[-indices,]
modelome <- lm(Ingresos ~ Seguidores + Publicaciones + Interacción +
Plataforma, data = me)
estim <- predict(modelome, newdata = data.frame(mp[,-9]))
errores <- estim - mp[,9]
MSE[i] <- colMeans(errores^2)
}
mean(MSE)## [1] 22.9872