Introducción

Este trabajo explora la construcción de un modelo predictivo para la renta de bicicletas, utilizando un conjunto de datos que incluye variables como la hora, el día, el mes, el año, la estación, el día de la semana, si es un día festivo, la temperatura, la sensación térmica, la humedad y la velocidad del viento. A través del análisis exploratorio inicial y la aplicación de técnicas de regresión lineal, se desarrolla un modelo que intenta predecir la cantidad total de rentas de bicicletas en función de estas variables. El objetivo es identificar los factores más significativos que afectan las rentas de bicicletas y ajustar el modelo para mejorar su capacidad predictiva.

Importar la base de datos

df <- read.csv("D:\\Descargas\\rentadebicis.csv")

Entender la base de datos

resumen <- summary(df)
resumen
##       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

Observaciones:

  1. ¿Por qué los días llegan hasta el 19? R: No se sabe.
  2. ¿cuál es la clave de las estaciones? R: 1 primavera, 2 verano,…
  3. ¿cuál es la clave del día de la semana? R: 1 domingo, 2 lunes,…

Gráfica “Influencia de la Temperatura sobre las Rentas Totales

plot(df$temperatura,df$rentas_totales,main="Influencia de la Temperatura sobre las Rentas Totales", xlab="Temperatura (°C)",ylab="Cantidad")

Generar regresión (modelo lineal)

regresion <- lm(rentas_totales ~ hora + dia + mes + año + estacion + dia_de_la_semana + asueto + temperatura + sensacion_termica + humedad + velocidad_del_viento, data=df)
summary(regresion)
## 
## Call:
## lm(formula = rentas_totales ~ hora + dia + mes + año + estacion + 
##     dia_de_la_semana + asueto + temperatura + sensacion_termica + 
##     humedad + velocidad_del_viento, data = df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -305.52  -93.64  -27.70   61.85  649.10 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -1.661e+05  5.496e+03 -30.217  < 2e-16 ***
## hora                  7.735e+00  2.070e-01  37.368  < 2e-16 ***
## dia                   3.844e-01  2.482e-01   1.549  0.12150    
## mes                   9.996e+00  1.682e+00   5.943 2.89e-09 ***
## año                   8.258e+01  2.732e+00  30.225  < 2e-16 ***
## estacion             -7.774e+00  5.177e+00  -1.502  0.13324    
## dia_de_la_semana      4.393e-01  6.918e-01   0.635  0.52545    
## asueto               -4.864e+00  8.365e+00  -0.582  0.56089    
## temperatura           1.582e+00  1.038e+00   1.524  0.12752    
## sensacion_termica     4.748e+00  9.552e-01   4.971 6.76e-07 ***
## humedad              -2.115e+00  7.884e-02 -26.827  < 2e-16 ***
## velocidad_del_viento  5.582e-01  1.809e-01   3.086  0.00203 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 141.7 on 10874 degrees of freedom
## Multiple R-squared:  0.3891, Adjusted R-squared:  0.3885 
## F-statistic: 629.6 on 11 and 10874 DF,  p-value: < 2.2e-16

Ajustar regresión lineal

regresion_ajustada <- lm(rentas_totales ~ hora + mes + año + sensacion_termica + humedad + velocidad_del_viento, data=df)
summary(regresion_ajustada)
## 
## Call:
## lm(formula = rentas_totales ~ hora + mes + año + sensacion_termica + 
##     humedad + velocidad_del_viento, data = df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -308.60  -93.85  -28.34   61.05  648.09 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -1.662e+05  5.496e+03 -30.250  < 2e-16 ***
## hora                  7.734e+00  2.070e-01  37.364  < 2e-16 ***
## mes                   7.574e+00  4.207e-01  18.002  < 2e-16 ***
## año                   8.266e+01  2.732e+00  30.258  < 2e-16 ***
## sensacion_termica     6.172e+00  1.689e-01  36.539  < 2e-16 ***
## humedad              -2.121e+00  7.858e-02 -26.988  < 2e-16 ***
## velocidad_del_viento  6.208e-01  1.771e-01   3.506 0.000457 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 141.7 on 10879 degrees of freedom
## Multiple R-squared:  0.3886, Adjusted R-squared:  0.3883 
## F-statistic:  1153 on 6 and 10879 DF,  p-value: < 2.2e-16

Construir modelo de predicción

datos <- data.frame(hora=12, mes=1:12, año=2013, sensacion_termica=24, humedad=62, velocidad_del_viento=13)
predict(regresion_ajustada,datos)
##        1        2        3        4        5        6        7        8 
## 279.1478 286.7215 294.2952 301.8690 309.4427 317.0164 324.5901 332.1638 
##        9       10       11       12 
## 339.7375 347.3112 354.8849 362.4587

Coclusiones

En este ejercicio, se genero un modelo predictivo, cuya finalidad es identificar las relaciones entre las variables explicativas (hora, mes, año, etc) y la variable predictiva (renta de bicicletas totales).

Este modelo será de utilidad para la toma de decisiones de la empresa al generar escenarios con una exactitud del 39% y una confiabilidad del 95%.

