Importar la base de datos

df <- read.csv("C:\\Users\\52664\\Documents\\PROGRAMA R\\CLASE 2 JUEVES 15 DE FEB\\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 de la semana? R: 1 domingo, 2 lunes, …

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

# Generar regresión (modelo lineal)

regresion <- lm(rentas_totales ~ hora + dia + 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 + año + estacion + 
##     dia_de_la_semana + asueto + temperatura + sensacion_termica + 
##     humedad + velocidad_del_viento, data = df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -316.12  -93.97  -27.66   61.20  638.52 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -1.663e+05  5.505e+03 -30.204  < 2e-16 ***
## hora                  7.758e+00  2.073e-01  37.425  < 2e-16 ***
## dia                   3.850e-01  2.486e-01   1.549  0.12143    
## año                   8.267e+01  2.737e+00  30.210  < 2e-16 ***
## estacion              2.201e+01  1.297e+00  16.967  < 2e-16 ***
## dia_de_la_semana      5.061e-01  6.928e-01   0.731  0.46508    
## asueto               -1.021e+01  8.329e+00  -1.226  0.22012    
## temperatura           1.584e+00  1.039e+00   1.524  0.12761    
## sensacion_termica     4.782e+00  9.567e-01   4.998 5.87e-07 ***
## humedad              -2.076e+00  7.869e-02 -26.379  < 2e-16 ***
## velocidad_del_viento  5.542e-01  1.812e-01   3.060  0.00222 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 141.9 on 10875 degrees of freedom
## Multiple R-squared:  0.3871, Adjusted R-squared:  0.3865 
## F-statistic: 686.9 on 10 and 10875 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 predictivo

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

Conclusiones

En este ejercicio se generó un modelo predictivo, cuya finalidad es identificar las relaciones entre las variables explicaivas (hora, dia, mes, año, etc) y la variable predictiva (rentas de bicis totales).

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

LS0tDQp0aXRsZTogIk1vZGVsbyBQcmVkaWN0aXZvIC0gUmVudGEgZGUgQmljaXMiDQphdXRob3I6ICJLZXZpbiBNZXphIE1lZGluYSAtIEEwMDgzNjExMyINCmRhdGU6ICIyMDI0LTAyLTE1Ig0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQotLS0NCg0KIVtdKEM6XFxVc2Vyc1xcNTI2NjRcXERvd25sb2Fkc1xcaW1hZ2UucG5nKQ0KDQojIEltcG9ydGFyIGxhIGJhc2UgZGUgZGF0b3MgDQpgYGB7cn0NCmRmIDwtIHJlYWQuY3N2KCJDOlxcVXNlcnNcXDUyNjY0XFxEb2N1bWVudHNcXFBST0dSQU1BIFJcXENMQVNFIDIgSlVFVkVTIDE1IERFIEZFQlxccmVudGFkZWJpY2lzLmNzdiIpDQpgYGANCg0KIyBFbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zDQpgYGB7cn0NCnJlc3VtZW4gPC0gc3VtbWFyeShkZikNCnJlc3VtZW4NCmBgYA0KT2JzZXJ2YWNpb25lczoNCjEuIMK/UG9yIHF1w6kgbG9zIGTDrWFzIGxsZWdhbiBoYXN0YSBlbCAxOT8gUjogTm8gc2Ugc2FiZS4NCjIuIMK/Q3XDoWwgZXMgbGEgY2xhdmUgZGUgbGFzIGVzdGFjaW9uZXM/IFI6IDEgcHJpbWF2ZXJhLCAyIHZlcmFubywgLi4uDQozLiDCv0N1w6FsIGVzIGxhIGNsYXZlIGRlbCBkw61hIGRlIGxhIHNlbWFuYSBkZSBsYSBzZW1hbmE/IFI6IDEgZG9taW5nbywgMiBsdW5lcywgLi4uDQoNCmBgYHtyfQ0KcGxvdChkZiR0ZW1wZXJhdHVyYSxkZiRyZW50YXNfdG90YWxlcyxtYWluPSJJbmZsdWVuY2lhIGRlIGxhIFRlbm1wZXJhdHVyYSBzb2JyZSBsYXMgUmVudGFzIFRvdGFsZXMiLHhsYWI9IlRlbXBlcmF0dXJhICjCsEMpIix5bGFiPSJDYW50aWRhZCIpDQoNCmBgYA0KIyBHZW5lcmFyIHJlZ3Jlc2nDs24gKG1vZGVsbyBsaW5lYWwpDQpgYGB7cn0NCnJlZ3Jlc2lvbiA8LSBsbShyZW50YXNfdG90YWxlcyB+IGhvcmEgKyBkaWEgKyBhw7FvICsgZXN0YWNpb24gKyBkaWFfZGVfbGFfc2VtYW5hICsgYXN1ZXRvICt0ZW1wZXJhdHVyYSArIHNlbnNhY2lvbl90ZXJtaWNhICsgaHVtZWRhZCArIHZlbG9jaWRhZF9kZWxfdmllbnRvLCBkYXRhPWRmKQ0Kc3VtbWFyeShyZWdyZXNpb24pDQpgYGANCiMgQWp1c3RhciByZWdyZXNpw7NuIGxpbmVhbCANCg0KYGBge3J9DQpyZWdyZXNpb25fYWp1c3RhZGEgPC0gbG0ocmVudGFzX3RvdGFsZXMgfiBob3JhICsgbWVzICsgYcOxbyArIHNlbnNhY2lvbl90ZXJtaWNhICsgaHVtZWRhZCArIHZlbG9jaWRhZF9kZWxfdmllbnRvLCBkYXRhPWRmKQ0Kc3VtbWFyeShyZWdyZXNpb25fYWp1c3RhZGEpDQpgYGANCiMgQ29uc3RydWlyIE1vZGVsbyBwcmVkaWN0aXZvIA0KYGBge3J9DQpkYXRvcyA8LSBkYXRhLmZyYW1lKGhvcmE9MTIsIG1lcz0xOjEyLCBhw7FvPTIwMTMsIHNlbnNhY2lvbl90ZXJtaWNhPTI0LCBodW1lZGFkPTYyLCB2ZWxvY2lkYWRfZGVsX3ZpZW50bz0xMykNCnByZWRpY3QocmVncmVzaW9uX2FqdXN0YWRhLGRhdG9zKQ0KYGBgDQojIENvbmNsdXNpb25lcyANCkVuIGVzdGUgZWplcmNpY2lvIHNlIGdlbmVyw7MgdW4gKiptb2RlbG8gcHJlZGljdGl2byoqLCBjdXlhIGZpbmFsaWRhZCBlcyBpZGVudGlmaWNhciBsYXMgcmVsYWNpb25lcyBlbnRyZSBsYXMgKnZhcmlhYmxlcyBleHBsaWNhaXZhcyogKGhvcmEsIGRpYSwgbWVzLCBhw7FvLCBldGMpIHkgKmxhIHZhcmlhYmxlIHByZWRpY3RpdmEqIChyZW50YXMgZGUgYmljaXMgdG90YWxlcykuICANCg0KRXN0ZSBtb2RlbG8gc2Vyw6EgZGUgdXRpbGlkYWQgcGFyYSBsYSB0b21hIGRlIGRlY2lzaW9uZSBkZSBsYSBlbXByZXNhIGFsIGdlbmVyYXIgZXNjZW5lYXJpb3MgY29uIHVuYSBleGFjdGl0dWQgZGVsICoqMzklKiogeSB1bmEgY29uZmlhYmlsaWRhZCBkZWwgOTUl