TP2 EEA2019 Andrés Rabinovich y Federico Rabinovich

TP2 EEA 2019

#knitr::opts_chunk$set(echo = T)
setwd("/home/andy/maestria/EEA2019/trabajos_practicos/TP-2/TP2/") #Seteamos directorio de trabajo
ar_properties<-readRDS("ar_properties.rds") #Cargamos las propiedades

1. Regresion lineal multiple

ml <- lm(price ~ l3 + rooms + bathrooms + surface_total + surface_covered + property_type, ar_properties)
#summary(ml)

Todas las variables numéricas son significativas al igual que las de tipo de propiead, mientras que la mayor parte de las dummies también. Las variables dummies que no son significativas puede que no tengan mucha representatividad en el dataset, veamoslo.

sml <- summary(ml)
table(ar_properties$l3)[gsub("l3", "", rownames(sml$coefficients)[sml$coefficients[grep("l3", rownames(sml$coefficients)), 4] > 0.05])]

No parece estar relacionado con la representatividad en el dataset. El R2 de 0.78 y el F-statistic significativo hacen que se gane confianza en el modelo. Veamos que conviene vender:

pred <- c(1, 3, 2, 120, 120, 1)
precio_depto <- ml$coefficients[c("(Intercept)", "rooms", "bathrooms", "surface_total", "surface_covered", "property_typeDepartamento")]%*%pred
pred <- c(1, 1, 2, 3, 100, 80, 1)
precio_ph <- ml$coefficients[c("(Intercept)", "l3Balvanera", "rooms", "bathrooms", "surface_total", "surface_covered", "property_typePH")]%*%pred
data.frame(Depto=precio_depto, PH=precio_ph)

Conviene tener un depto para vender. Veamos que pasa si sacamos el barrio.

fit <- lm(price ~ rooms + bathrooms + surface_total + surface_covered + property_type, ar_properties)
summary(fit)

Todos los coeficientes son significativos. El R2 cae respecto de la inclusión del barrio. Evidentemente el barrio es una covariable importante a tener en cuenta en este modelo. 2) Creación de variables. Para seleccionar los barrios con precios altos, medios y bajos vamos a usar el desvío estandar. Los barrios que estén a un desvío estandar de la media, serán altos o bajos. El restó será medio.

ar_properties$precio_por_metro_cuadrado <- ar_properties$price/(ar_properties$surface_covered + 0.5*(ar_properties$surface_total - ar_properties$surface_covered))
precios_promedios_por_barrio <- aggregate(precio_por_metro_cuadrado ~ l3, ar_properties, mean) #Buscamos los precios promedio por metro cuadrado por barrio. La superficie descubierta suele contar como la mitad de la cubierta
precios_promedios_por_barrio
library(ggplot2)
ggplot(precios_promedios_por_barrio, aes(x = precio_por_metro_cuadrado)) + geom_histogram()
ggplot(precios_promedios_por_barrio, aes(x = precio_por_metro_cuadrado)) + geom_histogram() + scale_x_log10()
#ggplot(precios_promedios_por_barrio, aes(y = precio_por_metro_cuadrado)) + geom_boxplot()
lpm<-log(precios_promedios_por_barrio$precio_por_metro_cuadrado) #Lo transformamos con logaritmo para normalizarlo
s <- sd(lpm)
u <- mean(lpm)
precios_promedios_por_barrio$barrios <- ifelse(lpm > u + s, "alto", "bajo")
precios_promedios_por_barrio$barrios <- ifelse(lpm < u + s & lpm > u - s, "medio", precios_promedios_por_barrio$barrios)
rownames(precios_promedios_por_barrio) <- precios_promedios_por_barrio$l3
table(precios_promedios_por_barrio$barrios) #Cuantos barrios tenemos de cada categoria. No quedan muy balanceados.
ar_properties$barrios <- precios_promedios_por_barrio[ar_properties$l3, "barrios"]
table(ar_properties$barrios) #Cuantas propiedades tenemos de cada.

colnames(ar_properties)
fit <- lm(price ~ rooms + bathrooms + surface_total + surface_covered + property_type + barrios, ar_properties)
summary(fit)

Todos los coeficientes son significativos, con R2 relativamente alto y un F-statistic significativo. El promedio de precios es de

mean(ar_properties$price)

por lo que el residual standard error representa un

71160/mean(ar_properties$price)*100

