mirror of
https://github.com/johrpan/geposan.git
synced 2025-10-26 18:57:25 +01:00
Add framework for progress information
This commit is contained in:
parent
16e83d38a8
commit
37f468658c
6 changed files with 76 additions and 11 deletions
28
R/analyze.R
28
R/analyze.R
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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)]
|
||||||
|
|
|
||||||
|
|
@ -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)]
|
||||||
|
|
|
||||||
16
R/neural.R
16
R/neural.R
|
|
@ -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)]
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -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)]
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue