Actividad 1
Cristian Ortega
2024-02-14
Cargue de librerias y datos
Se cargan las columnas que se consideran necesarias, se omite el “id” debido a que pertenece a un indicador interno de la base de datos que no aporta al análisis, se omite la latitud y longitud para el análisis de modelos, aunque se considera para un mapa inicial que nos permita ubicar las viviendas, se omite la variable Barrio al considerarla incluida en la variable Zona.
Mapas
Se crea un mapa para visualizar la ubicación de las viviendas, donde se observa que en su mayoría se concentran en la zona sur.
datos <- data.frame(
latitud = viviendaMapa$latitud,
longitud = viviendaMapa$longitud
)
mapa <- leaflet(data = datos) %>%
addTiles() %>%
addMarkers(~longitud, ~latitud, clusterOptions = markerClusterOptions()) ## Warning in validateCoords(lng, lat, funcName): Data contains 3 rows with either
## missing or invalid lat/lon values and will be ignoredmapatabla <-table(vivienda$tipo, vivienda$zona)
t(tabla)##
## Apartamento Casa
## Zona Centro 24 100
## Zona Norte 1198 722
## Zona Oeste 1029 169
## Zona Oriente 62 289
## Zona Sur 2787 1939summary(vivienda)## zona piso estrato preciom
## Length:8322 Min. : 1.000 Min. :3.000 Min. : 58.0
## Class :character 1st Qu.: 2.000 1st Qu.:4.000 1st Qu.: 220.0
## Mode :character Median : 3.000 Median :5.000 Median : 330.0
## Mean : 3.771 Mean :4.634 Mean : 433.9
## 3rd Qu.: 5.000 3rd Qu.:5.000 3rd Qu.: 540.0
## Max. :12.000 Max. :6.000 Max. :1999.0
## NA's :2638 NA's :3 NA's :2
## areaconst parqueaderos banios habitaciones
## Min. : 30.0 Min. : 1.000 Min. : 0.000 Min. : 0.000
## 1st Qu.: 80.0 1st Qu.: 1.000 1st Qu.: 2.000 1st Qu.: 3.000
## Median : 123.0 Median : 2.000 Median : 3.000 Median : 3.000
## Mean : 174.9 Mean : 1.835 Mean : 3.111 Mean : 3.605
## 3rd Qu.: 229.0 3rd Qu.: 2.000 3rd Qu.: 4.000 3rd Qu.: 4.000
## Max. :1745.0 Max. :10.000 Max. :10.000 Max. :10.000
## NA's :3 NA's :1605 NA's :3 NA's :3
## tipo
## Length:8322
## Class :character
## Mode :character
##
##
##
## Datos faltantes
La base de datos cuenta con una gran cantidad de datos faltantes (4263), que de eliminarse se perderían al menos la mitad de los datos, es por ello que por medio de un método de regresión se imputan las variables en los datos faltantes y se logra imputar todos los NA’s de la base de datos.
md.pattern(vivienda, rotate.names = TRUE)
## preciom zona estrato areaconst banios habitaciones tipo parqueaderos piso
## 4808 1 1 1 1 1 1 1 1 1
## 1909 1 1 1 1 1 1 1 1 0
## 876 1 1 1 1 1 1 1 0 1
## 726 1 1 1 1 1 1 1 0 0
## 1 1 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0
## 2 3 3 3 3 3 3 1605 2638
##
## 4808 0
## 1909 1
## 876 1
## 726 2
## 1 8
## 2 9
## 4263sum(is.na(vivienda))## [1] 4263Con un análisis de boxplot se encuentra que las variables Precio y área construida contienen una gran cantidad de outliers, sin embargo se omite su tratamiento debido a que no es el objetivo principal del ejercicio.
datos_numericos <- vivienda[sapply(vivienda, is.numeric)]
# Función para crear boxplot de múltiples variables
boxplot_multiple <- function(data, title = "Boxplot de todas las variables") {
datos_longitudinales <- stack(data)
ggplot(datos_longitudinales, aes(x = ind, y = values)) +
geom_boxplot() +
labs(title = title, x = "Variables", y = "Valores") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
}
# Crear boxplot de todas las variables numéricas
boxplot_multiple(datos_numericos)## Warning: Removed 4257 rows containing non-finite values (`stat_boxplot()`).
## Conversión de variables categoricas
Se convierten los datos categóricos en numéricos, debido a que esto facilita el tratamiento de los datos faltantes. Dicho tratamiento de los NA´s no modifica de forma considerable las medias de las variables.
vivienda_factores <- vivienda
for (col in names(vivienda)) {
if (is.character(vivienda[[col]])) {
vivienda_factores[[col]] <- factor(vivienda[[col]])
}
}
vivienda2 <- vivienda_factores
for (col in names(vivienda2)) {
if (is.factor(vivienda2[[col]])) {
vivienda2[[col]] <- as.integer(vivienda2[[col]])
}
}
# Verificar los resultados
head(vivienda2)## # A tibble: 6 × 9
## zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 4 NA 3 250 70 1 3 6 2
## 2 4 NA 3 320 120 1 2 3 2
## 3 4 NA 3 350 220 2 2 4 2
## 4 5 2 4 400 280 3 5 3 2
## 5 2 1 5 260 90 1 2 3 1
## 6 2 1 5 240 87 1 3 3 1summary(vivienda2)## zona piso estrato preciom
## Min. :1.000 Min. : 1.000 Min. :3.000 Min. : 58.0
## 1st Qu.:3.000 1st Qu.: 2.000 1st Qu.:4.000 1st Qu.: 220.0
## Median :5.000 Median : 3.000 Median :5.000 Median : 330.0
## Mean :3.918 Mean : 3.771 Mean :4.634 Mean : 433.9
## 3rd Qu.:5.000 3rd Qu.: 5.000 3rd Qu.:5.000 3rd Qu.: 540.0
## Max. :5.000 Max. :12.000 Max. :6.000 Max. :1999.0
## NA's :3 NA's :2638 NA's :3 NA's :2
## areaconst parqueaderos banios habitaciones
## Min. : 30.0 Min. : 1.000 Min. : 0.000 Min. : 0.000
## 1st Qu.: 80.0 1st Qu.: 1.000 1st Qu.: 2.000 1st Qu.: 3.000
## Median : 123.0 Median : 2.000 Median : 3.000 Median : 3.000
## Mean : 174.9 Mean : 1.835 Mean : 3.111 Mean : 3.605
## 3rd Qu.: 229.0 3rd Qu.: 2.000 3rd Qu.: 4.000 3rd Qu.: 4.000
## Max. :1745.0 Max. :10.000 Max. :10.000 Max. :10.000
## NA's :3 NA's :1605 NA's :3 NA's :3
## tipo
## Min. :1.000
## 1st Qu.:1.000
## Median :1.000
## Mean :1.387
## 3rd Qu.:2.000
## Max. :2.000
## NA's :3Se comprueba que no existen datos faltantes por tanto se toma vivienda3 como la base de datos principal para los subsiguientes análisis.
vivienda3 <- complete(mice(vivienda2))##
## iter imp variable
## 1 1 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 1 2 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 1 3 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 1 4 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 1 5 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 2 1 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 2 2 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 2 3 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 2 4 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 2 5 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 3 1 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 3 2 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 3 3 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 3 4 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 3 5 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 4 1 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 4 2 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 4 3 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 4 4 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 4 5 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 5 1 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 5 2 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 5 3 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 5 4 zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 5 5 zona piso estrato preciom areaconst parqueaderos banios habitaciones tiposum(is.na(vivienda3))## [1] 0md.pattern(vivienda3, rotate.names = TRUE)## /\ /\
## { `---' }
## { O O }
## ==> V <== No need for mice. This data set is completely observed.
## \ \|/ /
## `-----'
## zona piso estrato preciom areaconst parqueaderos banios habitaciones tipo
## 8322 1 1 1 1 1 1 1 1 1
## 0 0 0 0 0 0 0 0 0
##
## 8322 0
## 0summary(vivienda3)## zona piso estrato preciom
## Min. :1.000 Min. : 1.000 Min. :3.000 Min. : 58.0
## 1st Qu.:3.000 1st Qu.: 2.000 1st Qu.:4.000 1st Qu.: 220.0
## Median :5.000 Median : 3.000 Median :5.000 Median : 330.0
## Mean :3.917 Mean : 3.669 Mean :4.634 Mean : 433.9
## 3rd Qu.:5.000 3rd Qu.: 5.000 3rd Qu.:5.000 3rd Qu.: 540.0
## Max. :5.000 Max. :12.000 Max. :6.000 Max. :1999.0
## areaconst parqueaderos banios habitaciones
## Min. : 30.0 Min. : 1.000 Min. : 0.000 Min. : 0.000
## 1st Qu.: 80.0 1st Qu.: 1.000 1st Qu.: 2.000 1st Qu.: 3.000
## Median : 123.0 Median : 1.000 Median : 3.000 Median : 3.000
## Mean : 174.9 Mean : 1.756 Mean : 3.111 Mean : 3.605
## 3rd Qu.: 229.0 3rd Qu.: 2.000 3rd Qu.: 4.000 3rd Qu.: 4.000
## Max. :1745.0 Max. :10.000 Max. :10.000 Max. :10.000
## tipo
## Min. :1.000
## 1st Qu.:1.000
## Median :1.000
## Mean :1.387
## 3rd Qu.:2.000
## Max. :2.000Matriz de corrrelación
En la matriz de correlación se puede observar que existe una correlación significativa entre las variables precio, estrato, parqueaderos, baños y área construida. Así como entre el área construida, el número de baños, habitaciones, parqueaderos y el tipo que se presupone que es de tipo Casa.
correlation_matrix <- cor(vivienda3)
correlation_melted <- melt(correlation_matrix)
# Crear la visualización
ggplot(correlation_melted, aes(Var2, Var1, fill = value)) +
geom_tile(color = "white") +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0,
limit = c(-1, 1), space = "Lab", name="Correlation") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, vjust = 1, size = 10, hjust = 1)) +
geom_text(aes(label = round(value, 2)), color = "black", size = 3) +
labs(title = "Heatmap with Correlation Numbers",
x = "Variables", y = "Variables")
Normalización
Se normalizan las variables para el tratamiento de componentes principales. Y se comprueba que sus medias sean 0. Se crea una nueva base llamada vivienda4 debido a que se quiere hacer una prueba sin estandarizar los datos.
estandarizar_variables <- function(data) {
data_numerico <- data[sapply(data, is.numeric)]
data_estandarizado <- as.data.frame(lapply(data_numerico, scale))
data[, names(data_estandarizado)] <- data_estandarizado
return(data)
}
# Aplicar la función para estandarizar todas las variables numéricas en la base de datos
vivienda4 <- estandarizar_variables(vivienda3)
# Verificar los cambios
summary(vivienda4)## zona piso estrato preciom
## Min. :-2.1971 Min. :-1.0430 Min. :-1.5876 Min. :-1.1438
## 1st Qu.:-0.6909 1st Qu.:-0.6522 1st Qu.:-0.6159 1st Qu.:-0.6509
## Median : 0.8152 Median :-0.2614 Median : 0.3558 Median :-0.3161
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.8152 3rd Qu.: 0.5201 3rd Qu.: 0.3558 3rd Qu.: 0.3229
## Max. : 0.8152 Max. : 3.2556 Max. : 1.3274 Max. : 4.7629
## areaconst parqueaderos banios habitaciones
## Min. :-1.0138 Min. :-0.6943 Min. :-2.1787 Min. :-2.4698
## 1st Qu.:-0.6640 1st Qu.:-0.6943 1st Qu.:-0.7782 1st Qu.:-0.4144
## Median :-0.3632 Median :-0.6943 Median :-0.0780 Median :-0.4144
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.3784 3rd Qu.: 0.2236 3rd Qu.: 0.6222 3rd Qu.: 0.2707
## Max. :10.9840 Max. : 7.5663 Max. : 4.8237 Max. : 4.3815
## tipo
## Min. :-0.7942
## 1st Qu.:-0.7942
## Median :-0.7942
## Mean : 0.0000
## 3rd Qu.: 1.2590
## Max. : 1.2590Analisis PCA
# Realizar PCA
pca_result <- prcomp(vivienda4)
pca_result## Standard deviations (1, .., p=9):
## [1] 1.9496748 1.3323711 1.0128822 0.8916414 0.6959832 0.6202972 0.5619433
## [8] 0.4858821 0.4261194
##
## Rotation (n x k) = (9 x 9):
## PC1 PC2 PC3 PC4 PC5
## zona -0.04190079 -0.01588819 0.95569726 0.230014977 0.15211680
## piso 0.13051263 -0.47741013 -0.20573382 0.706171787 0.34326437
## estrato -0.23708798 -0.54047665 0.14526527 -0.207859604 -0.50452496
## preciom -0.42355592 -0.29661441 -0.05421271 -0.128720514 0.07845099
## areaconst -0.44233392 0.06097828 -0.09498124 0.002541246 0.27538481
## parqueaderos -0.39541082 -0.19288851 -0.02545562 -0.200095498 0.50125834
## banios -0.44132554 -0.04347561 -0.01127017 0.257125711 -0.35521928
## habitaciones -0.31911748 0.35859815 -0.09743781 0.528415127 -0.32078733
## tipo -0.31142772 0.46938783 0.03138098 -0.057088428 0.20530002
## PC6 PC7 PC8 PC9
## zona 0.008328545 0.08551594 0.01451108 -0.031548737
## piso -0.227604776 -0.20245951 -0.05838797 0.002767597
## estrato -0.215325080 -0.22961683 -0.46005284 0.148606301
## preciom -0.135498826 0.24497509 0.21653722 -0.762690389
## areaconst -0.353110186 0.59189538 -0.15679952 0.464913569
## parqueaderos 0.627567896 -0.28427320 -0.14423345 0.137993424
## banios 0.087860833 -0.17003618 0.69192182 0.309083520
## habitaciones 0.325258035 0.10949946 -0.45554758 -0.229442143
## tipo -0.501359449 -0.60572821 -0.07857804 -0.108873431En el analisis de la varianza acumulada observamos como los primeros 4 componentes logran explicar al menos el 82.3% de la varianza. El primero influenciado por piso y el estrato, el segundo por precio, el tercero por la zona y el cuarto de nuevo por el piso.
# Graficar la varianza explicada acumulada
fviz_eig(pca_result, addlabels = TRUE, ylim = c(0, 100))
Graficando dichos resultados podemos decidir que las variables precio, estrato, baños, y área construida debido a las direcciones y longitudes de sus flechas con respecto a las dimesiones, lo cual indica su aporte en dichas dimesiones.
fviz_pca_var(pca_result,
col.var = "contrib", # Color by contributions to the PC
gradient.cols = c("#FF7F00", "#034D94"),
repel = TRUE # Avoid text overlapping
)
En los casos específicos se puede observar como cuando aumenta el precio, el estrato es mayor, así como el número de parqueaderos, baños y habitaciones y el tipo suele ser casa. Por el contrario, cuando el precio es menor el estrato también lo es, el tipo suele ser apartamentos, las habitaciones suelen ser menores, al igual que los parqueaderos y el área construida.
datos<- rbind(vivienda4[1779,], # ok
vivienda4[357,],
vivienda4[966,],
vivienda4[6536,])
datos <- as.data.frame(datos)
rownames(datos) = c("vivienda 1779","vivienda 357","vivienda 966","vivienda 6536")
datos## zona piso estrato preciom areaconst
## vivienda 1779 0.8152442 0.1293682 1.3274285 4.1572737 1.9244413
## vivienda 357 -2.1970601 -0.6521940 -1.5875666 -0.2552502 1.1549029
## vivienda 966 0.8152442 0.5201492 0.3557634 -0.7725806 -0.7059807
## vivienda 6536 -0.6909080 3.2556167 1.3274285 3.2443377 0.4273394
## parqueaderos banios habitaciones tipo
## vivienda 1779 7.5663156 2.7229796 0.9558189 1.2590014
## vivienda 357 -0.6942839 0.6222439 4.3814542 1.2590014
## vivienda 966 -0.6942839 -0.7782466 -0.4144352 -0.7941849
## vivienda 6536 1.1414049 1.3224891 -0.4144352 -0.7941849casos1 <- rbind(pca_result$x[1779,1:2],pca_result$x[357,1:2]) # CP1
rownames(casos1) = c("1779","357")
casos1 <- as.data.frame(casos1)
casos2 <- rbind(pca_result$x[966,1:2], pca_result$x[6536,1:2]) # CP2
rownames(casos2) = c("966","6536")
casos2 <- as.data.frame(casos2)
fviz_pca_ind(pca_result, col.ind = "#DEDEDE", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")) +
geom_point(data = casos1, aes(x = PC1, y = PC2), color = "red", size = 3) +
geom_point(data = casos2, aes(x = PC1, y = PC2), color = "blue", size = 3)
Se repite el PCA con menos variables
En este caso podemos observar como mejoran los resultados, siendo el primer componente incluenciado por el precio y el numero de baños, así como por el area construida.
vivienda5 <- vivienda4[, c("preciom", "areaconst", "estrato", "parqueaderos")]
pca_result1 <- prcomp(vivienda5)
pca_result1## Standard deviations (1, .., p=4):
## [1] 1.6354502 0.8620026 0.6204017 0.4442476
##
## Rotation (n x k) = (4 x 4):
## PC1 PC2 PC3 PC4
## preciom 0.5671779 -0.02999507 0.1667601 -0.8059781
## areaconst 0.4841721 0.56055609 0.5185545 0.4271481
## estrato 0.4203840 -0.81053798 0.1838188 0.3640276
## parqueaderos 0.5168790 0.16704895 -0.8182316 0.1882227fviz_eig(pca_result1, addlabels = TRUE, ylim = c(0, 100))
fviz_pca_var(pca_result1,
col.var = "contrib", # Color by contributions to the PC
gradient.cols = c("#FF7F00", "#034D94"),
repel = TRUE # Avoid text overlapping
)
datos<- rbind(vivienda5[1779,], # ok
vivienda5[357,],
vivienda5[966,],
vivienda5[6536,])
datos <- as.data.frame(datos)
rownames(datos) = c("vivienda 1779","vivienda 357","vivienda 966","vivienda 6536")
casos1 <- rbind(pca_result1$x[1779,1:2],pca_result1$x[357,1:2]) # CP1
rownames(casos1) = c("1779","357")
casos1 <- as.data.frame(casos1)
casos2 <- rbind(pca_result1$x[966,1:2], pca_result1$x[6536,1:2]) # CP2
rownames(casos2) = c("966","6536")
casos2 <- as.data.frame(casos2)
fviz_pca_ind(pca_result1, col.ind = "#DEDEDE", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")) +
geom_point(data = casos1, aes(x = PC1, y = PC2), color = "red", size = 3) +
geom_point(data = casos2, aes(x = PC1, y = PC2), color = "blue", size = 3)
Conglomerado
El alto Coeficiente de Silhouette (0.5217303) nos indica una elección correcta de los clúster a usar. En las diferentes pruebas se encuentra a k=3 como el número optimo. Sin embargo se repetira el ejercicio con diferentes transformaciones de variables, las cuales no se colocarán en su totalidad para no saturar el ejercicio.
Distancias <- dist(vivienda5, method = "euclidean")
DistanciasM <- dist(vivienda5, method = "manhattan")
# Cluster jerarquico con el método complete
hc_emp <- hclust(Distancias, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments <- cutree(hc_emp, k = 3)
# asignamos los clusters
assigned_cluster <- vivienda5 %>% mutate(cluster = as.factor(cluster_assigments))
plot(vivienda5, col = cluster_assigments)
# gráfico de puntos
ggplot(assigned_cluster, aes(x = areaconst, y = preciom, color = cluster)) +
geom_point(size = 4) +
geom_text(aes(label = cluster), vjust = -.8) + # Agregar etiquetas del clúster
theme_classic()
plot(hc_emp, cex = 0.6, main = "Dendograma de viviendas", las=1,
ylab = "Distancia euclidiana", xlab = "Grupos")
rect.hclust(hc_emp, k = 3, border = 2:5)
dendograma <- hclust(Distancias, method = "average")
# plot(dendograma, cex = 0.6, hang = -1)
barplot(sort(dendograma$height, decreasing = TRUE), horiz = TRUE,
main = "Agregaciones (distancias euclidianas)",
col = "lightblue", ylab = "Nodo", xlab = "Peso", xlim = c(0, 2.5))
# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(vivienda5))
sil_avg <- mean(sil[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=3 : ", sil_avg)## Coeficiente de Silhouette promedio k=3 : 0.6536516Iteración con menos variables.
Se repite el ejercicio para las variables precio y área construida.En este ejercicio podemos destacar resultados similares al anterior con una menor cantidad de variables.
vivienda6 <- vivienda3[, c("preciom", "areaconst")]
str(vivienda6)## 'data.frame': 8322 obs. of 2 variables:
## $ preciom : num 250 320 350 400 260 240 220 310 320 780 ...
## $ areaconst: num 70 120 220 280 90 87 52 137 150 380 ...pca_result2 <- prcomp(vivienda6)
pca_result2## Standard deviations (1, .., p=2):
## [1] 344.38795 99.06668
##
## Rotation (n x k) = (2 x 2):
## PC1 PC2
## preciom 0.9499442 -0.3124196
## areaconst 0.3124196 0.9499442fviz_eig(pca_result2, addlabels = TRUE, ylim = c(0, 100))
fviz_pca_var(pca_result2,
col.var = "contrib", # Color by contributions to the PC
gradient.cols = c("#FF7F00", "#034D94"),
repel = TRUE # Avoid text overlapping
)
datos<- rbind(vivienda6[1779,], # ok
vivienda6[357,],
vivienda6[966,],
vivienda6[6536,])
datos <- as.data.frame(datos)
rownames(datos) = c("vivienda 1779","vivienda 357","vivienda 966","vivienda 6536")
casos1 <- rbind(pca_result2$x[1779,1:2],pca_result2$x[357,1:2]) # CP1
rownames(casos1) = c("1779","357")
casos1 <- as.data.frame(casos1)
casos2 <- rbind(pca_result2$x[966,1:2], pca_result2$x[6536,1:2]) # CP2
rownames(casos2) = c("966","6536")
casos2 <- as.data.frame(casos2)
fviz_pca_ind(pca_result2, col.ind = "#DEDEDE", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")) +
geom_point(data = casos1, aes(x = PC1, y = PC2), color = "red", size = 3) +
geom_point(data = casos2, aes(x = PC1, y = PC2), color = "blue", size = 3)
En este caso obtenemos el mayor Coeficiente de Silhouette (0.6940688) de todos los tipos de transformacione y segmentaciones de variables.
Distancias <- dist(vivienda6, method = "euclidean")
DistanciasM <- dist(vivienda6, method = "manhattan")
# Cluster jerarquico con el método complete
hc_emp <- hclust(Distancias, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments <- cutree(hc_emp, k = 3)
# asignamos los clusters
assigned_cluster <- vivienda6 %>% mutate(cluster = as.factor(cluster_assigments))
plot(vivienda5, col = cluster_assigments)
# gráfico de puntos
ggplot(assigned_cluster, aes(x = areaconst, y = preciom, color = cluster)) +
geom_point(size = 4) +
geom_text(aes(label = cluster), vjust = -.8) + # Agregar etiquetas del clúster
theme_classic()
plot(hc_emp, cex = 0.6, main = "Dendograma de viviendas", las=1,
ylab = "Distancia euclidiana", xlab = "Grupos")
rect.hclust(hc_emp, k = 3, border = 2:5)
dendograma <- hclust(Distancias, method = "average")
# plot(dendograma, cex = 0.6, hang = -1)
barplot(sort(dendograma$height, decreasing = TRUE), horiz = TRUE,
main = "Agregaciones (distancias euclidianas)",
col = "lightblue", ylab = "Nodo", xlab = "Peso", xlim = c(0, 2.5))
# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(vivienda6))
sil_avg <- mean(sil[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=3 : ", sil_avg)## Coeficiente de Silhouette promedio k=3 : 0.6940768A pesar que se intento pasar el precio a logaritmo, estandarizarlos y hacer todo tipo de conversiones el Coeficiente de Silhouette más alto se encuentra con las variables sin transformar y sin normalizar.
Correspondencia
En los resultados podemos observar que la mayoría de las viviendas estrato 6 se concentran en la zona oeste, el estrato 3 en la zona oriente y centro y los estratos 4 y 5 en la zona sur.
tabla <- table(vivienda$estrato, vivienda$zona)
tabla##
## Zona Centro Zona Norte Zona Oeste Zona Oriente Zona Sur
## 3 105 572 54 340 382
## 4 14 407 84 8 1616
## 5 4 769 290 2 1685
## 6 1 172 770 1 1043chisq.test(tabla)##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 3830.4, df = 12, p-value < 2.2e-16resultados_ac <- CA(tabla)
valores_prop <-resultados_ac$eig ; valores_prop## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.32215213 69.965515 69.96551
## dim 2 0.12745096 27.680002 97.64552
## dim 3 0.01084108 2.354483 100.00000fviz_screeplot(resultados_ac, addlabels = TRUE, ylim = c(0, 80))+ggtitle("")+
ylab("Porcentaje de varianza explicado") + xlab("Ejes")
En los resultados podemos observar en la mayoria de los casos de los estratos 6 se cuenta con 6 o más parqueaderos. Mientras que en los estratos 3 y 4 apenas se cuenta con un parqueadero.
tabla <- table(vivienda$estrato, vivienda$parqueaderos)
tabla##
## 1 2 3 4 5 6 7 8 9 10
## 3 557 93 19 10 1 3 0 0 0 1
## 4 1238 317 50 23 4 4 2 0 1 2
## 5 1206 1030 136 100 27 13 5 3 1 1
## 6 154 1035 315 251 36 48 11 14 2 4chisq.test(tabla)## Warning in chisq.test(tabla): Chi-squared approximation may be incorrect##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 2178.6, df = 27, p-value < 2.2e-16resultados_ac <- CA(tabla)
valores_prop <-resultados_ac$eig ; valores_prop## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.3126040325 96.38185847 96.38186
## dim 2 0.0116206195 3.58286134 99.96472
## dim 3 0.0001144275 0.03528019 100.00000fviz_screeplot(resultados_ac, addlabels = TRUE, ylim = c(0, 80))+ggtitle("")+
ylab("Porcentaje de varianza explicado") + xlab("Ejes")
# VIF
Variance Inflation Factor es una medida estadística utilizada para evaluar la multicolinealidad en un modelo de regresión. En nuestro caso y aunque se puedan construir modelos coherentes con variables como precio, área construida o estrato. Podemos ver que cuando se evalua cada variable como independiente, la variable que cuenta con un mayor VIF (Aunque relativamete bajo) es la variable Baños, debido a que se puede inferir que esta incluida en la variables habitaciones. Por lo demás y para modelos más rbustos, dato este resultado no se propone eliminar ninguna variable.
library(car)
# Función para calcular el VIF de todas las variables en la base de datos
calcular_vif_todas <- function(data) {
# Ajustar un modelo de regresión lineal con cada variable predictora en relación con las demás
modelos <- lapply(names(data), function(var) {
if (is.numeric(data[[var]])) {
modelo <- lm(paste(var, "~ ."), data = data)
return(modelo)
}
})
# Calcular el VIF para cada modelo
vif_resultados <- lapply(modelos, function(modelo) {
if (!is.null(modelo)) {
vif_result <- vif(modelo)
return(vif_result)
}
})
# Combinar los resultados en un data frame
vif_data <- do.call(rbind, vif_resultados)
rownames(vif_data) <- names(data)
return(vif_data)
}
# Calcular el VIF de todas las variables en la base de datos vivienda3
vif_todas <- calcular_vif_todas(vivienda3)
# Imprimir los resultados
print(vif_todas)## piso estrato preciom areaconst parqueaderos banios
## zona 1.320139 2.047937 3.750355 2.942820 2.104075 3.052524
## piso 1.032234 2.083915 3.761353 2.944209 2.100604 3.048204
## estrato 1.016344 1.322651 3.206002 2.934457 2.094810 2.840667
## preciom 1.028665 1.319432 1.771910 2.408921 1.858880 2.861795
## areaconst 1.033459 1.322329 2.076507 3.084256 2.066514 3.045663
## parqueaderos 1.034808 1.321248 2.075962 3.333100 2.894060 3.026372
## banios 1.031787 1.317699 1.934762 3.526694 2.931455 2.079958
## habitaciones 1.034857 1.323556 1.954342 3.713078 2.830709 2.102153
## tipo 1.031592 1.124302 1.983783 3.769422 2.694899 2.099643
## habitaciones tipo
## zona 2.153913 2.141436
## piso 2.154014 1.824900
## estrato 2.018702 2.043692
## preciom 2.119744 2.146217
## areaconst 2.069057 1.964579
## parqueaderos 2.151844 2.143588
## banios 1.623139 2.108615
## habitaciones 2.307157 2.073821
## tipo 3.005170 2.079321Para verificar los resultados anteriores se reconstruye el mapa de calor inicial sin la variable baños, esperando que esto reduzca la multicolinealidad en toda la base de datos.
vivienda7 <- vivienda3[, c("preciom", "areaconst", "habitaciones", "tipo", "zona", "parqueaderos", "piso", "estrato")]
correlation_matrix <- cor(vivienda7)
correlation_melted <- melt(correlation_matrix)
# Crear la visualización
ggplot(correlation_melted, aes(Var2, Var1, fill = value)) +
geom_tile(color = "white") +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0,
limit = c(-1, 1), space = "Lab", name="Correlation") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, vjust = 1, size = 10, hjust = 1)) +
geom_text(aes(label = round(value, 2)), color = "black", size = 3) +
labs(title = "Heatmap with Correlation Numbers",
x = "Variables", y = "Variables")
Conclusiones
- Las variables área construida,baños, estrato y precio pueden explicar la mayoría de la varianza de la base de datos. Y si reducimos aún más el número de variables encontramos que al menos 3 de estas 4 varaibles logran explicar la varianza, incluso cuando se utiliza solo el precio y el área construida se obtienen buenos resultados.
- Los clúster ideales son 3, es allí cuando se maximiza el Coeficiente de Silhouette, todas las demás combinaciones con distintas transformaciones de variables cuentan con un coeficiente mucho menor.
- A pesar de las diferentes transformaciones de las variables, el mayor Coeficiente de Silhouette se consigue sin transformar ni normalizar la variable precio.
- Si pudiesemos contar con una base de datos con las caracteristicas de la viviendas vendidas y el perfil de dichos casos exitosos, podriamos con las mismas tecnicas estadisticas asignar una probabilidad a una vivienda de ser vendida según el tipo de cliente objetivo.
- Se recomienza añadir a los métodos usados el método de Inflación de Factores de varianza.