feature: data filtering input now completely dynamic

m-jahn · Mar 23, 2021 · 4793a7f · 4793a7f
1 parent 8ebe2e8
commit 4793a7f
Show file tree

Hide file tree

Showing 5 changed files with 61 additions and 120 deletions.
diff --git a/R/fitness_interactive.R b/R/fitness_interactive.R
diff --git a/data/CRISPRi_library_2019.yml b/data/CRISPRi_library_2019.yml
@@ -11,22 +11,38 @@ tree:
 # main parameters to filter data
 data:
   condition:
-    - L100
-    - L300
-    - LAC
-    - LD
-    - NACL
+    values:
+      - L100
+      - L300
+      - LAC
+      - LD
+      - NACL
+    selected:
+      - L100
   timepoint:
-    - 0
-    - 1
-    - 2
-    - 4
-    - 8
-    - 16
-    - 32
+    values:
+      - 0
+      - 1
+      - 2
+      - 4
+      - 8
+      - 16
+      - 32
+    selected:
+      - 0
+      - 1
+      - 2
+      - 4
+      - 8
+      - 16
+      - 32
   induction:
-    - i
-    - u
+    values:
+      - i
+      - u
+    selected:
+      - i
+      - u
 
 # variables for plotting data
 plotting:

diff --git a/data/Cupriavidus_BarSeq_2021.yml b/data/Cupriavidus_BarSeq_2021.yml
@@ -11,15 +11,21 @@ tree:
 # main parameters to filter data
 data:
   condition:
-    - continuous
-    - short pulse
-    - long pulse
+    values:
+      - continuous
+      - short pulse
+      - long pulse
+    selected:
+      - continuous
   timepoint:
-    - 0
-    - 8
-    - 16
-  induction:
-    - not applicable
+    values:
+      - 0
+      - 8
+      - 16
+    selected:
+      - 0
+      - 8
+      - 16
 
 # variables for plotting data
 plotting:

diff --git a/server.R b/server.R
@@ -19,36 +19,25 @@ server <- function(input, output) {
     # filter data set by gene selection
     data <- data() %>% filter(get(config()$tree$gene_level) %in% filtGenes())
     # filter data set by user input
-    filter(data,
-      get(names(config()$data)[1]) %in% input$UserDataFilterCond,
-      get(names(config()$data)[2]) %in% input$UserDataFilterTime,
-      get(names(config()$data)[3]) %in% input$UserDataFilterInd
-    )
+    for (filt in names(config()$data)) {
+      data <- filter(data, get(filt) %in% input[[paste0("Filter_", filt)]])
+    }
+    data
   })
 
   # GET GLOBAL CONFIGURATION FOR CHOSEN DATASET
   config <- reactive({data_config[[input$UserDataChoice]]})
 
   # DYNAMIC BOXES FOR DATA FILTERING
-  output$FilterCond <- renderUI({
-    selectInput("UserDataFilterCond",
-      "Condition:", config()$data$condition, 
-      selected = config()$data$condition[1],
-      multiple = TRUE)
-  })
-
-  output$FilterTime <- renderUI({
-    selectInput("UserDataFilterTime",
-      "Time point:", config()$data$timepoint, 
-      selected = config()$data$timepoint,
-      multiple = TRUE)
-  })
-
-  output$FilterInd <- renderUI({
-    selectInput("UserDataFilterInd",
-      "Induction:", config()$data$induction, 
-      selected = config()$data$induction,
-      multiple = TRUE)
+  output$UserFilters <- renderUI({
+    lapply(names(config()$data), function(filt) {
+      selectInput(
+        inputId = paste0("Filter_", filt),
+        label = paste0(filt, ":"),
+        choices = config()$data[[filt]]$values,
+        selected = config()$data[[filt]]$selected,
+        multiple = TRUE)
+    })
   })
 
   # DYNAMIC BOXES FOR DATA VIZ OPTIONS

diff --git a/ui.R b/ui.R
@@ -25,23 +25,13 @@ ui <- navbarPage(
         h4("DATA OPTIONS"),
 
         fluidRow(
-          column(width = 12, 
+          column(width = 6,
             selectInput("UserDataChoice",
-              "Choose data:", data_list,
+              "Choose data:", data_list, 
               selected = data_list[1])
-          )
-        ),
-
-        # select additional filters
-        fluidRow(
-          column(width = 4, 
-            uiOutput("FilterCond")
-          ),
-          column(width = 4,
-            uiOutput("FilterTime")
           ),
-          column(width = 4,
-            uiOutput("FilterInd")
+          column(width = 6,
+            uiOutput("UserFilters")
           )
         ),