Handle caching

DESCRIPTION

@@ -22,7 +22,8 @@ Depends:
     R (>= 2.10)
 Imports:
     data.table,
-    neuralnet
+    neuralnet,
+    rlang
 Suggests:
     biomaRt,
     rlog,

R/analyze.R

@@ -59,6 +59,7 @@ analyze <- function(preset, progress = NULL) {
         "neural" = neural
     )
 
+    cached("results", preset, {
         total_progress <- 0.0
         method_count <- length(preset$method_ids)
         results <- data.table(gene = preset$gene_ids)
@@ -85,4 +86,5 @@ analyze <- function(preset, progress = NULL) {
         }
 
         results
+    })
 }

R/clusteriness.R

@@ -37,16 +37,20 @@ clusteriness_priv <- function(data, height = 1000000) {
 
 # Process genes clustering their distance to telomeres.
 clusteriness <- function(preset, progress = NULL) {
-    results <- data.table(gene = preset$gene_ids)
+    species_ids <- preset$species_ids
+    gene_ids <- preset$gene_ids
+
+    cached("clusteriness", c(species_ids, gene_ids), {
+        results <- data.table(gene = gene_ids)
 
         # Prefilter the input data by species.
-    distances <- geposan::distances[species %chin% preset$species_ids]
+        distances <- geposan::distances[species %chin% species_ids]
 
         # Add an index for quickly accessing data per gene.
         setkey(distances, gene)
 
         genes_done <- 0
-    genes_total <- length(preset$gene_ids)
+        genes_total <- length(gene_ids)
 
         # Perform the cluster analysis for one gene.
         compute <- function(gene_id) {
@@ -61,4 +65,5 @@ clusteriness <- function(preset, progress = NULL) {
         }
 
         results[, score := compute(gene), by = 1:nrow(results)]
+    })
 }

R/correlation.R

@@ -5,18 +5,23 @@ correlation <- function(preset, progress = NULL) {
     gene_ids <- preset$gene_ids
     reference_gene_ids <- preset$reference_gene_ids
 
+    cached("correlation", c(species_ids, gene_ids, reference_gene_ids), {
         # Prefilter distances by species.
         distances <- geposan::distances[species %chin% species_ids]
 
-    # Tranform data to get species as rows and genes as columns. We construct
-    # columns per species, because it requires fewer iterations, and transpose
-    # the table afterwards.
+        # Tranform data to get species as rows and genes as columns. We
+        # construct columns per species, because it requires fewer iterations,
+        # and transpose the table afterwards.
 
         data <- data.table(gene = gene_ids)
 
         # Make a column containing distance data for each species.
         for (species_id in species_ids) {
-        species_distances <- distances[species == species_id, .(gene, distance)]
+            species_distances <- distances[
+                species == species_id,
+                .(gene, distance)
+            ]
+
             data <- merge(data, species_distances, all.x = TRUE)
             setnames(data, "distance", species_id)
         }
@@ -48,10 +53,10 @@ correlation <- function(preset, progress = NULL) {
 
         if (!is.null(progress)) progress(0.66)
 
-    # Compute the final score as the mean of known correlation scores. Negative
-    # correlations will correctly lessen the score, which will be clamped to
-    # zero as its lower bound. Genes with no possible correlations at all will
-    # be assumed to have a score of 0.0.
+        # Compute the final score as the mean of known correlation scores.
+        # Negative correlations will correctly lessen the score, which will be
+        # clamped to zero as its lower bound. Genes with no possible
+        # correlations at all will be assumed to have a score of 0.0.
 
         compute_score <- function(scores) {
             score <- mean(scores, na.rm = TRUE)
@@ -70,4 +75,5 @@ correlation <- function(preset, progress = NULL) {
         ]
 
         results[, .(gene, score)]
+    })
 }

R/neural.R

@@ -3,17 +3,19 @@
 # @param seed A seed to get reproducible results.
 neural <- function(preset, progress = NULL, seed = 448077) {
     species_ids <- preset$species_ids
+    gene_ids <- preset$gene_ids
     reference_gene_ids <- preset$reference_gene_ids
 
+    cached("neural", c(species_ids, gene_ids, reference_gene_ids), {
         set.seed(seed)
-    gene_count <- length(preset$gene_ids)
+        gene_count <- length(gene_ids)
 
         # Prefilter distances by species.
         distances <- geposan::distances[species %chin% species_ids]
 
         # Input data for the network. This contains the gene ID as an identifier
         # as well as the per-species gene distances as input variables.
-    data <- data.table(gene = preset$gene_ids)
+        data <- data.table(gene = gene_ids)
 
         # Buffer to keep track of species included in the computation. Species
         # from `species_ids` may be excluded if they don't have enough data.
@@ -21,7 +23,10 @@ neural <- function(preset, progress = NULL, seed = 448077) {
 
         # Make a column containing distance data for each species.
         for (species_id in species_ids) {
-        species_distances <- distances[species == species_id, .(gene, distance)]
+            species_distances <- distances[
+                species == species_id,
+                .(gene, distance)
+            ]
 
             # Only include species with at least 25% known values.
 
@@ -31,11 +36,11 @@ neural <- function(preset, progress = NULL, seed = 448077) {
                 species_ids_included <- c(species_ids_included, species_id)
                 data <- merge(data, species_distances, all.x = TRUE)
 
-            # Replace missing data with mean values. The neural network can't
-            # handle NAs in a meaningful way. Choosing extreme values here
-            # would result in heavily biased results. Therefore, the mean value
-            # is chosen as a compromise. However, this will of course lessen the
-            # significance of the results.
+                # Replace missing data with mean values. The neural network
+                # can't handle NAs in a meaningful way. Choosing extreme values
+                # here would result in heavily biased results. Therefore, the
+                # mean value is chosen as a compromise. However, this will of
+                # course lessen the significance of the results.
 
                 mean_distance <- round(species_distances[, mean(distance)])
                 data[is.na(distance), distance := mean_distance]
@@ -51,10 +56,10 @@ neural <- function(preset, progress = NULL, seed = 448077) {
         reference_data[, neural := 1.0]
 
         # Take out random samples from the remaining genes. This is another
-    # compromise with a negative impact on significance. Because there is no
-    # information on genes with are explicitely *not* TPE-OLD genes, we have to
-    # assume that a random sample of genes has a low probability of including
-    # TPE-OLD genes.
+        # compromise with a negative impact on significance. Because there is
+        # no information on genes with are explicitely *not* TPE-OLD genes, we
+        # have to assume that a random sample of genes has a low probability of
+        # including TPE-OLD genes.
 
         without_reference_data <- data[!gene %chin% reference_gene_ids]
 
@@ -90,9 +95,9 @@ neural <- function(preset, progress = NULL, seed = 448077) {
         )
 
         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.
+            # 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)
         }
 
@@ -105,4 +110,5 @@ neural <- function(preset, progress = NULL, seed = 448077) {
         }
 
         data[, .(gene, score)]
+    })
 }

R/proximity.R

@@ -3,6 +3,10 @@
 # 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(preset, progress = NULL) {
+    species_ids <- preset$species_ids
+    gene_ids <- preset$gene_ids
+
+    cached("proximity", c(species_ids, gene_ids), {
         # Prefilter distances by species and gene.
         distances <- geposan::distances[
             species %chin% preset$species_ids & gene %chin% preset$gene_ids
@@ -15,11 +19,12 @@ proximity <- function(preset, progress = NULL) {
         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.
+            # 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)]
+    })
 }

R/utils.R

@@ -1,3 +1,34 @@
+# Cache the value of an expression on the file system.
+#
+# The expression will be evaluated if there is no matching cache file found.
+# The cache files will be located in a directory "cache" located in the current
+# working directory.
+#
+# @param name Human readable part of the cache file name.
+# @param objects A vector of objects that this expression depends on. The hash
+#   of those objects will be used for identifying the cache file.
+cached <- function(name, objects, expr) {
+    if (!dir.exists("cache")) {
+        dir.create("cache")
+    }
+
+    id <- rlang::hash(objects)
+    cache_file <- sprintf("cache/%s_%s.rda", name, id)
+
+    if (file.exists(cache_file)) {
+        # If the cache file exists, we restore the data from it.
+        load(cache_file)
+    } else {
+        # If the cache file doesn't exist, we have to do the computation.
+        data <- expr
+
+        # The results are cached for the next run.
+        save(data, file = cache_file, compress = "xz")
+    }
+
+    data
+}
+
 # This is needed to make data.table's symbols available within the package.
 #' @import data.table
 NULL