require(ggplot2)
## Loading required package: ggplot2
require(plotly)
## Loading required package: plotly
## 
## 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':
## 
##     layout
require(datarium)
## Loading required package: datarium
library(readxl)
base2_carros_cali <- read_excel("~/Downloads/base2_carros_cali.xlsx")
View(base2_carros_cali)
datos_vehiculos=base2_carros_cali
datos_vehiculos
## # A tibble: 129 × 6
##      precio     km modelo veh        transmision combustible
##       <dbl>  <dbl>  <dbl> <chr>      <chr>       <chr>      
##  1 38000000 111000   2011 kia cerato Mecánica    Gasolina   
##  2 46500000  65000   2014 kia cerato Mecánica    Gasolina   
##  3 43000000  86500   2013 kia cerato Mecánica    Gasolina   
##  4 35000000 134000   2011 kia cerato Mecánica    Gasolina   
##  5 48500000 112000   2015 kia cerato Mecánica    Gasolina   
##  6 43000000 105000   2012 kia cerato Automática  Gasolina   
##  7 52000000  88000   2015 kia cerato Mecánica    Gasolina   
##  8 56000000  78000   2016 kia cerato Automática  Gasolina   
##  9 74000000  50000   2019 kia cerato Automática  Gasolina   
## 10 40000000 140000   2013 kia cerato Mecánica    Gasolina   
## # ℹ 119 more rows

#regresion lineal simple

##planteamiento de las variables

se desea evaluar la relacion en las siguientes variables tomando como variable respuesta el precio del vehiculo:

kilometraje: ya que entre mayor uso se le de al vehiculo se esperaria una relacion inversa con el precio.

km=datos_vehiculos$km
summary(km)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0   68000   91000   92492  115000  228000

podemos observar que hay un rango amplio entre los valores de los datos, asi mismo una desviacion estandar de un valor alto siendo 42.745, equivalente al 18,74%. esto nos permite concluir que hay una gran variabilidad en el conjunto de datos.

sd(datos_vehiculos$km)
## [1] 42745.35

el modelo: el año del carro es una variable influyente de manera positiva al precio, pues el lanzamiento de nuevas tecnologias hara que se vuelva mas obsoleto.

mdl=datos_vehiculos$modelo
summary(mdl)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    2010    2014    2015    2015    2017    2022

analizando los rangos de los valores y su desviacion estandar vemos que es un conjunto de valores pequeño el cual tiene una desviacion estandar de aproximadamente 2 años, en puntos porcentuales un 20,47%. lo cual respresenta una gran variabilidad en el conjunto de datos.

sd(datos_vehiculos$modelo)
## [1] 2.456625

el tipo de vehiculo: factores como la marca y el vehiculo pueden influir de manera significtiva en el precio y la vejez de los vehiculos.

veh=datos_vehiculos$veh
require(DescTools)
## Loading required package: DescTools
Mode(veh)
## [1] "chevrolet sail"
## attr(,"freq")
## [1] 73

teniendo en cuenta que la moda es el chevrolte sail, es posible asumir que el chevrolet sail sea mas barato, y que el kia cerato sea un carro más lujoso. lo cual es informacion valiosa para el modelo, pero si o si necesita de otras variables que la complementen.

##analisis exploratorio

y=datos_vehiculos$precio
km=datos_vehiculos$km
mdl=datos_vehiculos$modelo
veh=datos_vehiculos$veh

hacemos los graficos

plot(km,y)

la dispersion de los datos no muestra una tendencia visible, como si los datos no estuviesen relacionados.

cor(km,y)
## [1] -0.1984356

el coeficiente muestra tal como esperabamos una relacion inversa, pero esta es muy debil, practicamente nula.

plot(mdl,y)

por otro lado la dispersion del modelo muestra una tendencia al alza, segmentada en dos pendientes, las cuales intuyo que sean los chevrolet sail y kia cerato.

