Actividad 2

Modelos Estadísticos para la toma de decisiones

EDA - Exploratory Data Analysis

Cargue de Librerias y dataframe

library(tidyverse) 
library(kableExtra) 
library(reshape2)
library(gridExtra) 
library(GGally)  
library(leaflet)  
library(plotly) 
library(lmtest)  
library(caret) 

library(paqueteMODELOS)
data <- paqueteMODELOS::vivienda
data <- as.data.frame(data)
dimension <- dim(data)
paste("filas:",dimension[1], "columnas:", dimension[2])
## [1] "filas: 8322 columnas: 13"
sapply(data, function(x) class(x)) 
##           id         zona         piso      estrato      preciom    areaconst 
##    "numeric"  "character"  "character"    "numeric"    "numeric"    "numeric" 
## parqueaderos       banios habitaciones         tipo       barrio     longitud 
##    "numeric"    "numeric"    "numeric"  "character"  "character"    "numeric" 
##      latitud 
##    "numeric"
data$piso <- as.numeric(data$piso)
data$parqueaderos <- as.numeric((data$parqueaderos))

sapply(data, function(x) class(x))
##           id         zona         piso      estrato      preciom    areaconst 
##    "numeric"  "character"    "numeric"    "numeric"    "numeric"    "numeric" 
## parqueaderos       banios habitaciones         tipo       barrio     longitud 
##    "numeric"    "numeric"    "numeric"  "character"  "character"    "numeric" 
##      latitud 
##    "numeric"
sapply(data, function(x) sum(is.na(x))) 
##           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
piso_media <- round(mean(data$piso, na.rm = T),2)

data$piso[is.na(data$piso)] <- piso_media


sapply(data, function(x) sum(is.na(x)))
##           id         zona         piso      estrato      preciom    areaconst 
##            3            3            0            3            2            3 
## parqueaderos       banios habitaciones         tipo       barrio     longitud 
##         1605            3            3            3            3            3 
##      latitud 
##            3
data <- drop_na(data)

Puntos 1

Realice un filtro a la base de datos e incluya solo las ofertas de : base1: casas, de la zona norte de la ciudad. Presente los primeros 3 registros de las bases y algunas tablas que comprueben la consulta.

# Registros unicos variable zona y tipos  
list_unic <- list(n_zonas = unique(data$zona), n_tipos = unique(data$tipo))
list_unic
## $n_zonas
## [1] "Zona Oriente" "Zona Sur"     "Zona Norte"   "Zona Oeste"   "Zona Centro" 
## 
## $n_tipos
## [1] "Casa"        "Apartamento"
# Aplicacion de filtro Casas & Zona norte
base1 <- data %>% dplyr::filter(zona == "Zona Norte" & tipo == "Casa")
head(base1,3)
#Verificacion del cumplimiento de criterios de la base 1 
tail(base1,3)
# Valores unicos 
list_cri1 <- list(unique(base1$zona), unique(base1$tipo))
list_cri1
## [[1]]
## [1] "Zona Norte"
## 
## [[2]]
## [1] "Casa"
# MApeo con el paquete leaflet sugerido por la actividad
Casas_Norte <- leaflet(base1) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = "blue", radius = 1)


Casas_Norte

Al realizar una revisión inicial de los datos, se puede apreciar que la distribución de los puntos representativos de las viviendas en la base de datos no se limita únicamente a la zona norte. De hecho, se observa una dispersión de estos puntos que abarca tanto las zonas central como sur. Este hallazgo tiene implicaciones significativas para el análisis estadístico y la posterior predicción de tendencias, ya que sugiere una variabilidad geográfica en la distribución de las viviendas que debe tenerse en cuenta en los modelos predictivos.

# Aplicacion de filtro Casas & Zona Oriente

base2 <- data %>% dplyr::filter(zona == "Zona Oriente" & tipo == "Casa")
head(base2,3)
# Verificacion de criterios por los ultimos 3 datos de la base
tail(base2,3)
Casas_Oriente <- leaflet(base2) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = "green", radius = 1)


Casas_Oriente

Asimismo, se observa una tendencia similar en las viviendas situadas en la zona Oriente de Cali, donde se pueden identificar puntos dispersos en dirección al Sur, tal como se evidenció en el mapa anterior.

# Aplicacion de filtro Casas & Zona Sur

base3 <- data %>% dplyr::filter(zona == "Zona Sur" & tipo == "Casa")
head(base3,3)
#Verificacion de los ultimos 3 registros segun el filtro aplicado
tail(base3,3)
# MApeo casa sur
Casa_Sur <- leaflet(base3) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = "red", radius = 1)


