library(devtools)
## Warning: package 'devtools' was built under R version 4.3.2
## Loading required package: usethis
## Warning: package 'usethis' was built under R version 4.3.2
library(shiny)
## Warning: package 'shiny' was built under R version 4.3.2
install.packages("ggplot2", repos = "http://cran.us.r-project.org")
## Installing package into 'C:/Users/cdela/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'ggplot2' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\cdela\AppData\Local\Temp\Rtmp2BivCj\downloaded_packages
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.2
devtools::install_github("dgonxalex80/paqueteMODELOS", force = TRUE)
## Downloading GitHub repo dgonxalex80/paqueteMODELOS@HEAD
## 
## ── R CMD build ─────────────────────────────────────────────────────────────────
##   
  
  
   checking for file 'C:\Users\cdela\AppData\Local\Temp\Rtmp2BivCj\remotes92585f3ad29\dgonxalex80-paqueteMODELOS-796f588/DESCRIPTION' ...
  
✔  checking for file 'C:\Users\cdela\AppData\Local\Temp\Rtmp2BivCj\remotes92585f3ad29\dgonxalex80-paqueteMODELOS-796f588/DESCRIPTION'
## 
  
  
  
─  preparing 'paqueteMODELOS': (4.5s)
##    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/cdela/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
library(paqueteMODELOS)
## Loading required package: boot
## Loading required package: broom
## Loading required package: GGally
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2
## Loading required package: gridExtra
## Loading required package: knitr
## Warning: package 'knitr' was built under R version 4.3.2
## Loading required package: summarytools
data(vivenda)
## Warning in data(vivenda): data set 'vivenda' not found
str(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>

Including Plots

You can also embed plots, for example:

data(vivenda)
## Warning in data(vivenda): data set 'vivenda' not found
str(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)
## Warning: package 'mice' was built under R version 4.3.2
## 
## Attaching package: 'mice'
## The following object is masked from 'package:stats':
## 
##     filter
## The following objects are masked from 'package:base':
## 
##     cbind, rbind
library (ggplot2)
library (tidyverse)
## Warning: package 'tidyverse' was built under R version 4.3.2
## Warning: package 'tidyr' was built under R version 4.3.2
## Warning: package 'readr' was built under R version 4.3.2
## Warning: package 'purrr' was built under R version 4.3.2
## Warning: package 'dplyr' was built under R version 4.3.2
## Warning: package 'stringr' was built under R version 4.3.2
## Warning: package 'lubridate' was built under R version 4.3.2
## ── 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 errors

Note 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 4275
missing_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 
##            3

#de 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.03604903

de 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
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 0

Se 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.1242009

con 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.04739724

** Análisis de componentes principales***

library (factoextra)
## Warning: package 'factoextra' was built under R version 4.3.2
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
res.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
casos1 <- 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] 8319
nrow(res.pca$x)
## [1] 8319
fviz_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: 5
head (vivienda_CON)
vivienda_CON_esc =scale(vivienda_CON)
vivienda_CON_esc = as.data.frame(vivienda_CON_esc)
head(vivienda_CON_esc)

Para 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

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)
## Warning: did not converge in 10 iterations
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)
table(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())