Adapt to geposan changes and add new methods

This commit is contained in:
Elias Projahn 2021-11-14 22:34:46 +01:00
parent 9709360d45
commit f485eadaf5
4 changed files with 61 additions and 49 deletions

View file

@ -71,13 +71,23 @@ genes <- geposan::genes[, .(
methods <- list( methods <- list(
list( list(
id = "clusteriness", id = "clusteriness",
name = "Clustering", name = "Clustering (distances)",
description = "Clustering of genes" description = "Clustering of genes (distances)"
),
list(
id = "clusteriness_positions",
name = "Clustering (positions)",
description = "Clustering of genes (positions)"
), ),
list( list(
id = "correlation", id = "correlation",
name = "Correlation", name = "Correlation (distances)",
description = "Correlation with known genes" description = "Correlation with known genes (distances)"
),
list(
id = "correlation_positions",
name = "Correlation (positions)",
description = "Correlation with known genes (positions)"
), ),
list( list(
id = "proximity", id = "proximity",
@ -91,6 +101,12 @@ methods <- list(
) )
) )
# IDs of methods for geposan.
method_ids <- sapply(methods, function(method) method$id)
# Names of methods for geposan.
method_names <- sapply(methods, function(method) method$name)
# Gene IDs of known or suggested TPE-OLD genes. # Gene IDs of known or suggested TPE-OLD genes.
genes_tpe_old <- genes[suggested | verified == TRUE, id] genes_tpe_old <- genes[suggested | verified == TRUE, id]
@ -99,17 +115,17 @@ species_replicative <- species[replicative == TRUE, id]
# Preset for [geposan] including all species and TPE-OLD genes for reference. # Preset for [geposan] including all species and TPE-OLD genes for reference.
preset_all_species <- geposan::preset( preset_all_species <- geposan::preset(
methods = c("clusteriness", "correlation", "proximity", "neural"), methods = method_ids,
species = species$id, species_ids = species$id,
genes = genes$id, gene_ids = genes$id,
reference_genes = genes_tpe_old reference_gene_ids = genes_tpe_old
) )
# Preset for [geposan] including only replicatively aging species as well as # Preset for [geposan] including only replicatively aging species as well as
# TPE-OLD genes for reference. # TPE-OLD genes for reference.
preset_replicative_species <- geposan::preset( preset_replicative_species <- geposan::preset(
methods = c("clusteriness", "correlation", "proximity", "neural"), methods = method_ids,
species = species_replicative, species_ids = species_replicative,
genes = genes$id, gene_ids = genes$id,
reference_genes = genes_tpe_old reference_gene_ids = genes_tpe_old
) )

View file

@ -46,9 +46,11 @@ methods_ui <- function(id) {
# Construct server for the methods editor. # Construct server for the methods editor.
# #
# @param analysis The reactive containing the results to be weighted. # @param analysis The reactive containing the results to be weighted.
# @param min_n_species A reactive containing the minimum number of species to
# require for genes to be included in the ranking.
# #
# @return A reactive containing the weighted results. # @return A reactive containing the weighted results.
methods_server <- function(id, analysis) { methods_server <- function(id, analysis, min_n_species) {
moduleServer(id, function(input, output, session) { moduleServer(id, function(input, output, session) {
observeEvent(input$optimize_button, { observeEvent(input$optimize_button, {
method_ids <- NULL method_ids <- NULL
@ -60,11 +62,12 @@ methods_server <- function(id, analysis) {
} }
} }
weights <- geposan::optimize_weights( weights <- geposan::optimal_weights(
analysis(), analysis(),
method_ids, method_ids,
genes_tpe_old, genes_tpe_old,
target = input$target target = input$target,
min_n_species = min_n_species()
) )
for (method_id in method_ids) { for (method_id in method_ids) {
@ -95,7 +98,11 @@ methods_server <- function(id, analysis) {
} }
} }
geposan::ranking(analysis(), weights) geposan::ranking(
analysis(),
weights,
min_n_species = min_n_species()
)
}) })
}) })
} }

View file

@ -82,15 +82,10 @@ preset_editor_server <- function(id) {
observeEvent(input$apply_button, { observeEvent(input$apply_button, {
result(geposan::preset( result(geposan::preset(
methods <- c( methods = method_ids,
"clusteriness", species_ids = input$species,
"correlation", gene_ids = genes$id,
"proximity", reference_gene_ids = input$reference_genes
"neural"
),
species = input$species,
genes = genes$id,
reference_genes = input$reference_genes
)) ))
}) })

View file

@ -24,45 +24,39 @@ server <- function(input, output, session) {
preset <- preset() preset <- preset()
# Perform the analysis cached based on the preset's hash. # Perform the analysis cached based on the preset's hash.
results <- withProgress( analysis <- withProgress(
message = "Analyzing genes", message = "Analyzing genes",
value = 0.0, { value = 0.0,
{ # nolint
geposan::analyze(preset, function(progress) { geposan::analyze(preset, function(progress) {
setProgress(progress) setProgress(progress)
}) })
} }
) )
# Add all gene information to the results. analysis
results <- merge(
results,
genes,
by.x = "gene",
by.y = "id"
)
# Count included species from the preset per gene.
genes_n_species <- geposan::distances[
species %chin% preset$species_ids,
.(n_species = .N),
by = "gene"
]
setkey(genes_n_species, gene)
# Exclude genes with too few species.
results[genes_n_species[gene, n_species] >= input$n_species]
}) })
min_n_species <- reactive(input$n_species)
# Rank the results. # Rank the results.
results <- methods_server("methods", analysis) ranking <- methods_server("methods", analysis, min_n_species)
# Add gene information to the results.
results <- reactive({
merge(
ranking(),
geposan::genes,
by.x = "gene",
by.y = "id",
sort = FALSE
)
})
# Apply the filters. # Apply the filters.
results_filtered <- filters_server("filters", results) results_filtered <- filters_server("filters", results)
output$genes <- DT::renderDT({ output$genes <- DT::renderDT({
method_ids <- sapply(methods, function(method) method$id)
method_names <- sapply(methods, function(method) method$name)
columns <- c("rank", "gene", "name", "chromosome", method_ids, "score") columns <- c("rank", "gene", "name", "chromosome", method_ids, "score")
column_names <- c("", "Gene", "", "Chromosome", method_names, "Score") column_names <- c("", "Gene", "", "Chromosome", method_names, "Score")