cor(mdl,y)
## [1] 0.3550418

el coeficiente de correlación es positivo como esperabamos, pero muestra una fuerza muy debíl, asi que por si solo no sera un buen predictor.

boxplot(y~veh,col="grey")

los cuartiles de ambas marcas de carro muestran que el valor del chevrolet sail varia muy poco, pues el 75% de sus datos esta en un rango muy pequeño; mientras el kia cerato tiene un rango para el 75% de sus datos un poco mas grande por lo que es probable que sea mas suceptible a otras variables.

require(DescTools)
Mode(veh)
## [1] "chevrolet sail"
## attr(,"freq")
## [1] 73

##estimacion de modelos simples

vamos a estimar un modelo simple con cada variable analizada anteriormente:

mds1=lm(y~km)
summary(mds1)
## 
## Call:
## lm(formula = y ~ km)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -40856877  -7854938  -4054037   5068628  39933128 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.577e+07  2.571e+06  17.802   <2e-16 ***
## km          -5.762e+01  2.525e+01  -2.282   0.0242 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 12210000 on 127 degrees of freedom
## Multiple R-squared:  0.03938,    Adjusted R-squared:  0.03181 
## F-statistic: 5.206 on 1 and 127 DF,  p-value: 0.02418

los betas de este modelo nos dicen que tiene un intercepto de 45.770.000, el cual es bastante malo porque el beta1 es de -57,62 pesos por km del carro, es decir que todos los datos por encima del intercepto no podran ser explicados. además de esto al promediar asi un intercepto de valores tan dispersos, este es muy desacertado. tiene un nivel de significancia del 3.9% lo cual significa que el kilometraje no es capaz de explicar las variaciones de el precio. aun asi las variables elegidas son significativas por lo que el efecto de esta variable no fue al azar.

mds2=lm(y~mdl)
summary(mds2)
## 
## Call:
## lm(formula = y ~ mdl)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -39042401  -8630002  -5042401   8251399  33988597 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -3.574e+09  8.446e+08  -4.232 4.40e-05 ***
## mdl          1.794e+06  4.191e+05   4.280 3.65e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11650000 on 127 degrees of freedom
## Multiple R-squared:  0.1261, Adjusted R-squared:  0.1192 
## F-statistic: 18.32 on 1 and 127 DF,  p-value: 3.65e-05

tiene un beta0 de -3.574.000.000 el cual se logra compensar con un beta1 de 1.794.000 mostrando que por cada año más que tenga un carro, aumentará este valor; este modelo podria servir ya que el minimo de años de un modelo es el 2010, por lo que este podria ir compensando el intercepto. aunque lo anterior sea una buena idea el “modelo” del vehiculo solo es capaz de explicar el 12.61% de las variaciones en y. las variables son significativas por lo aue podemos concluir que el efecto de estas variables no fue al azar.

mds3=lm(y~veh)
summary(mds3)
## 
## Call:
## lm(formula = y ~ veh)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -32423151  -5423151   -100000   3576849  33400000 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   33423151    1110140  30.107   <2e-16 ***
## vehkia cerato 16176849    1684917   9.601   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9485000 on 127 degrees of freedom
## Multiple R-squared:  0.4206, Adjusted R-squared:  0.416 
## F-statistic: 92.18 on 1 and 127 DF,  p-value: < 2.2e-16

el beta0 del modelo es un valor estandar de lo que deberia costar un chevrolet sail (33.423.151), y abajo en el beta1, esta lo que se le suma a este valor si el vehiculo fuese un kia cerato que son 16.176.849. aunque es una varable categorica, logra explicar el 42.06% de las variaciones, que es poco, pero seria la mejor variable testeada hasta ahorita; deduzco que es porque la mayoria de datos de chevrolet sail estan en un intervalo pequeño de precio. ambas variables son significativas por lo que los efectos causados en el modelo son probablemente reales.

