Clustering dataset Covid
Jorge Arias
02/09/2020
- Parámetros
options(scipen=999)#Desactiva la notación cientÃfica- Preparación del entorno 1.1 - Cargamos las librerÃas que vamos a utilizar
#lista de paquetes que vamos a usar
paquetes <- c('data.table',#para leer y escribir datos de forma rapida
'dplyr',#para manipulación de datos
'tidyr',#para manipulación de datos
'ggplot2',#para gráficos
'TeachingDemos', #para caras de chernoff
'aplpack' #caras chernoff
)
#Crea un vector lógico con si están instalados o no
instalados <- paquetes %in% installed.packages()
#Si hay al menos uno no instalado los instala
if(sum(instalados == FALSE) > 0) {
install.packages(paquetes[!instalados])
}
lapply(paquetes,require,character.only = TRUE)## Loading required package: data.table## Loading required package: dplyr##
## Attaching package: 'dplyr'## The following objects are masked from 'package:data.table':
##
## between, first, last## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union## Loading required package: tidyr## Loading required package: ggplot2## Loading required package: TeachingDemos## Loading required package: aplpack## Warning: package 'aplpack' was built under R version 4.1.0##
## Attaching package: 'aplpack'## The following objects are masked from 'package:TeachingDemos':
##
## faces, slider## [[1]]
## [1] TRUE
##
## [[2]]
## [1] TRUE
##
## [[3]]
## [1] TRUE
##
## [[4]]
## [1] TRUE
##
## [[5]]
## [1] TRUE
##
## [[6]]
## [1] TRUE1.2 - Cargamos los datos Usamos fread de data.table para una lectura mucho mas rapida
df <- fread('agregados.csv')## Warning in fread("agregados.csv"): Discarded single-line footer: <<NOTA 4:
## En los datos de PCR+ de Cataluña se incluyen casos pendientes de distribuir
## en la serie histórica. Aragón está actualizando sus series históricas de
## hospitalizados, UCI y fallecidos.,,,,,,,>>2 - Análisis exploratorio 2.1 - Análisis exploratorio general y tipo de datos
as.data.frame(sort(names(df)))## sort(names(df))
## 1 CASOS
## 2 CCAA
## 3 Fallecidos
## 4 FECHA
## 5 Hospitalizados
## 6 PCR+
## 7 TestAc+
## 8 UCIstr(df)## Classes 'data.table' and 'data.frame': 1737 obs. of 8 variables:
## $ CCAA : chr "AN" "AR" "AS" "IB" ...
## $ FECHA : chr "20/2/2020" "20/2/2020" "20/2/2020" "20/2/2020" ...
## $ CASOS : int 0 NA NA NA NA NA NA NA NA NA ...
## $ PCR+ : int 0 0 0 1 1 0 0 0 0 0 ...
## $ TestAc+ : int NA NA NA NA NA NA NA NA NA NA ...
## $ Hospitalizados: int NA NA NA NA NA NA NA NA NA NA ...
## $ UCI : int NA NA NA NA NA NA NA NA NA NA ...
## $ Fallecidos : int NA NA NA NA NA NA NA NA NA NA ...
## - attr(*, ".internal.selfref")=<externalptr>glimpse(df)## Rows: 1,737
## Columns: 8
## $ CCAA <chr> "AN", "AR", "AS", "IB", "CN", "CB", "CM", "CL", "CT"...
## $ FECHA <chr> "20/2/2020", "20/2/2020", "20/2/2020", "20/2/2020", ...
## $ CASOS <int> 0, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N...
## $ `PCR+` <int> 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0...
## $ `TestAc+` <int> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
## $ Hospitalizados <int> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 26, NA, NA, ...
## $ UCI <int> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0, NA, NA, N...
## $ Fallecidos <int> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...Observaciones: Encontramos un dataset con 8 variables y 1737 registros, con formatos a cambiar como la fecha. Los últimos 6 registros son anotaciones que alteran los valores del dataset. (serán eliminados)
2.2 - Calidad de datos: EstadÃsticos básicos Hacemos un summary, con lapply que sale en formato de lista y se lee mejor
lapply(df,summary)## $CCAA
## Length Class Mode
## 1737 character character
##
## $FECHA
## Length Class Mode
## 1737 character character
##
## $CASOS
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0 0 0 0 0 0 1736
##
## $`PCR+`
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0 71 1752 6323 5858 67049 8
##
## $`TestAc+`
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0 114 873 1509 2023 8634 1044
##
## $Hospitalizados
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0 260 1080 4182 4397 42497 336
##
## $UCI
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.0 29.0 118.0 399.4 420.5 3617.0 306
##
## $Fallecidos
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.0 17.0 197.0 810.5 773.0 8931.0 3232.3 - Calidad de datos: Análisis de nulos
data.frame(colSums(is.na(df)))## colSums.is.na.df..
## CCAA 0
## FECHA 0
## CASOS 1736
## PCR+ 8
## TestAc+ 1044
## Hospitalizados 336
## UCI 306
## Fallecidos 323Observaciones: Encontramos un alto numero de núlos, los convertiremos a ceros.
2.4 - Acciones resultado del analisis de calidad de datos y exploratorio
Vamos a hacer lo siguiente: - eliminar las variables sin información (últimos 6 registros) - Convertir nulos a ceros - transformar a Date las variables de fecha
df <- df[1:1729, ]
df[is.na(df)] <- 0
df$FECHA <- as.Date(df$FECHA, format="%d/%m/%Y")Hacemos nuevamente un Lapply para conocer de forma f;acil el rango de fechas del dataset
lapply(df,summary)## $CCAA
## Length Class Mode
## 1729 character character
##
## $FECHA
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## "2020-02-20" "2020-03-13" "2020-04-05" "2020-04-05" "2020-04-28" "2020-05-20"
##
## $CASOS
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0 0 0 0 0 0
##
## $`PCR+`
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0 71 1752 6323 5858 67049
##
## $`TestAc+`
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 0.0 0.0 604.8 475.0 8634.0
##
## $Hospitalizados
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0 11 771 3389 2648 42497
##
## $UCI
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 3.0 91.0 330.5 291.0 3617.0
##
## $Fallecidos
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 1.0 115.0 662.9 503.0 8931.0Ahora podemos comprobar que los datos recogidos son desde el 20-02-2020 al 20-05-2020
- Transformación de datos:
3.1. - Creación variable caso confirmados: Se usará la variable CASOS y se actualizará con la suma de PCR y TestAc+
df$CASOS <- (df$`PCR+` + df$`TestAc+`)3.2. - Agrupación de datos por CCAAs para obtener casos totales
#los nombres de PCR+ y TestAC+ dan problema si no sustituyo el sÃmbolo +, asà que renombramos antes:
names(df)[4]<-"PCRs"
names(df)[5]<-"TestACs"
df_CCAA<-group_by(df, CCAA)
df_CCAA<-summarize(df_CCAA, count=n(),
CONFIRMADOS=sum(CASOS, na.rm=T),
PCRs=sum(PCRs, na.rm=T),
TestAC=sum(TestACs, na.rm=T),
Hospitalizados=sum(Hospitalizados, na.rm=T),
UCIs=sum(UCI, na.rm=T),
Fallecidos=sum(Fallecidos,na.rm = T))Comprobamos resultados, ordenando salida de menor a mayor casos confirmados
df_CCAA %>%
arrange(CONFIRMADOS)## # A tibble: 19 x 8
## CCAA count CONFIRMADOS PCRs TestAC Hospitalizados UCIs Fallecidos
## <chr> <int> <dbl> <int> <dbl> <dbl> <dbl> <dbl>
## 1 ML 91 6319 5954 365 2393 174 106
## 2 CE 91 6739 5212 1527 509 215 193
## 3 IB 91 99690 96940 2750 51664 8315 8409
## 4 MC 91 101495 80381 21114 32490 5614 6051
## 5 CN 91 115311 115311 0 46386 8953 6562
## 6 CB 91 120897 108939 11958 49991 4155 8331
## 7 AS 91 144062 120402 23660 53122 6277 11458
## 8 EX 91 176636 147511 29125 73215 5916 20791
## 9 RI 91 243087 199022 44065 69281 4594 14809
## 10 AR 91 287873 252213 35660 121476 13162 33060
## 11 NC 91 303716 244856 58860 100666 7334 19779
## 12 GA 91 471562 440226 31336 137403 16382 21913
## 13 VC 91 609998 531901 78097 272179 36069 57242
## 14 AN 91 682382 604059 78323 297285 35354 54237
## 15 PV 91 765310 648620 116690 338296 28028 58808
## 16 CL 91 948423 808285 140138 389478 27191 81088
## 17 CM 91 975754 791554 184200 436771 32533 113396
## 18 CT 91 2394239 2352187 42052 1267248 135069 225775
## 19 MD 91 3524268 3378452 145816 2119014 196181 4041083.3. - Salvamos dataset limpio:
saveRDS(df_CCAA,'df_CCAA.rds')- Comprobamos las caras de Chernoff
CARAS<-TeachingDemos::faces(df_CCAA[,3:8])
Ahora las observaremos con mas detalles y color
library(aplpack)
CCAAfaces <- faces(df_CCAA[,3:8], labels = row.names(df_CCAA), face.type =5)
## effect of variables:
## modified item Var
## "height of face " "CONFIRMADOS"
## "width of face " "PCRs"
## "structure of face" "TestAC"
## "height of mouth " "Hospitalizados"
## "width of mouth " "UCIs"
## "smiling " "Fallecidos"
## "height of eyes " "CONFIRMADOS"
## "width of eyes " "PCRs"
## "height of hair " "TestAC"
## "width of hair " "Hospitalizados"
## "style of hair " "UCIs"
## "height of nose " "Fallecidos"
## "width of nose " "CONFIRMADOS"
## "width of ear " "PCRs"
## "height of ear " "TestAC"row.names(df_CCAA) <- df_CCAA$CCAA## Warning: Setting row names on a tibble is deprecated.- Clustering
5.1. - Clustering con MST
porCCAAs <- hclust(dist(df_CCAA,method="euclidian"),method="single")## Warning in dist(df_CCAA, method = "euclidian"): NAs introducidos por coerciónplot(porCCAAs)
plot(hclust(dist(df_CCAA,method="euclidian"),method="single"))## Warning in dist(df_CCAA, method = "euclidian"): NAs introducidos por coerción
5.2. - Clustering con KMEANS
# Trabajamos con la base de datos df_CCAA
# Primero vamos a escalar los datos para equilibrar los calculos
datos <- as.data.frame(scale(df_CCAA[, 3:8]))
# asignamos una semilla para garantizar la aleatoriedad de la primera asignacion
set.seed(123)
# Creamos los clusteres mediante kmeans
datos.kmeans <- kmeans(datos, centers = 6)
# k=centers
# observamos los resultados y la calidad de los mismos
datos.kmeans## K-means clustering with 6 clusters of sizes 5, 2, 3, 4, 3, 2
##
## Cluster means:
## CONFIRMADOS PCRs TestAC Hospitalizados UCIs Fallecidos
## 1 -0.62605539 -0.58894706 -0.9393934 -0.52917407 -0.511723209 -0.56036199
## 2 2.60067972 2.65015340 0.7064742 2.63427658 2.697071186 2.56609353
## 3 -0.54683513 -0.53151409 -0.5522747 -0.48588916 -0.480418435 -0.47926853
## 4 -0.33931578 -0.33710979 -0.2281061 -0.38266128 -0.392224109 -0.38228065
## 5 0.06196506 0.02255604 0.6538485 -0.01098544 0.061097514 -0.03587378
## 6 0.37039541 0.25987091 1.9458609 0.19929303 -0.004333563 0.37208621
##
## Clustering vector:
## [1] 5 4 3 1 1 6 6 1 2 3 4 1 3 2 1 4 5 4 5
##
## Within cluster sum of squares by cluster:
## [1] 0.11164268 6.94477816 0.03203429 0.29062339 0.37487819 0.38361500
## (between_SS / total_SS = 92.5 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"str(datos.kmeans)## List of 9
## $ cluster : int [1:19] 5 4 3 1 1 6 6 1 2 3 ...
## $ centers : num [1:6, 1:6] -0.626 2.601 -0.547 -0.339 0.062 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:6] "1" "2" "3" "4" ...
## .. ..$ : chr [1:6] "CONFIRMADOS" "PCRs" "TestAC" "Hospitalizados" ...
## $ totss : num 108
## $ withinss : num [1:6] 0.112 6.945 0.032 0.291 0.375 ...
## $ tot.withinss: num 8.14
## $ betweenss : num 99.9
## $ size : int [1:6] 5 2 3 4 3 2
## $ iter : int 2
## $ ifault : int 0
## - attr(*, "class")= chr "kmeans"5.2.1. - Metricas
#Inercia ENTRE grupos: mayor es mejor
datos.kmeans$betweenss## [1] 99.86243#Inercia INTRA grupos: menor es mejor
datos.kmeans$withinss## [1] 0.11164268 6.94477816 0.03203429 0.29062339 0.37487819 0.38361500#Inercia total INTRA grupos: menor es mejor
datos.kmeans$tot.withinss## [1] 8.137572#Representamos los resultados
comunidades<-df_CCAA$CCAA
grupo<-datos.kmeans$cluster
datosc<-data.frame(comunidades, grupo)ggplot(datosc)+
geom_point(mapping=aes(x=grupo, y=comunidades),color=grupo, size=5)
ggplot(datosc)+
geom_point(mapping=aes(x=comunidades, y=grupo),color=grupo)