Modelo Predictivo: Renta de Bicicletas

Paso 1. Importar base de datos

bd <- read.csv("/Users/ErickaMtz/Downloads/rentadebicis_2.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 (ºC)", ylab= "Cantidad")

Observaciones

  1. ¿Por qué los días llegan hasta el 19 y no hasta el 31?
  2. ¿Qué significan los números en las estaciones? R: 1 es primavera, 2 es verano, 3 es otoño y 4 es invierno.

Herramienta “El Generador de Valor de Datos”

Paso 1. Definir el área del negocio que buscamos impactaro mejorar su KPI.
El departamento de mercadotecnia será el impactado ya que deberán de encontrar una estrategia para evitar que las rentas disminuyan en ciertas épocas del año y siempre mantenerlas constanto o incrementarlas. El KPI sería el número de rentas x temperatura.
Paso 2. Seleccionar plantilla (-s) para crear valor a partir de los datos de los clientes
Visión / Segmentación / Personalización / Contextualización
Paso 3. Generar ideas o conceptos específicos
Elaborar un modelo predictivo de rentas mensuales
Paso 4. Reunir los datos requeridos
Elaborar una base de datos con la variable dependiente (rentas) y las variables independientes (temperatura y fecha) Paso 5. Plan de ejecución.
Mercadotecnia elaborará un plan para aumentar y hacer constantes las rentas a través de un modelo predictivo. El equipo se encargará de identificar las situaciones en las que las rentas disminuyan para poder aplicar algún tipo de descuento, promoción o cierto beneficio que pueda atraer a la gente y evitar esos espacios o puntos en los que la utilidad pueda caer.

Paso 3. 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)

colnames(bd)
##  [1] "hora"                     "dia"                     
##  [3] "mes"                      "año"                     
##  [5] "estacion"                 "dia_de_la_semana"        
##  [7] "asueto"                   "temperatura"             
##  [9] "sensacion_termica"        "humedad"                 
## [11] "velocidad_del_viento"     "rentas_de_no_registrados"
## [13] "rentas_de_registrados"    "rentas_totales"
summary(bd)
##       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
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

Paso 4. Evaluar, y en caso necesario ajustar, la regresión 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

Al realizar la regresión lineal pudimos descartar las variables que no nos iban a traer datos tan relevantes para nuestro modelo predictivo. Al hacer ese descarte, nos quedamos con las variables de hora, mes, año, temperatura, humedad y velocidad de viento. Nos podemos percatar de que el cambio en estas variables puede significar mayores o menores rentas y por consecuente, utilidad. Pienso que la variable que más afecta en este modelo es la temperatura ya que se muestra un aumento en las rentas de bicicletas cuando se encuentra una temperatura entre los 20-30 grados centígrados. Por el otro lado, las temperaturas de 0-10 y de 40 o más grados centígrados serían en dónde habría que aplicar una estrategia de mercadotecnia para hacerlas un poco más rentables.

