Add initial controls to the explore page

R/server.R

@@ -1,41 +1,67 @@
 #' Server implementing the main user interface.
 #' @noRd
 server <- function(input, output) {
-    output$all_data <- DT::renderDataTable({
+    output$ranked_data <- DT::renderDataTable({
-        data <- ubigen::genes[, .(
+        total_weight <- abs(input$above_median) +
-            "Gene" = glue::glue_data(
+            abs(input$mean_expression) +
-                ubigen::genes,
+            abs(input$sd_expression)
-                "<a href=\"https://www.ensembl.org/Homo_sapiens/Gene/Summary",
-                "?db=core;g={gene}\" target=\"_blank\">{hgnc_name}</a>"
-            ),
-            "Rank" = rank,
-            "Score" = score,
-            "Median" = median_expression,
-            "Mean" = mean_expression,
-            "Standard deviation" = sd_expression,
-            "Expressed" = above_zero,
-            "Above 50 TPM" = above_threshold,
-            "Above median" = above_median,
-            "Above 95%" = above_95
-        )]
 
-        DT::datatable(
+        data <- data.table::copy(ubigen::genes)
+
+        data[, score :=
+            (input$above_median * above_median +
+                input$mean_expression * mean_expression_normalized +
+                input$sd_expression * sd_expression_normalized) /
+                total_weight]
+
+        data.table::setorder(data, -score)
+        data[, rank := .I]
+
+        genes_table(data)
+    })
+
+    output$all_data <- DT::renderDataTable(genes_table(ubigen::genes))
+}
+
+#' Create a displayable data table from the gene results data.
+#' @noRd
+genes_table <- function(data) {
+    data <- data[, .(
+        "Gene" = glue::glue_data(
             data,
-            options = list(pageLength = 100),
+            "<a href=\"https://www.ensembl.org/Homo_sapiens/Gene/Summary",
-            rownames = FALSE,
+            "?db=core;g={gene}\" target=\"_blank\">{hgnc_name}</a>"
-            escape = FALSE
+        ),
-        ) |>
+        "Rank" = rank,
-            DT::formatPercentage(c(
+        "Score" = score,
+        "Median" = median_expression,
+        "Mean" = mean_expression,
+        "Standard deviation" = sd_expression,
+        "Expressed" = above_zero,
+        "Above 50 TPM" = above_threshold,
+        "Above median" = above_median,
+        "Above 95%" = above_95
+    )]
+
+    DT::datatable(
+        data,
+        options = list(pageLength = 100),
+        rownames = FALSE,
+        escape = FALSE
+    ) |>
+        DT::formatPercentage(
+            c(
                 "Score",
                 "Expressed",
                 "Above 50 TPM",
                 "Above median",
                 "Above 95%"
-            )) |>
+            ),
-            DT::formatRound(c(
+            digits = 2,
-                "Median",
+        ) |>
-                "Mean",
+        DT::formatRound(c(
-                "Standard deviation"
+            "Median",
-            ))
+            "Mean",
-    })
+            "Standard deviation"
+        ))
 }

R/ui.R

@@ -13,9 +13,35 @@ ui <- function() {
             sidebarLayout(
                 sidebarPanel(
                     width = 3,
+                    h3("Criteria"),
+                    sliderInput(
+                        "above_median",
+                        "Expressed above median",
+                        min = -1.0,
+                        max = 1.0,
+                        step = 0.01,
+                        value = 1.0
+                    ),
+                    sliderInput(
+                        "mean_expression",
+                        "Mean expression",
+                        min = -1.0,
+                        max = 1.0,
+                        step = 0.01,
+                        value = 1.0
+                    ),
+                    sliderInput(
+                        "sd_expression",
+                        "Standard deviation",
+                        min = -1.0,
+                        max = 1.0,
+                        step = 0.01,
+                        value = -1.0
+                    )
                 ),
                 mainPanel(
                     width = 9,
+                    DT::dataTableOutput("ranked_data")
                 )
             )
         ),