Merge pull request #9 from EMSL-Computing/feature/manual-corems

base functionality for manual coreMS upload

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FREDA
 Title: An app for the processing and visualization of Fourier-transform mass spectrometry data.
-Version: 1.7
+Version: 1.1.1
 Authors@R: c(person("Lisa", "Bramer", "[email protected]", role = "aut", "cre"),
     person("Daniel", "Claborne", "[email protected]", role = c("aut")))
 Description: A frontend application which exposes functionality of the ftmsRanalysis R package.  See 
@@ -33,6 +33,7 @@ Imports:
     scales, 
     shiny, 
     shinyBS, 
+    shinybusy,
     shinycssloaders, 
     shinyjs, 
     shinyWidgets, 

Dockerfile

@@ -4,9 +4,9 @@
 # Change this when we bump versions, or if you have some test version of the
 # base container you can specify --build-arg base_tag=<yourtag> in docker 
 # build.
-ARG base_tag=1.0.4
+ARG base_tag=docker.artifactory.pnnl.gov/mscviz/freda/base:latest
 
-FROM docker.artifactory.pnnl.gov/mscviz/freda/base:$base_tag
+FROM $base_tag
 
 # All app source/resources
 COPY . /srv/shiny-server/FREDA

FREDA.Rproj

@@ -11,3 +11,7 @@ Encoding: UTF-8
 
 RnwWeave: Sweave
 LaTeX: pdfLaTeX
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source

Makefile

@@ -0,0 +1,59 @@
+BASE_DOCKER_FILE=Dockerfile-base
+DOCKER_FILE=Dockerfile
+BASE_VERSION=latest
+TOP_VERSION=latest
+TAG_LATEST=1
+MAP_SHINYTEST=0
+SECRET_PATH=.mysecret
+APP_REGISTRY="docker.artifactory.pnnl.gov/mscviz/freda"
+BASE_IMAGE_TAG="${APP_REGISTRY}/base:${BASE_VERSION}"
+IMAGE_TAG="${APP_REGISTRY}:${TOP_VERSION}"
+MAP_SHINYTEST=2
+PROFILE=local
+
+.PHONY: build_base
+build_base:
+	docker build . --secret id=access_tokens,src=${SECRET_PATH} \
+	-f ${BASE_DOCKER_FILE} \
+	-t ${BASE_IMAGE_TAG} \
+	2>&1 | tee build_base.log \
+
+.PHONY: build_top
+build_top:
+	docker build . \
+	--build-arg base_tag=${BASE_IMAGE_TAG} \
+	-f ${DOCKER_FILE} \
+	-t ${IMAGE_TAG} \
+	2>&1 | tee build_top.log \
+
+.PHONY: build
+build: build_base build_top
+
+.PHONY: run
+run:
+	docker compose up --build
+
+.PHONY: login
+login:
+	docker login docker.artifactory.pnnl.gov
+
+.PHONY: push_base
+push_base: login
+	docker push ${BASE_IMAGE_TAG}
+
+	@if [ ${TAG_LATEST} = 1 ]; then\
+		docker tag ${BASE_IMAGE_TAG} "${APP_REGISTRY}/base:latest";\
+		docker push "${APP_REGISTRY}/base:latest";\
+    fi
+
+.PHONY: push_top
+push_top: login
+	docker push ${IMAGE_TAG}
+
+	@if [ ${TAG_LATEST} = 1 ]; then\
+		docker tag ${IMAGE_TAG} "${APP_REGISTRY}:latest";\
+		docker push "${APP_REGISTRY}:latest";\
+	fi
+
+.PHONY: push
+push: push_base push_top

Observers/preprocess_observers.R

