Caso C&A
Enunciado
Maria comenzó como agente de bienes raÃces en Cali hace 10 años. Después de laborar dos años para una empresa nacional, se traslado a Bogotá y trabajó para otra agencia de bienes raÃces. Sus amigos y familiares la convencieron de que con su experiencia y conocimientos del negocio debÃa abrir su propia agencia. Terminó por adquirir la licencia de intermediario y al poco tiempo fundó su propia compañÃa, C&A (Casas y Apartamentos) en Cali. Santiago y Lina, dos vendedores de la empresa anterior aceptaron trabajar en la nueva compaña. En la actualidad ocho agentes de bienes raÃces colaboran con ella en C-A.
Actualmente las ventas de bienes raÃces en Cali se han visto disminuidas de manera significativa en lo corrido del año. Durante este periodo muchas instituciones bancarias de ahorro y vivienda están prestando grandes sumas de dinero para la industria y la construcción comercial y residencial. Cuando el efecto producto de las tensiones polÃticas y sociales disminuya, se espera que la actividad económica de este sector se reactive.
Hace dos dÃas, MarÃa recibió una carta solicitando asesorÃa para la compra de dos viviendas por parte de una compañÃa internacional que desea ubicar a dos de sus empleados con sus familias en la ciudad. Las solicitudes incluyen las siguientes condiciones:
CaracterÃsticas Vivienda 1 Vivienda 2 Tipo Casa Apartamento área construida 200 300 parqueaderos 1 3 baños 2 3 habitaciones 4 5 estrato 4 o 5 5 o 6 zona Norte Sur crédito preaprobado 350 millones 850 millones
Ayude a MarÃa a responder la solicitud, mediante técnicas modelación que usted conoce. Ella requiere le envÃe un informe ejecutivo donde analice los dos casos y sus recomendaciones (Informe). Como soporte del informe debe anexar las estimaciones, validaciones y comparación de modelos requeridos (Anexos) .
Depuración de los datos
como primera etapa del proceso se procede a evaluar si estan todos los registros para las varibles que estan incluidas en la base de datos.
# Para encontrar valores vacÃos en todo el conjunto de datos
library(mice)
head(vivienda)
## # A tibble: 6 × 13
## id zona piso estrato preciom areaconst parqueaderos banios habitaciones
## <dbl> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1147 Zona O… <NA> 3 250 70 1 3 6
## 2 1169 Zona O… <NA> 3 320 120 1 2 3
## 3 1350 Zona O… <NA> 3 350 220 2 2 4
## 4 5992 Zona S… 02 4 400 280 3 5 3
## 5 1212 Zona N… 01 5 260 90 1 2 3
## 6 1724 Zona N… 01 5 240 87 1 3 3
## # ℹ 4 more variables: tipo <chr>, barrio <chr>, longitud <dbl>, latitud <dbl>
md.pattern(vivienda,rotate.names = TRUE)
## preciom id zona estrato areaconst banios habitaciones tipo barrio longitud
## 4808 1 1 1 1 1 1 1 1 1 1
## 1909 1 1 1 1 1 1 1 1 1 1
## 876 1 1 1 1 1 1 1 1 1 1
## 726 1 1 1 1 1 1 1 1 1 1
## 1 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0 0
## 2 3 3 3 3 3 3 3 3 3
## latitud parqueaderos piso
## 4808 1 1 1 0
## 1909 1 1 0 1
## 876 1 0 1 1
## 726 1 0 0 2
## 1 0 0 0 12
## 2 0 0 0 13
## 3 1605 2638 4275
vivienda2 <- data.frame(vivienda)
md.pattern(vivienda2,rotate.names = TRUE)
## preciom id zona estrato areaconst banios habitaciones tipo barrio longitud
## 4808 1 1 1 1 1 1 1 1 1 1
## 1909 1 1 1 1 1 1 1 1 1 1
## 876 1 1 1 1 1 1 1 1 1 1
## 726 1 1 1 1 1 1 1 1 1 1
## 1 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0 0
## 2 3 3 3 3 3 3 3 3 3
## latitud parqueaderos piso
## 4808 1 1 1 0
## 1909 1 1 0 1
## 876 1 0 1 1
## 726 1 0 0 2
## 1 0 0 0 12
## 2 0 0 0 13
## 3 1605 2638 4275
Se identifica que hay campos sin datos y se procede a depurar la base de datos. como primera instancia se retiran los campos vacios
# Identificar que campos estan vacio
valores_vacios <- apply(vivienda, 2, function(x) sum(is.na(x)))
print (valores_vacios)
## id zona piso estrato preciom areaconst
## 3 3 2638 3 2 3
## parqueaderos banios habitaciones tipo barrio longitud
## 1605 3 3 3 3 3
## latitud
## 3
Se hace imputación en las variables parqueaderos, piso y se omiten los datos faltantes.
#imputar parqueaderos
vivienda2$parqueaderos[is.na(vivienda2$parqueaderos)] <-0
#imputar piso
vivienda2$piso[is.na(vivienda2$piso)] <-0
#imputar datos faltantes
vivienda2 <-na.omit(vivienda2)
md.pattern(vivienda2,rotate.names = TRUE)
## /\ /\
## { `---' }
## { O O }
## ==> V <== No need for mice. This data set is completely observed.
## \ \|/ /
## `-----'
## id zona piso estrato preciom areaconst parqueaderos banios habitaciones
## 8319 1 1 1 1 1 1 1 1 1
## 0 0 0 0 0 0 0 0 0
## tipo barrio longitud latitud
## 8319 1 1 1 1 0
## 0 0 0 0 0
Se hace conversión de las variables:
en numericas, para poder procesar los registros.
#convertir en numerico los campos piso, preciom, aream , baños, habitaciones.
vivienda2$piso <-as.numeric(vivienda2$piso)
vivienda2$estrato <-as.numeric(vivienda2$estrato)
vivienda2$preciom <-as.numeric(vivienda2$preciom)
vivienda2$areaconst <-as.numeric(vivienda2$areaconst)
vivienda2$banios <-as.numeric(vivienda2$banios)
vivienda2$habitaciones <-as.numeric(vivienda2$habitaciones)
str(vivienda2)
## 'data.frame': 8319 obs. of 13 variables:
## $ id : num 1147 1169 1350 5992 1212 ...
## $ zona : chr "Zona Oriente" "Zona Oriente" "Zona Oriente" "Zona Sur" ...
## $ piso : num 0 0 0 2 1 1 1 1 2 2 ...
## $ estrato : num 3 3 3 4 5 5 4 5 5 5 ...
## $ preciom : num 250 320 350 400 260 240 220 310 320 780 ...
## $ areaconst : num 70 120 220 280 90 87 52 137 150 380 ...
## $ parqueaderos: num 1 1 2 3 1 1 2 2 2 2 ...
## $ banios : num 3 2 2 5 2 3 2 3 4 3 ...
## $ habitaciones: num 6 3 4 3 3 3 3 4 6 3 ...
## $ tipo : chr "Casa" "Casa" "Casa" "Casa" ...
## $ barrio : chr "20 de julio" "20 de julio" "20 de julio" "3 de julio" ...
## $ longitud : num -76.5 -76.5 -76.5 -76.5 -76.5 ...
## $ latitud : num 3.43 3.43 3.44 3.44 3.46 ...
## - attr(*, "na.action")= 'omit' Named int [1:3] 8320 8321 8322
## ..- attr(*, "names")= chr [1:3] "8320" "8321" "8322"
Analisis de Casos.
El primer caso de estudio solicita hacer estimación de casas, ubicadas en el norte. Para ello se utiliza un filtro donde solo se tengan los registros que cumplen estas dos condiciones. para ello se usa la funcion filter.
#Realizar filtro de la BD vivienda2
caso1 <- vivienda2 %>% filter(tipo=="Casa" & zona=="Zona Norte" )
str(caso1)
## 'data.frame': 722 obs. of 13 variables:
## $ id : num 1209 1592 4057 4460 6081 ...
## $ zona : chr "Zona Norte" "Zona Norte" "Zona Norte" "Zona Norte" ...
## $ piso : num 2 2 2 2 2 2 2 3 0 0 ...
## $ estrato : num 5 5 6 4 5 4 5 5 3 3 ...
## $ preciom : num 320 780 750 625 750 600 420 490 230 190 ...
## $ areaconst : num 150 380 445 355 237 160 200 118 160 435 ...
## $ parqueaderos: num 2 2 0 3 2 1 4 2 0 0 ...
## $ banios : num 4 3 7 5 6 4 4 4 2 0 ...
## $ habitaciones: num 6 3 6 5 6 5 5 4 3 0 ...
## $ tipo : chr "Casa" "Casa" "Casa" "Casa" ...
## $ barrio : chr "acopi" "acopi" "acopi" "acopi" ...
## $ longitud : num -76.5 -76.5 -76.5 -76.5 -76.5 ...
## $ latitud : num 3.48 3.49 3.39 3.41 3.37 ...
## - attr(*, "na.action")= 'omit' Named int [1:3] 8320 8321 8322
## ..- attr(*, "names")= chr [1:3] "8320" "8321" "8322"
Una vez se tiene el filtro de procede a realizar un mapa para localizar las casas ubicadas en el norte de la ciudad.
#install.packages("leaflet")
library(leaflet)
oferta1 <- data.frame(
lat=caso1$latitud,
long=caso1$longitud
)
summary(oferta1)
## lat long
## Min. :3.333 Min. :-76.59
## 1st Qu.:3.452 1st Qu.:-76.53
## Median :3.468 Median :-76.52
## Mean :3.460 Mean :-76.52
## 3rd Qu.:3.482 3rd Qu.:-76.50
## Max. :3.496 Max. :-76.47
Al realizar el mapa se identifican que hay casa que no estan ubicadas en el norte de la ciudad.
# Muestra el mapa
#Crea un mapa
map <- leaflet(oferta1) %>%
addTiles() %>%
addMarkers(
lng = ~ long,
lat = ~ lat,
#popup = ~as.character(lat) # Puedes personalizar el contenido del popup aquÃ
popup = ~as.character(long)
)
map
Con el fin de tener datos concentrados en el norte de la ciudad se hace un filtro adicional donde :
caso1 <- vivienda2 %>% filter(tipo=="Casa" & zona=="Zona Norte" & latitud>=3.478 & longitud>=-76.529)
#-76.54294
str(caso1)
## 'data.frame': 214 obs. of 13 variables:
## $ id : num 1209 1592 2875 2908 3182 ...
## $ zona : chr "Zona Norte" "Zona Norte" "Zona Norte" "Zona Norte" ...
## $ piso : num 2 2 0 0 0 0 0 0 1 2 ...
## $ estrato : num 5 5 5 5 4 3 3 3 3 3 ...
## $ preciom : num 320 780 390 780 420 280 250 240 135 153 ...
## $ areaconst : num 150 380 357 380 265 148 135 62 90 80 ...
## $ parqueaderos: num 2 2 0 0 0 2 0 0 0 0 ...
## $ banios : num 4 3 3 3 6 4 3 2 2 2 ...
## $ habitaciones: num 6 3 6 3 7 4 4 3 4 3 ...
## $ tipo : chr "Casa" "Casa" "Casa" "Casa" ...
## $ barrio : chr "acopi" "acopi" "acopi" "acopi" ...
## $ longitud : num -76.5 -76.5 -76.5 -76.5 -76.5 ...
## $ latitud : num 3.48 3.49 3.48 3.48 3.48 ...
## - attr(*, "na.action")= 'omit' Named int [1:3] 8320 8321 8322
## ..- attr(*, "names")= chr [1:3] "8320" "8321" "8322"
oferta1 <- data.frame(
lat=caso1$latitud,
long=caso1$longitud
)
summary(oferta1)
## lat long
## Min. :3.478 Min. :-76.53
## 1st Qu.:3.482 1st Qu.:-76.52
## Median :3.484 Median :-76.52
## Mean :3.485 Mean :-76.51
## 3rd Qu.:3.488 3rd Qu.:-76.50
## Max. :3.496 Max. :-76.48
Se valida con las nuevas localizaciones de las casas y se logra una mejor segmentación de los datos.
# Crea un mapa
map <- leaflet(oferta1) %>%
addTiles() %>%
addMarkers(
lng = ~ long,
lat = ~ lat,
#popup = ~as.character(lat) # Puedes personalizar el contenido del popup aquÃ
popup = ~as.character(long)
)
map
Posteriormente se toman las variables de analisis de correlacion de las variables estrato, areaconst, banios, habitaciones y la variable objetivo preciom
caso1 <- caso1[,c(4,6,8,7,9,5)]
cor(caso1)
## estrato areaconst banios parqueaderos habitaciones preciom
## estrato 1.00000000 0.5329213 0.4092125 0.4427823 0.04796746 0.6232494
## areaconst 0.53292133 1.0000000 0.5922063 0.3760983 0.37140979 0.7462440
## banios 0.40921253 0.5922063 1.0000000 0.4030626 0.50506880 0.5320400
## parqueaderos 0.44278228 0.3760983 0.4030626 1.0000000 0.12804739 0.4927094
## habitaciones 0.04796746 0.3714098 0.5050688 0.1280474 1.00000000 0.2506163
## preciom 0.62324944 0.7462440 0.5320400 0.4927094 0.25061633 1.0000000
Entre las variable no se identifica una fuerte corelación, por lo tanto se puede predecir que no hay multicolinealidad. las variables que podrian tener alguna relacion son las habitacione y los baños.
la variable objetivo (preciom), tiene una mayor correlacion con las variables independiente estrato y areaconst.
library(GGally)
ggpairs(caso1,title = " ")
Se realiza el proceso de regresión lineal de multivariables y se obtiene el siguiente resultado, donde :
R(cuadrado) es de: 63.65%
modelo1 <- lm(preciom ~ estrato+areaconst+banios+habitaciones+parqueaderos, data=caso1)
summary(modelo1)
##
## Call:
## lm(formula = preciom ~ estrato + areaconst + banios + habitaciones +
## parqueaderos, data = caso1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -305.23 -55.63 -9.63 31.93 923.58
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -108.55426 52.32112 -2.075 0.039238 *
## estrato 59.39833 12.40327 4.789 3.18e-06 ***
## areaconst 0.80039 0.08731 9.168 < 2e-16 ***
## banios 9.96700 9.71238 1.026 0.305982
## habitaciones -0.61867 6.82546 -0.091 0.927865
## parqueaderos 20.19878 5.85310 3.451 0.000676 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 117.4 on 208 degrees of freedom
## Multiple R-squared: 0.6536, Adjusted R-squared: 0.6453
## F-statistic: 78.51 on 5 and 208 DF, p-value: < 2.2e-16
# se define el modelo ingenuo y= b0
modelo_b0<- lm(preciom ~ 1, data=caso1)
#define model with all predictors
modelo_all <- lm(preciom ~ estrato+areaconst+habitaciones+banios+parqueaderos, data=caso1)
# Se aplica el proceso forward stepwise regression
forward <- step(modelo_b0, direction='forward', scope=formula(modelo_all), trace=0)
# Visualización de los resultados
forward$anova
## Step Df Deviance Resid. Df Resid. Dev AIC
## 1 NA NA 213 8283318 2262.649
## 2 + areaconst -1 4612814.7 212 3670503 2090.471
## 3 + estrato -1 588598.3 211 3081905 2055.068
## 4 + parqueaderos -1 196432.5 210 2885472 2042.974
# resultado final del modelo
summary(forward)
##
## Call:
## lm(formula = preciom ~ areaconst + estrato + parqueaderos, data = caso1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -316.74 -55.98 -9.12 38.89 912.03
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -94.54952 43.62923 -2.167 0.031351 *
## areaconst 0.84145 0.07573 11.111 < 2e-16 ***
## estrato 60.56074 11.97857 5.056 9.32e-07 ***
## parqueaderos 21.56734 5.70412 3.781 0.000204 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 117.2 on 210 degrees of freedom
## Multiple R-squared: 0.6517, Adjusted R-squared: 0.6467
## F-statistic: 130.9 on 3 and 210 DF, p-value: < 2.2e-16
#-------------------------------------------------------------------------------
library(boot)
# Se define la función que devuelve el estadÃstico de interés, los coeficientes
# de regresión
fun_coeficientes <- function(data, index){
return(coef(lm(preciom ~ estrato+areaconst+banios+habitaciones+parqueaderos, data = caso1, subset = index)))
}
# Se implementa un bucle que genere los modelos de forma iterativa y almacene
# los coeficientes. El data frame Auto tiene 392 observaciones
beta_0 <- rep(NA,9999)
beta_1 <- rep(NA,9999)
beta_2 <- rep(NA,9999)
beta_3 <- rep(NA,9999)
beta_4 <- rep(NA,9999)
beta_5 <- rep(NA,9999)
for(i in 1:9999) {
coeficientes <- fun_coeficientes(data = arboles1,
index = sample(1:90, 90, replace = TRUE))
beta_0[i] <- coeficientes[1]
beta_1[i] <- coeficientes[2]
beta_2[i] <- coeficientes[3]
beta_3[i] <- coeficientes[4]
beta_4[i] <- coeficientes[5]
beta_5[i] <- coeficientes[6]
}
# Se muestra la distribución de los coeficientes
p0 <- ggplot(data = data.frame(beta_0 = beta_0), aes(beta_0)) +
geom_histogram(colour = "firebrick3") +
theme_bw()
p1 <- ggplot(data = data.frame(beta_1 = beta_1), aes(beta_1)) +
geom_histogram(colour = "firebrick3") +
theme_bw()
p2 <- ggplot(data = data.frame(beta_2 = beta_2), aes(beta_2)) +
geom_histogram(colour = "firebrick3") +
theme_bw()
p3 <- ggplot(data = data.frame(beta_3 = beta_3), aes(beta_3)) +
geom_histogram(colour = "firebrick3") +
theme_bw()
p4 <- ggplot(data = data.frame(beta_4 = beta_4), aes(beta_4)) +
geom_histogram(colour = "firebrick3") +
theme_bw()
p5 <- ggplot(data = data.frame(beta_5 = beta_5), aes(beta_5)) +
geom_histogram(colour = "firebrick3") +
theme_bw()
grid.arrange(p0,p1,p2,p3,p4,p5, ncol = 3, nrow=2,top = "Bootstrap distribution de los coeficientes")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
valores_prueba <- data.frame(
areaconst=c(200,200),
estrato=c(4,5),
banios=c(2,2),
parqueaderos=c(1,1),
habitaciones=c(4,4))
# Suponiendo que 'modelo' es tu modelo de regresión lineal
predicciones_prueba <- predict(modelo1, newdata = valores_prueba)
predicciones_prueba
## 1 2
## 326.7754 386.1737
plot(modelo1)
# MSE
mean(modelo1$residuals^2)
## [1] 13406.66
# MAE
mean(abs(modelo1$residuals))
## [1] 69.16036