Merge pull request #28 from CRI-iAtlas/fix_heatmap_server_default

Fix heatmap server default

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: iatlas.modules
 Title: iAatlas Modules
 Type: Package
-Version: 0.5.6
+Version: 0.5.7
 Date: 2021-1-30
 Author: Andrew Lamb
 Maintainer: Andrew Lamb <Andrew.Lamb@sagebase.org>

R/example_data.R

@@ -72,7 +72,8 @@ get_pcawg_feature_class_list <- function(){
     iatlas.api.client::query_features(cohorts = "PCAWG") %>%
     dplyr::select("class") %>%
     dplyr::distinct() %>%
-    dplyr::arrange(.data$class)
+    dplyr::arrange(.data$class) %>%
+    dplyr::pull("class")
 }
 
 get_pcawg_feature_list <- function(){

R/heatmap_server.R

@@ -22,6 +22,10 @@
 #' the "feature_value" of repsonse_data_function. Each function must return one
 #' numeric value.
 #' @param drilldown A shiny::reactive that returns True or False
+#' @param default_feature A shiny::reactive that returns a string that
+#' is one of the values in response_features
+#' @param default_class A shiny::reactive that returns a string that is one of
+#' the values in feature_classes
 #' @param ... shiny::reactives passed to drilldown_scatterplot_server
 #'
 #' @export
@@ -33,6 +37,8 @@ heatmap_server <- function(
   response_data_function,
   summarise_function_list = shiny::reactive(stats::cor),
   drilldown = shiny::reactive(F),
+  default_feature = shiny::reactive(NULL),
+  default_class = shiny::reactive(NULL),
   ...
 ){
   shiny::moduleServer(
@@ -41,21 +47,42 @@ heatmap_server <- function(
 
       ns <- session$ns
 
+      default_class2 <- shiny::reactive({
+        if(is.null(default_class())){
+          shiny::req(feature_classes())
+          return(feature_classes()[[1]])
+        } else{
+          return(default_class())
+        }
+      })
+
       output$class_selection_ui <- shiny::renderUI({
-        shiny::req(feature_classes())
+        shiny::req(feature_classes(), default_class2())
         shiny::selectInput(
           inputId  = ns("feature_class_choice"),
           label    = "Select or Search for Feature Class",
-          choices  = feature_classes()
+          choices  = feature_classes(),
+          selected = default_class2()
         )
       })
 
+
+      default_feature2 <- shiny::reactive({
+        if(is.null(default_feature())){
+          shiny::req(response_features())
+          return(response_features()[[1]][[1]])
+        } else{
+          return(default_feature())
+        }
+      })
+
       output$response_selection_ui <- shiny::renderUI({
-        shiny::req(response_features())
+        shiny::req(response_features(), default_feature2())
         shiny::selectInput(
           inputId  = ns("response_feature_choice"),
           label    = "Select or Search for Response Feature",
-          choices  = response_features()
+          choices  = response_features(),
+          selected = default_feature2()
         )
       })
 

tests/testthat/test-heatmap_server.R

@@ -1,3 +1,30 @@
+test_that("heatmap_server_error_default_class_and_feature", {
+
+  shiny::testServer(
+    heatmap_server,
+    args = list(
+      "feature_classes" = shiny::reactive(get_pcawg_feature_class_list()),
+      "response_features" = shiny::reactive(get_pcawg_feature_list()),
+      "feature_data_function" = shiny::reactive(get_feature_values_by_class_no_data),
+      "response_data_function" = shiny::reactive(get_pcawg_feature_values_by_feature),
+      "summarise_function_list" = shiny::reactive(
+        purrr::partial(stats::cor, method = "pearson")
+      ),
+      "default_feature" = shiny::reactive("T_cells_gamma_delta"),
+      "default_class" = shiny::reactive("MCPcounter")
+    ),
+    {
+      expect_equal(default_class(), "MCPcounter")
+      expect_equal(default_class2(), "MCPcounter")
+
+      expect_equal(default_feature(), "T_cells_gamma_delta")
+      expect_equal(default_feature2(), "T_cells_gamma_delta")
+    }
+  )
+})
+
+
+
 test_that("heatmap_server_error_no_feature_data", {
 
   shiny::testServer(
@@ -199,6 +226,12 @@ test_that("heatmap_server_multiple_summarise_functions", {
       session$setInputs("response_feature_choice" = "age_at_diagnosis")
       session$setInputs("summarise_function_choice" = "Spearman")
 
+      expect_null(default_class())
+      expect_equal(default_class2(), "Adaptive Receptor - T cell")
+
+      expect_null(default_feature())
+      expect_equal(default_feature2(), "TCR_Evenness")
+
       expect_type(output$class_selection_ui, "list")
       expect_type(output$response_selection_ui, "list")
       expect_true(display_summarise_function_ui())