Taller final
Manuel Martinez
2024-05-30
library(readxl)
base1_mazdacol <- read_excel("~/Downloads/base1_mazdacol.xlsx")
View(base1_mazdacol)#Modelo simple No.1 ##Y=precio ##X1=kilkometraje
y=base1_mazdacol$precio
x=base1_mazdacol$kilometraje
plot(x,y)
cor(x,y)## [1] -0.6543672###Se evidencia una relación inversa, pues el coeficientede correlacion de pearson es de -0.65: es decir que a mayor kilometraje, menor precio
require(ggplot2)## Loading required package: ggplot2require(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':
##
## layoutrequire(datarium)## Loading required package: datariumg1=ggplot(data=base1_mazdacol,mapping = aes(x=kilometraje,y=precio))+geom_point()+theme_bw()+
geom_smooth()
ggplotly(g1)## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'g1=ggplot(data = base1_mazdacol,mapping = aes(x=kilometraje))+geom_histogram(fill="purple")+theme_bw()
ggplotly(g1)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.mod_simple=lm(y~x)
mod_simple##
## Call:
## lm(formula = y ~ x)
##
## Coefficients:
## (Intercept) x
## 72271766.3 -290.7###Y=72271766.3-290.7X, quiere decir que por cada kilometro adicional se espera que el precio baje 290 mil pesos
summary(mod_simple)##
## Call:
## lm(formula = y ~ x)
##
## Residuals:
## Min 1Q Median 3Q Max
## -60471042 -6914624 -489462 6727120 108002424
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.227e+07 1.675e+06 43.15 <2e-16 ***
## x -2.907e+02 1.902e+01 -15.29 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 15560000 on 312 degrees of freedom
## Multiple R-squared: 0.4282, Adjusted R-squared: 0.4264
## F-statistic: 233.6 on 1 and 312 DF, p-value: < 2.2e-16###Este modelo explica el 43% de la variabilidad del precio de los vehiculos
#Modelo simple No. 2 ##Y=precio ##X=modelo(año)
y=base1_mazdacol$precio
x2=base1_mazdacol$modelo
plot(x2,y)
###Se observa a simple vista que el ambas variables presentan una relacion directa, es decir que entre mas reciente sea el modelo del vehiculo (x2), mayor será el precio. Sin embargo, se corrobará esto.
cor(x2,y)## [1] 0.8295419###El coeficiente de correlación de pearson respalda lo dicho anteriormente. Pues, este arrojó un resultado de 0.82. Lo que significa una relación positiva y muy cercana a 1
require(ggplot2)
require(plotly)
require(datarium)g1=ggplot(data=base1_mazdacol,mapping = aes(x=modelo,y=precio))+geom_point()+theme_bw()+
geom_smooth()
ggplotly(g1)## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'g1=ggplot(data = base1_mazdacol,mapping = aes(x=modelo))+geom_histogram(fill="purple")+theme_bw()
ggplotly(g1)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.mod_simple=lm(y~x2)
mod_simple##
## Call:
## lm(formula = y ~ x2)
##
## Coefficients:
## (Intercept) x2
## -7.889e+09 3.940e+06###El modelo establece que por cada año que aumente el modelo del vehiculo, el precio de este aumentará 3 millones
summary(mod_simple)##
## Call:
## lm(formula = y ~ x2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -71764290 -4601367 -772342 3182090 103056684
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7.889e+09 3.026e+08 -26.07 <2e-16 ***
## x2 3.940e+06 1.502e+05 26.24 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11490000 on 312 degrees of freedom
## Multiple R-squared: 0.6881, Adjusted R-squared: 0.6871
## F-statistic: 688.4 on 1 and 312 DF, p-value: < 2.2e-16###Este modelo explica el 68% de la variabilidad de los datos del precio
#Modelo simplre No.3 ##Y=precio ##X3=transmision
y=base1_mazdacol$precio
x3=base1_mazdacol$transmision
knitr::opts_chunk$set(echo = TRUE)
library(ggplot2)
summary(base1_mazdacol)## web-scraper-order web-scraper-start-url link link-href
## Length:314 Length:314 Length:314 Length:314
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## precio kilometraje transmision modelo
## Min. : 6800000 Min. : 0 Length:314 Min. :1995
## 1st Qu.: 35000000 1st Qu.: 39125 Class :character 1st Qu.:2011
## Median : 42000000 Median : 79000 Mode :character Median :2015
## Mean : 50467516 Mean : 74996 Mean :2015
## 3rd Qu.: 63000000 3rd Qu.:107375 3rd Qu.:2018
## Max. :169800000 Max. :280000 Max. :2022
## color ciudad Dpto
## Length:314 Length:314 Length:314
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
## ggplot(base1_mazdacol, aes(x = transmision, y = precio)) +
geom_boxplot() +
labs(x = "transmision", y = "precio") +
theme_minimal()
###Este grafico de dispersion de los datos con variable categoricas. Se muestra que. la mayoria de los vehiculos con transmision automatica se venden por mas de 50 millones de pesos, mientras que los de transmision mecanica se venden por debajo de este rango de precio
modelo <- lm(y ~ x3, data = base1_mazdacol)
summary(modelo)##
## Call:
## lm(formula = y ~ x3, data = base1_mazdacol)
##
## Residuals:
## Min 1Q Median 3Q Max
## -36737286 -14043563 -3787286 13262714 113756437
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 56043563 1486374 37.705 < 2e-16 ***
## x3Mecánica -12506278 2226020 -5.618 4.28e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19610000 on 312 degrees of freedom
## Multiple R-squared: 0.09187, Adjusted R-squared: 0.08896
## F-statistic: 31.56 on 1 and 312 DF, p-value: 4.276e-08###Este modelo no es del todo adecuado para la justificacion de la variablidad del precio,pues explica unicamente el 9% de las variaciones
###ya establecidos los tres modelos, se selecciona al modelo que tiene como variable independiente el modelo, pues este explica un mayor porcentaje de la variabilidad de los precios con respecto a los demas modelos. Por lo cual este será el utilizado para la predicción
##Cual seria el valor estimado de ganancia para un lote de 20 carros nuevos modelo 2026?
#Escenario Promedio
y_mod=predict(mod_simple,list(x2=2026))
ganancia_carro=y_mod
ganancia_total_media=ganancia_carro*20
#Escenario Bajo y Alto
MAE=mean(abs(mod_simple$residuals))
y_mod_min=y_mod-MAE
y_mod_max=y_mod+MAE
ganancia_total_inf=y_mod_min*20
ganancia_total_sup=y_mod_max*20
c(ganancia_total_inf,ganancia_total_media,ganancia_total_sup)## 1 1 1
## 1771472453 1886511782 2001551112###Dado el modelo de predicción en el peor escenario se esperan vender los 20 carros por un total de 1.771.472.453 pesos; es decir cada carro a 88.573.622 pesos. En el escenario promedio se espera vender los vehiculos en 1.886.511.782 pesos a 94.325.589 pesos cada uno. Ya en el mejor escenario se plantea vender los carros en 2.001.551.112 pesos; a 100.077.555 pesos cada uno.
###Este modelo de predicción se acerca bastante a la realidad, pues actualmente el Mazda 2 nuevo modelo 2025 tiene un precio de 80 millones aproximadamente
#Modelo de regresion lineal multiple
y=base1_mazdacol$precio
x1=base1_mazdacol$kilometraje
X2=base1_mazdacol$modeloplot(base1_mazdacol[,5:6:8])## Warning in 5:6:8: numerical expression has 2 elements: only the first used
###Omitimos las posibles interpretaciones con la variable transmision por ser una variable cualitativa y momentaneamente se estan evaluando las variables cuantitativas. ###Se aprecia que la relacion que se presenta entre el modelo del vehiculo y el precio de este mismo es una relacion positiva, pues a mayor modelo (es decir más nuevo), mayor preciotendrá. Igualmente ya se demostrará esto
knitr::opts_chunk$set(echo = TRUE)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionbase1_mazdacol <- base1_mazdacol %>%
mutate(modelo_1 = ifelse(modelo == 1, 1, 0),
modelo_2 = ifelse(modelo == 2, 1, 0),
modelo_3 = ifelse(modelo == 3, 1, 0),
transmision_Automatica = ifelse(transmision == "Automatica", 1, 0),
transmision_Manual = ifelse(transmision == "Manual", 1, 0))
correlation_matrix <- cor(base1_mazdacol[, c("kilometraje", "modelo_1", "modelo_2", "modelo_3", "transmision_Automatica", "transmision_Manual")])## Warning in cor(base1_mazdacol[, c("kilometraje", "modelo_1", "modelo_2", : the
## standard deviation is zerosummary(modelo)##
## Call:
## lm(formula = y ~ x3, data = base1_mazdacol)
##
## Residuals:
## Min 1Q Median 3Q Max
## -36737286 -14043563 -3787286 13262714 113756437
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 56043563 1486374 37.705 < 2e-16 ***
## x3Mecánica -12506278 2226020 -5.618 4.28e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19610000 on 312 degrees of freedom
## Multiple R-squared: 0.09187, Adjusted R-squared: 0.08896
## F-statistic: 31.56 on 1 and 312 DF, p-value: 4.276e-08###El modelo Precio= Kilometraje + Modelo, da una explicación del 69% a la variabilidad de los precios. Este modelo toma la siguiente forma “y= -7.290 - 3.723x1 + 3.644x2”
y=base1_mazdacol$precio
x1=base1_mazdacol$kilometraje
x2=base1_mazdacol$modelo
x3=base1_mazdacol$transmision
mod_muliple1=lm(y~x1+x2+x3)
summary(mod_muliple1)##
## Call:
## lm(formula = y ~ x1 + x2 + x3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -67801596 -4005789 -967519 2918840 100935418
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7.048e+09 4.439e+08 -15.877 < 2e-16 ***
## x1 -3.539e+01 2.039e+01 -1.736 0.0836 .
## x2 3.526e+06 2.197e+05 16.045 < 2e-16 ***
## x3Mecánica -5.506e+06 1.295e+06 -4.252 2.81e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11150000 on 310 degrees of freedom
## Multiple R-squared: 0.7083, Adjusted R-squared: 0.7055
## F-statistic: 250.9 on 3 and 310 DF, p-value: < 2.2e-16###Este modelo en el cual se tienen en cuenta ya la variable cualitativa “transmision”. En este caso. de le logradar explicacion del 70% a la variabilidad de los datos. A pesar de no ser mucha la diferencia con el modelo anterios, este presenta una mayor precisión.
mod_multiple2=step(mod_muliple1)## Start: AIC=10194.39
## y ~ x1 + x2 + x3
##
## Df Sum of Sq RSS AIC
## <none> 3.8527e+16 10194
## - x1 1 3.7435e+14 3.8901e+16 10195
## - x3 1 2.2470e+15 4.0774e+16 10210
## - x2 1 3.1995e+16 7.0522e+16 10382summary(mod_multiple2)##
## Call:
## lm(formula = y ~ x1 + x2 + x3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -67801596 -4005789 -967519 2918840 100935418
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7.048e+09 4.439e+08 -15.877 < 2e-16 ***
## x1 -3.539e+01 2.039e+01 -1.736 0.0836 .
## x2 3.526e+06 2.197e+05 16.045 < 2e-16 ***
## x3Mecánica -5.506e+06 1.295e+06 -4.252 2.81e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11150000 on 310 degrees of freedom
## Multiple R-squared: 0.7083, Adjusted R-squared: 0.7055
## F-statistic: 250.9 on 3 and 310 DF, p-value: < 2.2e-16plot(x1,y)
par(mfrow=c(2,2))
plot(mod_multiple2)
plot(x1,log(y))
mod_trans=lm(log(y)~x1+x2+x3)
summary(mod_trans)##
## Call:
## lm(formula = log(y) ~ x1 + x2 + x3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.40126 -0.05946 0.00066 0.07333 1.04225
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.236e+02 8.045e+00 -15.361 < 2e-16 ***
## x1 -2.627e-07 3.696e-07 -0.711 0.477655
## x2 7.013e-02 3.982e-03 17.611 < 2e-16 ***
## x3Mecánica -8.161e-02 2.347e-02 -3.477 0.000578 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.202 on 310 degrees of freedom
## Multiple R-squared: 0.7213, Adjusted R-squared: 0.7186
## F-statistic: 267.4 on 3 and 310 DF, p-value: < 2.2e-16par(mfrow=c(2,2))
plot(mod_trans)