Casa_Sur

Según la representación cartográfica examinada, se advierte que, si bien la mayoría de los puntos están adecuadamente ubicados, existen instancias en las que se encuentran etiquetas incorrectas en relación con la latitud y longitud representadas. Se pueden identificar viviendas ubicadas al norte, centro y oriente del mapa, lo cual sugiere la necesidad de una revisión minuciosa de la precisión de la información geoespacial.

# Aplicacion de filtro Casas & Zona Oeste

base4 <- data %>% dplyr::filter(zona == "Zona Oeste" & tipo == "Casa")
head(base4,3)
#Verificacion de los ultimos registros para observar el cumplimiento de criterios
tail(base4,3)
# Mapeo de Casas ubicadas al Oeste del municipio de Cali

Casas_Oeste <- leaflet(base4) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = "purple", radius = 1)


Casas_Oeste

Como se ha observado en resultados previos, se constata que ciertos puntos no están etiquetados de forma precisa, con algunos situados en la parte sur y oeste del mapa. Este hallazgo subraya la importancia de garantizar la exactitud en la asignación de etiquetas geoespaciales para una interpretación adecuada de los datos.

# Aplicacion de filtro Casas & Zona Centro

base5 <- data %>% dplyr::filter(zona == "Zona Centro" & tipo == "Casa")
head(base5,3)
# Verificacion de los ultimos registros correspondiente a los filtros aplicados en la base
tail(base5,3)
# MApeo de las viviendas ubicadas en la zona centro del municipio

Casa_Centro <- leaflet(base5) %>%
  addTiles() %>%
  addCircleMarkers(lng = ~longitud, lat = ~latitud, color = "black", radius = 1)


Casa_Centro

Finalmente, se observa que la zona central también sufre de la misma problemática que sus áreas precedentes. Esto lleva a la conclusión de que la base de datos proporcionada carece de información precisa sobre la ubicación de las viviendas a nivel zonal, lo que resulta en una variable poco confiable para realizar un análisis preciso.

Punto 2

Realice un análisis exploratorio de datos enfocado en la correlación entre la variable respuesta (precio de la casa) en función del área construida, estrato, numero de baños, numero de habitaciones y zona donde se ubica la vivienda. Use gráficos interactivos con el paquete plotly e interprete los resultados.*

# Filtro de la base original
data <- data %>% dplyr::filter(tipo == "Casa")

# Analisis grafico 

plot_ly(data, x = ~preciom, type = "histogram") %>% 
  layout(title = "Histograma precios metro cuadrado de Casas (Miles)")
summary(data$preciom)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    89.0   335.0   450.0   583.7   720.0  1999.0
#En el histograma de precios, se observa una asimetría positiva, donde la media es mayor que la mediana y #la moda. De acuerdo con los cálculos previos, la media se estima en 583.7 y la mediana en 450. Esta #disparidad sugiere una distribución sesgada hacia valores más altos, lo que podría implicar una #concentración de precios por encima de la mediana.

plot_ly(data, x = ~preciom, type = "box") %>% 
  layout(title = "Boxplot precios metro cuadrado de Casas (Miles)")
plot_ly(data, x = ~banios, type = "histogram", marker = list(color = "red"))%>%
  layout(title = "Histograma comportamiento número de baños")
#Ahora bien, correspondiente al histograma representativo de los baños se observa una grafica que en #primera instancia sigue una distribucion normal y ademas se puede entrever que hay unidades de vivienda #que no tienen este espacio dentro de su distribucion habitacional

#corroborando la info anterior
head(data[data$banios == 0,], 3)
summary(data$banios)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   3.000   4.000   4.095   5.000  10.000
#Representadas por una media de 4.1 y una mediana de 4

plot_ly(data, x = ~banios, type = "box")%>%
  layout(title = "Boxplot comportamiento número de baños")
plot_ly(data, x = ~estrato, type = "histogram")%>%
  layout(title = "Histograma comportamiento de estratos")
#Se observa que mayoritariamente las casas existentes pertenecen al estrato 5.

plot_ly(data, x = ~areaconst, type = "histogram", marker = list(color = "purple"))%>%
  layout(title = "Histograma comportamiento de area construida en vivienda")
plot_ly(data, x = ~areaconst, type = "box")%>%
  layout(title = "Boxplot comportamiento de area construida en vivienda")
