parcial 1

while (!is.null(dev.list())) {
  dev.off()
}

require(ggplot2)        # Para gráficos

## Cargando paquete requerido: ggplot2

library(gridExtra)      # Para organizar múltiples gráficos
library(readxl)         # Para leer archivos Excel

Primer Punto

a)

parcial1 <- read_excel("C:/Users/David Rivera/OneDrive/Documents/Imágenes/Escritorio/parcial1.xlsx")

matriz_cor <- cor(parcial1)
cor_utilidad_descuento <- round(matriz_cor["utilidad", "descuento"], 3)
cor_utilidad_mercado   <- round(matriz_cor["utilidad", "mercado"], 3)

Gráfico: Utilidad vs Descuento

g1 = ggplot(parcial1, aes(x = descuento, y = utilidad)) +
  geom_point() +
  theme_bw() +
  geom_smooth(method = "lm") +
  ggtitle(paste("Utilidad vs Descuento\nCorrelación =", cor_utilidad_descuento))

print(g1)

Gráfico: Utilidad vs Mercado

g2 = ggplot(parcial1, aes(x = mercado, y = utilidad)) +
  geom_point() +
  theme_bw() +
  geom_smooth(method = "lm") +
  ggtitle(paste("Utilidad vs Mercado\nCorrelación =", cor_utilidad_mercado))

print(g2)

## `geom_smooth()` using formula = 'y ~ x'

print(cor(parcial1))

##            utilidad   mercado descuento
## utilidad  1.0000000 0.8080794 0.1736866
## mercado   0.8080794 1.0000000 0.2478642
## descuento 0.1736866 0.2478642 1.0000000

grid.arrange(g1, g2, nrow = 1)

b)

# Modelo: utilidad = β0 + β1*(descuento) + β2*(mercado) + error
modelo1 <- lm(utilidad ~ descuento + mercado, data = parcial1)

summary(modelo1)

## 
## Call:
## lm(formula = utilidad ~ descuento + mercado, data = parcial1)
## 
## 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 **
## descuento     -0.376      3.045  -0.123  0.90519   
## mercado        4.739      1.335   3.551  0.00934 **
## ---
## 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

c)

• Intercepto (β₀ = 240.1330):
  Este coeficiente representa la utilidad estimada cuando descuento y mercado son 0. Aunque en la práctica no es realista tener 0% descuento y 0% participación de mercado, este valor sirve como punto de referencia para el modelo.

• Coeficiente de descuento (β₁ = -0.3760):
  Este valor indica que, manteniendo constante la participación en el mercado, un incremento de 1 unidad en la variable descuento se asocia con una disminución de 0.376 unidades en la utilidad. Sin embargo, su p-valor (0.905) es muy alto, lo que significa que este coeficiente no es estadísticamente significativo al nivel de significancia 0.05.

• Coeficiente de mercado (β₂ = 4.7390):
  Este coeficiente sugiere que, manteniendo constante el descuento, un incremento de 1 unidad en la participación en el mercado se asocia con un aumento de 4.739 unidades en la utilidad. Su p-valor (0.009) es menor a 0.05, lo que indica que es estadísticamente significativo y que esta variable tiene un impacto relevante en la utilidad.

d)

summary(modelo1)

## 
## Call:
## lm(formula = utilidad ~ descuento + mercado, data = parcial1)
## 
## 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 **
## descuento     -0.376      3.045  -0.123  0.90519   
## mercado        4.739      1.335   3.551  0.00934 **
## ---
## 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

Analisis

El modelo completo es globalmente significativo (es lineal) si la prueba F arroja un p-valor menor que 0.05 (por ejemplo, 0.02443), lo que rechaza la hipótesis de que ninguno de los predictores tiene efecto sobre Y.

e)

summary(modelo1)

## 
## Call:
## lm(formula = utilidad ~ descuento + mercado, data = parcial1)
## 
## 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 **
## descuento     -0.376      3.045  -0.123  0.90519   
## mercado        4.739      1.335   3.551  0.00934 **
## ---
## 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

# Supongamos que 'descuento' no es significativa (p > 0.05),
# se ajusta un nuevo modelo eliminando 'descuento':
modelo2 <- lm(utilidad ~ mercado, data = parcial1)
summary(modelo2)

## 
## Call:
## lm(formula = utilidad ~ mercado, data = parcial1)
## 
## 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 ***
## mercado        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.004675

Analisis

Entre las variables incluidas, “mercado” es significativa (p = 0.00934) y “descuento” no lo es (p = 0.90519); por ello, se debe eliminar “descuento” del modelo final.

Si p-valor < 0.05, la variable se considera estadísticamente significativa y debe permanecer en el modelo.

