neural: Reimplement merging positions and distances

DESCRIPTION

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

R/analyze.R

@@ -40,9 +40,6 @@ analyze <- function(preset, progress = NULL) {
             correlation(..., use_positions = TRUE)
         },
         "neural" = neural,
-        "neural_positions" = function(...) {
-            neural(..., use_positions = TRUE)
-        },
         "proximity" = proximity
     )
 

R/neural.R

@@ -1,18 +1,10 @@
-# Find genes by training a neural network on reference position data.
+# Find genes by training and applying a neural network.
-#
+neural <- function(preset, progress = NULL, seed = 49641) {
-# @param seed A seed to get reproducible results.
-neural <- function(preset,
-                   use_positions = FALSE,
-                   progress = NULL,
-                   seed = 448077) {
     species_ids <- preset$species_ids
     gene_ids <- preset$gene_ids
     reference_gene_ids <- preset$reference_gene_ids
 
-    cached(
+    cached("neural", c(species_ids, gene_ids, reference_gene_ids), {
-        "neural",
-        c(species_ids, gene_ids, reference_gene_ids, use_positions),
-        { # nolint
         set.seed(seed)
         gene_count <- length(gene_ids)
 
@@ -24,31 +16,24 @@ neural <- function(preset,
         # variables.
         data <- data.table(gene = gene_ids)
 
-            # Buffer to keep track of species included in the computation.
+        # Buffer to keep track of the names of the input variables.
-            # Species from `species_ids` may be excluded if they don't have
+        input_vars <- NULL
-            # enough data.
-            species_ids_included <- NULL
 
-            # Make a column containing positions for each species.
+        # Make a columns containing positions and distances for each
+        # species.
         for (species_id in species_ids) {
-                species_data <- if (use_positions) {
+            species_data <- distances[
-                    setnames(distances[
                 species == species_id,
-                        .(gene, position)
+                .(gene, position, distance)
-                    ], "position", "distance")
-                } else {
-                    distances[
-                        species == species_id,
-                        .(gene, distance)
             ]
-                }
 
-                # Only include species with at least 25% known values.
+            # Only include species with at least 25% known values. As
+            # positions and distances always coexist, we don't loose any
+            # data here.
 
             species_data <- stats::na.omit(species_data)
 
             if (nrow(species_data) >= 0.25 * gene_count) {
-                    species_ids_included <- c(species_ids_included, species_id)
                 data <- merge(data, species_data, all.x = TRUE)
 
                 # Replace missing data with mean values. The neural network
@@ -58,18 +43,33 @@ neural <- function(preset,
                 # However, this will of course lessen the significance of
                 # the results.
 
+                mean_position <- round(species_data[, mean(position)])
                 mean_distance <- round(species_data[, mean(distance)])
-                    data[is.na(distance), distance := mean_distance]
 
-                    # Name the new column after the species.
+                data[is.na(distance), `:=`(
-                    setnames(data, "distance", species_id)
+                    position = mean_position,
+                    distance = mean_distance
+                )]
+
+                input_position <- sprintf("%s_position", species_id)
+                input_distance <- sprintf("%s_distance", species_id)
+
+                # Name the new columns after the species.
+                setnames(
+                    data,
+                    c("position", "distance"),
+                    c(input_position, input_distance)
+                )
+
+                # Add the input variables to the buffer.
+                input_vars <- c(input_vars, input_position, input_distance)
             }
         }
 
         # Extract the reference genes.
 
         reference_data <- data[gene %chin% reference_gene_ids]
-            reference_data[, neural := 1.0]
+        reference_data[, score := 1.0]
 
         # Take out random samples from the remaining genes. This is another
         # compromise with a negative impact on significance. Because there
@@ -86,61 +86,82 @@ neural <- function(preset,
             )
         ]
 
-            reference_samples[, neural := 0.0]
+        reference_samples[, score := 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.
+        # Layers for the neural network.
+        input_layer <- length(input_vars)
+        layer1 <- input_layer
+        layer2 <- 0.5 * input_layer
+        layer3 <- 0.5 * layer2
 
-            nn_formula <- stats::as.formula(sprintf(
+        # Train the model using the specified subset of the training data and
-                "neural~%s",
+        # apply it for predicting the genes.
-                paste(species_ids_included, collapse = "+")
+        apply_network <- function(training_gene_ids, gene_ids) {
-            ))
+            # Create a new model for each training session, because the model
+            # would keep its state across training sessions otherwise.
+            model <- keras::keras_model_sequential() |>
+                keras::layer_dense(
+                    units = layer1,
+                    activation = "relu",
+                    input_shape = input_layer,
+                ) |>
+                keras::layer_dense(
+                    units = layer2,
+                    activation = "relu",
+                    kernel_regularizer = keras::regularizer_l2()
+                ) |>
+                keras::layer_dense(
+                    units = layer3,
+                    activation = "relu",
+                    kernel_regularizer = keras::regularizer_l2()
+                ) |>
+                keras::layer_dense(
+                    units = 1,
+                    activation = "sigmoid"
+                ) |>
+                keras::compile(loss = "binary_crossentropy")
 
-            layer1 <- length(species_ids) * 0.66
+            # Prepare training data by filtering it to the given genes and
-            layer2 <- layer1 * 0.66
+            # converting it to a matrix.
-            layer3 <- layer2 * 0.66
+            training_data <- training_data[gene %chin% training_gene_ids]
+            training_matrix <- as.matrix(training_data[, ..input_vars])
+            colnames(training_matrix) <- NULL
+            training_matrix <- keras::normalize(training_matrix)
 
-            nn <- neuralnet::neuralnet(
+            keras::fit(
-                nn_formula,
+                model,
-                training_data,
+                x = training_matrix,
-                hidden = c(layer1, layer2, layer3),
+                y = training_data$score,
-                linear.output = FALSE
+                epochs = 300,
+                verbose = FALSE
             )
 
-            if (!is.null(progress)) {
+            # Convert the input data to a matrix.
-                progress(0.33)
+            data_matrix <- as.matrix(data[gene %chin% gene_ids, ..input_vars])
+            colnames(data_matrix) <- NULL
+            data_matrix <- keras::normalize(data_matrix)
+
+            data[gene %chin% gene_ids, score := predict(model, data_matrix)]
         }
 
-            # Apply the neural network.
+        # Apply the network to all non-training genes first.
-            data[, score := neuralnet::compute(nn, data)$net.result]
+        apply_network(
-
+            training_data$gene,
-            # Reconstruct and run the neural network for each training gene
+            gene_ids[!gene_ids %chin% training_data$gene]
-            # by training it without the respective gene.
-            for (gene_id in training_data$gene) {
-                nn <- neuralnet::neuralnet(
-                    nn_formula,
-                    training_data[gene != gene_id],
-                    hidden = c(layer1, layer2, layer3),
-                    linear.output = FALSE
         )
 
-                data[
+        # Apply the network to the training genes leaving out the gene itself.
-                    gene == gene_id,
+        for (training_gene_id in training_data$gene) {
-                    score := neuralnet::compute(
+            apply_network(
-                        nn,
+                training_data[gene != training_gene_id, gene],
-                        training_data[gene == gene_id]
+                training_gene_id
-                    )$net.result
+            )
-                ]
-            }
-
-            if (!is.null(progress)) {
-                progress(1.0)
         }
 
         data[, .(gene, score)]
-        }
+    })
-    )
 }

R/preset.R

@@ -43,7 +43,6 @@ preset <- function(methods = c(
                        "correlation",
                        "correlation_positions",
                        "neural",
-                       "neural_positions",
                        "proximity"
                    ),
                    species_ids = NULL,