Skip to content

Commit

Permalink
Merge pull request #165 from tanaylab/feat@heatmap-enrichment-type
Browse files Browse the repository at this point in the history 
Feat@heatmap enrichment type
  • Loading branch information
@aviezerl
aviezerl authored May 28, 2024
2 parents 1cfb2d0 + bb5d408 commit c0515dc
Show file tree
Hide file tree
Showing 7 changed files with 75 additions and 32 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: MCView
Title: A Shiny App for Metacell Analysis
Version: 0.2.28
Version: 0.2.29
Authors@R:
person(given = "Aviezer",
family = "Lifshitz",
Expand Down
4 changes: 4 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
# MCView 0.2.29

* Added "Enrichment type" toggle to the 'Markers' tab.

# MCView 0.2.28

* Added an option to show only fitted genes in the projected fold tab.
Expand Down
2 changes: 1 addition & 1 deletion R/import.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -554,7 +554,7 @@ import_dataset <- function(project,
)
serialize_shiny_data(qc_stats, "qc_stats", dataset = dataset, cache_dir = cache_dir)

if (has_name(adata$var, "gene")){
if (has_name(adata$var, "gene")) {
cli::cli_abort("A column named {.field 'gene'} already exists in the var slot of the anndata object. Please rename it to avoid conflicts.")
}

Expand Down
2 changes: 1 addition & 1 deletion R/metadata.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -576,7 +576,7 @@ parse_metadata_colors <- function(metadata_colors, metadata) {
if (is.null(names(.x))) {
cli_abort("In metadata colors field {.field {.y}}, color vector doesn't have any names.")
}

res <- .x
}
return(res)
Expand Down
13 changes: 9 additions & 4 deletions R/utils_gene_expression.R
View file
Original file line number Diff line number Diff line change
@@ -1,16 +1,21 @@
get_mc_egc <- function(dataset, genes = NULL, atlas = FALSE) {
get_mc_egc <- function(dataset, genes = NULL, atlas = FALSE, metacells = NULL) {
mc_mat <- get_mc_data(dataset, "mc_mat", atlas = atlas)
mc_sum <- get_mc_sum(dataset, atlas = atlas)

if (!is.null(genes)) {
mc_mat <- mc_mat[intersect(genes, rownames(mc_mat)), , drop = FALSE]
}

if (!is.null(metacells)) {
mc_mat <- mc_mat[, intersect(metacells, colnames(mc_mat)), drop = FALSE]
mc_sum <- mc_sum[intersect(metacells, names(mc_sum))]
}

return(t(t(mc_mat) / mc_sum))
}

get_mc_fp <- function(dataset, genes = NULL, atlas = FALSE) {
mc_egc <- get_mc_egc(dataset, genes = genes, atlas = atlas)
get_mc_fp <- function(dataset, genes = NULL, atlas = FALSE, metacells = NULL) {
mc_egc <- get_mc_egc(dataset, genes = genes, atlas = atlas, metacells = metacells)

mc_egc_norm <- mc_egc + 1e-5
mc_fp <- mc_egc_norm / apply(mc_egc_norm, 1, median, na.rm = TRUE)
Expand Down Expand Up @@ -55,7 +60,7 @@ filter_mat_by_cell_types <- function(mat, cell_types, metacell_types) {
filter(cell_type %in% cell_types) %>%
pull(metacell)

mat <- mat[, metacells, drop = FALSE]
mat <- mat[, intersect(colnames(mat), metacells), drop = FALSE]

return(mat)
}
Expand Down
63 changes: 41 additions & 22 deletions R/utils_heatmap.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,6 +110,7 @@ heatmap_sidebar <- function(id, ..., show_fitted_filter = FALSE) {
size = "sm",
justified = TRUE
),
uiOutput(ns("mat_value_ui")),
uiOutput(ns("copy_metacells_ui")),
tags$hr(),
uiOutput(ns("cell_type_list")),
Expand Down Expand Up @@ -143,7 +144,7 @@ heatmap_sidebar <- function(id, ..., show_fitted_filter = FALSE) {
)
}

heatmap_matrix_reactives <- function(ns, input, output, session, dataset, metacell_types, cell_type_colors, globals, markers, lfp_range, mode) {
heatmap_matrix_reactives <- function(ns, input, output, session, dataset, metacell_types, cell_type_colors, globals, markers, lfp_range, mode, metacell_filter, mat) {
observe({
choices <- markers()
if (!is.null(choices)) {
Expand Down Expand Up @@ -191,26 +192,30 @@ heatmap_matrix_reactives <- function(ns, input, output, session, dataset, metace
req(cell_type_colors())
req(is.null(input$selected_cell_types) || all(input$selected_cell_types %in% c(cell_type_colors()$cell_type, "(Missing)")))

if (!is.null(input$selected_cell_types)) {
markers_df <- metacell_types() %>%
filter(cell_type %in% input$selected_cell_types)
if (input$mat_value == "Local") {
mc_egc <- get_mc_egc(dataset(), metacells = colnames(mat()))
markers_df <- calc_marker_genes(mc_egc, genes_per_metacell = 20)
} else {
markers_df <- metacell_types()
}

if (!is.null(input$use_markers) && input$use_markers) {
new_markers_df <- get_marker_genes(dataset(), mode = "Markers")
} else {
new_markers_df <- get_marker_genes(dataset(), mode = mode)
}
if (!is.null(input$selected_cell_types)) {
markers_df <- metacell_types() %>%
filter(cell_type %in% input$selected_cell_types)
} else {
markers_df <- metacell_types()
}

if (!is.null(input$use_markers) && input$use_markers) {
new_markers_df <- get_marker_genes(dataset(), mode = "Markers")
} else {
new_markers_df <- get_marker_genes(dataset(), mode = mode)
}

if (has_name(new_markers_df, "metacell") && mode != "Outliers") {
markers_df <- markers_df %>%
select(metacell) %>%
inner_join(new_markers_df, by = "metacell")
} else {
markers_df <- new_markers_df
if (has_name(new_markers_df, "metacell") && mode != "Outliers") {
markers_df <- markers_df %>%
select(metacell) %>%
inner_join(new_markers_df, by = "metacell")
} else {
markers_df <- new_markers_df
}
}

req(input$max_gene_num)
Expand Down Expand Up @@ -323,7 +328,9 @@ heatmap_reactives <- function(id, dataset, metacell_types, gene_modules, cell_ty
mode = mode,
notify_var_genes = TRUE,
metadata_order = input$metadata_order_var,
cell_type_metadata_order = input$metadata_order_cell_type_var
cell_type_metadata_order = input$metadata_order_cell_type_var,
recalc = input$mat_value == "Local",
metacells = metacell_filter()
)


Expand All @@ -339,7 +346,7 @@ heatmap_reactives <- function(id, dataset, metacell_types, gene_modules, cell_ty
}

return(m)
}) %>% bindCache(id, dataset(), metacell_types(), cell_type_colors(), markers(), gene_modules(), input$selected_cell_types, input$force_cell_type, genes(), input$show_genes, clipboard_changed(), mode, input$metadata_order_var, input$metadata_order_cell_type_var)
}) %>% bindCache(id, dataset(), metacell_types(), cell_type_colors(), markers(), gene_modules(), input$selected_cell_types, input$force_cell_type, genes(), input$show_genes, clipboard_changed(), mode, input$metadata_order_var, input$metadata_order_cell_type_var, metacell_filter(), input$mat_value)

output$download_matrix <- downloadHandler(
filename = function() {
Expand Down Expand Up @@ -375,7 +382,7 @@ heatmap_reactives <- function(id, dataset, metacell_types, gene_modules, cell_ty
)


heatmap_matrix_reactives(ns, input, output, session, dataset, metacell_types, cell_type_colors, globals, markers, lfp_range, mode)
heatmap_matrix_reactives(ns, input, output, session, dataset, metacell_types, cell_type_colors, globals, markers, lfp_range, mode, metacell_filter, mat)

output$cell_type_list <- cell_type_selector(dataset, ns, id = "selected_cell_types", label = "Cell types", selected = "all", cell_type_colors = cell_type_colors)

Expand All @@ -390,8 +397,20 @@ heatmap_reactives <- function(id, dataset, metacell_types, gene_modules, cell_ty
shinyWidgets::actionGroupButtons(ns("copy_metacells"), labels = "Copy metacells", size = "sm")
})

output$mat_value_ui <- renderUI({
shinyWidgets::radioGroupButtons(
inputId = ns("mat_value"),
label = "Enrichment type:",
choices = c("Global", "Local"),
selected = "Global",
size = "sm",
justified = TRUE
)
})

observe({
shinyjs::toggle(id = "reset_zoom_ui", condition = !is.null(metacell_filter()) && length(metacell_filter()) > 0)
shinyjs::toggle(id = "mat_value_ui", condition = (!is.null(metacell_filter()) && length(metacell_filter()) > 0) || (!is.null(input$selected_cell_types) && length(input$selected_cell_types) < nrow(cell_type_colors())))
shinyjs::toggle(id = "copy_metacells_ui", condition = !is.null(selected_metacells()) && length(selected_metacells()) > 0 && !is.null(input$brush_action) && input$brush_action == "Select")
})

Expand Down Expand Up @@ -552,7 +571,7 @@ heatmap_reactives <- function(id, dataset, metacell_types, gene_modules, cell_ty
return(structure(list(p = res$p, gtable = res$gtable), class = "gt_custom"))
},
res = 96
) %>% bindCache(id, dataset(), metacell_types(), cell_type_colors(), gene_modules(), lfp_range(), metacell_filter(), input$plot_legend, input$plot_cell_type_legend, input$plot_genes_legend, input$selected_md, markers(), input$selected_cell_types, input$force_cell_type, clipboard_changed(), input$high_color, input$low_color, input$mid_color, input$midpoint, genes(), input$show_genes, highlighted_genes(), highlight_color, input$max_gene_num, input$metadata_order_var, input$metadata_order_cell_type_var)
) %>% bindCache(id, dataset(), metacell_types(), cell_type_colors(), gene_modules(), lfp_range(), metacell_filter(), input$plot_legend, input$plot_cell_type_legend, input$plot_genes_legend, input$selected_md, markers(), input$selected_cell_types, input$force_cell_type, clipboard_changed(), input$high_color, input$low_color, input$mid_color, input$midpoint, genes(), input$show_genes, highlighted_genes(), highlight_color, input$max_gene_num, input$metadata_order_var, input$metadata_order_cell_type_var, input$mat_value)

observeEvent(input$heatmap_brush, {
req(input$brush_action)
Expand Down
21 changes: 18 additions & 3 deletions R/utils_markers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -268,7 +268,7 @@ get_markers <- function(dataset) {
return(marker_genes)
}

get_marker_matrix <- function(dataset, markers, cell_types = NULL, metacell_types = NULL, cell_type_colors = NULL, gene_modules = NULL, force_cell_type = TRUE, mode = "Markers", notify_var_genes = FALSE, metadata_order = NULL, cell_type_metadata_order = NULL) {
get_marker_matrix <- function(dataset, markers, cell_types = NULL, metacell_types = NULL, cell_type_colors = NULL, gene_modules = NULL, force_cell_type = TRUE, mode = "Markers", notify_var_genes = FALSE, metadata_order = NULL, cell_type_metadata_order = NULL, recalc = FALSE, metacells = NULL) {
cached_dist <- NULL
if (mode == "Inner") {
mc_fp <- get_mc_data(dataset, "inner_fold_mat")
Expand All @@ -292,11 +292,26 @@ get_marker_matrix <- function(dataset, markers, cell_types = NULL, metacell_type
epsilon <- 1e-5
log_transform <- FALSE
} else if (mode == "Markers") {
mc_fp <- get_mc_fp(dataset, markers)
if (recalc) {
if (!is.null(cell_types)) {
ct_metacells <- metacell_types %>%
filter(cell_type %in% cell_types) %>%
pull(metacell)
if (!is.null(metacells)) {
metacells <- intersect(metacells, ct_metacells)
} else {
metacells <- ct_metacells
}
}
mc_fp <- get_mc_fp(dataset, markers, metacells = metacells)
} else {
mc_fp <- get_mc_fp(dataset, markers)
}

epsilon <- 0
log_transform <- TRUE
default_markers <- get_mc_data(dataset, "default_markers")
if (!is.null(default_markers) && all(markers %in% default_markers)) {
if (!is.null(default_markers) && all(markers %in% default_markers) && is.null(metacells)) {
cached_dist <- get_mc_data(dataset, "default_markers_dist")
}
} else if (mode == "Gene modules") {
Expand Down

0 comments on commit c0515dc

Please sign in to comment.