Covid-19- worldometers-clusters

library(tidyverse)
library(readr)
library(scales)
library(ggthemes)
library(reshape2)

library(ggplot2)  
library(factoextra)
library(psych)
library(cluster)
library(NbClust)
library(readxl)
library(robustX)
library(dendextend)
library(corrplot)

library(RColorBrewer)
#display.brewer.all()

library(readxl)
covidcluster <- read_excel("covidcluster_worldometers.xlsx", sheet="worldometers", col_types = c("text", 
        "numeric", "numeric", "numeric", 
        "numeric", "numeric", "numeric", 
        "numeric", "numeric", "numeric")) 
covidcluster

Preparação dos dados

dados1 <- as.data.frame(covidcluster)
#head(dados)
#is(dados)
# só países com mais de 100 mortes

dados1 <- dados1 %>% filter(total_deaths>=300)

#nomes dos países
nomes <- dados1$country
dados1 <- dados1[,-1]
row.names(dados1) <- c(nomes)
head(dados1)

#selecionar variáveis
dados1 <-dados1[,-c(3,5,8,9)]

# retirar NA
dados <- na.omit(dados1)  #df2 <- df[complete.cases(df),]
#describe(dados)
#padronizar dados
dados <- scale(dados)
head(dados)

       total_cases total_deaths active_cases totcases_1Mpop deaths_1Mpop
USA      5.6668836    4.9070492   5.80643473      1.6302248    0.5748437
Spain    0.7376955    1.2925839   0.02186621      2.6339134    2.3152996
UK       0.5339503    1.6424269   0.76051366      1.0457738    1.7797747
Italy    0.5334440    1.5558685   0.14982946      1.3030629    1.9725636
Russia   0.4914138   -0.3587768   0.68088200     -0.1244343   -0.6622188
France   0.3443794    1.2764753   0.21431479      0.7068575    1.4316835

# Compute dissimilarity matrix
d <- dist(dados, method = "euclidean")
#d <-d^2 # dist quad Euclidiana

# O pacote vegan apresenta muitas opções de distâncias para dados não métricos; inclusive a quadrática euclidiana. 
# library(vegan)
# ?designdist
# d <- designdist(dados, method = "A+B-2*J", terms = c("quadratic"))
# d

# Hierarchical clustering using complete method
hc <- hclust(d, method = "ward.D2" )

plot(hc,cex=0.6,labels=rownames(dados), hang = -1) # display dendogram

# ou
# plot(hc,cex=0.6,labels=rownames(dados)) # display dendogram

# outliers

#outliers <- BACON(dados)
# outliers


# há obs discrepante?
#table(outliers$subset)
#rownames(dados)[outliers$subset== F]

k=4
# Cut tree into 4 groups
grupos <- cutree(hc, k)
#grupos

#rownames(dados)[grupos == 1]
#rownames(dados)[grupos == 2]
#rownames(dados)[grupos == 3]
#rownames(dados)[grupos == 4]
#rownames(dados)[grupos == 5]

# Algoritmo Hierárquico - Usando o pacote factoextra

# ?hcut
# este pacote não tem dist quad Euclidiana

#res <- hcut(dados, k , stand = TRUE, 
#            hc_func = "hclust", 
#            hc_method = "ward.D2", 
#            hc_metric = "euclidean")

#fviz_dend(res, rect = T, cex = 0.7, horiz = F, palette = brewer.pal(n=k,name="Dark2"))
#fviz_cluster(res,repel = T, kcolors=brewer.pal(n=k,name="Dark2")) + theme_bw() 
#fviz_silhouette(res)+theme_bw()+ theme(axis.text.x = element_text(angle=90)) 

Algoritmo Hierárquico

dados_dist <- daisy(dados, metric = "euclidean")

res.hc <- hclust(d = dados_dist, method = "ward.D2")
#Ward’s minimum variance method: It minimizes the total within-cluster variance. At each step the pair of clusters with minimum between-cluster distance are merged.

#fviz_dend(res.hc, cex = 0.5)

# Cut tree into k groups
#k=7
grp <- cutree(res.hc, k )
#grp
#table(grp)


#colors() 

# Cut in k groups and color by groups
fviz_dend(res.hc, k , # Cut in k groups
cex = 0.5, # label size
k_colors = brewer.pal(n=k,name="Dark2"),
color_labels_by_k = TRUE, # color labels by groups
rect = TRUE # Add rectangle around groups
, ggtheme = theme_bw(18))