##modelo elegido

el modelo que escogi para predecir es el modelo simple 3, pues tiene un intercepto que refleja en promedio la mayoria de valores de chevrolet sail, y la variacion que puede tener al ser un kia cerato dejando las demas condiciones iguales. Tambien es el modelo que logra explicar mayor proporcion de cambios en la variable precio.

##validacion cruzada

entrenamos este modelo con el 70% de los datos que tenemos y usaremos el 30% restante para validar su poder de predicción.

datos_modelar=sample(1:129,size = 90 )
carros_modelar=datos_vehiculos[datos_modelar,]
carros_modelar
## # A tibble: 90 × 6
##      precio     km modelo veh            transmision combustible
##       <dbl>  <dbl>  <dbl> <chr>          <chr>       <chr>      
##  1 50000000 215000   2017 chevrolet sail Mecánica    Gasolina   
##  2 56000000  78000   2016 kia cerato     Automática  Gasolina   
##  3 39000000  36000   2016 chevrolet sail Mecánica    Gasolina   
##  4 34000000    125   2018 chevrolet sail Mecánica    Gasolina   
##  5 49800000  84500   2015 kia cerato     Automática  Gasolina   
##  6 33500000  68000   2017 chevrolet sail Mecánica    Gasolina   
##  7 36200000  34000   2018 chevrolet sail Mecánica    Gasolina   
##  8 27000000 128000   2013 chevrolet sail Mecánica    Gasolina   
##  9  1000000  68000   2015 chevrolet sail Mecánica    Gasolina   
## 10 34500000  78000   2017 chevrolet sail Mecánica    Gasolina   
## # ℹ 80 more rows
carros_validar=datos_vehiculos[-datos_modelar,]
md_pred=lm(precio~veh,data = carros_modelar)

precio_pred=predict(md_pred,list(veh=carros_validar$veh))

precio_real=carros_validar$precio
error=precio_real-precio_pred
res=data.frame(precio_real,precio_pred,error)
res
##    precio_real precio_pred        error
## 1     46500000    48535135  -2035135.11
## 2     35000000    48535135 -13535135.11
## 3     48500000    48535135    -35135.11
## 4     52000000    48535135   3464864.89
## 5     74000000    48535135  25464864.89
## 6     42800000    48535135  -5735135.11
## 7     52000000    48535135   3464864.89
## 8     34000000    48535135 -14535135.11
## 9     52000000    48535135   3464864.89
## 10    35500000    48535135 -13035135.11
## 11    42000000    48535135  -6535135.11
## 12    39000000    48535135  -9535135.11
## 13    60000000    48535135  11464864.89
## 14    63000000    48535135  14464864.89
## 15    54500000    48535135   5964864.89
## 16    65000000    48535135  16464864.89
## 17    56000000    48535135   7464864.89
## 18    58000000    48535135   9464864.89
## 19    72000000    48535135  23464864.89
## 20    31000000    33046981  -2046981.13
## 21    38000000    33046981   4953018.87
## 22    31000000    33046981  -2046981.13
## 23    36000000    33046981   2953018.87
## 24    37000000    33046981   3953018.87
## 25    32500000    33046981   -546981.13
## 26    29500000    33046981  -3546981.13
## 27    35000000    33046981   1953018.87
## 28    37000000    33046981   3953018.87
## 29    29800000    33046981  -3246981.13
## 30    30000000    33046981  -3046981.13
## 31    41500000    33046981   8453018.87
## 32    37800000    33046981   4753018.87
## 33    34500000    33046981   1453018.87
## 34    36900000    33046981   3853018.87
## 35    38500000    33046981   5453018.87
## 36    31000000    33046981  -2046981.13
## 37    31900000    33046981  -1146981.13
## 38    34500000    33046981   1453018.87
## 39    35000000    33046981   1953018.87

como el modelo es de variables categoricas solo puede dar dos valores lo cual limita mucho su alcance.

