rooting and pseudotime calculation need some work
Opened this issue · 2 comments
zouter commented
rcannood commented
Adding a small reproducible example ;) In both rootings, things are going wrong.
Example code
library(tidyverse)
library(dyno)
milestone_ids <- c("W", "X", "Y", "Z", "A", "B", "C")
milestone_network <- tribble(
~from, ~to, ~length, ~directed,
"W", "X", 2, TRUE,
"X", "Y", 4, TRUE,
"Y", "W", 3, TRUE,
"Y", "Z", 2, TRUE,
"A", "B", 1, TRUE,
"C", "A", 1, TRUE
)
progressions <-
milestone_network %>%
rowwise() %>%
do({
df <- .
tibble(
cell_id = paste0(df$from, df$to, seq_len(20)),
from = df$from,
to = df$to,
percentage = seq(0, 1, length.out = length(cell_id))
)
}) %>%
ungroup()
trajectory <- wrap_data(
id = "test",
cell_ids = unique(progressions$cell_id)
) %>% add_trajectory(
milestone_ids = milestone_ids,
milestone_network = milestone_network,
progressions = progressions
)
g1 <- plot_graph(trajectory, label_milestones = TRUE)
t2 <- trajectory %>% add_root(root_milestone_id = "W")
g2 <-
plot_graph(
t2, "pseudotime",
pseudotime = calculate_pseudotime(t2),
label_milestones = TRUE
) + labs(title = "Root W")
t3 <- trajectory %>% add_root(root_milestone_id = "Z")
g3 <-
plot_graph(
t3, "pseudotime",
pseudotime = calculate_pseudotime(t3),
label_milestones = TRUE
) + labs(title = "Root Z")
patchwork::wrap_plots(g1, g2, g3)
ggsave("~/plot.png", width = 12, height = 4)
zouter commented
Okay, I understand. So if you root at Y (or W, X), you only want to Z-Y if necessary, but not the other edges. So only the edges that are not accessible should be swapped