Si p-valor ≥ 0.05, la variable no es significativa y se recomienda eliminarla del modelo.

f)

R_mult <- sqrt(summary(modelo1)$r.squared)
print(paste("Coeficiente de correlación múltiple:", round(R_mult, 3)))

## [1] "Coeficiente de correlación múltiple: 0.809"

Analisis

El coeficiente de correlación múltiple (R) es aproximadamente 0.8086, lo que indica que existe una relación lineal. Entre las variables en juego. Por esto se puede predecir con mas exactitud.

g)

R2 <- summary(modelo1)$r.squared
print(paste("Coeficiente de determinación R^2:", round(R2, 3)))

## [1] "Coeficiente de determinación R^2: 0.654"

Analisis

Nos indica que las variables X1 y X2 explican aproximadamente el 65.38% de la variación total observada en Y. Esto quiere decir que, en el contexto del modelo, dos tercios de la variabilidad en Y se atribuye a las variaciones en X1 y X2. Mientras que al resto no se le puede atribuir que le afecte.

h)

mod2 <- lm(utilidad ~ mercado, data = parcial1)
summary(modelo2)

## 
## Call:
## lm(formula = utilidad ~ mercado, data = parcial1)
## 
## 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 ***
## mercado        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.004675

Intercepto (234.588):
Este valor indica que, en ausencia de participación en el mercado, se espera que la utilidad sea de 234.588 millones de dólares.

Coeficiente de la variable de participación:
Por cada incremento de 1 punto porcentual en la participación en el mercado, la utilidad aumenta en 4.698 millones de dólares.

Evidencia estadística:
Dado que el p-valor es menor a 0.05, se confirma que el efecto de la participación en el mercado sobre la utilidad es real y no se debe al azar.

i)

# Configurar la ventana gráfica para mostrar 4 gráficos
par(mfrow = c(2, 2))

# Generar los gráficos de diagnóstico del modelo final (mod2)
plot(modelo2)

• Grafico Residuos vs Valores ajustados: En el gráfico se observa una ligera tendencia de los residuos que podría indicar que el modelo no captura perfectamente la relación lineal o que existe alguna estructura no modelada. Aun así, si la tendencia es leve, el impacto en la calidad del ajuste puede ser moderado.

• Grafico Q-Q: Algunos puntos se desvían en los extremos, lo que sugiere valores potencialmente atípicos o una distribución no perfectamente normal. Sin embargo, si la mayoría de los puntos se alinean razonablemente con la diagonal, se considera que el supuesto de normalidad no se viola de manera grave.

• Grafico Scale-Location : Si la dispersión de los residuos no es uniforme, puede existir heterocedasticidad. En la gráfica, se ve cierta variabilidad en la dispersión.

• Resisous Vs Leverage : Si algún punto se ubica muy alejado de los demás y supera las líneas de Cook’s Distance, se considera influyente. En la imagen, se ven puntos numerados, pero no todos sobrepasan de forma marcada estas líneas.

Segundo Punto

a)

require(ggplot2)
library(gridExtra)

df2 <- 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)
)

# =========================================
modelo_ini <- lm(Y ~ X1 + X2 + X3, data = df2)

# Mostrar resultados del modelo completo
summary(modelo_ini)

## 
## Call:
## lm(formula = Y ~ X1 + X2 + X3, data = df2)
## 
## 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-05

Este proceso permite no solo cuantificar la relación entre las variables, sino también utilizar el modelo para hacer predicciones, siempre y cuando se verifiquen los supuestos de linealidad, independencia, homocedasticidad y normalidad de los residuos.

b)

• Intercepto (28.16): Indica que, en ausencia de créditos, de promedio y de horas de ocio, el tiempo estimado en actividades deportivas sería de 28.16 horas.

• Créditos matriculados (X1): Por cada crédito adicional, el tiempo dedicado a actividades deportivas disminuye en 0.92 horas (p < 0.001). Esto es altamente significativo y sugiere que un mayor número de créditos reduce el tiempo disponible para el deporte.

• Promedio acumulado (X2): Por cada unidad de aumento en el promedio acumulado, el tiempo deportivo disminuye en 2.39 horas (p = 0.0195). Este resultado es significativo y se interpreta como que los estudiantes con mejor rendimiento académico dedican menos tiempo al deporte.

• Horas de ocio (X3): No es significativa (p = 0.33), lo que indica que el tiempo de ocio no tiene una influencia clara sobre el tiempo dedicado a actividades deportivas.

c)

modelo_final <- lm(Y ~ X1 + X2, data = df2)
summary(modelo_final)

## 
## Call:
## lm(formula = Y ~ X1 + X2, data = df2)
## 
## 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-06

Analisis

