library(rio)
setwd("~/Documents/Estadística 2 ")
data= import("datapre2.xlsx")
## New names:
## • `` -> `...1`
str(data)
## 'data.frame': 196 obs. of 50 variables:
## $ ...1 : num 1 2 3 4 5 6 7 8 9 10 ...
## $ key : chr "AMAZONAS+BAGUA" "AMAZONAS+BONGARA" "AMAZONAS+CHACHAPOYAS" "AMAZONAS+CONDORCANQUI" ...
## $ Código : num 102 103 101 104 105 106 107 202 203 204 ...
## $ pared1_Ladrillo : num 4633 1602 3782 291 430 ...
## $ pared2_Piedra : num 46 9 22 7 7 7 35 1 0 3 ...
## $ pared3_Adobe : num 6639 2729 5881 672 5217 ...
## $ pared4_Tapia : num 222 240 2476 8 6052 ...
## $ pared5_Quincha : num 2518 157 309 386 346 ...
## $ pared6_Piedra : num 127 36 168 7 54 28 518 65 7 6 ...
## $ pared7_Madera : num 4484 2505 1270 8145 606 ...
## $ pared8_Triplay : num 851 30 91 200 45 24 210 18 0 1 ...
## $ pared9_Otro : num 0 0 0 0 0 0 0 0 0 0 ...
## $ pared10_Total : num 19520 7308 13999 9716 12757 ...
## $ techo1_Concreto : num 2187 692 2262 56 187 ...
## $ techo2_Madera : num 294 75 160 188 43 48 340 57 12 8 ...
## $ techo3_Tejas : num 179 382 3393 177 3071 ...
## $ techo4_Planchas : num 13186 6084 8005 2036 9343 ...
## $ techo5_Caña : num 160 38 50 15 26 15 196 10 8 5 ...
## $ techo6_Triplay : num 106 5 14 10 12 5 62 17 4 3 ...
## $ techo7_Paja : num 3408 32 115 7234 75 ...
## $ techo8_Otro : num 0 0 0 0 0 0 0 0 0 0 ...
## $ techo9_Total : num 19520 7308 13999 9716 12757 ...
## $ piso1_Parquet : num 6 5 23 2 4 3 20 0 0 5 ...
## $ piso2_Láminas : num 19 2 36 0 0 4 32 0 0 1 ...
## $ piso3_Losetas : num 647 165 1077 20 46 ...
## $ piso4_Madera : num 157 132 240 1523 295 ...
## $ piso5_Cemento : num 7121 2917 6189 943 1911 ...
## $ piso6_Tierra : num 11569 4087 6434 7228 10501 ...
## $ piso7_Otro : num 1 0 0 0 0 0 0 0 0 0 ...
## $ piso8_Total : num 19520 7308 13999 9716 12757 ...
## $ agua1_Red : num 9429 4569 10647 1307 7172 ...
## $ agua2_Red_fueraVivienda: num 4392 1497 1619 867 3097 ...
## $ agua3_Pilón : num 793 215 184 1003 1112 ...
## $ agua4_Camión : num 59 0 49 2 0 0 117 0 0 0 ...
## $ agua5_Pozo : num 1792 474 876 2564 819 ...
## $ agua6_Manantial : num 270 67 92 431 132 211 471 121 61 27 ...
## $ agua7_Río : num 2648 388 488 3428 369 ...
## $ agua8_Otro : num 56 61 24 80 9 29 104 2 1 6 ...
## $ agua9_Vecino : num 81 37 20 34 47 8 177 9 4 6 ...
## $ agua10_Total : num 19520 7308 13999 9716 12757 ...
## $ elec1_Sí : num 13204 6025 12248 1792 10886 ...
## $ elec2_No : num 6316 1283 1751 7924 1871 ...
## $ elec3_Total : num 19520 7308 13999 9716 12757 ...
## $ departamento : chr "AMAZONAS" "AMAZONAS" "AMAZONAS" "AMAZONAS" ...
## $ provincia : chr "BAGUA" "BONGARA" "CHACHAPOYAS" "CONDORCANQUI" ...
## $ Castillo : num 25629 8374 15671 13154 12606 ...
## $ Keiko : num 10770 5209 10473 1446 7840 ...
## $ ganaCastillo : num 1 1 1 1 1 1 1 1 1 1 ...
## $ covidPositivos : num 8126 389 2174 3481 456 ...
## $ covidFallecidos : num 462 72 281 111 88 60 336 26 31 21 ...
library(readxl)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyr)
library(cluster)
library(factoextra)
## Loading required package: ggplot2
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
head(data)
## ...1 key Código pared1_Ladrillo pared2_Piedra
## 1 1 AMAZONAS+BAGUA 102 4633 46
## 2 2 AMAZONAS+BONGARA 103 1602 9
## 3 3 AMAZONAS+CHACHAPOYAS 101 3782 22
## 4 4 AMAZONAS+CONDORCANQUI 104 291 7
## 5 5 AMAZONAS+LUYA 105 430 7
## 6 6 AMAZONAS+RODRIGUEZ DE MENDOZA 106 1546 7
## pared3_Adobe pared4_Tapia pared5_Quincha pared6_Piedra pared7_Madera
## 1 6639 222 2518 127 4484
## 2 2729 240 157 36 2505
## 3 5881 2476 309 168 1270
## 4 672 8 386 7 8145
## 5 5217 6052 346 54 606
## 6 2778 155 720 28 3646
## pared8_Triplay pared9_Otro pared10_Total techo1_Concreto techo2_Madera
## 1 851 0 19520 2187 294
## 2 30 0 7308 692 75
## 3 91 0 13999 2262 160
## 4 200 0 9716 56 188
## 5 45 0 12757 187 43
## 6 24 0 8904 480 48
## techo3_Tejas techo4_Planchas techo5_Caña techo6_Triplay techo7_Paja
## 1 179 13186 160 106 3408
## 2 382 6084 38 5 32
## 3 3393 8005 50 14 115
## 4 177 2036 15 10 7234
## 5 3071 9343 26 12 75
## 6 2810 5495 15 5 51
## techo8_Otro techo9_Total piso1_Parquet piso2_Láminas piso3_Losetas
## 1 0 19520 6 19 647
## 2 0 7308 5 2 165
## 3 0 13999 23 36 1077
## 4 0 9716 2 0 20
## 5 0 12757 4 0 46
## 6 0 8904 3 4 264
## piso4_Madera piso5_Cemento piso6_Tierra piso7_Otro piso8_Total agua1_Red
## 1 157 7121 11569 1 19520 9429
## 2 132 2917 4087 0 7308 4569
## 3 240 6189 6434 0 13999 10647
## 4 1523 943 7228 0 9716 1307
## 5 295 1911 10501 0 12757 7172
## 6 176 2974 5483 0 8904 5256
## agua2_Red_fueraVivienda agua3_Pilón agua4_Camión agua5_Pozo agua6_Manantial
## 1 4392 793 59 1792 270
## 2 1497 215 0 474 67
## 3 1619 184 49 876 92
## 4 867 1003 2 2564 431
## 5 3097 1112 0 819 132
## 6 1278 154 0 1020 211
## agua7_Río agua8_Otro agua9_Vecino agua10_Total elec1_Sí elec2_No elec3_Total
## 1 2648 56 81 19520 13204 6316 19520
## 2 388 61 37 7308 6025 1283 7308
## 3 488 24 20 13999 12248 1751 13999
## 4 3428 80 34 9716 1792 7924 9716
## 5 369 9 47 12757 10886 1871 12757
## 6 948 29 8 8904 6895 2009 8904
## departamento provincia Castillo Keiko ganaCastillo covidPositivos
## 1 AMAZONAS BAGUA 25629 10770 1 8126
## 2 AMAZONAS BONGARA 8374 5209 1 389
## 3 AMAZONAS CHACHAPOYAS 15671 10473 1 2174
## 4 AMAZONAS CONDORCANQUI 13154 1446 1 3481
## 5 AMAZONAS LUYA 12606 7840 1 456
## 6 AMAZONAS RODRÍGUEZ DE MENDOZA 7967 5491 1 110
## covidFallecidos
## 1 462
## 2 72
## 3 281
## 4 111
## 5 88
## 6 60
# Filtrar para excluir la provincia de Lima
data_filtered <- data %>%
filter(provincia != "Lima")
# Seleccionar las variables de interés
data_selected <- data_filtered %>%
select(agua1_Red, Keiko, covidFallecidos)
# Normalizar las variables
data_normalized <- as.data.frame(scale(data_selected))
# Aplicar K-Means Clustering
set.seed(123) # Para reproducibilidad
kmeans_result <- kmeans(data_normalized, centers = 4) # Cambia "centers" según el número de grupos deseado
# Agregar resultados al dataframe original
data_filtered$Cluster <- kmeans_result$cluster
# Visualizar los resultados
fviz_cluster(kmeans_result, data = data_normalized, geom = "point",
ellipse.type = "convex", ggtheme = theme_minimal())
# Explorar los datos agrupados
grouped_data <- data_filtered %>%
group_by(Cluster) %>%
summarise(across(everything(), mean))
## Warning: There were 12 warnings in `summarise()`.
## The first warning was:
## ℹ In argument: `across(everything(), mean)`.
## ℹ In group 1: `Cluster = 1`.
## Caused by warning in `mean.default()`:
## ! argument is not numeric or logical: returning NA
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 11 remaining warnings.
print(grouped_data)
## # A tibble: 4 × 51
## Cluster ...1 key Código pared1_Ladrillo pared2_Piedra pared3_Adobe
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 135 NA 1501 1850434 10905 51710
## 2 2 102. NA 1161 165420. 3817 34713.
## 3 3 124. NA 1460. 40269. 206. 17011.
## 4 4 94.4 NA 1096. 3721. 48.7 6917.
## # ℹ 44 more variables: pared4_Tapia <dbl>, pared5_Quincha <dbl>,
## # pared6_Piedra <dbl>, pared7_Madera <dbl>, pared8_Triplay <dbl>,
## # pared9_Otro <dbl>, pared10_Total <dbl>, techo1_Concreto <dbl>,
## # techo2_Madera <dbl>, techo3_Tejas <dbl>, techo4_Planchas <dbl>,
## # techo5_Caña <dbl>, techo6_Triplay <dbl>, techo7_Paja <dbl>,
## # techo8_Otro <dbl>, techo9_Total <dbl>, piso1_Parquet <dbl>,
## # piso2_Láminas <dbl>, piso3_Losetas <dbl>, piso4_Madera <dbl>, …
library(cluster)
library(factoextra)
hclust_agglomerative <- hclust(dist(data_normalized), method = "ward.D2")
clusters_agglo <- cutree(hclust_agglomerative, k = 4)
hclust_divisive <- diana(dist(data_normalized))
clusters_divisive <- cutree(as.hclust(hclust_divisive), k = 4)
kmeans_result <- kmeans(data_normalized, centers = 4)
clusters_kmeans <- kmeans_result$cluster
sil_agglo <- silhouette(clusters_agglo, dist(data_normalized))
sil_divisive <- silhouette(clusters_divisive, dist(data_normalized))
sil_kmeans <- silhouette(clusters_kmeans, dist(data_normalized))
mean(sil_agglo[, 3]) # Aglomerativo
## [1] 0.7400686
mean(sil_divisive[, 3]) # Divisivo
## [1] 0.7703502
mean(sil_kmeans[, 3]) # K-Means
## [1] 0.7589749
fviz_silhouette(sil_agglo) + ggtitle("Silueta - Jerárquico Aglomerativo")
## cluster size ave.sil.width
## 1 1 160 0.84
## 2 2 30 0.26
## 3 3 5 0.62
## 4 4 1 0.00
fviz_silhouette(sil_divisive) + ggtitle("Silueta - Jerárquico Divisivo")
## cluster size ave.sil.width
## 1 1 172 0.82
## 2 2 18 0.41
## 3 3 5 0.58
## 4 4 1 0.00
fviz_silhouette(sil_kmeans) + ggtitle("Silueta - K-Means")
## cluster size ave.sil.width
## 1 1 165 0.83
## 2 2 1 0.00
## 3 3 25 0.33
## 4 4 5 0.60
