Actividad 4.3 Regresión Lineal
José Alejandro Montaño A00830486
2023-09-21
Renta de Bicis
1. Importar la base de datos
2. Entender la base de datos
## 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.0Observaciones:
1. los días llegan hasta el 19 y no hasta el 31.
2. ¿Cuál es la relación de las estaciones? 1 es primavera, 2 verano, 3
otoño y 4 invierno.
3. ¿Cuál es la relación de los días de la semana ? 1 es domingo, 2 es
lunes, … y 7 es sabado.
3. Generar la 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=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-164. Ajustar la regresión lineal
regresion <- lm(rentas_totales ~ hora + mes + año + sensacion_termica + humedad + velocidad_del_viento, data=df)
summary(regresion)##
## 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-165. 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,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.9110Conclusiones
El modelo predictivo nos muestra las bicicletas rentadas por hora por mes durante el próximo año (2013), considerando las demás variables como promedio, con una R-cuadrada ajustada del 39%.
Renta de casas
1. Importar la base de datos
2. Entender la base de datos
## Observation Dist_Taxi Dist_Market Dist_Hospital
## Min. : 1.0 Min. : 146 Min. : 1666 Min. : 3227
## 1st Qu.:237.0 1st Qu.: 6477 1st Qu.: 9367 1st Qu.:11302
## Median :469.0 Median : 8228 Median :11149 Median :13189
## Mean :468.4 Mean : 8235 Mean :11022 Mean :13091
## 3rd Qu.:700.0 3rd Qu.: 9939 3rd Qu.:12675 3rd Qu.:14855
## Max. :932.0 Max. :20662 Max. :20945 Max. :23294
##
## Carpet Builtup Parking City_Category
## Min. : 775 Min. : 932 Length:905 Length:905
## 1st Qu.: 1317 1st Qu.: 1579 Class :character Class :character
## Median : 1478 Median : 1774 Mode :character Mode :character
## Mean : 1511 Mean : 1794
## 3rd Qu.: 1654 3rd Qu.: 1985
## Max. :24300 Max. :12730
## NA's :7
## Rainfall House_Price
## Min. :-110.0 Min. : 1492000
## 1st Qu.: 600.0 1st Qu.: 4623000
## Median : 780.0 Median : 5860000
## Mean : 786.9 Mean : 6083992
## 3rd Qu.: 970.0 3rd Qu.: 7200000
## Max. :1560.0 Max. :150000000
## ##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union## Parking n
## 1 Open 355
## 2 Not Provided 225
## 3 Covered 184
## 4 No Parking 141## City_Category n
## 1 CAT B 351
## 2 CAT A 320
## 3 CAT C 234
Observaciones:
1. El precio máximo de casa está con datos atípicos.
2. Rainfall tiene valores negativos.
3. La variable Carpet tiene NA.
3. Limpiar la base de datos
## [1] 7## Observation Dist_Taxi Dist_Market Dist_Hospital Carpet
## 0 0 0 0 7
## Builtup Parking City_Category Rainfall House_Price
## 0 0 0 0 0# Eliminar NA
bd <- na.omit(bd)
# Eliminar registro de precio alto
bd <- bd[bd$House_Price<15000000,]
boxplot(bd$House_Price, horizontal = TRUE)
4. Generar la regresión lineal
regresion_casas <- lm(House_Price ~ Dist_Taxi + Dist_Market + Dist_Hospital + Carpet + Builtup + Parking + City_Category + Rainfall, data=bd)
summary(regresion_casas)##
## Call:
## lm(formula = House_Price ~ Dist_Taxi + Dist_Market + Dist_Hospital +
## Carpet + Builtup + Parking + City_Category + Rainfall, data = bd)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3572286 -803711 -64861 759084 4399052
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.611e+06 3.681e+05 15.246 < 2e-16 ***
## Dist_Taxi 3.041e+01 2.684e+01 1.133 0.2575
## Dist_Market 1.248e+01 2.083e+01 0.599 0.5492
## Dist_Hospital 4.862e+01 3.009e+01 1.616 0.1065
## Carpet -7.734e+02 3.478e+03 -0.222 0.8241
## Builtup 1.315e+03 2.902e+03 0.453 0.6506
## ParkingNo Parking -6.046e+05 1.390e+05 -4.351 1.52e-05 ***
## ParkingNot Provided -4.898e+05 1.236e+05 -3.963 8.00e-05 ***
## ParkingOpen -2.635e+05 1.126e+05 -2.340 0.0195 *
## City_CategoryCAT B -1.875e+06 9.607e+04 -19.517 < 2e-16 ***
## City_CategoryCAT C -2.890e+06 1.059e+05 -27.291 < 2e-16 ***
## Rainfall -1.260e+02 1.558e+02 -0.809 0.4187
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1223000 on 883 degrees of freedom
## Multiple R-squared: 0.5005, Adjusted R-squared: 0.4943
## F-statistic: 80.43 on 11 and 883 DF, p-value: < 2.2e-16LS0tCnRpdGxlOiAiQWN0aXZpZGFkIDQuMyBSZWdyZXNpw7NuIExpbmVhbCIKYXV0aG9yOiAiSm9zw6kgQWxlamFuZHJvIE1vbnRhw7FvICBBMDA4MzA0ODYiCmRhdGU6ICIyMDIzLTA5LTIxIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogVFJVRSAKICAgIHRvY19mbG9hdDogVFJVRQogICAgY29kZV9kb3dubG9hZDogVFJVRQogICAgdGhlbWU6ICJzaW1wbGV4IgogICAgaGlnaGxpZ2h0OiAibW9ub2Nocm9tZSIKLS0tCgojIFJlbnRhIGRlIEJpY2lzCiFbXSgvVXNlcnMvYWxlamFuZHJvbW9udGFuby9EZXNrdG9wL21yYmVhbi1iaWtlLmdpZikKCiMjIDEuIEltcG9ydGFyIGxhIGJhc2UgZGUgZGF0b3MKYGBge3J9CiNmaWxlLmNob29zZSgpCmRmIDwtIHJlYWQuY3N2KCIvVXNlcnMvYWxlamFuZHJvbW9udGFuby9EZXNrdG9wL3JlbnRhZGViaWNpcy5jc3YiKQpgYGAKIyMgMi4gRW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvcwpgYGB7cn0Kc3VtbWFyeShkZikKYGBgCk9ic2VydmFjaW9uZXM6ICAKMS4gbG9zIGTDrWFzIGxsZWdhbiBoYXN0YSBlbCAxOSB5IG5vIGhhc3RhIGVsIDMxLiAgCjIuIMK/Q3XDoWwgZXMgbGEgcmVsYWNpw7NuIGRlIGxhcyBlc3RhY2lvbmVzPyAxIGVzIHByaW1hdmVyYSwgMiB2ZXJhbm8sIDMgb3Rvw7FvIHkgNCBpbnZpZXJuby4gIAozLiDCv0N1w6FsIGVzIGxhIHJlbGFjacOzbiBkZSBsb3MgZMOtYXMgZGUgbGEgc2VtYW5hID8gMSBlcyBkb21pbmdvLCAyIGVzIGx1bmVzLCAuLi4geSA3IGVzIHNhYmFkby4KCiMjIDMuIEdlbmVyYXIgbGEgcmVncmVzacOzbiBsaW5lYWwgCmBgYHtyfQpyZWdyZXNpb24gPC0gbG0ocmVudGFzX3RvdGFsZXMgfiBob3JhICsgZGlhICsgbWVzICsgYcOxbyArIGVzdGFjaW9uICsgZGlhX2RlX2xhX3NlbWFuYSArIGFzdWV0byArIHRlbXBlcmF0dXJhICsgc2Vuc2FjaW9uX3Rlcm1pY2EgKyBodW1lZGFkICsgdmVsb2NpZGFkX2RlbF92aWVudG8sIGRhdGE9ZGYpCnN1bW1hcnkocmVncmVzaW9uKQpgYGAKIyMgNC4gQWp1c3RhciBsYSByZWdyZXNpw7NuIGxpbmVhbCAKYGBge3J9CnJlZ3Jlc2lvbiA8LSBsbShyZW50YXNfdG90YWxlcyB+IGhvcmEgKyBtZXMgKyBhw7FvICArIHNlbnNhY2lvbl90ZXJtaWNhICsgaHVtZWRhZCArIHZlbG9jaWRhZF9kZWxfdmllbnRvLCBkYXRhPWRmKQpzdW1tYXJ5KHJlZ3Jlc2lvbikKYGBgCiMjIDUuIENvbnN0cnVpciB1biBtb2RlbG8gcHJlZGljdGl2byAKYGBge3J9CmRhdG9zIDwtIGRhdGEuZnJhbWUoaG9yYT0xMS41NCwgbWVzPTE6MTIsIGHDsW89MjAxMywgc2Vuc2FjaW9uX3Rlcm1pY2E9MjMuNjYsIGh1bWVkYWQ9NjEuODksIHZlbG9jaWRhZF9kZWxfdmllbnRvPTEyLjc5OSkKcHJlZGljdChyZWdyZXNpb24sZGF0b3MpCmBgYAojIyBDb25jbHVzaW9uZXMKRWwgbW9kZWxvIHByZWRpY3Rpdm8gbm9zIG11ZXN0cmEgbGFzIGJpY2ljbGV0YXMgcmVudGFkYXMgcG9yIGhvcmEgcG9yIG1lcyBkdXJhbnRlIGVsIHByw7N4aW1vIGHDsW8gKDIwMTMpLCBjb25zaWRlcmFuZG8gbGFzIGRlbcOhcyB2YXJpYWJsZXMgY29tbyBwcm9tZWRpbywgY29uIHVuYSBSLWN1YWRyYWRhIGFqdXN0YWRhIGRlbCAzOSUuIAoKCiMgUmVudGEgZGUgY2FzYXMKIVtdKC9Vc2Vycy9hbGVqYW5kcm9tb250YW5vL0Rlc2t0b3AvY2FzYS0yNi5naWYpCgojIyAxLiBJbXBvcnRhciBsYSBiYXNlIGRlIGRhdG9zCmBgYHtyfQojZmlsZS5jaG9vc2UoKQpiZCA8LSByZWFkLmNzdigiL1VzZXJzL2FsZWphbmRyb21vbnRhbm8vRGVza3RvcC9Ib3VzZVByaWNlRGF0YS5jc3YiKQpgYGAKIyMgMi4gRW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvcwpgYGB7cn0Kc3VtbWFyeShiZCkKI2luc3RhbGwucGFja2FnZXMoImRwbHlyIikKbGlicmFyeShkcGx5cikKY291bnQoYmQsUGFya2luZyxzb3J0ID0gVFJVRSkKY291bnQoYmQsQ2l0eV9DYXRlZ29yeSxzb3J0ID0gVFJVRSkKYm94cGxvdChiZCRIb3VzZV9QcmljZSwgaG9yaXpvbnRhbCA9IFQpCmBgYApPYnNlcnZhY2lvbmVzOiAgCjEuIEVsIHByZWNpbyBtw6F4aW1vIGRlIGNhc2EgZXN0w6EgY29uIGRhdG9zIGF0w61waWNvcy4gICAgICAgICAKMi4gUmFpbmZhbGwgdGllbmUgdmFsb3JlcyBuZWdhdGl2b3MuICAgICAKMy4gTGEgdmFyaWFibGUgQ2FycGV0IHRpZW5lIE5BLiAgICAgICAKCgojIyAzLiBMaW1waWFyIGxhIGJhc2UgZGUgZGF0b3MKYGBge3J9CiPCv0N1w6FudG9zIE5BIHRlbmdvIGVuIGxhIGJhc2UgZGUgZGF0b3M/CnN1bShpcy5uYShiZCkpCgojIMK/Q3XDoW50b3MgTkEgdGVuZ28gcG9yIHZhcmlhYmxlPwpzYXBwbHkoYmQsIGZ1bmN0aW9uKHgpIHN1bShpcy5uYSh4KSkpCgojIEVsaW1pbmFyIE5BCmJkIDwtIG5hLm9taXQoYmQpCgojIEVsaW1pbmFyIHJlZ2lzdHJvIGRlIHByZWNpbyBhbHRvIApiZCA8LSBiZFtiZCRIb3VzZV9QcmljZTwxNTAwMDAwMCxdCmJveHBsb3QoYmQkSG91c2VfUHJpY2UsIGhvcml6b250YWwgPSBUUlVFKQoKIyBFbGltaW5hciByZWdpc3RybyBuZWdhdGl2byBkZSBSYWluZmFsbApiZCA8LSBiZFtiZCRSYWluZmFsbD4wLF0KCmBgYAojIyA0LiBHZW5lcmFyIGxhIHJlZ3Jlc2nDs24gbGluZWFsIApgYGB7cn0KcmVncmVzaW9uX2Nhc2FzIDwtIGxtKEhvdXNlX1ByaWNlIH4gIERpc3RfVGF4aSArIERpc3RfTWFya2V0ICsgRGlzdF9Ib3NwaXRhbCArIENhcnBldCArIEJ1aWx0dXAgKyBQYXJraW5nICsgQ2l0eV9DYXRlZ29yeSArIFJhaW5mYWxsLCBkYXRhPWJkKQpzdW1tYXJ5KHJlZ3Jlc2lvbl9jYXNhcykKYGBgCiMjIDUuIENvbnN0cnVpciB1biBtb2RlbG8gcHJlZGljdGl2byAKYGBge3J9CmRhdGFzIDwtIGRhdGEuZnJhbWUoRGlzdF9UYXhpPTgyNzgsIERpc3RfTWFya2V0PTE2MjUxLCBEaXN0X0hvc3BpdGFsPTEzODU3LCBDYXJwZXQ9MTQ1NSwgQnVpbHR1cD0gMTc2NCwgUGFya2luZz0gIkNvdmVyZWQiLCBDaXR5X0NhdGVnb3J5PSJDQVQgQSIsIFJhaW5mYWxsPTM5MCkKcHJlZGljdChyZWdyZXNpb25fY2FzYXMsIGRhdGFzKQpgYGA=