Modelo Predictivo - Renta de Bicis

Paso 1. Importar base de datos .csv

#file.choose() 

bd<- read.csv("/Users/ricardogc/Desktop/R - Analisis de datos para la toma de decisiones. /rentadebicis.csv")

Paso 2. Entender la base de datos

resumen <- summary(bd)
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(bd$temperatura,bd$rentas_totales,main = "Influencia de la temperatura sobre las rentas totales",xlab = "Temperatura",ylab = "Rentas_totales")

“Herramienta”El Generador de valor de Datos”

Paso 1. Definir el area del negocio que buscamos impactar o mejorar (Departamento) y el KPI.

El areá que queremos impactar es el de ventas con el KPI de rentas mensuales y rentas de suscriptores, basado en los que estan suscritos y los que no.

Paso 2. Seleccionar la plantilla para crear valor a partir de los datos de los clientes.

Visión | Segmentación | Personalización | Contextualización

Esto debido a que con la visión tienes un panorama más amplio del comportamiento del clientes en cuestión a la variable clima y como esto puede cambiar el metodo para obtener mayores ventas.

Paso 3. Generar ideas y conceptos especificos.

Elaborar un modelo predictivo de la renta de bicis. Se enfoca al analisis de los meses con mayor numero de ventas, de esta manera obtener mejores oportunidades, ya sea lanzando nuevas promociones o descuentos que tengan mayor impacto en las fechas que tienen bajas de ventas.

Paso 4. Reunir los datos requeridos

Elaborar una base de datos con la variable dependientes (Ventas/rentas) y las variables independientes (Temperatura y tipos de suscriptores)

Paso 5 Plan de ejecución.

El departamento de Ventas y Mercadotecnia, obtendra un plan de implementación de ofertas y promociones con el fin de incrementar las ventas.

Observaciones

1. Por que los días llegan hasta el 19 y no hasta el 31?

2. ¿Que significan los numeros en las estaciones? R: 1 es primavera. 2 es verano

Generar regresión lineal

regresion<- lm(rentas_totales ~hora+dia+mes+año+estacion+dia_de_la_semana+asueto+temperatura+sensacion_termica+humedad+velocidad_del_viento, data = bd)
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 = bd)
## 
## 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

Evaluar y en caso necesario ajustar, la regresion lineal

regresion<- lm (rentas_totales~ hora+mes+año+sensacion_termica+humedad+velocidad_del_viento, data = bd)
summary(regresion)
## 
## Call:
## lm(formula = rentas_totales ~ hora + mes + año + sensacion_termica + 
##     humedad + velocidad_del_viento, data = bd)
## 
## 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_nuevos <- data.frame(hora=12,mes=1:12,año=2013,sensacion_termica=24,humedad=62,velocidad_del_viento=13)
predict(regresion,datos_nuevos)
##        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

Obtuvimos el siguiente caso de renta de bicis en el cual analizamos para poder realizar un modelo predictivo. Pero para esto realizamos varias acciones para poder obtener un análisis más preciso. Como primer paso fue el observar que facto afectaba más a la renta de bicis, por lo que obtuvimos que la temperatura es un factor importante. Posteriormente realizamos una regresión Lineal, lo que nos brindo un panorama amplio de qué factores afectaban y tenían mayor relevancia para la renta de bicis. Obtuvimos algunos factores, como hora, mes, día, etc. Con estos datos volvimos hacer otra regresión para obtener una relación más precisa con la renta de bicis y en base a ello realizamos el modelo predictivo para predecir la renta de las bicis.

