Unidad 1: Modelos multivariados
Modelos estadísticos para la toma de decisiones
Diego Fernando Ortiz Meléndez
2023-08-10
R Markdown
hola
instalamos el paquete
Miramos los 10 primeros datos de la tabla
head(vivienda,10)Obtenemos información de la base de datos a analizar
str(vivienda)## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 8322 obs. of 13 variables:
## $ id : num 1147 1169 1350 5992 1212 ...
## $ zona : chr "Zona Oriente" "Zona Oriente" "Zona Oriente" "Zona Sur" ...
## $ piso : chr NA NA NA "02" ...
## $ estrato : num 3 3 3 4 5 5 4 5 5 5 ...
## $ preciom : num 250 320 350 400 260 240 220 310 320 780 ...
## $ areaconst : num 70 120 220 280 90 87 52 137 150 380 ...
## $ parqueaderos: num 1 1 2 3 1 1 2 2 2 2 ...
## $ banios : num 3 2 2 5 2 3 2 3 4 3 ...
## $ habitaciones: num 6 3 4 3 3 3 3 4 6 3 ...
## $ tipo : chr "Casa" "Casa" "Casa" "Casa" ...
## $ barrio : chr "20 de julio" "20 de julio" "20 de julio" "3 de julio" ...
## $ longitud : num -76.5 -76.5 -76.5 -76.5 -76.5 ...
## $ latitud : num 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>Obtenermos el resumen estadístico
summary(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 :3La dimensión de la base de datos
dim(vivienda) ## [1] 8322 13De lo anterior tenemos que la base de datos tiene 8322 filas y 13 columnas, de las 13 variables encontradas se tiene que 10 son numericas y 3 de texto, también se pueden identificar que existen muchas columnas vacias.
Si analizamos mas detalle las que mas tienen datos vacios son la variables piso con 2638 y la variable parqueaderos con 1605, en el caso de la variable parqueaderos asumiremos que son las viviendas que con 0 parqueaderos y para la variable piso imputaremos con la media.
vivienda$parquea <- ifelse(is.na(vivienda$parquea), 0, vivienda$parquea)
media_piso <- mean(vivienda$piso, na.rm = TRUE)## Warning in mean.default(vivienda$piso, na.rm = TRUE): argument is not numeric
## or logical: returning NAvivienda$piso[is.na(vivienda$piso)] <- media_pisoAhora eliminamos los datos nulos del resto de la data
vivienda_nueva <- na.omit(vivienda)Visualizamos la información de la data modificada
summary(vivienda_nueva)## id zona piso estrato
## Min. : 1 Length:4808 Length:4808 Min. :3.000
## 1st Qu.:2479 Class :character Class :character 1st Qu.:4.000
## Median :4474 Mode :character Mode :character Median :5.000
## Mean :4427 Mean :4.838
## 3rd Qu.:6413 3rd Qu.:6.000
## Max. :8316 Max. :6.000
## preciom areaconst parqueaderos banios
## Min. : 58.0 Min. : 40.0 Min. : 1.000 Min. : 0.000
## 1st Qu.: 244.5 1st Qu.: 85.0 1st Qu.: 1.000 1st Qu.: 2.000
## Median : 350.0 Median : 123.0 Median : 2.000 Median : 3.000
## Mean : 457.2 Mean : 174.8 Mean : 1.815 Mean : 3.219
## 3rd Qu.: 560.0 3rd Qu.: 225.0 3rd Qu.: 2.000 3rd Qu.: 4.000
## Max. :1999.0 Max. :1500.0 Max. :10.000 Max. :10.000
## habitaciones tipo barrio longitud
## Min. : 0.000 Length:4808 Length:4808 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.564 Mean :-76.53
## 3rd Qu.: 4.000 3rd Qu.:-76.52
## Max. :10.000 Max. :-76.46
## latitud parquea
## Min. :3.333 Min. : 1.000
## 1st Qu.:3.378 1st Qu.: 1.000
## Median :3.408 Median : 2.000
## Mean :3.414 Mean : 1.815
## 3rd Qu.:3.451 3rd Qu.: 2.000
## Max. :3.498 Max. :10.000La dimensión de la base de datos
dim(vivienda_nueva) ## [1] 4808 14La nueva base de datos solo tiene 3 filas menos, es decir 8319 registros.
install.packages("ggplot2")## package 'ggplot2' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\Diego Ortiz\AppData\Local\Temp\Rtmp0OTIhB\downloaded_packageslibrary(ggplot2)# Histograma de precios de vivienda
ggplot(vivienda_nueva, aes(x = preciom)) +
geom_histogram(binwidth = 100, fill = "blue", color = "black") +
labs(title = "Histograma de Precios de Vivienda",
x = "Precio",
y = "Frecuencia")
# Diagrama de barras de estratos
ggplot(vivienda_nueva, aes(x = factor(estrato))) +
geom_bar(fill = "green") +
labs(title = "Diagrama de Barras de Estratos",
x = "Estrato",
y = "Frecuencia")
# Gráfico de dispersión de área construida vs. precio
ggplot(vivienda_nueva, aes(x = areaconst, y = preciom)) +
geom_point(alpha = 0.5, color = "blue") +
labs(title = "Gráfico de Dispersiones de Área Construida vs. Precio",
x = "Área Construida",
y = "Precio")
# Diagrama de barras para la variable 'zona'
ggplot(vivienda_nueva, aes(x = zona, fill = zona)) +
geom_bar() +
labs(title = "Diagrama de Barras para Zona",
x = "Zona",
y = "Frecuencia")
# Diagrama de barras para la variable 'tipo'
ggplot(vivienda_nueva, aes(x = tipo, fill = tipo)) +
geom_bar() +
labs(title = "Diagrama de Barras para Tipo de Vivienda",
x = "Tipo",
y = "Frecuencia")
# Gráfico de dispersión de latitud y longitud por zona
ggplot(vivienda_nueva, aes(x = longitud, y = latitud, color = zona)) +
geom_point() +
labs(title = "Gráfico de Dispersiones de Latitud y Longitud por Zona",
x = "Longitud",
y = "Latitud")
##ANALISIS PDCA
# Seleccionar las variables numéricas para el PCA
variables_numericas <- vivienda_nueva[, c("estrato", "preciom", "areaconst", "parqueaderos", "banios", "habitaciones")]
# Estandarizar los datos (convertir a Z-scores)
variables_estandarizadas <- scale(variables_numericas)
# Realizar el PCA
pca_resultado <- prcomp(variables_estandarizadas, scale = TRUE)
# Explorar los resultados del PCA
summary(pca_resultado)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 1.8866 1.0884 0.69530 0.58528 0.49647 0.42886
## Proportion of Variance 0.5932 0.1974 0.08057 0.05709 0.04108 0.03065
## Cumulative Proportion 0.5932 0.7906 0.87117 0.92827 0.96935 1.00000# Explorar los valores propios (varianza explicada)
pca_valores_propios <- pca_resultado$sdev^2
proporcion_varianza_explicada <- pca_valores_propios / sum(pca_valores_propios)
# Gráfico de varianza explicada por componentes
fviz_screeplot(pca_resultado, addlabels = TRUE, ylim = c(0, 100))
# Seleccionar el número de componentes principales
num_componentes <- 6 # Escoge el número que consideres adecuado
# Obtener los valores transformados (coordenadas) para las observaciones en las primeras num_componentes componentes
coordenadas_componentes <- predict(pca_resultado, newdata = variables_estandarizadas)[, 1:num_componentes]
# Matriz de cargas
matriz_cargas <- pca_resultado$rotation[, 1:num_componentes]
# Imprimir la matriz de cargas
print(matriz_cargas)## PC1 PC2 PC3 PC4 PC5 PC6
## estrato 0.2946513 0.6488133 -0.5512044 0.06330413 -0.4037809 0.1461135
## preciom 0.4676270 0.2332802 0.1252672 -0.31468474 0.2245253 -0.7495167
## areaconst 0.4495212 -0.2109552 0.2495691 -0.64247711 -0.2937703 0.4382534
## parqueaderos 0.4287458 0.1463697 0.6073869 0.62730620 -0.1435930 0.1081764
## banios 0.4639679 -0.1419484 -0.3362258 0.14651179 0.7162461 0.3421438
## habitaciones 0.3055275 -0.6622281 -0.3690942 0.26307887 -0.4081922 -0.3099112fviz_pca_var(pca_resultado,
col.var = "contrib",
gradient.cols = c("green", "red"),
repel = TRUE)
fviz_pca_biplot(pca_resultado,
col.var = "steelblue",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE,
title = "Biplot de Componentes Principales",
habillage = as.factor(vivienda_nueva$zona), # Colorear por la variable 'zona'
geom = "point",
pointshape = 21, pointsize = 3,
fill.ind = "lightgray",
alpha.var = 0.6,
legend.title = "Zona",
ggtheme = theme_minimal())
Analisis de conglomerados
library(stats)
# Seleccionar las variables numéricas para el análisis de conglomerados
variables_conglomerados <- vivienda_nueva[, c("estrato", "preciom", "areaconst", "parqueaderos", "banios", "habitaciones", "longitud", "latitud")]
# Estandarizar los datos (convertir a Z-scores)
variables_estandarizadas <- scale(variables_conglomerados)Determinamos el numero optimo Cluster
# Crear un vector para almacenar las sumas de cuadrados
sumas_cuadrados <- vector("numeric", length = 10)
# Calcular las sumas de cuadrados para diferentes números de clústeres
for (i in 1:10) {
resultado_conglomerados <- kmeans(variables_estandarizadas, centers = i)
sumas_cuadrados[i] <- resultado_conglomerados$tot.withinss
}
# Crear un gráfico de codo
grafico_codo <- ggplot(data = data.frame(Clusters = 1:10, Sumas_Cuadrados = sumas_cuadrados),
aes(x = Clusters, y = Sumas_Cuadrados)) +
geom_line() +
geom_point() +
labs(title = "Gráfico de Codo para Determinar Número de Clústeres", x = "Número de Clústeres", y = "Sumas de Cuadrados") +
theme_minimal()
print(grafico_codo)
Del gráfico de codo concluimos que el número optimo sería 4 puesto que es ahi donde empieza a aplanarse la recta.
# Realizar el análisis de componentes principales (PCA)
pca_resultado <- prcomp(variables_estandarizadas)
# Obtener las dos primeras componentes principales (PC1 y PC2)
pc1 <- pca_resultado$x[, 1]
pc2 <- pca_resultado$x[, 2]
# Definir la variable de los cluster
num_clusters <- 4
# Realizar el análisis de conglomerados utilizando el método k-means
resultado_conglomerados <- kmeans(variables_estandarizadas, centers = num_clusters)
# Obtener la asignación de clúster para cada observación
asignacion_cluster <- resultado_conglomerados$cluster
# Crear un dataframe con los datos originales y la asignación de clúster
datos_con_clusters <- cbind(vivienda_nueva, Clusters = asignacion_cluster)
# Crear un gráfico de dispersión de las dos primeras dimensiones con colores de clúster
ggplot(datos_con_clusters, aes(x = pc1, y = pc2, color = factor(Clusters))) +
geom_point(size = 3, alpha = 0.6) +
labs(title = "Visualización de Conglomerados en las Dos Primeras Dimensiones", x = "Dimensión 1 (PC1)", y = "Dimensión 2 (PC2)", color = "Clúster") +
theme_minimal()
# Calculamos la matriz de distancias usando dist()
dist_matrix <- dist(variables_estandarizadas)
# Realizamos análisis jerárquico de conglomerados (AHC) con método Ward
modelo_hclust <- hclust(dist_matrix, method = "ward.D2")
# Graficamos el dendrograma
plot(modelo_hclust, hang = -1, main = "Dendrograma de Análisis Jerárquico")
Analisis de correspondencia
library(FactoMineR)
tabla <- table(vivienda_nueva$zona, vivienda_nueva$estrato)
tabla##
## 3 4 5 6
## Zona Centro 33 3 0 0
## Zona Norte 141 184 482 79
## Zona Oeste 19 51 181 502
## Zona Oriente 94 2 1 0
## Zona Sur 147 973 1195 721library(FactoMineR)
library(ggplot2)
library(factoextra)
library(gridExtra)##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinePlano_ca <- CA(tabla)
El estrato 6 se localiza en la Zona Occidental. Los estratos 4 y 5
tienen su principal ubicación en las Zonas Sur y Norte respectivamente.
El estrato 3 abarca tanto las Zonas Oriental como Central.
# Obtener los valores propios
valores_propios <- Plano_ca$eig
# Graficar el Scree Plot
fviz_screeplot(Plano_ca, addlabels = TRUE, ylim = c(0, 70)) +
ggtitle("Scree Plot del Análisis de Correspondencia") +
ylab("Porcentaje de Varianza Explicado") +
xlab("Ejes")
Del resultado conluciomos que que la primera componente del análisis de correspondencia explica aproximadamente el 65.3% % de la variabilidad total de los datos, la segunda componente sigue con un 30,8%, y la tercera con un 3.9 %, las dos primeras componentes son altamente significativas y abarcan la mayoría de la variabilidad en los datos (96,1%). Esto confirma la estrecha relación entre estrato y zona en el proceso de segmentación del mercado inmobiliario.