diff --git a/R/ProcessCSV.R b/R/ProcessCSV.R index 2b59ba42..0d2d8f91 100644 --- 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 index de3574dc..57fb58b5 100644 --- a/README.md +++ b/README.md @@ -31,7 +31,7 @@ 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 @@ -39,7 +39,7 @@ docker pull eppicenter/sampledb:v2.1.0 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 @@ -47,7 +47,7 @@ docker build -t eppicenter/sampledb:v2.1.0 . 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 index ac0a0e76..0efbbd3f 100644 --- 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()