Add more assessment information

rank_plot.R

@@ -12,7 +12,11 @@ library(plotly)
 #'
 #' @param results Results to display.
 #' @param reference_gene_ids IDs of reference genes.
-rank_plot <- function(results, reference_gene_ids) {
+#' @param cutoff Cut-off score.
+rank_plot <- function(results, reference_gene_ids, cutoff) {
+    first_not_included_rank <- results[score < cutoff, min(rank)]
+    last_rank <- results[, .N]
+
     plot <- plot_ly() |> add_trace(
         data = results,
         x = ~rank,
@@ -30,6 +34,15 @@ rank_plot <- function(results, reference_gene_ids) {
         width = 10,
         type = "bar"
     )  |> layout(
+        shapes = list(
+            type = "rect",
+            fillcolor = "black",
+            opacity = 0.1,
+            x0 = first_not_included_rank,
+            x1 = last_rank,
+            y0 = 0.0,
+            y1 = 1.0
+        ),
         xaxis = list(title = "Ranks"),
         yaxis = list(title = "Score")
     )

server.R

@@ -35,8 +35,8 @@ server <- function(input, output) {
         )
     })
 
-    #' This reactive expression applies all user defined filters as well as the
+    #' Rank the results based on the specified weights. Filter out genes with
-    #' desired ranking weights to the results.
+    #' too few species but don't apply the cut-off score.
     results <- reactive({
         # Select the species preset.
 
@@ -75,18 +75,15 @@ server <- function(input, output) {
             results <- results[, score := score * n_species / species_count]
         }
 
-        # Apply the cut-off score.
-        results <- results[score >= input$cutoff / 100]
-
         # Order the results based on their score.
 
         setorder(results, -score, na.last = TRUE)
         results[, rank := .I]
     })
 
-    output$rank_plot <- renderPlotly({
+    #' Apply the cut-off score to the ranked results.
-        results <- results()
+    results_filtered <- reactive({
-        rank_plot(results, genes[suggested | verified == TRUE, id])
+        results()[score >= input$cutoff / 100]
     })
 
     output$genes <- renderDT({
@@ -96,7 +93,7 @@ server <- function(input, output) {
         column_names <- c("", "Gene", "", "Chromosome", method_names, "Score")
 
         dt <- datatable(
-            results()[, ..columns],
+            results_filtered()[, ..columns],
             rownames = FALSE,
             colnames = column_names,
             style = "bootstrap",
@@ -114,22 +111,8 @@ server <- function(input, output) {
         formatPercentage(dt, c(method_ids, "score"), digits = 1)
     })
 
-    output$synposis <- renderText({
-        results <- results()
-
-        sprintf(
-            "Found %i candidates including %i/%i verified and %i/%i suggested \
-            TPE-OLD genes.",
-            results[, .N],
-            results[verified == TRUE, .N],
-            genes[verified == TRUE, .N],
-            results[suggested == TRUE, .N],
-            genes[suggested == TRUE, .N]
-        )
-    })
-
     output$copy <- renderUI({
-        results <- results()
+        results <- results_filtered()
 
         gene_ids <- results[, gene]
         names <- results[name != "", name]
@@ -155,7 +138,7 @@ server <- function(input, output) {
     })
 
     output$scatter <- renderPlotly({
-        results <- results()
+        results <- results_filtered()
 
         gene_ids <- results[input$genes_rows_selected, gene]
         genes <- genes[id %chin% gene_ids]
@@ -169,9 +152,38 @@ server <- function(input, output) {
         scatter_plot(results, species, genes, distances)
     })
 
+    output$assessment_synopsis <- renderText({
+        reference_gene_ids <- genes[suggested | verified == TRUE, id]
+
+        reference_count <- results_filtered()[
+            gene %chin% reference_gene_ids,
+            .N
+        ]
+
+        reference_results <- results()[gene %chin% reference_gene_ids]
+
+        sprintf(
+            "Included reference genes: %i/%i<br> \
+            Mean rank of reference genes: %.1f<br> \
+            Maximum rank of reference genes: %i",
+            reference_count,
+            length(reference_gene_ids),
+            reference_results[, mean(rank)],
+            reference_results[, max(rank)]
+        )
+    })
+
+    output$rank_plot <- renderPlotly({
+        rank_plot(
+            results(),
+            genes[suggested | verified == TRUE, id],
+            input$cutoff / 100
+        )
+    })
+
     output$gost <- renderPlotly({
         if (input$enable_gost) {
-            result <- gost(results()[, gene], ordered_query = TRUE)
+            result <- gost(results_filtered()[, gene], ordered_query = TRUE)
             gostplot(result, capped = FALSE, interactive = TRUE)
         } else {
             NULL

ui.R

@@ -53,11 +53,7 @@ ui <- fluidPage(
                 header = div(style = "margin-top: 16px"),
                 tabPanel(
                     "Results",
-                    textOutput("synposis"),
+                    uiOutput("copy"),
-                    div(
-                        style = "margin-top: 16px",
-                        uiOutput("copy")
-                    ),
                     div(
                         style = "margin-top: 16px",
                         DTOutput("genes", height = "1000px")
@@ -72,13 +68,17 @@ ui <- fluidPage(
                     )
                 ),
                 tabPanel(
-                    "Ranks",
+                    "Assessment",
+                    htmlOutput("assessment_synopsis"),
+                    div(
+                        style = "margin-top: 16px",
                         plotlyOutput(
                             "rank_plot",
                             width = "100%",
                             height = "600px"
                         )
                     ),
+                ),
                 tabPanel(
                     "Analysis",
                     checkboxInput(