search

dynverse / dyno

Inferring, interpreting and visualising trajectories using a streamlined set of packages 🦕
https://dynverse.github.io/dyno
Other
163 stars 32 forks source link

plot_heatmap change heatmap colours #77

Open subkhankul opened 4 years ago

subkhankul commented 4 years ago

Hi there,

I am trying to change the palette in plot_heatmap() function. Unfortunately, when I change "RdBu" for custom "my_palette' in plot_heatmap code I always have an error:

Error in check_milestones(trajectory, milestones) : could not find function "check_milestones"

The same error appears if the plot_heatmap (or plot_dimred) function is built by copy and paste the code (please, see below).

I wonder if there is any possibility to change the palette (colours) in the heatmap?

 a<-function (trajectory, expression_source = "expression", features_oi = 20, 
          clust = "ward.D2", margin = 0.02, color_cells = NULL, milestones = NULL, 
          milestone_percentages = trajectory$milestone_percentages, 
          grouping = NULL, groups = NULL, cell_feature_importances = NULL, 
          heatmap_type = c("tiled", "dotted"), scale = dynutils::scale_quantile, 
          label_milestones = TRUE) 
{
  testthat::expect_true(dynwrap::is_wrapper_with_trajectory(trajectory))
  heatmap_type <- match.arg(heatmap_type)
  expression <- get_expression(trajectory, expression_source)
  if (dynutils::is_sparse(expression)) {
    expression <- as.matrix(expression)
  }
  if (is.function(scale)) {
    expression <- scale(expression)
  }
  else if (is.logical(scale) && scale) {
    expression <- dynutils::scale_quantile(expression)
  }
  milestones <- check_milestones(trajectory, milestones)
  features_oi <- check_features_oi(trajectory, expression, 
                                   features_oi, cell_feature_importances)
  expression <- expression[, features_oi]
  if (is.character(clust)) {
    clust <- hclust(as.dist(correlation_distance(t(expression))), 
                    method = clust)
  }
  feature_order <- colnames(expression)[clust$order]
  linearised <- linearise_cells(trajectory = trajectory, equal_cell_width = TRUE, 
                                margin = margin)
  molten <- expression %>% reshape2::melt(varnames = c("cell_id", 
                                                       "feature_id"), value.name = "expression") %>% mutate_if(is.factor, 
                                                                                                               as.character) %>% mutate(feature_position = as.numeric(factor(feature_id, 
                                                                                                                                                                             feature_order))) %>% left_join(linearised$progressions, 
                                                                                                                                                                                                            "cell_id")
  if (!is.null(cell_feature_importances)) {
    molten <- left_join(molten, cell_feature_importances, 
                        c("cell_id", "feature_id"))
  }
  x_limits <- c(min(linearised$milestone_network$cumstart) - 
                  1, max(linearised$milestone_network$cumend) + 1)
  y_limits <- c(0.5, length(feature_order) + 0.5)
  heatmap <- if (heatmap_type == "tiled") {
    if (is.null(cell_feature_importances)) {
      ggplot(molten) + geom_tile(aes(cumpercentage, feature_position, 
                                     fill = expression)) + scale_fill_distiller(palette = "RdBu") + 
        scale_x_continuous(NULL, breaks = NULL, expand = c(0, 
                                                           0), limits = x_limits) + scale_y_continuous(NULL, 
                                                                                                       expand = c(0, 0), breaks = seq_along(feature_order), 
                                                                                                       labels = feature_order, position = "left", limits = y_limits) + 
        theme(legend.position = "none", plot.margin = margin(), 
              plot.background = element_blank(), panel.background = element_blank())
    }
    else {
      ggplot(molten) + geom_rect(aes(xmin = cumpercentage - 
                                       0.5, xmax = cumpercentage + 0.5, ymin = feature_position + 
                                       scale_minmax(importance)/10 * 5, ymax = feature_position - 
                                       scale_minmax(importance)/10 * 5, fill = expression)) + 
        scale_fill_distiller(palette = "RdBu") + scale_x_continuous(NULL, 
                                                                    breaks = NULL, expand = c(0, 0), limits = x_limits) + 
        scale_y_continuous(NULL, expand = c(0, 0), breaks = seq_along(feature_order), 
                           labels = feature_order, position = "left", 
                           limits = y_limits) + scale_alpha_continuous(range = c(0, 
                                                                                 1)) + theme(legend.position = "none", plot.margin = margin(), 
                                                                                             plot.background = element_blank(), panel.background = element_blank())
    }
  }
  else if (heatmap_type == "dotted") {
    if (is.null(cell_feature_importances)) {
      ggplot(molten) + geom_point(aes(cumpercentage, feature_position, 
                                      color = expression, size = expression)) + scale_color_distiller(palette = "RdBu") + 
        scale_size_continuous(range = c(0, 6)) + scale_x_continuous(NULL, 
                                                                    breaks = NULL, expand = c(0, 0), limits = x_limits) + 
        scale_y_continuous(NULL, expand = c(0, 0), breaks = seq_along(feature_order), 
                           labels = feature_order, position = "left", 
                           limits = y_limits) + theme(legend.position = "none", 
                                                      plot.margin = margin(), plot.background = element_blank(), 
                                                      panel.background = element_blank())
    }
    else {
      ggplot(molten) + geom_point(aes(cumpercentage, feature_position, 
                                      color = expression, size = importance^2)) + scale_color_distiller(palette = "RdBu") + 
        scale_size_continuous(range = c(0, 6)) + scale_x_continuous(NULL, 
                                                                    breaks = NULL, expand = c(0, 0), limits = x_limits) + 
        scale_y_continuous(NULL, expand = c(0, 0), breaks = seq_along(feature_order), 
                           labels = feature_order, position = "left", 
                           limits = y_limits) + theme(legend.position = "none", 
                                                      plot.margin = margin(), plot.background = element_blank(), 
                                                      panel.background = element_blank())
    }
  }
  onedim <- plot_onedim(trajectory, linearised = linearised, 
                        orientation = -1, quasirandom_width = 0, margin = margin, 
                        color_cells = color_cells, grouping = grouping, groups = groups, 
                        milestone_percentages = milestone_percentages, milestones = milestones, 
                        plot_cells = FALSE, label_milestones = label_milestones) + 
    scale_x_continuous(expand = c(0, 0), limits = x_limits) + 
    theme(plot.margin = margin())
  dendrogram <- ggraph::ggraph(as.dendrogram(clust), "dendrogram") + 
    ggraph::geom_edge_elbow() + scale_x_continuous(limits = c(-0.5, 
                                                              length(feature_order) - 0.5), expand = c(0, 0)) + scale_y_reverse() + 
    coord_flip() + theme_graph() + theme(plot.margin = margin())
  if (!is.null(grouping)) {
    cell_annotation_positions <- linearised$progressions %>% 
      add_cell_coloring(color_cells = "grouping", grouping = grouping, 
                        trajectory = trajectory, groups = groups, milestones = milestones)
  }
  else if (!is.null(milestone_percentages)) {
    cell_annotation_positions <- linearised$progressions %>% 
      add_cell_coloring(color_cells = "milestone", milestone_percentages = milestone_percentages, 
                        trajectory = trajectory, milestones = milestones)
  }
  cell_annotation <- ggplot(cell_annotation_positions$cell_positions) + 
    geom_point(aes(cumpercentage, 1, color = color)) + cell_annotation_positions$color_scale + 
    scale_x_continuous(expand = c(0, 0), limits = x_limits) + 
    theme_graph() + theme(legend.position = "top")
  patchwork::wrap_plots(empty_plot(), cell_annotation, dendrogram, 
                        heatmap, empty_plot(), onedim, ncol = 2, widths = c(2, 
                                                                            10), heights = c(0.5, 10, 2))
}
rcannood commented 4 years ago