MAE=mean(abs(error))
MAE
## [1] 6471966

obtenemos un valor de MAE el cual si es alto, pues más de 8 millones es bastante dinero para una persona en Colombia, por lo que el error promedio a la hora de estimar de este modelo es hace que no sea muy fiable el valor de nuestra predicción.

#regresion lineal multiple

##estimación modelos multivariables

anteriormente pude concluir que los modelos univariables todos tenian variables significativas, pero estas por separado no lograban explicar bien los cambios en el precio, por lo que ahora juntas veremos si son mas completas.

analisis previo

options(repos = "https://cloud.r-project.org")
install.packages("psych")
## 
## The downloaded binary packages are in
##  /var/folders/my/ptff2dh15q3418hppk9h93tw0000gn/T//Rtmpxv72s1/downloaded_packages
require(psych)
## Loading required package: psych
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:DescTools':
## 
##     AUC, ICC, SD
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
library(psych)
pairs.panels(datos_vehiculos)
## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero

## Warning in cor(x, y, use = "pairwise", method = method): the standard deviation
## is zero
## Warning in min(diff(breaks)): no non-missing arguments to min; returning Inf

las variables no presentan multicolinealidad.

mdm1=lm(y~km+veh)
summary(mdm1)
## 
## Call:
## lm(formula = y ~ km + veh)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -34044252  -5577301   -240583   2975680  37036303 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    4.048e+07  1.935e+06  20.918  < 2e-16 ***
## km            -8.000e+01  1.849e+01  -4.326 3.06e-05 ***
## vehkia cerato  1.696e+07  1.589e+06  10.673  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 8886000 on 126 degrees of freedom
## Multiple R-squared:  0.4955, Adjusted R-squared:  0.4875 
## F-statistic: 61.88 on 2 and 126 DF,  p-value: < 2.2e-16

tenemos un beta0 de 40.480.000 para el chevrolet sail, el cual por cada kilometro recorrido se le restaran 80,00, además de esto, si el vehiculo es un kia cerato se le sumaran (16.960.000). su R2 ajustado es del 48.75% el cual sigue siendo bajo, no permitiendo explicar las variaciones en el precio como nos gustaria. aun asi todas las variables son significativas lo cual es un buen indicativo para buscar otro modelo.

mdm2=lm(y~km+mdl+veh)
summary(mdm2)
## 
## Call:
## lm(formula = y ~ km + mdl + veh)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -28213580  -2731610   -474787   2437139  19500723 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -7.395e+09  4.823e+08 -15.335   <2e-16 ***
## km             2.595e+01  1.288e+01   2.014   0.0462 *  
## mdl            3.684e+06  2.389e+05  15.419   <2e-16 ***
## vehkia cerato  2.250e+07  1.003e+06  22.434   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5237000 on 125 degrees of freedom
## Multiple R-squared:  0.8261, Adjusted R-squared:  0.822 
## F-statistic:   198 on 3 and 125 DF,  p-value: < 2.2e-16

este modelo comienza con un beta0 de -7.395.000.000 para el chevrolet sail, y nos dice que por cada km andado el valor aumentara 25,95 pesos, por cada año del modelo aumentará 3.684.000, y si es un kia cerato aumentara 22.500.000. la razón de por que el kilometraje ha pasado a ser positivo en presencia del modelo y la marca, interpreto que se debe a que en el mercado, un carro que sea de un año viejo y no tenga tanto kilometraje puede causar un efecto positivo en el precio indicando que esta bien cuidado, otra razón podría ser que un vehiculo de cierto año con un alto kilometraje, el cual este en buen estado podria gregar valor al vehiculo indicando que es una marca duradera y de calidad. tiene un R2 ajustado del 82.2% logrando explicar la mayoria de variaciones en el precio, y, todos sus componentes son significativos, por lo que los valores del modelo podrian ser reales.