@@ -20,10 +20,23 @@ observeEvent(input$preprocess_click, {
     arguments <- list()
     choices <- calc_opts$Function
 
-    tryCatch({
-      for (x in choices) {
-        if (x == 'calc_kendrick') {
-          if (!is.null(input$base_unit)) {
+    tryCatch({ 
+      for(x in choices) {
+        if(x == 'calc_element_ratios'){
+          if(!is.null(input$element_ratios)){
+            # Split string and send to 2xN matrix after checking elements are present in data.
+            raw_ratios <- strsplit(input$element_ratios, ",")
+            # Send raw string "O:C, H:C,N:C" --> [['O','C'],['H','C'],['N','C']]
+            ratio_element_list <- lapply(raw_ratios, function(ratio){
+              elements <- strsplit(ratio, ":")
+              lapply(elements, gsub, pattern="\\s", replacement="") #remove white space
+            })
+            # Send[['O','C'],['H','C'],['N','C']] --> ['O','C','H','C','N','C'] --> 3x2 matrix(['O','C','H','C','N','C']) as argument
+            arguments[[x]] <- list(ratios = matrix(data = unlist(ratio_element_list, recursive = TRUE), nrow = 2) )
+          }
+        }
+        else if(x == 'calc_kendrick'){
+          if(!is.null(input$base_unit)){
             arguments[[x]] <- list(base_compounds = input$base_unit)
           }
         }

Observers/startup_observers.R

@@ -41,23 +41,8 @@ observe({
             )
           })
 
-          names(fpaths) <- sapply(fpaths, function(x) basename(tools::file_path_sans_ext(x))) %>%
-            make.unique()
-
-          corems_revals[['combined_tables']] <- ftmsRanalysis::read_CoreMS_data(
-            unlist(fpaths),
-            sample_names = names(fpaths)
-          )
-
-          for (name in names(fpaths)) {
-            corems_revals[['tables']][[name]] <- read_csv(fpaths[[name]])
-            corems_revals[['fpaths']][[name]] <- fpaths[[name]]
-          }
-
-          modalmessage <- div(class = "column-scroll-sm",
-            HTML(info_text[["COREMS_UPLOAD_SUCCESS"]]),
-            HTML(paste(names(fpaths), collapse = "<br>"))
-          )
+          modalmessage <- store_corems(fpaths)
+
         }, error = function(e) {
           modalmessage <<- div(sprintf(info_text[["COREMS_UPLOAD_ERROR"]], e))
         })
@@ -66,14 +51,71 @@ observe({
       }
 
       # defined in srv_ui_elements/corems_UI.R
-      showModal(corems_upload_modal(modalmessage))
+      showModal(corems_upload_success_modal(modalmessage))
     }
 
-    insertTab(
-      "top_page",
-      target = "Welcome",
-      tab = upload_tab(length(corems_revals[['combined_tables']]) > 0),
-      position = "after"
+    # if we're not coming from minio, ask whether they have multiple CoreMS files to upload.
+    # if they don't automatically insert the Core
+    if (length(corems_revals[['combined_tables']]) == 0) {
+      showModal(upload_type_modal())
+    } else {
+      insertTab(
+        "top_page",
+        target = "Welcome",
+        tab = upload_tab(from_corems = TRUE),
+        position = "after"
+      )
+    }
+  })
+})
+
+#' create the modal asking for what type of file input the user has.
+upload_type_modal <- function() {
+  modalDialog(
+    title = "What type of data are you uploading?",
+    tags$p("Users have the option of uploading a single aligned data file along with a molecular identification file as defined in the data requirements page, or multiple files representing unaligned samples from the output of CoreMS."),
+    footer = tagList(
+      actionButton("upload_type_modal_single", "Single aligned data file"),
+      actionButton("upload_type_modal_multiple", "Multiple unaligned files (CoreMS output)")
     )
+  )
+}
+
+#' @details Insert the manual CoreMS upload tab
+observeEvent(input$upload_type_modal_multiple, {
+  insertTab(
+    "top_page",
+    target = "Welcome",
+    tab = upload_tab(from_corems = TRUE),
+    position = "after"
+  )
+  removeModal()
+
+  showModal(corems_manual_upload_modal())
+})
+
+#' @details load the corems files
+observeEvent(input$corems_files, {
+  fpaths <- input$corems_files$datapath
+  fnames <- input$corems_files$name
+
+  tryCatch({
+    modalmessage <- store_corems(fpaths, fnames)
+    removeModal()
+  }, error = function(e) {
+    modalmessage <<- div(sprintf(info_text[["COREMS_UPLOAD_ERROR"]], e))
   })
+
+  showModal(corems_upload_success_modal(modalmessage))
 })
+
+#' @details Insert the original e_data/e_meta upload tab
+observeEvent(input$upload_type_modal_single, {
+  insertTab(
+    "top_page",
+    target = "Welcome",
+    tab = upload_tab(),
+    position = "after"
+  )
+  removeModal()
+})

Observers/upload_observers.R

@@ -76,7 +76,6 @@ observeEvent(input$upload_click, {
 
   # If elemental columns chosen
   if (input$select == 2) {
-
     ## Error handling: all drop down columns nonempty and of class 'numeric'
 
     # first check that H and C columns are specified and numeric...
@@ -94,26 +93,22 @@ observeEvent(input$upload_click, {
       'One or more elemental columns are non-numeric.')
     )
     # ...then check that -if- other columns are selected, they are numeric
-    for (col in c('n_column', 'o_column', 's_column', 'p_column')) {
-      if (input[[col]] != 'Select a column') {
-        validate(need(is.numeric(Emeta()[, input[[col]]]), 'One or more elemental columns are non-numeric.'))
-      }
+    for (col in as.character(isolate(extra_elements()))) {
+        validate(need(is.numeric(Emeta()[, col]), 'One or more elemental columns are non-numeric.'))
     } # End error handling #
     tryCatch({
       revals$warningmessage_upload$makeobject_error <- NULL
+      # Combine Hydrogen and Carbon names with extra element columns
+      all_element_cols <- c("C"=input$c_column, "H"=input$h_column, isolate(extra_elements()))
       # If no C13
       if (input$isotope_yn == 2 | isTRUE(input$iso_info_filter == 2)) {
         # Create peakData object
         res <- as.peakData(e_data = Edata(), f_data = fdata(),
-          e_meta = Emeta(), edata_cname = input$edata_id_col,
-          fdata_cname = 'SampleId', mass_cname = input$edata_id_col,
-          c_cname = input$c_column, h_cname = input$h_column,
-          n_cname = if (input$n_column == 'Select a column') NULL else input$n_column,
-          o_cname = if (input$o_column == 'Select a column') NULL else input$o_column,
-          s_cname = if (input$s_column == 'Select a column') NULL else input$s_column,
-          p_cname = if (input$p_column == 'Select a column') NULL else input$p_column,
-          check_rows = TRUE, data_scale = input$data_scale)
-
+                           e_meta = Emeta(), edata_cname = input$edata_id_col, 
+                           fdata_cname = 'SampleId', mass_cname = input$edata_id_col,
+                           element_col_names = all_element_cols,
+                           check_rows = TRUE, data_scale = input$data_scale)
+
       }
       if (input$isotope_yn == 1 & isTRUE(input$iso_info_filter == 1)) { # If there's C13 #
 
@@ -124,17 +119,13 @@ observeEvent(input$upload_click, {
         ) # End error handling
 
         res <- as.peakData(e_data = Edata(), f_data = fdata(),
-          e_meta = Emeta(), edata_cname = input$edata_id_col,
-          fdata_cname = 'SampleId', mass_cname = input$edata_id_col,
-          c_cname = input$c_column, h_cname = input$h_column,
-          n_cname = if (input$n_column == 'Select a column') NULL else input$n_column,
-          o_cname = if (input$o_column == 'Select a column') NULL else input$o_column,
-          s_cname = if (input$s_column == 'Select a column') NULL else input$s_column,
-          p_cname = if (input$p_column == 'Select a column') NULL else input$p_column,
-          isotopic_cname = input$iso_info_column,
-          isotopic_notation = as.character(input$iso_symbol),
-          check_rows = TRUE, data_scale = input$data_scale)
-
+                           e_meta = Emeta(), edata_cname = input$edata_id_col, 
+                           fdata_cname = 'SampleId', mass_cname = input$edata_id_col,
+                           element_col_names = all_element_cols,
+                           isotopic_cname = input$iso_info_column,
+                           isotopic_notation = as.character(input$iso_symbol),
+                           check_rows = TRUE, data_scale = input$data_scale)
+
       } # End C13 / no C13 if statement
 
       if (input$NA_value != "NA") {
@@ -162,6 +153,50 @@ observeEvent(input$upload_click, {
 
 }) # End peakData creation
 
+observeEvent(input$add_ONSP, {
+  if(input$add_ONSP == TRUE){
+    # Add column if found
+    for (el in c("O","N","S","P")){
+      if( any(grepl(paste0("^",tolower(el), "$"), tolower(emeta_cnames()))) ){
+        el_col_name <- emeta_cnames()[grepl(paste0("^",tolower(el), "$"), tolower(emeta_cnames()))][1]
+        # Add to extra elements after checking it's not in there already
+        old_element_list <- isolate(extra_elements())
+        # Add to list if element hasn't been added yet to extra_elements
+        if((! el %in% names(old_element_list)) && (! el_col_name %in% as.character(old_element_list))){
+          old_element_list[[el]] <- c(old_element_list[[el]], el_col_name)
+          extra_elements(old_element_list)
+        }
+      }
+    }
+  }
+})
+
+observeEvent(input$add_element_column_button,{
+    validate(need(input$extra_element_name != 'Select an element' && input$extra_element_col != 'Select a column', "Please select an element and a column name before adding."))
+    # Isolate current elements, add new row, then reassign the reactive variable
+    old_element_list <- isolate(extra_elements())
+    # Check that input element or column name have not already been added to table
+    validate(need(! input$extra_element_name %in% names(old_element_list), "Element has already been added. Remove row to re-add element with a different column name."))
+    validate(need(! input$extra_element_col %in% as.character(old_element_list), "Column name has already been added. Remove row to re-add column with a different element."))
+    # Add to list
+    old_element_list[[input$extra_element_name]] <- c(old_element_list[[input$extra_element_name]], input$extra_element_col)
+    extra_elements(old_element_list)
+    # Reset select inputs after addition
+    shinyjs::reset("extra_element_name")
+    shinyjs::reset("extra_element_col")
+})
+
+observeEvent(input$remove_element_row_button,{
+  # Remove selected rows if rows have been selected
+  if (!is.null(input$added_elements_rows_selected)) {
+    #values$dfWorking <- values$dfWorking[-as.numeric(input$added_elements_rows_selected),]
+    old_element_list <- isolate(extra_elements())
+    #selected_elements <- added_elements()[input$added_elements_rows_selected]
+    old_element_list <- old_element_list[- as.numeric(input$added_elements_rows_selected)]
+    extra_elements(old_element_list)
+  }
+})
+
 # if edata is big, warn the user and prevent plotting of filter barplot
 observeEvent(Edata(), {
   if (prod(dim(Edata()[, -1])) > max_cells) {
@@ -299,13 +334,11 @@ observeEvent(c(input$iso_info_column, input$iso_symbol, input$isotope_yn, input$
 })
 
 # Non-numeric or non-selected elemental columns
-observeEvent(c(input$c_column, input$h_column, input$n_column,
-  input$o_column, input$s_column, input$p_column,
-  input$select, input$isotope_yn), {
+observeEvent(c(input$c_column, input$h_column, input$select, input$isotope_yn), {
 
   req(Edata(), Emeta(), input$edata_id_col != "Select one")
 
-  elcols <- c(input$c_column, input$h_column)
+  elcols <- c(input$c_column, input$h_column, as.character(isolate(extra_elements())) )
   conditions <- isTRUE(any(elcols == 'Select a column') | any(is.null(elcols)))
 
   if (conditions[1]) {

Reactive_Variables/upload_revals.R

@@ -50,3 +50,5 @@ fdata <- reactive({
   data.frame('SampleId' = sample_names(), 'Var1' = col2)
 
 }) # End fdata #
+
+extra_elements <- reactiveVal(value = list(), label = "extra_elements")

Welcome to FREDA.md

@@ -15,12 +15,3 @@ The FT-MS R Exploratory Data Analysis (FREDA) tool is designed to allow users up
   * comparison of two samples
   * comparisons of two groups of samples
 * Download a preprocessing summary report, .csv data summaries, and plots in .pdf .jpeg and .png formats
-
-***
-
-#### **Recent Updates:**
-
-  * *Linked plots sub-tab of the Visualize tab.  Interactively compare scatter or single sample histogram plots.*
-  * *Map peaks to values in the Kegg and Metacyc databases.*
-
-***

calculation_options.csv

@@ -1,5 +1,5 @@
 "DisplayName","Function","Info"
-"O:C, H:C, N:C, P:C, & N:P","calc_element_ratios","Element ratios for each molecule"
+"Element Ratios","calc_element_ratios","Element ratios for each molecule"
 "Kendrick Mass and Defect","calc_kendrick","Kendrick Defect = Nominal Kendrick Mass - Kendrick Mass \n\n Kendrick MAss = IUPAC mass*(14/14.01565), where IUPAC mass is based on the 12C atomic mass as exactly 12 Da. <a href=""https://pubs.acs.org/doi/pdf/10.1021/ac010560w"">[Hughey et al., 2001]</a>"
 "NOSC","calc_nosc","Nominal oxidation state of carbon. <a href=""https://onlinelibrary.wiley.com/doi/abs/10.1002/rcm.2386"">[Koch \& Dittmar, 2006]</a><a href = ""https://onlinelibrary.wiley.com/doi/full/10.1002/rcm.7433"">[Erratum]</a>"
 "Gibbs Free Energy","calc_gibbs","Cox Gibbs Free Energy. Calculated as:60.3 - 28.5*NOSC <a href=""https://www.sciencedirect.com/science/article/pii/S0016703711000378"">[LaRowe &amp; Van Cappellen, 2011]</a>"