Modulo 1 - Unidad 1: Modelos Multivariados
Edwin Alexander Ochoa Sánchez
2024-08-13
[1]: Análisis Exploratorio de Datos (EDA)
[1.1]: Resumen estadístico
summary(ds_vivienda)## id zona piso estrato
## Min. : 1 Length:8322 Length:8322 Min. :3.000
## 1st Qu.:2080 Class :character Class :character 1st Qu.:4.000
## Median :4160 Mode :character Mode :character Median :5.000
## Mean :4160 Mean :4.634
## 3rd Qu.:6240 3rd Qu.:5.000
## Max. :8319 Max. :6.000
## NA's :3 NA's :3
## preciom areaconst parqueaderos banios
## Min. : 58.0 Min. : 30.0 Min. : 1.000 Min. : 0.000
## 1st Qu.: 220.0 1st Qu.: 80.0 1st Qu.: 1.000 1st Qu.: 2.000
## Median : 330.0 Median : 123.0 Median : 2.000 Median : 3.000
## Mean : 433.9 Mean : 174.9 Mean : 1.835 Mean : 3.111
## 3rd Qu.: 540.0 3rd Qu.: 229.0 3rd Qu.: 2.000 3rd Qu.: 4.000
## Max. :1999.0 Max. :1745.0 Max. :10.000 Max. :10.000
## NA's :2 NA's :3 NA's :1605 NA's :3
## habitaciones tipo barrio longitud
## Min. : 0.000 Length:8322 Length:8322 Min. :-76.59
## 1st Qu.: 3.000 Class :character Class :character 1st Qu.:-76.54
## Median : 3.000 Mode :character Mode :character Median :-76.53
## Mean : 3.605 Mean :-76.53
## 3rd Qu.: 4.000 3rd Qu.:-76.52
## Max. :10.000 Max. :-76.46
## NA's :3 NA's :3
## latitud
## Min. :3.333
## 1st Qu.:3.381
## Median :3.416
## Mean :3.418
## 3rd Qu.:3.452
## Max. :3.498
## NA's :3
[1.2]: Estructura del conjunto de datos
str(ds_vivienda)## spc_tbl_ [8,322 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ id : num [1:8322] 1147 1169 1350 5992 1212 ...
## $ zona : chr [1:8322] "Zona Oriente" "Zona Oriente" "Zona Oriente" "Zona Sur" ...
## $ piso : chr [1:8322] NA NA NA "02" ...
## $ estrato : num [1:8322] 3 3 3 4 5 5 4 5 5 5 ...
## $ preciom : num [1:8322] 250 320 350 400 260 240 220 310 320 780 ...
## $ areaconst : num [1:8322] 70 120 220 280 90 87 52 137 150 380 ...
## $ parqueaderos: num [1:8322] 1 1 2 3 1 1 2 2 2 2 ...
## $ banios : num [1:8322] 3 2 2 5 2 3 2 3 4 3 ...
## $ habitaciones: num [1:8322] 6 3 4 3 3 3 3 4 6 3 ...
## $ tipo : chr [1:8322] "Casa" "Casa" "Casa" "Casa" ...
## $ barrio : chr [1:8322] "20 de julio" "20 de julio" "20 de julio" "3 de julio" ...
## $ longitud : num [1:8322] -76.5 -76.5 -76.5 -76.5 -76.5 ...
## $ latitud : num [1:8322] 3.43 3.43 3.44 3.44 3.46 ...
## - attr(*, "spec")=
## .. cols(
## .. id = col_double(),
## .. zona = col_character(),
## .. piso = col_character(),
## .. estrato = col_double(),
## .. preciom = col_double(),
## .. areaconst = col_double(),
## .. parqueaderos = col_double(),
## .. banios = col_double(),
## .. habitaciones = col_double(),
## .. tipo = col_character(),
## .. barrio = col_character(),
## .. longitud = col_double(),
## .. latitud = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
[1.3]: Verificar valores faltantes
na_counts <- colSums(is.na(ds_vivienda))
na_df <- data.frame(
Column = names(na_counts),
NA_Count = na_counts
)# Crear la gráfica de valores faltantes
ggplot(na_df, aes(x = reorder(Column, -NA_Count), y = NA_Count)) +
geom_bar(stat = "identity", fill = "steelblue") +
geom_text(aes(label = NA_Count), vjust = -0.5, color = "black", size = 3) +
labs(title = "ANALISIS - Valores faltantes por variable",
x = "Variable",
y = "Cantidad") +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
plot.title = element_text(hjust = 0.5)
)
[1.4]: Distribución de las variables numéricas
ds_vivienda$piso <- as.numeric(as.character(ds_vivienda$piso))
var_numericas <- c("piso", "preciom", "areaconst", "parqueaderos", "banios", "habitaciones")
[1.4.1]: Gráficos de densidad
for (var in var_numericas) {
vivienda[[var]] <- as.numeric(vivienda[[var]])
dens <- density(vivienda[[var]], na.rm = TRUE)
# Encontrar el valor con la densidad máxima
moda <- dens$x[which.max(dens$y)]
p <- ggplot(vivienda, aes_string(x = var)) +
geom_density(fill = "#4682B4", alpha = 0.5) +
geom_vline(xintercept = moda, linetype = "dashed", color = "#D6D6D6") + # Línea vertical para la moda
labs(title = paste("DISTRIBUCION - Variable [", var, "]", sep = ""),
x = var,
y = "Densidad") +
theme_minimal() +
annotate("text", x = moda, y = max(dens$y), label = paste("Moda:", round(moda, 0)),
vjust = -0.5, color = "blue", hjust = 0.5, size = 3.5) +
theme(plot.title = element_text(hjust = 0.5))
print(p)
}## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 2638 rows containing non-finite outside the scale range
## (`stat_density()`).
## Warning: Removed 2 rows containing non-finite outside the scale range
## (`stat_density()`).
## Warning: Removed 3 rows containing non-finite outside the scale range
## (`stat_density()`).
## Warning: Removed 1605 rows containing non-finite outside the scale range
## (`stat_density()`).
## Warning: Removed 3 rows containing non-finite outside the scale range
## (`stat_density()`).
## Warning: Removed 3 rows containing non-finite outside the scale range
## (`stat_density()`).
[1.4.2]: Gráficos de cajas y bigotes
for (var in var_numericas) {
p <- ggplot(vivienda, aes(x = factor(0), y = .data[[var]])) +
geom_boxplot(fill = "#4682B4", color = "black") +
theme_minimal() +
labs(title = paste("DETECCION OUTLIERS - Variable [", var, "]", sep = ""),
x = NULL,
y = paste("Variable [", var, "]", sep = "")) +
theme(axis.title.x = element_blank(),
axis.text.x = element_blank(),
plot.title = element_text(hjust = 0.5))
print(p)
}## Warning: Removed 2638 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 2 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 3 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 1605 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 3 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 3 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
[1.4.3]: Graficas de barras
ds_vivienda$estrato <- as.factor(ds_vivienda$estrato)
# Lista de variables categóricas
var_categoricas <- c("zona", "tipo", "estrato", "barrio")
# Crear una lista para almacenar los gráficos
graficos <- list()
for (var in var_categoricas) {
counts <- ds_vivienda %>%
count(!!sym(var))
ds_vivienda[[var]] <- factor(ds_vivienda[[var]],
levels = counts[[var]][order(counts$n, decreasing = TRUE)])
p <- ggplot(ds_vivienda, aes_string(x = var)) +
geom_bar(fill = "#4682B4", color = "#4682B4") +
theme_minimal() +
labs(title = paste("DISTRIBUCION - Variable [", var, "]", sep = ""),
x = var,
y = "Conteo") +
theme(plot.title = element_text(hjust = 0.5))
graficos[[var]] <- p
}
for (var in var_categoricas) {
p <- graficos[[var]]
if (var == "barrio") {
p <- p + theme(axis.text.x = element_blank())
}
print(p)
}
[1.5]: Imputación de valores nulos
calcular_moda <- function(x) {
unique_x <- unique(na.omit(x))
tab <- tabulate(match(x, unique_x))
unique_x[tab == max(tab)]
}
modas_por_tipo <- ds_vivienda %>%
group_by(tipo) %>%
summarise(
moda_piso = calcular_moda(piso),
moda_parqueaderos = calcular_moda(parqueaderos)
)
moda_piso_apt = 3
moda_piso_casa = 2
moda_parqueaderos_apt = 1
moda_parqueaderos_casa = 2
ds_vivienda$piso <- ifelse(
is.na(ds_vivienda$piso) & ds_vivienda$tipo == "Apartamento",
moda_piso_apt,
ds_vivienda$piso
)
ds_vivienda$piso <- ifelse(
is.na(ds_vivienda$piso) & ds_vivienda$tipo == "Casa",
moda_piso_casa,
ds_vivienda$piso
)
ds_vivienda$parqueaderos <- ifelse(
is.na(ds_vivienda$parqueaderos) & ds_vivienda$tipo == "Apartamento",
moda_parqueaderos_apt,
ds_vivienda$parqueaderos
)
ds_vivienda$parqueaderos <- ifelse(
is.na(ds_vivienda$parqueaderos) & ds_vivienda$tipo == "Casa",
moda_parqueaderos_casa,
ds_vivienda$parqueaderos
)
[1.6]: Eliminación de valores faltantes
ds_vivienda <- na.omit(ds_vivienda)
[2]: Analisis de Componentes Principales (PCA)
md.pattern(ds_vivienda)## /\ /\
## { `---' }
## { 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 0df_vivienda_acp_ac = ds_vivienda[, var_numericas]
[2.1]: Estandarización de las varaibles
df_estandarizado = prcomp(df_vivienda_acp_ac)
[2.2]: Elección del número de componentes principales
res.pca <- df_estandarizado
fviz_eig(res.pca, addlabels = TRUE)
[2.3]: Diagrama “Variables - PCA”
fviz_pca_var(res.pca,
col.var = "contrib", # Color by contributions to the PC
gradient.cols = c("#FF7F00", "#034D94"),
repel = TRUE # Avoid text overlapping
)
[2.4]: Gráfica de “PAC - Biplot”
fviz_pca_biplot(res.pca,
col.var = "contrib",
gradient.cols = c("#FF7F00", "#034D94"),
#repel = TRUE,
col.ind = "#DEDEDE"
)
[3]: Análisis de Conglomerados
[3.1]: Codificación de variables categóricas
df_vivienda_ac = ds_vivienda[,2:11]
df_vivienda_ac$zona <- as.numeric(factor(df_vivienda_ac$zona))
df_vivienda_ac$tipo <- as.numeric(factor(df_vivienda_ac$tipo))
df_vivienda_ac$barrio <- as.numeric(factor(df_vivienda_ac$barrio))
df_vivienda_ac$estrato <- as.numeric(factor(df_vivienda_ac$estrato))
[3.2]: Normalización de los datos
cols_z <- c("piso", "preciom", "areaconst", "parqueaderos", "banios", "habitaciones")
df_vivienda_ac[cols_z] <- scale(df_vivienda_ac[, cols_z])
df_ac_z = as.data.frame(df_vivienda_ac)
[3.3]: Análisis por “Zonas”
[3.3.1]: Análisis vs “Precio”
df_ac_analisis = df_ac_z[, c("zona", "preciom")]
# Distancia euclidiana
dist_ac <- dist(df_ac_analisis, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_ac <- hclust(dist_ac, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments <- cutree(hc_ac, k = 4)
# Asignamos los clusters
assigned_cluster <- df_ac_analisis %>% mutate(cluster = as.factor(cluster_assigments))
# Medición del índice de Silhouette
# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(df_ac_analisis))
sil_avg <- mean(sil[,3])
sil_avg## [1] 0.5120866# Análisis de los clusters
media_sd_por_cluster <- aggregate(. ~ cluster, data = assigned_cluster, FUN = function(x) c(mean = mean(x, na.rm = TRUE), sd = sd(x, na.rm = TRUE)))
print(media_sd_por_cluster)## cluster zona.mean zona.sd preciom.mean preciom.sd
## 1 1 3.5476190 0.6894011 -0.05091538 0.59435244
## 2 2 1.3609059 0.5530557 -0.34490392 0.49564477
## 3 3 1.9236546 0.9137922 1.84412098 0.56435970
## 4 4 1.4851485 0.8299597 3.61147905 0.51756792# Gráfico de puntos
ggplot(assigned_cluster, aes(x = zona, y = preciom, color = cluster)) +
geom_point(size = 4) +
geom_text(aes(label = cluster), vjust = -.8) + # Agregar etiquetas del clúster
theme_classic()
[3.3.2]: Análisis vs “Area construida”
df_ac_analisis = df_ac_z[, c("zona", "areaconst")]
# Distancia euclidiana
dist_ac <- dist(df_ac_analisis, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_ac <- hclust(dist_ac, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments <- cutree(hc_ac, k = 4)
# Asignamos los clusters
assigned_cluster <- df_ac_analisis %>% mutate(cluster = as.factor(cluster_assigments))
# Medición del índice de Silhouette
# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(df_ac_analisis))
sil_avg <- mean(sil[,3])
sil_avg## [1] 0.4409422# Análisis de los clusters
media_sd_por_cluster <- aggregate(. ~ cluster, data = assigned_cluster, FUN = function(x) c(mean = mean(x, na.rm = TRUE), sd = sd(x, na.rm = TRUE)))
print(media_sd_por_cluster)## cluster zona.mean zona.sd areaconst.mean areaconst.sd
## 1 1 1.6896314 0.9683112 -0.2903736 0.5165123
## 2 2 1.8466196 0.9345696 1.6783350 0.7009600
## 3 3 1.3076923 0.4916892 4.7873831 0.9728086
## 4 4 2.0000000 1.4142136 9.5043378 0.8627949# Gráfico de puntos
ggplot(assigned_cluster, aes(x = zona, y = areaconst, color = cluster)) +
geom_point(size = 4) +
geom_text(aes(label = cluster), vjust = -.8) + # Agregar etiquetas del clúster
theme_classic()
[3.4]: Análisis por “Estrato”
[3.4.1]: Análisis vs “Precio”
df_ac_analisis = df_ac_z[, c("estrato", "preciom")]
# Distancia euclidiana
dist_ac <- dist(df_ac_analisis, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_ac <- hclust(dist_ac, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments <- cutree(hc_ac, k = 4)
# Asignamos los clusters
assigned_cluster <- df_ac_analisis %>% mutate(cluster = as.factor(cluster_assigments))
# Medición del índice de Silhouette
# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(df_ac_analisis))
sil_avg <- mean(sil[,3])
sil_avg## [1] 0.5458509# Análisis de los clusters
media_sd_por_cluster <- aggregate(. ~ cluster, data = assigned_cluster, FUN = function(x) c(mean = mean(x, na.rm = TRUE), sd = sd(x, na.rm = TRUE)))
print(media_sd_por_cluster)## cluster estrato.mean estrato.sd preciom.mean preciom.sd
## 1 1 3.5309637 0.4991318 -0.1759800 0.6981770
## 2 2 1.4459863 0.4971270 -0.3426669 0.4233976
## 3 3 2.6060209 0.7717254 2.0112380 0.6077224
## 4 4 2.6830986 0.7377339 3.8641932 0.3917765# Gráfico de puntos
ggplot(assigned_cluster, aes(x = estrato, y = preciom, color = cluster)) +
geom_point(size = 4) +
geom_text(aes(label = cluster), vjust = -.8) + # Agregar etiquetas del clúster
theme_classic()
[3.4.2]: Análisis vs “Area construida”
df_ac_analisis = df_ac_z[, c("estrato", "areaconst")]
# Distancia euclidiana
dist_ac <- dist(df_ac_analisis, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_ac <- hclust(dist_ac, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments <- cutree(hc_ac, k = 6)
# Asignamos los clusters
assigned_cluster <- df_ac_analisis %>% mutate(cluster = as.factor(cluster_assigments))
# Medición del índice de Silhouette
# Calcular el coeficiente de Silhouette
sil <- silhouette(cluster_assigments, dist(df_ac_analisis))
sil_avg <- mean(sil[,3])
sil_avg## [1] 0.3861342# Análisis de los clusters
media_sd_por_cluster <- aggregate(. ~ cluster, data = assigned_cluster, FUN = function(x) c(mean = mean(x, na.rm = TRUE), sd = sd(x, na.rm = TRUE)))
print(media_sd_por_cluster)## cluster estrato.mean estrato.sd areaconst.mean areaconst.sd
## 1 1 4.0000000 0.0000000 -0.3836863 0.5281575
## 2 2 1.8653125 0.8116879 -0.1508541 0.6377602
## 3 3 3.2770701 0.4482658 2.3195470 0.8036081
## 4 4 1.2985075 0.4587459 2.4843715 0.6825679
## 5 5 2.2424242 0.9692234 5.6570977 0.6685957
## 6 6 3.3750000 0.5175492 9.2562736 1.0631824# Gráfico de puntos
ggplot(assigned_cluster, aes(x = estrato, y = areaconst, color = cluster)) +
geom_point(size = 4) +
geom_text(aes(label = cluster), vjust = -.8) + # Agregar etiquetas del clúster
theme_classic()
[4]: Análisis de Correspondencia
[4.1]: Construcción del dataframe a analizar
df_vivienda_c = ds_vivienda[,c("tipo", "zona", "barrio")]
[4.2]: Función
analisis_correspondencia <- function(df, var_1, var_2) {
# Construcción de la tabla cruzada
tabla <- table(df[[var_1]], df[[var_2]])
# Prueba de independencia
chisq_result <- chisq.test(tabla)
print("Resultado de la prueba chi-cuadrado:")
print(chisq_result)
# Análisis de correspondencia
resultados_ac <- CA(tabla)
# Valores de eigenvalores
valores_prop <- resultados_ac$eig
print("Valores de los eigenvalores:")
print(valores_prop)
# Visualización de los eigenvalores
fviz_screeplot(resultados_ac, addlabels = TRUE, ylim = c(0, 80)) +
ggtitle("Scree Plot del Análisis de Correspondencia") +
ylab("Porcentaje de varianza explicado") +
xlab("Ejes")
}
[4.2.1]: “Tipo” vs “Zona”
analisis_correspondencia(df_vivienda_c, "tipo", "zona")## [1] "Resultado de la prueba chi-cuadrado:"
##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 690.93, df = 4, p-value < 2.2e-16
##
## [1] "Valores de los eigenvalores:"
## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.08305442 100 100## `geom_line()`: Each group consists of only one observation.
## ℹ Do you need to adjust the group aesthetic?
[4.2.1]: “Tipo” vs “Barrio”
analisis_correspondencia(df_vivienda_c, "tipo", "barrio")## Warning in chisq.test(tabla): Chi-squared approximation may be incorrect## [1] "Resultado de la prueba chi-cuadrado:"
##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 2468.3, df = 435, p-value < 2.2e-16
##
## [1] "Valores de los eigenvalores:"
## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.2967032 100 100## `geom_line()`: Each group consists of only one observation.
## ℹ Do you need to adjust the group aesthetic?
[4.2.1]: “Zona” vs “Barrio”
analisis_correspondencia(df_vivienda_c, "zona", "barrio")## Warning in chisq.test(tabla): Chi-squared approximation may be incorrect## [1] "Resultado de la prueba chi-cuadrado:"
##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 29343, df = 1740, p-value < 2.2e-16
## [1] "Valores de los eigenvalores:"
## eigenvalue percentage of variance cumulative percentage of variance
## dim 1 0.9619479 27.27168 27.27168
## dim 2 0.9298275 26.36105 53.63272
## dim 3 0.8951910 25.37909 79.01181
## dim 4 0.7403118 20.98819 100.00000
[5]: Informe final
El proceso implementado en el presente análisis multivariado de un conjunto de datos que caracteriza la oferta inmobiliaria de viviendas urbanas en un sector específico siguió los siguientes lineamientos metodológicos:
[1] Análisis exploratorio de datos: En esta etapa, además de comprender las variables presentes en el conjunto de datos, que se dividieron por tipo (numéricas y categóricas), se realizó la imputación y resolución de los valores faltantes. Esto permitió trabajar con un conjunto de datos completamente poblado.
[2] Análisis de componentes principales: A través de este análisis se identificaron las variables numéricas de mayor impacto en la explicación de la variabilidad general del conjunto de datos, en particular las variables asociadas al precio y al área construida de las viviendas. Esto permitió reducir el conjunto de datos a solo dos variables (componentes principales), donde el primero explica más del 92% de la variabilidad total de las variables numéricas. Esto indica que estas variables, especialmente el precio, determinan el comportamiento de la oferta en el mercado, mientras que las demás variables se relacionan entre sí y contribuyen a una mayor magnitud en este aspecto. En términos generales, variando el precio y el área construida, se podría explicar el comportamiento del mercado.
[3] Análisis de conglomerados: Con los resultados del punto anterior y siguiendo las indicaciones del ejercicio, se procedió a analizar pares de variables conformados por “zona”/“estrato” y “precio”/“área construida”. Se identificaron patrones sumamente interesantes, observándose una gran variabilidad en el tamaño de las viviendas en cada zona. Se encontró que, en todas las zonas pero en un solo estrato, hay una oferta de viviendas de menor tamaño, mientras que en dos estratos en particular se encuentran viviendas de tamaño mayor. Como era de esperarse, también se observó una oferta que agrupa viviendas con precios promedio en todos los estratos.
[4] Análisis de correspondencia: En este apartado se utilizaron tres variables: “tipo de vivienda”, “zona” y “barrio”. A excepción de la combinación “zona” vs “barrio”, donde la explicación de la variabilidad de las frecuencias absolutas de los datos se distribuye en tres componentes, las demás combinaciones se pueden reducir a una sola dimensión, logrando una explicación de la variabilidad conjunta de más del 80%.
En resumen, el mercado se ve muy influenciado, a nivel cuantitativo, por las variaciones en el precio de la vivienda y, en menor medida, por el tamaño de las mismas. Esto lleva a concluir que, al controlar estos dos aspectos, se podría lograr una relevancia competitiva en este sector. Las demás variables utilizadas en la caracterización del conjunto de datos deben estar correlacionadas entre sí y, aunque en menor proporción que el tamaño de la vivienda, también contribuyen al incremento en el precio de la misma.