porciento del precio promedio. Vemos que los residuos no están centrados en el cero. Graficando los residuos vemos que tienen estructura, con lo cual no pareciera ser un buen ajuste, más allá de los valores de R2 y el F-statistic.

plot(fit)

Veamos con l3

fit <- lm(price ~ rooms + bathrooms + surface_total + surface_covered + property_type + l3, ar_properties)
#summary(fit)

Para l3 en lugar del barrio, el R2 es un poco mejor (pero con tantos términos agregados puede ser simplemente un artefacto de la cantidad de covariables). El F-statistic da mas bajo que en el caso anterior y un error estandar residual menor. Vemos los residuos.

plot(fit)

Nuevamente tienen estructura, por lo que el ajuste no es muy bueno. Evidentemente el barrio tiene relevancia para el precio pero estas nuevas variables no logran generar un efecto frente al resto. Los dos modelos dan resultados similares. La nueva variable es más fácil de interpretar, pero requiere una clasificación previa arbitraria de los barrios respecto al precio promedio.

#construimos surface patio
ar_properties$surface_patio <- ar_properties$surface_total - ar_properties$surface_covered
summary(ar_properties$surface_patio)

No existen registros cuyo surface_total < surface_covered, pero en caso de que los hubiera, se podrían descartar esos registros.

fit <- lm(price ~ rooms + bathrooms + surface_patio + surface_covered + property_type + barrios, ar_properties)
summary(fit)
plot(fit)

Para facilitar la interpretación utilizamos la variable barrios en lugar de l3. Tanto surface_patio como surface_covered son significativos, con el coeficiente de patio aproximadamente un tercio del de covered. Usualmente se considera que una superficie descubierta es equivalente a media cubierta, pero acá podemos ver que debería ser menor aun. Por otro lado, se obtienen valores muy similares al ajuste anterior para todos los estadísticos, evidentemente la nueva variable no resuelve el problema de la alta correlación entre covered y total. 3) Evaluación del modelo. Los residuos anteriores muestran estructura por lo que un ajuste lineal del precio no parece adecuado. Los residuos muestran dependencia con las covariables y el Q-Q plot se separa de los valores esperados.

library(ggplot2)
library(tidyr)
library(purrr)
ar_properties %>%
keep(is.numeric) %>%
gather() %>%        
ggplot(aes(value)) +
  facet_wrap( ~ key, scales = "free") +
  geom_histogram()

Evidentemente ninguna de las variables es normal, por lo que no se cumplen los supuestos de la regresión lineal. Transformemos las variables.

fit <- lm(log(price) ~ log(rooms) + log(bathrooms) + log(surface_covered) + property_type + barrios + surface_patio, ar_properties)
summary(fit)
plot(fit)

Nuevamente todos los coeficientes son significativos, y se observa ahora si una distribución simétrica de residuos alrededor del 0. Además, se observa una mejora en R2 y un aumento del F-Statistic.

0.2346/mean(log(ar_properties$price))*100

Ahora el error residual solo implica el 2% del promedio de , mejorando el Q-Q plot y reduciendo la estructura en los errores. Evidentemente este ajuste es superior a los anteriores. 4) Dataframes anidados

library(modelr)
library(broom)
library(dplyr)
library(tidyr)
library(ggplot2)
library(purrr)
by_property_type <- ar_properties %>% 
  group_by(property_type) %>% 
  nest()

property_type_model <- function(df) {
  fit <- lm(price ~ rooms + bathrooms + surface_patio + surface_covered + barrios, df)
  return(fit)
}
by_property_type <- by_property_type %>% 
  mutate(model = map(data, property_type_model))
by_property_type <- by_property_type %>% 
mutate(
  resids = map2(data, model, add_residuals)
)
by_property_type
resids <- unnest(by_property_type, resids)
by_property_type %>% 
  mutate(glnc = map(model, glance)) %>% 
  unnest(glnc)
glnc <- by_property_type %>% 
  mutate(glnc = map(model, glance)) %>% 
  unnest(glnc) %>% 
  select(-c(data,model,resids))
glnc %>% 
  arrange(r.squared)
glnc %>% 
  ggplot(aes(property_type, r.squared)) + 
  geom_point()+
  theme(legend.position = "none")
map(by_property_type$model, plot)

El modelo lineal parece funcionar mejor para Departamentos que para Casas en base al R2. Observando los residuos vemos nuevamente que existe estructura en todos por lo que sería mejor transformar los datos para poder realizar los ajustes.