library(ggplot2)
library(ggpubr)
library(tidyverse)
library(broom)
library(factoextra)
Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(cowplot)
Attaching package: ‘cowplot’
The following object is masked from ‘package:lubridate’:
stamp
The following object is masked from ‘package:ggpubr’:
get_legend
library(cluster)
library(purrr)
library(dplyr)
Instrucciones: Encadenar un análisis de conglomerado y un Árbol de decisión (primero dividirás en grupos tu base de datos y luego escogerás uno de esos grupos específicos y crearás un árbol de decisión unicamente con los elementos de tu subgrupo)
Covid <- read.csv("/Users/ander/Downloads/archive (1)/country_wise_latest.csv")
Esta es una base de datos que muestra durante un periodo en específico la cantidad de muertes, recuperados, casos y activos de Covid-19 en cada uno de los países
La idea es que por medio de un algortimo de clustering se pueda ver la diferencia entre qué países tienen más muertes, cuáles se recuperan más rápido, cuáles tienen más casos y más activos; pueden haber países con muchas muertes, pero pocos casos y viceversa. Conocer esta información puede servir para que cada país tome estrategias de cómo están manejando la pandemia.
head (Covid)
Se eliminaron variables que se repetían. Es decir, tener el número de muertes por ejemplo junto con el número de casos, daría al final la misma información de muertes por 100 casos de la columna “Deaths…100.Cases”
# Identificar datos nulos
colSums(is.na(Covid))
Country.Region Confirmed Deaths
0 0 0
Recovered Active New.cases
0 0 0
New.deaths New.recovered Deaths...100.Cases
0 0 0
Recovered...100.Cases Deaths...100.Recovered Confirmed.last.week
0 0 0
X1.week.change X1.week...increase WHO.Region
0 0 0
En esta base de datos no hay datos nulos. De igual forma, no se eliminaron datos atipicos por el contexto de la base. Se sabe que durante el Covid habían países con un gran número de casos y muertes, mientras que otros se manetían dentro de un promedio; en este caso los datos atípicos son representativos de fenómenos interesantes
rownames(Covid) <- Covid$Country.Region
# Seleccionar variables
Covid <- select(Covid, Confirmed, Deaths, Recovered, Active, New.cases,New.deaths, New.recovered, X1.week.change,X1.week...increase )
str(Covid)
'data.frame': 187 obs. of 9 variables:
$ Confirmed : int 36263 4880 27973 907 950 86 167416 37390 15303 20558 ...
$ Deaths : int 1269 144 1163 52 41 3 3059 711 167 713 ...
$ Recovered : int 25198 2745 18837 803 242 65 72575 26665 9311 18246 ...
$ Active : int 9796 1991 7973 52 667 18 91782 10014 5825 1599 ...
$ New.cases : int 106 117 616 10 18 4 4890 73 368 86 ...
$ New.deaths : int 10 6 8 0 1 0 120 6 6 1 ...
$ New.recovered : int 18 63 749 0 0 5 2057 187 137 37 ...
$ X1.week.change : int 737 709 4282 23 201 10 36642 2409 2875 815 ...
$ X1.week...increase: num 2.07 17 18.07 2.6 26.84 ...
View (Covid)
# Estandarizar los datos
Covid_estandarizado = scale(Covid, center = TRUE, scale = TRUE)
summary(Covid_estandarizado)
Confirmed Deaths Recovered Active
Min. :-0.2299 Min. :-0.2481 Min. :-0.2662 Min. :-0.1594
1st Qu.:-0.2270 1st Qu.:-0.2467 1st Qu.:-0.2629 1st Qu.:-0.1587
Median :-0.2167 Median :-0.2404 Median :-0.2514 Median :-0.1519
Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
3rd Qu.:-0.1244 3rd Qu.:-0.1960 3rd Qu.:-0.1474 3rd Qu.:-0.1165
Max. :10.9625 Max. :10.2492 Max. : 9.4433 Max. :13.0431
New.cases New.deaths New.recovered X1.week.change
Min. :-0.2142 Min. :-0.2412 Min. :-0.2225 Min. :-0.1999
1st Qu.:-0.2135 1st Qu.:-0.2412 1st Qu.:-0.2225 1st Qu.:-0.1979
Median :-0.2056 Median :-0.2329 Median :-0.2172 Median :-0.1899
Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
3rd Qu.:-0.1407 3rd Qu.:-0.1913 3rd Qu.:-0.1698 3rd Qu.:-0.1322
Max. : 9.6514 Max. : 8.7227 Max. : 7.8124 Max. : 9.3940
X1.week...increase
Min. :-0.7118
1st Qu.:-0.4419
Median :-0.2740
Mean : 0.0000
3rd Qu.: 0.1326
Max. : 8.6787
Covid_estandarizado = as.data.frame(Covid_estandarizado)
Estado = rownames(Covid_estandarizado)
boxplot(Covid_estandarizado, main = "Boxplot Original", col = "pink", outline = TRUE)
# Número óptimo de clusters
# creamos una funcion que nos retorne la var.within para cada k
total_dentro = function(n_clusters, data, iter.max=1000, nstart=50){
media_cluster = kmeans(data,centers = n_clusters,
iter.max = iter.max,
nstart = nstart)
return(media_cluster$tot.withinss)
}
# Se aplica esta funci?n con para diferentes valores de k
totales_dentro <- map_dbl(.x = 1:15, # Se ejecuta 15 veces
.f = total_dentro,
data = Covid_estandarizado)
totales_dentro
[1] 1674.00000 556.89462 417.60728 315.39776 280.82990 255.42339 242.12631
[8] 93.72658 80.89856 77.06773 220.54711 68.59899 66.36522 65.77957
[15] 58.68442
#graficamos la varianza total
data.frame(n_clusters = 1:15, suma_cuadrados_internos = totales_dentro) %>%
ggplot(aes(x = n_clusters, y = suma_cuadrados_internos)) +
geom_line() +
geom_point() +
scale_x_continuous(breaks = 1:15) +
labs(title = "Suma total de cuadrados intra-cluster") +
theme_bw()
# Otro método
matriz_dist=get_dist(Covid_estandarizado, method = "euclidean")
fviz_nbclust(Covid_estandarizado, FUNcluster = kmeans,
method = "wss", k.max = 15,
diss = matriz_dist, nstart = 50)
Ambas gráficas nos dicen casi lo mismo. Como se puede ver, la cantidad óptima de Clusters sería 2.
# Creación de clústers
kmcluster = kmeans(Covid_estandarizado,centers=2,nstart = 50)
kmcluster
K-means clustering with 2 clusters of sizes 3, 184
Cluster means:
Confirmed Deaths Recovered Active New.cases New.deaths New.recovered
1 6.9118421 6.11216072 6.961029 5.8096531 7.028618 6.2206517 7.3425232
2 -0.1126931 -0.09965479 -0.113495 -0.0947226 -0.114597 -0.1014237 -0.1197151
X1.week.change X1.week...increase
1 7.5501865 0.196538638
2 -0.1231009 -0.003204434
Clustering vector:
Afghanistan Albania
2 2
Algeria Andorra
2 2
Angola Antigua and Barbuda
2 2
Argentina Armenia
2 2
Australia Austria
2 2
Azerbaijan Bahamas
2 2
Bahrain Bangladesh
2 2
Barbados Belarus
2 2
Belgium Belize
2 2
Benin Bhutan
2 2
Bolivia Bosnia and Herzegovina
2 2
Botswana Brazil
2 1
Brunei Bulgaria
2 2
Burkina Faso Burma
2 2
Burundi Cabo Verde
2 2
Cambodia Cameroon
2 2
Canada Central African Republic
2 2
Chad Chile
2 2
China Colombia
2 2
Comoros Congo (Brazzaville)
2 2
Congo (Kinshasa) Costa Rica
2 2
Cote d'Ivoire Croatia
2 2
Cuba Cyprus
2 2
Czechia Denmark
2 2
Djibouti Dominica
2 2
Dominican Republic Ecuador
2 2
Egypt El Salvador
2 2
Equatorial Guinea Eritrea
2 2
Estonia Eswatini
2 2
Ethiopia Fiji
2 2
Finland France
2 2
Gabon Gambia
2 2
Georgia Germany
2 2
Ghana Greece
2 2
Greenland Grenada
2 2
Guatemala Guinea
2 2
Guinea-Bissau Guyana
2 2
Haiti Holy See
2 2
Honduras Hungary
2 2
Iceland India
2 1
Indonesia Iran
2 2
Iraq Ireland
2 2
Israel Italy
2 2
Jamaica Japan
2 2
Jordan Kazakhstan
2 2
Kenya Kosovo
2 2
Kuwait Kyrgyzstan
2 2
Laos Latvia
2 2
Lebanon Lesotho
2 2
Liberia Libya
2 2
Liechtenstein Lithuania
2 2
Luxembourg Madagascar
2 2
Malawi Malaysia
2 2
Maldives Mali
2 2
Malta Mauritania
2 2
Mauritius Mexico
2 2
Moldova Monaco
2 2
Mongolia Montenegro
2 2
Morocco Mozambique
2 2
Namibia Nepal
2 2
Netherlands New Zealand
2 2
Nicaragua Niger
2 2
Nigeria North Macedonia
2 2
Norway Oman
2 2
Pakistan Panama
2 2
Papua New Guinea Paraguay
2 2
Peru Philippines
2 2
Poland Portugal
2 2
Qatar Romania
2 2
Russia Rwanda
2 2
Saint Kitts and Nevis Saint Lucia
2 2
Saint Vincent and the Grenadines San Marino
2 2
Sao Tome and Principe Saudi Arabia
2 2
Senegal Serbia
2 2
Seychelles Sierra Leone
2 2
Singapore Slovakia
2 2
Slovenia Somalia
2 2
South Africa South Korea
2 2
South Sudan Spain
2 2
Sri Lanka Sudan
2 2
Suriname Sweden
2 2
Switzerland Syria
2 2
Taiwan* Tajikistan
2 2
Tanzania Thailand
2 2
Timor-Leste Togo
2 2
Trinidad and Tobago Tunisia
2 2
Turkey US
2 1
Uganda Ukraine
2 2
United Arab Emirates United Kingdom
2 2
Uruguay Uzbekistan
2 2
Venezuela Vietnam
2 2
West Bank and Gaza Western Sahara
2 2
Yemen Zambia
2 2
Zimbabwe
2
Within cluster sum of squares by cluster:
[1] 183.6792 373.2154
(between_SS / total_SS = 66.7 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault"
Como se puede ver, la mayoría de los países se encuentran en el Clúster 2. Los que están en el Clúster 1 son aquellos países con grandes cantidades de casos, recuperados, muertes y activos.
rownames(Covid_estandarizado) = Estado
fviz_cluster(kmcluster, Covid_estandarizado, show.clust.cent = T,
ellipse.type = "euclid", star.plot = T, repel = T) +
labs(title = "Resultados clustering K-means") +
theme_bw()
Hay una gran diferencia entre el primero y segundo cluster, pero incluso dentro de los clusters existe una gran diferencia entre sus datos.
Se intentó seleccionar menor variables x, de tal forma que se dejaran solo aquellas de mayor importancia (muertes, recuperados, activos y nuevos casos) para analizar si se podía hacer un clustering más preciso
Covid2 <- read.csv("/Users/ander/Downloads/archive (1)/country_wise_latest.csv")
rownames(Covid2) <- Covid2$Country.Region
Covid2 <- select(Covid2, Deaths, Recovered, Active, New.cases )
Covid2
Covid_estandarizado2 = scale(Covid2, center = TRUE, scale = TRUE)
summary(Covid_estandarizado2)
Deaths Recovered Active New.cases
Min. :-0.2481 Min. :-0.2662 Min. :-0.1594 Min. :-0.2142
1st Qu.:-0.2467 1st Qu.:-0.2629 1st Qu.:-0.1587 1st Qu.:-0.2135
Median :-0.2404 Median :-0.2514 Median :-0.1519 Median :-0.2056
Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
3rd Qu.:-0.1960 3rd Qu.:-0.1474 3rd Qu.:-0.1165 3rd Qu.:-0.1407
Max. :10.2492 Max. : 9.4433 Max. :13.0431 Max. : 9.6514
Covid_estandarizado2 = as.data.frame(Covid_estandarizado2)
Estado2 = rownames(Covid_estandarizado2)
# Número óptimo de clusters
# creamos una funcion que nos retorne la var.within para cada k
total_dentro2 = function(n_clusters, data, iter.max=1000, nstart=50){
media_cluster2 = kmeans(data,centers = n_clusters,
iter.max = iter.max,
nstart = nstart)
return(media_cluster2$tot.withinss)
}
# Se aplica esta funci?n con para diferentes valores de k
totales_dentro2 <- map_dbl(.x = 1:15, # Se ejecuta 15 veces
.f = total_dentro2,
data = Covid_estandarizado2)
totales_dentro2
[1] 744.00000 228.83134 179.20928 64.63511 50.69943 42.88151 39.90565 38.60587
[9] 13.67365 13.45151 32.48248 37.09640 32.76864 12.13377 12.04326
#graficamos la varianza total
data.frame(n_clusters = 1:15, suma_cuadrados_internos = totales_dentro2) %>%
ggplot(aes(x = n_clusters, y = suma_cuadrados_internos)) +
geom_line() +
geom_point() +
scale_x_continuous(breaks = 1:15) +
labs(title = "Suma total de cuadrados intra-cluster") +
theme_bw()
Para este caso, la cantidad óptima de clusters fue un 4, sin embargo, desde la gráfica es posible ver cómo existen dos clusteres que marcan la diferencia, mientras que los otros dos son más parecidos entre ellos.
kmcluster2 = kmeans(Covid_estandarizado2,centers=4,nstart = 50)
kmcluster2
K-means clustering with 4 clusters of sizes 173, 1, 2, 11
Cluster means:
Deaths Recovered Active New.cases
1 -0.1952973 -0.1825444 -0.1216655 -0.1646608
2 10.2491813 6.7047934 13.0431349 9.6513880
3 4.0436504 7.0891469 2.1929122 5.7172329
4 1.4045407 0.9724635 0.3290163 0.6727702
Clustering vector:
Afghanistan Albania
1 1
Algeria Andorra
1 1
Angola Antigua and Barbuda
1 1
Argentina Armenia
1 1
Australia Austria
1 1
Azerbaijan Bahamas
1 1
Bahrain Bangladesh
1 1
Barbados Belarus
1 1
Belgium Belize
1 1
Benin Bhutan
1 1
Bolivia Bosnia and Herzegovina
1 1
Botswana Brazil
1 3
Brunei Bulgaria
1 1
Burkina Faso Burma
1 1
Burundi Cabo Verde
1 1
Cambodia Cameroon
1 1
Canada Central African Republic
1 1
Chad Chile
1 4
China Colombia
1 4
Comoros Congo (Brazzaville)
1 1
Congo (Kinshasa) Costa Rica
1 1
Cote d'Ivoire Croatia
1 1
Cuba Cyprus
1 1
Czechia Denmark
1 1
Djibouti Dominica
1 1
Dominican Republic Ecuador
1 1
Egypt El Salvador
1 1
Equatorial Guinea Eritrea
1 1
Estonia Eswatini
1 1
Ethiopia Fiji
1 1
Finland France
1 4
Gabon Gambia
1 1
Georgia Germany
1 1
Ghana Greece
1 1
Greenland Grenada
1 1
Guatemala Guinea
1 1
Guinea-Bissau Guyana
1 1
Haiti Holy See
1 1
Honduras Hungary
1 1
Iceland India
1 3
Indonesia Iran
1 4
Iraq Ireland
1 1
Israel Italy
1 4
Jamaica Japan
1 1
Jordan Kazakhstan
1 1
Kenya Kosovo
1 1
Kuwait Kyrgyzstan
1 1
Laos Latvia
1 1
Lebanon Lesotho
1 1
Liberia Libya
1 1
Liechtenstein Lithuania
1 1
Luxembourg Madagascar
1 1
Malawi Malaysia
1 1
Maldives Mali
1 1
Malta Mauritania
1 1
Mauritius Mexico
1 4
Moldova Monaco
1 1
Mongolia Montenegro
1 1
Morocco Mozambique
1 1
Namibia Nepal
1 1
Netherlands New Zealand
1 1
Nicaragua Niger
1 1
Nigeria North Macedonia
1 1
Norway Oman
1 1
Pakistan Panama
1 1
Papua New Guinea Paraguay
1 1
Peru Philippines
4 1
Poland Portugal
1 1
Qatar Romania
1 1
Russia Rwanda
4 1
Saint Kitts and Nevis Saint Lucia
1 1
Saint Vincent and the Grenadines San Marino
1 1
Sao Tome and Principe Saudi Arabia
1 1
Senegal Serbia
1 1
Seychelles Sierra Leone
1 1
Singapore Slovakia
1 1
Slovenia Somalia
1 1
South Africa South Korea
4 1
South Sudan Spain
1 4
Sri Lanka Sudan
1 1
Suriname Sweden
1 1
Switzerland Syria
1 1
Taiwan* Tajikistan
1 1
Tanzania Thailand
1 1
Timor-Leste Togo
1 1
Trinidad and Tobago Tunisia
1 1
Turkey US
1 2
Uganda Ukraine
1 1
United Arab Emirates United Kingdom
1 4
Uruguay Uzbekistan
1 1
Venezuela Vietnam
1 1
West Bank and Gaza Western Sahara
1 1
Yemen Zambia
1 1
Zimbabwe
1
Within cluster sum of squares by cluster:
[1] 11.88895 0.00000 25.35081 27.39535
(between_SS / total_SS = 91.3 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault"
Es interesante analizar cómo lo que diferencia al clúster 3 con el 4 es que, mientras que en el 3 hay más recuperados que muertes, en el 4 hay más muertes que recuperados, proporcionalmente.
rownames(Covid_estandarizado2) = Estado2
fviz_cluster(kmcluster2, Covid_estandarizado2, show.clust.cent = T,
ellipse.type = "euclid", star.plot = T, repel = T) +
labs(title = "Resultados clustering K-means") +
theme_bw()
En este gráfico se puede ver como existe la notoria diferencia entre unos de los clusters y los demás. Los países que pertenecen al cluster 1 son Estados Unidos, Brasil e India, lo que quiere decir que tienen una gran cantidad de casos, muertes y recuperados.
Un caso interesante es el del Cluster 4, donde hay más muertes que recuperados. México pertenece al tercer Clúster. Todos aquellos que vivimos la pandemia aquí en México sabemos la gran cantidad de muertes que habían sobretodo porque los hospitales estaban saturados. Las muertes en México aumentaban más de un 8% cada semana.
Para hacer el árbol de decisiones se usó el clustering de 4 clústers
library(rpart)
library(rpart.plot)
Covid_Arbol <- read.csv("/Users/ander/Downloads/archive (1)/country_wise_latest.csv")
Covid_Arbol2 <- read.csv("/Users/ander/Downloads/archive (1)/country_wise_latest.csv")
Covid_Arbol
Covid_Arbol <- select (Covid_Arbol,Country.Region, Deaths, Recovered, Active, New.cases )
Covid_Arbol <- data.frame(
muertes = Covid_Arbol$Deaths,
recuperados = Covid_Arbol$Recovered,
nuevosCasos = Covid_Arbol$New.cases,
activos = Covid_Arbol$Active,
Y = Covid_Arbol$Country.Region
)
Covid_Arbol
columnas_a_estandarizar <- c("muertes", "recuperados", "nuevosCasos", "activos")
Covid_Arbol[columnas_a_estandarizar] <- scale(Covid_Arbol[columnas_a_estandarizar])
Covid_Arbol
k <- 4 # Número de clústeres
cluster_result <- kmeans(Covid_Arbol[, c("muertes", "recuperados", "nuevosCasos", "activos" )], centers = k)
cluster_result
K-means clustering with 4 clusters of sizes 3, 5, 10, 169
Cluster means:
muertes recuperados nuevosCasos activos
1 6.1121607 6.9610291 7.02861796 5.8096531
2 2.3565160 0.5071509 0.07933679 0.3255075
3 0.4331688 1.1643258 0.69409503 0.1772467
4 -0.2038506 -0.2074680 -0.16818632 -0.1232483
Clustering vector:
[1] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 1 4 4 4 4 4 4 4 4 4 4 4 3 4 3 4 4 4 4
[43] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 2 4 4 4 3 4 4 4 4 4 4 4 4 4 4 4 4 4 1 4 3 4 4
[85] 4 2 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 2 4 4 4 4 4 4 4 4 4 4 4 4 4 4
[127] 4 4 3 4 4 4 3 4 4 4 4 4 3 4 4 4 4 4 4 3 4 4 4 4 4 4 4 4 3 4 4 2 4 4 4 4 4 4 4 4 4 4
[169] 4 4 4 4 3 1 4 4 4 2 4 4 4 4 4 4 4 4 4
Within cluster sum of squares by cluster:
[1] 139.924976 4.013774 14.826556 6.508287
(between_SS / total_SS = 77.8 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault"
# Agregar el resultado del clustering al DataFrame
Covid_Arbol$Cluster <- as.factor(cluster_result$cluster)
Covid_Arbol
Se volvió a crear la base de datos pero sin estandarizar para tener en el árbol los datos reales
Datos_Cluster <- data.frame(
muertes = Covid_Arbol2$Deaths,
recuperados = Covid_Arbol2$Recovered,
nuevosCasos = Covid_Arbol2$New.cases,
activos = Covid_Arbol2$Active,
Y = Covid_Arbol2$Country.Region
)
Datos_Cluster$Cluster <- as.factor(cluster_result$cluster)
Datos_Cluster
cluster3 = Datos_Cluster %>% filter (Cluster == 3)
cluster3
# Crear el árbol de decisiones
modelo_arbol <- rpart(Y ~ muertes + recuperados + nuevosCasos + activos + Cluster, data = cluster1, method = "class", control =rpart.control(minsplit =1,minbucket=2, cp=0))
# Visualizar el árbol de decisiones
plot(modelo_arbol)
text(modelo_arbol)
par(mfrow = c(2, 2))
Para la creación del árbol se utilizó el primer cluster. Es importante decir, que como se pudo ver en el algoritmo de clustering, la diferencia entre clusters no era tan notoria ya que cada cluster se parecía mucho entre sí, sin embargo en el cluster notorio solo habían 3 países de los 187 analizados, por lo que tampoco era viable analizarlo solo con dos clusters. Dicho esto, el comando de “rpart” en R no pudo crear un árbol automáticamente, ya que no existía la información necesaria para segmentar los datos, por lo que se usó el comando “rpart.control(minsplit =1,minbucket=2, cp=0))” para forzar a la creación del árbol, sin embargo al hacer esto se crea un árbol sobreajustado para los datos, y por ende desde ahorita se puede saber que no es apto para generar un modelo de predicción. Es por eso por lo que se decidió no hacer ningún tipo de predicción con estos datos.
La base de datos de Covid fue de utilidad para un clustering, sin embargo no para un árbol de decisiones. Algo que pudo ayudar para crear el árbol es tener más datos de cada uno de los países, ya que, aunque no hay una regla estricta, tener suficientes ejemplos en cada clase de la variable objetivo es beneficioso para que el modelo pueda aprender patrones distintivos asociados con cada clase; en esta base de datos solo habia un ejemplo de cada variable y.