Se creo un data frame información proporcionada con el siguiente codigo y tener una visualición previa de la misma:
df <- data.frame(
Ventas = c(200000, 210000, 215000, 220000, 225000, 230000, 235000, 240000, 245000, 250000,
255000, 260000, 265000, 270000, 275000, 280000, 285000, 290000, 295000, 300000,
305000, 310000, 315000, 320000, 325000, 330000, 335000, 340000, 345000, 350000),
Gasto_en_Publicidad = c(20000, 22000, 23000, 25000, 26000, 28000, 29000, 31000, 32000, 33000,
35000, 36000, 37000, 39000, 40000, 42000, 43000, 45000, 46000, 48000,
49000, 51000, 52000, 54000, 55000, 57000, 58000, 60000, 61000, 63000),
Numero_de_Empleados = c(50, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
71, 72, 73, 74, 75, 76, 77, 78, 79, 80))
print(df)
## Ventas Gasto_en_Publicidad Numero_de_Empleados
## 1 200000 20000 50
## 2 210000 22000 52
## 3 215000 23000 53
## 4 220000 25000 54
## 5 225000 26000 55
## 6 230000 28000 56
## 7 235000 29000 57
## 8 240000 31000 58
## 9 245000 32000 59
## 10 250000 33000 60
## 11 255000 35000 61
## 12 260000 36000 62
## 13 265000 37000 63
## 14 270000 39000 64
## 15 275000 40000 65
## 16 280000 42000 66
## 17 285000 43000 67
## 18 290000 45000 68
## 19 295000 46000 69
## 20 300000 48000 70
## 21 305000 49000 71
## 22 310000 51000 72
## 23 315000 52000 73
## 24 320000 54000 74
## 25 325000 55000 75
## 26 330000 57000 76
## 27 335000 58000 77
## 28 340000 60000 78
## 29 345000 61000 79
## 30 350000 63000 80
Vamos a realizar la carga de la libreria necesaria dplyr, ggplot2 nos ayuda a visualizar resultados
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.2.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.2.3
Vamos a utilizar la función “summarise” para obtener el resumen estadistico calculando el promedio, desviacion estandar, mediana, minimo y maximo para tener el resumen estadistico y visualizarlo con print:
REVentas <- df %>%
summarise(Promedio_Ventas = mean(Ventas),
Desviacion_Ventas = sd(Ventas),
Mediana_Ventas = median(Ventas),
Minimo_Ventas = min(Ventas),
Maximo_Ventas = max(Ventas)
)
print(REVentas)
## Promedio_Ventas Desviacion_Ventas Mediana_Ventas Minimo_Ventas Maximo_Ventas
## 1 277333.3 44309.52 277500 2e+05 350000
REGasto <- df %>%
summarise(
Promedio_Publicidad = mean(Gasto_en_Publicidad),
Desviacion_Publicidad = sd(Gasto_en_Publicidad),
Mediana_Publicidad = median(Gasto_en_Publicidad),
Minimo_Publicidad = min(Gasto_en_Publicidad),
Maximo_Publicidad = max(Gasto_en_Publicidad)
)
print(REGasto)
## Promedio_Publicidad Desviacion_Publicidad Mediana_Publicidad
## 1 41333.33 12836.73 41000
## Minimo_Publicidad Maximo_Publicidad
## 1 20000 63000
REEmpleados <- df %>%
summarise(
Promedio_Empleados = mean(Numero_de_Empleados),
Desviacion_Empleados = sd(Numero_de_Empleados),
Mediana_Empleados = median(Numero_de_Empleados),
Minimo_Empleados = min(Numero_de_Empleados),
Maximo_Empleados = max(Numero_de_Empleados)
)
print(REEmpleados)
## Promedio_Empleados Desviacion_Empleados Mediana_Empleados Minimo_Empleados
## 1 65.46667 8.861903 65.5 50
## Maximo_Empleados
## 1 80
La desviación estandar para Ventas y Publicidad son altos, caso contrario a Empleados es baja lo cual indica que es constante.
Vamos a realizar el calculo de la correlación:
print(paste('CorrelacionPearson',cor(df['Ventas'],df['Gasto_en_Publicidad']),
'CorrelacionPearson',cor(df['Ventas'],df['Numero_de_Empleados']),
'CorrelacionPearson',cor(df['Gasto_en_Publicidad'],df['Numero_de_Empleados']))
)
## [1] "CorrelacionPearson 0.999501544422277 CorrelacionPearson 1 CorrelacionPearson 0.999501544422277"
La correlación es alta entre las variables por lo que se asume que estan altamente relacionadas.
Vamos a construir el modelo de regresión con las 3 variables que tenemos:
x_train = df[, c('Gasto_en_Publicidad','Numero_de_Empleados')]
y_train = df['Ventas']
lm <- lm(y_train$Ventas ~ x_train$Gasto_en_Publicidad + x_train$Numero_de_Empleados)
print(summary(lm))
## Warning in summary.lm(lm): essentially perfect fit: summary may be unreliable
##
## Call:
## lm(formula = y_train$Ventas ~ x_train$Gasto_en_Publicidad + x_train$Numero_de_Empleados)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.175e-10 -8.415e-12 3.143e-12 1.120e-11 5.814e-11
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.000e+04 7.198e-10 -6.946e+13 < 2e-16 ***
## x_train$Gasto_en_Publicidad -4.084e-14 1.345e-14 -3.037e+00 0.00524 **
## x_train$Numero_de_Empleados 5.000e+03 1.948e-11 2.567e+14 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.934e-11 on 27 degrees of freedom
## Multiple R-squared: 1, Adjusted R-squared: 1
## F-statistic: 3.306e+31 on 2 and 27 DF, p-value: < 2.2e-16
La variable dependiente es la Venta, La R cuadrada y la R cuadrada ajustada dan 1 por lo que se indica que el 100% de la variabilidad de las ventas es explicada por el modelo, el que este al 100% nos podría indicar que el modelo esta sobreajustado
Aqui los Pv-alues son menores a 0,05 por lo que los datos son estadisticamente significatvos
Ahora vamos a aplicar el contraste de la Durbin Watson, Jarque-Bera, VIF
library(car)
## Warning: package 'car' was built under R version 4.2.3
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.2.3
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
durbinWatsonTest(lm)
## Warning in summary.lm(model): essentially perfect fit: summary may be unreliable
## lag Autocorrelation D-W Statistic p-value
## 1 -0.2389702 1.882067 0.97
## Alternative hypothesis: rho != 0
El Estadistico de contraste D-W nos indica que no hay evidencia de correlación fuerte de orden 1, ya que es muy cercano a 2.
library(tseries)
## Warning: package 'tseries' was built under R version 4.2.3
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
jarque.bera.test(lm$residuals)
##
## Jarque Bera Test
##
## data: lm$residuals
## X-squared = 111.13, df = 2, p-value < 2.2e-16
No hay normalidad en los residuos del modelo. el p-value es menor al 0.05 no es normal y no tiene comportamiento aleatorio.se rechaza la hipotesis nula.
Ahora vamos a validar que no exista multicolinealidad en las variables explicativas del modelo.
library(car)
vif(lm)
## Warning in summary.lm(object, ...): essentially perfect fit: summary may be
## unreliable
## x_train$Gasto_en_Publicidad x_train$Numero_de_Empleados
## 1003.348 1003.348
En este caso si se observa un tema de multicolinealidad ya que los valores son mayores a 5 que es el valor a contrastar.
Prueba de autocorrelacion
library(lmtest)
## Warning: package 'lmtest' was built under R version 4.2.3
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.2.3
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
acf(lm$residuals)
No existe autocorrelación
Vamos a Ejecutar ahora la prueba de Breush-Pagan
library(lmtest)
bptest(lm)
##
## studentized Breusch-Pagan test
##
## data: lm
## BP = 13.141, df = 2, p-value = 0.001401
Con esto revisamos el supuesto de que los residuos ni deben de tener heteroscedasticidad, se observa que el p-value es menor a 0.05 por lo que se observa un problema de heteroscedasticidad
Como conclusión se podria indicar que las variables al estar muy cercanas a 1 la R cuadrada y las correlaciones se puede indicar que las variables son iguales, de misma manera no cumple con los supuestos de multicolinealidad y heteroscedasticidad, por lo que los residuos no se comportan como una variable aleatoria.