Donut heatmap

Rotem & Nina

2022-09-08

Data read and preperation

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

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



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
```

Cluster coef

Code
temp <- nba |> select(feature, metadata, coef)  |> 
  pivot_wider(names_from = metadata, values_from = coef) 
# rownames(temp) <- paste0(temp$feature)
ord <- hclust( dist(temp |> select(-1), method = "euclidean"), method = "ward.D" )$order
nba$feature = factor(nba$feature, temp$feature[ord])

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)))-340
                  , length.out=nrow(nba.labs))+90
            
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)]

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, 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( start = -.3) + 
  #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),], vjust = 0) +   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