PRECISE-DAPT 6Y GOOD

Descriptive Statistics

Table 1

var total
n 421’593
Age 67 (13)
Haemoglobin 13 (2)
WBC 9 (7)
Creatinine_Clearance 64 (31)
Prior_bleeding (= 1) 34’592 (8.2%)
Score 25 (16)
12m_risk 2 (4)
m12m_risk 4 (9)
Cluster_risk
High 191’885 (45.5%)
Low 153’939 (36.5%)
Moderate 75’769 (18.0%)
alternative_score 27 (19)
Local_time_label
Night 27’415 (6.5%)
Morning 166’620 (39.7%)
Afternoon 147’056 (35.0%)
Evening 78’595 (18.7%)
Year
2017 46’257 (11.0%)
2018 67’667 (16.1%)
2019 83’335 (19.8%)
2020 81’838 (19.4%)
2021 77’941 (18.5%)
2022 64’555 (15.3%)
hbr (= 1) 181’458 (46.3%)
hbr_alternative (= 1) 194’758 (49.7%)
new_cluster_risk
High 181’458 (46.3%)
Low 71’012 (18.1%)
Moderate 69’011 (17.6%)
Very Low 70’460 (18.0%)
quantile_score alternative_score
0% 0 0
25% 13 13
50% 23 24
75% 35 38
100% 100 100
var total
n 421’593
No HBR (= 1) 187’187 (47.8%)
HBR only alternative score (= 2) 23’296 (5.9%)
HBR only conventional score (= 3) 9’996 (2.6%)
HBR (= 4) 171’462 (43.7%)

Plot per anni (linee vs barre)

#analisi per anni
#modifica data
#db$Date <- as.Date(db$Date)
#db$Date <- as.character(db$Date)
#db$Date <- as.Date(db$Date)

date_table <- data.frame(table(db$Year))
date_table$pubbl <- c(5, 12, 13, 24, 19, 14)
date_table_month <- data.frame(table(db$Month_Year))
#quadrimestri
db$quarters <- paste0(year(db$Timestamp),
                             "/0",
                             quarter(db$Timestamp))
date_table_quarters <- data.frame(table(db$quarters))
date_table_quarters %>% arrange(date_table_quarters$Var1)
      Var1  Freq
1  2017/01  1648
2  2017/02  3115
3  2017/03  8773
4  2017/04 17842
5  2018/01 20212
6  2018/02 19729
7  2018/03 12780
8  2018/04 19034
9  2019/01 17299
10 2019/02 22862
11 2019/03 22343
12 2019/04 19788
13 2020/01 16701
14 2020/02 17591
15 2020/03 24026
16 2020/04 21213
17 2021/01 21847
18 2021/02 20313
19 2021/03 17270
20 2021/04 20184
21 2022/01 20033
22 2022/02 17741
23 2022/03 15284
24 2022/04 15347
25 2023/01  8618
#db_pubmed <- read_excel("pubmed search precise dapt.xlsx")
#table_pubmed <- data.frame(table(db_pubmed$quadrimestri))
date_table_quarters$pubbl <- c(1,   0,  2,  2,  0,  1,  2,  6,  3,  4,  3,  4,  3,  7,  7,  9,  1,  2,  5,  7,  5,  3,  6,  1,  3)
  
#plotting dati per anno a linee
date_table_tidy <- gather(date_table, measure, value, -Var1)
colnames(date_table_tidy)[1] <- "Year"
ggplot(data = date_table_tidy, aes(x = Year, y = value)) +
  geom_point(size = 2) +
  geom_line(group = 1) +
  facet_grid(measure ~ ., scales = "free_y")

#plotting.a quadrimestri
date_table_quarters_tidy <- gather(date_table_quarters, measure, value, -Var1)
colnames(date_table_quarters_tidy)[1] <- "Quarters"
ggplot(data = date_table_quarters_tidy, aes(x = Quarters, y = value)) +
  geom_point(size = 2) +
  geom_line(group = 1) +
  facet_grid(measure ~ ., scales = "free_y")

#plotting dati per anno a barre colorate
plt_Year <- ggplot(date_table) +
  # Make custom panel grid
  geom_hline(
    aes(yintercept = y), 
    data.frame(y = c(0:3) * 1000),
    color = "lightgrey"
  ) + 
  # Add bars to represent the cumulative track lengths
  # str_wrap(region, 5) wraps the text so each line has at most 5 characters
  # (but it doesn't break long words!)
  geom_col(
    aes(
      x = Var1,
      y = Freq,
      fill = pubbl,
      ),
    position = "dodge2",
    show.legend = TRUE,
    alpha = .9
  ) +
    # Make it circular!
  coord_polar()
plt_Year

#plotting dati per quadrimestri
plt_quarter <- ggplot(date_table_quarters) +
  # Make custom panel grid
  geom_hline(
    aes(yintercept = y), 
    data.frame(y = c(0:3) * 1000),
    color = "lightgrey"
  ) + 
  # Add bars to represent the cumulative track lengths
  # str_wrap(region, 5) wraps the text so each line has at most 5 characters
  # (but it doesn't break long words!)
  geom_col(
    aes(
      x = Var1,
      y = Freq,
      fill = pubbl,
      ),
    position = "dodge2",
    show.legend = TRUE,
    alpha = .9
  ) +
    # Make it circular!
  coord_polar()
plt_quarter

Scatterplot Convenzionale vs Alternativo

#scatterplot convetional Score - Alternative Score
scatterplot <- ggplot(db, aes(x = Score, y = alternative_score)) + 
  geom_point(shape=21, fill="white", color=as.factor(db$hbr_color)) + 
  geom_smooth(method = lm) + 
  labs(x = "PRECISE-DAPT", y = "Alternative PRECISE-DAPT")
