Sintomas COVID-19: Analisis de Frecuencia

library(tidyverse)
library(magrittr)
library(ggplot2)
library(arules)
library(splitstackshape)

crudos <- read_csv("Kudos to DXY.cn Last update_ 03_13_2020,  8_00 PM (EST).csv", col_types = cols())
glimpse(crudos, width = 80)

Observations: 3,397
Variables: 22
$ id                     <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 1...
$ case_in_country        <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
$ `reporting date`       <chr> "1/20/2020", "1/20/2020", "1/21/2020", "1/21...
$ location               <chr> "Shenzhen, Guangdong", "Shanghai", "Zhejiang...
$ country                <chr> "China", "China", "China", "China", "China",...
$ gender                 <chr> "male", "female", "male", "female", "male", ...
$ age                    <dbl> 66, 56, 46, 60, 58, 44, 34, 37, 39, 56, 18, ...
$ symptom_onset          <chr> "1/3/2020", "1/15/2020", "1/4/2020", NA, NA,...
$ If_onset_approximated  <dbl> 0, 0, 0, NA, NA, 0, 0, 0, 0, 0, 0, 0, NA, 0,...
$ hosp_visit_date        <chr> "1/11/2020", "1/15/2020", "1/17/2020", "1/19...
$ international_traveler <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
$ domestic_traveler      <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
$ exposure_start         <chr> "12/29/2019", NA, NA, NA, NA, NA, NA, "1/10/...
$ exposure_end           <chr> "1/4/2020", "1/12/2020", "1/3/2020", NA, NA,...
$ traveler               <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
$ `visiting Wuhan`       <dbl> 1, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0,...
$ `from Wuhan`           <dbl> 0, 1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1,...
$ death                  <chr> "0", "0", "0", "0", "0", "0", "0", "0", "0",...
$ recovered              <chr> "0", "0", "0", "0", "0", "0", "0", "0", "0",...
$ symptom                <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
$ source                 <chr> "Shenzhen Municipal Health Commission", "Off...
$ link                   <chr> "http://wjw.sz.gov.cn/wzx/202001/t20200120_1...

# Registros de sintomas a variables dummy.
datos_snulos <- crudos %>%
  drop_na(symptom) %>%
  filter(symptom != "")
  
datos_snulos$symptom %<>% gsub("\\s+", "", .) # trim entre palabras.
split <- datos_snulos$symptom %>% strsplit(",") # separa por comas en cada celda (lista de listas).
niveles <- split %>%
  unlist() %>% # lista plana.
  unique() # valores unicos de sintomas.
dummys <- split %>% lapply(function(x) table(factor(x, levels = niveles))) # dummys x registro.
datos <- data.frame(do.call(rbind, dummys))
tbl_df(datos)

# Homologamos sintomas.
sintomas <- datos %>% 
  mutate(fever = feaver + fever + feve. + highfever + mildfever) %>% # Suma de columnas iguales.
  select(-c(feaver, feve., highfever, mildfever)) %>% # Descartamos las ya sumadas.
  
  mutate(chestpain = chestdiscomfort + chestpain) %>%
  select(-c(chestdiscomfort)) %>% 
  
  mutate(chills = chill + chills) %>%
  select(-c(chill)) %>% 
  
  mutate(cough = cough + coughing + mildcough) %>%
  select(-c(coughing, mildcough)) %>% 
  
  mutate(
    difficultybreathing = difficultinbreathing + difficultybreathing + shortnessofbreath + breathlessness + respiratorydistress + dyspnea
  ) %>% select(
    -c(
      difficultinbreathing, shortnessofbreath,
      breathlessness, respiratorydistress, dyspnea
    )
  ) %>% 
  mutate(headache = headache + heavyhead) %>%
  select(-c(heavyhead)) %>%
  
  mutate(coughwithsputum = coughwithsputum + sputum) %>%
  select(-c(sputum)) %>%
  
  mutate(runnynose = runnynose + nasaldischarge) %>%
  select(-c(nasaldischarge)) %>%
  
  mutate(malaise = malaise + generalmalaise + physicaldiscomfort + wholebodypain + sorebody + myalgias, tired) %>%
  select(-c(generalmalaise, physicaldiscomfort, wholebodypain, sorebody, myalgias, tired)) %>%
  
  mutate(musclepain = musclepain + myalgia + musclecramps + muscleaches + achingmuscles + backpain, abdominalpain) %>%
  select(-c(myalgia, musclecramps, muscleaches, achingmuscles, backpain, abdominalpain)) %>%
  
  mutate(sorethroat = sorethroat + throatpain + throatdiscomfort + itchythroat) %>%
  select(-c(throatpain, throatdiscomfort, itchythroat)) %>%
  
  mutate(jointpain = jointpain + jointmusclepain) %>%
  select(-c(jointmusclepain)) %>%
  
  mutate(nausea = nausea + vomiting) %>%
  select(-c(vomiting)) %>%
  
  select(-c(hospitalization, flu, flusymptoms, cold, pneumonia, difficultywalking))
  sintomas <- cbind(datos_snulos$id, sintomas)
  names(sintomas)[1] <- "id"
  sintomas_id <- sintomas
  write_csv(sintomas, file.path("D:/dbs/datos/covid", "sintomas_covid.csv"))
  rownames(sintomas) <- sintomas[, 1]
  sintomas %<>% select(-id)
  sintomas_casos <- rowSums(sintomas)
  casos_sin_sintomas <- which(sintomas_casos == 0)
  sintomas %<>% slice(-c(casos_sin_sintomas))