summary(data$areaconst)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    30.0   165.0   250.0   285.9   356.8  1745.0
quantile(data$areaconst, c(0.25, 0.5, 0.75))
##    25%    50%    75% 
## 165.00 250.00 356.75
plot_ly(data, x = ~zona, type = "histogram")%>%
  layout(title = "Histograma comportamiento de las casas en las Zonas",
         xaxis = list(title = "zonas"))
plot_ly(data, x = ~habitaciones, type = "histogram")%>%
  layout(title = "Histograma comportamiento de las casas en las Habitaciones",
         xaxis = list(title = "Habitaciones"))
head(data[data$habitaciones == 0,],3)
#Correlacion 

data$zona <- as.factor(data$zona)
data$zona <- as.numeric(data$zona)


num_df <-  data[sapply(data, function(x) class(x))=='numeric'] 
num_df <- dplyr::select(num_df, preciom, zona, estrato, areaconst, banios, habitaciones,
                        -longitud, -latitud, -id) # Se eliminan id, latitud y longitud 

#Se aplica la correlación

cor_mat <- round(cor(num_df),2)

cor_mat_long <- melt(cor_mat)

# Crear el mapa de calor con ggplot2
ggplot(data = cor_mat_long, aes(x = Var1, y = Var2, fill = value)) +
  geom_tile(color = "white") + # Tiles con borde blanco
  scale_fill_gradient(low = "lightblue", high = "darkblue") + # Escala de colores
  labs(title = "Correlación", x = "", y = "") + # Títulos de ejes
  geom_text(aes(label = value), color = "black") + #Valores
  theme_minimal() + # Estilo del tema
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Ajustar la orientación del texto en el eje x

ggpairs(num_df, title="Correlacion de variables numericas")

Según las gráficas anteriores, se observa una correlación más fuerte entre las variables preciom y areaconst, con un coeficiente de correlación de 0.645. Posteriormente, la variable dependiente también está significativamente relacionada con la variable estrato.

Además, se destaca la relación entre las variables areaconst y baños con un coeficiente de correlación de 0.50, seguido por la correlación entre baños y habitaciones con 0.453. Estas observaciones subrayan las relaciones importantes entre las variables que pueden influir en el modelo y en la interpretación de los resultados.

Punto 3.

Estime un modelo de regresión lineal múltiple con las variables del punto anterior (precio = f(área construida, estrato, número de cuartos, número de parqueaderos, número de baños ) ) e interprete los coeficientes si son estadísticamente significativos. Las interpretaciones deber están contextualizadas y discutir si los resultados son lógicos. Adicionalmente interprete el coeficiente R2 y discuta el ajuste del modelo e implicaciones (que podrían hacer para mejorarlo)*

modelo = lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = data)
summary(modelo)
## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
##     banios, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1190.80  -114.52   -25.94    74.59   986.16 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -413.87536   25.58852 -16.174  < 2e-16 ***
## areaconst       0.74227    0.02941  25.235  < 2e-16 ***
## estrato       116.07109    5.26618  22.041  < 2e-16 ***
## habitaciones  -14.74995    3.18137  -4.636 3.73e-06 ***
## parqueaderos   64.29943    3.47719  18.492  < 2e-16 ***
## banios         39.03498    4.05083   9.636  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 205.2 on 2480 degrees of freedom
## Multiple R-squared:  0.6834, Adjusted R-squared:  0.6828 
## F-statistic:  1071 on 5 and 2480 DF,  p-value: < 2.2e-16

La ecuación de regresión proporcionada es: Precio = −413.8 + 0.74(areaconst) + 116.1(estrato) - 14.7(habitaciones) + 64.3(parqueaderos) + 39.03 (banios) Al observar que todos los valores p de las variables explicativas son menores que 0.05, se rechaza la hipótesis nula de que los coeficientes correspondientes sean iguales a 0. Esto sugiere que todas las variables son significativas para el modelo.

El coeficiente de determinación R2 es 0.68, lo que indica que aproximadamente el 68% de la variabilidad en la variable dependiente puede ser explicada por las variables independientes seleccionadas. Se sugiere eliminar los valores atípicos y considerar la posible redundancia entre la variable dependiente y areaconst.

Punto 4.

Realice la validación de supuestos del modelo e interprete los resultados (no es necesario corregir en caso de presentar problemas solo realizar sugerencias de que se podría hacer).*

par(mfrow = c(2, 2))
plot(modelo)

summary(modelo$residuals)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1190.80  -114.52   -25.94     0.00    74.59   986.16
# Supuesto del valor esperado de los errores