mdm3=lm(y~mdl+veh)
summary(mdm3)
## 
## Call:
## lm(formula = y ~ mdl + veh)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -28995966  -3204706   -495966   2131220  23149664 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -6.876e+09  4.124e+08  -16.68   <2e-16 ***
## mdl            3.427e+06  2.045e+05   16.76   <2e-16 ***
## vehkia cerato  2.230e+07  1.010e+06   22.08   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5300000 on 126 degrees of freedom
## Multiple R-squared:  0.8205, Adjusted R-squared:  0.8177 
## F-statistic:   288 on 2 and 126 DF,  p-value: < 2.2e-16

por ultimo, este modelo con solo el modelo y la marca del carro, tiene un intercepto negativo de -6.876.000.000 para el chevrolet sail, el cual aumenta 3.427.000 por cada año del modelo del carro, y, si es un kia cerato aumenta 22.300.000. tiene un R2 ajustado de 81.77% y todas sus vaiables son significativas. es bastante parecido al anterior y tambien considerado un buen modelo.

##modelo elegido

step(mdm1)
## Start:  AIC=4130.95
## y ~ km + veh
## 
##        Df  Sum of Sq        RSS    AIC
## <none>               9.9480e+15 4130.9
## - km    1 1.4777e+15 1.1426e+16 4146.8
## - veh   1 8.9942e+15 1.8942e+16 4212.0
## 
## Call:
## lm(formula = y ~ km + veh)
## 
## Coefficients:
##   (Intercept)             km  vehkia cerato  
##      40484502            -80       16956320
step(mdm2)
## Start:  AIC=3995.52
## y ~ km + mdl + veh
## 
##        Df  Sum of Sq        RSS    AIC
## <none>               3.4281e+15 3995.5
## - km    1 1.1123e+14 3.5393e+15 3997.6
## - mdl   1 6.5199e+15 9.9480e+15 4130.9
## - veh   1 1.3803e+16 1.7231e+16 4201.8
## 
## Call:
## lm(formula = y ~ km + mdl + veh)
## 
## Coefficients:
##   (Intercept)             km            mdl  vehkia cerato  
##    -7.395e+09      2.595e+01      3.684e+06      2.250e+07
step(mdm3)
## Start:  AIC=3997.63
## y ~ mdl + veh
## 
##        Df  Sum of Sq        RSS    AIC
## <none>               3.5393e+15 3997.6
## - mdl   1 7.8863e+15 1.1426e+16 4146.8
## - veh   1 1.3694e+16 1.7233e+16 4199.8
## 
## Call:
## lm(formula = y ~ mdl + veh)
## 
## Coefficients:
##   (Intercept)            mdl  vehkia cerato  
##    -6.876e+09      3.427e+06      2.230e+07

despues del paso a paso y evaluar en los tres modelos propuesto criterios como el AIC, betas, R2 ajustado y significancia; concluimos que el modelo más apto para predicciones es el modelo multiple 2. por medio de un menor AIC vemos que este esta mejor ajustado a los datos que tenemos. tambien es el modelo que más porcentaje de variaciones en el precio logra explicar y en terminos de betas es el que desarrolla interacciones más coherentes entre las variables.

#validamos su poder predictivo

entrenamos este modelo con el 70% de los datos que tenemos y usaremos el 20% restante para validar su poder de predicción.

