Renta de Bicis

1. Importar Bases de datos

df<- read.csv("rentadebicis.csv")

2. Entender la base de datos

library(dplyr)
## Warning: package 'dplyr' was built under R version 4.1.3
## 
## 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
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

Observación; 1. los días llegan hasta el 19 y no hasta el 31

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

4. Ajustar el modelo de regresión lineal

regresion <- lm(rentas_totales ~ ï..hora + mes + aÃ.o  + sensacion_termica  + velocidad_del_viento + humedad , data=df )
summary(regresion)
## 
## Call:
## lm(formula = rentas_totales ~ ï..hora + mes + aÃ.o + sensacion_termica + 
##     velocidad_del_viento + humedad, 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 ***
## velocidad_del_viento  6.208e-01  1.771e-01   3.506 0.000457 ***
## humedad              -2.121e+00  7.858e-02 -26.988  < 2e-16 ***
## ---
## 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

5. Construir un modelo predictivo

datos<- data.frame..hora=11.54, mes=1:12, aÃ.o=2013, sensacion_termica=23.66, velocidad_del_viento=12.799, humedad=61.89)
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.9110

Valuacion de casas

Importar datos

df<- read.csv("HousePriceData.csv")

Limpiar bases de datos

# ¿Cuántos NA tengo en la base de datos?
sum(is.na(df))
## [1] 7
# ¿Cuantos NA tengo por variable?
sapply(df, 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
# Eliminar NA
df<- na.omit(df)

#Eliminar el registro del precio atípico
df<- df[df$House_Price<12000000,]

# eliminar el registro de lluvia atípico 
df<- df[df$Rainfall>=0,]
# Instala y carga la biblioteca Shiny
library(shiny)


# Define la interfaz de la aplicación Shiny
ui <- fluidPage(
  titlePanel("Valuación de Casas"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("Dist_Taxi", "Distancia al Taxi:", min = 0, max = 20000, value = 8278),
      sliderInput("Dist_Market", "Distancia al Mercado:", min = 0, max = 20000, value = 16251),
      sliderInput("Dist_Hospital", "Distancia al Hospital:", min = 0, max = 20000, value = 13857),
      sliderInput("Carpet", "Área de la Alfombra:", min = 0, max = 5000, value = 1455),
      selectInput("Parking", "Tipo de Estacionamiento:",
                  choices = unique(df$Parking)),
      selectInput("City_Category", "Categoría de la Ciudad:",
                  choices = unique(df$City_Category)),
      sliderInput("Rainfall", "Lluvia:", min = 0, max = 500, value = 390),
      sliderInput("Builtup", "Área Construida:", min = 0, max = 10000, value = 1764),
      actionButton("submitBtn", "Obtener Precio"),
      hr()
    ),
    mainPanel(
      verbatimTextOutput("predictionText")
    )
  )
)

# Define la función de servidor para la aplicación Shiny
server <- function(input, output) {
  model <- NULL
  
  observeEvent(input$submitBtn, {
    datos <- data.frame(
      Dist_Taxi = input$Dist_Taxi,
      Dist_Market = input$Dist_Market,
      Dist_Hospital = input$Dist_Hospital,
      Carpet = input$Carpet,
      Parking = input$Parking,
      City_Category = input$City_Category,
      Rainfall = input$Rainfall,
      Builtup = input$Builtup
    )
    
    # Generar el modelo de regresión lineal con los datos actuales
    model <- lm(House_Price ~ Dist_Taxi + Dist_Market + Dist_Hospital +
                Carpet + Parking + City_Category + Rainfall + Builtup, data = df)
    
    prediction <- predict(model, datos)
    output$predictionText <- renderText({
      paste("Precio de la Casa Estimado:", round(prediction, 2))
    })
  })
}