#  como fazer com as dist?  só lançar data como matriz de distâncias
fviz_cluster(list(data = dados_dist, cluster = grp),
palette = brewer.pal(n=k,name="Dark2"),
#ellipse.type = "confidence", # Concentration ellipse
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = T, ggtheme = theme_bw(18), labelsize=18)

NA
NA
NA

# It’s possible to compare simultaneously multiple dendrograms.
# A chaining operator %>% (available in dendextend) is used to run multiple function at the same time. It’s useful for simplifying the code:

# Create multiple dendrograms by chaining
dend1 <- dados %>% dist("euclidean") %>% hclust("complete") %>% as.dendrogram
dend2 <- dados %>% dist("euclidean") %>% hclust("single") %>% as.dendrogram
dend3 <- dados %>% dist("euclidean") %>% hclust("average") %>% as.dendrogram
dend4 <- dados %>% dist("euclidean") %>% hclust("centroid") %>% as.dendrogram
dend5 <- dados %>% dist("euclidean") %>% hclust("ward.D2") %>% as.dendrogram

#?hclust
# Compute correlation matrix
dend_list <- dendlist("Complete" = dend1, "Single" = dend2,
                      "Average" = dend3, "Centroid" = dend4,
                      "ward"= dend5)

#Computes the cophenetic distances for a hierarchical clustering.
# ?cor.dendlist

cors <- cor.dendlist(dend_list)

# Print correlation matrix
round(cors, 2)

         Complete Single Average Centroid ward
Complete     1.00   0.83    0.92     0.88 0.88
Single       0.83   1.00    0.96     0.99 0.59
Average      0.92   0.96    1.00     0.99 0.74
Centroid     0.88   0.99    0.99     1.00 0.66
ward         0.88   0.59    0.74     0.66 1.00

# Visualize the correlation matrix using corrplot package
corrplot(cors, "number", "lower")

corrplot(cors, "pie", "lower")

algoritmo não hierárquico PAM

# Calculate silhouette width for many k using PAM
#gower_dist - matriz com as distâncias
sil_width <- c(NA)
for(i in 2:8){
  pam_fit <- pam(dados_dist,
                 diss = TRUE,
                 k = i)
  sil_width[i] <- pam_fit$silinfo$avg.width
}
# Plot sihouette width (higher is better)

plot(1:8, sil_width,
     xlab = "Number of clusters",
     ylab = "Silhouette Width")
lines(1:8, sil_width)

library(fpc)

package 㤼㸱fpc㤼㸲 was built under R version 3.6.3

pamk(dados_dist, diss=T,krange=2:7,criterion="asw", usepam=TRUE)

$pamobject
Medoids:
     ID            
[1,] "4"  "Italy"  
[2,] "28" "Romania"
Clustering vector:
               USA              Spain                 UK              Italy             Russia             France            Germany 
                 1                  1                  1                  1                  2                  1                  2 
            Brazil             Turkey               Iran              China             Canada               Peru              India 
                 2                  2                  2                  2                  2                  2                  2 
           Belgium        Netherlands             Mexico           Pakistan        Switzerland            Ecuador              Chile 
                 1                  2                  2                  2                  2                  2                  2 
          Portugal             Sweden            Ireland             Poland            Austria              Japan            Romania 
                 2                  2                  1                  2                  2                  2                  2 
           Ukraine          Indonesia        Philippines           Colombia            Denmark Dominican Republic              Egypt 
                 2                  2                  2                  2                  2                  2                  2 
         Argentina            Algeria            Hungary 
                 2                  2                  2 
Objective function:
   build     swap 
1.037593 1.037593 

Available components:
[1] "medoids"    "id.med"     "clustering" "objective"  "isolation"  "clusinfo"   "silinfo"    "diss"       "call"      

$nc
[1] 2

$crit
[1] 0.0000000 0.6397794 0.6267032 0.4721142 0.4919354 0.4902504 0.4559666

Cluster plot PAM

pam_fit <- pam(dados_dist, diss = TRUE, k)

#dados[pam_fit$medoids, ]
#print(pam_fit)

grp = pam_fit$clustering

#  como fazer com as dist?  só lançar data como matriz de distâncias

fviz_cluster(list(data = dados_dist, cluster = grp),
palette = brewer.pal(n=k,name="Dark2"),
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = T, ggtheme = theme_bw(16))

# Descrição dos grupos pelo PAM

#pam_results <- dados %>%
#  dplyr::mutate(cluster = pam_fit$clustering) %>%
#  group_by(cluster) %>%
#  do(the_summary = summary(.))

#pam_results$the_summary