mdm_pred=lm(precio~km+modelo+veh, data = carros_modelar)
presio_pred=predict(mdm_pred,list(km=carros_validar$km, modelo=carros_validar$modelo, veh=carros_validar$veh))
presio_real=carros_validar$precio
errror=presio_real-presio_pred
res2=data.frame(presio_real,presio_pred,errror)
res2
##    presio_real presio_pred     errror
## 1     46500000    46767008  -267008.5
## 2     35000000    37998891 -2998890.9
## 3     48500000    52643696 -4143696.2
## 4     52000000    51630902   369097.6
## 5     74000000    65600512  8399488.1
## 6     42800000    46021809 -3221809.3
## 7     52000000    51867221   132779.0
## 8     34000000    38041091 -4041090.7
## 9     52000000    46767008  5232991.5
## 10    35500000    32670800  2829200.2
## 11    42000000    39908803  2091197.0
## 12    39000000    38041091   958909.3
## 13    60000000    58742306  1257693.6
## 14    63000000    62230615   769384.6
## 15    54500000    50322710  4177289.6
## 16    65000000    48242944 16757055.6
## 17    56000000    52770295  3229704.6
## 18    58000000    63310802 -5310802.1
## 19    72000000    64292320  7707680.1
## 20    31000000    24937552  6062448.4
## 21    38000000    40552951 -2552950.9
## 22    31000000    26731041  4268959.4
## 23    36000000    36423332  -423332.5
## 24    37000000    43759541 -6759540.5
## 25    32500000    33378247  -878247.4
## 26    29500000    30497741  -997741.3
## 27    35000000    36469752 -1469752.2
## 28    37000000    40574051 -3574050.8
## 29    29800000    34201142 -4401142.4
## 30    30000000    30666540  -666540.3
## 31    41500000    40278653  1221347.4
## 32    37800000    35710157  2089843.1
## 33    34500000    36638551 -2138551.2
## 34    36900000    40574051 -3674050.8
## 35    38500000    37283279  1216721.2
## 36    31000000    40098930 -9098930.0
## 37    31900000    21613948 10286051.8
## 38    34500000    37620069 -3120068.9
## 39    35000000    30244543  4755457.2
MAE2=mean(abs(errror))
MAE2
## [1] 3680808

este MAE es más acertado al primera, ya que una magnitud promedio de error de casi 4 millones es un rango dentro del cual normalmente se negocia entre compradores y vendedores.

##pronosticos hipoteticos

para las predicciones tome 3 escenarios que tuvieran en cuenta diferentes condiciones para las variables. en el primer escenario trate de tomar un kilometrahe moderadamente alto y un año promedio, para un kia cerato. en el segundo caso un kilometraje muy alto, con un año mas viejo, para un chevrolet sail. por ultimo el tercer caso examina un kia cerato que es muy nuevo y tiene un kilometraje mas un poco alto.

escenario 1

predict(mdm_pred,list(km=102600,modelo=2014,veh="kia cerato"))
##        1 
## 48353719

escenario 2

predict(mdm_pred,list(km=170000,modelo=2013,veh="chevrolet sail"))
##        1 
## 25327525

escenario 3

predict(mdm_pred,list(km=91000,modelo=2020,veh="kia cerato"))
##        1 
## 71224001

en base a los resultados puedo concluir que este conjunto de datos depende mucho de el modelo/año del vehiculo para hacer la predicción. y como que la otra variable predictora numerica casi no tiene relacion con el precio se dan estos errores.

##validacion de supuestos

par(mfrow=c(2,2))
plot(mdm_pred)

en el primer grafico vemos que el supuesto de la varianza constante se cumple, pero no es tan limpio como nos gustaria que fuese, pues depronto hace una ligera forma de embudo.

el supuesto de la normalidad se cumple muy bien con excepcion de los extremos.

en base a esto haremos una transformacion a logaritmo del precio para manejar un mejor ajuste.

##transformacion de modelo

vamos a trabajar con los datos de carros modelar, ya que el modelo que voy a transformar es el que esta entrenado para hacer las predicciones, asi que necesito evaluar el desempeño del nuevo modelo en base al verdadero punto de partida.

