Actividad 4.3 Regresión Lineal

Renta de bicis

1. Importar base de datos

#file.choose()
df <- read.csv("C:\\Users\\Lesgo\\Downloads\\rentadebicis.csv")

2. Enteder base de datos

summary(df) 

##       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

str(df) #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=df)
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 = 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

Los 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=df)
summary(regresión_relev)

## 
## 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

La 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

datos <- 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,datos)

##        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.2977

Conclusiones

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 base de datos

#file.choose()
dfc <- read.csv("C:\\Users\\Lesgo\\Downloads\\HousePriceData.csv")

Objetivo:
Predecir el precio de la casa

2. Enteder base de datos

summary(dfc) 

##   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(dfc) #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, union

count(dfc, Parking, sort=TRUE )

##        Parking   n
## 1         Open 355
## 2 Not Provided 225
## 3      Covered 184
## 4   No Parking 141

count(dfc, 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(dfc))

## [1] 7

sapply(dfc, 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
dfc<- na.omit(dfc) 
sapply(dfc, 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
dfc <- dfc[dfc$Rainfall>0,]
count(dfc, 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  1

Observaciones:
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(dfc$House_Price, horizontal = TRUE)

caja<-boxplot(dfc$House_Price, col="skyblue", frame.plot=F)
#si tenemos outliers
caja$out

## [1] 150000000  11632000

#Eliminamos outliers
dfc2<-dfc[!(dfc$House_Price %in% caja$out),]
boxplot(dfc$House_Price, col="skyblue", frame.plot=F)

#Confirmamos
summary(dfc2)

##   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.   :10515000

4. Generar regresión lineal

regresión_casas <- lm (House_Price ~ Observation + Dist_Taxi + Dist_Market + Dist_Hospital + Carpet + Builtup + Parking + City_Category + Rainfall, data=dfc2)
summary(regresión_casas)

## 
## Call:
## lm(formula = House_Price ~ Observation + Dist_Taxi + Dist_Market + 
##     Dist_Hospital + Carpet + Builtup + Parking + City_Category + 
##     Rainfall, data = dfc2)
## 
## 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-16

No 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 
## 7728692

Conclusiones

El modelo predictivo nos muestra el valor de la casa de $7,728,692, considerando las variables como promedio, con una R-cuadrada ajustada del 50%