Al analizar el modelo completo, se observó que una de las variables (por ejemplo, las horas de ocio) no es estadísticamente significativa (p-valor ≥ 0.05), lo que indica que no aporta información relevante para explicar la variabilidad en el tiempo dedicado a actividades deportivas. Dado que nuestro nivel de significancia es 0.05, se decide eliminar esta variable.

En consecuencia, se ajusta un nuevo modelo que solo incluye las variables que demostraron ser significativas (como el número de créditos matriculados y el promedio acumulado). Esto produce un modelo más parsimonioso, en el que cada predictor incluido tiene un efecto comprobado sobre la variable respuesta. Con este modelo final, se espera una mejor interpretación y predicción, ya que se reduce el “ruido” introducido por variables que no influyen significativamente.

En resumen, al eliminar la variable no significativa, se optimiza el modelo para que únicamente considere aquellos factores que realmente afectan el tiempo dedicado al deporte, lo que mejora la precisión y la claridad de las conclusiones extraídas.

d)

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

Analisis

• Residuals vs Fitted: La línea de suavizado es casi horizontal y no se aprecian patrones claros, lo que indica linealidad y varianza aproximadamente constante.

• Q-Q Residuals: Los puntos siguen de cerca la diagonal, sugiriendo que los residuos se distribuyen de forma normal.

• Scale-Location: La dispersión se mantiene estable, reforzando la homocedasticidad (varianza constante de los residuos).

• Residuals vs Leverage: No hay puntos que sobrepasen los límites de Cook’s distance de forma marcada, por lo que no se detectan observaciones influyentes extremas.

Tercer Punto

a) Modelo de regresion lineal multiple

library(readxl)
datos <- read_excel("C:/Users/David Rivera/Downloads/PIB_Datos.xlsx", sheet = "PIB")

head(datos)

## # A tibble: 6 × 7
##   Periodo `Azucar (Toneladas)` `Cemento Gris (Toneladas)` Lingotes de Acero (T…¹
##     <dbl>                <dbl>                      <dbl>                  <dbl>
## 1    2000              199272.                    595278.                 23872.
## 2    2001              186797.                    564625                  27632.
## 3    2002              210944.                    552715.                 26238.
## 4    2003              220526.                    597366.                 24321.
## 5    2004              228398                     637160.                 30025.
## 6    2005              223605.                    820784.                 32048.
## # ℹ abbreviated name: ¹​`Lingotes de Acero (Toneladas)`
## # ℹ 3 more variables: `Produccion de Carbón (Toneladas)` <dbl>,
## #   `Vehiculos Ensamblados (Unidades)` <dbl>,
## #   `PIB (Miles de Millones de Pesos)` <dbl>

colnames(datos)

## [1] "Periodo"                          "Azucar (Toneladas)"              
## [3] "Cemento Gris (Toneladas)"         "Lingotes de Acero (Toneladas)"   
## [5] "Produccion de Carbón (Toneladas)" "Vehiculos Ensamblados (Unidades)"
## [7] "PIB (Miles de Millones de Pesos)"

colnames(datos) <- c("PIB", "Azucar", "Cemento", "Acero", "Carbon", "Vehiculos")

modelo <- lm(PIB ~ Azucar + Cemento + Acero + Carbon + Vehiculos, data = datos)

summary(modelo)

## 
## Call:
## lm(formula = PIB ~ Azucar + Cemento + Acero + Carbon + Vehiculos, 
##     data = datos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.1792 -0.6252 -0.1323  0.4416  2.0639 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.999e+03  5.917e+00 337.919 5.25e-16 ***
## Azucar      -4.924e-07  1.960e-05  -0.025  0.98066    
## Cemento     -8.022e-06  9.989e-06  -0.803  0.44835    
## Acero       -3.242e-04  1.632e-04  -1.987  0.08726 .  
## Carbon       7.526e-03  1.953e-03   3.854  0.00626 ** 
## Vehiculos    6.671e-04  3.120e-04   2.138  0.06985 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.171 on 7 degrees of freedom
## Multiple R-squared:  0.9472, Adjusted R-squared:  0.9095 
## F-statistic: 25.13 on 5 and 7 DF,  p-value: 0.0002461

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

b) Interpretacion

Cada coeficiente representa el cambio esperado en el PIB (en miles de millones de pesos) cuando la variable correspondiente aumenta en una unidad, manteniendo constantes las demás variables.

1. Intercepto (1.999e+03)

• Representa el valor estimado del PIB cuando todas las variables explicativas son cero.

• En este caso, si no hubiera producción de azúcar, cemento, acero, carbón ni ensamblaje de vehículos, el PIB sería 1999 miles de millones de pesos.

