Donut heatmap

Data read and preperation

Code

```{r}
#| cache: true
library(tidyverse)
sample_type  <- "Serum" # "Stool"
#md <- paste0(sample_type, "_metadata.txt") |>  read_tsv()

sig <- paste0(sample_type, "_maaslin_#2_DS-CD/significant_results.tsv") |> read_tsv()
```

Rows: 290 Columns: 9
── Column specification ────────────────────────────────────────────────────────
Delimiter: "\t"
chr (3): feature, metadata, value
dbl (6): coef, stderr, N, N.not.0, pval, qval

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Code

```{r}
#| cache: true
sig_features <- sig |> filter(metadata != "Fasting") |> filter(metadata != "Age") |> filter(metadata != "Gender") |> pull(feature)

all_results <- paste0(sample_type, "_maaslin_#2_DS-CD/all_results.tsv") |> 
    read_tsv() |> filter(feature %in% sig_features)
```

Rows: 1884 Columns: 9
── Column specification ────────────────────────────────────────────────────────
Delimiter: "\t"
chr (3): feature, metadata, value
dbl (6): coef, stderr, N, N.not.0, pval, qval

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Code

```{r}
#| cache: true
hole <- 4
a_alpha <- .25
nba <- 
  all_results |> filter(metadata != "Fasting") |> 
  filter(metadata != "Age") |> 
  filter(metadata != "Gender") |>
 # complete(feature, metadata) |> replace_na(list(coef = NA)) |> 
  mutate(metadata = metadata |> as.factor(), 
         num.metadata = metadata |> as.numeric() + hole) |>
  mutate(signif = qval < a_alpha) |> 
  mutate(mz = str_extract(feature, pattern = "(?!_)\\d+") |> as.numeric()) |> 
  arrange(mz |> desc()) |> 
  mutate(feature = str_remove(feature, "_.*")) |> distinct(feature, metadata, .keep_all = T)

y_labels = levels(nba$metadata)
y_breaks = seq_along(y_labels) + hole
```

Also set the hole size (= 4).

Code

nba.labs <- subset(nba, metadata==levels(nba$metadata)[nlevels(nba$metadata)])
# nba.labs <- nba
nba.labs <- nba.labs[order(nba.labs$feature),]

nba.labs$ang <- seq(from=(360/nrow(nba.labs))/1.5, to=(1.5*(360/nrow(nba.labs)))-360, length.out=nrow(nba.labs))+80
nba.labs$hjust <- 0
nba.labs$hjust[which(nba.labs$ang < -90)] <- 1
nba.labs$ang[which(nba.labs$ang < -90)] <- (180+nba.labs$ang)[which(nba.labs$ang < -90)]
# nba.labs$feature <- nba$feature |> str_remove("_.*")

Set the text angle.

Code

pl <- nba |> 
  ggplot(aes(fill = coef, x = feature, y = num.metadata)) + 
  geom_text(data = nba.labs, aes(x = feature, y = num.metadata + 1, label = feature |> str_remove("_.*"), angle = ang, hjust = hjust), size = 3) +
  geom_tile(color = "darkgrey") + 
  ylim(c(0, max(nba$num.metadata) + 4.5)) +
  scale_fill_gradient2(low="blue", mid = "white", high="red", 
                       guide="colorbar",na.value="white") + 
  # scale_y_discrete(breaks=y_breaks, labels=y_labels) +
  coord_polar() + 
  #theme_minimal() + 
  theme_void() +
  theme(axis.text = element_blank() , panel.grid = element_blank()
        , axis.title = element_blank(), legend.position = c(0.5, 0.5)) +
  geom_text(aes(x= -Inf, label = metadata), size = 3.5, data = nba[!duplicated(nba$metadata),]) +   scale_x_discrete(expand = c(0.05, 0)) +
    geom_text(aes(x = feature, y = num.metadata, label = ifelse(signif, "+","")), size = 2) + 
    ggtitle(sample_type)
pl  

Plot settings.

Plot at next slide.

Plot

Download