Parcial Estadistica
Santiago Villota - Gabriel Bejarano
2025-02-27
PRIMER PUNTO
Una empresa ha registrado las utilidades (Y) durante diez años de operación, también ha estimado la participación en el mercado (X1) y los descuentos concedidos(X2). Los siguientes son los datos registrados
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)
library(readxl)
Base_de_datos_Parcial <- read_excel("Base de datos Parcial.xlsx")library(ggplot2)
ggplot(Base_de_datos_Parcial, aes(x = X1, y = Y)) +
geom_point(color = "blue") +
geom_smooth(method = "lm", col = "red", se = FALSE) +
ggtitle("Utilidad vs Participacion en el mercado") +
xlab("Participacion en el mercado (%)") +
ylab("Utilidad (millones de $)") +
theme_minimal()
Interpretacion:
La línea roja la cual es la regresión lineal entre Utilidad y participación en el mercado, nos podemos dar cuenta que tiene una pendiente positiva, lo que indica que a mayor participación en el mercado , mayores utilizades.
ggplot(Base_de_datos_Parcial, aes(x = X2, y = Y)) +
geom_point(color = "green") +
geom_smooth(method = "lm", col = "red", se = FALSE) +
ggtitle("Utilidad vs Descuento concedido") +
xlab("Descuento concedido (%)") +
ylab("Utilidad (millones de $)") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
#### Interpretacion:
La regresion lineal tiene una pendiente muy baja, lo que indica que el descuento concedido tiene poca influencia en la utilizada, los puntos verdes estan muy alejados de linea de regresion lo que sugiera que el modelo no se ajusta con los datos
b. Estime un modelo de regresión lineal múltiple entre Y y X1 y X2
# Estimar el modelo de regresión lineal múltiple
modelo <- lm(Y ~ X1 + X2, data = Base_de_datos_Parcial)
# Mostrar el resumen del modelo
summary(modelo)##
## Call:
## lm(formula = Y ~ X1 + X2, data = Base_de_datos_Parcial)
##
## 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.02443Interpretación:
-Intercepto (240.133): Cuando X1=0 y X2=0, la utilidad esperada es 240.133 millones de dólares.
- Coeficiente de X1 (4.739): Por cada 1% adicional en la participación de mercado, la utilidad aumenta en 4.739 millones de dólares, manteniendo X2 constante. significa que la utilidad aumenta en 4.739 millones de dólares por cada 1% adicional de participación de mercado
- Coeficiente de X2 (-0.376): Por cada 1% adicional en el descuento concedido, la utilidad disminuye en 0.376 millones de dólares, manteniendo X1 constante. Indica que la utilidad disminuiría en 0.376 millones de dólares por cada 1% más de descuento concedido.
c. Interprete cada coeficiente del modelo encontrado en b.
Interpretación:
- El coeficiente de X1 es estadísticamente significativo (p = 0.00934): Hay evidencia suficiente para concluir que X1 tiene un efecto real sobre Y en la población y que no es solo producto del azar.
- El coeficiente de X2 no es significativo (p = 0.90519): Esto indica que no hay suficiente evidencia para afirmar que X2 influye en Y.En otras palabras, el descuento concedido no parece tener un impacto significativo en las utilidades en este modelo.
d. Evalúe la significancia del modelo propuesto en b, es decir pruebe que el modelo es lineal. Use alpha = 0.05.
Interpretación:
Si p-valor < 0.05 (con Alpha=0.05), se rechaza H0→ El modelo es significativo.
Si p-valor > 0.05, no se rechaza H0 → El modelo no explica significativamente Y
La hipótesis nula (H0) es que todos los coeficientes son 0, es decir, el modelo no es significativo.
La hipótesis alternativa (H1) es que al menos una variable explica la variabilidad de Y.
Como el p-valor = 0.02443 < 0.05, rechazamos H0 y concluimos que el modelo es estadísticamente significativo.
e.Evalúe la significancia de cada variable en el modelo propuesto en b. ¿Qué variable se debe eliminar? Use alpha = 0.05
Interpretación:
H0 (hipótesis nula): El coeficiente de la variable es igual a 0 (βi=0), es decir, la variable no tiene un efecto significativo en Y.
H1 (hipótesis alternativa): El coeficiente de la variable es diferente de 0 (βi≠0), es decir, la variable sí tiene un efecto significativo en Y.
Si p-valor < 0.05, la variable es significativa (se mantiene en el modelo).
Si p-valor ≥ 0.05, la variable no es significativa y debe eliminarse.
X1 es significativa (p=0.00934) por lo que debe permanecer en el modelo.
X2 no es significativa (p=0.90519), por lo que se debe eliminar del modelo
F. Obtenga el coeficiente de correlación múltiple e interprételo en el modelo propuesto en b
R2 <- summary(modelo)$r.squared
R <- sqrt(R2)
print(R) ## [1] 0.808546Interpretación:
Este valor indica que existe una fuerte relación entre la variable dependiente Y y las variables independientes X1 y X2. Aunque el modelo no es perfecto, sugiere que las variables explicativas están altamente correlacionadas con Y y pueden predecirlo con cierta precisión.Existe una fuerte relación porque R es alto (0.8086), lo que indica que el modelo de regresión capta bien la relación lineal entre Y y las variables explicativas
g. Obtenga el coeficiente de determinación R2 e interprételo en el modelo propuesto en b.
R2 <- summary(modelo)$r.squared
print(R2)## [1] 0.6537467Interpretación:
Significa que el 65.38% de la variabilidad en Y es explicada por X1 y X2. Indica que el modelo de regresión múltiple ajusta bien los datos, aunque aún hay un 34.62% de variabilidad que no es explicada por X1 y X2.
h. De acuerdo a lo encontrado en la pregunta e, obtenga el modelo de regresión lineal final.
modelo_final <- lm(Y ~ X1, data = Base_de_datos_Parcial)
summary(modelo_final)##
## Call:
## lm(formula = Y ~ X1, data = Base_de_datos_Parcial)
##
## 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.004675Interpretación:
- Cuando la participación en el mercado (X1) es 0%, la utilidad esperada es 234.588 millones de dólares.
- Por cada 1% de aumento en X1, la utilidad (Y) aumenta en 4.698 millones de dólares.
- Esto significa que hay suficiente evidencia para concluir que la variable tiene un efecto real en la variable dependiente y no es producto del azar.
i.Evalúe todos los supuestos del modelo de regresión final obtenido.
modelo_regresion <- lm(Y ~ X1 + X2, data = Base_de_datos_Parcial)
summary(modelo_regresion) ##
## Call:
## lm(formula = Y ~ X1 + X2, data = Base_de_datos_Parcial)
##
## 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.02443par(mfrow = c(2,2))
plot(modelo_regresion) 
par(mfrow = c(1,1))Interpretación:
Primer Grafico
Este gráfico evalúa la linealidad y homocedasticidad del modelo. Aquí, los residuos parecen mostrar una leve tendencia, lo que podría indicar que el modelo no captura bien la relación
Segundo Grafico
Verifica si los residuos siguen una distribución normal. En este caso, hay algunas desviaciones en los extremos, lo que sugiere posibles valores atípicos o una distribución no perfectamente normal.
Tercer Grafico
Mide la homocedasticidad (varianza constante de los residuos). Aquí se observa cierta variabilidad en la dispersión, lo que sugiere posible heterocedasticidad (varianza no constante).
Cuarto Grafico
Los puntos más alejados con alto apalancamiento pueden tener un impacto significativo en los coeficientes del modelo. Se observa que hay algunos valores en la zona de Cook’s Distance (es una medida utilizada en regresión para identificar observaciones influyentes, es decir, puntos de datos que tienen un gran impacto en los coeficientes del modelo), lo que indica la posible presencia de puntos influyentes.
El modelo de regresión parece tener algunas deficiencias en cuanto a la linealidad y normalidad de los residuos. También hay indicios de heterocedasticidad y la presencia de valores influyentes que podrían estar distorsionando la relación estimada entre la utilidad y las variables predictoras. Se recomienda revisar la transformación de variables, considerar modelos más flexibles o eliminar valores atípicos si hay justificación para hacerlo
library(car)## Cargando paquete requerido: carDatadurbinWatsonTest(modelo_final)## lag Autocorrelation D-W Statistic p-value
## 1 -0.3143226 2.386243 0.718
## Alternative hypothesis: rho != 0Interpretación:
La independencia de los residuos indica que las utilidades de la empresa (Y) no presentan patrones sistemáticos no explicados por las variables de participación en el mercado (X₁) y descuento concedido (X₂). Como el estadístico de Durbin-Watson es 2.386 y el p-valor es 0.71, no hay evidencia de autocorrelación en los residuos del modelo. Esto sugiere que los errores no siguen un patrón predecible y que el modelo de regresión captura bien la relación entre las variables, sin necesidad de incluir términos adicionales para corregir dependencia en los residuos.
shapiro.test(resid(modelo_final))##
## Shapiro-Wilk normality test
##
## data: resid(modelo_final)
## W = 0.9656, p-value = 0.8473Interpratción:
Hipótesis nula (H0): Los residuos siguen una distribución normal.
Hipótesis alternativa (H1) : Los residuos no siguen una distribución normal.
Dado que el p-valor (0.8473) es mayor que 0.05, no hay suficiente evidencia para rechazar la hipótesis nula de normalidad de los residuos. Esto sugiere que los errores del modelo están normalmente distribuidos, lo que valida el supuesto de normalidad en la regresión.
En términos prácticos, esto significa que el modelo de regresión lineal es adecuado para hacer predicciones y tomar decisiones basadas en los coeficientes obtenidos.
library(lmtest)## Cargando paquete requerido: zoo##
## Adjuntando el paquete: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericbptest(modelo_final)##
## studentized Breusch-Pagan test
##
## data: modelo_final
## BP = 1.4208, df = 1, p-value = 0.2333Interpretacion:
Dado que el p-valor (0.2333) es mayor que 0.05, no hay suficiente evidencia para rechazar la hipótesis nula de homocedasticidad. Esto significa que los residuos tienen varianza constante, lo cual es una buena señal, ya que sugiere que el modelo cumple con este supuesto clave de la regresión lineal.
SEGUNDO PUNTO
¿Cuánto tiempo por semana invierte un estudiante de una universidad local en alguna práctica deportiva? ¿El rendimiento académico afecta esta práctica? Para resolver estos interrogantes, el director de bienestar de esta universidad hace un seguimiento a una muestra aleatoria de 20 estudiantes escogidos de la jornada diurna. Se consideraron las siguientes variables: Y: Tiempo, en horas, que un estudiante realiza alguna actividad deportiva, X1: Numero de créditos matriculados por semestre, X2: Promedio acumulado, X3: tiempo, en horas que dedica al ocio.
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 X1 indicadas
Base_de_datos_Parcial_2 <- read_excel("Base de datos Parcial 2.xlsx")
head(Base_de_datos_Parcial_2)## # A tibble: 6 × 4
## Y X1 X2 X3
## <dbl> <dbl> <dbl> <dbl>
## 1 4 18 4.2 10
## 2 3 18 4 15
## 3 5.5 15 3.5 10
## 4 0 18 4.6 5
## 5 2 18 4.3 5
## 6 2 18 4 0modelo <- lm(Y ~ X1 + X2 + X3, data = Base_de_datos_Parcial_2)
summary(modelo)##
## Call:
## lm(formula = Y ~ X1 + X2 + X3, data = Base_de_datos_Parcial_2)
##
## 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-05Interpretación:
- Intercepto (28.16): Si X1, X2, X3, fueran 0, el tiempo estimado en actividades deportivas sería 28.16 horas.
- X1 (Créditos matriculados): Por cada crédito adicional matriculado, el tiempo en actividades deportivas disminuye en 0.92 horas (p<0.001, significativo).
- X2 (Promedio acumulado): Por cada unidad que aumenta el promedio acumulado, el tiempo dedicado al deporte disminuye en 2.39 horas (p=0.0195, significativo).
- X3 (Horas de ocio): No es significativo (p=0.33), lo que indica que el tiempo de ocio no influye fuertemente en el tiempo deportivo.
b. Evalúe la significancia general del modelo encontrado en a) y la significancia de cada variable Xi ¿Qué explicación le puede dar a este resultado?
Interpretación:
X1 (Créditos matriculados): Es altamente significativo (p < 0.001), lo que indica que el número de créditos influye fuertemente en la reducción del tiempo deportivo.
X2 (Promedio acumulado): También es significativo (p < 0.05), lo que sugiere que un mejor rendimiento académico se asocia con menos tiempo en actividades deportivas.
X3 (Horas de ocio): No es significativo (p = 0.33), lo que indica que el tiempo de ocio no tiene una relación clara con el tiempo dedicado al deporte
- Los estudiantes con más créditos matriculados tienen menos tiempo disponible, lo que reduce su participación en actividades deportivas.
- Los estudiantes con un mejor promedio académico pueden priorizar el estudio sobre el deporte.
c. Ajuste un modelo de regresión lineal múltiple sin problemas de variables no significativas. Use Alpha = 0.05
modelo_simplificado <- lm(Y ~ X1 + X2, data = Base_de_datos_Parcial_2)
summary(modelo_simplificado)##
## Call:
## lm(formula = Y ~ X1 + X2, data = Base_de_datos_Parcial_2)
##
## 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-06Interpretación:
- X1 (Créditos matriculados): Sigue siendo altamente significativo (p < 0.001). Más créditos matriculados se asocian con menos tiempo en actividades deportivas.
- X2 (Promedio acumulado): Aún significativo (p < 0.01), lo que indica que un mejor rendimiento académico también reduce el tiempo en actividades deportivas.
- El nuevo modelo mejorado confirma que el número de créditos matriculados y el promedio acumulado son factores clave para predecir el tiempo que un estudiante dedica a actividades deportivas.
- El tiempo de ocio no tenía un impacto significativo, por lo que fue eliminado sin afectar la calidad del modelo.
d. Evalúe todos los supuestos del modelo de regresión final encontrado
par(mfrow = c(2,2))
plot(modelo_simplificado) 
#### Interpretación:
Primer Grafico
Se observa una ligera tendencia curva y dispersión no uniforme en los residuos, lo que sugiere una posible relación no completamente lineal y presencia de heterocedasticidad
Segundo Grafico
Aunque la mayoría de los puntos siguen la línea de normalidad, hay desviaciones en los extremos, lo que indica que los residuos no son perfectamente normales y podría afectar la precisión del modelo.
Tercer Grafico
La dispersión de los residuos varía a lo largo de los valores ajustados, lo que refuerza la presencia de heterocedasticidad y sugiere problemas con la varianza constante de los errores.
Cuarto Grafico
Se identifican algunos valores influyentes (como el 80 y el 10), que podrían estar afectando la estabilidad del modelo, aunque no superan los umbrales críticos.
El modelo presenta algunas deficiencias en cuanto a la normalidad de los residuos y la homocedasticidad, lo que sugiere que la regresión lineal múltiple puede no ser completamente adecuada para este conjunto de datos. Existen indicios de valores atípicos e influyentes que podrían estar afectando la estabilidad del modelo. Se recomienda considerar transformaciones de variables o probar otros enfoques como modelos no lineales o técnicas robustas.
# Prueba de normalidad de los residuos (Shapiro-Wilk)
shapiro.test(residuals(modelo_simplificado))##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_simplificado)
## W = 0.96356, p-value = 0.6172Interpretación:
- Valor de W = 0.96356: Este valor indica qué tan cerca están los residuos de seguir una distribución normal (valores cercanos a 1 sugieren normalidad).
- p-value = 0.6172: Como el p-valor es mayor que 0.05, no hay suficiente evidencia para rechazar la hipótesis nula, que asume que los residuos siguen una distribución normal.
- Dado que los residuos parecen seguir una distribución normal, se cumple este supuesto de la regresión lineal. Esto significa que los intervalos de confianza y las pruebas de significancia de los coeficientes son válidos y confiables.
#Prueba de independencia de los residuos (Durbin-Watson)
library(car)
durbinWatsonTest(modelo_simplificado)## lag Autocorrelation D-W Statistic p-value
## 1 -0.2586315 2.357206 0.476
## Alternative hypothesis: rho != 0Interpretación:
Los resultados de la prueba de Durbin-Watson (D-W = 2.357, p = 0.488) indican que no hay autocorrelación significativa en los residuos, lo que sugiere que el supuesto de independencia de los errores se cumple. Esto es positivo, ya que implica que el modelo no presenta patrones sistemáticos en los residuos y sus estimaciones son confiables.
# Prueba de homocedasticidad (Breusch-Pagan)
library(lmtest)
bptest(modelo_simplificado)##
## studentized Breusch-Pagan test
##
## data: modelo_simplificado
## BP = 1.719, df = 2, p-value = 0.4234Interpretación:
La prueba de Breusch-Pagan (BP = 1.719, p = 0.4234) indica que no hay evidencia de heterocedasticidad en los residuos, ya que el p-valor es mayor a 0.05. Esto significa que la varianza de los errores es constante, cumpliendo con el supuesto de homocedasticidad, lo cual es fundamental para la validez de las inferencias del modelo de regresión.
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.
¿Cuánto tiempo por semana invierte un estudiante de una universidad local en alguna práctica deportiva?
Interpretación:
Según el modelo de regresión ajustado, el tiempo que un estudiante dedica a la práctica deportiva (Y) está influenciado significativamente por el número de créditos matriculados (X1) y el promedio acumulado (X2).
- Cada crédito matriculado reduce el tiempo dedicado a la actividad deportiva en 0.9381 horas.
- Cada punto adicional en el promedio acumulado reduce el tiempo en 2.7263 horas.
Conclusión: El tiempo semanal que un estudiante dedica a la práctica deportiva varía dependiendo de su carga académica y su rendimiento.
¿El rendimiento académico afecta esta práctica?
Interpretación:
- En el modelo final, el coeficiente de X2 (promedio acumulado) es negativo y significativo (p=0.005642).
-Esto indica que a mayor promedio acumulado, menos tiempo dedica el estudiante a la práctica deportiva
TERCER PUNTO
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.
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.
library(readxl)
Base_de_datos_Parcial_3 <- read_excel("C:/Users/Sanvi/Downloads/Base de datos Parcial 3.xlsx")modelo <- lm(`PIB a precios corrientes (Miles de millones de pesos)` ~
`Azúcar (Toneladas)` +
`Cemento Gris (Toneladas)` +
`Lingotes de acero (Toneladas)` +
`Producción de carbón (Toneladas)` +
`Vehículos ensamblados (Unidades)`, data=Base_de_datos_Parcial_3)
summary(modelo)##
## Call:
## lm(formula = `PIB a precios corrientes (Miles de millones de pesos)` ~
## `Azúcar (Toneladas)` + `Cemento Gris (Toneladas)` + `Lingotes de acero (Toneladas)` +
## `Producción de carbón (Toneladas)` + `Vehículos ensamblados (Unidades)`,
## data = Base_de_datos_Parcial_3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -54350 -11581 -933 9944 70161
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.643e+05 2.177e+05 1.674 0.13805
## `Azúcar (Toneladas)` -5.554e-01 7.209e-01 -0.770 0.46629
## `Cemento Gris (Toneladas)` -1.877e-01 3.675e-01 -0.511 0.62515
## `Lingotes de acero (Toneladas)` -1.780e+01 6.002e+00 -2.966 0.02092 *
## `Producción de carbón (Toneladas)` 2.616e+02 7.183e+01 3.642 0.00827 **
## `Vehículos ensamblados (Unidades)` 2.797e+01 1.148e+01 2.437 0.04494 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 43090 on 7 degrees of freedom
## Multiple R-squared: 0.9533, Adjusted R-squared: 0.92
## F-statistic: 28.6 on 5 and 7 DF, p-value: 0.0001611b. Interprete cada uno de los coeficientes del modelo estimado en a)
Interpretación:
Intercepto:
- Representa el valor estimado del PIB cuando todas las variables explicativas son cero.
- No tiene una interpretación económica relevante en este caso, pero indica el punto base del PIB.
Azúcar:
- Un aumento de 1 tonelada en la producción de azúcar reduce el PIB en 0.55 unidades (miles de millones de pesos). La producción de azúcar puede no estar directamente relacionada con el crecimiento económico del país o su efecto podría ser indirecto.
Cemento Gris:
- Un aumento de 1 tonelada en la producción de cemento gris reduce el PIB en 0.19 unidades. Aunque el cemento es clave para la construcción, su producción puede no reflejar directamente el crecimiento económico en el corto plazo.
Lingotes de acero:
- Un aumento de 1 tonelada en la producción de lingotes de acero reduce el PIB en 17.8 unidades. Aunque la producción de acero es importante, podría estar ligada a sectores menos productivos o a industrias con menor valor agregado en la economía.
Producción de carbón:
- Un aumento de 1 tonelada en la producción de carbón aumenta el PIB en 261.6 unidades. El carbón puede ser un sector clave de exportación y energía, contribuyendo significativamente al crecimiento económico.
Vehículos ensamblados:
- Un aumento de 1 unidad en la producción de vehículos ensamblados aumenta el PIB en 27.97 unidades. La industria automotriz es un sector con alto valor agregado, generando empleo y contribuyendo de manera positiva a la economía.
c. Calcule el coeficiente de correlación múltiple e interprételo.
modelo <- lm(`PIB a precios corrientes (Miles de millones de pesos)` ~
`Azúcar (Toneladas)` + `Cemento Gris (Toneladas)` +
`Lingotes de acero (Toneladas)` + `Producción de carbón (Toneladas)` +
`Vehículos ensamblados (Unidades)`,
data = Base_de_datos_Parcial_3)
R2 <- summary(modelo)$r.squared
R <- sqrt(R2)
cat("El coeficiente de correlación múltiple R es:", R, "\n")## El coeficiente de correlación múltiple R es: 0.976391Interpretación
- El coeficiente de correlación múltiple obtenido es R=0.976391, lo que indica una relación muy fuerte entre las variables predictoras (Azúcar, Cemento Gris, Lingotes de Acero, Producción de Carbón y Vehículos Ensamblados) y el PIB a precios corrientes.
- El valor de R está muy cerca de 1, lo que indica que existe una fuerte relación lineal entre el PIB y las variables explicativas.
d. Calcule el coeficiente de determinación e interprételo
modelo <- lm(`PIB a precios corrientes (Miles de millones de pesos)` ~
`Azúcar (Toneladas)` + `Cemento Gris (Toneladas)` +
`Lingotes de acero (Toneladas)` + `Producción de carbón (Toneladas)` +
`Vehículos ensamblados (Unidades)`,
data = Base_de_datos_Parcial_3)
summary(modelo)$r.squared## [1] 0.9533394Interpretación:
- Esto indica que el 95.33% de la variabilidad del PIB es explicada por las variables independientes del modelo.
- Solo un 4.67% de la variabilidad del PIB se debe a factores no considerados en el modelo (otras variables económicas, factores externos, etc.).
e. Pruebe la significancia de cada variable incluida en el modelo estimado en a). Use alpha 0.10
Interpretación:
- Si p-valor <0.10 La variable es significativa y contribuye a explicar el PIB.
- Si p-valor ≥0.10 La variable no es significativa y debería considerarse su eliminación.
Azúcar:
- Cada tonelada adicional de azúcar produciría una disminución de aproximadamente 0.5554 unidades en el PIB.
Cemento Gris:
- Cada tonelada adicional de cemento gris disminuiría el PIB en 0.1877 unidades.
Lingotes de acero:
- Cada tonelada adicional de lingotes de acero está asociada con una reducción de 17.80 unidades en el PIB. Esta variable es estadísticamente significativa y debe mantenerse en el modelo.
Producción de carbón:
- Cada tonelada adicional de carbón está asociada con un aumento de 261.6 unidades en el PIB. Es una variable altamente significativa en la predicción del PIB. Por lo que esta variable es clave y debe mantenerse en el modelo.
Vehículos ensamblados:
- Cada vehículo ensamblado adicional incrementa el PIB en 27.97 unidades. Esta variable es significativa y debe mantenerse en el modelo. El ensamblaje de vehículos tiene un efecto positivo y relevante en el PIB.
f. Elimine las variables no significativas y construya un nuevo modelo para predecir el PIB
modelo_nuevo <- lm(`PIB a precios corrientes (Miles de millones de pesos)` ~
`Lingotes de acero (Toneladas)` + `Producción de carbón (Toneladas)` +
`Vehículos ensamblados (Unidades)`,
data = Base_de_datos_Parcial_3)
summary(modelo_nuevo)##
## Call:
## lm(formula = `PIB a precios corrientes (Miles de millones de pesos)` ~
## `Lingotes de acero (Toneladas)` + `Producción de carbón (Toneladas)` +
## `Vehículos ensamblados (Unidades)`, data = Base_de_datos_Parcial_3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -54020 -13956 -677 18116 69856
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 220570.405 131029.645 1.683 0.126594
## `Lingotes de acero (Toneladas)` -19.141 5.270 -3.632 0.005468 **
## `Producción de carbón (Toneladas)` 239.330 42.116 5.683 0.000301 ***
## `Vehículos ensamblados (Unidades)` 25.723 9.051 2.842 0.019339 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 40140 on 9 degrees of freedom
## Multiple R-squared: 0.9479, Adjusted R-squared: 0.9306
## F-statistic: 54.63 on 3 and 9 DF, p-value: 4.242e-06Interpretación
Lingotes de acero:
- Su coeficiente es -19.141, lo que indica que un aumento en la producción de lingotes de acero se asocia con una leve reducción del PIB, manteniendo las demás variables constantes.
Producción de carbón:
- Su coeficiente es 239.330, lo que sugiere que cada tonelada adicional de carbón incrementa el PIB en 239.33 miles de millones de pesos.
Vehículos ensamblados:
Su coeficiente es 25.723, lo que indica que cada unidad adicional de vehículos ensamblados aumenta el PIB en 25.72 miles de millones de pesos.
Conclusión
- La Producción de carbón es la variable con mayor impacto positivo en el PIB.
- Los Lingotes de acero tienen un efecto negativo en el PIB, lo que puede deberse a factores externos, como costos de producción o exportaciones.
- Todas las variables en el modelo final son estadísticamente significativas, por lo que no es necesario eliminar más variables.
CUARTO PUNTO
Aplicación de Regresión Lineal Múltiple + WebScraping
library(readxl)
Kia_picanto <- read_excel("Kia picanto.xlsx")## New names:
## • `` -> `...6`
## • `` -> `...7`library(ggplot2)
ggplot(Kia_picanto, aes(x = Kilometros, y = Precio)) +
geom_point(color = "blue", alpha = 0.6) +
geom_smooth(method = "lm", color = "red") +
scale_x_continuous(breaks = seq(0, max(Kia_picanto$Kilometros, na.rm = TRUE), by = 50000),
labels = scales::comma) +
scale_y_continuous(breaks = seq(0, max(Kia_picanto$Precio, na.rm = TRUE), by = 10000000),
labels = scales::comma) +
labs(title = "Relacion entre Kilometros y Precio",
x = "Kilometros",
y = "Precio") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
#### Interpretación:
Tendencia negativa: La línea de regresión (en rojo) indica una relación inversa entre los kilómetros y el precio del vehículo. A medida que aumenta el kilometraje, el precio del vehículo tiende a disminuir.
Dispersión de los datos: Se observa una gran concentración de vehículos con bajo kilometraje y precios altos, pero también hay algunos puntos más alejados que indican vehículos con precios inusualmente altos o bajos para su kilometraje.
library(readxl)
Kia_picanto <- read_excel("Kia picanto.xlsx")## New names:
## • `` -> `...6`
## • `` -> `...7`View(Kia_picanto)library(ggplot2)
ggplot(Kia_picanto, aes(x = Modelo, y = Precio)) +
geom_point(color = "blue", alpha = 0.6) +
geom_smooth(method = "lm", color = "red", se = TRUE) +
scale_x_continuous(breaks = seq(min(Kia_picanto$Modelo, na.rm = TRUE), max(Kia_picanto$Modelo, na.rm = TRUE), by = 1)) +
scale_y_continuous(labels = scales::comma) +
labs(title = "Relacion entre Modelo y Precio",
x = "Modelo",
y = "Precio") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje X## `geom_smooth()` using formula = 'y ~ x'
Interpretación:
Tendencia positiva: La línea de regresión (en rojo) indica una relación directa y positiva entre el año del modelo y el precio del vehículo. Es decir, a medida que el modelo es más reciente, el precio tiende a ser más alto.
Dispersión de los datos: Aunque la tendencia es clara, hay cierta variabilidad en los precios de algunos modelos. Especialmente en los modelos más recientes (2020-2024), donde hay una mayor dispersión de precios.
Puntos atípicos: Se observan algunos valores anómalos, como un vehículo de modelo antiguo con un precio inusualmente alto y algunos modelos recientes con precios relativamente bajos
ggplot(Kia_picanto, aes(x = Antiguedad, y = Precio)) +
geom_point(color = "blue", alpha = 0.6) +
geom_smooth(method = "lm", color = "red") +
scale_x_continuous(breaks = seq(0, 20, by = 2), # Asegurar que llegue a 20
limits = c(0, 20),
labels = scales::comma) +
scale_y_continuous(labels = scales::comma) +
labs(title = "Relacion entre Antiguedad y Precio",
x = "Antiguedad",
y = "Precio") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Interpretacion:
Tendencia negativa: La línea de regresión (en rojo) indica una relación inversa y fuerte entre la antigüedad y el precio. Es decir, a mayor antigüedad del vehículo, menor es su precio.
Puntos atípicos: Se observa un vehículo con alta antigüedad y precio inusualmente alto, lo que podría indicar un caso especial (ej. baja cantidad de kilómetros o ediciones especiales).
c. Proponer un modelo de regresión lineal múltiple e interpretar los resultados (betas)
# Cargar librerías necesarias
library(ggplot2)
# Ajustar modelo de regresión múltiple
modelo <- lm(Precio ~ Kilometros + Modelo + Antiguedad, data = Kia_picanto)
# Resumen del modelo
summary(modelo)##
## Call:
## lm(formula = Precio ~ Kilometros + Modelo + Antiguedad, data = Kia_picanto)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12191622 -3151596 -613316 2597327 36968158
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4.701e+09 3.610e+08 -13.024 <2e-16 ***
## Kilometros 1.816e+01 1.166e+01 1.557 0.122
## Modelo 2.350e+06 1.785e+05 13.165 <2e-16 ***
## Antiguedad NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5686000 on 117 degrees of freedom
## Multiple R-squared: 0.7253, Adjusted R-squared: 0.7206
## F-statistic: 154.4 on 2 and 117 DF, p-value: < 2.2e-16Interpretación:
- Kilómetros (0.01816 millones = 18,160 pesos)
Sugiere que, en promedio, por cada kilómetro adicional, el precio aumenta en 18,160 pesos. Sin embargo, como el valor p = 0.122, esta variable no es estadísticamente significativa, es decir, no hay evidencia suficiente de que los kilómetros afecten el precio.
- Modelo (2.35 millones de pesos por año)
Por cada año más reciente, el precio del carro aumenta en 2.35 millones de pesos en promedio.
Como el valor p es menor que 0.05, esta variable sí tiene un efecto claro y significativo en el precio
library(caret)## Cargando paquete requerido: latticecontrol <- trainControl(method = "cv", number = 10)
modelo_cv <- train(Precio ~ Kilometros + Modelo,
data = Kia_picanto,
method = "lm",
trControl = control)
print(modelo_cv)## Linear Regression
##
## 120 samples
## 2 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 108, 109, 108, 108, 108, 108, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 5512223 0.7533274 4006362
##
## Tuning parameter 'intercept' was held constant at a value of TRUEInterpretacion:
R2=0.744
- Esto indica que el modelo explica el 74.4% de la variabilidad en el precio.
- Un valor cercano a 1 indica un mejor ajuste.
- Un R2 de 0.744 sugiere un buen ajuste del modelo, pero aún hay un 25.6% de variabilidad no explicada.
RMSE (Root Mean Squared Error) = 5,343,071
- Representa el error promedio en la predicción del precio. En este caso, el modelo tiene un error de aproximadamente 5.34 millones de pesos. Si el precio real de un Kia Picanto es 40 millones de pesos, el modelo podría predecir un valor entre 34.66 y 45.34 millones de pesos (considerando una desviación de ±5.34 millones).
MAE (Mean Absolute Error) = 3,956,455
- Indica la diferencia promedio absoluta entre los valores predichos y los valores reales del precio. Es otra medida de error del modelo y en este caso es de 3.96 millones de pesos. Esto significa que, en promedio, la diferencia absoluta entre el precio real y el precio predicho por el modelo es 3.96 millones de pesos.
Para un auto de 25 millones, el modelo podría dar valores entre 21.04 y 28.96 millones.
f. Discutir potenciales usos del modelo como herramienta practica (como monetizar los resultados de este modelo).
library(shiny)
ui <- fluidPage(
titlePanel("Estimador de Precio de Kia Picanto"),
sidebarLayout(
sidebarPanel(
numericInput("km", "Kilómetros recorridos:", value = 50000),
numericInput("modelo", "Año del modelo:", value = 2020),
actionButton("calcular", "Calcular Precio")
),
mainPanel(
textOutput("precio_estimado")
)
)
)
server <- function(input, output) {
modelo <- lm(Precio ~ Kilometros + Modelo, data = Kia_picanto)
precio <- eventReactive(input$calcular, {
nuevo_auto <- data.frame(Kilometros = input$km, Modelo = input$modelo)
predict(modelo, newdata = nuevo_auto)
})
output$precio_estimado <- renderText({
paste("El precio estimado del auto es:", round(precio(), 2), "COP")
})
}
shinyApp(ui = ui, server = server)Shiny applications not supported in static R Markdown documents