2. Producción de Azúcar (-4.924e-07)

• Indica que por cada tonelada adicional de producción de azúcar, el PIB disminuiría en aproximadamente 492.4 pesos.

• P-valor = 0.98066 → Este coeficiente no es estadísticamente significativo, por lo que no se puede concluir que la producción de azúcar afecte al PIB.

3. Producción de Cemento (-8.022e-06)

• Indica que por cada tonelada adicional de producción de cemento, el PIB disminuiría en aproximadamente 8,022 pesos.

• P-valor = 0.44835 → No es estadísticamente significativo, por lo que no se puede afirmar que la producción de cemento tenga un impacto real en el PIB.

4. Producción de Lingotes de Acero (-3.242e-04)

• Indica que por cada tonelada adicional de producción de acero, el PIB disminuiría en aproximadamente 324,200 pesos.

• P-valor = 0.08726 → Es marginalmente significativo al 10%, lo que sugiere que podría haber una relación negativa con el PIB, pero no es concluyente.

5. Producción de Carbón (7.526e-03)

• Indica que por cada tonelada adicional de producción de carbón, el PIB aumentaría en aproximadamente 7.526 millones de pesos.

• P-valor = 0.00626 → Altamente significativo (p < 0.01), lo que indica que la producción de carbón tiene un impacto positivo y relevante en el PIB.

6. Vehículos Ensamblados (6.671e-04)

• Indica que por cada unidad adicional de vehículos ensamblados, el PIB aumentaría en aproximadamente 667,100 pesos.

• P-valor = 0.06985 → Es moderadamente significativo al 10%, lo que sugiere que el ensamblaje de vehículos podría tener un impacto positivo en el PIB.

¿Cómo interpretar el p-valor?

El p-valor se compara con un nivel de significancia (), que normalmente se fija en 0.05 (5%) o 0.01 (1%). Su interpretación es la siguiente:

• p-valor < 0.01 (muy significativo): Hay una evidencia fuerte de que la variable influye en el PIB.

• p-valor < 0.05 (significativo): Hay una relación estadísticamente significativa entre la variable y el PIB.

• p-valor < 0.10 (marginalmente significativo): Puede haber una relación, pero no es concluyente.

• p-valor > 0.10 (no significativo): No hay suficiente evidencia para afirmar que la variable afecta al PIB.

c) Coeficiente de correlacion multiple

R2 <- summary(modelo)$r.squared
R <- sqrt(R2)
#Mostrar el resultado
cat("El coeficiente de correlacion multiple (R) es:", R, "\n")

## El coeficiente de correlacion multiple (R) es: 0.9732543

R = √0.9472 = 0.9733

El coeficiente de correlación múltiple () indica qué tan fuerte es la relación entre el PIB y las variables independientes (Azúcar, Cemento, Acero, Carbón y Vehículos ensamblados).

• Como R = 0. 9733 está cercano a 1, significa que existe una relación muy fuerte y positiva entre el PIB y las variables explicativas.

• En términos simples, el modelo tiene un buen ajuste y las variables predicen bien el PIB.

d) Coeficiente de determinacion

# Ajustar el modelo de regresión
modelo <- lm(PIB ~ Azucar + Cemento + Acero + Carbon + Vehiculos, data = datos)

R2 <- summary(modelo)$r.squared
cat("El coeficiente de determinacion (R^2) es:", R2, "\n")

## El coeficiente de determinacion (R^2) es: 0.9472239

El coeficiente de determinación (R^2) nos dice qué tan bien el modelo de regresión logra explicar la variabilidad del PIB a partir de las variables utilizadas (producción de azúcar, cemento, acero, carbón y ensamblaje de vehículos).

En este caso, el valor de R^2 es 0.9472, lo que significa que el 94.72% de los cambios en el PIB pueden ser explicados por estas variables.

Esto indica que el modelo tiene un buen nivel de ajuste, ya que la mayor parte de la variación en el PIB se debe a los factores incluidos en el análisis. Sin embargo, hay un pequeño porcentaje (5.28%) que no es explicado por el modelo, lo que sugiere que existen otros factores influyendo en el PIB que no han sido considerados en esta regresión.

e) Significancia de cada variable

Para probar la significancia estadística de cada variable en el modelo estimado, utilizamos los valores p (-valores) obtenidos en la regresión y los comparamos con el nivel de significancia dado .

Criterio de decisión:

• Si p-valor es menor o igual a alfa (0.10) → La variable es significativa y tiene un efecto estadísticamente relevante en el PIB.

• Si p-valor es mayor a alfa (0.10) → No hay suficiente evidencia para decir que la variable afecta significativamente el PIB.

Resultados de la prueba

