df_bicis <- read.csv("/Users/maxgomez/Desktop/Inteligencia artifiial con impacgto empresarial/Modulo 2/rentadebicis.csv")
El dataset tiene 10886 registros horarios de bicicletas rentadas en Washington D.C. (2011-2012).
dim(df_bicis)
## [1] 10886 14
summary(df_bicis)
## hora dia mes año
## Min. : 0.00 Min. : 1.000 Min. : 1.000 Min. :2011
## 1st Qu.: 6.00 1st Qu.: 5.000 1st Qu.: 4.000 1st Qu.:2011
## Median :12.00 Median :10.000 Median : 7.000 Median :2012
## Mean :11.54 Mean : 9.993 Mean : 6.521 Mean :2012
## 3rd Qu.:18.00 3rd Qu.:15.000 3rd Qu.:10.000 3rd Qu.:2012
## Max. :23.00 Max. :19.000 Max. :12.000 Max. :2012
## estacion dia_de_la_semana asueto temperatura
## Min. :1.000 Min. :1.000 Min. :0.00000 Min. : 0.82
## 1st Qu.:2.000 1st Qu.:2.000 1st Qu.:0.00000 1st Qu.:13.94
## Median :3.000 Median :4.000 Median :0.00000 Median :20.50
## Mean :2.507 Mean :4.014 Mean :0.02857 Mean :20.23
## 3rd Qu.:4.000 3rd Qu.:6.000 3rd Qu.:0.00000 3rd Qu.:26.24
## Max. :4.000 Max. :7.000 Max. :1.00000 Max. :41.00
## sensacion_termica humedad velocidad_del_viento
## Min. : 0.76 Min. : 0.00 Min. : 0.000
## 1st Qu.:16.66 1st Qu.: 47.00 1st Qu.: 7.002
## Median :24.24 Median : 62.00 Median :12.998
## Mean :23.66 Mean : 61.89 Mean :12.799
## 3rd Qu.:31.06 3rd Qu.: 77.00 3rd Qu.:16.998
## Max. :45.45 Max. :100.00 Max. :56.997
## rentas_de_no_registrados rentas_de_registrados rentas_totales
## Min. : 0.00 Min. : 0.0 Min. : 1.0
## 1st Qu.: 4.00 1st Qu.: 36.0 1st Qu.: 42.0
## Median : 17.00 Median :118.0 Median :145.0
## Mean : 36.02 Mean :155.6 Mean :191.6
## 3rd Qu.: 49.00 3rd Qu.:222.0 3rd Qu.:284.0
## Max. :367.00 Max. :886.0 Max. :977.0
par(mfrow = c(2, 2))
hist(df_bicis$rentas_totales, main = "Distribución de Rentas",
xlab = "Rentas/hora", col = "steelblue", border = "white")
boxplot(rentas_totales ~ hora, data = df_bicis,
main = "Rentas por Hora", xlab = "Hora",
col = "lightblue", outline = FALSE)
boxplot(rentas_totales ~ estacion, data = df_bicis,
main = "Rentas por Estación (1=Inv 2=Pri 3=Ver 4=Oto)",
col = c("lightblue","lightgreen","orange","#D2691E"), outline = FALSE)
plot(df_bicis$temperatura, df_bicis$rentas_totales,
main = "Rentas vs Temperatura", xlab = "Temperatura (°C)",
pch = 16, col = rgb(0,0,1,0.05), cex = 0.5)
abline(lm(rentas_totales ~ temperatura, data = df_bicis), col = "red", lwd = 2)
par(mfrow = c(1, 1))
modelo_rentas <- lm(
rentas_totales ~ factor(año) + factor(mes) + factor(dia_de_la_semana) +
factor(estacion) + factor(asueto) + hora + temperatura +
sensacion_termica + humedad + velocidad_del_viento,
data = df_bicis
)
summary(modelo_rentas)
##
## Call:
## lm(formula = rentas_totales ~ factor(año) + factor(mes) + factor(dia_de_la_semana) +
## factor(estacion) + factor(asueto) + hora + temperatura +
## sensacion_termica + humedad + velocidad_del_viento, data = df_bicis)
##
## Residuals:
## Min 1Q Median 3Q Max
## -315.79 -92.50 -28.29 62.31 638.37
##
## Coefficients: (3 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -18.2422 9.9738 -1.829 0.06743 .
## factor(año)2012 79.8969 2.7241 29.330 < 2e-16 ***
## factor(mes)2 1.6390 6.7292 0.244 0.80757
## factor(mes)3 1.9201 7.0905 0.271 0.78655
## factor(mes)4 11.0544 7.4639 1.481 0.13862
## factor(mes)5 36.3281 8.4762 4.286 1.84e-05 ***
## factor(mes)6 -1.6233 9.4744 -0.171 0.86396
## factor(mes)7 -42.6339 10.5437 -4.044 5.30e-05 ***
## factor(mes)8 -23.4853 10.3602 -2.267 0.02342 *
## factor(mes)9 28.8823 9.3024 3.105 0.00191 **
## factor(mes)10 64.2679 8.0888 7.945 2.13e-15 ***
## factor(mes)11 64.7177 6.9918 9.256 < 2e-16 ***
## factor(mes)12 75.8967 6.9850 10.866 < 2e-16 ***
## factor(dia_de_la_semana)2 1.0962 5.2211 0.210 0.83370
## factor(dia_de_la_semana)3 4.7493 5.1805 0.917 0.35928
## factor(dia_de_la_semana)4 1.6280 5.2171 0.312 0.75500
## factor(dia_de_la_semana)5 10.9849 5.1948 2.115 0.03449 *
## factor(dia_de_la_semana)6 13.6028 5.1874 2.622 0.00875 **
## factor(dia_de_la_semana)7 -2.9014 5.1885 -0.559 0.57603
## factor(estacion)2 NA NA NA NA
## factor(estacion)3 NA NA NA NA
## factor(estacion)4 NA NA NA NA
## factor(asueto)1 -7.0055 8.6479 -0.810 0.41791
## hora 7.3057 0.2100 34.788 < 2e-16 ***
## temperatura 6.9825 1.1610 6.014 1.87e-09 ***
## sensacion_termica 2.1737 0.9801 2.218 0.02659 *
## humedad -2.1459 0.0816 -26.298 < 2e-16 ***
## velocidad_del_viento 0.2656 0.1818 1.461 0.14416
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 140.2 on 10861 degrees of freedom
## Multiple R-squared: 0.4022, Adjusted R-squared: 0.4009
## F-statistic: 304.4 on 24 and 10861 DF, p-value: < 2.2e-16
Hay tres razones:
1. Dataset muy grande — con 10886 observaciones, hasta efectos mínimos resultan estadísticamente “significativos”. El p-value depende tanto del efecto como del tamaño de muestra.
2. Colinealidad perfecta — factor(mes)
y factor(estacion) contienen la misma información: cada mes
pertenece a una sola estación. Incluir ambas es redundante.
3. Multicolinealidad alta — temperatura
y sensacion_termica están correlacionadas 0.98.
Prácticamente miden lo mismo.
round(cor(df_bicis$temperatura, df_bicis$sensacion_termica), 3)
## [1] 0.985
Se eliminan las variables redundantes y se agrega hora²
para capturar los picos de demanda de mañana (~8h) y tarde
(~17-18h).
modelo_mejorado <- lm(
rentas_totales ~ factor(año) + factor(mes) + factor(dia_de_la_semana) +
factor(asueto) + hora + I(hora^2) +
temperatura + humedad + velocidad_del_viento,
data = df_bicis
)
summary(modelo_mejorado)
##
## Call:
## lm(formula = rentas_totales ~ factor(año) + factor(mes) + factor(dia_de_la_semana) +
## factor(asueto) + hora + I(hora^2) + temperatura + humedad +
## velocidad_del_viento, data = df_bicis)
##
## Residuals:
## Min 1Q Median 3Q Max
## -293.19 -89.22 -26.39 60.28 591.70
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -139.05915 9.45825 -14.702 < 2e-16 ***
## factor(año)2012 84.33421 2.50342 33.688 < 2e-16 ***
## factor(mes)2 7.53136 6.17872 1.219 0.22290
## factor(mes)3 19.83597 6.52256 3.041 0.00236 **
## factor(mes)4 38.31628 6.87453 5.574 2.55e-08 ***
## factor(mes)5 64.89248 7.81156 8.307 < 2e-16 ***
## factor(mes)6 43.69875 8.75342 4.992 6.06e-07 ***
## factor(mes)7 11.72032 9.73646 1.204 0.22871
## factor(mes)8 24.62457 9.50548 2.591 0.00959 **
## factor(mes)9 62.62127 8.56726 7.309 2.87e-13 ***
## factor(mes)10 86.39504 7.44603 11.603 < 2e-16 ***
## factor(mes)11 77.18535 6.42551 12.012 < 2e-16 ***
## factor(mes)12 79.03658 6.40958 12.331 < 2e-16 ***
## factor(dia_de_la_semana)2 0.92871 4.79505 0.194 0.84643
## factor(dia_de_la_semana)3 3.08201 4.75675 0.648 0.51705
## factor(dia_de_la_semana)4 3.48307 4.79049 0.727 0.46719
## factor(dia_de_la_semana)5 9.48688 4.75395 1.996 0.04600 *
## factor(dia_de_la_semana)6 12.70640 4.76447 2.667 0.00767 **
## factor(dia_de_la_semana)7 -4.86905 4.76601 -1.022 0.30698
## factor(asueto)1 -5.88160 7.93730 -0.741 0.45870
## hora 39.65442 0.74563 53.182 < 2e-16 ***
## I(hora^2) -1.36024 0.03029 -44.914 < 2e-16 ***
## temperatura 6.59701 0.35693 18.482 < 2e-16 ***
## humedad -1.56268 0.07591 -20.586 < 2e-16 ***
## velocidad_del_viento -0.50001 0.16318 -3.064 0.00219 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 128.8 on 10861 degrees of freedom
## Multiple R-squared: 0.4956, Adjusted R-squared: 0.4945
## F-statistic: 444.6 on 24 and 10861 DF, p-value: < 2.2e-16
data.frame(
Modelo = c("Base", "Mejorado"),
R2_ajustado = round(c(summary(modelo_rentas)$adj.r.squared,
summary(modelo_mejorado)$adj.r.squared), 4),
AIC = round(c(AIC(modelo_rentas), AIC(modelo_mejorado)), 1),
RMSE = round(c(sqrt(mean(modelo_rentas$residuals^2)),
sqrt(mean(modelo_mejorado$residuals^2))), 2)
)
| Modelo | R2_ajustado | AIC | RMSE |
|---|---|---|---|
| Base | 0.4009 | 138542.8 | 140.05 |
| Mejorado | 0.4945 | 136693.2 | 128.65 |
El modelo mejorado tiene menor AIC y RMSE con menos variables — mejor balance entre ajuste y simplicidad.