Actividad 4.3 - Regresión Lineal
Benjamín Reyes Sánchez A00830513
21-09-2023
Renta de Bicis
1. Importar Base de Datos
bicis <- read.csv("/Users/benjaminreyessanchez/Downloads/rentadebicis.csv")2. Enteder Base de Datos
summary(bicis) ## 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.0str(bicis) #si vemos variables de chr(palabras, cuali) van con count, sino con summary## 'data.frame': 10886 obs. of 14 variables:
## $ hora : int 0 1 2 3 4 5 6 7 8 9 ...
## $ dia : int 1 1 1 1 1 1 1 1 1 1 ...
## $ mes : int 1 1 1 1 1 1 1 1 1 1 ...
## $ año : int 2011 2011 2011 2011 2011 2011 2011 2011 2011 2011 ...
## $ estacion : int 1 1 1 1 1 1 1 1 1 1 ...
## $ dia_de_la_semana : int 6 6 6 6 6 6 6 6 6 6 ...
## $ asueto : int 0 0 0 0 0 0 0 0 0 0 ...
## $ temperatura : num 9.84 9.02 9.02 9.84 9.84 ...
## $ sensacion_termica : num 14.4 13.6 13.6 14.4 14.4 ...
## $ humedad : int 81 80 80 75 75 75 80 86 75 76 ...
## $ velocidad_del_viento : num 0 0 0 0 0 ...
## $ rentas_de_no_registrados: int 3 8 5 3 0 0 2 1 1 8 ...
## $ rentas_de_registrados : int 13 32 27 10 1 1 0 2 7 6 ...
## $ rentas_totales : int 16 40 32 13 1 1 2 3 8 14 ...Observaciones:
1. Los días llegan hasta el 19 y no hasta el 31
2. ¿Cuál es la relación entre estaciones? 1- Primavera, 2- Verano, 3-
Otoño, 4- Invierno.
3. ¿Cuál es la relación de los días de la semana? 1-Domingo, 2-Lunes,…
7- Sábado.
4. No ocupa limpieza de datos
3. Generar Regresión Lineal
regresión <- lm (rentas_totales ~ hora + dia + mes + año + estacion + dia_de_la_semana + asueto + temperatura + sensacion_termica + humedad + velocidad_del_viento, data=bicis)
summary(regresión)##
## Call:
## lm(formula = rentas_totales ~ hora + dia + mes + año + estacion +
## dia_de_la_semana + asueto + temperatura + sensacion_termica +
## humedad + velocidad_del_viento, data = bicis)
##
## 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-16Los asteriscos de P value representan que tan relevantes son las
variables de la base de datos.
Si tiene 3 asteriscos es lo ideal, 2 asteriscos es bueno, 1 o un punto
más o menos Si no tiene asteriscos no es relavante, por lo que se pueden
borrar las variables que no tienen asteriscos
4. Limitando Variables Relevantes
regresión_relev <- lm (rentas_totales ~ hora + mes + año + sensacion_termica + humedad + velocidad_del_viento, data=bicis)
summary(regresión_relev)##
## Call:
## lm(formula = rentas_totales ~ hora + mes + año + sensacion_termica +
## humedad + velocidad_del_viento, data = bicis)
##
## 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-16La regresión lineal grafica una línea en rojo
R2 y R2 ajustada son indicadores en porcentaje, entre más cercano a
100%, los puntos pasan más cerca de arriba de la regresión lineal
Ahorita tenemos un 39%, está bien por que no es ciencia exacta, si se
encuentran otras variables para hacerlo más exacto estaría ideal
5. Construir un Modelo Predictivo
datosm1 <- data.frame(hora=11.59, mes=1:12, año=2013, sensacion_termica=23.66, humedad=61.89, velocidad_del_viento=12.799)
predict(regresión_relev,datosm1)## 1 2 3 4 5 6 7 8
## 273.9868 281.5605 289.1343 296.7080 304.2817 311.8554 319.4291 327.0028
## 9 10 11 12
## 334.5765 342.1502 349.7240 357.2977Conclusiones
El modelo predictivo que realizamos nos muestra las bicicletas rentadas por hora por mes esperadas 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 Base de Datos
hpdata <- read.csv("/Users/benjaminreyessanchez/Downloads/HousePriceData.csv")Objetivo:
Predecir el precio de la casa
2. Enteder Base de Datos
summary(hpdata) ## 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
## str(hpdata) #si vemos variables de chr(palabras, cuali) van con count, sino con summary## 'data.frame': 905 obs. of 10 variables:
## $ Observation : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Dist_Taxi : int 9796 8294 11001 8301 10510 6665 13153 5882 7495 8233 ...
## $ Dist_Market : int 5250 8186 14399 11188 12629 5142 11869 9948 11589 7067 ...
## $ Dist_Hospital: int 10703 12694 16991 12289 13921 9972 17811 13315 13370 11400 ...
## $ Carpet : int 1659 1461 1340 1451 1770 1442 1542 1261 1090 1030 ...
## $ Builtup : int 1961 1752 1609 1748 2111 1733 1858 1507 1321 1235 ...
## $ Parking : chr "Open" "Not Provided" "Not Provided" "Covered" ...
## $ City_Category: chr "CAT B" "CAT B" "CAT A" "CAT B" ...
## $ Rainfall : int 530 210 720 620 450 760 1030 1020 680 1130 ...
## $ House_Price : int 6649000 3982000 5401000 5373000 4662000 4526000 7224000 3772000 4631000 4415000 ...library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unioncount(hpdata, Parking, sort=TRUE )## Parking n
## 1 Open 355
## 2 Not Provided 225
## 3 Covered 184
## 4 No Parking 141count(hpdata, City_Category, sort=TRUE)## City_Category n
## 1 CAT B 351
## 2 CAT A 320
## 3 CAT C 234#Revisar si tenemos NA's
sum(is.na(hpdata))## [1] 7sapply(hpdata, function(x) sum(is.na(x)))## 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#Limpiar NA's
hpdata<- na.omit(hpdata)
sapply(hpdata, function(x) sum(is.na(x)))## Observation Dist_Taxi Dist_Market Dist_Hospital Carpet
## 0 0 0 0 0
## Builtup Parking City_Category Rainfall House_Price
## 0 0 0 0 0#Eliminar datos negativos
hpdata <- hpdata[hpdata$Rainfall>0,]
count(hpdata, Rainfall, sort=TRUE)## Rainfall n
## 1 670 19
## 2 680 17
## 3 760 17
## 4 790 16
## 5 620 15
## 6 660 15
## 7 730 15
## 8 770 15
## 9 860 15
## 10 700 14
## 11 720 14
## 12 840 14
## 13 900 14
## 14 980 14
## 15 580 13
## 16 590 13
## 17 810 13
## 18 830 13
## 19 910 13
## 20 940 13
## 21 950 13
## 22 1020 13
## 23 1070 13
## 24 540 12
## 25 690 12
## 26 740 12
## 27 800 12
## 28 890 12
## 29 920 12
## 30 530 11
## 31 610 11
## 32 630 11
## 33 850 11
## 34 930 11
## 35 1080 11
## 36 370 10
## 37 480 10
## 38 560 10
## 39 600 10
## 40 650 10
## 41 750 10
## 42 870 10
## 43 710 9
## 44 780 9
## 45 880 9
## 46 990 9
## 47 460 8
## 48 490 8
## 49 570 8
## 50 820 8
## 51 1000 8
## 52 1140 8
## 53 1210 8
## 54 440 7
## 55 450 7
## 56 520 7
## 57 550 7
## 58 1030 7
## 59 1050 7
## 60 1060 7
## 61 1170 7
## 62 310 6
## 63 360 6
## 64 500 6
## 65 960 6
## 66 970 6
## 67 1010 6
## 68 1040 6
## 69 1090 6
## 70 1110 6
## 71 1160 6
## 72 1200 6
## 73 330 5
## 74 340 5
## 75 380 5
## 76 410 5
## 77 420 5
## 78 430 5
## 79 1120 5
## 80 1130 5
## 81 1220 5
## 82 1260 5
## 83 1100 4
## 84 1240 4
## 85 1340 4
## 86 210 3
## 87 290 3
## 88 320 3
## 89 350 3
## 90 390 3
## 91 510 3
## 92 640 3
## 93 1150 3
## 94 1180 3
## 95 1190 3
## 96 1270 3
## 97 220 2
## 98 230 2
## 99 280 2
## 100 300 2
## 101 400 2
## 102 470 2
## 103 1230 2
## 104 1250 2
## 105 1280 2
## 106 1290 2
## 107 1320 2
## 108 1330 2
## 109 1350 2
## 110 1410 2
## 111 1440 2
## 112 70 1
## 113 100 1
## 114 120 1
## 115 130 1
## 116 140 1
## 117 160 1
## 118 190 1
## 119 1300 1
## 120 1310 1
## 121 1370 1
## 122 1380 1
## 123 1390 1
## 124 1400 1
## 125 1450 1
## 126 1470 1
## 127 1490 1
## 128 1530 1
## 129 1560 1Observaciones:
1. Habían 7 NA’s en Carpet
2. Había un dato negativo en “Rainfall”
3. Hay dos precios de casa muy altos
3. Caja de Bigotes, Datos Outliers
#Identificar outliers
boxplot(hpdata$House_Price, horizontal = TRUE)
caja<-boxplot(hpdata$House_Price, col="skyblue", frame.plot=F)
#si tenemos outliers
caja$out## [1] 150000000 11632000#Eliminamos outliers
hpdata2<-hpdata[!(hpdata$House_Price %in% caja$out),]
boxplot(hpdata$House_Price, col="skyblue", frame.plot=F)
#Confirmamos
summary(hpdata2)## Observation Dist_Taxi Dist_Market Dist_Hospital Carpet
## Min. : 1.0 Min. : 146 Min. : 1666 Min. : 3227 Min. : 775
## 1st Qu.:236.2 1st Qu.: 6479 1st Qu.: 9368 1st Qu.:11301 1st Qu.:1317
## Median :469.5 Median : 8229 Median :11166 Median :13194 Median :1477
## Mean :469.3 Mean : 8233 Mean :11017 Mean :13087 Mean :1485
## 3rd Qu.:702.8 3rd Qu.: 9969 3rd Qu.:12673 3rd Qu.:14866 3rd Qu.:1653
## Max. :932.0 Max. :16850 Max. :18281 Max. :22407 Max. :2229
## Builtup Parking City_Category Rainfall
## Min. : 932 Length:894 Length:894 Min. : 70.0
## 1st Qu.:1576 Class :character Class :character 1st Qu.: 600.0
## Median :1774 Mode :character Mode :character Median : 780.0
## Mean :1782 Mean : 787.1
## 3rd Qu.:1982 3rd Qu.: 970.0
## Max. :2667 Max. :1560.0
## House_Price
## Min. : 1492000
## 1st Qu.: 4658000
## Median : 5860500
## Mean : 5930310
## 3rd Qu.: 7181750
## Max. :105150004. Generar Regresión Lineal
regresión_casas <- lm (House_Price ~ Observation + Dist_Taxi + Dist_Market + Dist_Hospital + Carpet + Builtup + Parking + City_Category + Rainfall, data=hpdata2)
summary(regresión_casas)##
## Call:
## lm(formula = House_Price ~ Observation + Dist_Taxi + Dist_Market +
## Dist_Hospital + Carpet + Builtup + Parking + City_Category +
## Rainfall, data = hpdata2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3688783 -796423 -31616 763900 4371434
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.441e+06 3.762e+05 14.466 < 2e-16 ***
## Observation 3.598e+02 1.516e+02 2.373 0.0179 *
## Dist_Taxi 3.059e+01 2.661e+01 1.150 0.2506
## Dist_Market 1.573e+01 2.067e+01 0.761 0.4469
## Dist_Hospital 4.700e+01 2.983e+01 1.575 0.1155
## Carpet 5.133e+02 3.461e+03 0.148 0.8822
## Builtup 2.275e+02 2.889e+03 0.079 0.9372
## ParkingNo Parking -6.370e+05 1.381e+05 -4.612 4.57e-06 ***
## ParkingNot Provided -4.868e+05 1.226e+05 -3.972 7.72e-05 ***
## ParkingOpen -2.638e+05 1.116e+05 -2.363 0.0184 *
## City_CategoryCAT B -1.853e+06 9.538e+04 -19.433 < 2e-16 ***
## City_CategoryCAT C -2.873e+06 1.051e+05 -27.342 < 2e-16 ***
## Rainfall -1.280e+02 1.545e+02 -0.828 0.4077
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1212000 on 881 degrees of freedom
## Multiple R-squared: 0.5042, Adjusted R-squared: 0.4974
## F-statistic: 74.65 on 12 and 881 DF, p-value: < 2.2e-16No limitamos por que quedarían solo dos variables
5. Construir un Modelo Predictivo
datos_casas <- data.frame(Observation =469 ,Carpet=1511 ,Builtup=1774 ,Parking= "Covered" ,City_Category= "CAT A",Dist_Taxi= 8233,Dist_Market=11017, Dist_Hospital= 13087,Rainfall= 787.1)
predict(regresión_casas,datos_casas)## 1
## 7728692Conclusiones
El modelo predictivo que realizamos nos muestra un valor esperado de la casa de $7,728,692, considerando cada variable como un promedio, con una R-cuadrada ajustada del 49.74%