Add experimental neural network

init.R

@@ -1,6 +1,7 @@
 source("clustering.R")
 source("correlation.R")
 source("input.R")
+source("neural.R")
 source("util.R")
 
 # Load input data
@@ -56,6 +57,24 @@ correlation_replicative <- run_cached(
     tpe_old_genes
 )
 
+neural_all <- run_cached(
+    "neural_all",
+    process_neural,
+    distances,
+    all_species,
+    all_genes,
+    tpe_old_genes
+)
+
+neural_replicative <- run_cached(
+    "neural_replicative",
+    process_neural,
+    distances,
+    replicative_species,
+    all_genes,
+    tpe_old_genes
+)
+
 # Merge processed data as well as gene information.
 
 results_all <- merge(
@@ -72,6 +91,13 @@ results_all <- merge(
     by.y = "gene"
 )
 
+results_all <- merge(
+    results_all,
+    neural_all,
+    by.x = "id",
+    by.y = "gene"
+)
+
 results_replicative <- merge(
     genes,
     clustering_replicative,
@@ -86,6 +112,13 @@ results_replicative <- merge(
     by.y = "gene"
 )
 
+results_replicative <- merge(
+    results_replicative,
+    neural_replicative,
+    by.x = "id",
+    by.y = "gene"
+)
+
 # Rename `id` columns to `gene`.
 
 setnames(results_all, "id", "gene")

neural.R

@@ -0,0 +1,110 @@
+library(data.table)
+library(neuralnet)
+
+#' Find genes by training a neural network on reference position data.
+#'
+#' The result will be a data.table with the following columns:
+#'
+#'  - `gene` Gene ID of the processed gene.
+#'  - `neural` Output score given by the neural network.
+#'
+#' @param distances Distance data to use.
+#' @param species_ids Species, whose data should be included.
+#' @param gene_ids Genes to process. This should include the reference genes.
+#' @param reference_gene_ids Genes to compare to.
+#' @param seed A seed to get reproducible results.
+process_neural <- function(distances, species_ids, gene_ids,
+                           reference_gene_ids, seed = 726839) {
+    set.seed(seed)
+    gene_count <- length(gene_ids)
+
+    # Prefilter distances by species.
+    distances <- 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 = 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.
+    species_ids_included <- NULL
+
+    for (species_id in species_ids) {
+        # Make a column specific to this species.
+
+        species_distances <- distances[species == species_id, .(gene, distance)]
+        setnames(species_distances, "distance", species_id)
+
+        # Only include species with at least 25% known values.
+
+        species_distances <- na.omit(species_distances)
+
+        if (nrow(species_distances) >= 0.25 * gene_count) {
+            species_ids_included <- append(species_ids_included, species_id)
+            data <- merge(data, species_distances, all = 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.
+    for (species_id in species_ids_included) {
+        mean_value <- data[, mean(get(species_id), na.rm = TRUE)]
+
+        data[
+            is.na(get(species_id)),
+            eval(quote(species_id)) := round(mean_value)
+        ]
+    }
+
+    # Extract the reference genes.
+
+    reference_data <- data[gene %chin% reference_gene_ids]
+    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.
+
+    without_reference_data <- data[!gene %chin% reference_gene_ids]
+
+    reference_samples <- without_reference_data[
+        sample(
+            nrow(without_reference_data),
+            nrow(reference_data)
+        )
+    ]
+
+    reference_samples[, neural := 0.0]
+
+    # Merge training data. The training data includes all reference genes as
+    # well as an equal number of random sample genes.
+    training_data <- rbindlist(list(reference_data, reference_samples))
+
+    # Construct and train the neural network.
+
+    nn_formula <- as.formula(sprintf(
+        "neural~%s",
+        paste(species_ids_included, collapse = "+")
+    ))
+
+    layer1 <- length(species_ids_included) * 0.66
+    layer2 <- layer1 * 0.66
+    layer3 <- layer2 * 0.66
+
+    nn <- neuralnet(
+        nn_formula,
+        training_data,
+        hidden = c(layer1, layer2, layer3),
+        linear.output = FALSE
+    )
+
+    # Return the resulting scores given by applying the neural network.
+
+    data[, neural := compute(nn, data)$net.result]
+    data[, .(gene, neural)]
+}

server.R

@@ -30,12 +30,14 @@ server <- function(input, output) {
 
         clusteriness_weight <- input$clusteriness / 100
         correlation_weight <- input$correlation / 100
-        total_weight <- clusteriness_weight + correlation_weight
+        neural_weight <- input$neural / 100
+        total_weight <- clusteriness_weight + correlation_weight + neural_weight
         clusteriness_factor <- clusteriness_weight / total_weight
         correlation_factor <- correlation_weight / total_weight
+        neural_factor <- neural_weight / total_weight
 
         results[, score := clusteriness_factor * clusteriness +
-            correlation_factor * r_mean]
+            correlation_factor * r_mean + neural_factor * neural]
 
         # Apply the cut-off score.
 
@@ -55,6 +57,7 @@ server <- function(input, output) {
                 name,
                 clusteriness,
                 r_mean,
+                neural,
                 score
             )],
             rownames = FALSE,
@@ -64,6 +67,7 @@ server <- function(input, output) {
                 "",
                 "Clusters",
                 "Correlation",
+                "Neural",
                 "Score"
             ),
             style = "bootstrap",
@@ -73,7 +77,11 @@ server <- function(input, output) {
             )
         )
 
-        formatPercentage(dt, c("clusteriness", "r_mean", "score"), digits = 1)
+        formatPercentage(
+            dt,
+            c("clusteriness", "r_mean", "neural", "score"),
+            digits = 1
+        )
     })
 
     output$synposis <- renderText({

ui.R

@@ -36,6 +36,15 @@ ui <- fluidPage(
                 step = 1,
                 value = 100
             ),
+            sliderInput(
+                "neural",
+                "Assessment by neural network",
+                post = "%",
+                min = 0,
+                max = 100,
+                step = 1,
+                value = 100
+            ),
             sliderInput(
                 "cutoff",
                 "Cut-off score",