How to make a heatmap-like graph with significance level based on two tables in R?

user_15370584 0
Viewed 265

Basically, I have two 7x7 tables, which are saved as long_iccs and pvalues in data.

For the long_iccs table, the x-axis is titled as 03m, 06m, 09m, 12m, 18m, 24m, and 36m, and the y-axis is also titled as 03m, 06m, 09m, 12m, 18m, 24m, and 36m-- I want to keep this format in my output graph.

03m 06m 09m 12m 18m 24m 36m
03m 1 0.25 -0.002 0.10 -0.057 -0.063 NaN
06m 0.25 1 0.384 0.265 0.209 0.021 0.209
09m -0.0021 0.374 1 0.454 0.426 -0.0132 0.361
12m 0.100 0.265 0.454 1 0.286 0.118 0.414
18m -0.0572 0.209 0.426 0.286 1 0.248 0.409
24m -0.0632 0.0213 -0.0132 0.118 0.248 1 -0.163
36m NaN 0.209 0.361 0.414 0.409 -0.163 1

For the pvalues dataframe, it looks like this:

V1 V2 V3 V4 V5 V6 V7
1 NaN 0.146821255 0.5032691552 0.2744200984 0.696125633 0.68544985 0.809989049
2 1.468213e-01 NaN 0.0046248855 0.0255566484 0.084404798 0.42822440 0.081061255
3 5.032692e-01 0.004624886 NaN 0.0004159696 0.002517379 0.53866956 0.006688649
4 2.744201e-01 0.025556648 0.0004159696 NaN 0.040601011 0.21443715 0.002414332
5 6.961256e-01 0.084404798 0.0025173792 0.0406010109 NaN 0.07311703 0.008312505
6 6.854499e-01 0.428224404 0.5386695582 0.2144371492 0.073117029 NaN 0.840898661
7 8.099890e-01 0.081061255 0.0066886493 0.0024143322 0.008312505 0.84089866 NaN

Now talking about what the output graph should look like:

  1. basically it should look like heatmap (these values are from the long_iccs):

  2. then, on each block, I want to add *, **, *** at the top right corner of the numbers if the corresponding values from the pvalues table are <.05, <.005, < .0005 respectively (if the block shows NaN, no need to add any asterisks).

I have tried to "hack" the corrplot package but the significance level given to me is not based on my pvalues table, but the correlations of long_iccs. Some brilliant people please help, thanks a lot!

heatmap data-visualization graph r datatable
1 Answers

I don't believe it is possible to solve your problem using corrplot. Here is a potential solution using ggplot:

library(tidyverse)

df1 <- tibble::tribble(
   ~`03m`, ~`06m`,  ~`09m`, ~`12m`, ~`18m`,  ~`24m`, ~`36m`,
        1,   0.25,  -0.002,    0.1, -0.057,  -0.063,    NaN,
     0.25,      1,   0.384,  0.265,  0.209,   0.021,  0.209,
  -0.0021,  0.374,       1,  0.454,  0.426, -0.0132,  0.361,
      0.1,  0.265,   0.454,      1,  0.286,   0.118,  0.414,
  -0.0572,  0.209,   0.426,  0.286,      1,   0.248,  0.409,
  -0.0632, 0.0213, -0.0132,  0.118,  0.248,       1, -0.163,
      NaN,  0.209,   0.361,  0.414,  0.409,  -0.163,      1
  ) %>%
  as.data.frame() %>% 
  magrittr::set_rownames(c("03m", "06m", "09m", "12m", "18m", "24m", "36m")) %>% 
  rownames_to_column("f_id") %>%
  pivot_longer(-c(f_id), names_to = "samples", values_to = "Correlation")

df2 <- tibble::tribble(
           ~V1,         ~V2,          ~V3,          ~V4,         ~V5,        ~V6,         ~V7,
           NaN, 0.146821255, 0.5032691552, 0.2744200984, 0.696125633, 0.68544985, 0.809989049,
     0.1468213,         NaN, 0.0046248855, 0.0255566484, 0.084404798,  0.4282244, 0.081061255,
     0.5032692, 0.004624886,          NaN, 0.0004159696, 0.002517379, 0.53866956, 0.006688649,
     0.2744201, 0.025556648, 0.0004159696,          NaN, 0.040601011, 0.21443715, 0.002414332,
     0.6961256, 0.084404798, 0.0025173792, 0.0406010109,         NaN, 0.07311703, 0.008312505,
     0.6854499, 0.428224404, 0.5386695582, 0.2144371492, 0.073117029,        NaN, 0.840898661,
      0.809989, 0.081061255, 0.0066886493, 0.0024143322, 0.008312505, 0.84089866,         NaN
  ) %>%
  as.data.frame() %>% 
  magrittr::set_colnames(c("03m", "06m", "09m", "12m", "18m", "24m", "36m")) %>% 
  magrittr::set_rownames(c("03m", "06m", "09m", "12m", "18m", "24m", "36m")) %>% 
  rownames_to_column("f_id") %>%
  pivot_longer(-c(f_id), names_to = "samples", values_to = "Significance")

df3 <- df2 %>% 
  mutate(Asterisks = ifelse(Significance <= 0.0005, "***",
                            ifelse(Significance <= 0.005, "**",
                            ifelse(Significance <= 0.05, "*", NA))))

ggplot() + 
  geom_raster(data = df1, aes(x = samples, y = f_id, fill = Correlation)) +
  geom_text(data = df2, aes(x = samples, y = f_id, label = round(Significance, 3))) +
  geom_text(data = df3, aes(x = samples, y = f_id, label = Asterisks),
            nudge_y = 0.25, nudge_x = 0.25, size = 6) +
  scale_fill_viridis_c(na.value = "black")

example_heatmap.png

user_129573400
Related