mdm_trans=lm(log(precio)~km+modelo+veh, data = carros_modelar)
summary(mdm_trans)
## 
## Call:
## lm(formula = log(precio) ~ km + modelo + veh, data = carros_modelar)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3234 -0.0119  0.0327  0.0893  0.3524 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -1.744e+02  4.094e+01  -4.261 5.19e-05 ***
## km             1.513e-06  1.026e-06   1.474    0.144    
## modelo         9.502e-02  2.028e-02   4.685 1.04e-05 ***
## vehkia cerato  5.674e-01  8.646e-02   6.563 3.81e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3756 on 86 degrees of freedom
## Multiple R-squared:  0.3675, Adjusted R-squared:  0.3455 
## F-statistic: 16.66 on 3 and 86 DF,  p-value: 1.283e-08

con esta nueva transformación el modelo loga explicar el 85.9% de las variaciones del precio, es decir, una mejora del 2.04% en el R2, pero vemos que la variable kilometraje deja de ser significativa.

summary(mdm_pred)
## 
## Call:
## lm(formula = precio ~ km + modelo + veh, data = carros_modelar)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -27809752  -2500447   -136174   2615395  17031488 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -7.819e+09  5.926e+08  -13.19  < 2e-16 ***
## km             4.220e+01  1.486e+01    2.84  0.00562 ** 
## modelo         3.893e+06  2.936e+05   13.26  < 2e-16 ***
## vehkia cerato  2.198e+07  1.252e+06   17.56  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5437000 on 86 degrees of freedom
## Multiple R-squared:  0.8145, Adjusted R-squared:  0.808 
## F-statistic: 125.8 on 3 and 86 DF,  p-value: < 2.2e-16
coefficients(mdm_trans)
##   (Intercept)            km        modelo vehkia cerato 
## -1.744358e+02  1.513199e-06  9.502325e-02  5.674367e-01

los coeficientes del modelo en logaritmos nos dicen que el el precio cuando todo lo demás es cero es igual a −139.2317. al igual que el modelo anterior su variable mas sencible es el vehiculo, sea chevrolet sail o kia cerato, segundo el año del modelo y tercero el kilometraje. en este modelo tambien todas las variables predictoras son de caracter positivo.

step(mdm_trans)
## Start:  AIC=-172.36
## log(precio) ~ km + modelo + veh
## 
##          Df Sum of Sq    RSS     AIC
## <none>                12.131 -172.36
## - km      1    0.3066 12.438 -172.12
## - modelo  1    3.0959 15.227 -153.91
## - veh     1    6.0754 18.207 -137.82
## 
## Call:
## lm(formula = log(precio) ~ km + modelo + veh, data = carros_modelar)
## 
## Coefficients:
##   (Intercept)             km         modelo  vehkia cerato  
##    -1.744e+02      1.513e-06      9.502e-02      5.674e-01
step(mdm_pred)
## Start:  AIC=2795.48
## precio ~ km + modelo + veh
## 
##          Df  Sum of Sq        RSS    AIC
## <none>                 2.5422e+15 2795.5
## - km      1 2.3848e+14 2.7807e+15 2801.6
## - modelo  1 5.1972e+15 7.7394e+15 2893.7
## - veh     1 9.1134e+15 1.1656e+16 2930.5
## 
## Call:
## lm(formula = precio ~ km + modelo + veh, data = carros_modelar)
## 
## Coefficients:
##   (Intercept)             km         modelo  vehkia cerato  
##    -7.819e+09      4.220e+01      3.893e+06      2.198e+07

aunque la variable kilometraje deja de ser significativa se nos aconseja mantenerla en el modelo, puesto a que con ella hay un mejor AIC

par(mfrow=c(2,2))
plot(mdm_trans)

ahora si podemos ver a los residuales con un comportamiento mas lineal como es de esperarse, asi como una distribucion normal mas ajustada. por lo que se podria decir que eliminamos factores exogenos y ahora es más preciso.

