Heatmap of genes along DPT pseudotime

[tkapello]

Sorry for posting this again, but unfortunately the previous thread was closed and I could not comment there. I want to create a heatmap of features along a DPT pseudotime (see attached panel below from the Haghverdi 2015 paper. I tried the suggestion posted in Issue #20, but the result was not what I anticipated. Is it possible to make this heatmap using the information of the DPT object?

[flying-sheep]

The conversation in that issue wasn’t locked, so you should be able to comment there.

This heatmap is of course very customized for the publications, but you should be able to get the main feature (the branching). You can get the:

• branch labels: dpt$Branch
• order starting from a tip cell: tip_idx <- tips(dpt)[[1]]; order(dpt[tip_idx, ])

And with this you can subset and reorder the expressions to get a 3-part heatmap:

library(destiny)
library(tidyverse)

data(guo_norm)
dm <- DiffusionMap(guo_norm)
dpt <- DPT(dm)

exprs <- Biobase::exprs(guo_norm)
order_tip_1 <- order(dpt[tips(dpt)[[1]], ])

heatmaps <-
    na.exclude(unique(dpt$Branch)) %>%
    set_names() %>%
    map(function(branch) {
        branch_subset <- dpt$Branch == branch & !is.na(dpt$Branch)
        exprs_subset <- exprs[, order_tip_1[branch_subset]]
        as.data.frame(t(exprs_subset)) %>% mutate(Cell = n():1)
    })
heatmaps[[2]]$Cell <- heatmaps[[2]]$Cell + max(heatmaps[[1]]$Cell) + 2L
heatmaps[[3]]$Cell <- heatmaps[[3]]$Cell + max(heatmaps[[2]]$Cell) + 2L
heatmaps %>%
    bind_rows(.id = 'Branch') %>%
    gather(Gene, Expr, -Branch, -Cell) %>%
    ggplot(aes(Cell, Gene, fill = Expr)) + geom_tile() + scale_fill_viridis_c() +
    scale_x_continuous(expand = c(0, 0)) + 
    scale_y_discrete(expand = c(0, 0))

I’m not 100% sure it’s correct, but I hope you get the idea.