Variable	p-valor	¿Es significativa?
Producción de azúcar	0.98066	❌ No significativa
Producción de cemento	0.44835	❌ No significativa
Producción de acero	0.08726	✅ Sí, marginalmente significativa
Producción de carbón	0.00626	✅ Sí, altamente significativa
Vehículos ensamblados	0.06985	✅ Sí, moderadamente significativa

Conclusiones

• La producción de carbón y el ensamblaje de vehículos son estadísticamente significativos, lo que indica que influyen de manera importante en el PIB.

• El acero tiene una relación marginalmente significativa, lo que sugiere un posible impacto en el PIB, pero con menor certeza.

• El azúcar y el cemento no tienen un efecto significativo en el PIB, por lo que no se puede concluir que afectan su variación de manera relevante.

f) Nuevo modelo

# Modelo inicial con todas las variables
modelo_inicial <- lm(PIB ~ Azucar + Cemento + Acero + Carbon + Vehiculos, data = datos)

summary(modelo_inicial)

## 
## Call:
## lm(formula = PIB ~ Azucar + Cemento + Acero + Carbon + Vehiculos, 
##     data = datos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.1792 -0.6252 -0.1323  0.4416  2.0639 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.999e+03  5.917e+00 337.919 5.25e-16 ***
## Azucar      -4.924e-07  1.960e-05  -0.025  0.98066    
## Cemento     -8.022e-06  9.989e-06  -0.803  0.44835    
## Acero       -3.242e-04  1.632e-04  -1.987  0.08726 .  
## Carbon       7.526e-03  1.953e-03   3.854  0.00626 ** 
## Vehiculos    6.671e-04  3.120e-04   2.138  0.06985 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.171 on 7 degrees of freedom
## Multiple R-squared:  0.9472, Adjusted R-squared:  0.9095 
## F-statistic: 25.13 on 5 and 7 DF,  p-value: 0.0002461

# Construcción del nuevo modelo eliminando las variables no significativas (Azúcar y Cemento)
modelo_final <- lm(PIB ~ Acero + Carbon + Vehiculos, data = datos)

summary(modelo_final)

## 
## Call:
## lm(formula = PIB ~ Acero + Carbon + Vehiculos, data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.55853 -0.39177 -0.03995  0.44493  2.02147 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.998e+03  3.524e+00 567.020  < 2e-16 ***
## Acero       -3.665e-04  1.417e-04  -2.585 0.029441 *  
## Carbon       6.315e-03  1.133e-03   5.575 0.000345 ***
## Vehiculos    5.352e-04  2.434e-04   2.198 0.055486 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.08 on 9 degrees of freedom
## Multiple R-squared:  0.9424, Adjusted R-squared:  0.9231 
## F-statistic: 49.05 on 3 and 9 DF,  p-value: 6.693e-06

• Después de eliminar las variables no significativas, se obtuvo un modelo más eficiente y preciso para predecir el PIB, evitando sobreajuste.

• Este nuevo modelo resalta la importancia del carbón, acero y los vehículos ensamblados como factores clave en la economía analizada.

Cuarto Punto

b) Relaciones

Precio vs Kilometros

library(readxl)
library(ggplot2)

datos <- read_excel("C:/Users/David Rivera/Downloads/kia picanto cali.xlsx")
colnames(datos)

## [1] "web-scraper-order"     "web-scraper-start-url" "precio"               
## [4] "kilometros"            "modelo"                "antiguedad"

# Gráfico de dispersión: precio vs kilometros
ggplot(datos, aes(x = kilometros, y = precio)) +
  geom_point(color = "blue") +  # Puntos en azul
  geom_smooth(method = "lm", se = FALSE, color = "red") +
  labs(title = "Relacion entre Precio y Kilometros",
       x = "Kilometros",
       y = "Precio (COP)") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Precio vs Modelo

library(readxl)
library(ggplot2)

datos <- read_excel("C:/Users/David Rivera/Downloads/kia picanto cali.xlsx")

colnames(datos)

## [1] "web-scraper-order"     "web-scraper-start-url" "precio"               
## [4] "kilometros"            "modelo"                "antiguedad"

# Gráfico de dispersión: precio vs modelo
ggplot(datos, aes(x = modelo, y = precio)) +
  geom_point(color = "purple") +  # Puntos en azul
  geom_smooth(method = "lm", se = FALSE, color = "red") +
  labs(title = "Relacion entre Precio y Modelo",
       x = "Modelo",
       y = "Precio (COP)") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Precio vs Antiguedad

library(readxl)
library(ggplot2)

datos <- read_excel("C:/Users/David Rivera/Downloads/kia picanto cali.xlsx")

colnames(datos)