t.test(modelo$residuals, mu=0)
## 
##  One Sample t-test
## 
## data:  modelo$residuals
## t = 3.62e-15, df = 2485, p-value = 1
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  -8.063801  8.063801
## sample estimates:
##    mean of x 
## 1.488619e-14
lmtest::gqtest(modelo) # Determinacion de la heterocedasticidad.
## 
##  Goldfeld-Quandt test
## 
## data:  modelo
## GQ = 1.268, df1 = 1237, df2 = 1237, p-value = 1.525e-05
## alternative hypothesis: variance increases from segment 1 to 2
shapiro.test(modelo$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo$residuals
## W = 0.89699, p-value < 2.2e-16
lmtest::dwtest(modelo)
## 
##  Durbin-Watson test
## 
## data:  modelo
## DW = 1.5759, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is greater than 0

Basándonos en la evaluación de los valores p, se llega a la conclusión de que los errores no son independientes. Esto sugiere la presencia de alguna estructura o patrón en los errores del modelo, lo cual podría requerir una investigación más detallada para comprender y abordar adecuadamente esta falta de independencia en los errores.

Punto 5.

Realice una partición en los datos de forma aleatoria donde el 70% sea un set para entrenar el modelo y el 30% para prueba. Estime el modelo con la muestra del 70%. Muestre los resultados*

particion <- createDataPartition(data$preciom, p = 0.7, list = FALSE)

train <- data[particion, ]
test <- data[-particion, ]
modelo_2 = lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = train )
summary(modelo_2)
## 
## Call:
## lm(formula = preciom ~ areaconst + estrato + habitaciones + parqueaderos + 
##     banios, data = train)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1123.62  -115.38   -25.88    72.47   991.12 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -425.7333    31.1143 -13.683  < 2e-16 ***
## areaconst       0.7042     0.0364  19.344  < 2e-16 ***
## estrato       118.2715     6.4644  18.296  < 2e-16 ***
## habitaciones  -11.9419     3.8596  -3.094  0.00201 ** 
## parqueaderos   64.7288     4.2175  15.348  < 2e-16 ***
## banios         38.3643     4.8939   7.839 7.85e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 208.6 on 1736 degrees of freedom
## Multiple R-squared:  0.6733, Adjusted R-squared:  0.6724 
## F-statistic: 715.6 on 5 and 1736 DF,  p-value: < 2.2e-16

Se llega nuevamente a la conclusión de que todas las variables son significativas para explicar el comportamiento de la variable dependiente. Sin embargo, se observa que el coeficiente de determinación R2 es ligeramente menor en comparación con el modelo anterior. Este ligero cambio en el R2 podría indicar una leve variación en la capacidad del modelo para explicar la variabilidad en la variable dependiente, aunque todas las variables siguen siendo significativas para el modelo en su conjunto.

Punto 6.

Realice predicciones con el modelo anterior usando los datos de prueba (30%)*

test$predicciones <- fitted(lm(preciom ~ areaconst + estrato + habitaciones + parqueaderos + banios, data = test ))
# predicciones
head(select(test, preciom, predicciones), 5)

Punto 7.

Calcule el error cuadratico medio, el error absoluto medio y el R2, interprete*

mse <- mean((test$predicciones - test$preciom)^2)

mae <- mean(abs(test$predicciones - test$preciom))

r2 <- 1 - sum((test$preciom - test$predicciones)^2) / sum((test$preciom - mean(test$preciom))^2)

paste("El error cuadrático medio es:", mse)
## [1] "El error cuadrático medio es: 38617.6454293582"
paste("El error absoluto medio es:", mae)
## [1] "El error absoluto medio es: 137.72228417934"
paste("El Coeficiente de determinación es:", r2)
## [1] "El Coeficiente de determinación es: 0.709138440606185"

El Error Cuadrático Medio (MSE) es el valor obtenido al elevar al cuadrado la diferencia entre las predicciones realizadas y los valores reales del precio por metro cuadrado de la vivienda, y luego calcular su promedio. En este caso, el MSE es [valor del MSE].

El Error Absoluto Medio (MAE) es [valor del MAE], lo cual representa el promedio de las diferencias absolutas entre las predicciones y los valores reales del precio por metro cuadrado de la vivienda.

El Coeficiente de Determinación (R²) es 0.71, lo que indica que el modelo explica aceptablemente la variabilidad de los datos.

Dado que el R² es relativamente alto y los errores cuadráticos y absolutos medios son moderados, se sugiere que el modelo de regresión múltiple utilizado tiene una capacidad razonable para predecir el precio por metro cuadrado de la vivienda de la compañía C&A. Por lo tanto, puede utilizarse como un insumo válido para satisfacer las necesidades de la empresa internacional hacia la inmobiliaria.