Parcial 1
Guido Salazar & Federico Viedman
2025-02-27
Punto 1
Base de datos
datos_utilidad <- data.frame(
utilidad = c(270, 250, 280, 260, 310, 330, 350, 320, 360, 330),
participacion = c(5, 9, 12, 8, 16, 18, 19, 20, 18, 27),
descuento = c(20, 18, 16, 10, 14, 16, 16, 17, 17, 20)
)Punto a: Construya graficas de dispersión y determine gráficamente si existe relación lineal entre la utilidad (Y) y las variables regresoras: Participación en el mercado (X1) y Descuento concedido (X2).
# Graficas de dispersión
par(mfrow=c(1, 2)) # Divide la ventana en 2 gráficos
plot(datos_utilidad$participacion, datos_utilidad$utilidad, main="Utilidad vs Participación", xlab="Participación", ylab="Utilidad", col="blue", pch=19)
plot(datos_utilidad$descuento, datos_utilidad$utilidad, main="Utilidad vs Descuento", xlab="Descuento", ylab="Utilidad", col="red", pch=19)
Las gráficas de dispersión mostraron que existe una relación visual entre la utilidad y la variable participación. La relación parece ajustarse de manera lineal, por lo que un modelo de regresión lineal podría ser adecuado para modelar la utilidad en función de esta variable. Mientras tanto, la otra variable, el descuento, no parece tener un comportamiento polinómico.
Punto b:
modelo <- lm(utilidad ~ participacion+descuento, data = datos_utilidad)
modelo##
## Call:
## lm(formula = utilidad ~ participacion + descuento, data = datos_utilidad)
##
## Coefficients:
## (Intercept) participacion descuento
## 240.133 4.739 -0.376Estimamos un modelo de regresión lineal múltiple entre la utilidad y las variables participación y descuento. El modelo nos permitió cuantificar cómo la participación en el mercado y el descuento concedido afectan la utilidad.
Punto c: Interprete cada coeficiente del modelo encontrado en b.
El coeficiente de la participación indicó que, manteniendo constante el descuento, un aumento en la participación en el mercado incrementa la utilidad de manera significativa. El coeficiente del descuento mostró que impacto negativo en la utilidad, aunque la magnitud de su efecto pequeño.
Punto d y e: Evalúe la significancia del modelo propuesto en b, es decir pruebe que el modelo es lineal. Evalúe la significancia de cada variable en el modelo propuesto en b. ¿Qué variable se debe eliminar? Use \(\alpha\) = 0.05.
# Resumen del modelo
summary(modelo)##
## Call:
## lm(formula = utilidad ~ participacion + descuento, data = datos_utilidad)
##
## 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 **
## participacion 4.739 1.335 3.551 0.00934 **
## descuento -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.02443##Intercepto: Es el valor de la utilidad cuando ambas variables independientes (participación y descuento) son 0.
##Coeficiente de Participación: Indica el cambio en la utilidad por cada unidad adicional de participación en el mercado, manteniendo el descuento constante.
##Coeficiente de Descuento (β2): Indica el cambio en la utilidad por cada unidad adicional de descuento, manteniendo la participación constante.Al evaluar la significancia de cada variable individualmente, observamos que la participación en el mercado es estadísticamente significativa (valor p = 0.00934), lo que sugiere que debe mantenerse en el modelo. Sin embargo, el descuento no es estadísticamente significativo (valor p = 0.90519), ya que su valor p es mayor que el umbral de 0.05, lo que indica que no tiene un efecto significativo sobre la utilidad en este modelo. Por lo tanto, en casos donde alguna variable no fuera significativa, como el descuento en este caso, se podría considerar eliminarla del modelo
Punto f y g: Obtenga el coeficiente de correlación múltiple e interprételo en el modelo propuesto en b. Obtenga el coeficiente de determinación \(R^2\)! e interprételo en el modelo propuesto en b.
correlation_matrix = cor(datos_utilidad);
corrplot(correlation_matrix,
method = "color", # Usa colores para la visualización
col = colorRampPalette(c("red", "white", "green"))(200), # Gradiente de colores rojo (negativo) a verde (positivo)
type = "upper", # Solo muestra la parte superior de la matriz (opcional)
tl.cex = 0.8, # Ajusta el tamaño de las etiquetas
addCoef.col = "black") # Agrega los coeficientes de correlación en negro
# Coeficiente de correlación múltiple
correlacion_multiple <- summary(modelo)$r.squared
correlacion_multiple## [1] 0.6537467El coeficiente de determinación (\(R^2\)) indicó que aproximadamente el 65.37% de la variabilidad en la utilidad es explicada por las variables participación y descuento. Esto sugiere que el modelo tiene un buen poder explicativo, lo cual es positivo para la toma de decisiones basadas en este modelo.
Punto h: De acuerdo a lo encontrado en la pregunta e, obtenga el modelo de regresión lineal final.
# Suponiendo que eliminamos la variable no significativa
modelo_final <- lm(utilidad ~ participacion, data = datos_utilidad) # Ejemplo si eliminamos "descuento"
summary(modelo_final)##
## Call:
## lm(formula = utilidad ~ participacion, data = datos_utilidad)
##
## 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 ***
## participacion 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.004675El análisis del segundo modelo, que solo incluye la variable participación, muestra que explica aproximadamente el 65.3% de la variabilidad en la utilidad (según el \(R^2\)), lo que indica un buen poder explicativo. El valor p de participación es significativo (0.00467), lo que confirma que participación es un predictor importante de la utilidad. En resumen, este modelo es efectivo para explicar la utilidad y no es necesario incluir el descuento, ya que no aporta valor significativo.
Punto I:
# Graficar los residuos
par(mfrow=c(2, 2))
plot(modelo_final)
# Prueba de normalidad de los residuos
shapiro.test(resid(modelo_final))##
## Shapiro-Wilk normality test
##
## data: resid(modelo_final)
## W = 0.9656, p-value = 0.8473# Prueba de heterocedasticidad (Breusch-Pagan test)
bptest(modelo_final)##
## studentized Breusch-Pagan test
##
## data: modelo_final
## BP = 1.4208, df = 1, p-value = 0.2333En el análisis de los residuos del modelo, se realizaron dos pruebas estadísticas para evaluar su validez.
La prueba de normalidad de Shapiro-Wilk mostró un valor p de 0.8473, lo que indica que no hay evidencia suficiente para rechazar la hipótesis nula de que los residuos siguen una distribución normal. Esto sugiere que los residuos se ajustan adecuadamente a una distribución normal, cumpliendo con uno de los supuestos clave de la regresión.
Por otro lado, la prueba de Breusch-Pagan para detectar heterocedasticidad presentó un valor p de 0.2333, lo que indica que no existe evidencia significativa de heterocedasticidad. Esto significa que la variabilidad de los residuos es constante a lo largo de las predicciones, lo cual es otro supuesto fundamental que no se ve violado en el modelo.
En conjunto, estos resultados sugieren que el modelo no presenta problemas de normalidad ni de heterocedasticidad, lo que refuerza la validez de los supuestos del modelo de regresión y la calidad de los residuos.
Finalmente, al evaluar los supuestos del modelo de regresión (como la normalidad de los residuos y la homocedasticidad), los resultados sugirieron que los supuestos del modelo fueron razonablemente cumplidos, lo que valida la aplicación del modelo para hacer predicciones sobre la utilidad.
Punto 2
Base de datos
# Crear el data frame con los datos proporcionados
datos <- 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), # Tiempo en horas dedicado a la actividad deportiva
X1 = c(18, 18, 15, 18, 18, 18, 18, 15, 18, 19, 15, 15, 18, 18, 15, 15, 18, 19, 18, 18), # Cr?ditos matriculados
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), # Promedio acumulado
X3 = c(10, 15, 10, 5, 5, 0, 5, 10, 2, 2, 5, 5, 8, 8, 10, 8, 5, 5, 6, 10) # Tiempo dedicado al ocio
)Punto 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.
##A
# Ajustar el modelo de regresi?n lineal m?ltiple
modelo <- lm(Y ~ X1 + X2 + X3, data = datos)
# Ver el resumen del modelo
summary(modelo)##
## Call:
## lm(formula = Y ~ X1 + X2 + X3, data = datos)
##
## 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-05Punto b: 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?
Uno de los indicadores clave es el p-valor global del modelo (en este caso, el p-valor de la estadística F). En los resultados, el p-valor del F-statistic es 1.799e-05, que es mucho menor que 0.05. Esto indica que el modelo en su conjunto es estadísticamente significativo. En otras palabras, al menos una de las variables independientes (X1, X2, X3) tiene un efecto significativo sobre la variable dependiente Y. Este resultado sugiere que el modelo tiene una capacidad predictiva. Y que es explicado en un 75,75%.
Los resultados indican que tanto el número de créditos matriculados como el promedio acumulado juegan un papel importante en predecir el tiempo que un estudiante dedica a las actividades deportivas. Es decir, los estudiantes con una mayor carga académica o un mejor desempeño académico parecen dedicar más tiempo al deporte.
Por otro lado, el tiempo que se dedica al ocio no parece influir de manera significativa en el tiempo que se invierte en deportes. Esto sugiere que las actividades de ocio no son un factor clave cuando se trata de cuánto tiempo dedica un estudiante al deporte, al menos no de forma directa en este caso.
En resumen, los factores académicos, como la cantidad de créditos y el rendimiento académico, parecen ser más importantes para determinar el tiempo que los estudiantes dedican a las actividades deportivas que el tiempo que pasan en actividades de ocio.
Punto c: Ajuste un modelo de regresión lineal múltiple sin problemas de variables no significativas. Use \(\alpha\) = 0.05.
##C
# Ajustar el modelo sin X3 (si es no significativa)
modelo_simplificado <- lm(Y ~ X1 + X2, data = datos)
# Ver el resumen del modelo simplificado
summary(modelo_simplificado)##
## Call:
## lm(formula = Y ~ X1 + X2, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.9924 -0.9235 -0.1287 0.5982 2.9209
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 30.4194 3.6349 8.369 1.97e-07 ***
## X1 -0.9381 0.2276 -4.122 0.000712 ***
## X2 -2.7263 0.8610 -3.166 0.005642 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.284 on 17 degrees of freedom
## Multiple R-squared: 0.7634, Adjusted R-squared: 0.7356
## F-statistic: 27.43 on 2 and 17 DF, p-value: 4.772e-06En el análisis sobre el tiempo que los estudiantes dedican a actividades deportivas y su rendimiento académico, el Modelo 1 incluye tres variables: créditos matriculados, promedio acumulado y tiempo dedicado al ocio, mientras que el Modelo 2 elimina el tiempo dedicado al ocio, dado que esta variable no resultó significativa. Aunque el Modelo 2 presenta un R-cuadrado ligeramente más bajo (0.7634 frente a 0.7775) y el mismo error estándar residual, sigue siendo robusto, explicando un 76.34% de la variabilidad en el tiempo dedicado al deporte. La eliminación de la variable del ocio simplifica el modelo sin sacrificar mucho su capacidad predictiva, por lo que el Modelo 2 es una opción más eficiente y adecuada para el análisis.
Punto d: Evalúe todos los supuestos del modelo de regresión final encontrado
##D
# Graficar los residuos vs los valores ajustados
par(mfrow=c(1, 2))
plot(modelo_simplificado$fitted.values, modelo_simplificado$residuals,
main = "Residuos vs Valores ajustados",
xlab = "Valores ajustados",
ylab = "Residuos")
abline(h = 0, col = "red")
# Histograma de los residuos para evaluar normalidad
hist(modelo_simplificado$residuals, main = "Histograma de los residuos",
xlab = "Residuos")
# Graficar los residuos
par(mfrow=c(2, 2))
plot(modelo_final)
# Prueba de normalidad de los residuos
shapiro.test(resid(modelo_final))##
## Shapiro-Wilk normality test
##
## data: resid(modelo_final)
## W = 0.9656, p-value = 0.8473# Prueba de heterocedasticidad (Breusch-Pagan test)
bptest(modelo_final)##
## studentized Breusch-Pagan test
##
## data: modelo_final
## BP = 1.4208, df = 1, p-value = 0.2333# Comprobar la normalidad con la prueba de Shapiro-Wilk
shapiro.test(modelo_simplificado$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo_simplificado$residuals
## W = 0.96356, p-value = 0.6172bptest(modelo_simplificado)##
## studentized Breusch-Pagan test
##
## data: modelo_simplificado
## BP = 1.719, df = 2, p-value = 0.4234##E
# Predicci?n del tiempo de actividad deportiva para un estudiante promedio
prediccion <- predict(modelo_simplificado, newdata = data.frame(X1 = 18, X2 = 4.0))
prediccion## 1
## 2.629191El análisis del modelo de regresión muestra que los supuestos de normalidad y homocedasticidad se cumplen razonablemente bien. Aunque los gráficos de residuos sugieren ciertas desviaciones, las pruebas estadísticas de Shapiro-Wilk indican que los residuos siguen una distribución normal, y la prueba de Breusch-Pagan no muestra evidencia de heterocedasticidad. Además, no se identifican observaciones con una influencia significativa en el modelo. Si bien hay algunos indicios de patrones en los residuos, el modelo es estadísticamente válido
Punto e: 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.
El modelo de regresión lineal múltiple ajustado muestra que el tiempo que un estudiante dedica a actividades deportivas se ve significativamente influido por dos variables: el número de créditos matriculados y el promedio acumulado. En cambio, el tiempo dedicado al ocio no resultó ser estadísticamente significativo. Esto sugiere que, en el contexto de esta universidad, los estudiantes con un mayor número de créditos o mejor rendimiento académico tienden a dedicar más tiempo a la actividad deportiva. Esta relación es importante para el director de bienestar, ya que indica que el apoyo al rendimiento académico podría tener un impacto positivo en la participación de los estudiantes en actividades deportivas.
El modelo encontrado se puede utilizar para predecir el tiempo que un estudiante dedica semanalmente a actividades deportivas, siempre y cuando las variables involucradas (número de créditos y promedio acumulado) estén dentro del rango observado en los datos. Sin embargo, hay que tener precaución al extrapolar más allá de los valores disponibles en la muestra. Además, aunque el modelo presenta un ajuste adecuado, se podrían realizar mejoras en la evaluación de otros factores que puedan influir en la participación deportiva, como la motivación personal o el apoyo institucional, que no fueron considerados en este análisis.
Punto 3
Base de datos
# Crear el dataframe con los datos de la tabla
datos_PIB = data.frame(
Periodo = 2000:2012,
Azucar = c(199271.5, 186798.6, 210944.3, 220525.5, 228398.0, 223604.8, 201144.8, 189799.5, 169633.3, 216439.6, 173202.4, 194980.3, 183235.9),
Cemento_Gris = c(595277.5, 564625.0, 552714.8, 597365.5, 637159.6, 820783.8, 832349.1, 894934.8, 850502.3, 760221.4, 789116.9, 898069.2, 913096.8),
Lingotes_Acero = c(23871.7, 27632.3, 26238.4, 24320.6, 30025.3, 32048.3, 35501.5, 34372.9, 31329.9, 27247.1, 29277.9, 28955.3, 31328.4),
Produccion_Carbon = c(1535.8, 1617.1, 1295.3, 1836.9, 1978.1, 2163.9, 2369.4, 2468.8, 2602.5, 2547.3, 2514.9, 2687.9, 2887.2),
Vehiculos_Ensamblados = c(4213.7, 5243.3, 5719.7, 5058.0, 7471.3, 8906.4, 10748.3, 12891.1, 8460.0, 7365.1, 10292.8, 12474.1, 12052.6),
PIB = c(208531, 225851, 245323, 272345, 307762, 340156, 383898, 431072, 480087, 504647, 544924, 621615, 665765)
)Punto a: Estime un modelo de regresión lineal múltiple que permita predecir el PIB con base al resto de variables indicadas en la tabla
mod1PIB=lm(PIB~Azucar+Cemento_Gris+Lingotes_Acero+Produccion_Carbon+Vehiculos_Ensamblados,data=datos_PIB)
mod1PIB##
## Call:
## lm(formula = PIB ~ Azucar + Cemento_Gris + Lingotes_Acero + Produccion_Carbon +
## Vehiculos_Ensamblados, data = datos_PIB)
##
## Coefficients:
## (Intercept) Azucar Cemento_Gris
## 3.749e+05 -5.894e-01 -2.032e-01
## Lingotes_Acero Produccion_Carbon Vehiculos_Ensamblados
## -1.764e+01 2.626e+02 2.812e+01Punto b: Interprete cada uno de los coeficientes del modelo estimado en a).
Intercepto: 374.900. Representa el PIB estimado cuando todas las variables explicativas son cero. No tiene un significado práctico en este caso.
Producción de Azúcar: -0.5894: Esto sugiere que la producción de azucar disminuye el pib en un valor pequeño. Lo que sugiere que el sector azucarero tiene un efecto pequeño en el PIB, no obstante, esta generando perdidas pero no significativas.
Producción de Cemento Gris: −0.2032. Cada tonelada de cemento reduce el pib en 0.2032 unidades. Lo cual no es significativo, por lo que sugiere que no afecta a la economia y que no es un motor de la misma a pesar de ser usado en el sector de la construcción e infraestructura.
Producción de Lingotes de Acero: -17.64. Cada tonelada de acero reduce el pib en 17.64 unidades. Lo que sugeire que tiene un efecto negativo en la economia a pesar de ser un bien usado en la industria de construcción. Por lo que es un resultado inesperado y sorprendente que requiere mas estudio.
Producción de Carbón: 262.6. Cada tonelada adicional de carbón aumenta el PIB en 262.6 unidades monetarias. Lo cual sugiere al carbon como un producto importante para la economia colombiana que tiene sentido con el contexto nacional.
Producción de Vehículos Ensamblados: 28.12. Cada unidad adicional de vehículo ensamblado aumenta el PIB en 5.481 unidades monetarias. Lo que sugiere que el sector automovilistico tiene un efecto importante dentro de la economia del pais.
Punto c: Calcule el coeficiente de correlación múltiple e interprételo.
correlation_matrix = cor(datos_PIB[, -which(names(datos_PIB) == "Periodo")]);
corrplot(correlation_matrix,
method = "color", # Usa colores para la visualización
col = colorRampPalette(c("red", "white", "green"))(200), # Gradiente de colores rojo (negativo) a verde (positivo)
type = "upper", # Solo muestra la parte superior de la matriz (opcional)
tl.cex = 0.8, # Ajusta el tamaño de las etiquetas
addCoef.col = "black") # Agrega los coeficientes de correlación en negro
La matriz de correlación nos ayuda a entender cómo se relacionan las variables entre sí y con el PIB.
Variables con alta correlación positiva con el PIB:
Producción de Carbón (0.93):
Tiene la correlación más alta con el PIB.
Sugiere que a medida que la producción de carbón aumenta, el PIB también tiende a aumentar.
Cemento Gris (0.85):
También tiene una relación fuerte y positiva.
La producción de cemento gris parece estar estrechamente ligada al crecimiento económico.
Vehículos Ensamblados (0.80):
Alta correlación positiva con el PIB.
Un incremento en la producción de vehículos está relacionado con el aumento del PIB.
Lingotes de Acero (0.41):
Relación positiva pero más débil.
Su efecto en el PIB es menor comparado con otras industrias.
Variables con correlación negativa con el PIB
Azúcar (-0.47):
Relación negativa moderada.
Podría indicar que el crecimiento del PIB está asociado a una menor producción de azúcar o a cambios estructurales en la economía.
Relaciones entre Variables
Cemento Gris y Producción de Carbón (0.93): Muy correlacionadas, indicando que suelen crecer juntas.
Cemento Gris y Vehículos Ensamblados (0.92): También tienen una alta relación, lo que sugiere una posible conexión con el desarrollo industrial.
Producción de Carbón y Vehículos Ensamblados (0.83): Relación positiva fuerte, indicando que ambos sectores pueden impulsarse mutuamente.
Punto d y e: Calcule el coeficiente de determinación e interprételo. Pruebe la significancia de cada variable incluida en el modelo estimado en a). Use \(\alpha = 0.1\)
summary(mod1PIB)##
## Call:
## lm(formula = PIB ~ Azucar + Cemento_Gris + Lingotes_Acero + Produccion_Carbon +
## Vehiculos_Ensamblados, data = datos_PIB)
##
## Residuals:
## Min 1Q Median 3Q Max
## -54503 -8814 -1431 10551 68975
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.749e+05 2.185e+05 1.716 0.12982
## Azucar -5.894e-01 7.173e-01 -0.822 0.43832
## Cemento_Gris -2.032e-01 3.688e-01 -0.551 0.59881
## Lingotes_Acero -1.764e+01 5.952e+00 -2.964 0.02099 *
## Produccion_Carbon 2.626e+02 7.155e+01 3.670 0.00797 **
## Vehiculos_Ensamblados 2.812e+01 1.144e+01 2.459 0.04356 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 42920 on 7 degrees of freedom
## Multiple R-squared: 0.9537, Adjusted R-squared: 0.9207
## F-statistic: 28.85 on 5 and 7 DF, p-value: 0.0001567El coeficiente de determinación es de 0.9537 lo que quiere decir que el 95.37% de la variabilidad del PIB es explicada por las variables independientes incluidas en el modelo. No obstante, puede haber problemas de multicolinealidad (cuando algunas variables están muy correlacionadas entre sí) con el caso de producción de carbon y vehiculos ensamblados que es de 0.83. Ademas, usando un \(\alpha = 0.1\) de significancia, las variables lingotes de acero, producción de carbon y Vehiculos ensambladores son significativas para poder explicar el fenomeno dep PIB.
Punto f: Elimine las variables no significativas y construya un nuevo modelo para predecir el PIB.
mod2PIB=lm(PIB~Lingotes_Acero+Produccion_Carbon+Vehiculos_Ensamblados,data=datos_PIB)
mod2PIB##
## Call:
## lm(formula = PIB ~ Lingotes_Acero + Produccion_Carbon + Vehiculos_Ensamblados,
## data = datos_PIB)
##
## Coefficients:
## (Intercept) Lingotes_Acero Produccion_Carbon
## 220031.96 -19.03 239.06
## Vehiculos_Ensamblados
## 25.50summary((mod2PIB))##
## Call:
## lm(formula = PIB ~ Lingotes_Acero + Produccion_Carbon + Vehiculos_Ensamblados,
## data = datos_PIB)
##
## Residuals:
## Min 1Q Median 3Q Max
## -53892 -14545 -1196 18248 68988
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 220031.956 131494.596 1.673 0.128593
## Lingotes_Acero -19.025 5.267 -3.612 0.005640 **
## Produccion_Carbon 239.060 42.386 5.640 0.000318 ***
## Vehiculos_Ensamblados 25.497 9.029 2.824 0.019916 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 40260 on 9 degrees of freedom
## Multiple R-squared: 0.9476, Adjusted R-squared: 0.9302
## F-statistic: 54.28 on 3 and 9 DF, p-value: 4.357e-06par(mfrow=c(2, 2))
plot(mod2PIB)
# Prueba de normalidad de los residuos
shapiro.test(resid(mod2PIB))##
## Shapiro-Wilk normality test
##
## data: resid(mod2PIB)
## W = 0.96447, p-value = 0.8207# Prueba de heterocedasticidad (Breusch-Pagan test)
bptest(mod2PIB)##
## studentized Breusch-Pagan test
##
## data: mod2PIB
## BP = 4.5964, df = 3, p-value = 0.2039El modelo de regresión lineal múltiple propuesto es altamente significativo y tiene un buen ajuste, con una alta capacidad para explicar la variabilidad del PIB. Las variables Lingotes de Acero, Producción de Carbón y Vehículos Ensamblados muestran efectos significativos sobre el PIB, siendo la Producción de Carbón la que tiene el impacto más fuerte. Además, el modelo cumple con los supuestos de normalidad de los residuos y homocedasticidad, lo que refuerza la validez de las conclusiones extraídas del modelo. En general, este modelo es robusto y confiable para analizar la relación entre las variables propuestas y el PIB.
Punto 4
Importación de la BD
Para obtener la base de datos de precios de vehículos Renault en Colombia, se realizó web scraping en el portal Carroya para extraer información relevante sobre los autos en venta.
Descripción de la Base de Datos
La base de datos contiene las siguientes variables:
- precio: Precio de venta del vehículo en pesos colombianos.
- distancia: Kilometraje recorrido por el vehículo.
- fecha: Año del modelo del vehículo.
- modelo: Modelo del vehículo.
- ciudad: Ciudad donde se encuentra el vehículo en venta.
carros = read.csv("./BD Parcial 1/carros.csv", sep = ";");Conteo de Datos y Valores Nulos
Para realizar un análisis más profundo, primero se identificaron posibles problemas con los datos. Se analizó la cantidad de elementos, la presencia de valores nulos y las repeticiones en los datos, así como la cantidad de valores únicos por columna.
# Contar el número de filas y columnas
dim(carros)## [1] 6761 5# Contar valores nulos por columna
colSums(is.na(carros))## precio city distance year brand
## 0 0 0 0 0# Contar la cantidad de valores únicos en cada columna
sapply(carros, function(x) length(unique(x)))## precio city distance year brand
## 813 224 1959 51 38La base de datos contó con 6761 registros de autos Renault a lo largo de 53 años. Se pudo apreciar que no había datos vacíos en ninguna de las columnas (aunque no se verificó la presencia de valores en 0 o cadenas vacías). La variable de interés fue el precio, con 813 registros diferentes, seguida de las variables numéricas: año, con 51 valores distintos, y distancia, con 1959. Por último, se identificaron 38 modelos diferentes y 224 ciudades de interés.
EDA
Una vez codificada la nueva base de datos, se procedió a realizar un análisis exploratorio de datos (EDA).
Resumen Estadistico de las variables numéricas
summary(carros[, c("precio", "year", "distance")]) # Resumen estadístico## precio year distance
## Min. : 3500000 Min. :1972 Min. : 0
## 1st Qu.: 28500000 1st Qu.:2012 1st Qu.: 41200
## Median : 41000000 Median :2017 Median : 78000
## Mean : 43749600 Mean :2016 Mean : 94137
## 3rd Qu.: 55000000 3rd Qu.:2020 3rd Qu.: 122744
## Max. :200000000 Max. :2025 Max. :24000000par(mfrow = c(2, 3))
hist(carros$precio, col = "green", main = "Distribución del Precio", xlab = "Precio")
hist(carros$year, col = "skyblue", main = "Distribución del Año", xlab = "Año")
hist(carros$distance, col = "orange", main = "Distribución del Kilometraje", xlab = "Kilometraje")
boxplot(carros$precio, main = "Boxplot de precio", col = "green")
boxplot(carros$year, main = "Boxplot de Año", col = "skyblue")
boxplot(carros$distance, main = "Boxplot de Kilometraje", col = "orange")
Al analizar los gráficos de cajas, se observaron numerosos datos
atípicos en las diferentes variables. Estos valores atípicos se
eliminaron considerando:
- Distancia: Se filtraron valores atípicos, ya que los
autos con un alto kilometraje representan casos extremos.
- Precio: Se eliminaron datos atípicos, ya que algunos
vehículos podrían estar sobrevalorados por sus dueños.
remove_outliers <- function(data, columns) {
df_clean <- data # Copiar los datos originales
for (col in columns) {
Q1 <- quantile(df_clean[[col]], 0.25, na.rm = TRUE)
Q3 <- quantile(df_clean[[col]], 0.75, na.rm = TRUE)
IQR_value <- Q3 - Q1
# Definir límites para valores atípicos
lower_bound <- Q1 - 1.5 * IQR_value
upper_bound <- Q3 + 1.5 * IQR_value
# Filtrar datos eliminando los valores atípicos
df_clean <- df_clean[df_clean[[col]] >= lower_bound & df_clean[[col]] <= upper_bound, ]
}
return(df_clean)
}
# Uso de la función
columns_to_clean <- c("distance", "precio")
df_clean <- remove_outliers(carros, columns_to_clean)
# Contar el número de filas y columnas
dim(df_clean)## [1] 6499 5# Contar valores nulos por columna
colSums(is.na(df_clean))## precio city distance year brand
## 0 0 0 0 0# Contar la cantidad de valores únicos en cada columna
sapply(df_clean, function(x) length(unique(x)))## precio city distance year brand
## 735 221 1858 46 37La nueva base de datos quedó con 6499 registros.
# Para la variable 'precio' (asegúrate de que la variable dependa de algo, como un modelo de regresión)
boxcox_model = lm(precio ~ 1, data = df_clean) # Modelo simple con solo la constante
boxcox_result = boxcox(boxcox_model)
# Encuentra el mejor valor lambda
lambda = boxcox_result$x[which.max(boxcox_result$y)]
# Aplica la transformación Box-Cox
df_clean$precio_boxcox = (df_clean$precio^lambda - 1) / lambdasummary(df_clean[, c("year", "distance", "precio")]) # Resumen estadístico## year distance precio
## Min. :1972 Min. : 0 Min. : 3500000
## 1st Qu.:2012 1st Qu.: 42000 1st Qu.:28500000
## Median :2017 Median : 78000 Median :40500000
## Mean :2016 Mean : 84442 Mean :42473198
## 3rd Qu.:2020 3rd Qu.:121000 3rd Qu.:53500000
## Max. :2025 Max. :245000 Max. :94000000par(mfrow = c(2, 4))
hist(df_clean$year, col = "skyblue", main = "Distribución del Año", xlab = "Año")
hist(df_clean$precio, col = "green", main = "Distribución del Precio", xlab = "Precio")
hist(df_clean$distance, col = "orange", main = "Distribución del Kilometraje", xlab = "Kilometraje")
hist(df_clean$precio_boxcox, col = "lightgreen", main = "Distribución del Precio logaritmico", xlab = "log Precio")
boxplot(df_clean$year, main = "Boxplot de Año", col = "skyblue")
boxplot(df_clean$precio, main = "Boxplot de precio", col = "green")
boxplot(df_clean$distance, main = "Boxplot de Kilometraje", col = "orange")
boxplot(df_clean$precio_boxcox, main = "Boxplot de precio", col = "lightgreen")
Transformación de la BD
Como la base de datos contó con variables cualitativas no numéricas, se realizó una codificación binaria en la que las diferentes ciudades y marcas fueron representadas en bits. Debido a la gran cantidad de categorías, se optó por la codificación binaria en lugar de one-hot encoding, donde cada categoría distinta se transforma en su propia columna. Esto permitió reducir el número de variables, ya que las 220 ciudades pudieron representarse mediante cadenas de bits de tamaño 8 (es decir, 8 columnas) y las marcas mediante cadenas de tamaño 6 (6 columnas), obteniendo así 14 nuevas columnas.
# Función para convertir números a binario con longitud fija
to_binary <- function(x, bits) {
binary <- intToBits(x)[1:bits]
as.integer(rev(binary)) # Invierte el orden para tener la lectura binaria correcta
}
# Función para codificar múltiples columnas categóricas en binario
binary_encode <- function(df, cols) {
df <- as.data.table(df) # Asegurar que es data.table
binary_data <- list() # Lista para almacenar los resultados
for (col_name in cols) {
factor_col <- as.factor(df[[col_name]]) # Convertir a factor
labels <- as.integer(factor_col) - 1 # Convertir categorías a números empezando en 0
bits <- ceiling(log2(length(levels(factor_col)))) # Número de bits necesarios
# Matriz con los valores binarios de cada categoría
binary_matrix <- t(sapply(labels, to_binary, bits = bits))
colnames(binary_matrix) <- paste(col_name, 1:bits, sep = "_") # Nombres de columnas
binary_data[[col_name]] <- as.data.table(binary_matrix) # Guardar resultado
}
# Unir el dataframe original con las nuevas columnas codificadas
df_encoded <- cbind(df, do.call(cbind, binary_data))
return(df_encoded)
}
# Aplicar la codificación binaria a las columnas "city" y "brand"
carros_encoded <- binary_encode(df_clean, c("city", "brand"))
carros_encoded## precio city distance year brand precio_boxcox
## <int> <char> <int> <int> <char> <num>
## 1: 31000000 Bogota 135000 2016 Renault Sandero 3550.186
## 2: 40000000 Cali 102000 2019 Renault Logan 3955.884
## 3: 49990000 Bogota 109750 2017 Renault Duster 4348.539
## 4: 42000000 Bogota 45559 2021 Renault Sandero 4038.669
## 5: 89360000 Bogota 43265 2023 Renault Duster Oroch 5564.347
## ---
## 6495: 43500000 Bogota 74000 2017 Renault Stepway 4099.279
## 6496: 39500000 Envigado 40481 2018 Renault Logan 3934.817
## 6497: 38000000 Bogota 40000 2015 Renault Sandero 3870.680
## 6498: 23000000 Bogota 106000 2012 Renault Logan 3127.634
## 6499: 18000000 Bogota 135000 2005 Renault Megane II 2818.495
## city.city_1 city.city_2 city.city_3 city.city_4 city.city_5 city.city_6
## <int> <int> <int> <int> <int> <int>
## 1: 0 0 0 1 1 0
## 2: 0 0 1 0 0 1
## 3: 0 0 0 1 1 0
## 4: 0 0 0 1 1 0
## 5: 0 0 0 1 1 0
## ---
## 6495: 0 0 0 1 1 0
## 6496: 0 1 0 0 1 0
## 6497: 0 0 0 1 1 0
## 6498: 0 0 0 1 1 0
## 6499: 0 0 0 1 1 0
## city.city_7 city.city_8 brand.brand_1 brand.brand_2 brand.brand_3
## <int> <int> <int> <int> <int>
## 1: 1 1 0 1 1
## 2: 1 1 0 0 1
## 3: 1 1 0 0 0
## 4: 1 1 0 1 1
## 5: 1 1 0 0 0
## ---
## 6495: 1 1 0 1 1
## 6496: 0 1 0 0 1
## 6497: 1 1 0 1 1
## 6498: 1 1 0 0 1
## 6499: 1 1 0 0 1
## brand.brand_4 brand.brand_5 brand.brand_6
## <int> <int> <int>
## 1: 0 0 1
## 2: 1 0 1
## 3: 1 0 0
## 4: 0 0 1
## 5: 1 0 1
## ---
## 6495: 1 0 1
## 6496: 1 0 1
## 6497: 0 0 1
## 6498: 1 0 1
## 6499: 1 1 1Relación entre variables
par(mfrow = c(1, 2))
plot(carros_encoded$distance, carros_encoded$precio_boxcox,
col = "blue", pch = 16,
main = "Relación entre Distancia y Precio",
xlab = "Distancia", ylab = "Precio")
plot(carros_encoded$year, carros_encoded$precio_boxcox,
col = "red", pch = 16,
main = "Relación entre Año y Precio",
xlab = "Año", ylab = "Precio")
En las variables numéricas, observamos una relación en la que, a mayor distancia recorrida, menor es el precio. Por el contrario, en la variable del año, los autos más nuevos tienen un precio más alto que los más antiguos.
numeric_cols <- names(carros_encoded)[sapply(carros_encoded, is.numeric)]
df_numeric <- carros_encoded[, c(numeric_cols) , with = FALSE]
# Calcular la matriz de correlación
cor_matrix <- cor(df_numeric, use = "pairwise.complete.obs")
dev.new(width = 20, height = 20) # Abre una nueva ventana de mayor tamaño
corrplot(cor_matrix,
method = "color", # Usa colores para la visualización
col = colorRampPalette(c("red", "white", "green"))(200), # Gradiente de colores rojo (negativo) a verde (positivo)
type = "upper", # Solo muestra la parte superior de la matriz (opcional)
tl.cex = 0.8, # Ajusta el tamaño de las etiquetas
addCoef.col = "black",
number.cex = 0.5) # Agrega los coeficientes de correlación en negroCon la matriz de correlación de las variables, se observa que el precio tiene una correlación positiva con el año, como sugieren los gráficos, mientras que presenta una relación negativa con la distancia. Es decir, a mayor año, mayor será el precio, pero a mayor distancia, menor será el precio. Además, es importante destacar que las nuevas columnas definidas para la marca muestran una relación inversa moderada, lo que sugiere que las marcas también influyen en el precio de los vehículos.
Modelos de regresión Lineal
mod1=lm(precio_boxcox~distance+year+city.city_1+city.city_2+city.city_3+city.city_4+city.city_5+city.city_6+city.city_7+city.city_8+brand.brand_1+brand.brand_2+brand.brand_3+brand.brand_4+brand.brand_5+brand.brand_5++brand.brand_6,data=carros_encoded)
mod1##
## Call:
## lm(formula = precio_boxcox ~ distance + year + city.city_1 +
## city.city_2 + city.city_3 + city.city_4 + city.city_5 + city.city_6 +
## city.city_7 + city.city_8 + brand.brand_1 + brand.brand_2 +
## brand.brand_3 + brand.brand_4 + brand.brand_5 + brand.brand_5 +
## +brand.brand_6, data = carros_encoded)
##
## Coefficients:
## (Intercept) distance year city.city_1 city.city_2
## -1.693e+05 -2.485e-03 8.631e+01 3.325e+01 2.032e+01
## city.city_3 city.city_4 city.city_5 city.city_6 city.city_7
## -8.808e+00 9.291e+00 -5.414e+00 -4.477e-01 3.236e+00
## city.city_8 brand.brand_1 brand.brand_2 brand.brand_3 brand.brand_4
## 8.454e+00 -4.097e+02 1.442e+02 -2.737e+02 7.993e+01
## brand.brand_5 brand.brand_6
## -1.201e+02 -4.839e+02summary(mod1)##
## Call:
## lm(formula = precio_boxcox ~ distance + year + city.city_1 +
## city.city_2 + city.city_3 + city.city_4 + city.city_5 + city.city_6 +
## city.city_7 + city.city_8 + brand.brand_1 + brand.brand_2 +
## brand.brand_3 + brand.brand_4 + brand.brand_5 + brand.brand_5 +
## +brand.brand_6, data = carros_encoded)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1012.26 -174.45 -26.45 144.58 2364.30
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.693e+05 1.850e+03 -91.525 < 2e-16 ***
## distance -2.485e-03 9.299e-05 -26.728 < 2e-16 ***
## year 8.631e+01 9.135e-01 94.477 < 2e-16 ***
## city.city_1 3.325e+01 1.128e+01 2.947 0.00322 **
## city.city_2 2.032e+01 1.120e+01 1.815 0.06951 .
## city.city_3 -8.808e+00 1.330e+01 -0.663 0.50767
## city.city_4 9.291e+00 1.008e+01 0.922 0.35675
## city.city_5 -5.414e+00 1.070e+01 -0.506 0.61295
## city.city_6 -4.477e-01 1.213e+01 -0.037 0.97056
## city.city_7 3.236e+00 1.031e+01 0.314 0.75360
## city.city_8 8.454e+00 1.005e+01 0.841 0.40042
## brand.brand_1 -4.097e+02 2.042e+01 -20.060 < 2e-16 ***
## brand.brand_2 1.442e+02 1.013e+01 14.238 < 2e-16 ***
## brand.brand_3 -2.737e+02 1.061e+01 -25.808 < 2e-16 ***
## brand.brand_4 7.993e+01 9.870e+00 8.098 6.61e-16 ***
## brand.brand_5 -1.201e+02 1.088e+01 -11.043 < 2e-16 ***
## brand.brand_6 -4.839e+02 1.031e+01 -46.952 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 289.2 on 6482 degrees of freedom
## Multiple R-squared: 0.8509, Adjusted R-squared: 0.8505
## F-statistic: 2312 on 16 and 6482 DF, p-value: < 2.2e-16mod2=lm(precio_boxcox~distance+year+brand.brand_1+brand.brand_2+brand.brand_3+brand.brand_4+brand.brand_5+brand.brand_6,data=carros_encoded)
mod2##
## Call:
## lm(formula = precio_boxcox ~ distance + year + brand.brand_1 +
## brand.brand_2 + brand.brand_3 + brand.brand_4 + brand.brand_5 +
## brand.brand_6, data = carros_encoded)
##
## Coefficients:
## (Intercept) distance year brand.brand_1 brand.brand_2
## -1.694e+05 -2.473e-03 8.637e+01 -4.072e+02 1.441e+02
## brand.brand_3 brand.brand_4 brand.brand_5 brand.brand_6
## -2.743e+02 8.054e+01 -1.198e+02 -4.841e+02summary(mod2)##
## Call:
## lm(formula = precio_boxcox ~ distance + year + brand.brand_1 +
## brand.brand_2 + brand.brand_3 + brand.brand_4 + brand.brand_5 +
## brand.brand_6, data = carros_encoded)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1016.62 -173.64 -27.22 146.06 2361.65
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.694e+05 1.840e+03 -92.092 < 2e-16 ***
## distance -2.473e-03 9.256e-05 -26.716 < 2e-16 ***
## year 8.637e+01 9.086e-01 95.050 < 2e-16 ***
## brand.brand_1 -4.072e+02 2.043e+01 -19.937 < 2e-16 ***
## brand.brand_2 1.441e+02 1.013e+01 14.230 < 2e-16 ***
## brand.brand_3 -2.743e+02 1.060e+01 -25.864 < 2e-16 ***
## brand.brand_4 8.054e+01 9.869e+00 8.161 3.97e-16 ***
## brand.brand_5 -1.198e+02 1.088e+01 -11.015 < 2e-16 ***
## brand.brand_6 -4.841e+02 1.031e+01 -46.950 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 289.5 on 6490 degrees of freedom
## Multiple R-squared: 0.8504, Adjusted R-squared: 0.8503
## F-statistic: 4613 on 8 and 6490 DF, p-value: < 2.2e-16Interpretación de los coeficientes
Coeficientes clave
Intercept (-1.694e+05): Representa el precio estimado cuando todas las variables son 0. No tiene una interpretación práctica directa, ya que el año y otras variables no pueden ser 0.
Distance (-2.473e-03): Indica que, por cada kilómetro adicional, el precio disminuye manteniendo las demás variables constantes.
Year (8.637e+01): Sugiere que cada año más reciente aumenta el precio en.
Brand.brand_1 a Brand.brand_6: Representan ajustes en el precio dependiendo de la marca.
- Por ejemplo, Brand.brand_1 (-7.154e+06) sugiere que los vehículos de esta marca son, en promedio, 7.15M más baratos que la categoría base.
Evaluación del Modelo
par(mfrow = c(2, 2))
plot(mod2)
qqnorm(resid(mod2)) # Gráfico Q-Q de los residuos
qqline(resid(mod2), col = "red") # Línea de referencia
# Prueba de heterocedasticidad (Breusch-Pagan test)
bptest(mod2)##
## studentized Breusch-Pagan test
##
## data: mod2
## BP = 780.81, df = 8, p-value < 2.2e-16
- R² = 0.8504: Explica el 85.04% de la variabilidad en el precio.
- p-value < 2.2e-16: Indica que el modelo es estadísticamente significativo.
- Coeficientes altamente significativos (p-values bajos), lo que indica que las variables incluidas tienen un impacto real en el precio del vehículo.
El modelo de regresión presenta problemas de heterocedasticidad, falta de normalidad en los residuos y observaciones influyentes que pueden afectar su validez. La dispersión desigual de los residuos sugiere que la varianza no es constante, lo que impacta la precisión de los coeficientes. Además, los residuos no siguen una distribución normal, lo que puede afectar la interpretación estadística. También se identifican puntos con alta influencia en el modelo, lo que sugiere la necesidad de un análisis más profundo. Para mejorar el ajuste, es recomendable aplicar transformaciones a las variables, utilizar métodos robustos y evaluar el impacto de las observaciones influyentes antes de considerar el modelo como confiable.
Este análisis sugiere que el precio del vehículo depende significativamente del kilometraje, el año y la marca. Sin embargo, aún podríamos mejorar el modelo considerando interacciones o transformaciones de variables.
Potenciales Usos y Monetización del Modelo de Precios de Vehículos
1. Plataforma de Tasación Automática
Aplicación web donde los usuarios ingresan los datos de su vehículo y obtienen una estimación de su precio.
2. Asesoría para Compradores y Vendedores
Servicio de consultoría para calcular el precio justo de compra o venta de un vehículo.
3. Herramienta para Concesionarios y Financieras
Integración del modelo en plataformas de concesionarios y entidades financieras.
4. Análisis de Mercado para Aseguradoras
Cálculo de primas y valores de reposición basado en precios reales de mercado.
5. Optimización de Flotas de Empresas de Transporte
Evaluación del mejor momento para vender vehículos y reducir pérdidas por depreciación.
6. Integración con Marketplaces de Autos Usados
Implementación del modelo en plataformas como Carroya.