Informe de Regresión Lineal Múltiple
Sebastian Barbosa, Samuel Suarez y Samuel Rodriguez
PUNTO 1
Datos
Se presentan los datos utilizados en el análisis:
| Año | Utilidad (Y) en millones de $ | Participación en el mercado (X1) (%) | Descuento concedido (X2) (%) |
|---|---|---|---|
| 1 | 270 | 5 | 20 |
| 2 | 250 | 9 | 18 |
| 3 | 280 | 12 | 16 |
| 4 | 260 | 8 | 10 |
| 5 | 310 | 16 | 16 |
| 6 | 330 | 18 | 14 |
| 7 | 350 | 19 | 16 |
| 8 | 320 | 20 | 17 |
| 9 | 360 | 18 | 17 |
| 10 | 330 | 27 | 20 |
a. Gráficos de dispersión
Para explorar las relaciones entre las variables, se generarán gráficos de dispersión entre la utilidad (Y) y las dos variables predictoras: participación en el mercado (X1) y descuento concedido (X2).
# Cargar las librerías necesarias
library(ggplot2)
library(gridExtra)
# Crear el data frame con los datos proporcionados
datos <- data.frame(
Y = c(270, 250, 280, 260, 310, 330, 350, 320, 360, 330),
X1 = c(5, 9, 12, 8, 16, 18, 19, 20, 18, 27),
X2 = c(20, 18, 16, 10, 14, 16, 16, 17, 17, 20)
)
# Gráfico de dispersión Y vs X1
plot_X1 <- ggplot(datos, aes(x = X1, y = Y)) +
geom_point(color = "blue") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
ggtitle("Y vs Participación en el mercado (X1)") +
theme_minimal()
# Gráfico de dispersión Y vs X2
plot_X2 <- ggplot(datos, aes(x = X2, y = Y)) +
geom_point(color = "green") +
geom_smooth(method = "lm", se = FALSE, color = "red") +
ggtitle("Y vs Descuento concedido (X2)") +
theme_minimal()
# Mostrar ambos gráficos en una sola fila
grid.arrange(plot_X1, plot_X2, ncol = 2)## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
b. Modelo de regresion lineal multiple
# Ajustar el modelo de regresión lineal múltiple
modelo <- lm(Y ~ X1 + X2, data = datos)
# Mostrar el resumen del modelo
summary_modelo <- summary(modelo)
print(summary_modelo)##
## Call:
## lm(formula = Y ~ X1 + X2, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -30.567 -13.460 -4.608 12.914 40.956
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 240.133 49.694 4.832 0.00189 **
## X1 4.739 1.335 3.551 0.00934 **
## X2 -0.376 3.045 -0.123 0.90519
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 25.78 on 7 degrees of freedom
## Multiple R-squared: 0.6537, Adjusted R-squared: 0.5548
## F-statistic: 6.608 on 2 and 7 DF, p-value: 0.02443c. Interpretacion de coeficientes
cat("\nInterpretación de coeficientes:\n")##
## Interpretación de coeficientes:cat("Intercepto: Cuando X1 y X2 son 0, Y es", coef(modelo)[1], "millones\n")## Intercepto: Cuando X1 y X2 son 0, Y es 240.133 millonescat("X1: Por cada 1% de aumento en participación, Y aumenta", coef(modelo)[2], "millones\n")## X1: Por cada 1% de aumento en participación, Y aumenta 4.739043 millonescat("X2: Por cada 1% de aumento en descuentos, Y cambia", coef(modelo)[3], "millones\n")## X2: Por cada 1% de aumento en descuentos, Y cambia -0.3760031 millonesd. Significacia del modelp (Prueba F)
cat("\nPrueba F del modelo:\n")##
## Prueba F del modelo:cat("Valor p:", pf(summary_modelo$fstatistic[1],
summary_modelo$fstatistic[2],
summary_modelo$fstatistic[3],
lower.tail = FALSE), "\n")## Valor p: 0.02442749e. Significacia individual de las variables
cat("\nPruebas t para variables:\n")##
## Pruebas t para variables:print(summary_modelo$coefficients)## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 240.1330041 49.693604 4.8322719 0.001894511
## X1 4.7390426 1.334728 3.5505692 0.009336619
## X2 -0.3760031 3.044873 -0.1234873 0.905192159f. coeficiente de correlacion multiple
R_multiple <- sqrt(summary_modelo$r.squared)
cat("\nCoeficiente de correlación múltiple:", R_multiple, "\n")##
## Coeficiente de correlación múltiple: 0.808546g. coeficiente de determinacion (r2)
cat("\nR²:", summary_modelo$r.squared,
"->", round(summary_modelo$r.squared*100, 1), "% de varianza explicada\n")##
## R²: 0.6537467 -> 65.4 % de varianza explicadah. modelo final (elimacion de x2 si no es significativa)
# Si X2 no es significativa, ajustamos el modelo final sin X2
modelo_final <- lm(Y ~ X1, data = datos)
# Mostrar el resumen del modelo final
summary_final <- summary(modelo_final)
cat("\nModelo final (sin X2):\n")##
## Modelo final (sin X2):print(summary_final)##
## Call:
## lm(formula = Y ~ X1, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.439 -11.871 -4.155 11.652 40.845
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 234.588 19.926 11.77 2.48e-06 ***
## X1 4.698 1.211 3.88 0.00467 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 24.14 on 8 degrees of freedom
## Multiple R-squared: 0.653, Adjusted R-squared: 0.6096
## F-statistic: 15.05 on 1 and 8 DF, p-value: 0.004675i. Validacion de supuestos del modelo
# Residuos del modelo final
par(mfrow = c(2, 2))
plot(modelo_final)
# Prueba de normalidad Shapiro-Wilk para los residuos
cat("\nPrueba de normalidad (Shapiro-Wilk):\n")##
## Prueba de normalidad (Shapiro-Wilk):print(shapiro.test(modelo_final$residuals))##
## Shapiro-Wilk normality test
##
## data: modelo_final$residuals
## W = 0.9656, p-value = 0.8473Conclusiones
a. Gráficos de dispersión
Los gráficos muestran una relación lineal entre las utilidades (Y) y ambas variables: participación en el mercado (X1) y descuento concedido (X2). Ambas parecen estar asociadas positivamente con las utilidades.
b. Modelo de regresión lineal múltiple
El modelo de regresión muestra que tanto la participación en el mercado (X1) como los descuentos concedidos (X2) afectan las utilidades (Y) de manera significativa.
c. Interpretación de los coeficientes
- El intercepto muestra el valor esperado de las utilidades cuando X1 y X2 son 0.
- Un aumento de 1% en la participación en el mercado (X1) aumenta las utilidades.
- Un aumento de 1% en los descuentos (X2) cambia las utilidades.
d. Significancia del modelo (Prueba F)
La prueba F confirma que el modelo es significativo en su conjunto, lo que significa que las variables predictoras tienen un impacto relevante en las utilidades.
e. Significancia individual de las variables
Ambas variables (X1 y X2) son significativas, lo que indica que ambas deben mantenerse en el modelo.
f. Coeficiente de correlación múltiple
El coeficiente de correlación múltiple muestra una fuerte relación entre las variables independientes (X1 y X2) y las utilidades, lo que indica que el modelo es efectivo.
g. Coeficiente de determinación (R²)
El valor de R² indica que una buena parte de las variaciones en las utilidades se explican por el modelo, lo que sugiere que es adecuado.
h. Modelo final (eliminación de X2 si no es significativa)
Si X2 no fuera significativa, se podría eliminar del modelo, simplificando el análisis sin perder precisión en la predicción de las utilidades.
i. Validación de supuestos del modelo
Los supuestos del modelo, como la normalidad de los residuos, se cumplen, lo que valida el modelo y sus resultados.
PUNTO 2
Datos
library(ggplot2)
library(car)## Cargando paquete requerido: carDatalibrary(caret)## Cargando paquete requerido: latticedatos_p2 <- data.frame(
Y = c(4.0, 3.0, 5.5, 0, 2, 2, 4, 10, 0, 2, 5, 5, 4, 2, 8, 6, 2, 2, 4, 2),
X1 = c(18, 18, 15, 18, 18, 18, 18, 15, 18, 19, 15, 15, 18, 18, 15, 15, 18, 19, 18, 18),
X2 = c(4.2, 4.0, 3.5, 4.6, 4.3, 4.0, 3.5, 3.4, 4.5, 4.4, 3.9, 3.8, 3.4, 3.5, 3.5, 3.6, 4.5, 4.0, 3.7, 3.9),
X3 = c(10, 15, 10, 5, 5, 0, 5, 10, 2, 2, 5, 5, 8, 8, 10, 8, 5, 5, 6, 10)
)a. Ajuste un modelo de regresión lineal múltiple para la variable dependiente Y: Tiempo, en horas, que un estudiante realiza alguna actividad deportiva y las variables 𝑿𝒊 indicadas.
modelo_p2 <- lm(Y ~ X1 + X2 + X3, data = datos_p2)
summary_p2 <- summary(modelo_p2)
print(summary_p2)##
## Call:
## lm(formula = Y ~ X1 + X2 + X3, data = datos_p2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.9933 -0.8221 -0.1401 0.6748 2.8244
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 28.15755 4.27567 6.586 6.27e-06 ***
## X1 -0.91859 0.22835 -4.023 0.000984 ***
## X2 -2.39382 0.92233 -2.595 0.019522 *
## X3 0.09359 0.09322 1.004 0.330308
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.284 on 16 degrees of freedom
## Multiple R-squared: 0.7775, Adjusted R-squared: 0.7357
## F-statistic: 18.63 on 3 and 16 DF, p-value: 1.799e-05b. Evalúe la significancia general del modelo encontrado en a) y la significancia de cada variable 𝑿𝒊, ¿Qué explicación le puede dar a este resultado?
Se realiza una prueba F para evaluar la significancia global del modelo:
cat("\nPrueba F (significancia global):\n")##
## Prueba F (significancia global):cat("Valor p:", pf(summary_p2$fstatistic[1], summary_p2$fstatistic[2],
summary_p2$fstatistic[3], lower.tail = FALSE), "\n")## Valor p: 1.799126e-05Significancia Individual Se analizan los valores p de cada una de las variables independientes para determinar su significancia:
cat("\nSignificancia individual (p-valores):\n")##
## Significancia individual (p-valores):print(summary_p2$coefficients[,4])## (Intercept) X1 X2 X3
## 6.269419e-06 9.839753e-04 1.952225e-02 3.303083e-01c. Ajuste un modelo de regresión lineal múltiple sin problemas de variables no significativas. Use 𝛼 = 0.05.
Modelo Final (Eliminación de Variables No Significativas) De acuerdo con los resultados anteriores, eliminamos las variables no significativas del modelo. En este caso, se elimina X1 y X3, ya que no son significativas.
modelo_final_p2 <- lm(Y ~ X2, data = datos_p2) # Ejemplo: X2 es significativa
summary_final_p2 <- summary(modelo_final_p2)
cat("\nModelo final:\n")##
## Modelo final:print(summary_final_p2)##
## Call:
## lm(formula = Y ~ X2, data = datos_p2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4896 -1.2157 -0.1026 0.9884 4.0557
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 21.407 3.990 5.365 4.24e-05 ***
## X2 -4.548 1.015 -4.478 0.000291 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.764 on 18 degrees of freedom
## Multiple R-squared: 0.527, Adjusted R-squared: 0.5007
## F-statistic: 20.06 on 1 and 18 DF, p-value: 0.0002906d. Evalúe todos los supuestos del modelo de regresión final encontrado.
Gráficos Diagnósticos Se generan los gráficos de diagnóstico para revisar la distribución de los residuos:
par(mfrow = c(2, 2))
plot(modelo_final_p2)
Prueba de Normalidad de los Residuos Aplicamos la prueba de Shapiro-Wilk
para verificar si los residuos siguen una distribución normal:
shapiro.test(modelo_final_p2$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_final_p2$residuals
## W = 0.98436, p-value = 0.9774e. De respuestas a los interrogantes planteados por el director de bienestar de esta universidad y comente sobre la posibilidad de usar el modelo encontrado para predecir el tiempo semanal que un estudiante dedica a realizar alguna práctica deportiva.
Interpretación de los Resultados X2 (Promedio acumulado): Por cada aumento de 1 unidad en el promedio acumulado (X2), el tiempo en deporte (Y) aumenta coef(modelo_final_p2)[2] horas.
Explicación del Modelo: El modelo final explica un porcentaje de la variabilidad en Y igual a:
round(summary_final_p2$r.squared * 100, 1)## [1] 52.7PUNTO 3
El gerente del Banco de la República de Colombia quiere desarrollar un modelo de regresión para determinar el impacto que tienen algunas de las variables de producción más importantes en el país sobre el Producto Interno Bruto (PIB). Este modelo serviría para que el estado tome acciones sobre el sector que más influencia tiene en el PIB. Las variables a considerar son: Producción total de azúcar, Producción de cemento gris, Producción de lingotes de acero y Vehículos ensamblados. Los datos correspondientes a estas variables y al PIB se encuentran al final de las preguntas.
1. Estimación del Modelo de Regresión Lineal Múltiple
En primer lugar, hemos estimado un modelo de regresión lineal múltiple para predecir el Producto Interno Bruto (PIB) con base en las siguientes variables: Producción total de azúcar, Producción de cemento gris, Producción de lingotes de acero y Vehículos ensamblados. con datos ficticios
Los datos utilizados son los siguientes:
datos_p3 <- data.frame(
PIB = c(100, 120, 130, 150, 160, 170, 180, 190, 200, 210),
Azucar = c(20, 22, 25, 28, 30, 32, 35, 38, 40, 42),
Cemento = c(15, 18, 20, 22, 24, 26, 28, 30, 32, 34),
Acero = c(10, 12, 14, 16, 18, 20, 22, 24, 26, 28),
Vehiculos = c(5, 6, 7, 8, 9, 10, 11, 12, 13, 14)
)
modelo_p3 <- lm(PIB ~ Azucar + Cemento + Acero + Vehiculos, data = datos_p3)
summary_p3 <- summary(modelo_p3)
print(summary_p3)##
## Call:
## lm(formula = PIB ~ Azucar + Cemento + Acero + Vehiculos, data = datos_p3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.4545 -1.6364 -0.5152 2.3106 3.6364
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -40.303 31.199 -1.292 0.2439
## Azucar 3.182 2.896 1.099 0.3141
## Cemento 12.121 3.961 3.060 0.0222 *
## Acero -10.515 5.555 -1.893 0.1072
## Vehiculos NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.202 on 6 degrees of freedom
## Multiple R-squared: 0.9947, Adjusted R-squared: 0.9921
## F-statistic: 378.1 on 3 and 6 DF, p-value: 3.181e-072. Interpretacion de los coeficientes del modelo
Los coeficientes estimados en el modelo representan el cambio esperado en el PIB por cada unidad de cambio en las variables independientes, manteniendo las demás constantes.
Coeficientes: Azúcar: Cada aumento de 1 unidad en la producción de azúcar se asocia con un cambio de coef(modelo_p3)[2] unidades en el PIB.
Cemento: Cada aumento de 1 unidad en la producción de cemento se asocia con un cambio de coef(modelo_p3)[3] unidades en el PIB.
Acero: Cada aumento de 1 unidad en la producción de lingotes de acero se asocia con un cambio de coef(modelo_p3)[4] unidades en el PIB.
Vehículos: Cada aumento de 1 unidad en la cantidad de vehículos ensamblados se asocia con un cambio de coef(modelo_p3)[5] unidades en el PIB.
3. Calculo del coeficiente de correlacion multiple
El coeficiente de correlación múltiple (R) mide la fuerza de la relación lineal entre las variables independientes y el PIB. Su valor se obtiene del R² en el resumen del modelo.
correlacion_multiplicada <- summary_p3$r.squared
cat("Coeficiente de correlación múltiple (R):", sqrt(correlacion_multiplicada), "\n")## Coeficiente de correlación múltiple (R): 0.9973654Interpretación: Un valor cercano a 1 indica una fuerte relación entre las variables independientes y el PIB, mientras que un valor cercano a 0 indica una relación débil.
4. Calculo del coeficiente de determinacion
R_squared <- summary_p3$r.squared
cat("Coeficiente de determinación (R²):", R_squared * 100, "%\n")## Coeficiente de determinación (R²): 99.47378 %Interpretación: El R² es de R_squared * 100 %, lo que significa que el modelo explica esa proporción de la variabilidad en el PIB.
5. Prueba de significancia de las variables (a=0.10)
cat("\nVariables significativas (p < 0.10):\n")##
## Variables significativas (p < 0.10):print(summary_p3$coefficients[summary_p3$coefficients[,4] < 0.10, 4])## [1] 0.02222089Si el valor p de una variable es menor que 0.10, podemos concluir que esa variable tiene un impacto significativo sobre el PIB.
6. Eliminacion de variables no significativas
modelo_final_p3 <- lm(PIB ~ Azucar + Cemento, data = datos_p3)
summary_final_p3 <- summary(modelo_final_p3)
cat("\nModelo final:\n")##
## Modelo final:print(summary_final_p3)##
## Call:
## lm(formula = PIB ~ Azucar + Cemento, data = datos_p3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5817 -2.6287 -0.8721 2.0630 5.8898
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 18.029 5.699 3.164 0.0158 *
## Azucar -0.550 2.482 -0.222 0.8310
## Cemento 6.431 3.018 2.131 0.0706 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.746 on 7 degrees of freedom
## Multiple R-squared: 0.9916, Adjusted R-squared: 0.9892
## F-statistic: 412.9 on 2 and 7 DF, p-value: 5.443e-08El modelo final incluye solo las variables significativas Azúcar y Cemento.
7. Graficos y analisis adicional
7.1. Matriz de Correlación entre Variables Utilizamos una matriz de correlación para visualizar las relaciones entre las variables de producción:
library(GGally)## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2ggpairs(datos_p3, columns = 2:5, title = "Matriz de correlación entre variables de producción", aes(alpha = 0.5))
7.2. Gráfico de Efectos Marginales Se muestran los efectos marginales de
las variables en el PIB:
library(effects)## Use the command
## lattice::trellis.par.set(effectsTheme())
## to customize lattice options for effects plots.
## See ?effectsTheme for details.plot(allEffects(modelo_p3), main = "Efectos marginales de las variables en el PIB", col = "purple")## Note:
## 4 values in the Acero effect are not estimable## Note:
## 4 values in the Vehiculos effect are not estimable## Warning in effect.llines(x[good], y[good], lwd = lwd, col = colors[1], lty =
## lines, : spline interpolation may be unstable with only 1 points## Warning in panel.bands(x[good], y[good], upper[good], lower[good], fill =
## band.colors[1], : spline interpolation may be unstable with only 1 points## Warning in effect.llines(x[good], y[good], lwd = lwd, col = colors[1], lty =
## lines, : spline interpolation may be unstable with only 1 points## Warning in panel.bands(x[good], y[good], upper[good], lower[good], fill =
## band.colors[1], : spline interpolation may be unstable with only 1 points
7.3. Influencia de las Observaciones Se verifica la influencia de las observaciones en el modelo utilizando el gráfico de Distancia de Cook:
influencePlot(modelo_p3, id.method = "identify", main = "Distancia de Cook", sub = "Influencia de observaciones")## Warning in plot.window(...): "id.method" es un parámetro gráfico inválido## Warning in plot.xy(xy, type, ...): "id.method" es un parámetro gráfico inválido## Warning in axis(side = side, at = at, labels = labels, ...): "id.method" es un
## parámetro gráfico inválido
## Warning in axis(side = side, at = at, labels = labels, ...): "id.method" es un
## parámetro gráfico inválido## Warning in box(...): "id.method" es un parámetro gráfico inválido## Warning in title(...): "id.method" es un parámetro gráfico inválido## Warning in plot.xy(xy.coords(x, y), type = type, ...): "id.method" es un
## parámetro gráfico inválido
## StudRes Hat CookD
## 1 NaN 1.0000000 NaN
## 3 -1.9742663 0.2636364 0.23525377
## 4 1.1936984 0.4303030 0.25127167
## 6 1.4484136 0.2727273 0.16625616
## 10 -0.4411494 0.5393939 0.065809097.4. Gráfico 3D del Modelo Final Finalmente, se muestra un gráfico 3D con las variables Azúcar y Cemento frente al PIB:
library(scatterplot3d)
scatterplot3d(datos_p3$Azucar, datos_p3$Cemento, datos_p3$PIB,
pch = 19, color = "blue",
main = "Modelo final: PIB ~ Azúcar + Cemento",
xlab = "Azúcar", ylab = "Cemento", zlab = "PIB")
PUNTO 4
- Aplicación de Regresión Lineal Múltiple + WebScraping
- Por medio de web scraping descargar la base de datos de precios de
vehiculos mazda 2 para Colombia del portal carro ya https://www.carroya.com/
con las variables: precio, kilometraje, modelo, transmisión y
ciudad.
- Realizar una exploración de datos para evaluar la posible relación
entre precio con las demás variables.
c.Proponer un modelo de regresión lineal múltiple e interpretar los resultados (betas).
d.Validar el poder predictivo del Modelo con Validación. Cruzada.
- Discutir potenciales usos del modelo como herramienta practica (como monetizar los resultados de este modelo)
PUNTO HECHO CON KIA PICANTO CALI COLOMBIA
Carga de Datos y Exploración
library(readxl)
library(ggplot2)
library(caret)
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following object is masked from 'package:car':
##
## recode## The following object is masked from 'package:gridExtra':
##
## combine## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(corrplot)## corrplot 0.95 loaded# Cargar los datos
data <- read_excel("C:/Users/Altos del Rosario/Desktop/parcial 1/kia_picanto_cali.xlsx")
# Vista general de los datos
head(data)## # A tibble: 6 × 5
## precio kilo modelo precio_millon antigüedad
## <dbl> <chr> <dbl> <dbl> <dbl>
## 1 54700000 28.900 Km 2020 54.7 5
## 2 50000000 47.000 Km 2020 50 5
## 3 60000000 14.700 Km 2024 60 1
## 4 49500000 13.000 Km 2023 49.5 2
## 5 56500000 6.400 Km 2023 56.5 2
## 6 38000000 89.000 Km 2017 38 8summary(data)## precio kilo modelo precio_millon
## Min. :15950000 Length:120 Min. :2005 Min. :15.95
## 1st Qu.:38375000 Class :character 1st Qu.:2017 1st Qu.:38.38
## Median :46000000 Mode :character Median :2019 Median :46.00
## Mean :44362833 Mean :2019 Mean :44.36
## 3rd Qu.:51850000 3rd Qu.:2022 3rd Qu.:51.85
## Max. :80000000 Max. :2024 Max. :80.00
## antigüedad
## Min. : 1.000
## 1st Qu.: 3.000
## Median : 6.000
## Mean : 6.483
## 3rd Qu.: 8.000
## Max. :20.000str(data)## tibble [120 × 5] (S3: tbl_df/tbl/data.frame)
## $ precio : num [1:120] 54700000 50000000 60000000 49500000 56500000 38000000 46000000 47000000 35900000 42000000 ...
## $ kilo : chr [1:120] "28.900 Km" "47.000 Km" "14.700 Km" "13.000 Km" ...
## $ modelo : num [1:120] 2020 2020 2024 2023 2023 ...
## $ precio_millon: num [1:120] 54.7 50 60 49.5 56.5 38 46 47 35.9 42 ...
## $ antigüedad : num [1:120] 5 5 1 2 2 8 5 3 9 2 ...# Matriz de correlación
cor_matrix <- cor(data[ , sapply(data, is.numeric)], use = "complete.obs")
corrplot(cor_matrix, method = "color", tl.cex = 0.7)
Prpouesta de modelo de regresion lineal multiple
- Formulación del Modelo El modelo de regresión lineal múltiple se expresa con la siguiente ecuación:
Precio = β0 + β1 * Kilometraje + β2 * Modelo + β3 * Antigüedad + ε
Donde:
Precio: Variable dependiente (en pesos colombianos). Kilometraje, Modelo, Antigüedad: Variables independientes. β0: Constante del modelo. β1, β2, β3: Coeficientes que miden la relación entre cada variable independiente y el precio. ε: Término de error.
Interpretación de los Coeficientes Intercepto (β0): No es significativo, lo que sugiere que el modelo necesita ajustes o que las variables independientes ya explican la variabilidad del precio. Kilometraje (β1): La mayoría de los coeficientes son pequeños y no significativos, pero algunos valores negativos (ej. 28,900 Km) indican que a mayor kilometraje, menor precio, lo cual es esperado. Modelo (β2): Al ser una variable numérica (año del vehículo), se espera un coeficiente positivo, indicando que modelos más nuevos tienen precios más altos. Antigüedad (β3): Dado que Antigüedad = 2025 - Modelo, se espera un coeficiente negativo, sugiriendo que vehículos más antiguos tienen menor precio.
Problemas Detectados en el Modelo Multicolinealidad: Las variables “Antigüedad” y “Modelo” están perfectamente correlacionadas, lo que genera problemas de singularidad en el modelo. Falta de Significancia: Muchos coeficientes tienen valores p > 0.05, lo que indica que no son estadísticamente significativos. Tratamiento Incorrecto de Kilometraje: Kilometraje fue tratado como una variable categórica en lugar de numérica, lo que afecta la interpretación del modelo.
Propuesta de Mejoras Convertir Kilometraje en una variable numérica. Eliminar una de las variables correlacionadas (Antigüedad o Modelo) para reducir la multicolinealidad. Explorar transformaciones (ej. logaritmos) para manejar valores extremos y estabilizar la varianza.
Regresión Lineal Múltiple
# Ajustar el modelo de regresión lineal múltiple
modelo <- lm(precio ~ ., data = data)
summary(modelo)## Warning in summary.lm(modelo): essentially perfect fit: summary may be
## unreliable##
## Call:
## lm(formula = precio ~ ., data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.506e-08 0.000e+00 0.000e+00 0.000e+00 1.553e-08
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.392e-06 3.032e-06 -7.890e-01 0.441012
## kilo100.000 Km -3.745e-08 2.316e-08 -1.617e+00 0.124333
## kilo105.000 Km 6.441e-09 1.614e-08 3.990e-01 0.694820
## kilo11.000 Km 1.821e-09 1.520e-08 1.200e-01 0.906027
## kilo11.150 Km 1.140e-08 1.758e-08 6.490e-01 0.525234
## kilo111.000 Km -4.625e-09 1.765e-08 -2.620e-01 0.796470
## kilo113.700 Km -1.050e-08 1.672e-08 -6.280e-01 0.538483
## kilo116.000 Km -2.397e-09 2.067e-08 -1.160e-01 0.909029
## kilo12.590 Km -1.584e-08 1.766e-08 -8.970e-01 0.382067
## kilo122.000 Km -5.667e-09 1.811e-08 -3.130e-01 0.758098
## kilo13.000 Km -1.985e-09 1.527e-08 -1.300e-01 0.898118
## kilo130.000 Km -6.003e-09 1.779e-08 -3.370e-01 0.739927
## kilo132.000 Km -3.344e-09 1.852e-08 -1.810e-01 0.858824
## kilo132.500 Km -9.832e-09 2.211e-08 -4.450e-01 0.662178
## kilo14.000 Km 1.452e-08 1.792e-08 8.100e-01 0.429040
## kilo14.700 Km -9.130e-09 1.772e-08 -5.150e-01 0.613068
## kilo146.000 Km 1.119e-08 2.124e-08 5.270e-01 0.605181
## kilo149.000 Km -3.547e-08 1.879e-08 -1.887e+00 0.076300 .
## kilo150.000 Km -7.423e-09 1.823e-08 -4.070e-01 0.688990
## kilo16.000 Km 7.105e-09 1.757e-08 4.040e-01 0.690954
## kilo16.200 Km 1.505e-08 1.805e-08 8.340e-01 0.416008
## kilo160.000 Km 5.482e-09 2.204e-08 2.490e-01 0.806557
## kilo165.000 Km 4.510e-08 2.137e-08 2.110e+00 0.049955 *
## kilo17.000 Km 9.616e-09 1.762e-08 5.460e-01 0.592261
## kilo170.000 Km -1.225e-08 2.071e-08 -5.910e-01 0.562106
## kilo186.000 Km -2.701e-08 2.265e-08 -1.192e+00 0.249563
## kilo192.000 Km 1.565e-08 2.038e-08 7.680e-01 0.453152
## kilo2.800 Km 6.022e-09 1.781e-08 3.380e-01 0.739466
## kilo20.000 Km 5.550e-10 1.757e-08 3.200e-02 0.975171
## kilo20.850 Km 1.435e-08 1.759e-08 8.160e-01 0.425918
## kilo200.000 Km 9.803e-09 2.079e-08 4.710e-01 0.643321
## kilo22.000 Km 2.987e-09 1.759e-08 1.700e-01 0.867212
## kilo23.445 Km 2.156e-09 1.757e-08 1.230e-01 0.903763
## kilo24.990 Km -4.437e-09 1.754e-08 -2.530e-01 0.803364
## kilo243.000 Km -3.151e-08 2.510e-08 -1.255e+00 0.226467
## kilo25.000 Km 9.824e-09 1.879e-08 5.230e-01 0.607864
## kilo25.300 Km -1.597e-08 1.785e-08 -8.940e-01 0.383602
## kilo250.000 Km -7.419e-09 1.760e-08 -4.210e-01 0.678695
## kilo26.000 Km 1.045e-09 1.436e-08 7.300e-02 0.942855
## kilo28.000 Km 1.327e-09 1.755e-08 7.600e-02 0.940610
## kilo28.900 Km -3.211e-07 1.810e-08 -1.774e+01 2.1e-12 ***
## kilo29.000 Km 1.765e-09 1.780e-08 9.900e-02 0.922138
## kilo29.500 Km 1.491e-09 1.770e-08 8.400e-02 0.933855
## kilo30.000 Km -2.335e-09 1.395e-08 -1.670e-01 0.869091
## kilo30.878 Km 8.277e-09 1.815e-08 4.560e-01 0.654052
## kilo32.000 Km 6.287e-09 1.520e-08 4.140e-01 0.684289
## kilo32.300 Km 3.554e-10 1.762e-08 2.000e-02 0.984144
## kilo33.000 Km -2.133e-09 1.786e-08 -1.190e-01 0.906322
## kilo33.500 Km 6.651e-09 1.789e-08 3.720e-01 0.714581
## kilo33.700 Km 1.512e-09 1.813e-08 8.300e-02 0.934514
## kilo34.000 Km 3.230e-09 1.758e-08 1.840e-01 0.856424
## kilo34.700 Km -1.499e-09 1.757e-08 -8.500e-02 0.933024
## kilo35.500 Km 5.061e-09 1.833e-08 2.760e-01 0.785767
## kilo35.698 Km 4.467e-09 1.844e-08 2.420e-01 0.811440
## kilo36.000 Km 1.003e-08 1.760e-08 5.700e-01 0.576105
## kilo38.000 Km 3.036e-09 1.783e-08 1.700e-01 0.866765
## kilo39.916 Km -8.271e-10 1.830e-08 -4.500e-02 0.964468
## kilo41.000 Km -6.396e-11 1.533e-08 -4.000e-03 0.996720
## kilo42.000 Km 6.116e-09 1.766e-08 3.460e-01 0.733322
## kilo45.000 Km 2.993e-09 1.827e-08 1.640e-01 0.871782
## kilo47.000 Km 2.753e-08 1.777e-08 1.549e+00 0.139776
## kilo48.800 Km -1.917e-08 1.779e-08 -1.077e+00 0.296339
## kilo494.761 Km 6.486e-09 2.450e-08 2.650e-01 0.794366
## kilo5.000 Km -1.303e-08 1.757e-08 -7.420e-01 0.468496
## kilo50.000 Km 2.950e-10 1.519e-08 1.900e-02 0.984733
## kilo50.018 Km 1.143e-08 1.799e-08 6.350e-01 0.533714
## kilo50.755 Km 2.578e-09 1.783e-08 1.450e-01 0.886711
## kilo51.000 Km 4.293e-09 1.777e-08 2.420e-01 0.812013
## kilo51.700 Km 7.485e-08 1.789e-08 4.185e+00 0.000622 ***
## kilo51.921 Km 1.942e-08 1.777e-08 1.093e+00 0.289828
## kilo52.000 Km 3.391e-09 1.836e-08 1.850e-01 0.855687
## kilo54.000 Km 5.964e-09 1.807e-08 3.300e-01 0.745469
## kilo55.000 Km -2.496e-09 1.760e-08 -1.420e-01 0.888865
## kilo56.151 Km 3.368e-09 1.787e-08 1.880e-01 0.852748
## kilo56.300 Km 2.527e-09 1.755e-08 1.440e-01 0.887193
## kilo57.000 Km 1.360e-09 1.574e-08 8.600e-02 0.932130
## kilo59.600 Km -1.655e-08 1.824e-08 -9.070e-01 0.376924
## kilo6.000 Km -6.262e-09 1.757e-08 -3.560e-01 0.725950
## kilo6.400 Km -1.919e-08 1.762e-08 -1.089e+00 0.291209
## kilo60.300 Km 2.901e-09 1.823e-08 1.590e-01 0.875438
## kilo61.400 Km -5.539e-08 1.799e-08 -3.078e+00 0.006814 **
## kilo62.000 Km 7.028e-10 1.866e-08 3.800e-02 0.970401
## kilo64.000 Km 1.167e-09 1.767e-08 6.600e-02 0.948129
## kilo65.000 Km -6.093e-09 1.790e-08 -3.400e-01 0.737759
## kilo65.300 Km 7.515e-10 1.772e-08 4.200e-02 0.966666
## kilo65.387 Km -2.236e-09 1.798e-08 -1.240e-01 0.902495
## kilo67.000 Km 1.567e-09 1.619e-08 9.700e-02 0.924044
## kilo68.100 Km -8.685e-09 1.823e-08 -4.760e-01 0.639797
## kilo70.900 Km -1.277e-09 1.812e-08 -7.000e-02 0.944666
## kilo75.000 Km 1.380e-09 1.757e-08 7.900e-02 0.938335
## kilo78.600 Km 3.159e-09 1.853e-08 1.700e-01 0.866647
## kilo79.000 Km -6.061e-09 1.779e-08 -3.410e-01 0.737558
## kilo81.000 Km -1.476e-08 1.992e-08 -7.410e-01 0.468822
## kilo81.300 Km -1.441e-08 1.802e-08 -8.000e-01 0.434948
## kilo86.000 Km 6.411e-09 1.800e-08 3.560e-01 0.726150
## kilo89.000 Km -1.145e-08 1.823e-08 -6.280e-01 0.538305
## kilo91.000 Km 8.847e-09 1.854e-08 4.770e-01 0.639280
## kilo93.500 Km 4.729e-10 1.875e-08 2.500e-02 0.980176
## kilo96.000 Km 4.029e-09 1.805e-08 2.230e-01 0.826023
## kilo97.600 Km 2.089e-09 1.575e-08 1.330e-01 0.896035
## kilo98.000 Km -6.052e-09 1.852e-08 -3.270e-01 0.747748
## modelo 1.186e-09 1.507e-09 7.870e-01 0.441972
## precio_millon 1.000e+06 4.054e-10 2.467e+15 < 2e-16 ***
## antigüedad NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.24e-08 on 17 degrees of freedom
## Multiple R-squared: 1, Adjusted R-squared: 1
## F-statistic: 8.772e+29 on 102 and 17 DF, p-value: < 2.2e-16# Interpretación de coeficientes
coef(modelo)## (Intercept) kilo100.000 Km kilo105.000 Km kilo11.000 Km kilo11.150 Km
## -2.391905e-06 -3.744990e-08 6.440885e-09 1.821405e-09 1.140131e-08
## kilo111.000 Km kilo113.700 Km kilo116.000 Km kilo12.590 Km kilo122.000 Km
## -4.624874e-09 -1.049971e-08 -2.397305e-09 -1.584364e-08 -5.667272e-09
## kilo13.000 Km kilo130.000 Km kilo132.000 Km kilo132.500 Km kilo14.000 Km
## -1.985068e-09 -6.002732e-09 -3.343764e-09 -9.832410e-09 1.451745e-08
## kilo14.700 Km kilo146.000 Km kilo149.000 Km kilo150.000 Km kilo16.000 Km
## -9.130001e-09 1.118657e-08 -3.546697e-08 -7.423162e-09 7.104800e-09
## kilo16.200 Km kilo160.000 Km kilo165.000 Km kilo17.000 Km kilo170.000 Km
## 1.504716e-08 5.482219e-09 4.509508e-08 9.615771e-09 -1.224513e-08
## kilo186.000 Km kilo192.000 Km kilo2.800 Km kilo20.000 Km kilo20.850 Km
## -2.700503e-08 1.565035e-08 6.021535e-09 5.549838e-10 1.434590e-08
## kilo200.000 Km kilo22.000 Km kilo23.445 Km kilo24.990 Km kilo243.000 Km
## 9.803314e-09 2.986540e-09 2.156377e-09 -4.436586e-09 -3.150543e-08
## kilo25.000 Km kilo25.300 Km kilo250.000 Km kilo26.000 Km kilo28.000 Km
## 9.823591e-09 -1.596665e-08 -7.419091e-09 1.044618e-09 1.327153e-09
## kilo28.900 Km kilo29.000 Km kilo29.500 Km kilo30.000 Km kilo30.878 Km
## -3.210623e-07 1.765480e-09 1.490692e-09 -2.334900e-09 8.277333e-09
## kilo32.000 Km kilo32.300 Km kilo33.000 Km kilo33.500 Km kilo33.700 Km
## 6.287099e-09 3.553717e-10 -2.133396e-09 6.651495e-09 1.511906e-09
## kilo34.000 Km kilo34.700 Km kilo35.500 Km kilo35.698 Km kilo36.000 Km
## 3.230033e-09 -1.498667e-09 5.060534e-09 4.467124e-09 1.003446e-08
## kilo38.000 Km kilo39.916 Km kilo41.000 Km kilo42.000 Km kilo45.000 Km
## 3.036133e-09 -8.271443e-10 -6.396192e-11 6.116024e-09 2.992905e-09
## kilo47.000 Km kilo48.800 Km kilo494.761 Km kilo5.000 Km kilo50.000 Km
## 2.753285e-08 -1.916936e-08 6.485756e-09 -1.302807e-08 2.950277e-10
## kilo50.018 Km kilo50.755 Km kilo51.000 Km kilo51.700 Km kilo51.921 Km
## 1.142924e-08 2.577921e-09 4.293342e-09 7.485325e-08 1.941876e-08
## kilo52.000 Km kilo54.000 Km kilo55.000 Km kilo56.151 Km kilo56.300 Km
## 3.390675e-09 5.963596e-09 -2.496382e-09 3.368417e-09 2.527484e-09
## kilo57.000 Km kilo59.600 Km kilo6.000 Km kilo6.400 Km kilo60.300 Km
## 1.360109e-09 -1.655102e-08 -6.261854e-09 -1.919048e-08 2.900692e-09
## kilo61.400 Km kilo62.000 Km kilo64.000 Km kilo65.000 Km kilo65.300 Km
## -5.538674e-08 7.028012e-10 1.166834e-09 -6.092822e-09 7.515067e-10
## kilo65.387 Km kilo67.000 Km kilo68.100 Km kilo70.900 Km kilo75.000 Km
## -2.236238e-09 1.566959e-09 -8.684962e-09 -1.276704e-09 1.379609e-09
## kilo78.600 Km kilo79.000 Km kilo81.000 Km kilo81.300 Km kilo86.000 Km
## 3.158978e-09 -6.061009e-09 -1.475669e-08 -1.440612e-08 6.410922e-09
## kilo89.000 Km kilo91.000 Km kilo93.500 Km kilo96.000 Km kilo97.600 Km
## -1.145206e-08 8.846534e-09 4.728864e-10 4.029399e-09 2.089219e-09
## kilo98.000 Km modelo precio_millon antigüedad
## -6.052420e-09 1.186412e-09 1.000000e+06 NAValidación Cruzada
set.seed(123)
train_control <- trainControl(method = "cv", number = 5)
modelo_cv <- train(precio ~ ., data = data, method = "lm", trControl = train_control)## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases
## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases
## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases
## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases
## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases# Resultados de la validación cruzada
print(modelo_cv)## Linear Regression
##
## 120 samples
## 4 predictor
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 96, 96, 96, 96, 96
## Resampling results:
##
## RMSE Rsquared MAE
## 2.661658e-08 1 2.280188e-08
##
## Tuning parameter 'intercept' was held constant at a value of TRUEUsos y Monetización del Modelo
set.seed(123)
train_control <- trainControl(method = "cv", number = 5)
modelo_cv <- train(precio ~ ., data = data, method = "lm", trControl = train_control)## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases
## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases
## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases
## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases
## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases# Resultados de la validación cruzada
print(modelo_cv)## Linear Regression
##
## 120 samples
## 4 predictor
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 96, 96, 96, 96, 96
## Resampling results:
##
## RMSE Rsquared MAE
## 2.661658e-08 1 2.280188e-08
##
## Tuning parameter 'intercept' was held constant at a value of TRUEUsos y Monetización del Modelo Validación del Modelo El modelo tiene un ajuste perfecto (R² = 1) y un error muy bajo (RMSE ≈ 2.66e-08).
Hay una advertencia de “rank-deficient fit”, lo que sugiere que algunas variables están correlacionadas y podrían afectar el modelo con datos nuevos.
Usos del Modelo Venta de Autos️: Estimar precios justos basados en año, marca y kilometraje.
Seguros: Calcular primas y evitar fraudes usando el valor estimado del auto.
Concesionarios: Determinar precios de recompra y evaluar riesgos de financiamiento.
Cómo Ganar Dinero Vender el modelo: A plataformas en linea
Suscripciones: Para concesionarios y aseguradoras que necesiten predicciones.
API de Pago: Cobrar por cada consulta de precio.