Merge pull request #149 from EPPIcenter/fix-and-improve-search

Fix and improve search
EPPIcenter · Aug 24, 2023 · e90b4cd · e90b4cd
2 parents 9452c7a + 5b9ae51
commit e90b4cd
Show file tree

Hide file tree

Showing 3 changed files with 80 additions and 59 deletions.
diff --git a/R/ProcessCSV.R b/R/ProcessCSV.R
@@ -143,15 +143,6 @@ ProcessCSV <- function(user_csv, user_action, sample_storage_type, search_type =
     }
   }
 
-  ## todo - across the app, 1, 2, 3 should be changed to their character counterparts (below)
-  ## until then do this for readability
-  sample_storage_type = switch(
-    sample_storage_type,
-    "1" = "micronix",
-    "2" = "cryovial",
-    "3" = "dbs"
-  )
-
   ## second row is valid because traxcer will have "plate_label:" in the first row
   valid_header_rows <- 1:2
 
@@ -249,6 +240,15 @@ ProcessCSV <- function(user_csv, user_action, sample_storage_type, search_type =
       dbmap <- NULL
       dbmap$row_number <- "RowNumber"
 
+      ## todo - across the app, 1, 2, 3 should be changed to their character counterparts (below)
+      ## until then do this for readability
+      sample_storage_type = switch(
+        sample_storage_type,
+        "1" = "micronix",
+        "2" = "cryovial",
+        "3" = "dbs"
+      )
+
       ## pass the row id to link back to the actual user file, so that
       # we can inform the user if there is an issue with one of their rows
 

diff --git a/README.md b/README.md
@@ -31,23 +31,23 @@ A docker image for sampleDB can be pulled from [DockerHub](https://hub.docker.co
 To pull from DockerHub, run the command below:
 
 ```bash
-docker pull eppicenter/sampledb:v2.1.0
+docker pull eppicenter/sampledb:v2.1.1
 ```
 
 ##### Option 2: Build the image
 
 You can build the image instead of pulling from DockerHub. To do so, run the following command:
 
 ```bash
-docker build -t eppicenter/sampledb:v2.1.0 .
+docker build -t eppicenter/sampledb:v2.1.1 .
 ```
 
 #### 3. Create your container
 
 This is the final step. The host `localhost` and port `8080` will be used to access the application within the container, and all volumes needed to run the container are passed in on the command line. Notice that the sampleDB database volume is also include in the list of volumes.
 
 ```bash
-docker run -d -p 8080:3838 -v /srv/shinyapps/:/srv/shiny-server -v /srv/shinylog/:/var/log/shiny-server -v sampledb_database:/usr/local/share/sampleDB --restart unless-stopped --name sampleDB eppicenter/sampledb:v2.1.0
+docker run -d -p 8080:3838 -v /srv/shinyapps/:/srv/shiny-server -v /srv/shinylog/:/var/log/shiny-server -v sampledb_database:/usr/local/share/sampleDB --restart unless-stopped --name sampleDB eppicenter/sampledb:v2.1.1
 ```
 
 #### 4. Access sampleDB 
@@ -79,7 +79,7 @@ To install sampleDB at the site level, you can run the command below using an R
 ```R
 remotes::install_github(
     "https://github.com/EPPIcenter/sampleDB-rpackage", 
-    ref = "v2.1.0",
+    ref = "v2.1.1",
     lib = .libPaths()[1]
 )
 ```
@@ -93,7 +93,7 @@ For a local install, the below command is sufficient within a regular RStudio or
 ```R
 remotes::install_github(
     "https://github.com/EPPIcenter/sampleDB-rpackage", 
-    ref = "v2.1.0"
+    ref = "v2.1.1"
 )
 ```
 

diff --git a/inst/sampleDB/server_helpers/AppSearchDelArchSamples.R b/inst/sampleDB/server_helpers/AppSearchDelArchSamples.R
@@ -3,17 +3,68 @@ library(RSQLite)
 library(DBI)
 library(stringr)
 
+
 SearchDelArchSamples <- function(session, input, database, output, dbUpdateEvent) {
-
-  ## Set defaults
-  # updateSelectInput(session, "DelArchSearchByState", selected = "Active")
-  # updateSelectInput(session, "DelArchSearchByStatus", selected = "In Use")
 
-# Reactive to store retrieved database data
-  all_data <- reactiveVal(NULL)
+  # Reactive to store retrieved database data
+  createFilterSetReactive <- function(defaults = list()) {
+    rv <- reactiveVal(defaults)
+
+    list(
+      get = function() { rv() },
+      set = function(new_filters) {
+        rv(new_filters)
+      },
+      insert = function(new_filters) {
+        existing_filters <- rv()
+        updated_filters <- modifyList(existing_filters, new_filters)
+        rv(updated_filters)
+      },
+      clear = function() { rv(list()) },
+      reset = function() { rv(defaults) }
+    )
+  }
+
+  # Initialize the custom filter with default values
+  filter_set <- createFilterSetReactive(
+    list(
+      state = "Active",
+      status = "In Use"
+    )
+  )
+
+
+  #' Declare filters for searching and establish any filter dependencies
+  observe({
+    # Build the filters
+    new_filters <- list(
+      manifest = input$DelArchSearchByManifest,
+      short_code = input$DelArchSearchByStudy,
+      study_subject = input$DelArchSearchBySubjectUID,
+      specimen_type = input$DelArchSearchBySpecimenType,
+      collection_date = list(
+        date.from = input$DelArchdateRange[1],
+        date.to = input$DelArchdateRange[2]
+      ), 
+      location = list(
+        name = input$DelArchSearchByLocation,
+        level_I = input$DelArchSearchByLevelI,
+        level_II = input$DelArchSearchByLevelII
+      ),
+      state = input$DelArchSearchByState,
+      status = input$DelArchSearchByStatus
+    )
+
+    # Remove empty or NULL values
+    new_filters <- purrr::map(new_filters, ~purrr::discard(.x, function(x) is.null(x) | "" %in% x | length(x) == 0))
+    new_filters <- purrr::discard(new_filters, ~is.null(.x) | length(.x) == 0)
+
+    filter_set$insert(new_filters)
+  })
+
 
   # get DelArchSearch ui elements
-  rv <- reactiveValues(user_file = NULL, error = NULL, search_table = NULL, filters = NULL, dbmap = NULL, operation = NULL, filtered_sample_container_ids = NULL)
+  rv <- reactiveValues(user_file = NULL, error = NULL, search_table = NULL, operation = NULL, filtered_sample_container_ids = NULL)
 
   error <- reactiveValues(
     title = "",
@@ -51,41 +102,10 @@ SearchDelArchSamples <- function(session, input, database, output, dbUpdateEvent
     rv$error <- NULL
   })
 
-  # Initial data retrieval using default values
-  # observe({
-  #   initial_data <- SearchSamples(input$DelArchSearchBySampleType, filters = list(state = "Active", status = "In Use"))
-
-  #   # Update the reactiveVal with the initial data
-  #   all_data(initial_data)
-  # })
-
   filtered_data <- reactive({
-
-    # Build the filters
-    filters <- list(
-      manifest = input$DelArchSearchByManifest,
-      short_code = input$DelArchSearchByStudy,
-      study_subject = input$DelArchSearchBySubjectUID,
-      specimen_type = input$DelArchSearchBySpecimenType,
-      collection_date = list(
-        date.from = input$DelArchdateRange[1],
-        date.to = input$DelArchdateRange[2]
-      ), 
-      location = list(
-        name = input$DelArchSearchByLocation,
-        level_I = input$DelArchSearchByLevelI,
-        level_II = input$DelArchSearchByLevelII
-      ),
-      state = input$DelArchSearchByState,
-      status = input$DelArchSearchByStatus
-    )
-
-    # Remove empty or NULL values
-    filters <- purrr::map(filters, ~purrr::discard(.x, function(x) is.null(x) | "" %in% x | length(x) == 0))
-    filters <- purrr::discard(filters, ~is.null(.x) | length(.x) == 0)
 
     # Obtain the search results
-    results <- SearchSamples(input$DelArchSearchBySampleType, filters = filters, include_internal_sample_id = TRUE)
+    results <- SearchSamples(input$DelArchSearchBySampleType, filters = filter_set$get(), include_internal_sample_id = TRUE)
 
     # Prepare data for reactable
     if (!is.null(results)) {
@@ -136,7 +156,6 @@ SearchDelArchSamples <- function(session, input, database, output, dbUpdateEvent
 
   observeEvent(input$DelArchSearchByBarcode, ignoreInit = FALSE, {
     dataset <- input$DelArchSearchByBarcode
-
     message(paste("Loaded", dataset$name))
 
     tryCatch({
@@ -148,8 +167,8 @@ SearchDelArchSamples <- function(session, input, database, output, dbUpdateEvent
         validate = FALSE
       )
 
-      head(rv$user_file)
-      rv$filters$barcode <-rv$user_file %>% pull(Barcodes)
+      new_filter <- list(barcode = rv$user_file %>% pull(Barcodes))
+      filter_set$insert(new_filter)  # Insert new barcode filter
     },
     formatting_error = function(e) {
       message("Caught formatting error")
@@ -170,7 +189,6 @@ SearchDelArchSamples <- function(session, input, database, output, dbUpdateEvent
 
   observeEvent(input$DelArchSearchBySubjectUIDFile, ignoreInit = TRUE, {
     dataset <- input$DelArchSearchBySubjectUIDFile
-
     message(paste("Loaded", dataset$name))
 
     tryCatch({
@@ -182,8 +200,9 @@ SearchDelArchSamples <- function(session, input, database, output, dbUpdateEvent
         validate = FALSE
       )
 
-      head(rv$filters$study_subject)
-      rv$filters$study_subject <- rv$user_file %>% pull(StudySubjects)
+      new_filter <- list(study_subject = rv$user_file %>% pull(StudySubjects))
+      filter_set$insert(new_filter)  # Insert new study_subject filter
+
     },
     formatting_error = function(e) {
       message("Caught formatting error")
@@ -204,6 +223,8 @@ SearchDelArchSamples <- function(session, input, database, output, dbUpdateEvent
 
   observeEvent(input$DelArchSearchReset, ignoreInit = TRUE, {
 
+    filter_set$reset()  # restore defaults
+
     updateRadioButtons(session, selected = "individual", "SubjectUIDDelArchSearchType", label = NULL, choices = list("Single Study Subject" = "individual", "Multiple Study Subjects" = "multiple"))
 
     updateDateRangeInput(session, "DelArchdateRange", start = NA, end = NA) %>% suppressWarnings()