Add framework for progress information

R/analyze.R

@@ -31,18 +31,23 @@ preset <- function(methods, species, genes, reference_genes) {
 #' Analyze by applying the specified 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
 #'   (`gene` column). The additional columns contain the resulting scores per
 #'   method and are named after the method IDs.
 #'
 #' @export
-analyze <- function(preset) {
+analyze <- function(preset, progress = NULL) {
     # Available methods by ID.
     #
     # 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
-    # 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:
     #
@@ -55,10 +60,21 @@ analyze <- function(preset) {
         "neural" = neural
     )
 
+    total_progress <- 0.0
+    method_count <- length(preset$method_ids)
     results <- data.table(gene = genes$id)
 
     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)
 
         results <- merge(
@@ -66,6 +82,12 @@ analyze <- function(preset) {
             method_results,
             by = "gene"
         )
+
+        total_progress <- total_progress + 1 / method_count
+    }
+
+    if (!is.null(progress)) {
+        progress(1.0)
     }
 
     results

R/clusteriness.R

@@ -36,7 +36,7 @@ clusteriness_priv <- function(data, height = 1000000) {
 }
 
 # Process genes clustering their distance to telomeres.
-clusteriness <- function(distances, preset) {
+clusteriness <- function(distances, preset, progress = NULL) {
     results <- data.table(gene = preset$gene_ids)
 
     # Prefilter the input data by species.
@@ -45,9 +45,19 @@ clusteriness <- function(distances, preset) {
     # Add an index for quickly accessing data per gene.
     setkey(distances, gene)
 
+    genes_done <- 0
+    genes_total <- length(preset$gene_ids)
+
     # Perform the cluster analysis for one gene.
     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)]

R/correlation.R

@@ -1,6 +1,6 @@
 # Compute the mean correlation coefficient comparing gene distances with a set
 # of reference genes.
-correlation <- function(distances, preset) {
+correlation <- function(distances, preset, progress = NULL) {
     results <- data.table(gene = preset$gene_ids)
     reference_gene_ids <- preset$reference_gene_ids
     reference_count <- length(reference_gene_ids)
@@ -14,6 +14,9 @@ correlation <- function(distances, preset) {
     # Prepare the reference genes' data.
     reference_distances <- distances[gene %chin% reference_gene_ids]
 
+    genes_done <- 0
+    genes_total <- length(preset$gene_ids)
+
     # Perform the correlation for one gene.
     compute <- function(gene_id) {
         gene_distances <- distances[gene_id]
@@ -29,7 +32,7 @@ correlation <- function(distances, preset) {
 
         # Correlate with all reference genes but not with the gene itself.
         for (reference_gene_id in
-             reference_gene_ids[reference_gene_ids != gene_id]) {
+            reference_gene_ids[reference_gene_ids != gene_id]) {
             data <- merge(
                 gene_distances,
                 reference_distances[reference_gene_id],
@@ -55,6 +58,13 @@ correlation <- function(distances, preset) {
 
         # Compute the score as the mean correlation coefficient.
         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)]

R/neural.R

@@ -1,7 +1,7 @@
 # Find genes by training a neural network on reference position data.
 #
 # @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
     reference_gene_ids <- preset$reference_gene_ids
 
@@ -89,8 +89,20 @@ neural <- function(distances, preset, seed = 448077) {
         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]
+
+    if (!is.null(progress)) {
+        # See above.
+        progress(1.0)
+    }
+
     data[, .(gene, score)]
 }

R/proximity.R

@@ -2,7 +2,7 @@
 #
 # 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.
-proximity <- function(distances, preset) {
+proximity <- function(distances, preset, progress = NULL) {
     # Prefilter distances by species and gene.
     distances <- distances[
         species %chin% preset$species_ids & gene %chin% preset$gene_ids
@@ -14,5 +14,12 @@ proximity <- function(distances, preset) {
     max_distance <- distances[, max(mean_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)]
 }

man/analyze.Rd

@@ -4,10 +4,14 @@
 \alias{analyze}
 \title{Analyze by applying the specified preset.}
 \usage{
-analyze(preset)
+analyze(preset, progress = NULL)
 }
 \arguments{
 \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{
 A \link{data.table} with one row for each gene identified by it's ID