PRECISE-DAPT

Descriptive Statistics

Table 1

var	total
n	699’815
Age	66 (13)
Haemoglobin	13 (2)
WBC	9 (8)
Creatinine_Clearance	63 (32)
Prior_bleeding (= 1)	72’203 (10.3%)
Score	26 (17)
12m_risk	2 (5)
m12m_risk	5 (10)
Cluster_risk
High	335’373 (47.9%)
Low	245’201 (35.0%)
Moderate	119’241 (17.0%)
alternative_score	27 (20)
Local_time_label
Night	50’170 (7.2%)
Morning	265’206 (38.0%)
Afternoon	244’410 (35.0%)
Evening	137’917 (19.8%)
Year
2017	83’954 (12.0%)
2018	124’871 (17.8%)
2019	128’807 (18.4%)
2020	130’027 (18.6%)
2021	124’562 (17.8%)
2022	107’594 (15.4%)
hbr (= 1)	317’945 (48.6%)
hbr_alternative (= 1)	321’748 (49.2%)
new_cluster_risk
High	317’945 (48.6%)
Low	108’199 (16.5%)
Moderate	109’406 (16.7%)
Very Low	118’794 (18.2%)

	quantile_score	alternative_score
0%	0	0
25%	14	12
50%	24	24
75%	35	38
100%	100	100

var	total
n	699’815
No HBR (= 1)	311’135 (47.5%)
HBR only alternative score (= 2)	25’264 (3.9%)
HBR only conventional score (= 3)	21’461 (3.3%)
HBR (= 4)	296’484 (45.3%)

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(14, 19, 16, 32, 28, 19)
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  3589
2  2017/02  8383
3  2017/03 17034
4  2017/04 30519
5  2018/01 39204
6  2018/02 37316
7  2018/03 24038
8  2018/04 29720
9  2019/01 29045
10 2019/02 36103
11 2019/03 34855
12 2019/04 30750
13 2020/01 24422
14 2020/02 28533
15 2020/03 38053
16 2020/04 33566
17 2021/01 34756
18 2021/02 31511
19 2021/03 27486
20 2021/04 33245
21 2022/01 31550
22 2022/02 28832
23 2022/03 25434
24 2022/04 26364
25 2023/01 15507

db_pubmed <- read_excel("pubmed search precise dapt.xlsx")
table_pubmed <- data.frame(table(db_pubmed$quadrimestri))
date_table_quarters$pubbl <- c(2,   2,  4,  5,  1,  5,  4,  6,  4,  5,  3,  5,  4,  8,  9,  11, 4,  3,  9,  9,  7,  5,  8,  1,  4) 
  
#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 45471 rows containing non-finite values (`stat_smooth()`).

Warning: Removed 45471 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(6,  173,    1021,   3,  6213,   935,    26, 5477,   2781,   96, 11, 219,    150,    915,    3748,   3,  42, 229,    12584,  11, 72, 4725,   2,  118,    3108,   3133,   45250,  17137,  133,    887,    25, 14, 164,    15037,  3355,   9,  329,    2,  371,    4700,   75, 6,  327,    91, 27, 355,    13549,  3,  14, 207,    32327,  4,  7484,   4,  1,  149,    2,  148,    996,    1943,   9,  12204,  9687,   499,    227,    2724,   3,  2611,   67179,  2,  49495,  9,  564,    827,    199,    11, 509,    141,    3,  129,    238,    33, 58, 1764,   66, 34, 1,  3031,   50, 538,    1,  29, 13, 12203,  612,    1,  58, 28, 796,    162,    8,  228,    41405,  117,    263,    32, 11, 207,    776,    144,    1065,   59, 2180,   188,    3399,   1069,   31448,  5685,   53, 289,    25, 4091,   28352,  11, 1685,   23, 2293,   1,  1811,   2024,   401,    16, 333,    27661,  30290,  154,    24, 2,  4505,   7725,   84, 2900,   5,  27, 17106,  44, 1809,   36134,  18, 18607,  1733,   548,    323,    38616,  42, 3,  233,    21689,  39, 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)