Informe RLM
Juan Pablo Gomez Bravo
12/9/2022
Por medio de web Scrapping, se descargo la base de datos de precios de vehiculos mazda 2 para Colombia del portal olx.com.co, con las variables precio, kilometraje, transmisión y ciudad.
Se realizo una depuración y limpieza previa de la base y se agregaron otras variables de interes como color y se separo la ciudad y departamento.
#cargue de librerias requeridas
library(readxl)
library(ggplot2)
library(CGPfunctions)## Warning: package 'CGPfunctions' was built under R version 4.1.2library(ggplot2)
library(plotly)## Warning: package 'plotly' was built under R version 4.1.2##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(sqldf)## Loading required package: gsubfn## Loading required package: proto## Loading required package: RSQLitelibrary(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(fastDummies)
library(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:plotly':
##
## selectCargue inicial de datos
data_olx = read_excel("G:/ACADEMIA/JAVERIANA CALI/2. SEMESTRE 2022 - II/2. Met. Estad. para la Toma Decisiones/RLM/mazda2_col_1.xlsx")
head(data_olx)## # A tibble: 6 x 8
## `web-scraper-ord~ precio kilometraje transmision modelo_ano color ciudad Depto
## <chr> <dbl> <dbl> <chr> <dbl> <chr> <chr> <chr>
## 1 1662992063-359 5.8 e7 33000 Mecanica 2019 Blan~ Bogota Bogo~
## 2 1662992030-348 5.69e7 100000 Automatica 2016 Azul Medel~ Anti~
## 3 1662991456-146 3.8 e7 92000 Mecanica 2013 Azul Bogota Bogo~
## 4 1662991768-254 6.49e7 35000 Mecanica 2019 Azul Bogota Bogo~
## 5 1662992126-381 5.49e7 61000 Automatica 2016 Azul Bogota Bogo~
## 6 1662992066-360 4.19e7 94000 Mecanica 2014 Azul Bogota Bogo~str(data_olx)## tibble [318 x 8] (S3: tbl_df/tbl/data.frame)
## $ web-scraper-order: chr [1:318] "1662992063-359" "1662992030-348" "1662991456-146" "1662991768-254" ...
## $ precio : num [1:318] 58000000 56900000 38000000 64900000 54900000 41900000 72500000 66000000 42000000 38500000 ...
## $ kilometraje : num [1:318] 33000 100000 92000 35000 61000 ...
## $ transmision : chr [1:318] "Mecanica" "Automatica" "Mecanica" "Mecanica" ...
## $ modelo_ano : num [1:318] 2019 2016 2013 2019 2016 ...
## $ color : chr [1:318] "Blanco" "Azul" "Azul" "Azul" ...
## $ ciudad : chr [1:318] "Bogota" "Medellin" "Bogota" "Bogota" ...
## $ Depto : chr [1:318] "Bogotá" "Antioquia" "Bogotá" "Bogotá" ...EXPLORACION INICIAL DE VARIABLES
par(mfrow=c(1,3))
boxplot(data_olx$precio, main='Precio')
boxplot(data_olx$kilometraje ,main='Kilometraje')
boxplot(data_olx$modelo_ano ,main='Modelo Ano')
#Conteo por Color de vehiculo publicado
sqldf("select color, count() as conteo
from data_olx
group by color
order by conteo desc")## color conteo
## 1 Gris 106
## 2 Blanco 77
## 3 Rojo 44
## 4 Plateado 26
## 5 Negro 19
## 6 Azul 19
## 7 Vinotinto 7
## 8 Otro 7
## 9 Beige 5
## 10 Verde 3
## 11 Marrón 2
## 12 Morado 1
## 13 Dorado 1
## 14 Crema 1#se identifica principalmente Carros Grises y Blancos en las publicaciones, siendo el 58% de las publicaciones de interes.
#Conteo por Color de vehiculo publicado
sqldf("select depto, count() as conteo
from data_olx
group by depto
order by conteo desc")## Depto conteo
## 1 Antioquia 84
## 2 ValledelCauca 55
## 3 Bogotá 52
## 4 Caldas 23
## 5 Santander 21
## 6 Atlántico 13
## 7 Quindío 11
## 8 Risaralda 10
## 9 Huila 10
## 10 Tolima 8
## 11 Cundinamarca 8
## 12 Meta 7
## 13 NortedeSantander 6
## 14 Nariño 3
## 15 Cesar 2
## 16 Sucre 1
## 17 Magdalena 1
## 18 Córdoba 1
## 19 Cauca 1
## 20 Casanare 1Se identifica principalmente publicaciones en Antioquia, Valle Del Cauca y Bogotá, siendo un 61% del total. (para el ejercicio se considerara deptos)
#Conteo por tipo de transmision
sqldf("select transmision, count() as conteo
from data_olx
group by transmision
order by conteo desc")## transmision conteo
## 1 Automatica 174
## 2 Mecanica 144RELACIÓN ENTRE VARIABLES
#relacion entre precio y kilometraje
g1=ggplot(data=data_olx,mapping=
aes(x=kilometraje,y=precio))+geom_point()+theme_bw()+
geom_smooth()
ggplotly(g1)## `geom_smooth()` using method = 'loess' and formula 'y ~ x'#Se observa una relacion a mayor kilometraje menor precio.
#relacion entre precio y ano
g2=ggplot(data=data_olx,mapping=
aes(x=kilometraje,y=modelo_ano))+geom_point()+theme_bw()+
geom_smooth()
ggplotly(g2)## `geom_smooth()` using method = 'loess' and formula 'y ~ x'#Precio promedio por color
sqldf("select color, count() as conteo, avg(precio) as avg_precio
from data_olx
group by color
order by conteo desc")## color conteo avg_precio
## 1 Gris 106 52461793
## 2 Blanco 77 52722468
## 3 Rojo 44 54205227
## 4 Plateado 26 49442308
## 5 Negro 19 34178421
## 6 Azul 19 53578947
## 7 Vinotinto 7 37771429
## 8 Otro 7 40071429
## 9 Beige 5 39240000
## 10 Verde 3 29100000
## 11 Marrón 2 62450000
## 12 Morado 1 33900000
## 13 Dorado 1 34500000
## 14 Crema 1 33500000#entre los principales colores de vehiculos publicados, no se observan diferencias significativas
#Precio promedio por depto de publicacion
sqldf("select depto, count() as conteo, avg(precio) as avg_precio
from data_olx
group by depto
order by conteo desc")## Depto conteo avg_precio
## 1 Antioquia 84 50654762
## 2 ValledelCauca 55 58039818
## 3 Bogotá 52 48171923
## 4 Caldas 23 46982609
## 5 Santander 21 51700000
## 6 Atlántico 13 42490001
## 7 Quindío 11 39700000
## 8 Risaralda 10 56230000
## 9 Huila 10 48070000
## 10 Tolima 8 45350000
## 11 Cundinamarca 8 54037500
## 12 Meta 7 38857143
## 13 NortedeSantander 6 59216667
## 14 Nariño 3 53433333
## 15 Cesar 2 57000000
## 16 Sucre 1 34000000
## 17 Magdalena 1 31000000
## 18 Córdoba 1 40000000
## 19 Cauca 1 31500000
## 20 Casanare 1 30000000#Inicialmente se observa un mayor precio en Valle del Cauca y en Bogota los precios son inferiores frente a otras regiones. Quindio es donde se evidencia menores precios.
#Precio promedio por tipo de transmision
sqldf("select transmision, count() as conteo, avg(precio) as avg_precio
from data_olx
group by transmision
order by conteo desc")## transmision conteo avg_precio
## 1 Automatica 174 56043563
## 2 Mecanica 144 43486944#Se observa una diferencia significativa entre los tipos de migracion
PREPACION DE VARIABLES
library(fastDummies)
data_olx = dummy_cols(data_olx, select_columns = c("color","Depto","transmision"))head(data_olx)## # A tibble: 6 x 44
## `web-scraper-ord~ precio kilometraje transmision modelo_ano color ciudad Depto
## <chr> <dbl> <dbl> <chr> <dbl> <chr> <chr> <chr>
## 1 1662992063-359 5.8 e7 33000 Mecanica 2019 Blan~ Bogota Bogo~
## 2 1662992030-348 5.69e7 100000 Automatica 2016 Azul Medel~ Anti~
## 3 1662991456-146 3.8 e7 92000 Mecanica 2013 Azul Bogota Bogo~
## 4 1662991768-254 6.49e7 35000 Mecanica 2019 Azul Bogota Bogo~
## 5 1662992126-381 5.49e7 61000 Automatica 2016 Azul Bogota Bogo~
## 6 1662992066-360 4.19e7 94000 Mecanica 2014 Azul Bogota Bogo~
## # ... with 36 more variables: color_Azul <int>, color_Beige <int>,
## # color_Blanco <int>, color_Crema <int>, color_Dorado <int>,
## # color_Gris <int>, color_Marrón <int>, color_Morado <int>,
## # color_Negro <int>, color_Otro <int>, color_Plateado <int>,
## # color_Rojo <int>, color_Verde <int>, color_Vinotinto <int>,
## # Depto_Antioquia <int>, Depto_Atlántico <int>, Depto_Bogotá <int>,
## # Depto_Caldas <int>, Depto_Casanare <int>, Depto_Cauca <int>, ...#seleccionar variables de interes para el modelado
data_mazda=sqldf("select precio, kilometraje, modelo_ano,
color_Blanco, color_Gris, color_Rojo,
Depto_Antioquia,Depto_ValledelCauca,Depto_Bogotá,
transmision_Mecanica
from data_olx
")MODELO
mod1 <- lm(precio ~ kilometraje+modelo_ano+color_Blanco+color_Gris+color_Rojo+
Depto_Antioquia+Depto_ValledelCauca+Depto_Bogotá+
transmision_Mecanica,
data = data_mazda )
summary(mod1)##
## Call:
## lm(formula = precio ~ kilometraje + modelo_ano + color_Blanco +
## color_Gris + color_Rojo + Depto_Antioquia + Depto_ValledelCauca +
## Depto_Bogotá + transmision_Mecanica, data = data_mazda)
##
## Residuals:
## Min 1Q Median 3Q Max
## -70047487 -4044427 -960476 3270482 98232535
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7.025e+09 4.604e+08 -15.258 < 2e-16 ***
## kilometraje -3.574e+01 2.057e+01 -1.738 0.08328 .
## modelo_ano 3.514e+06 2.280e+05 15.411 < 2e-16 ***
## color_Blanco -1.105e+06 1.790e+06 -0.617 0.53751
## color_Gris 8.159e+05 1.650e+06 0.494 0.62138
## color_Rojo -6.065e+05 2.102e+06 -0.289 0.77309
## Depto_Antioquia 9.019e+05 1.627e+06 0.554 0.57980
## Depto_ValledelCauca 2.463e+06 1.830e+06 1.346 0.17933
## Depto_Bogotá -1.565e+06 1.847e+06 -0.847 0.39752
## transmision_Mecanica -5.119e+06 1.314e+06 -3.896 0.00012 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11100000 on 308 degrees of freedom
## Multiple R-squared: 0.7141, Adjusted R-squared: 0.7058
## F-statistic: 85.48 on 9 and 308 DF, p-value: < 2.2e-16library(MASS)
# Stepwise para mejorar la seleccion de variables
step.model <- stepAIC(mod1, direction = "both",
trace = FALSE)
summary(step.model)##
## Call:
## lm(formula = precio ~ kilometraje + modelo_ano + Depto_ValledelCauca +
## transmision_Mecanica, data = data_mazda)
##
## Residuals:
## Min 1Q Median 3Q Max
## -69479513 -4062271 -1087399 3138488 99143339
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.959e+09 4.419e+08 -15.748 < 2e-16 ***
## kilometraje -3.627e+01 2.020e+01 -1.795 0.0735 .
## modelo_ano 3.481e+06 2.188e+05 15.915 < 2e-16 ***
## Depto_ValledelCauca 2.392e+06 1.662e+06 1.439 0.1512
## transmision_Mecanica -5.504e+06 1.278e+06 -4.308 2.21e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11070000 on 313 degrees of freedom
## Multiple R-squared: 0.7113, Adjusted R-squared: 0.7076
## F-statistic: 192.8 on 4 and 313 DF, p-value: < 2.2e-16#Se obtiene un modelo robusto, de buena capacidad de explicacion de varianza con un 71.1% y con variables explicativas significantes.
par(mfrow=c(2,2))
plot(step.model)
shapiro.test(step.model$residuals)##
## Shapiro-Wilk normality test
##
## data: step.model$residuals
## W = 0.60071, p-value < 2.2e-16#Cumple con normalidad
bptest(step.model)##
## studentized Breusch-Pagan test
##
## data: step.model
## BP = 14.139, df = 4, p-value = 0.006865#Cumple con heterocedasticidad
dwtest( step.model,
alternative = "two.sided",
data = data_mazda)##
## Durbin-Watson test
##
## data: step.model
## DW = 2.0024, p-value = 0.9773
## alternative hypothesis: true autocorrelation is not 0#Cumple con indepencia en los residuos
VALIDACION DEL MODELO
###Paso 1 - Segmentar los datos
require(caTools)## Loading required package: caToolsset.seed(740)
sample = sample.split(data_mazda$precio, SplitRatio = .70)
train = subset(data_mazda, sample == TRUE)
test = subset(data_mazda, sample == FALSE)
##Paso 2 - Estimar el modelo en el set de entrenamiento con el modelo obtenido en el step
mod_train=lm(precio ~ kilometraje + modelo_ano + Depto_ValledelCauca +
transmision_Mecanica,
data = train)
summary(mod_train)##
## Call:
## lm(formula = precio ~ kilometraje + modelo_ano + Depto_ValledelCauca +
## transmision_Mecanica, data = train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -70050620 -4277893 -1344451 3005217 98751532
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.919e+09 5.801e+08 -11.927 < 2e-16 ***
## kilometraje -4.093e+01 2.706e+01 -1.513 0.13168
## modelo_ano 3.462e+06 2.871e+05 12.057 < 2e-16 ***
## Depto_ValledelCauca 2.418e+06 2.054e+06 1.177 0.24020
## transmision_Mecanica -5.354e+06 1.675e+06 -3.197 0.00158 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 12460000 on 235 degrees of freedom
## Multiple R-squared: 0.6759, Adjusted R-squared: 0.6704
## F-statistic: 122.5 on 4 and 235 DF, p-value: < 2.2e-16##Paso 3 - Predecir set de test
precio_pred=predict(object=mod_train,newdata = test)
##Paso 4 - Comparar precio modelo vs precio real
precio_real=test$precio
error=as.numeric(precio_real)- as.numeric(precio_pred)
res=data.frame(precio_real,precio_pred,error)
##Paso 5 - Calcular indicador de evaluacion de prediccion
MAE=mean(abs(error))
MAE## [1] 4063902RMSE=sqrt(mean(error^2))
RMSE## [1] 4981343head(res)## precio_real precio_pred error
## 1 58000000 63400590 -5400590
## 2 56900000 55626437 1273563
## 21 43900000 48489328 -4589328
## 22 32900000 30575570 2324430
## 31 60000000 63629901 -3629901
## 33 38500000 37431419 1068581POTENCIALES USOS Entre los usos potenciales, se puede evaluar si el precio de la publicacion esta sobre estimado o subestimado para mejorar el pricing.
Otra linea de aplicacion es el uso para usaurios inexpertos o nuevos que pueden obtener una linea base para su oferta y de esta manera mejorar la venta.
Se puede monetizar por uso o consulta y un fee adicional por cercania entre el precio final de la publicacion, precio sugerido y efectividad (tiempo) de la venta del vehiculo.