Allow setting a custom default dataset

R/app.R

@@ -2,8 +2,19 @@
 #'
 #' @param host The hostname to serve the application on.
 #' @param port The port to serve the application on.
+#' @param custom_dataset This allows to set a custom dataset (return value of
+#'   [analyze()]) as the default dataset of the UI.
 #'
 #' @export
-run_app <- function(host = "127.0.0.1", port = 3464) {
+run_app <- function(host = "127.0.0.1",
-  runApp(shinyApp(ui, server), host = host, port = port)
+                    port = 3464,
+                    custom_dataset = NULL) {
+  runApp(
+    shinyApp(
+      ui(custom_dataset = custom_dataset),
+      server(custom_dataset = custom_dataset)
+    ),
+    host = host,
+    port = port
+  )
 }

R/server.R

@@ -1,184 +1,188 @@
 #' Server implementing the main user interface.
 #' @noRd
-server <- function(input, output, session) {
+server <- function(custom_dataset = NULL) {
-  dataset <- reactive({
+  function(input, output, session) {
-    analysis <- if (input$dataset == "gtex_tissues") {
+    dataset <- reactive({
-      ubigen::gtex_tissues
+      analysis <- if (input$dataset == "gtex_tissues") {
-    } else if (input$dataset == "hpa_tissues") {
+        ubigen::gtex_tissues
-      ubigen::hpa_tissues
+      } else if (input$dataset == "hpa_tissues") {
-    } else {
+        ubigen::hpa_tissues
-      ubigen::gtex_all
+      } else if (input$dataset == "gtex_all") {
-    }
+        ubigen::gtex_all
-
+      } else {
-    merge(analysis, ubigen::genes, by = "gene")
+        custom_dataset
-  })
-
-  ranked_data <- reactive({
-    rank_genes(
-      data = dataset(),
-      cross_sample_metric = input$cross_sample_metric,
-      cross_sample_weight = input$cross_sample_weight,
-      level_metric = input$level_metric,
-      level_weight = input$level_weight,
-      variation_metric = input$variation_metric,
-      variation_weight = input$variation_weight
-    )
-  })
-
-  custom_genes <- gene_selector_server("custom_genes") |> debounce(500)
-
-  output$overview_plot <- plotly::renderPlotly(overview_plot(
-    ranked_data(),
-    highlighted_genes = custom_genes()
-  ))
-
-  observeEvent(custom_genes(),
-    { # nolint
-      if (length(custom_genes()) > 0) {
-        updateTabsetPanel(session, "results_panel", selected = "custom_genes")
-      } else if (input$results_panel == "custom_genes") {
-        updateTabsetPanel(session, "results_panel", selected = "top_genes")
       }
-    },
-    ignoreNULL = FALSE
-  )
 
-  output$custom_genes_synopsis <- renderText({
+      merge(analysis, ubigen::genes, by = "gene")
-    comparison_gene_ids <- custom_genes()
-
-    if (length(comparison_gene_ids) > 1) {
-      reference <- ranked_data()[!gene %chin% comparison_gene_ids, score]
-      comparison <- ranked_data()[gene %chin% comparison_gene_ids, score]
-
-      reference_median <- format(
-        round(stats::median(reference), digits = 3),
-        nsmall = 3
-      )
-
-      comparison_median <- format(
-        round(stats::median(comparison), digits = 3),
-        nsmall = 3
-      )
-
-      test_result <- stats::wilcox.test(
-        x = comparison,
-        y = reference,
-        alternative = "greater",
-        conf.int = TRUE
-      )
-
-      p_value <- format(
-        round(test_result$p.value, digits = 4),
-        nsmall = 4,
-        scientific = FALSE
-      )
-
-      lower <- format(round(test_result$conf.int[1], digits = 3), nsmall = 3)
-      upper <- format(round(test_result$conf.int[2], digits = 3), nsmall = 3)
-
-      HTML(glue::glue(
-        "The p-value with the alternative hypothesis that your genes have ",
-        "higher scores than other genes is <b>{p_value}</b>. This value ",
-        "was computed using a Wilcoxon rank sum test. Based on a 95% ",
-        "confidence, the difference in scores is between <b>{lower}</b> and ",
-        "<b>{upper}</b>. The median score of your genes is ",
-        "<b>{comparison_median}</b> compared to a median score of ",
-        "<b>{reference_median}</b> of the other genes."
-      ))
-    }
-  })
-
-  output$custom_genes_boxplot <- plotly::renderPlotly(
-    box_plot(ranked_data(), custom_genes())
-  )
-
-  genes_table_server("custom_genes", reactive({
-    ranked_data()[gene %chin% custom_genes()]
-  }))
-
-  output$scores_plot <- plotly::renderPlotly(scores_plot(
-    ranked_data(),
-    highlighted_genes = custom_genes()
-  ))
-
-  selected_genes <- reactive({
-    selected_points <- plotly::event_data("plotly_selected")
-    ranked_data()[rank %in% selected_points$x]
-  })
-
-  genes_table_server("selected_genes", reactive({
-    if (nrow(selected_genes()) > 0) {
-      selected_genes()
-    } else {
-      ranked_data()
-    }
-  }))
-
-  gsea_genes <- reactive({
-    sort(if (input$gsea_set == "top") {
-      ranked_data()[rank >= input$gsea_ranks, gene]
-    } else if (input$gsea_set == "selected") {
-      selected_genes()[, gene]
-    } else {
-      custom_genes()
     })
-  })
 
-  gsea_result <- reactive({
+    ranked_data <- reactive({
-    withProgress(
+      rank_genes(
-      message = "Querying g:Profiler",
+        data = dataset(),
-      value = 0.0,
+        cross_sample_metric = input$cross_sample_metric,
+        cross_sample_weight = input$cross_sample_weight,
+        level_metric = input$level_metric,
+        level_weight = input$level_weight,
+        variation_metric = input$variation_metric,
+        variation_weight = input$variation_weight
+      )
+    })
+
+    custom_genes <- gene_selector_server("custom_genes") |> debounce(500)
+
+    output$overview_plot <- plotly::renderPlotly(overview_plot(
+      ranked_data(),
+      highlighted_genes = custom_genes()
+    ))
+
+    observeEvent(custom_genes(),
       { # nolint
-        setProgress(0.2)
+        if (length(custom_genes()) > 0) {
-        gprofiler2::gost(gsea_genes())
+          updateTabsetPanel(session, "results_panel", selected = "custom_genes")
-      }
+        } else if (input$results_panel == "custom_genes") {
+          updateTabsetPanel(session, "results_panel", selected = "top_genes")
+        }
+      },
+      ignoreNULL = FALSE
     )
-  }) |>
-    bindCache(gsea_genes()) |>
-    bindEvent(input$gsea_run, ignoreNULL = FALSE)
 
-  output$gsea_plot <- plotly::renderPlotly({
+    output$custom_genes_synopsis <- renderText({
-    gprofiler2::gostplot(gsea_result(), interactive = TRUE)
+      comparison_gene_ids <- custom_genes()
-  })
 
-  output$gsea_details <- DT::renderDT({
+      if (length(comparison_gene_ids) > 1) {
-    data <- data.table(gsea_result()$result)
+        reference <- ranked_data()[!gene %chin% comparison_gene_ids, score]
-    setorder(data, p_value)
+        comparison <- ranked_data()[gene %chin% comparison_gene_ids, score]
 
-    data[, total_ratio := term_size / effective_domain_size]
+        reference_median <- format(
-    data[, query_ratio := intersection_size / query_size]
+          round(stats::median(reference), digits = 3),
-    data[, increase := (query_ratio - total_ratio) / total_ratio]
+          nsmall = 3
+        )
 
-    data <- data[, .(
+        comparison_median <- format(
-      source,
+          round(stats::median(comparison), digits = 3),
-      term_name,
+          nsmall = 3
-      total_ratio,
+        )
-      query_ratio,
-      increase,
-      p_value
-    )]
 
-    DT::datatable(
+        test_result <- stats::wilcox.test(
-      data,
+          x = comparison,
-      rownames = FALSE,
+          y = reference,
-      colnames = c(
+          alternative = "greater",
-        "Source",
+          conf.int = TRUE
-        "Term",
+        )
-        "Total ratio",
+
-        "Query ratio",
+        p_value <- format(
-        "Increase",
+          round(test_result$p.value, digits = 4),
-        "p-value"
+          nsmall = 4,
-      ),
+          scientific = FALSE
-      options = list(
+        )
-        pageLength = 25
+
+        lower <- format(round(test_result$conf.int[1], digits = 3), nsmall = 3)
+        upper <- format(round(test_result$conf.int[2], digits = 3), nsmall = 3)
+
+        HTML(glue::glue(
+          "The p-value with the alternative hypothesis that your genes have ",
+          "higher scores than other genes is <b>{p_value}</b>. This value ",
+          "was computed using a Wilcoxon rank sum test. Based on a 95% ",
+          "confidence, the difference in scores is between <b>{lower}</b> and ",
+          "<b>{upper}</b>. The median score of your genes is ",
+          "<b>{comparison_median}</b> compared to a median score of ",
+          "<b>{reference_median}</b> of the other genes."
+        ))
+      }
+    })
+
+    output$custom_genes_boxplot <- plotly::renderPlotly(
+      box_plot(ranked_data(), custom_genes())
+    )
+
+    genes_table_server("custom_genes", reactive({
+      ranked_data()[gene %chin% custom_genes()]
+    }))
+
+    output$scores_plot <- plotly::renderPlotly(scores_plot(
+      ranked_data(),
+      highlighted_genes = custom_genes()
+    ))
+
+    selected_genes <- reactive({
+      selected_points <- plotly::event_data("plotly_selected")
+      ranked_data()[rank %in% selected_points$x]
+    })
+
+    genes_table_server("selected_genes", reactive({
+      if (nrow(selected_genes()) > 0) {
+        selected_genes()
+      } else {
+        ranked_data()
+      }
+    }))
+
+    gsea_genes <- reactive({
+      sort(if (input$gsea_set == "top") {
+        ranked_data()[rank >= input$gsea_ranks, gene]
+      } else if (input$gsea_set == "selected") {
+        selected_genes()[, gene]
+      } else {
+        custom_genes()
+      })
+    })
+
+    gsea_result <- reactive({
+      withProgress(
+        message = "Querying g:Profiler",
+        value = 0.0,
+        { # nolint
+          setProgress(0.2)
+          gprofiler2::gost(gsea_genes())
+        }
       )
-    ) |>
+    }) |>
-      DT::formatRound("p_value", digits = 4) |>
+      bindCache(gsea_genes()) |>
-      DT::formatPercentage(
+      bindEvent(input$gsea_run, ignoreNULL = FALSE)
-        c("total_ratio", "query_ratio", "increase"),
-        digits = 2
-      )
-  })
 
-  output$gsea_plot_ranking <- plotly::renderPlotly(gsea_plot_ranking)
+    output$gsea_plot <- plotly::renderPlotly({
+      gprofiler2::gostplot(gsea_result(), interactive = TRUE)
+    })
+
+    output$gsea_details <- DT::renderDT({
+      data <- data.table(gsea_result()$result)
+      setorder(data, p_value)
+
+      data[, total_ratio := term_size / effective_domain_size]
+      data[, query_ratio := intersection_size / query_size]
+      data[, increase := (query_ratio - total_ratio) / total_ratio]
+
+      data <- data[, .(
+        source,
+        term_name,
+        total_ratio,
+        query_ratio,
+        increase,
+        p_value
+      )]
+
+      DT::datatable(
+        data,
+        rownames = FALSE,
+        colnames = c(
+          "Source",
+          "Term",
+          "Total ratio",
+          "Query ratio",
+          "Increase",
+          "p-value"
+        ),
+        options = list(
+          pageLength = 25
+        )
+      ) |>
+        DT::formatRound("p_value", digits = 4) |>
+        DT::formatPercentage(
+          c("total_ratio", "query_ratio", "increase"),
+          digits = 2
+        )
+    })
+
+    output$gsea_plot_ranking <- plotly::renderPlotly(gsea_plot_ranking)
+  }
 }

R/ui.R

@@ -1,6 +1,6 @@
 #' Function for creating the main user interface.
 #' @noRd
-ui <- function() {
+ui <- function(custom_dataset = NULL) {
   div(
     custom_css(),
     rclipboard::rclipboardSetup(),
@@ -22,11 +22,19 @@ ui <- function() {
             selectInput(
               "dataset",
               label = strong("Expression dataset"),
-              list(
+              {
-                "GTEx (across tissues and conditions)" = "gtex_all",
+                choices <- list(
-                "GTEx (across tissues)" = "gtex_tissues",
+                  "GTEx (across tissues and conditions)" = "gtex_all",
-                "Human Protein Atlas (across tissues)" = "hpa_tissues"
+                  "GTEx (across tissues)" = "gtex_tissues",
-              )
+                  "Human Protein Atlas (across tissues)" = "hpa_tissues"
+                )
+
+                if (!is.null(custom_dataset)) {
+                  c(list("Custom dataset" = "custom"), choices)
+                } else {
+                  choices
+                }
+              }
             ),
             selectInput(
               "cross_sample_metric",

man/run_app.Rd

@@ -4,12 +4,15 @@
 \alias{run_app}
 \title{Run the application server.}
 \usage{
-run_app(host = "127.0.0.1", port = 3464)
+run_app(host = "127.0.0.1", port = 3464, custom_dataset = NULL)
 }
 \arguments{
 \item{host}{The hostname to serve the application on.}
 
 \item{port}{The port to serve the application on.}
+
+\item{custom_dataset}{This allows to set a custom dataset (return value of
+\code{\link[=analyze]{analyze()}}) as the default dataset of the UI.}
 }
 \description{
 Run the application server.