# Calculamos proporciones.
sintomas[sintomas > 0] <- 1
sumas_df <- as.data.frame(colSums(sintomas) / nrow(sintomas)) %>%
  rownames_to_column("symptom")
names(sumas_df) <- c("sintomas", "proporcion")
n_registros <- nrow(sintomas)
sub_titulo <- paste(n_registros, "Casos Registrados (Wuhan)")
ggplot(data = sumas_df, aes(x = reorder(sintomas, proporcion), y = proporcion)) +
  geom_bar(stat="identity") +
  labs(x = "", y = "Proporcion", title = "Frecuencia de Sintomas COVID-19", subtitle = sub_titulo) +
  coord_flip() +
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5))

# Seleccion de variables y formato para Apriori.
top_n_sintomas <- 20
top_sintomas_nombres <- sumas_df %>%
  arrange(desc(proporcion)) %>%
  head(top_n_sintomas)
top_sintomas <- sintomas %>% select(top_sintomas_nombres$sintoma)
datos_transac <- as(
  data.frame(lapply(top_sintomas, as.character), stringsAsFactors=T),
  "transactions"
)
# Solo queremos combinaciones donde los sintomas esten presentes.
valores <- c()
for(col in names(top_sintomas)) {
  condicion <- paste(col, "=1", sep = "")
  valores <- c(valores, condicion)
}

reglas <- apriori(
  datos_transac,
  parameter = list(supp = 0.025, target = "frequent itemsets", minlen = 2, maxlen = 4),
  appearance = list(items = valores)
)

Apriori

Parameter specification:

Algorithmic control:

Absolute minimum support count: 8 

set item appearances ...[19 item(s)] done [0.00s].
set transactions ...[19 item(s), 336 transaction(s)] done [0.00s].
sorting and recoding items ... [14 item(s)] done [0.00s].
creating transaction tree ... done [0.00s].
checking subsets of size 1 2 3 done [0.00s].
writing ... [19 set(s)] done [0.00s].
creating S4 object  ... done [0.00s].

summary(reglas)

set of 19 itemsets

most frequent items:
              fever=1               cough=1             malaise=1          sorethroat=1 difficultybreathing=1               (Other) 
                   14                     9                     3                     3                     3                     9 

element (itemset/transaction) length distribution:sizes
 2  3 
16  3 

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.000   2.000   2.000   2.158   2.000   3.000 

summary of quality measures:
    support            count      
 Min.   :0.02679   Min.   : 9.00  
 1st Qu.:0.02976   1st Qu.:10.00  
 Median :0.03571   Median :12.00  
 Mean   :0.05686   Mean   :19.11  
 3rd Qu.:0.05506   3rd Qu.:18.50  
 Max.   :0.28869   Max.   :97.00  

includes transaction ID lists: FALSE 

mining info:

reglas_df <- as.data.frame(inspect(reglas))

reglas_df$items %<>%
  lapply(
    function(x) mgsub::mgsub(as.character(x), c("=1", "\\{", "}", ","), c("", "", "", " + "))
  ) %>%
  unlist()

n_registros <- nrow(datos_transac)
subtitulo <- paste(n_registros, "Casos Registrados (Wuhan)")
ggplot(data = reglas_df, aes(x = reorder(items, support), y = support)) +
  geom_bar(stat = "identity") +
  labs(x = "", y = "Proporcion (>= 0.025)", title = "Combinacion de Sintomas COVID-19", subtitle = subtitulo) +
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5)) +
  coord_flip()

# Revisamos proporcion de decesos por combinacion de sintomas.
datos_sintomas <- sintomas_id %>%
  inner_join(datos_snulos %>% select(id, death), by = "id")
datos_sintomas %<>% 
  mutate(muerte = ifelse(death == 0, 0, 1)) # algunos registros son la fecha del deceso (pasamos todo a binario).
datos_sintomas %>%
  filter(fever == 1, cough == 1) %>%
  group_by(muerte) %>%
  summarise(n = n()) %>%
  mutate(freq = n / sum(n))

# Vector basado en agrupamiento.
pct_muertes_sintomas <- c(1, 0, 4, 0,   0, 0,   6,  6,  0,  0,  9,  0,  0,  0,  0,  0,  0,  11, 0)

reglas_df <- arrange(reglas_df, desc(count))
reglas_decesos <- reglas_df %>% mutate(pct_muertes = pct_muertes_sintomas)
reglas_decesos %<>%  filter(pct_muertes > 0)
reglas_decesos %>% mutate(n_decesos = ceiling(count * (pct_muertes / 100)))

ggplot(data = reglas_decesos, aes(x = reorder(items, pct_muertes), y = pct_muertes)) +
  geom_bar(stat = "identity") +
  labs(x = "", y = "% descesos", title = "Pct. Decesos por Combinacion de Sintomas COVID-19") +
  theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5), title = element_text(size = 10)) +
  coord_flip()