## [1] "web-scraper-order"     "web-scraper-start-url" "precio"               
## [4] "kilometros"            "modelo"                "antiguedad"

# Calcular la antigüedad del vehículo (año actual - modelo)
datos$antiguedad <- 2024 - datos$modelo  # Ajustar según el año actual

# Gráfico de dispersión: precio vs antigüedad
ggplot(datos, aes(x = antiguedad, y = precio)) +
  geom_point(color = "green") +  # Puntos en azul
  geom_smooth(method = "lm", se = FALSE, color = "red") +
  labs(title = "Relacion entre Precio y Antiguedad",
       x = "Antiguedad (anos)",
       y = "Precio (COP)") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

c) Modelo de regresion lineal

library(readxl)

datos <- read_excel("C:/Users/David Rivera/Downloads/kia picanto cali.xlsx")

colnames(datos)

## [1] "web-scraper-order"     "web-scraper-start-url" "precio"               
## [4] "kilometros"            "modelo"                "antiguedad"

summary(datos$antiguedad)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   3.000   6.000   6.483   8.000  20.000

table(datos$antiguedad)

## 
##  1  2  3  4  5  6  7  8  9 10 12 13 14 15 16 17 18 20 
##  3 16 16  5 18 15 13  9  6  3  1  1  4  3  2  2  2  1

# Crear modelo de regresión lineal múltiple con las tres variables
modelo <- lm(precio ~ kilometros + modelo + antiguedad, data = datos)

# Mostrar resumen del modelo
summary(modelo)