scatterplot <- scatterplot + geom_hline(yintercept=25, linetype="dashed", color = "red")
scatterplot + geom_vline(xintercept=25, linetype="dashed", color = "red")
`geom_smooth()` using formula = 'y ~ x'
Warning: Removed 29652 rows containing non-finite values (`stat_smooth()`).
Warning: Removed 29652 rows containing missing values (`geom_point()`).

Country analysis

Istogramma per continente

Heatmap mondo tutti i pazienti

world_table <- data.frame(table(db$`Country`))
#world_table$Var1[world_table$Var1 == "United States"] <- "USA"

world_map <- map_data("world")
world_map <- subset(world_map, region != "Antarctica")


ggplot(world_table) +
  geom_map(
    dat = world_map, map = world_map, aes(map_id = region),
    fill = "white", color = "#7f7f7f", size = 0.25
  ) +
  geom_map(map = world_map, aes(map_id = Var1, fill = Freq), size = 0.25) +
  scale_fill_gradient(low = "#fff7bc", high = "#cc4c02", name = "Total Cases") +
  expand_limits(x = world_map$long, y = world_map$lat)
Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.

Heatmap mondo solo hbr

#seleziono solo hbr patient
db$hbr <- as.numeric(db$hbr)
db_hbr <- db %>% filter(db$hbr == 1)

world_table_hbr1 <- data.frame(table(db_hbr$`Country`))
world_table_hbr1$total <- c(5,  71, 637,    3,  3953,   645,    20, 1794,   1570,   49, 3,  174,    82, 831,    2504,   2,  22, 148,    8134,   5,  38, 3477,   2,  52, 1756,   1416,   25181,  11814,  88, 536,    18, 12, 77, 11050,  1422,   3,  211,    2,  214,    2560,   53, 2,  158,    39, 9,  181,    9379,   3,  6,  120,    18786,  4,  4800,   2,  1,  1,  98, 1,  132,    456,    1172,   8143,   6319,   278,    126,    1685,   2,  1389,   37982,  2,  28525,  8,  416,    669,    150,    8,  274,    102,    1,  65, 153,    25, 1154,   32, 17, 1,  1489,   29, 376,    1,  11, 4,  8217,   455,    1,  34, 21, 442,    61, 5,  68, 26872,  82, 154,    25, 7,  121,    413,    105,    714,    45, 1733,   132,    1871,   593,    20751,  3282,   27, 115,    20, 2191,   22028,  4,  855,    9,  1418,   1,  751,    1299,   238,    12, 240,    15831,  19097,  90, 16, 2,  1128,   4002,   55, 1384,   3,  13, 8385,   29, 925,    23769,  8,  7573,   945,    348,    144,    21671,  34, 1,  133,    13183,  30, 3)
world_table_hbr1$hbr_perc <- world_table_hbr1$Freq/world_table_hbr1$total*100
world_table_hbr1$hbr_perc <- round(world_table_hbr1$hbr_perc,2)
world_table_hbr <- droplevels( world_table_hbr1[-which(world_table_hbr1$total < 330), ] )

#world_table_hbr <- read_excel("world_heatmap.xlsx")
world_map_hbr <- map_data("world")
world_map_hbr <- subset(world_map_hbr, region != "Antarctica")


ggplot(world_table_hbr) +
  geom_map(
    dat = world_map_hbr, map = world_map_hbr, aes(map_id = region),
    fill = "white", color = "#7f7f7f", size = 0.25
  ) +
  geom_map(map = world_map_hbr, aes(map_id = Var1, fill = hbr_perc), size = 0.25) +
  scale_fill_gradient(low = "yellow", high = "red", name = "HBR/Total Cases", limits = c(15,100)) +
  expand_limits(x = world_map$long, y = world_map$lat)

Prova radar

library(githubinstall)
library(ggradar)
library(palmerpenguins)
library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ forcats 1.0.0     ✔ readr   2.1.4
✔ purrr   1.0.1     ✔ tibble  3.2.0
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ lubridate::days()    masks chron::days()
✖ dplyr::filter()      masks plotly::filter(), stats::filter()
✖ lubridate::hours()   masks chron::hours()
✖ dplyr::lag()         masks stats::lag()
✖ purrr::map()         masks maps::map()
✖ lubridate::minutes() masks chron::minutes()
✖ lubridate::seconds() masks chron::seconds()
✖ lubridate::years()   masks chron::years()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors
library(scales)

Attaching package: 'scales'

The following object is masked from 'package:purrr':

    discard

The following object is masked from 'package:readr':

    col_factor
library(showtext)
Loading required package: sysfonts
Loading required package: showtextdb
font_add_google("Lobster Two", "lobstertwo")
font_add_google("Roboto", "roboto")

db_radar <- db %>%
  drop_na() %>%
  group_by(new_cluster_risk) %>%
  summarise(
    avg_haemoglobin = mean(Haemoglobin),
    avg_WBC = mean(WBC),
    avg_CrCl = mean(Creatinine_Clearance),
    avg_age = mean(Age)
  ) %>%
  ungroup() %>%
  mutate_at(vars(-new_cluster_risk), rescale)

plt_radar <- db_radar %>%
  ggradar(
    #font.radar = "roboto",
    grid.label.size = 3,  # Affects the grid annotations (0%, 50%, etc.)
    axis.label.size = 8.5, # Afftects the names of the variables
    group.point.size = 3   # Simply the size of the point 
  )

plt_radar

plt_radar <- plt_radar + 
  theme(
    legend.position = c(1, 0),  
    legend.justification = c(1, 0),
    legend.text = element_text(size = 28, family = "Arial"),
    legend.key = element_rect(fill = NA, color = NA),
    legend.background = element_blank()
  )
plt_radar