La capacidad del modelo para explicar el 39% de la variabilidad en las rentas de bicicletas, si bien no es perfecta, ofrece una base sólida para comprender los patrones de demanda. Este nivel de precisión, junto con la confiabilidad del 95%, sugiere que, aunque existen otros factores no capturados por el modelo que pueden influir en las rentas de bicicletas, las variables seleccionadas juegan un papel significativo en la predicción de las tendencias de renta.

LS0tDQp0aXRsZTogIk1vZGVsbyBQcmVkaWN0aXZvIC0gUmVudGEgZGUgQmljaXMiDQphdXRob3I6ICJBbG1hIFNhbnRpYWdvIC0gQTAwODM2NjM2Ig0KZGF0ZTogIjIwMjQtMDItMTUiDQpvdXRwdXQ6IA0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCi0tLQ0KIVtdKEQ6XFxEZXNjYXJnYXNcXFRpZW5kYUJpY2lzLmpwZykNCg0KIyBJbnRyb2R1Y2Npw7NuDQpFc3RlIHRyYWJham8gZXhwbG9yYSBsYSBjb25zdHJ1Y2Npw7NuIGRlIHVuIG1vZGVsbyBwcmVkaWN0aXZvIHBhcmEgbGEgcmVudGEgZGUgYmljaWNsZXRhcywgdXRpbGl6YW5kbyB1biBjb25qdW50byBkZSBkYXRvcyBxdWUgaW5jbHV5ZSB2YXJpYWJsZXMgY29tbyBsYSBob3JhLCBlbCBkw61hLCBlbCBtZXMsIGVsIGHDsW8sIGxhIGVzdGFjacOzbiwgZWwgZMOtYSBkZSBsYSBzZW1hbmEsIHNpIGVzIHVuIGTDrWEgZmVzdGl2bywgbGEgdGVtcGVyYXR1cmEsIGxhIHNlbnNhY2nDs24gdMOpcm1pY2EsIGxhIGh1bWVkYWQgeSBsYSB2ZWxvY2lkYWQgZGVsIHZpZW50by4gQSB0cmF2w6lzIGRlbCBhbsOhbGlzaXMgZXhwbG9yYXRvcmlvIGluaWNpYWwgeSBsYSBhcGxpY2FjacOzbiBkZSB0w6ljbmljYXMgZGUgcmVncmVzacOzbiBsaW5lYWwsIHNlIGRlc2Fycm9sbGEgdW4gbW9kZWxvIHF1ZSBpbnRlbnRhIHByZWRlY2lyIGxhIGNhbnRpZGFkIHRvdGFsIGRlIHJlbnRhcyBkZSBiaWNpY2xldGFzIGVuIGZ1bmNpw7NuIGRlIGVzdGFzIHZhcmlhYmxlcy4gRWwgb2JqZXRpdm8gZXMgaWRlbnRpZmljYXIgbG9zIGZhY3RvcmVzIG3DoXMgc2lnbmlmaWNhdGl2b3MgcXVlIGFmZWN0YW4gbGFzIHJlbnRhcyBkZSBiaWNpY2xldGFzIHkgYWp1c3RhciBlbCBtb2RlbG8gcGFyYSBtZWpvcmFyIHN1IGNhcGFjaWRhZCBwcmVkaWN0aXZhLg0KDQojIEltcG9ydGFyIGxhIGJhc2UgZGUgZGF0b3MNCmBgYHtyfQ0KZGYgPC0gcmVhZC5jc3YoIkQ6XFxEZXNjYXJnYXNcXHJlbnRhZGViaWNpcy5jc3YiKQ0KDQpgYGANCg0KIyBFbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zDQpgYGB7cn0NCnJlc3VtZW4gPC0gc3VtbWFyeShkZikNCnJlc3VtZW4NCmBgYA0KDQpPYnNlcnZhY2lvbmVzOg0KDQoxLiDCv1BvciBxdcOpIGxvcyBkw61hcyBsbGVnYW4gaGFzdGEgZWwgMTk/IFI6IE5vIHNlIHNhYmUuIA0KMi4gwr9jdcOhbCBlcyBsYSBjbGF2ZSBkZSBsYXMgZXN0YWNpb25lcz8gUjogMSBwcmltYXZlcmEsIDIgdmVyYW5vLC4uLiANCjMuIMK/Y3XDoWwgZXMgbGEgY2xhdmUgZGVsIGTDrWEgZGUgbGEgc2VtYW5hPyBSOiAxIGRvbWluZ28sIDIgbHVuZXMsLi4uIA0KDQoNCiMgR3LDoWZpY2Eg4oCcSW5mbHVlbmNpYSBkZSBsYSBUZW1wZXJhdHVyYSBzb2JyZSBsYXMgUmVudGFzIFRvdGFsZXMNCmBgYHtyfQ0KcGxvdChkZiR0ZW1wZXJhdHVyYSxkZiRyZW50YXNfdG90YWxlcyxtYWluPSJJbmZsdWVuY2lhIGRlIGxhIFRlbXBlcmF0dXJhIHNvYnJlIGxhcyBSZW50YXMgVG90YWxlcyIsIHhsYWI9IlRlbXBlcmF0dXJhICjCsEMpIix5bGFiPSJDYW50aWRhZCIpDQpgYGANCg0KIyBHZW5lcmFyIHJlZ3Jlc2nDs24gKG1vZGVsbyBsaW5lYWwpDQpgYGB7cn0NCnJlZ3Jlc2lvbiA8LSBsbShyZW50YXNfdG90YWxlcyB+IGhvcmEgKyBkaWEgKyBtZXMgKyBhw7FvICsgZXN0YWNpb24gKyBkaWFfZGVfbGFfc2VtYW5hICsgYXN1ZXRvICsgdGVtcGVyYXR1cmEgKyBzZW5zYWNpb25fdGVybWljYSArIGh1bWVkYWQgKyB2ZWxvY2lkYWRfZGVsX3ZpZW50bywgZGF0YT1kZikNCnN1bW1hcnkocmVncmVzaW9uKQ0KYGBgDQoNCiMgQWp1c3RhciByZWdyZXNpw7NuIGxpbmVhbA0KYGBge3J9DQpyZWdyZXNpb25fYWp1c3RhZGEgPC0gbG0ocmVudGFzX3RvdGFsZXMgfiBob3JhICsgbWVzICsgYcOxbyArIHNlbnNhY2lvbl90ZXJtaWNhICsgaHVtZWRhZCArIHZlbG9jaWRhZF9kZWxfdmllbnRvLCBkYXRhPWRmKQ0Kc3VtbWFyeShyZWdyZXNpb25fYWp1c3RhZGEpDQpgYGANCg0KIyBDb25zdHJ1aXIgbW9kZWxvIGRlIHByZWRpY2Npw7NuDQpgYGB7cn0NCmRhdG9zIDwtIGRhdGEuZnJhbWUoaG9yYT0xMiwgbWVzPTE6MTIsIGHDsW89MjAxMywgc2Vuc2FjaW9uX3Rlcm1pY2E9MjQsIGh1bWVkYWQ9NjIsIHZlbG9jaWRhZF9kZWxfdmllbnRvPTEzKQ0KcHJlZGljdChyZWdyZXNpb25fYWp1c3RhZGEsZGF0b3MpDQpgYGANCg0KIyBDb2NsdXNpb25lcw0KRW4gZXN0ZSBlamVyY2ljaW8sIHNlIGdlbmVybyB1biAqKm1vZGVsbyBwcmVkaWN0aXZvKiosIGN1eWEgZmluYWxpZGFkIGVzIGlkZW50aWZpY2FyIGxhcyByZWxhY2lvbmVzIGVudHJlIGxhcyAqdmFyaWFibGVzIGV4cGxpY2F0aXZhcyogIChob3JhLCBtZXMsIGHDsW8sIGV0YykgIHkgbGEgKnZhcmlhYmxlIHByZWRpY3RpdmEqICAocmVudGEgZGUgYmljaWNsZXRhcyB0b3RhbGVzKS4NCg0KRXN0ZSBtb2RlbG8gc2Vyw6EgZGUgdXRpbGlkYWQgcGFyYSBsYSB0b21hIGRlIGRlY2lzaW9uZXMgZGUgbGEgZW1wcmVzYSBhbCBnZW5lcmFyIGVzY2VuYXJpb3MgY29uIHVuYSBleGFjdGl0dWQgZGVsICoqMzklKiogeSB1bmEgY29uZmlhYmlsaWRhZCBkZWwgICoqOTUlKiouDQoNCkxhIGNhcGFjaWRhZCBkZWwgbW9kZWxvIHBhcmEgZXhwbGljYXIgZWwgMzklIGRlIGxhIHZhcmlhYmlsaWRhZCBlbiBsYXMgcmVudGFzIGRlIGJpY2ljbGV0YXMsIHNpIGJpZW4gbm8gZXMgcGVyZmVjdGEsIG9mcmVjZSB1bmEgYmFzZSBzw7NsaWRhIHBhcmEgY29tcHJlbmRlciBsb3MgcGF0cm9uZXMgZGUgZGVtYW5kYS4gRXN0ZSBuaXZlbCBkZSBwcmVjaXNpw7NuLCBqdW50byBjb24gbGEgY29uZmlhYmlsaWRhZCBkZWwgOTUlLCBzdWdpZXJlIHF1ZSwgYXVucXVlIGV4aXN0ZW4gb3Ryb3MgZmFjdG9yZXMgbm8gY2FwdHVyYWRvcyBwb3IgZWwgbW9kZWxvIHF1ZSBwdWVkZW4gaW5mbHVpciBlbiBsYXMgcmVudGFzIGRlIGJpY2ljbGV0YXMsIGxhcyB2YXJpYWJsZXMgc2VsZWNjaW9uYWRhcyBqdWVnYW4gdW4gcGFwZWwgc2lnbmlmaWNhdGl2byBlbiBsYSBwcmVkaWNjacOzbiBkZSBsYXMgdGVuZGVuY2lhcyBkZSByZW50YS4NCg0KDQo=