Add framework for progress information

This commit is contained in:
Elias Projahn 2021-10-19 15:03:10 +02:00
parent 16e83d38a8
commit 37f468658c
6 changed files with 76 additions and 11 deletions

View file

@ -31,18 +31,23 @@ preset <- function(methods, species, genes, reference_genes) {
#' Analyze by applying the specified preset. #' Analyze by applying the specified preset.
#' #'
#' @param preset The preset to use which can be created using [preset()]. #' @param preset The preset to use which can be created using [preset()].
#' @param progress A function to be called for progress information. The
#' function should accept a number between 0.0 and 1.0 for the current
#' progress.
#' #'
#' @return A [data.table] with one row for each gene identified by it's ID #' @return A [data.table] with one row for each gene identified by it's ID
#' (`gene` column). The additional columns contain the resulting scores per #' (`gene` column). The additional columns contain the resulting scores per
#' method and are named after the method IDs. #' method and are named after the method IDs.
#' #'
#' @export #' @export
analyze <- function(preset) { analyze <- function(preset, progress = NULL) {
# Available methods by ID. # Available methods by ID.
# #
# A method describes a way to perform a computation on gene distance data # A method describes a way to perform a computation on gene distance data
# that results in a single score per gene. The function should accept the # that results in a single score per gene. The function should accept the
# preset to apply as a single parameter (see [preset()]). # distances data, the preset to apply (see [preset()]) and an optional
# progress function (that may be called with a number between 0.0 and 1.0)
# as its parameters.
# #
# The function should return a [data.table] with the following columns: # The function should return a [data.table] with the following columns:
# #
@ -55,10 +60,21 @@ analyze <- function(preset) {
"neural" = neural "neural" = neural
) )
total_progress <- 0.0
method_count <- length(preset$method_ids)
results <- data.table(gene = genes$id) results <- data.table(gene = genes$id)
for (method_id in preset$method_ids) { for (method_id in preset$method_ids) {
method_results <- methods[[method_id]](distances, preset) method_progress <- if (!is.null(progress)) function(p) {
progress(total_progress + p / method_count)
}
method_results <- methods[[method_id]](
distances,
preset,
method_progress
)
setnames(method_results, "score", method_id) setnames(method_results, "score", method_id)
results <- merge( results <- merge(
@ -66,6 +82,12 @@ analyze <- function(preset) {
method_results, method_results,
by = "gene" by = "gene"
) )
total_progress <- total_progress + 1 / method_count
}
if (!is.null(progress)) {
progress(1.0)
} }
results results

View file

@ -36,7 +36,7 @@ clusteriness_priv <- function(data, height = 1000000) {
} }
# Process genes clustering their distance to telomeres. # Process genes clustering their distance to telomeres.
clusteriness <- function(distances, preset) { clusteriness <- function(distances, preset, progress = NULL) {
results <- data.table(gene = preset$gene_ids) results <- data.table(gene = preset$gene_ids)
# Prefilter the input data by species. # Prefilter the input data by species.
@ -45,9 +45,19 @@ clusteriness <- function(distances, preset) {
# Add an index for quickly accessing data per gene. # Add an index for quickly accessing data per gene.
setkey(distances, gene) setkey(distances, gene)
genes_done <- 0
genes_total <- length(preset$gene_ids)
# Perform the cluster analysis for one gene. # Perform the cluster analysis for one gene.
compute <- function(gene_id) { compute <- function(gene_id) {
clusteriness_priv(distances[gene_id, distance]) score <- clusteriness_priv(distances[gene_id, distance])
if (!is.null(progress)) {
genes_done <<- genes_done + 1
progress(genes_done / genes_total)
}
score
} }
results[, score := compute(gene), by = 1:nrow(results)] results[, score := compute(gene), by = 1:nrow(results)]

View file

@ -1,6 +1,6 @@
# Compute the mean correlation coefficient comparing gene distances with a set # Compute the mean correlation coefficient comparing gene distances with a set
# of reference genes. # of reference genes.
correlation <- function(distances, preset) { correlation <- function(distances, preset, progress = NULL) {
results <- data.table(gene = preset$gene_ids) results <- data.table(gene = preset$gene_ids)
reference_gene_ids <- preset$reference_gene_ids reference_gene_ids <- preset$reference_gene_ids
reference_count <- length(reference_gene_ids) reference_count <- length(reference_gene_ids)
@ -14,6 +14,9 @@ correlation <- function(distances, preset) {
# Prepare the reference genes' data. # Prepare the reference genes' data.
reference_distances <- distances[gene %chin% reference_gene_ids] reference_distances <- distances[gene %chin% reference_gene_ids]
genes_done <- 0
genes_total <- length(preset$gene_ids)
# Perform the correlation for one gene. # Perform the correlation for one gene.
compute <- function(gene_id) { compute <- function(gene_id) {
gene_distances <- distances[gene_id] gene_distances <- distances[gene_id]
@ -55,6 +58,13 @@ correlation <- function(distances, preset) {
# Compute the score as the mean correlation coefficient. # Compute the score as the mean correlation coefficient.
score <- correlation_sum / reference_count score <- correlation_sum / reference_count
if (!is.null(progress)) {
genes_done <<- genes_done + 1
progress(genes_done / genes_total)
}
score
} }
results[, score := compute(gene), by = 1:nrow(results)] results[, score := compute(gene), by = 1:nrow(results)]

View file

@ -1,7 +1,7 @@
# Find genes by training a neural network on reference position data. # Find genes by training a neural network on reference position data.
# #
# @param seed A seed to get reproducible results. # @param seed A seed to get reproducible results.
neural <- function(distances, preset, seed = 448077) { neural <- function(distances, preset, progress = NULL, seed = 448077) {
species_ids <- preset$species_ids species_ids <- preset$species_ids
reference_gene_ids <- preset$reference_gene_ids reference_gene_ids <- preset$reference_gene_ids
@ -89,8 +89,20 @@ neural <- function(distances, preset, seed = 448077) {
linear.output = FALSE linear.output = FALSE
) )
# Return the resulting scores given by applying the neural network. if (!is.null(progress)) {
# We do everything in one go, so it's not possible to report detailed
# progress information. As the method is relatively quick, this should
# not be a problem.
progress(0.5)
}
# Apply the neural network.
data[, score := neuralnet::compute(nn, data)$net.result] data[, score := neuralnet::compute(nn, data)$net.result]
if (!is.null(progress)) {
# See above.
progress(1.0)
}
data[, .(gene, score)] data[, .(gene, score)]
} }

View file

@ -2,7 +2,7 @@
# #
# A score will be given to each gene such that 0.0 corresponds to the maximal # A score will be given to each gene such that 0.0 corresponds to the maximal
# mean distance across all genes and 1.0 corresponds to a distance of 0. # mean distance across all genes and 1.0 corresponds to a distance of 0.
proximity <- function(distances, preset) { proximity <- function(distances, preset, progress = NULL) {
# Prefilter distances by species and gene. # Prefilter distances by species and gene.
distances <- distances[ distances <- distances[
species %chin% preset$species_ids & gene %chin% preset$gene_ids species %chin% preset$species_ids & gene %chin% preset$gene_ids
@ -14,5 +14,12 @@ proximity <- function(distances, preset) {
max_distance <- distances[, max(mean_distance)] max_distance <- distances[, max(mean_distance)]
distances[, score := 1 - mean_distance / max_distance] distances[, score := 1 - mean_distance / max_distance]
if (!is.null(progress)) {
# We do everything in one go, so it's not possible to report detailed
# progress information. As the method is relatively quick, this should
# not be a problem.
progress(1.0)
}
distances[, .(gene, score)] distances[, .(gene, score)]
} }

View file

@ -4,10 +4,14 @@
\alias{analyze} \alias{analyze}
\title{Analyze by applying the specified preset.} \title{Analyze by applying the specified preset.}
\usage{ \usage{
analyze(preset) analyze(preset, progress = NULL)
} }
\arguments{ \arguments{
\item{preset}{The preset to use which can be created using \code{\link[=preset]{preset()}}.} \item{preset}{The preset to use which can be created using \code{\link[=preset]{preset()}}.}
\item{progress}{A function to be called for progress information. The
function should accept a number between 0.0 and 1.0 for the current
progress.}
} }
\value{ \value{
A \link{data.table} with one row for each gene identified by it's ID A \link{data.table} with one row for each gene identified by it's ID