Modelo predictivo

#Contexto
#Una emprea de renta de bicicletas, quiere obtener un pronostico de rentas mensuales para el proximo año. 

###Paso 1. Importar la base de datos

#file.choose()
df <- read.csv("C:\\Users\\Acer\\Desktop\\R studio\\rentadebicis (2).csv")

###Paso 2. 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
plot(df$temperatura,df$rentas_totales, main = 'Influencia de la temperatura sobre las rentas',xlab = "temperatura(*C)", ylab = "Rentas totales")

###Comentarios:

#1. Los dias llegan hasta el 19 y no hasta el 31
#2. Cual es la estacion del año 1 ? Primavera 
#3. Cual es el dia 1 de la semana? Domingo

###Paso 3. Generar regresion 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

###Paso 4. En caso necesario, ajustar la regresion 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

###Paso 5. Construir un modelo predictivo

datos<- data.frame(hora=11.54,mes=1:12,año=2013,sensacion_termica=23.66,humedad=61.89,velocidad_del_viento=12.799)
predict(regresion_ajustada,datos)
##        1        2        3        4        5        6        7        8 
## 273.6001 281.1738 288.7475 296.3213 303.8950 311.4687 319.0424 326.6161 
##        9       10       11       12 
## 334.1898 341.7635 349.3372 356.9110
LS0tDQp0aXRsZTogIk1vZGVsb19wcmVkaWN0aXZvIg0KYXV0aG9yOiAiRGllZ28gR3V0aWVycmV6IEZsb3JlcyBBMDE3MjI0NTIiDQpkYXRlOiAiYHIgU3lzLkRhdGUoKWAiDQpvdXRwdXQ6DQogaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRydWUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6ICJ5ZXRpIg0KICAgIGhpZ2hsaWd0aDogInRhbmdvIg0KLS0tDQoNCiFbXShDOlxcVXNlcnNcXEFjZXJcXERlc2t0b3BcXFIgc3R1ZGlvXFxnaWYgcHJlZGljdGlvbi5naWYpDQoNCiMjIyBNb2RlbG8gcHJlZGljdGl2bw0KYGBge3J9DQojQ29udGV4dG8NCiNVbmEgZW1wcmVhIGRlIHJlbnRhIGRlIGJpY2ljbGV0YXMsIHF1aWVyZSBvYnRlbmVyIHVuIHByb25vc3RpY28gZGUgcmVudGFzIG1lbnN1YWxlcyBwYXJhIGVsIHByb3hpbW8gYcOxby4gDQpgYGANCg0KDQojIyNQYXNvIDEuIEltcG9ydGFyIGxhIGJhc2UgZGUgZGF0b3MNCg0KYGBge3J9DQojZmlsZS5jaG9vc2UoKQ0KZGYgPC0gcmVhZC5jc3YoIkM6XFxVc2Vyc1xcQWNlclxcRGVza3RvcFxcUiBzdHVkaW9cXHJlbnRhZGViaWNpcyAoMikuY3N2IikNCmBgYA0KDQojIyNQYXNvIDIuIEVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3MNCmBgYHtyfQ0KcmVzdW1lbiA8LSBzdW1tYXJ5KGRmKQ0KcmVzdW1lbg0KcGxvdChkZiR0ZW1wZXJhdHVyYSxkZiRyZW50YXNfdG90YWxlcywgbWFpbiA9ICdJbmZsdWVuY2lhIGRlIGxhIHRlbXBlcmF0dXJhIHNvYnJlIGxhcyByZW50YXMnLHhsYWIgPSAidGVtcGVyYXR1cmEoKkMpIiwgeWxhYiA9ICJSZW50YXMgdG90YWxlcyIpDQpgYGANCg0KDQojIyNDb21lbnRhcmlvczoNCmBgYHtyfQ0KIzEuIExvcyBkaWFzIGxsZWdhbiBoYXN0YSBlbCAxOSB5IG5vIGhhc3RhIGVsIDMxDQojMi4gQ3VhbCBlcyBsYSBlc3RhY2lvbiBkZWwgYcOxbyAxID8gUHJpbWF2ZXJhIA0KIzMuIEN1YWwgZXMgZWwgZGlhIDEgZGUgbGEgc2VtYW5hPyBEb21pbmdvDQpgYGANCg0KDQojIyNQYXNvIDMuIEdlbmVyYXIgcmVncmVzaW9uIGxpbmVhbCANCmBgYHtyfQ0KcmVncmVzaW9uIDwtIGxtKHJlbnRhc190b3RhbGVzIH4gaG9yYSArIGRpYSArIG1lcyArIGHDsW8gKyBlc3RhY2lvbiArIGRpYV9kZV9sYV9zZW1hbmEgKyBhc3VldG8gKyB0ZW1wZXJhdHVyYSArIHNlbnNhY2lvbl90ZXJtaWNhICsgaHVtZWRhZCArIHZlbG9jaWRhZF9kZWxfdmllbnRvLCBkYXRhID0gZGYpDQpzdW1tYXJ5KHJlZ3Jlc2lvbikNCmBgYA0KDQoNCiMjI1Bhc28gNC4gRW4gY2FzbyBuZWNlc2FyaW8sIGFqdXN0YXIgbGEgcmVncmVzaW9uIGxpbmVhbA0KYGBge3J9DQpyZWdyZXNpb25fYWp1c3RhZGEgPC0gbG0ocmVudGFzX3RvdGFsZXMgfiBob3JhICsgbWVzICsgYcOxbyArIHNlbnNhY2lvbl90ZXJtaWNhICsgaHVtZWRhZCArIHZlbG9jaWRhZF9kZWxfdmllbnRvLCBkYXRhID0gZGYpDQpzdW1tYXJ5KHJlZ3Jlc2lvbl9hanVzdGFkYSkNCmBgYA0KDQojIyNQYXNvIDUuIENvbnN0cnVpciB1biBtb2RlbG8gcHJlZGljdGl2bw0KYGBge3J9DQpkYXRvczwtIGRhdGEuZnJhbWUoaG9yYT0xMS41NCxtZXM9MToxMixhw7FvPTIwMTMsc2Vuc2FjaW9uX3Rlcm1pY2E9MjMuNjYsaHVtZWRhZD02MS44OSx2ZWxvY2lkYWRfZGVsX3ZpZW50bz0xMi43OTkpDQpwcmVkaWN0KHJlZ3Jlc2lvbl9hanVzdGFkYSxkYXRvcykNCmBgYA0KDQo=