## 
## Call:
## lm(formula = precio ~ kilometros + modelo + antiguedad, data = datos)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -17172821         0         0         0  17172821 
## 
## Coefficients: (1 not defined because of singularities)
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -5.627e+09  1.161e+09  -4.847 0.000129 ***
## kilometros100.000 Km  7.566e+06  1.335e+07   0.567 0.577801    
## kilometros105.000 Km  1.193e+06  9.379e+06   0.127 0.900219    
## kilometros11.000 Km   4.961e+05  8.836e+06   0.056 0.955844    
## kilometros11.150 Km  -1.308e+06  1.021e+07  -0.128 0.899540    
## kilometros111.000 Km  1.155e+05  1.026e+07   0.011 0.991142    
## kilometros113.700 Km  2.654e+06  9.703e+06   0.274 0.787537    
## kilometros116.000 Km  1.158e+07  1.170e+07   0.989 0.335632    
## kilometros12.590 Km  -4.318e+06  1.021e+07  -0.423 0.677500    
## kilometros122.000 Km -5.269e+06  1.045e+07  -0.504 0.620341    
## kilometros13.000 Km  -3.058e+06  8.850e+06  -0.346 0.733723    
## kilometros130.000 Km -7.670e+04  1.034e+07  -0.007 0.994164    
## kilometros132.000 Km  3.466e+05  1.076e+07   0.032 0.974667    
## kilometros132.500 Km  1.000e+07  1.264e+07   0.791 0.439027    
## kilometros14.000 Km   8.692e+06  1.021e+07   0.851 0.405943    
## kilometros14.700 Km   3.884e+06  1.026e+07   0.379 0.709473    
## kilometros146.000 Km  4.193e+06  1.231e+07   0.341 0.737262    
## kilometros149.000 Km  5.135e+06  1.086e+07   0.473 0.641905    
## kilometros150.000 Km -1.461e+06  1.059e+07  -0.138 0.891833    
## kilometros16.000 Km   2.400e+06  1.020e+07   0.235 0.816599    
## kilometros16.200 Km   1.019e+07  1.021e+07   0.998 0.331570    
## kilometros160.000 Km  9.001e+06  1.264e+07   0.712 0.485441    
## kilometros165.000 Km  7.193e+06  1.231e+07   0.584 0.566152    
## kilometros17.000 Km  -4.000e+06  1.020e+07  -0.392 0.699487    
## kilometros170.000 Km  4.385e+06  1.200e+07   0.366 0.718923    
## kilometros186.000 Km  9.309e+06  1.298e+07   0.717 0.482637    
## kilometros192.000 Km  2.637e+07  1.009e+07   2.613 0.017610 *  
## kilometros2.800 Km    5.884e+06  1.026e+07   0.573 0.573465    
## kilometros20.000 Km   6.922e+05  1.021e+07   0.068 0.946713    
## kilometros20.850 Km   1.892e+06  1.021e+07   0.185 0.855098    
## kilometros200.000 Km  6.385e+06  1.200e+07   0.532 0.601002    
## kilometros22.000 Km   2.308e+06  1.021e+07   0.226 0.823793    
## kilometros23.445 Km   2.500e+06  1.020e+07   0.245 0.809114    
## kilometros24.990 Km   2.000e+05  1.020e+07   0.020 0.984569    
## kilometros243.000 Km  1.573e+07  1.412e+07   1.114 0.279729    
## kilometros25.000 Km   1.492e+07  1.034e+07   1.443 0.166215    
## kilometros25.300 Km  -7.808e+06  1.021e+07  -0.764 0.454524    
## kilometros250.000 Km -2.692e+06  1.021e+07  -0.264 0.795095    
## kilometros26.000 Km  -6.922e+05  8.346e+06  -0.083 0.934815    
## kilometros28.000 Km   1.500e+06  1.020e+07   0.147 0.884696    
## kilometros28.900 Km   9.816e+06  1.026e+07   0.956 0.351508    
## kilometros29.000 Km   1.223e+06  1.034e+07   0.118 0.907155    
## kilometros29.500 Km   3.116e+06  1.026e+07   0.304 0.764922    
## kilometros30.000 Km   1.162e+06  8.108e+06   0.143 0.887667    
## kilometros30.878 Km   8.823e+06  1.034e+07   0.853 0.404799    
## kilometros32.000 Km   1.150e+06  8.832e+06   0.130 0.897841    
## kilometros32.300 Km  -3.308e+06  1.021e+07  -0.324 0.749787    
## kilometros33.000 Km   3.923e+06  1.034e+07   0.379 0.708870    
## kilometros33.500 Km   7.116e+06  1.026e+07   0.693 0.496931    
## kilometros33.700 Km   5.731e+06  1.045e+07   0.548 0.590251    
## kilometros34.000 Km  -3.000e+06  1.020e+07  -0.294 0.771986    
## kilometros34.700 Km   2.500e+06  1.020e+07   0.245 0.809114    
## kilometros35.500 Km   8.731e+06  1.045e+07   0.835 0.414527    
## kilometros35.698 Km   1.312e+07  1.026e+07   1.278 0.217475    
## kilometros36.000 Km   2.692e+06  1.021e+07   0.264 0.795095    
## kilometros38.000 Km  -6.116e+06  1.026e+07  -0.596 0.558647    
## kilometros39.916 Km   4.039e+06  1.059e+07   0.381 0.707495    
## kilometros41.000 Km   5.100e+06  8.832e+06   0.577 0.570775    
## kilometros42.000 Km   1.116e+06  1.026e+07   0.109 0.914642    
## kilometros45.000 Km   1.022e+07  1.034e+07   0.988 0.336013    
## kilometros47.000 Km   5.116e+06  1.026e+07   0.498 0.624184    
## kilometros48.800 Km  -5.484e+06  1.026e+07  -0.534 0.599585    
## kilometros494.761 Km  2.481e+07  1.298e+07   1.911 0.072117 .  
## kilometros5.000 Km    1.922e+05  1.021e+07   0.019 0.985191    
## kilometros50.000 Km   6.170e+06  8.712e+06   0.708 0.487896    
## kilometros50.018 Km   6.623e+06  1.034e+07   0.640 0.529976    
## kilometros50.755 Km   6.116e+06  1.026e+07   0.596 0.558647    
## kilometros51.000 Km   5.116e+06  1.026e+07   0.498 0.624184    
## kilometros51.700 Km   7.116e+06  1.026e+07   0.693 0.496931    
## kilometros51.921 Km   5.116e+06  1.026e+07   0.498 0.624184    
## kilometros52.000 Km   1.122e+07  1.034e+07   1.085 0.292161    
## kilometros54.000 Km   4.531e+06  1.045e+07   0.433 0.669831    
## kilometros55.000 Km  -3.500e+06  1.020e+07  -0.343 0.735417    
## kilometros56.151 Km   6.916e+06  1.026e+07   0.674 0.508952    
## kilometros56.300 Km   1.500e+06  1.020e+07   0.147 0.884696    
## kilometros57.000 Km   2.731e+06  9.125e+06   0.299 0.768151    
## kilometros59.600 Km   2.039e+06  1.059e+07   0.192 0.849546    
## kilometros6.000 Km    6.922e+05  1.021e+07   0.068 0.946713    
## kilometros6.400 Km    3.192e+06  1.021e+07   0.313 0.758226    
## kilometros60.300 Km   1.039e+06  1.059e+07   0.098 0.922971    
## kilometros61.400 Km   1.631e+06  1.045e+07   0.156 0.877743    
## kilometros62.000 Km   1.392e+07  1.034e+07   1.346 0.194933    
## kilometros64.000 Km   2.116e+06  1.026e+07   0.206 0.838991    
## kilometros65.000 Km   4.923e+06  1.034e+07   0.476 0.639776    
## kilometros65.300 Km  -5.692e+06  1.021e+07  -0.557 0.584189    
## kilometros65.387 Km   7.311e+05  1.045e+07   0.070 0.945015    
## kilometros67.000 Km   3.443e+06  9.379e+06   0.367 0.717854    
## kilometros68.100 Km  -9.612e+05  1.059e+07  -0.091 0.928712    
## kilometros70.900 Km   5.631e+06  1.045e+07   0.539 0.596701    
## kilometros75.000 Km  -6.922e+05  1.021e+07  -0.068 0.946713    
## kilometros78.600 Km   1.847e+06  1.076e+07   0.172 0.865703    
## kilometros79.000 Km   9.233e+05  1.034e+07   0.089 0.929850    
## kilometros81.000 Km   7.770e+06  1.143e+07   0.680 0.505375    
## kilometros81.300 Km  -2.769e+06  1.045e+07  -0.265 0.794105    
## kilometros86.000 Km   2.231e+06  1.045e+07   0.213 0.833389    
## kilometros89.000 Km   1.539e+06  1.059e+07   0.145 0.886126    
## kilometros91.000 Km   2.247e+06  1.076e+07   0.209 0.837015    
## kilometros93.500 Km   7.347e+06  1.076e+07   0.683 0.503602    
## kilometros96.000 Km   3.931e+06  1.045e+07   0.376 0.711267    
## kilometros97.600 Km   3.231e+06  9.125e+06   0.354 0.727395    
## kilometros98.000 Km   3.466e+05  1.076e+07   0.032 0.974667    
## modelo                2.808e+06  5.741e+05   4.890 0.000118 ***
## antiguedad                   NA         NA      NA       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7211000 on 18 degrees of freedom
## Multiple R-squared:  0.932,  Adjusted R-squared:  0.5505 
## F-statistic: 2.443 on 101 and 18 DF,  p-value: 0.01676