Hello @subkhankul,

That's because check_milestones() is a dynplot function that is not exported. If you change the code to dynplot:::check_milestones(), it should work. You might have to do this for other function calls as well.

Does this solve your problem?

Kind regards, Robrecht

subkhankul commented 4 years ago

Many thanks Robrecht,

I tried Slingshot first (used it from 2017:)), it works, the reason to explore Scorprius was nice smooth Heatmap without intermediate milestones. Now am using these both plus page_tree for my complex data.

Thanks for codes plot_heattmap, will try it. Best regards,

Tatiana

From: Robrecht Cannoodt notifications@github.com Sent: 23 March 2020 15:31 To: dynverse/dyno dyno@noreply.github.com Cc: subkhankul subkhankul@hotmail.com; Mention mention@noreply.github.com Subject: Re: [dynverse/dyno] plot_heatmap change heatmap colours (#77)

Hello @subkhankulhttps://github.com/subkhankul,

That's because check_milestones() is a dynplot function that is not exported. If you change the code to dynplot:::check_milestones(), it should work. You might have to do this for other function calls as well.

Does this solve your problem?

Kind regards, Robrecht

— You are receiving this because you were mentioned. Reply to this email directly, view it on GitHubhttps://github.com/dynverse/dyno/issues/77#issuecomment-602676433, or unsubscribehttps://github.com/notifications/unsubscribe-auth/AFITIDPWLVR3NOWOVG2ZI4LRI56GRANCNFSM4LFUSYLQ.