LS0tCnRpdGxlOiA8c3BhbiBzdHlsZT0iQ29sb3I6R3JlZW4iPiAiTW9kZWxvIFByZWRpY3Rpdm8iCmF1dGhvcjogIlJpY2FyZG8gR2FsaWNpYSAtIEEwMTY1MzI3OSIKZGF0ZTogJzIwMjItMDktMjAnCm91dHB1dDogCiBodG1sX2RvY3VtZW50OgogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUgCi0tLQohW10oL1VzZXJzL3JpY2FyZG9nYy9EZXNrdG9wL2JpY2kuUE5HKQoKIyMgKipNb2RlbG8gUHJlZGljdGl2byAtIFJlbnRhIGRlIEJpY2lzKioKCiMjIyAqUGFzbyAxLiogSW1wb3J0YXIgYmFzZSBkZSBkYXRvcyAuY3N2CmBgYHtyfQojZmlsZS5jaG9vc2UoKSAKCmJkPC0gcmVhZC5jc3YoIi9Vc2Vycy9yaWNhcmRvZ2MvRGVza3RvcC9SIC0gQW5hbGlzaXMgZGUgZGF0b3MgcGFyYSBsYSB0b21hIGRlIGRlY2lzaW9uZXMuIC9yZW50YWRlYmljaXMuY3N2IikKYGBgCgojIyMgKlBhc28gMi4qIEVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3MKYGBge3J9CnJlc3VtZW4gPC0gc3VtbWFyeShiZCkKcmVzdW1lbgoKcGxvdChiZCR0ZW1wZXJhdHVyYSxiZCRyZW50YXNfdG90YWxlcyxtYWluID0gIkluZmx1ZW5jaWEgZGUgbGEgdGVtcGVyYXR1cmEgc29icmUgbGFzIHJlbnRhcyB0b3RhbGVzIix4bGFiID0gIlRlbXBlcmF0dXJhIix5bGFiID0gIlJlbnRhc190b3RhbGVzIikKYGBgCgojIyAqKiJIZXJyYW1pZW50YSAiRWwgR2VuZXJhZG9yIGRlIHZhbG9yIGRlIERhdG9zIioqCgojIyMgUGFzbyAxLiBEZWZpbmlyIGVsIGFyZWEgZGVsIG5lZ29jaW8gcXVlIGJ1c2NhbW9zIGltcGFjdGFyIG8gbWVqb3JhciAoRGVwYXJ0YW1lbnRvKSB5IGVsIEtQSS4KIyMjIyBFbCBhcmXDoSBxdWUgcXVlcmVtb3MgaW1wYWN0YXIgZXMgZWwgZGUgdmVudGFzIGNvbiBlbCBLUEkgZGUgcmVudGFzIG1lbnN1YWxlcyB5IHJlbnRhcyBkZSBzdXNjcmlwdG9yZXMsIGJhc2FkbyBlbiBsb3MgcXVlIGVzdGFuIHN1c2NyaXRvcyB5IGxvcyBxdWUgbm8uIAoKIyMjIFBhc28gMi4gU2VsZWNjaW9uYXIgbGEgcGxhbnRpbGxhIHBhcmEgY3JlYXIgdmFsb3IgYSBwYXJ0aXIgZGUgbG9zIGRhdG9zIGRlIGxvcyBjbGllbnRlcy4gCiMjIyMgKipWaXNpw7NuKiogfCBTZWdtZW50YWNpw7NuIHwgUGVyc29uYWxpemFjacOzbiB8IENvbnRleHR1YWxpemFjacOzbiAKIyMjIyBFc3RvIGRlYmlkbyBhIHF1ZSBjb24gbGEgdmlzacOzbiB0aWVuZXMgdW4gcGFub3JhbWEgbcOhcyBhbXBsaW8gZGVsIGNvbXBvcnRhbWllbnRvIGRlbCBjbGllbnRlcyBlbiBjdWVzdGnDs24gYSBsYSB2YXJpYWJsZSBjbGltYSB5IGNvbW8gZXN0byBwdWVkZSBjYW1iaWFyIGVsIG1ldG9kbyBwYXJhIG9idGVuZXIgbWF5b3JlcyB2ZW50YXMuIAoKIyMjIFBhc28gMy4gR2VuZXJhciBpZGVhcyB5IGNvbmNlcHRvcyBlc3BlY2lmaWNvcy4KIyMjIyBFbGFib3JhciB1biBtb2RlbG8gcHJlZGljdGl2byBkZSBsYSByZW50YSBkZSBiaWNpcy4gU2UgZW5mb2NhIGFsIGFuYWxpc2lzIGRlIGxvcyBtZXNlcyBjb24gbWF5b3IgbnVtZXJvIGRlIHZlbnRhcywgZGUgZXN0YSBtYW5lcmEgb2J0ZW5lciBtZWpvcmVzIG9wb3J0dW5pZGFkZXMsIHlhIHNlYSBsYW56YW5kbyBudWV2YXMgcHJvbW9jaW9uZXMgbyBkZXNjdWVudG9zIHF1ZSB0ZW5nYW4gbWF5b3IgaW1wYWN0byBlbiBsYXMgZmVjaGFzIHF1ZSB0aWVuZW4gYmFqYXMgZGUgdmVudGFzLiAKCiMjIyBQYXNvIDQuIFJldW5pciBsb3MgZGF0b3MgcmVxdWVyaWRvcwojIyMjIEVsYWJvcmFyIHVuYSBiYXNlIGRlIGRhdG9zIGNvbiBsYSB2YXJpYWJsZSBkZXBlbmRpZW50ZXMgKFZlbnRhcy9yZW50YXMpIHkgbGFzIHZhcmlhYmxlcyBpbmRlcGVuZGllbnRlcyAgKFRlbXBlcmF0dXJhIHkgdGlwb3MgZGUgc3VzY3JpcHRvcmVzKQoKIyMjIFBhc28gNSBQbGFuIGRlIGVqZWN1Y2nDs24uCiMjIyMgRWwgZGVwYXJ0YW1lbnRvIGRlIFZlbnRhcyB5IE1lcmNhZG90ZWNuaWEsIG9idGVuZHJhIHVuIHBsYW4gZGUgaW1wbGVtZW50YWNpw7NuIGRlIG9mZXJ0YXMgeSBwcm9tb2Npb25lcyBjb24gZWwgZmluIGRlIGluY3JlbWVudGFyIGxhcyB2ZW50YXMuCgojIyMgKk9ic2VydmFjaW9uZXMqCiMjIDEuIFBvciBxdWUgbG9zIGTDrWFzIGxsZWdhbiBoYXN0YSBlbCAxOSB5IG5vIGhhc3RhIGVsIDMxPwojIyAyLiDCv1F1ZSBzaWduaWZpY2FuIGxvcyBudW1lcm9zIGVuIGxhcyBlc3RhY2lvbmVzPyBSOiAxIGVzIHByaW1hdmVyYS4gMiBlcyB2ZXJhbm8KCiMjIyAqKkdlbmVyYXIgcmVncmVzacOzbiBsaW5lYWwqKgpgYGB7cn0KcmVncmVzaW9uPC0gbG0ocmVudGFzX3RvdGFsZXMgfmhvcmErZGlhK21lcythw7FvK2VzdGFjaW9uK2RpYV9kZV9sYV9zZW1hbmErYXN1ZXRvK3RlbXBlcmF0dXJhK3NlbnNhY2lvbl90ZXJtaWNhK2h1bWVkYWQrdmVsb2NpZGFkX2RlbF92aWVudG8sIGRhdGEgPSBiZCkKc3VtbWFyeShyZWdyZXNpb24pCmBgYAoKIyMjIEV2YWx1YXIgeSBlbiBjYXNvIG5lY2VzYXJpbyBhanVzdGFyLCBsYSByZWdyZXNpb24gbGluZWFsCmBgYHtyfQpyZWdyZXNpb248LSBsbSAocmVudGFzX3RvdGFsZXN+IGhvcmErbWVzK2HDsW8rc2Vuc2FjaW9uX3Rlcm1pY2EraHVtZWRhZCt2ZWxvY2lkYWRfZGVsX3ZpZW50bywgZGF0YSA9IGJkKQpzdW1tYXJ5KHJlZ3Jlc2lvbikKYGBgCgojIyMgKipDb25zdHJ1aXIgbW9kZWxvIHByZWRpY3Rpdm8qKiAKYGBge3J9CmRhdG9zX251ZXZvcyA8LSBkYXRhLmZyYW1lKGhvcmE9MTIsbWVzPTE6MTIsYcOxbz0yMDEzLHNlbnNhY2lvbl90ZXJtaWNhPTI0LGh1bWVkYWQ9NjIsdmVsb2NpZGFkX2RlbF92aWVudG89MTMpCnByZWRpY3QocmVncmVzaW9uLGRhdG9zX251ZXZvcykKYGBgCgojIyBDb25jbHVzaW9uZXMKCjxwIHN0eWxlPSAidGV4dC1hbGlnbjoganVzdGlmeTsiPiBPYnR1dmltb3MgZWwgc2lndWllbnRlIGNhc28gZGUgcmVudGEgZGUgYmljaXMgZW4gZWwgY3VhbCBhbmFsaXphbW9zIHBhcmEgcG9kZXIgcmVhbGl6YXIgdW4gbW9kZWxvIHByZWRpY3Rpdm8uIFBlcm8gcGFyYSBlc3RvIHJlYWxpemFtb3MgdmFyaWFzIGFjY2lvbmVzIHBhcmEgcG9kZXIgb2J0ZW5lciB1biBhbsOhbGlzaXMgbcOhcyBwcmVjaXNvLiBDb21vIHByaW1lciBwYXNvIGZ1ZSBlbCBvYnNlcnZhciBxdWUgZmFjdG8gYWZlY3RhYmEgbcOhcyBhIGxhIHJlbnRhIGRlIGJpY2lzLCBwb3IgbG8gcXVlIG9idHV2aW1vcyBxdWUgbGEgdGVtcGVyYXR1cmEgZXMgdW4gZmFjdG9yIGltcG9ydGFudGUuIFBvc3Rlcmlvcm1lbnRlIHJlYWxpemFtb3MgdW5hIHJlZ3Jlc2nDs24gTGluZWFsLCBsbyBxdWUgbm9zIGJyaW5kbyB1biBwYW5vcmFtYSBhbXBsaW8gZGUgcXXDqSBmYWN0b3JlcyBhZmVjdGFiYW4geSB0ZW7DrWFuIG1heW9yIHJlbGV2YW5jaWEgcGFyYSBsYSByZW50YSBkZSBiaWNpcy4gT2J0dXZpbW9zIGFsZ3Vub3MgZmFjdG9yZXMsIGNvbW8gaG9yYSwgbWVzLCBkw61hLCBldGMuIENvbiBlc3RvcyBkYXRvcyB2b2x2aW1vcyBoYWNlciBvdHJhIHJlZ3Jlc2nDs24gcGFyYSBvYnRlbmVyIHVuYSByZWxhY2nDs24gbcOhcyBwcmVjaXNhIGNvbiBsYSByZW50YSBkZSBiaWNpcyB5IGVuIGJhc2UgYSBlbGxvIHJlYWxpemFtb3MgZWwgbW9kZWxvIHByZWRpY3Rpdm8gcGFyYSBwcmVkZWNpciBsYSByZW50YSBkZSBsYXMgYmljaXMuIDwvcD4KCgoK