• El único coeficiente con significancia estadística (p < 0.05) es el de 192,000 km, lo que sugiere que este valor específico de kilometraje tiene una relación clara con el precio.

• La gran mayoría de los coeficientes tienen valores de p mayores a 0.05, lo que indica que no se pueden considerar significativos para predecir el precio del vehículo con confianza.

• Además, hay una observación con 494,761 km con un valor p cercano a 0.05 (p = 0.072), lo que indica que podría tener cierta influencia, aunque no con un alto nivel de confianza.

d) Validacion cruzada

library(caret)

## Warning: package 'caret' was built under R version 4.4.3

## Cargando paquete requerido: lattice

## Warning: package 'lattice' was built under R version 4.4.3

control <- trainControl(method = "cv", number = 10)

modelo_cv <- train(precio ~ kilometros + modelo + antiguedad, 
                   data = datos, 
                   method = "lm", 
                   trControl = 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
## 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

print(modelo_cv)

## Linear Regression 
## 
## 120 samples
##   3 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 108, 107, 108, 108, 108, 108, ... 
## Resampling results:
## 
##   RMSE     Rsquared   MAE    
##   8044532  0.6811696  5637311
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

• El R² de 0.655 sugiere que el modelo tiene una capacidad predictiva moderada, pero todavía deja un 34.5% de la variabilidad sin explicar.

• El RMSE (error cuadratico medio) y MAE (error absoluto medio) son bastante altos, lo que sugiere que las predicciones del modelo pueden tener una gran desviación respecto a los valores reales.

• Puede haber colinealidad o variables importantes faltantes que mejorarían el ajuste del modelo.

e) Monetizar resultados

Posibles Aplicaciones Prácticas

Plataforma de Valuación de Vehículos Usados

• Se podría integrar en una aplicación web donde los usuarios ingresen el kilometraje de su auto y obtengan un precio estimado.

• Monetización: Cobro por consulta, suscripción mensual o publicidad de concesionarios.

Herramienta para Concesionarios y Vendedores

• Ayudar a concesionarios o vendedores independientes a determinar precios justos de vehículos usados.

• Monetización: Venta de reportes de valuación o integración con plataformas de compra/venta.

Uso en Aseguradoras y Empresas Financieras

• Utilizarlo para determinar el valor de un vehículo antes de ofrecer financiamiento o seguros.

• Monetización: Venta de acceso al modelo para valuaciones en aseguradoras o bancos.

Análisis de Mercado para Empresas Automotrices

• Identificar tendencias en la depreciación de los autos con base en kilometraje.

• Monetización: Venta de informes de mercado a fabricantes y concesionarios.

Conclusión

El modelo tiene potencial para ser utilizado en múltiples industrias, aunque su precisión aún podría mejorarse. La monetización podría lograrse mediante suscripciones, venta de datos y servicios de valuación.