Taller 1 Modelos Estadísticos para la toma de decisiones
Karen Marcela Rosero Ramos
2024-02-13
Problema sector inmobiliario
Una empresa inmobiliaria líder en una gran ciudad está buscando comprender en profundidad el mercado de viviendas urbanas para tomar decisiones estratégicas más informadas. La empresa posee una base de datos extensa que contiene información detallada sobre diversas propiedades residenciales disponibles en el mercado. Se requiere realizar un análisis holístico de estos datos para identificar patrones, relaciones y segmentaciones relevantes que permitan mejorar la toma de decisiones en cuanto a la compra, venta y valoración de propiedades.
library(devtools)## Loading required package: usethisdevtools::install_github("dgonxalex80/paqueteMODELOS", force = TRUE)## Downloading GitHub repo dgonxalex80/paqueteMODELOS@HEAD## Warning in untar2(tarfile, files, list, exdir, restore_times): skipping pax
## global extended headers
## Warning in untar2(tarfile, files, list, exdir, restore_times): skipping pax
## global extended headers## magick (2.8.2 -> 2.8.3) [CRAN]## Installing 1 packages: magick## Installing package into 'C:/Users/karen/Documents/maestría Javeriana/KMRR/renv/library/R-4.3/x86_64-w64-mingw32'
## (as 'lib' is unspecified)##
## There is a binary version available but the source version is later:
## binary source needs_compilation
## magick 2.8.2 2.8.3 TRUE
##
## Binaries will be installed
## package 'magick' successfully unpacked and MD5 sums checked## Warning: cannot remove prior installation of package 'magick'## Warning in file.copy(savedcopy, lib, recursive = TRUE): problema al copiar
## C:\Users\karen\Documents\maestría
## Javeriana\KMRR\renv\library\R-4.3\x86_64-w64-mingw32\00LOCK\magick\libs\x64\magick.dll
## a C:\Users\karen\Documents\maestría
## Javeriana\KMRR\renv\library\R-4.3\x86_64-w64-mingw32\magick\libs\x64\magick.dll:
## Permission denied## Warning: restored 'magick'##
## The downloaded binary packages are in
## C:\Users\karen\AppData\Local\Temp\RtmpAzcWld\downloaded_packages
## ── R CMD build ─────────────────────────────────────────────────────────────────
##
checking for file 'C:\Users\karen\AppData\Local\Temp\RtmpAzcWld\remotes3b807b4a54ae\dgonxalex80-paqueteMODELOS-796f588/DESCRIPTION' ...
✔ checking for file 'C:\Users\karen\AppData\Local\Temp\RtmpAzcWld\remotes3b807b4a54ae\dgonxalex80-paqueteMODELOS-796f588/DESCRIPTION' (426ms)
##
─ preparing 'paqueteMODELOS':
## checking DESCRIPTION meta-information ...
✔ checking DESCRIPTION meta-information
##
─ checking for LF line-endings in source and make files and shell scripts
##
─ checking for empty or unneeded directories
##
─ building 'paqueteMODELOS_0.1.0.tar.gz'
##
## ## Installing package into 'C:/Users/karen/Documents/maestría Javeriana/KMRR/renv/library/R-4.3/x86_64-w64-mingw32'
## (as 'lib' is unspecified)library(paqueteMODELOS)## Loading required package: boot## Loading required package: broom## Loading required package: GGally## Loading required package: ggplot2## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2## Loading required package: gridExtra## Loading required package: knitr## Loading required package: summarytoolsdata(vivenda)## Warning in data(vivenda): data set 'vivenda' not foundstr(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")=List of 3
## ..$ cols :List of 13
## .. ..$ id : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ zona : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
## .. ..$ piso : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
## .. ..$ estrato : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ preciom : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ areaconst : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ parqueaderos: list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ banios : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ habitaciones: list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ tipo : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
## .. ..$ barrio : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
## .. ..$ longitud : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ latitud : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## ..$ default: list()
## .. ..- attr(*, "class")= chr [1:2] "collector_guess" "collector"
## ..$ delim : chr ";"
## ..- attr(*, "class")= chr "col_spec"
## - attr(*, "problems")=<externalptr>Limpieza base de datos
data(vivenda)## Warning in data(vivenda): data set 'vivenda' not foundstr(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")=List of 3
## ..$ cols :List of 13
## .. ..$ id : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ zona : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
## .. ..$ piso : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
## .. ..$ estrato : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ preciom : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ areaconst : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ parqueaderos: list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ banios : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ habitaciones: list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ tipo : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
## .. ..$ barrio : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_character" "collector"
## .. ..$ longitud : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## .. ..$ latitud : list()
## .. .. ..- attr(*, "class")= chr [1:2] "collector_double" "collector"
## ..$ default: list()
## .. ..- attr(*, "class")= chr [1:2] "collector_guess" "collector"
## ..$ delim : chr ";"
## ..- attr(*, "class")= chr "col_spec"
## - attr(*, "problems")=<externalptr>library (mice)##
## Attaching package: 'mice'## The following object is masked from 'package:stats':
##
## filter## The following objects are masked from 'package:base':
##
## cbind, rbindlibrary (ggplot2)
library (tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::combine() masks gridExtra::combine()
## ✖ dplyr::filter() masks mice::filter(), stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ tibble::view() masks summarytools::view()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsNote that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.
md.pattern(vivienda)
## 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 4275missing_values <-sapply(vivienda, function(x) sum(is.na(x)))
missing_values## 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
## 3De lo anterior se concluye que las variables con mayor número de datos faltantes son “piso” y “parqueadero”.
porcentaje_perdido <- function(x) {sum(is.na(x))/length(x)*100}
apply(vivienda, 2, porcentaje_perdido)## id zona piso estrato preciom areaconst
## 0.03604903 0.03604903 31.69911079 0.03604903 0.02403268 0.03604903
## parqueaderos banios habitaciones tipo barrio longitud
## 19.28622927 0.03604903 0.03604903 0.03604903 0.03604903 0.03604903
## latitud
## 0.03604903De lo anterior se puede concluir que el peso porcentual de los datos faltantes es mayor en las variables “piso” con 31,69% y en “parqueaderos” con 19,28%
# Se procede a eliminar las variables con datos faltantes "piso" y "parqueadero"
vivienda_limpia <- vivienda[, !names(vivienda) %in% c("id","piso", "parqueaderos")]
# Eliminar las filas con datos faltantes
vivienda_limpia_nueva <- vivienda_limpia[complete.cases(vivienda_limpia), ]
vivienda_limpia_nueva## # A tibble: 8,319 × 10
## zona estrato preciom areaconst banios habitaciones tipo barrio longitud
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <chr> <dbl>
## 1 Zona Ori… 3 250 70 3 6 Casa 20 de… -76.5
## 2 Zona Ori… 3 320 120 2 3 Casa 20 de… -76.5
## 3 Zona Ori… 3 350 220 2 4 Casa 20 de… -76.5
## 4 Zona Sur 4 400 280 5 3 Casa 3 de … -76.5
## 5 Zona Nor… 5 260 90 2 3 Apar… acopi -76.5
## 6 Zona Nor… 5 240 87 3 3 Apar… acopi -76.5
## 7 Zona Nor… 4 220 52 2 3 Apar… acopi -76.5
## 8 Zona Nor… 5 310 137 3 4 Apar… acopi -76.5
## 9 Zona Nor… 5 320 150 4 6 Casa acopi -76.5
## 10 Zona Nor… 5 780 380 3 3 Casa acopi -76.5
## # ℹ 8,309 more rows
## # ℹ 1 more variable: latitud <dbl>md.pattern(vivienda_limpia_nueva)## /\ /\
## { `---' }
## { O O }
## ==> V <== No need for mice. This data set is completely observed.
## \ \|/ /
## `-----'
## zona estrato preciom areaconst banios habitaciones tipo barrio longitud
## 8319 1 1 1 1 1 1 1 1 1
## 0 0 0 0 0 0 0 0 0
## latitud
## 8319 1 0
## 0 0Se procede a estandarizar los datos de variables númericas que se consideren de gran relevancia, de modo que se asegura la no afectación de procedimiento de analisis de componentes principales.
viviendaCP <- vivienda_limpia_nueva %>%
select_if(is.numeric) %>%
scale()
head (viviendaCP)## estrato preciom areaconst banios habitaciones longitud
## [1,] -1.5872276 -0.5595498 -0.7339949 -0.07793773 1.6406840 0.9728466
## [2,] -1.5872276 -0.3465670 -0.3842568 -0.77811479 -0.4147626 0.9331875
## [3,] -1.5872276 -0.2552886 0.3152194 -0.77811479 0.2703863 0.7607566
## [4,] -0.6156201 -0.1031580 0.7349051 1.32241640 -0.4147626 -0.6549016
## [5,] 0.3559875 -0.5291236 -0.5940997 -0.77811479 -0.4147626 0.8682385
## [6,] 0.3559875 -0.5899759 -0.6150839 -0.07793773 -0.4147626 0.6670691
## latitud
## [1,] 0.3793708
## [2,] 0.3763219
## [3,] 0.4225243
## [4,] 0.4070454
## [5,] 0.9678065
## [6,] -1.1242009Con lo anterior se procede a calcular la desviación estándar de los datos escalados.
prcomp(viviendaCP)## Standard deviations (1, .., p=7):
## [1] 1.7649945 1.2197986 0.9408170 0.8090903 0.6534211 0.4902176 0.4357175
##
## Rotation (n x k) = (7 x 7):
## PC1 PC2 PC3 PC4 PC5
## estrato 0.3596495 -0.46160840 0.29253122 -0.24988384 -0.47695341
## preciom 0.4947460 -0.06764679 0.25051923 -0.25237458 0.22943062
## areaconst 0.4556538 0.26756925 0.02809938 -0.12641620 0.64147176
## banios 0.4903682 0.18623745 -0.06882523 -0.01680433 -0.39400870
## habitaciones 0.2974110 0.54943309 -0.32731570 0.32355603 -0.33736244
## longitud -0.2672367 0.46217187 -0.01581921 -0.82481589 -0.17733905
## latitud -0.1338978 0.40072976 0.85950759 0.26942892 -0.08880096
## PC6 PC7
## estrato 0.501853021 0.17381740
## preciom -0.219896274 -0.72332891
## areaconst 0.292270190 0.45509101
## banios -0.652112622 0.37328490
## habitaciones 0.431734658 -0.31247031
## longitud 0.052076162 -0.01578471
## latitud -0.003114001 0.04739724Análisis de componentes principales
library (factoextra)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBares.pca <- prcomp(viviendaCP)
fviz_eig(res.pca, addlabels = TRUE)
De acuerdo con el gráfico anterior, es posible deducir que el primer componente explica el 44.5% de la variabilidad, en tanto que el segundo componente la explica en 21,3%, el tercero con un valor del 12.6% y el 9.4%, lo que significa que los cuatro primeros componentes se tendran en cuenta para el analisis, dado que representan una variabilidad aproximada al 90% que es el valor recomendado para el analisis de componentes principales.
fviz_contrib(res.pca,axes = 1, choice = "var", addlabels = TRUE) # dimensión 1 
fviz_contrib(res.pca,axes = 2, choice = "var", addlabels = TRUE) # dimensión 2 
fviz_contrib(res.pca,axes = 3, choice = "var", addlabels = TRUE) # dimensión 3
fviz_contrib(res.pca,axes = 4, choice = "var", addlabels = TRUE) # dimensión 4 
fviz_pca_var(res.pca,
col.var = "contrib",
gradient.cols = c("#FF7F00", "#034D94"),
repel = TRUE
)
datos<- rbind(viviendaCP[112,],
viviendaCP[1088,],
viviendaCP[21,],
viviendaCP[497,])
datos <- as.data.frame(datos)
rownames(datos) = c("Dato 112","Dato 1088","Dato 021","Dato 497")
datos## estrato preciom areaconst banios habitaciones longitud
## Dato 112 -0.6156201 -0.8851092 -0.8179320 -1.4782919 -0.4147626 -0.092201884
## Dato 1088 -0.6156201 0.9617560 0.8748003 1.3224164 0.2703863 0.045168107
## Dato 021 -1.5872276 -0.7877456 -0.6640473 -0.7781148 -0.4147626 -0.008285488
## Dato 497 1.3275950 0.2923815 -0.4332201 0.6222393 -0.4147626 -1.114717428
## latitud
## Dato 112 0.20581862
## Dato 1088 1.36744563
## Dato 021 0.05665756
## Dato 497 0.66502833casos1 <- rbind(res.pca$x[112,1:4],res.pca$x[1088,1:4]) # CP1
rownames(casos1) = c("112","1088")
casos1 <- as.data.frame(casos1)
casos2 <- rbind(res.pca$x[021,1:4], res.pca$x[497,1:4]) # CP2
rownames(casos2) = c("021","497")
casos2 <- as.data.frame(casos2)
fviz_pca_ind(res.pca, 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)
length(vivienda_limpia_nueva$tipo)## [1] 8319nrow(res.pca$x)## [1] 8319fviz_pca_biplot(
res.pca,
habillage = vivienda_limpia_nueva$tipo,
repel = TRUE,
col.var = "#001F3F", # Variables color
col.ind = c("#6A5ACD", "#FFD700") # Individuals color
)
Lo anterior indica que el tipo de vivienda apartamento presenta
variables que cuentan con un mayor peso explicativo y se encuentran
relacionadas con el precio por metro cuadrado y el estrato. En el caso
del tipo de vivienda de casa, es posible entender que los atributos que
cuentan con un mayor peso explicativo son las habitaciones, área
construida y número de baños.
fviz_pca_biplot(res.pca,
repel = TRUE,
habillage = vivienda_limpia_nueva$zona,
col.var = "#001F3F", # Variables color
col.ind = c("#DEDEDE", "#034B26") # Individuals color
)
Con lo anterior, es posible establecer que los atributos de los componentes principales tienen variacion acorde con la zona de la vivienda, pues en la zona sur el área construída es el principal atributo explicativo. En contraste, la zona oeste encuentra como variables explicativas el número de baños, el precio por metro cuadrado, mientras que en la zona norte la explicación es las características de habitaciones, longitud y latitud.
Análisis de Conglomerados
El análisis de conglomerados es una tecnica estadistica que permite agrupar datos similares en conglomerados, dividiendo un conjunto de datos en subgrupos homogéneos de manera que los elementos de cada grupo sean mas similares entre sí. De esta manera, para dar continuidad al trabajo es necesario seleccionar las variables con las que se debe trabajar.
vivienda_CON <- vivienda_limpia_nueva [, c("zona", "estrato", "preciom", "areaconst", "habitaciones", "banios")]
vivienda_CON$zona <- factor(vivienda_CON$zona)
niveles <- levels(vivienda_CON$zona)
vivienda_CON$zona <- as.integer(vivienda_CON$zona) # Asignar valores numéricos a cada nivel del factor
for (i in 1:length(niveles)) {
cat("Categoría:", niveles[i], " - Valor numérico asignado:", i, "\n")
}## Categoría: Zona Centro - Valor numérico asignado: 1
## Categoría: Zona Norte - Valor numérico asignado: 2
## Categoría: Zona Oeste - Valor numérico asignado: 3
## Categoría: Zona Oriente - Valor numérico asignado: 4
## Categoría: Zona Sur - Valor numérico asignado: 5head (vivienda_CON)## # A tibble: 6 × 6
## zona estrato preciom areaconst habitaciones banios
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 3 250 70 6 3
## 2 4 3 320 120 3 2
## 3 4 3 350 220 4 2
## 4 5 4 400 280 3 5
## 5 2 5 260 90 3 2
## 6 2 5 240 87 3 3vivienda_CON_esc =scale(vivienda_CON)
vivienda_CON_esc = as.data.frame(vivienda_CON_esc)
head(vivienda_CON_esc)## zona estrato preciom areaconst habitaciones banios
## 1 0.06192582 -1.5872276 -0.5595498 -0.7339949 1.6406840 -0.07793773
## 2 0.06192582 -1.5872276 -0.3465670 -0.3842568 -0.4147626 -0.77811479
## 3 0.06192582 -1.5872276 -0.2552886 0.3152194 0.2703863 -0.77811479
## 4 0.81508501 -0.6156201 -0.1031580 0.7349051 -0.4147626 1.32241640
## 5 -1.44439256 0.3559875 -0.5291236 -0.5940997 -0.4147626 -0.77811479
## 6 -1.44439256 0.3559875 -0.5899759 -0.6150839 -0.4147626 -0.07793773Para identificar el número de conglomerados que se necesitan en el presente analisis se pueden usar dos técnicas, tales como: los métodos jerárquicos y no jerárquicos.
Métodos no jerárquicos
Los métodos no jerárquicos se reconocen como técnicas utilizadas en el análisis de conglomerados para agrupar un conjunto de objetos en subconjuntos, sin formar una estructura jerárquica. Estos métodos implican la asignación directa de cada objeto a un grupo específico, en lugar de formar una estructura de agrupación en niveles como lo hacen los métodos jerárquicos.
scv <- (nrow(vivienda_CON_esc) - 1) * sum(apply(vivienda_CON_esc, 2, var))
for (i in 2:15) scv[i] <- sum(kmeans(vivienda_CON_esc,
centers = i)$withinss)
plot(1:15, scv,
type = "b",
xlab = "Cantidad de Clusters",
ylab="Suma de cuadrados dentro de grupos")
fviz_nbclust(vivienda_CON_esc, kmeans, method = "wss") +
geom_vline(xintercept = 4, linetype = 2) + labs (subtitle="Método del Codo")
set.seed(123)
wcss <- numeric(length = 10)
for (i in 1:10) {
kmeans_model <- kmeans(vivienda_CON_esc, centers = i)
wcss[i] <- kmeans_model$tot.withinss
}
plot(1:10, wcss, type = "b", pch = 19, frame = FALSE, xlab = "Número de Clusters", ylab = "WCSS")
abline(v = 3, col = "red", lty = 2) 
set.seed(123)
kmeans_model<- kmeans(vivienda_CON_esc, 3)
vivienda_CON_esc <- data.frame(vivienda_CON_esc,
kmeans_model$cluster)
aggregate(vivienda_CON,
by = list(vivienda_CON_esc$kmeans_model.cluster),
FUN = median)## Group.1 zona estrato preciom areaconst habitaciones banios
## 1 1 5 6 750 300 4 5
## 2 2 5 4 252 92 3 2
## 3 3 2 5 300 103 3 2table(vivienda_CON_esc$kmeans_model.cluster)##
## 1 2 3
## 2243 3717 2359***Lo anterior indica que en el primer cluster existen un total de 2.243 registros, mientras que en el segundo existen 3.713 y en el tercero 2.359
fviz_cluster(list(data = vivienda_CON_esc[,1:6],
cluster = vivienda_CON_esc$kmeans_model.cluster),
palette = c("#FF5733", "#3AFF57", "#338CFF"),
ellipse.type = "convex",repel = F,
show.clust.cent = FALSE, ggtheme = theme_minimal())
La grafica anterior indica que ezisten 3 conglomerados identificados,
donde se encuentra que el clúster 1 y 2 estan apartados claramente, en
tanto que el clúster 2 parece compartir atributos con el clúster 3.
Métodos jerárquicos
Con el método jerárquico se procede a ratificar el número de clusters, para lo que se utiliza el índice de Sulhouette para valorar la major alternativa para la elección de los conglomerados
library(cluster)
# distancia euclidiana
dist_vivi_k2 <- dist(vivienda_CON_esc, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_viv_k2 <- hclust(dist_vivi_k2, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments_k2 <- cutree(hc_viv_k2, k = 2)
# Calcular el coeficiente de Silhouette
sil_k2 <- silhouette(cluster_assigments_k2, dist(vivienda_CON_esc))
sil_avg_k2 <- mean(sil_k2[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=2 : ", sil_avg_k2)## Coeficiente de Silhouette promedio k=2 : 0.6655843# distancia euclidiana
dist_vivi_k3 <- dist(vivienda_CON_esc, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_viv_k3 <- hclust(dist_vivi_k3, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments_k3 <- cutree(hc_viv_k3, k = 3)
# Calcular el coeficiente de Silhouette
sil_k3 <- silhouette(cluster_assigments_k3, dist(vivienda_CON_esc))
sil_avg_k3 <- mean(sil_k3[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=3 : ", sil_avg_k3)## Coeficiente de Silhouette promedio k=3 : 0.3590902# distancia euclidiana
dist_vivi_k4 <- dist(vivienda_CON_esc, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_viv_k4 <- hclust(dist_vivi_k4, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments_k4 <- cutree(hc_viv_k4, k = 4)
# Calcular el coeficiente de Silhouette
sil_k4 <- silhouette(cluster_assigments_k4, dist(vivienda_CON_esc))
sil_avg_k4 <- mean(sil_k4[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=4 : ", sil_avg_k4)## Coeficiente de Silhouette promedio k=4 : 0.3179575# distancia euclidiana
dist_vivi_k5 <- dist(vivienda_CON_esc, method = 'euclidean')
# Cluster jerarquico con el método complete
hc_viv_k5 <- hclust(dist_vivi_k5, method = 'complete')
# Determinamos a dónde pertenece cada observación
cluster_assigments_k5 <- cutree(hc_viv_k5, k = 5)
# Calcular el coeficiente de Silhouette
sil_k5 <- silhouette(cluster_assigments_k5, dist(vivienda_CON_esc))
sil_avg_k5 <- mean(sil_k5[,3])
# Imprimir el coeficiente de Silhouette promedio
cat("Coeficiente de Silhouette promedio k=5 : ", sil_avg_k5)## Coeficiente de Silhouette promedio k=5 : 0.3091564set.seed(123)
kmeans_model_2<- kmeans(vivienda_CON_esc, 2)
vivienda_CON_esc <- data.frame(vivienda_CON_esc,
kmeans_model_2$cluster)
aggregate(vivienda_CON,
by = list(vivienda_CON_esc$kmeans_model_2.cluster),
FUN = median)## Group.1 zona estrato preciom areaconst habitaciones banios
## 1 1 5 6 750 300 4 5
## 2 2 5 4 270 96 3 2table(vivienda_CON_esc$kmeans_model_2.cluster)##
## 1 2
## 2244 6075fviz_cluster(list(data = vivienda_CON_esc[,1:6],
cluster = vivienda_CON_esc$kmeans_model_2.cluster),
palette = c("#FF5733", "#3AFF57", "#338CFF"),
ellipse.type = "convex",repel = F,
show.clust.cent = FALSE, ggtheme = theme_minimal())
Acorde con lo anterior es posible dedudir la existencia de dos
Clústeres, pero para tener una visión mas precisa se procede a efectuar
el dentograma y se continúa con la valoración de datos atípicos en los
clusteres
# Cálculo de la matríz de distancia
d <- dist(vivienda_CON_esc, method = "euclidean")
# Clustering jerárquico con liga completa
hc1 <- hclust(d, method = "complete")
# Dendrograma
plot(hc1, cex = 0.6, main = "Dendrograma de Viviendas 1", hang = -1, ylab = "Distancia Euclidiana", xlab = "Grupos")
rect.hclust(hc1, k = 3, border = 2:10)
# Cálculo de la matríz de distancia
d2 <- dist(vivienda_CON_esc, method = "euclidean")
# Clustering jerárquico con liga completa
hc2 <- hclust(d, method = "complete")
# Dendrograma
plot(hc2, cex = 0.6, main = "Dendrograma de Viviendas 2", hang = -1, ylab = "Distancia Euclidiana", xlab = "Grupos")
rect.hclust(hc2, k = 2, border = 2:10)
Con los resultados de los dendogramas es posible establecer que con la
agrupación de 3 clúesteres existe una mejor relación que con el análisis
de dos, debido a que en el primero los datos se distribuyen de una forma
normal. Cabe resaltar que en la elección de los clústeres es necesario
reconocer la no existencia de una formula única, lo que significa que
existen diferentes metodologías para la selección de los mismos. Con
base en lo anterior se procede a efectuar una evaluación de los
clústeres seleccionados acorde con variables: preciom, area construída,
estrato y número de habitaciones.
set.seed(0)
clusterfinal <- kmeans(vivienda_CON, center=3, nstart = 20)
vivienda_CON_esc %>%
ggplot(aes(x = factor(clusterfinal$cluster), y = preciom, fill = factor(clusterfinal$cluster))) + geom_boxplot() + geom_point() + xlab("Cluster") + labs(fill="Cluster")
Con la gráfica anterior, es posible evidenciar una relación entre el
preciom y cada uno de los cluster, donde se encuentra que el cluster 2
es el que presenta los precios mas elevados con mayor dispersión y más
datos atípicos, señalando que en este clústere hay una importante
cantidad de viviendas con precios muy alejados de la media. Por otro
lado, es preciso establecer que el cluster 1 es el que presenta precios
bajos y tiene menos dispension en los valores de vivienda, mientras que
el tres cuenta con precios superiores al cluster 1, con más datos
atípicos y mayor variabilidad de datos con relación al 1.
vivienda_CON_esc %>%
ggplot(aes(x = factor(clusterfinal$cluster), y = areaconst, fill = factor(clusterfinal$cluster))) + geom_boxplot() + geom_point() + xlab("Cluster") + labs(fill="Cluster")
La gráfica presentada indica que el cluster dos las areas construidas
cuentan con una media superior y adicionalmente existe gran cantdidad de
datos atípicos.
vivienda_CON_esc %>%
ggplot(aes(x = factor(clusterfinal$cluster), y = estrato, fill = factor(clusterfinal$cluster))) + geom_boxplot() + geom_point() + xlab("Cluster") + labs(fill="Cluster")
En la gráfica se evidencia que el clúster 2 presenta la mayor cantidad
de datos atípicos que no posibilitan visualizar de manera clara la caja
del mismo. De la misma manera, se indica que el clúster 1 es el que
cuenta con los estratos mas bajos.
vivienda_CON_esc %>%
ggplot(aes(x = factor(clusterfinal$cluster), y = habitaciones, fill = factor(clusterfinal$cluster))) + geom_boxplot() + geom_point() + xlab("Cluster") + labs(fill="Cluster")
En el gráfico anterior se encuentra que el clúster 1 es el que presenta
un menor número de habitaciones y pese a que los clústeres dos y tres
presentan mayor número de habitaciones, la totalidad de los clústeres
indicnan la existencia de datos atípicos.
vivienda_CON_esc %>%
ggplot(aes(x = factor(clusterfinal$cluster), y = banios, fill = factor(clusterfinal$cluster))) + geom_boxplot() + geom_point() + xlab("Cluster") + labs(fill="Cluster")
Finalmente, se encuentra que el clúster número 1 presenta una menor
cantidad de baños, mientras que el clúster 2 es el que cuenta con un
mayor número de baños.
Análisis de correspondencia
El análisis de correspondencia se resume en una técnica estadística utilizada principalmente en el análisis exploratorio de datos de tablas de contingencia, es decir, en situaciones donde se tienen dos o más variables categóricas y se quiere examinar la relación entre ellas. Es particularmente útil cuando se trabaja con tablas de datos multidimensionales donde las variables categóricas pueden tener múltiples niveles.
El objetivo principal del análisis de correspondencia es encontrar patrones y relaciones entre las categorías de las variables categóricas mediante la representación gráfica de estas relaciones en un espacio de baja dimensión. En otras palabras, el AC reduce la dimensionalidad de los datos para visualizar y comprender mejor las asociaciones entre las categorías.
tabla <- table(vivienda$zona, vivienda$estrato)
tabla##
## 3 4 5 6
## Zona Centro 105 14 4 1
## Zona Norte 572 407 769 172
## Zona Oeste 54 84 290 770
## Zona Oriente 340 8 2 1
## Zona Sur 382 1616 1685 1043Se realiza la independencia de variables con el método de chi-cuadrado
chisq.test(tabla)##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 3830.4, df = 12, p-value < 2.2e-16Si el estadístico de prueba es mayor que el valor crítico (o si el p-valor es menor que un nivel de significancia predefinido, comúnmente 0.05), entonces se rechaza la hipótesis nula. Esto sugiere que hay una asociación significativa entre las variables categóricas en estudio. De lo contrario, si el estadístico de prueba es menor que el valor crítico (o si el p-valor es mayor que el nivel de significancia), no se puede rechazar la hipótesis nula y no se puede concluir que hay una asociación significativa entre las variables categóricas.
Dado que el valor p es significativamente menor que cualquier nivel de significancia comúnmente utilizado (como 0.05), sugiere que hay una asociación significativa entre las variables categóricas en estudio. Por lo tanto, se tiene evidencia estadística suficiente para concluir que hay una asociación significativa entre las variables categóricas en la tabla de datos que se analizó.
library(FactoMineR)
library(factoextra)
library(gridExtra)
resultados_ac <- CA(tabla)
En primer lugar se reconoce que el estrato seis se encuentra ubicado en
la Zona Oeste de la ciudad de Cali; mientras que en la Zona sur están
los estratos 4 y 5. Así mismo, el estrato tres se ubica principalmente
en la zona centro y oriente.
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")
Con lo anterior, es posible entender que el primer componente explica el
70% de los cambios y sumados con el segundo se explica en el 97.7% de
los cambios. COn base en los resultados se encuentra que la relacion
entre estrato y precio eziste un alto grado de certeza.
library(dplyr)
q1 <- quantile(vivienda_limpia_nueva$preciom, c(0.25), type = 6)
q2 <- quantile(vivienda_limpia_nueva$preciom, c(0.50), type = 6)
q3 <- quantile(vivienda_limpia_nueva$preciom, c(0.75), type = 6)
datacorresp <- vivienda_limpia_nueva %>% mutate(value = ifelse(preciom <= q1, "bajo", ifelse(preciom <= q2,"medio bajo",ifelse(preciom <= q3,"medio alto","alto"))))
tabla2 <- table(datacorresp$zona, datacorresp$value)
chisq.test(tabla2)##
## Pearson's Chi-squared test
##
## data: tabla2
## X-squared = 1137.6, df = 12, p-value < 2.2e-16resultados_ac_2 <- CA(tabla2)
La
gráfica señala que los ingresos medio alto y alto se encuentran en la
zona oeste, en tanto que en la zona sur y centro se encuentran los
ingresos medio bajo que también indican correlación con los datos
obtenidos en el gráfico de estrato. Finalmente, en la zona norte y
oriente se ubican las vivienda de precio bajo.
fviz_screeplot(resultados_ac_2, addlabels = TRUE, ylim = c(0, 80))+ggtitle("")+
ylab("Porcentaje de varianza explicado") + xlab("Ejes")
Lo
anterior explica el nivel de varianza del análisis precio-zona indicando
que en los dos primeros componente se explica más del 98% de las
variaciones.
Conclusiones
las principales conclusiones del análisis indican que las variables mas determinantes y más explicativas de la base de datos son el precio, las habitaciones, el numero de baños, el area construída y la zona.
El análisis de conglomerados indica la necesidad de agrupar los datos en tres clústeres, puesto que hay una mejor agrupación y un mejor balanceo de los datos.
El análisis final de correspondencia señala la existencia de asociaciones entre variables, algunas de ellas se presentan entre la zona, el precio y el estrato. Dichas variables presentan alto grado de explicacion de la varianza.