Skip to content

Commit

Permalink
Fix@recalc umap additions (#145)
Browse files Browse the repository at this point in the history 
* Added a reset button for 2D projection

* Added update_2d_projection function

* Added loading of layout and graph to the manifold tab

* Added separating lines
  • Loading branch information
@aviezerl
aviezerl authored Jul 6, 2023
1 parent 8081ddd commit 01ef8d8
Show file tree
Hide file tree
Showing 6 changed files with 233 additions and 50 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ export(import_dataset)
export(import_dataset_metacell1)
export(print.gt_custom)
export(run_app)
export(update_2d_projection)
export(update_cell_type_colors)
export(update_gene_modules)
export(update_metacell_types)
Expand Down
39 changes: 8 additions & 31 deletions R/import.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,8 @@
#' @param umap_config a named list with UMAP configuration. See \code{umap::umap} for more details. When NULL, the default configuration would be used, except for: min_dist=0.96, n_neighbors=10, n_epoch=500.
#' @param min_umap_log_expr minimal log2 expression for genes to use for UMAP calculation.
#' @param genes_per_anchor number of genes to use for each umap anchor.
#' @param layout a data frame with a column named "metacell" with the metacell id and other columns with the x and y coordinates of the metacell. If NULL, the layout would be taken from the anndata object.
#' @param default_graph a data frame with a column named "from", "to" and "weight" with the ids of the metacells and the weight of the edge. If NULL, the graph would be taken from the anndata object.
#'
#' @return invisibly returns an \code{AnnDataR6} object of the read \code{anndata_file}
#'
Expand Down Expand Up @@ -114,6 +116,8 @@ import_dataset <- function(project,
umap_config = NULL,
min_umap_log_expr = -14,
genes_per_anchor = 30,
layout = NULL,
default_graph = NULL,
...) {
verbose <- !is.null(getOption("MCView.verbose")) && getOption("MCView.verbose")
verify_project_dir(project, create = TRUE, atlas = !is.null(atlas_project), ...)
Expand Down Expand Up @@ -193,38 +197,11 @@ import_dataset <- function(project,
}

cli_alert_info("Processing 2d projection")
mc2d_list <- NULL
if (!is.null(umap_anchors)) {
mc2d_list <- compute_umap(mc_egc, umap_anchors, min_log_expr = min_umap_log_expr, config = umap_config, genes_per_anchor = genes_per_anchor)
if (!is.null(mc2d_list)) {
serialize_shiny_data(umap_anchors, "umap_anchors", dataset = dataset, cache_dir = cache_dir)
}
}

if (is.null(mc2d_list)) {
if (is.null(adata$obsp$obs_outgoing_weights)) {
cli_abort_compute_for_mcview("$obsp$obs_outgoing_weights")
}
graph <- Matrix::summary(adata$obsp$obs_outgoing_weights) %>%
as.data.frame()

graph <- graph %>% mutate(i = rownames(adata$obs)[i], j = rownames(adata$obs)[j])

purrr::walk(c("x", "y"), ~ {
if (is.null(adata$obs[[.x]])) {
cli_abort_compute_for_mcview(glue("$obs${.x}"))
}
})

mc2d_list <- list(
graph = tibble(mc1 = graph[, 1], mc2 = graph[, 2], weight = graph[, 3]),
mc_id = rownames(adata$obs),
mc_x = adata$obs %>% select(umap_x = x) %>% tibble::rownames_to_column("mc") %>% tibble::deframe(),
mc_y = adata$obs %>% select(umap_y = y) %>% tibble::rownames_to_column("mc") %>% tibble::deframe()
)
if (!is.null(layout) && !is.null(default_graph)) {
update_2d_projection(project, dataset, layout, default_graph)
} else {
load_default_2d_projection(project, dataset, adata, mc_egc, umap_anchors, min_umap_log_expr, umap_config, genes_per_anchor)
}
serialize_shiny_data(mc2d_list, "mc2d", dataset = dataset, cache_dir = cache_dir)


if (!is.null(metacell_graphs)) {
cli_alert_info("Processing metacell graphs")
Expand Down
98 changes: 79 additions & 19 deletions R/mod_manifold.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,8 @@ mod_manifold_sidebar_ui <- function(id) {
list(
uiOutput(ns("top_correlated_select_color_proj")),
shinyWidgets::actionGroupButtons(ns("recompute"), labels = "Recompute 2D projection", size = "sm"),
shinyWidgets::actionGroupButtons(ns("reset"), labels = "Restore default", size = "sm"),
tags$hr(),
uiOutput(ns("add_genes_ui")),
selectInput(
ns("selected_anchor_genes"),
Expand All @@ -58,13 +60,42 @@ mod_manifold_sidebar_ui <- function(id) {
".tsv"
)
),
tags$hr(),
numericInput(ns("genes_per_anchor"), "Genes per anchor", value = 30, min = 1, max = 100, step = 1),
numericInput(ns("n_neighbors"), "Number of neighbors", value = 10, min = 1, max = 100, step = 1),
numericInput(ns("min_dist"), "Minimum distance", value = 0.96, min = 0, max = 1, step = 0.01),
numericInput(ns("n_epoch"), "Number of epochs", value = 500, min = 1, max = 10000, step = 1),
numericInput(ns("min_log_expr"), "Minimum log expression", value = -14, min = -50, max = 0, step = 0.1),
downloadButton(ns("download_projection"), "Download 2D positions", align = "center", style = "margin: 5px 5px 5px 15px; "),
downloadButton(ns("download_graph"), "Download edges", align = "center", style = "margin: 5px 5px 5px 15px; ")
tags$hr(),
downloadButton(ns("download_projection"), "Download 2D layout", align = "center", style = "margin: 5px 5px 5px 15px; "),
fileInput(ns("load_projection"),
label = NULL,
buttonLabel = "Load 2D layout",
multiple = FALSE,
accept =
c(
"text/csv",
"text/comma-separated-values,text/plain",
"text/tab-separated-values",
".csv",
".tsv"
)
),
tags$hr(),
downloadButton(ns("download_graph"), "Download graph", align = "center", style = "margin: 5px 5px 5px 15px; "),
fileInput(ns("load_graph"),
label = NULL,
buttonLabel = "Load graph",
multiple = FALSE,
accept =
c(
"text/csv",
"text/comma-separated-values,text/plain",
"text/tab-separated-values",
".csv",
".tsv"
)
)
)
)
}
Expand Down Expand Up @@ -98,6 +129,10 @@ mod_manifold_server <- function(id, dataset, metacell_types, cell_type_colors, g
globals$mc2d <- mc2d
})

observeEvent(input$reset, {
globals$mc2d <- get_mc_data(dataset(), "mc2d")
})

observe({
updateSelectInput(session, "selected_anchor_genes", choices = globals$anchor_genes)
})
Expand Down Expand Up @@ -137,9 +172,26 @@ mod_manifold_server <- function(id, dataset, metacell_types, cell_type_colors, g
}
)

observeEvent(input$load_genes, {
req(input$load_genes)
req(input$load_genes$datapath)
req(file.exists(input$load_genes$datapath))
new_anchors <- fread(input$load_genes$datapath, header = FALSE)[, 1]

# check if all genes are present in the dataset
unknown_genes <- setdiff(new_anchors, gene_names(dataset()))
if (length(unknown_genes) > 0) {
showNotification(paste0("Unknown genes: ", paste(unknown_genes, collapse = ", ")), type = "error")
new_anchors <- setdiff(new_anchors, unknown_genes)
}

req(length(new_anchors) > 0)
globals$anchor_genes <- new_anchors
})

output$download_projection <- downloadHandler(
filename = function() {
paste0("projection_", dataset(), "_", Sys.Date(), ".csv")
paste0("2d_layout_", dataset(), "_", Sys.Date(), ".csv")
},
content = function(file) {
mc2d <- globals$mc2d
Expand All @@ -148,32 +200,40 @@ mod_manifold_server <- function(id, dataset, metacell_types, cell_type_colors, g
}
)

observeEvent(input$load_projection, {
req(input$load_projection)
req(input$load_projection$datapath)
mc2d <- layout_and_graph_to_mc2d(input$load_projection$datapath, globals$mc2d$graph %>% rename(from = mc1, to = mc2), metacells = get_metacell_ids(project, dataset()), warn_function = function(msg) {
showNotification(msg, type = "error")
}, error_function = function(msg) {
showNotification(msg, type = "error")
})
req(mc2d)
globals$mc2d <- mc2d
})


output$download_graph <- downloadHandler(
filename = function() {
paste0("graph_", dataset(), "_", Sys.Date(), ".csv")
},
content = function(file) {
mc2d <- globals$mc2d
req(mc2d)
fwrite(mc2d$graph, file, row.names = FALSE)
fwrite(mc2d$graph %>% rename(from = mc1, to = mc2), file, row.names = FALSE)
}
)

observeEvent(input$load_genes, {
req(input$load_genes)
req(input$load_genes$datapath)
req(file.exists(input$load_genes$datapath))
new_anchors <- fread(input$load_genes$datapath, header = FALSE)[, 1]

# check if all genes are present in the dataset
unknown_genes <- setdiff(new_anchors, gene_names(dataset()))
if (length(unknown_genes) > 0) {
showNotification(paste0("Unknown genes: ", paste(unknown_genes, collapse = ", ")), type = "error")
new_anchors <- setdiff(new_anchors, unknown_genes)
}

req(length(new_anchors) > 0)
globals$anchor_genes <- new_anchors
observeEvent(input$load_graph, {
req(input$load_graph)
req(input$load_graph$datapath)
mc2d <- layout_and_graph_to_mc2d(mc2d_to_df(globals$mc2d), input$load_graph$datapath, metacells = get_metacell_ids(project, dataset()), warn_function = function(msg) {
showNotification(msg, type = "error")
}, error_function = function(msg) {
showNotification(msg, type = "error")
})
req(mc2d)
globals$mc2d <- mc2d
})

# Projection plots
Expand Down
119 changes: 119 additions & 0 deletions R/umap.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -72,3 +72,122 @@ compute_umap <- function(mc_egc, anchors, min_dist = 0.96, n_neighbors = 10, n_e

return(mc2d_list)
}

load_default_2d_projection <- function(project, dataset, adata, mc_egc, umap_anchors, min_umap_log_expr, umap_config, genes_per_anchor) {
cache_dir <- project_cache_dir(project)

mc2d_list <- NULL
if (!is.null(umap_anchors)) {
cli_alert_info("Computing umap 2D projection based on gene anchors")
mc2d_list <- compute_umap(mc_egc, umap_anchors, min_log_expr = min_umap_log_expr, config = umap_config, genes_per_anchor = genes_per_anchor)
if (!is.null(mc2d_list)) {
serialize_shiny_data(umap_anchors, "umap_anchors", dataset = dataset, cache_dir = cache_dir)
}
}

if (is.null(mc2d_list)) {
if (is.null(adata$obsp$obs_outgoing_weights)) {
cli_abort_compute_for_mcview("$obsp$obs_outgoing_weights")
}
cli_alert_info("Using 2D projection from anndata object")
graph <- Matrix::summary(adata$obsp$obs_outgoing_weights) %>%
as.data.frame()

graph <- graph %>% mutate(i = rownames(adata$obs)[i], j = rownames(adata$obs)[j])

purrr::walk(c("x", "y"), ~ {
if (is.null(adata$obs[[.x]])) {
cli_abort_compute_for_mcview(glue("$obs${.x}"))
}
})

mc2d_list <- list(
graph = tibble(mc1 = graph[, 1], mc2 = graph[, 2], weight = graph[, 3]),
mc_id = rownames(adata$obs),
mc_x = adata$obs %>% select(umap_x = x) %>% tibble::rownames_to_column("mc") %>% tibble::deframe(),
mc_y = adata$obs %>% select(umap_y = y) %>% tibble::rownames_to_column("mc") %>% tibble::deframe()
)
}
serialize_shiny_data(mc2d_list, "mc2d", dataset = dataset, cache_dir = cache_dir)
}


#' Update default 2D projection for a dataset
#'
#' @param layout a data frame with a column named "metacell" with the metacell id and other columns with the x and y coordinates of the metacell.
#' @param graph a data frame with a column named "from", "to" and "weight" with the ids of the metacells and the weight of the edge. If NULL, the graph would be taken from the anndata object.
#'
#' @inheritParams import_dataset
#'
#' @export
update_2d_projection <- function(project, dataset, layout, graph) {
cache_dir <- project_cache_dir(project)

cli_alert_info("Loading 2D projection for dataset {.val {dataset}}")

metacells <- get_metacell_ids(project, dataset)

mc2d_list <- layout_and_graph_to_mc2d(layout, graph, metacells)

serialize_shiny_data(mc2d_list, "mc2d", dataset = dataset, cache_dir = cache_dir)
}

layout_and_graph_to_mc2d <- function(layout, graph, metacells, warn_function = cli_warn, error_function = cli_abort) {
if (is.character(layout)) {
cli_alert_info("Loading layout from {.val {layout}}")
layout <- fread(layout)
}

columns_ok <- purrr::map_lgl(c("metacell", "x", "y"), ~ {
if (!(.x %in% colnames(layout))) {
error_function(glue("Column {.x} not found in layout"))
return(FALSE)
}
return(TRUE)
})
if (any(!columns_ok)) {
return(NULL)
}

unknown_metacells <- setdiff(metacells, layout$metacell)
if (length(unknown_metacells) > 0) {
unknown_metacells <- paste(unknown_metacells, collapse = ", ")
warn_function(glue("Metacells {unknown_metacells} were not found in layout"))
}

layout <- layout %>% filter(metacell %in% metacells)

if (is.character(graph)) {
cli_alert_info("Loading graph from {.val {graph}}")
graph <- fread(graph)
}

columns_ok <- purrr::map_lgl(c("from", "to", "weight"), ~ {
if (!(.x %in% colnames(graph))) {
error_function(glue("Column {.x} not found in graph"))
return(FALSE)
}
return(TRUE)
})

if (any(!columns_ok)) {
return(NULL)
}

unknown_metacells <- c(setdiff(metacells, graph$from), setdiff(metacells, graph$to))
if (length(unknown_metacells) > 0) {
unknown_metacells <- paste(unknown_metacells, collapse = ", ")
warn_function(glue("Metacells {unknown_metacells} were not found in layout"))
}

graph <- graph %>% filter(from %in% metacells, to %in% metacells)

mc2d_list <- list(
graph = graph %>% rename(mc1 = from, mc2 = to),
mc_id = layout$metacell,
mc_x = tibble::deframe(layout[, c("metacell", "x")]),
mc_y = tibble::deframe(layout[, c("metacell", "y")])
)

return(mc2d_list)
}
6 changes: 6 additions & 0 deletions man/import_dataset.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

20 changes: 20 additions & 0 deletions man/update_2d_projection.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 01ef8d8

Please sign in to comment.