# Crea la aplicación Shiny
shinyApp(ui, server)
Shiny applications not supported in static R Markdown documents
LS0tDQp0aXRsZTogIlJlbnRhIGRlIEJpY2lzIg0KYXV0aG9yOiAiQW5kcsOpcyBHYXJjw61hX0EwMTE5NzQxMSINCmRhdGU6ICI5LzE5LzIwMjMiDQpvdXRwdXQ6IA0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogInNpbXBsZXgiDQogICAgaGlnaGxpZ2h0OiAicHlnbWVudHMiDQotLS0NCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+UmVudGEgZGUgQmljaXM8L3NwYW4+DQoNCiFbXShyZW50YS5qcGcpDQoNCiMjIDEuIEltcG9ydGFyIEJhc2VzIGRlIGRhdG9zDQoNCmBgYHtyfQ0KZGY8LSByZWFkLmNzdigicmVudGFkZWJpY2lzLmNzdiIpDQoNCmBgYA0KDQojIyAyLiBFbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zDQoNCmBgYHtyfQ0KbGlicmFyeShkcGx5cikNCnN1bW1hcnkoZGYpDQpgYGANCk9ic2VydmFjacOzbjsNCjEuIGxvcyBkw61hcyBsbGVnYW4gaGFzdGEgZWwgMTkgeSBubyBoYXN0YSBlbCAzMQ0KDQojIyAzLiBHZW5lcmFyIGxhIHJlZ3Jlc2nDs24gbGluZWFsIA0KDQpgYGB7cn0NCnJlZ3Jlc2lvbiA8LSBsbShyZW50YXNfdG90YWxlcyB+IMOvLi5ob3JhICsgZGlhKyBtZXMgKyBhw4MubyArIGVzdGFjaW9uICsgZGlhX2RlX2xhX3NlbWFuYSArIGFzdWV0byArIHRlbXBlcmF0dXJhICsgc2Vuc2FjaW9uX3Rlcm1pY2EgKyBodW1lZGFkICsgdmVsb2NpZGFkX2RlbF92aWVudG8gKyBodW1lZGFkICsgdmVsb2NpZGFkX2RlbF92aWVudG8sIGRhdGE9ZGYgKQ0Kc3VtbWFyeShyZWdyZXNpb24pDQpgYGANCg0KIyMgNC4gQWp1c3RhciBlbCBtb2RlbG8gZGUgcmVncmVzacOzbiBsaW5lYWwgDQoNCmBgYHtyfQ0KcmVncmVzaW9uIDwtIGxtKHJlbnRhc190b3RhbGVzIH4gw68uLmhvcmEgKyBtZXMgKyBhw4MubyAgKyBzZW5zYWNpb25fdGVybWljYSAgKyB2ZWxvY2lkYWRfZGVsX3ZpZW50byArIGh1bWVkYWQgLCBkYXRhPWRmICkNCnN1bW1hcnkocmVncmVzaW9uKQ0KDQpgYGANCg0KIyMgNS4gQ29uc3RydWlyIHVuIG1vZGVsbyBwcmVkaWN0aXZvIA0KDQpgYGB7cn0NCmRhdG9zPC0gZGF0YS5mcmFtZSjDry4uaG9yYT0xMS41NCwgbWVzPTE6MTIsIGHDgy5vPTIwMTMsIHNlbnNhY2lvbl90ZXJtaWNhPTIzLjY2LCB2ZWxvY2lkYWRfZGVsX3ZpZW50bz0xMi43OTksIGh1bWVkYWQ9NjEuODkpDQpwcmVkaWN0KHJlZ3Jlc2lvbixkYXRvcykNCmBgYA0KDQojIFZhbHVhY2lvbiBkZSBjYXNhcw0KDQojIyBJbXBvcnRhciBkYXRvcw0KYGBge3J9DQoNCmRmPC0gcmVhZC5jc3YoIkhvdXNlUHJpY2VEYXRhLmNzdiIpDQoNCmBgYA0KDQojIyBMaW1waWFyIGJhc2VzIGRlIGRhdG9zIA0KYGBge3J9DQojIMK/Q3XDoW50b3MgTkEgdGVuZ28gZW4gbGEgYmFzZSBkZSBkYXRvcz8NCnN1bShpcy5uYShkZikpDQoNCiMgwr9DdWFudG9zIE5BIHRlbmdvIHBvciB2YXJpYWJsZT8NCnNhcHBseShkZiwgZnVuY3Rpb24oeCkgc3VtKGlzLm5hKHgpKSkNCg0KIyBFbGltaW5hciBOQQ0KZGY8LSBuYS5vbWl0KGRmKQ0KDQojRWxpbWluYXIgZWwgcmVnaXN0cm8gZGVsIHByZWNpbyBhdMOtcGljbw0KZGY8LSBkZltkZiRIb3VzZV9QcmljZTwxMjAwMDAwMCxdDQoNCiMgZWxpbWluYXIgZWwgcmVnaXN0cm8gZGUgbGx1dmlhIGF0w61waWNvIA0KZGY8LSBkZltkZiRSYWluZmFsbD49MCxdDQpgYGANCg0KYGBge3J9DQojIEluc3RhbGEgeSBjYXJnYSBsYSBiaWJsaW90ZWNhIFNoaW55DQpsaWJyYXJ5KHNoaW55KQ0KDQoNCiMgRGVmaW5lIGxhIGludGVyZmF6IGRlIGxhIGFwbGljYWNpw7NuIFNoaW55DQp1aSA8LSBmbHVpZFBhZ2UoDQogIHRpdGxlUGFuZWwoIlZhbHVhY2nDs24gZGUgQ2FzYXMiKSwNCiAgc2lkZWJhckxheW91dCgNCiAgICBzaWRlYmFyUGFuZWwoDQogICAgICBzbGlkZXJJbnB1dCgiRGlzdF9UYXhpIiwgIkRpc3RhbmNpYSBhbCBUYXhpOiIsIG1pbiA9IDAsIG1heCA9IDIwMDAwLCB2YWx1ZSA9IDgyNzgpLA0KICAgICAgc2xpZGVySW5wdXQoIkRpc3RfTWFya2V0IiwgIkRpc3RhbmNpYSBhbCBNZXJjYWRvOiIsIG1pbiA9IDAsIG1heCA9IDIwMDAwLCB2YWx1ZSA9IDE2MjUxKSwNCiAgICAgIHNsaWRlcklucHV0KCJEaXN0X0hvc3BpdGFsIiwgIkRpc3RhbmNpYSBhbCBIb3NwaXRhbDoiLCBtaW4gPSAwLCBtYXggPSAyMDAwMCwgdmFsdWUgPSAxMzg1NyksDQogICAgICBzbGlkZXJJbnB1dCgiQ2FycGV0IiwgIsOBcmVhIGRlIGxhIEFsZm9tYnJhOiIsIG1pbiA9IDAsIG1heCA9IDUwMDAsIHZhbHVlID0gMTQ1NSksDQogICAgICBzZWxlY3RJbnB1dCgiUGFya2luZyIsICJUaXBvIGRlIEVzdGFjaW9uYW1pZW50bzoiLA0KICAgICAgICAgICAgICAgICAgY2hvaWNlcyA9IHVuaXF1ZShkZiRQYXJraW5nKSksDQogICAgICBzZWxlY3RJbnB1dCgiQ2l0eV9DYXRlZ29yeSIsICJDYXRlZ29yw61hIGRlIGxhIENpdWRhZDoiLA0KICAgICAgICAgICAgICAgICAgY2hvaWNlcyA9IHVuaXF1ZShkZiRDaXR5X0NhdGVnb3J5KSksDQogICAgICBzbGlkZXJJbnB1dCgiUmFpbmZhbGwiLCAiTGx1dmlhOiIsIG1pbiA9IDAsIG1heCA9IDUwMCwgdmFsdWUgPSAzOTApLA0KICAgICAgc2xpZGVySW5wdXQoIkJ1aWx0dXAiLCAiw4FyZWEgQ29uc3RydWlkYToiLCBtaW4gPSAwLCBtYXggPSAxMDAwMCwgdmFsdWUgPSAxNzY0KSwNCiAgICAgIGFjdGlvbkJ1dHRvbigic3VibWl0QnRuIiwgIk9idGVuZXIgUHJlY2lvIiksDQogICAgICBocigpDQogICAgKSwNCiAgICBtYWluUGFuZWwoDQogICAgICB2ZXJiYXRpbVRleHRPdXRwdXQoInByZWRpY3Rpb25UZXh0IikNCiAgICApDQogICkNCikNCg0KIyBEZWZpbmUgbGEgZnVuY2nDs24gZGUgc2Vydmlkb3IgcGFyYSBsYSBhcGxpY2FjacOzbiBTaGlueQ0Kc2VydmVyIDwtIGZ1bmN0aW9uKGlucHV0LCBvdXRwdXQpIHsNCiAgbW9kZWwgPC0gTlVMTA0KICANCiAgb2JzZXJ2ZUV2ZW50KGlucHV0JHN1Ym1pdEJ0biwgew0KICAgIGRhdG9zIDwtIGRhdGEuZnJhbWUoDQogICAgICBEaXN0X1RheGkgPSBpbnB1dCREaXN0X1RheGksDQogICAgICBEaXN0X01hcmtldCA9IGlucHV0JERpc3RfTWFya2V0LA0KICAgICAgRGlzdF9Ib3NwaXRhbCA9IGlucHV0JERpc3RfSG9zcGl0YWwsDQogICAgICBDYXJwZXQgPSBpbnB1dCRDYXJwZXQsDQogICAgICBQYXJraW5nID0gaW5wdXQkUGFya2luZywNCiAgICAgIENpdHlfQ2F0ZWdvcnkgPSBpbnB1dCRDaXR5X0NhdGVnb3J5LA0KICAgICAgUmFpbmZhbGwgPSBpbnB1dCRSYWluZmFsbCwNCiAgICAgIEJ1aWx0dXAgPSBpbnB1dCRCdWlsdHVwDQogICAgKQ0KICAgIA0KICAgICMgR2VuZXJhciBlbCBtb2RlbG8gZGUgcmVncmVzacOzbiBsaW5lYWwgY29uIGxvcyBkYXRvcyBhY3R1YWxlcw0KICAgIG1vZGVsIDwtIGxtKEhvdXNlX1ByaWNlIH4gRGlzdF9UYXhpICsgRGlzdF9NYXJrZXQgKyBEaXN0X0hvc3BpdGFsICsNCiAgICAgICAgICAgICAgICBDYXJwZXQgKyBQYXJraW5nICsgQ2l0eV9DYXRlZ29yeSArIFJhaW5mYWxsICsgQnVpbHR1cCwgZGF0YSA9IGRmKQ0KICAgIA0KICAgIHByZWRpY3Rpb24gPC0gcHJlZGljdChtb2RlbCwgZGF0b3MpDQogICAgb3V0cHV0JHByZWRpY3Rpb25UZXh0IDwtIHJlbmRlclRleHQoew0KICAgICAgcGFzdGUoIlByZWNpbyBkZSBsYSBDYXNhIEVzdGltYWRvOiIsIHJvdW5kKHByZWRpY3Rpb24sIDIpKQ0KICAgIH0pDQogIH0pDQp9DQoNCiMgQ3JlYSBsYSBhcGxpY2FjacOzbiBTaGlueQ0Kc2hpbnlBcHAodWksIHNlcnZlcikNCg0KYGBg