prezio_pred=exp(predict(mdm_trans,list(km=carros_validar$km, modelo=carros_validar$modelo, veh=carros_validar$veh)))
prezio_real=carros_validar$precio
errrror=prezio_real-prezio_pred
res3=data.frame(prezio_real,prezio_pred,errrror)
res3
##    prezio_real prezio_pred     errrror
## 1     46500000    44314713  2185287.50
## 2     35000000    36990373 -1990372.89
## 3     48500000    52324270 -3824269.88
## 4     52000000    50458113  1541886.88
## 5     74000000    69667575  4332425.12
## 6     42800000    45113345 -2313344.84
## 7     52000000    50887507  1112492.51
## 8     34000000    37046389 -3046389.05
## 9     52000000    44314713  7685287.50
## 10    35500000    31950431  3549568.51
## 11    42000000    37885203  4114797.41
## 12    39000000    37046389  1953610.95
## 13    60000000    59559682   440317.92
## 14    63000000    64552571 -1552571.41
## 15    54500000    48145823  6354176.60
## 16    65000000    46723201 18276798.91
## 17    56000000    52562341  3437659.12
## 18    58000000    67101963 -9101962.87
## 19    72000000    66474994  5525006.20
## 20    31000000    25258842  5741158.40
## 21    38000000    36994988  1005011.71
## 22    31000000    26936633  4063366.61
## 23    36000000    33357589  2642411.40
## 24    37000000    41502944 -4502943.76
## 25    32500000    31270568  1229432.09
## 26    29500000    29487630    12370.11
## 27    35000000    33413159  1586840.84
## 28    37000000    37022989   -22989.26
## 29    29800000    32207028 -2407028.50
## 30    30000000    29666654   333346.30
## 31    41500000    36632897  4867103.03
## 32    37800000    32515348  5284651.65
## 33    34500000    33616015   883984.56
## 34    36900000    37022989  -122989.26
## 35    38500000    34402225  4097774.70
## 36    31000000    38056994 -7056994.32
## 37    31900000    23443217  8456783.26
## 38    34500000    33301923  1198076.74
## 39    35000000    29221118  5778882.26
MAEX=mean(abs(errrror))
MAEX
## [1] 3682881

por otro lado el MAE resulta ser mas pequeño, lo cual es otro buen indicador de esta transformacion, pues quiere decir que el error promedio es de menor tamaño.

para cocnluir este modelo transformado cumple de mejor manera los supuestos, logra explicar mayor cantidad de variaciones en el precio, tiene un mejor ajuste a los datos y su valor promedio del error tambien es menor. la unica falla es que no todas sus variables son significativas, pero todo lo anterior prima sobre esto

##pronosticos

para evaluar la calidad del modelo usamos los mismos tres escenarios anteriores y asi podremos comparar.

escenario 1

exp(predict(mdm_trans,list(km=102600,modelo=2014,veh="kia cerato")))
##        1 
## 46909162

escenario 2

exp(predict(mdm_trans,list(km=170000,modelo=2013,veh="chevrolet sail")))
##        1 
## 26782339

escenario 3

exp(predict(mdm_trans,list(km=91000,modelo=2020,veh="kia cerato")))
##        1 
## 81516006

si comparamos los resultados de las predicciones del modelo multiple elegido y su transformacion obtenemos:

escenario 1

vr mdm_pred: 49.181.372

vr mdm_trans: 47.749.589

vr real: 48.000.000

escenario 2

vr mdm_pred: 24.806.484

vr mdm_trans: 27.546.235

vr real: 28.000.000

escenario 3

vr mdm_pred: 71.435.728

vr mdm_trans: 75.678.088

vr real: 68.000.000

en los primeros dos escenarios el poder predictivo del modelo transformado es superior notablemente al modelo multiple inicial, pero en el tercer escenario el precio se desfasa por aproximadamente 7millones. este error puede ser culpa del conjunto de datos, pues el modelo aun despues de sus transformaciones es muy dependiente del año, por lo que necesitaria una variable que ayude a explicar mejor las variaciones.