LS0tCnRpdGxlOiAiTW9kZWxvIFByZWRpY3Rpdm86IFJlbnRhIGRlIEJpY2lzIgphdXRob3I6ICJFcmlja2EgTWFydMOtbmV6IC0gQTAxMTc3MDE3IgpkYXRlOiAiMjAyMi0wOS0wNSIKb3V0cHV0OiAKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKLS0tCgojIyA8aW1nIHNyYz0gIi9Vc2Vycy9Fcmlja2FNdHovRGVza3RvcC91cmJhbi1iaWtlLmpwZWciPgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBmaXJlYnJpY2siID4gKipNb2RlbG8gUHJlZGljdGl2bzogUmVudGEgZGUgQmljaWNsZXRhcyoqIDwvc3Bhbj4KCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IGRpbWdyYXkiID4gUGFzbyAxLiBJbXBvcnRhciBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4KYGBge3J9CmJkIDwtIHJlYWQuY3N2KCIvVXNlcnMvRXJpY2thTXR6L0Rvd25sb2Fkcy9yZW50YWRlYmljaXNfMi5jc3YiKQpgYGAKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IGRpbWdyYXkiID4gUGFzbyAyLiBFbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4KYGBge3J9CnJlc3VtZW4gPC0gc3VtbWFyeShiZCkKcmVzdW1lbgpwbG90KGJkJHRlbXBlcmF0dXJhLCBiZCRyZW50YXNfdG90YWxlcywgbWFpbiA9ICJJbmZsdWVuY2lhIGRlIGxhIFRlbXBlcmF0dXJhIHNvYnJlIGxhcyBSZW50YXMgVG90YWxlcyIsIHhsYWI9IlRlbXBlcmF0dXJhICjCukMpIiwgeWxhYj0gIkNhbnRpZGFkIikKYGBgCgojIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogZGltZ3JheSIgPiAqT2JzZXJ2YWNpb25lcyogPC9zcGFuPgoxLiDCv1BvciBxdcOpIGxvcyBkw61hcyBsbGVnYW4gaGFzdGEgZWwgMTkgeSBubyBoYXN0YSBlbCAzMT8KMi4gwr9RdcOpIHNpZ25pZmljYW4gbG9zIG7Dum1lcm9zIGVuIGxhcyBlc3RhY2lvbmVzPyBSOiAxIGVzIHByaW1hdmVyYSwgMiBlcyB2ZXJhbm8sIDMgZXMgb3Rvw7FvIHkgNCBlcyBpbnZpZXJuby4KCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogZGltZ3JheSIgPiBIZXJyYW1pZW50YSAiRWwgR2VuZXJhZG9yIGRlIFZhbG9yIGRlIERhdG9zIiAgPC9zcGFuPgoKKipQYXNvIDEuKiogRGVmaW5pciBlbCDDoXJlYSBkZWwgbmVnb2NpbyBxdWUgYnVzY2Ftb3MgaW1wYWN0YXJvIG1lam9yYXIgc3UgS1BJLiAgICAKRWwgKmRlcGFydGFtZW50byBkZSBtZXJjYWRvdGVjbmlhKiBzZXLDoSBlbCBpbXBhY3RhZG8geWEgcXVlIGRlYmVyw6FuIGRlIGVuY29udHJhciB1bmEgZXN0cmF0ZWdpYSBwYXJhIGV2aXRhciBxdWUgbGFzIHJlbnRhcyBkaXNtaW51eWFuIGVuIGNpZXJ0YXMgw6lwb2NhcyBkZWwgYcOxbyB5IHNpZW1wcmUgbWFudGVuZXJsYXMgY29uc3RhbnRvIG8gaW5jcmVtZW50YXJsYXMuIEVsICpLUEkqIHNlcsOtYSBlbCBuw7ptZXJvIGRlIHJlbnRhcyB4IHRlbXBlcmF0dXJhLiAgCioqUGFzbyAyLioqIFNlbGVjY2lvbmFyIHBsYW50aWxsYSAoLXMpIHBhcmEgY3JlYXIgdmFsb3IgYSBwYXJ0aXIgZGUgbG9zIGRhdG9zIGRlIGxvcyBjbGllbnRlcyAgIAoqKlZpc2nDs24qKiAvIFNlZ21lbnRhY2nDs24gLyBQZXJzb25hbGl6YWNpw7NuIC8gQ29udGV4dHVhbGl6YWNpw7NuICAgCioqUGFzbyAzLioqIEdlbmVyYXIgaWRlYXMgbyBjb25jZXB0b3MgZXNwZWPDrWZpY29zICAKRWxhYm9yYXIgdW4gbW9kZWxvIHByZWRpY3Rpdm8gZGUgcmVudGFzIG1lbnN1YWxlcyAgCioqUGFzbyA0LioqICBSZXVuaXIgbG9zIGRhdG9zIHJlcXVlcmlkb3MgIApFbGFib3JhciB1bmEgYmFzZSBkZSBkYXRvcyBjb24gbGEgdmFyaWFibGUgZGVwZW5kaWVudGUgKHJlbnRhcykgeSBsYXMgdmFyaWFibGVzIGluZGVwZW5kaWVudGVzICgqKnRlbXBlcmF0dXJhKiogeSBmZWNoYSkgCioqUGFzbyA1LioqIFBsYW4gZGUgZWplY3VjacOzbi4gIApNZXJjYWRvdGVjbmlhIGVsYWJvcmFyw6EgdW4gcGxhbiBwYXJhIGF1bWVudGFyIHkgaGFjZXIgY29uc3RhbnRlcyBsYXMgcmVudGFzIGEgdHJhdsOpcyBkZSB1biBtb2RlbG8gcHJlZGljdGl2by4gRWwgZXF1aXBvIHNlIGVuY2FyZ2Fyw6EgZGUgaWRlbnRpZmljYXIgbGFzIHNpdHVhY2lvbmVzIGVuIGxhcyBxdWUgbGFzIHJlbnRhcyBkaXNtaW51eWFuIHBhcmEgcG9kZXIgYXBsaWNhciBhbGfDum4gdGlwbyBkZSBkZXNjdWVudG8sIHByb21vY2nDs24gbyBjaWVydG8gYmVuZWZpY2lvIHF1ZSBwdWVkYSBhdHJhZXIgYSBsYSBnZW50ZSB5IGV2aXRhciBlc29zIGVzcGFjaW9zIG8gcHVudG9zIGVuIGxvcyBxdWUgbGEgdXRpbGlkYWQgcHVlZGEgY2Flci4KCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IGRpbWdyYXkiID4gUGFzbyAzLiBHZW5lcmFyIHJlZ3Jlc2nDs24gbGluZWFsIDwvc3Bhbj4KYGBge3J9CnJlZ3Jlc2lvbiA8LSBsbSAocmVudGFzX3RvdGFsZXMgfiBob3JhICsgZGlhICsgbWVzICsgYcOxbyArIGVzdGFjaW9uICsgZGlhX2RlX2xhX3NlbWFuYSArIGFzdWV0byArIHRlbXBlcmF0dXJhICsgc2Vuc2FjaW9uX3Rlcm1pY2EgKyBodW1lZGFkICsgdmVsb2NpZGFkX2RlbF92aWVudG8sIGRhdGE9YmQpCgpjb2xuYW1lcyhiZCkKCnN1bW1hcnkoYmQpCnN1bW1hcnkocmVncmVzaW9uKQpgYGAKCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IGRpbWdyYXkiID4gUGFzbyA0LiBFdmFsdWFyLCB5IGVuIGNhc28gbmVjZXNhcmlvIGFqdXN0YXIsIGxhIHJlZ3Jlc2nDs24gbGluZWFsIDwvc3Bhbj4KYGBge3J9CnJlZ3Jlc2lvbiA8LSBsbSAocmVudGFzX3RvdGFsZXMgfiBob3JhICsgbWVzICsgYcOxbyArIHNlbnNhY2lvbl90ZXJtaWNhICsgaHVtZWRhZCArIHZlbG9jaWRhZF9kZWxfdmllbnRvLCBkYXRhPWJkKQpzdW1tYXJ5IChyZWdyZXNpb24pCmBgYAoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogZGltZ3JheSIgPiBDb25zdHJ1aXIgTW9kZWxvIFByZWRpY3Rpdm8gPC9zcGFuPgpgYGB7cn0KZGF0b3NfbnVldm9zIDwtIGRhdGEuZnJhbWUoaG9yYT0xMiwgbWVzPTE6MTIsIGHDsW89MjAxMywgc2Vuc2FjaW9uX3Rlcm1pY2E9MjQsIGh1bWVkYWQ9NjIsIHZlbG9jaWRhZF9kZWxfdmllbnRvPTEzKQpwcmVkaWN0KHJlZ3Jlc2lvbixkYXRvc19udWV2b3MpCmBgYAoKIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogZGltZ3JheSIgPiBDb25jbHVzaW9uZXMgPC9zcGFuPgo8cCBzdHlsZT0ndGV4dC1hbGlnbjpqdXN0aWZ5Oyc+ICoqQWwgcmVhbGl6YXIgbGEgcmVncmVzacOzbiBsaW5lYWwgcHVkaW1vcyBkZXNjYXJ0YXIgbGFzIHZhcmlhYmxlcyBxdWUgbm8gbm9zIGliYW4gYSB0cmFlciBkYXRvcyB0YW4gcmVsZXZhbnRlcyBwYXJhIG51ZXN0cm8gbW9kZWxvIHByZWRpY3Rpdm8uIEFsIGhhY2VyIGVzZSBkZXNjYXJ0ZSwgbm9zIHF1ZWRhbW9zIGNvbiBsYXMgdmFyaWFibGVzIGRlIGhvcmEsIG1lcywgYcOxbywgdGVtcGVyYXR1cmEsIGh1bWVkYWQgeSB2ZWxvY2lkYWQgZGUgdmllbnRvLiBOb3MgcG9kZW1vcyBwZXJjYXRhciBkZSBxdWUgZWwgY2FtYmlvIGVuIGVzdGFzIHZhcmlhYmxlcyBwdWVkZSBzaWduaWZpY2FyIG1heW9yZXMgbyBtZW5vcmVzIHJlbnRhcyB5IHBvciBjb25zZWN1ZW50ZSwgdXRpbGlkYWQuIFBpZW5zbyBxdWUgbGEgdmFyaWFibGUgcXVlIG3DoXMgYWZlY3RhIGVuIGVzdGUgbW9kZWxvIGVzIGxhIHRlbXBlcmF0dXJhIHlhIHF1ZSBzZSBtdWVzdHJhIHVuIGF1bWVudG8gZW4gbGFzIHJlbnRhcyBkZSBiaWNpY2xldGFzIGN1YW5kbyBzZSBlbmN1ZW50cmEgdW5hIHRlbXBlcmF0dXJhIGVudHJlIGxvcyAyMC0zMCBncmFkb3MgY2VudMOtZ3JhZG9zLiBQb3IgZWwgb3RybyBsYWRvLCBsYXMgdGVtcGVyYXR1cmFzIGRlIDAtMTAgeSBkZSA0MCBvIG3DoXMgZ3JhZG9zIGNlbnTDrWdyYWRvcyBzZXLDrWFuIGVuIGTDs25kZSBoYWJyw61hIHF1ZSBhcGxpY2FyIHVuYSBlc3RyYXRlZ2lhIGRlIG1lcmNhZG90ZWNuaWEgcGFyYSBoYWNlcmxhcyB1biBwb2NvIG3DoXMgcmVudGFibGVzLioqIDwvcD4KCgo=