From 53cfda9fb5f6b2bb8f1ac667c6b15a7f18123996 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <kontrapunkt@uclmail.net>
Date: Mon, 27 Feb 2023 13:46:01 +0100
Subject: [PATCH] Try to set proper default values for tag_sets_list and
 tag_adducts_list.

---
 R/resources.R            | 188 +++++++++++++++++++--------------------
 R/shiny-ui-base.R        |  60 +++++++++----
 inst/rmd/app_project.Rmd |  14 +--
 3 files changed, 146 insertions(+), 116 deletions(-)

diff --git a/R/resources.R b/R/resources.R
index 6023e46..c534c47 100644
--- a/R/resources.R
+++ b/R/resources.R
@@ -16,35 +16,35 @@
 
 
 ## Config defaults
-CONF <- list(data=NA_character_,
+CONF = list(data=NA_character_,
              project=getwd(),
              compounds=list(lists=list(),
                             sets=NA_character_))
 
 ## Constants
 FN_ENVOPTS="envopts.rds"
-FN_SUMM_BASE<-"summ.base.csv"
-FN_SUMM_PP<-"summ.pp.csv"
-FN_PP_OUT_PREF<-"PP.filetable"
-FN_SUMM_STATE<-"summ_state.csv"
-FN_SUMM <- "summ.csv"
-FN_SUMM_DEF_OUT <- FN_SUMM
-FN_CMP_L<-"compounds.csv"
-FN_LOC_SETID <-"setid.csv"
-FN_COMP_TAB<-"comprehensive.csv"
-FN_SPEC<-"specdata.rds"
-FN_CONF <- "conf-state.yaml"
-FN_EXTR_STATE <- "state_after_extraction.rds"
-FN_STATE <- "current-state.rds"
-FN_GUI_STATE <- "gui.rds"
-.envp <- new.env(parent = emptyenv())
+FN_SUMM_BASE="summ.base.csv"
+FN_SUMM_PP="summ.pp.csv"
+FN_PP_OUT_PREF="PP.filetable"
+FN_SUMM_STATE="summ_state.csv"
+FN_SUMM = "summ.csv"
+FN_SUMM_DEF_OUT = FN_SUMM
+FN_CMP_L="compounds.csv"
+FN_LOC_SETID ="setid.csv"
+FN_COMP_TAB="comprehensive.csv"
+FN_SPEC="specdata.rds"
+FN_CONF = "conf-state.yaml"
+FN_EXTR_STATE = "state_after_extraction.rds"
+FN_STATE = "current-state.rds"
+FN_GUI_STATE = "gui.rds"
+.envp = new.env(parent = emptyenv())
 data(adducts,package = "enviPat", envir = .envp)
 data(isotopes,package = "enviPat", envir = .envp)
-ADDUCTS <- dtable(.envp$adducts)
-ISOTOPES <- dtable(.envp$isotopes)
-.envp <- NULL
-ADDUCTMAP <- ADDUCTS$Name
-ADDUCTS$Name <- the_ifelse(ADDUCTS$Charge>0,paste0("[",ADDUCTS$Name,"]+"),paste0("[",ADDUCTS$Name,"]-"))
+ADDUCTS = dtable(.envp$adducts)
+ISOTOPES = dtable(.envp$isotopes)
+.envp = NULL
+ADDUCTMAP = ADDUCTS$Name
+ADDUCTS$Name = the_ifelse(ADDUCTS$Charge>0,paste0("[",ADDUCTS$Name,"]+"),paste0("[",ADDUCTS$Name,"]-"))
 ## names(ADDUCTMAP) <- apply(ADDUCTS,1,function(row) {
 ##     nm <- row[["Name"]]
 ##     sgn <- row[["Charge"]]
@@ -52,68 +52,68 @@ ADDUCTS$Name <- the_ifelse(ADDUCTS$Charge>0,paste0("[",ADDUCTS$Name,"]+"),paste0
 ##     paste0("[",nm,"]",suff)
 ## })
 ## ADDUCTS$Name <- names(ADDUCTMAP)
-DISP_ADDUCTS <- ADDUCTS$Name
-TAG_NA <- "::UNSET::"
-SET_NA <- "::UNSET::"
-TAG_DEF <- TAG_NA
-TAG_DEF_DESC<-"Case"
+DISP_ADDUCTS = ADDUCTS$Name
+TAG_NA = "::UNSET::"
+SET_NA = "::UNSET::"
+TAG_DEF = TAG_NA
+TAG_DEF_DESC="Case"
 DEFAULT_RT_RANGE=c(NA,NA)
 DEFAULT_INT_RANGE=c(NA,NA)
 DEFAULT_MZ_RANGE=c(NA,NA)
 
-## QANAMES <- c("MS1","MS2","Alignment","AboveNoise")
-PLOT_DEF_TAGS<-NA
-PLOT_DEF_SET<-NA
+## QANAMES = c("MS1","MS2","Alignment","AboveNoise")
+PLOT_DEF_TAGS=NA
+PLOT_DEF_SET=NA
 
-CEX<-0.75
+CEX=0.75
 RT_DIGITS=2
 M_DIGITS=4
 PAL="Dark2"
 
-REST_TAB<-c("mzml")
+REST_TAB=c("mzml")
 
 
-GUI_TAB_TITLE<-c(conf="Config",
+GUI_TAB_TITLE=c(conf="Config",
                  gen="Spectra Extraction and Automatic QA",
                  pres="Prescreening",
                  log="Log")
 
 
-GUI_SIDE_TITLE<-GUI_TAB_TITLE
-GUI_SIDE_TITLE[["gen"]]<-"Spectra Extraction"
+GUI_SIDE_TITLE=GUI_TAB_TITLE
+GUI_SIDE_TITLE[["gen"]]="Spectra Extraction"
 
 CHR_GRAM_X="retention time [min]"
 CHR_GRAM_Y="intensity"
 
 KEY_GLYPH='rect'
 
-PLOT_MS1_LEG_TIT<-"peak retention time (MS1)"
-PLOT_MS2_LEG_TIT<-"peak retention time (MS2)"
+PLOT_MS1_LEG_TIT="peak retention time (MS1)"
+PLOT_MS2_LEG_TIT="peak retention time (MS2)"
 
 
-MS2_1ST_N<-5
+MS2_1ST_N=5
 
-EXTR_MS2_DIR<-"MS2"
-EXTR_MS2_FLAG<-file.path(EXTR_MS2_DIR,'.ms2.DONE')
+EXTR_MS2_DIR="MS2"
+EXTR_MS2_FLAG=file.path(EXTR_MS2_DIR,'.ms2.DONE')
 
 
-SUMM_CHK_NONE<-'NONE'
+SUMM_CHK_NONE='NONE'
 
-SUMM_CHK_AUTO<-'AUTO'
+SUMM_CHK_AUTO='AUTO'
 
-SUMM_CHK_MANL<-'MANUAL'
+SUMM_CHK_MANL='MANUAL'
 
 
-MS1_ERR_COARSE<-"0.5 Da"                     # Da
-MS1_ERR_FINE<- "5 ppm"                       # ppm
-EIC_ERR <- "0.001 Da"                       # Da
-RT_EXTR_ERR<-"0.5 min"                       # min
-RT_SHIFT_ERR <- "0.5 min"               # min
+MS1_ERR_COARSE="0.5 Da"                     # Da
+MS1_ERR_FINE= "5 ppm"                       # ppm
+EIC_ERR = "0.001 Da"                       # Da
+RT_EXTR_ERR="0.5 min"                       # min
+RT_SHIFT_ERR = "0.5 min"               # min
 
-MS1_INT_THOLD <- 1e5
-MS2_INT_THOLD <- 2500.
+MS1_INT_THOLD = 1e5
+MS2_INT_THOLD = 2500.
 
-MS1_SN_FAC <- 3.0
+MS1_SN_FAC = 3.0
 
 
 ## Shiny objects
@@ -124,7 +124,7 @@ NUM_INP_HEIGHT="5%"
 
 
 ## Possible compound list fields
-EMPTY_CMPD_LIST <- dtable(ID=character(),
+EMPTY_CMPD_LIST = dtable(ID=character(),
                           SMILES=character(),
                           Name=character(),
                           Formula=character(),
@@ -132,32 +132,32 @@ EMPTY_CMPD_LIST <- dtable(ID=character(),
                           mz=numeric(),
                           known=character(),
                           ORIG=character())
-COMP_LIST_COLS <- c("ID","Name","SMILES","Formula","RT","mz")
+COMP_LIST_COLS = c("ID","Name","SMILES","Formula","RT","mz")
 ## Comprehensive table properties
-COMP_NAME_MAP <- list(RT="rt")
-COMP_NAME_FIRST <- c("ID","mz","rt","adduct","tag","set","Name","known","SMILES","Formula","file")
+COMP_NAME_MAP = list(RT="rt")
+COMP_NAME_FIRST = c("ID","mz","rt","adduct","tag","set","Name","known","SMILES","Formula","file")
 
 
 
 ## Trivial data table
-EMPTY_MZML <- dtable(file=character(0),
+EMPTY_MZML = dtable(file=character(0),
                      tag=character(0),
                      adduct=character(0),
                      set=character(0))
 
-FN_DATA_TAB <- "data-files.csv"
+FN_DATA_TAB = "data-files.csv"
 
 
 ## Default number of concurrent workers
-NO_WORKERS <- 2
+NO_WORKERS = 2
 
 ## Input parameters for prescreening.
-CONF_PRES_NUM <- c("ms1_int_thresh","ms2_int_thresh","s2n")
-CONF_PRES_TU <- c("ret_time_shift_tol")
+CONF_PRES_NUM = c("ms1_int_thresh","ms2_int_thresh","s2n")
+CONF_PRES_TU = c("ret_time_shift_tol")
 
 
 ## Prescreening columns
-QA_FLAGS <- c("qa_pass",
+QA_FLAGS = c("qa_pass",
               "qa_ms1_exists",
               "qa_ms2_exists",
               "qa_ms1_good_int",
@@ -165,7 +165,7 @@ QA_FLAGS <- c("qa_pass",
               "qa_ms2_near",
               "qa_ms2_good_int")
 
-QABOX_VALS <- c("MS1 exists"="qa_ms1_exists",
+QABOX_VALS = c("MS1 exists"="qa_ms1_exists",
                 "MS1 good intensity"="qa_ms1_good_int",
                 "MS1 above noise"="qa_ms1_above_noise",
                 "MS2 exists"="qa_ms2_exists",
@@ -173,42 +173,42 @@ QABOX_VALS <- c("MS1 exists"="qa_ms1_exists",
                 "MS2 no RT shift"="qa_ms2_near")
 
 
-QA_NUM_REAL <- c("ms1_int","ms1_rt","ms1_mean")
+QA_NUM_REAL = c("ms1_int","ms1_rt","ms1_mean")
 
-QA_NUM_INT <- c("ms2_sel","ms1_rt_ind")
+QA_NUM_INT = c("ms2_sel","ms1_rt_ind")
 
-QA_COLS <- c(QA_FLAGS,QA_NUM_REAL,QA_NUM_INT)
+QA_COLS = c(QA_FLAGS,QA_NUM_REAL,QA_NUM_INT)
 
 ## MS2 spectral table columns
-MS2_SPEC_COLS <- c("adduct","tag","ID","CE","rt","file","spec","ms2_max_int")
+MS2_SPEC_COLS = c("adduct","tag","ID","CE","rt","file","spec","ms2_max_int")
 
 ## MS1 spectral table columns
-MS1_SPEC_COLS <- c("adduct","tag","ID","eicMS1","ms1_int","ms1_rt","ms1_mean")
+MS1_SPEC_COLS = c("adduct","tag","ID","eicMS1","ms1_int","ms1_rt","ms1_mean")
 
 
 
 ## Default secondary indexing in the summary table
-DEF_INDEX_SUMM <- c("set", "-qa_pass", "-ms1_int", "adduct","-mz")
+DEF_INDEX_SUMM = c("set", "-qa_pass", "-ms1_int", "adduct","-mz")
 
 ## Top-level directory to store the figures
-FIG_TOPDIR <- "figures"
+FIG_TOPDIR = "figures"
 
-REP_TOPDIR <- "report"
+REP_TOPDIR = "report"
 ## Figure filter
-FIG_DEF_FILTER <- ""
+FIG_DEF_FILTER = ""
 
-FIG_DEF_SUBSET <- c("set","adduct","ID")
+FIG_DEF_SUBSET = c("set","adduct","ID")
 
 
-REPORT_AUTHOR <- "Anonymous"
-REPORT_TITLE <- "Plots of EICs and MS2 Spectra"
+REPORT_AUTHOR = "Anonymous"
+REPORT_TITLE = "Plots of EICs and MS2 Spectra"
 
 ## Select the most fundamental group of entries. Within this group,
 ## each ID is unique.
-BASE_KEY <- c("adduct","tag","ID")
-BASE_KEY_MS2 <- c(BASE_KEY,"CE","an")
+BASE_KEY = c("adduct","tag","ID")
+BASE_KEY_MS2 = c(BASE_KEY,"CE","an")
 
-FIG_DEF_CONF <-list(grouping=list(group="adduct",
+FIG_DEF_CONF =list(grouping=list(group="adduct",
                                   plot="ID",
                                   label="tag"))
 
@@ -217,14 +217,14 @@ FIG_DEF_CONF <-list(grouping=list(group="adduct",
 SUMM_COLS=c("set",BASE_KEY_MS2,"mz","ms1_rt", "ms1_int", "ms2_rt", "ms2_int",
             "ms1_mean","ms2_sel",QA_FLAGS,"Name", "SMILES", "Formula", "known","Comments","file")
 
-SUMM_KEY <- c("set","ID","adduct","tag","an")
+SUMM_KEY = c("set","ID","adduct","tag","an")
 
-PLOT_FEATURES <- c("adduct",
+PLOT_FEATURES = c("adduct",
                    "tag",
                    "ID")
 
 ## Empty summary table.
-EMPTY_SUMM <- data.table::data.table(set=character(0),
+EMPTY_SUMM = data.table::data.table(set=character(0),
                                      adduct=character(0),
                                      tag=character(0),
                                      ID=character(0),
@@ -252,10 +252,10 @@ EMPTY_SUMM <- data.table::data.table(set=character(0),
                                      file=character(0))
 
 ## Default sorting keys of spectra in the summary table
-DEF_KEY_SUMM <- c(BASE_KEY_MS2,"an")
+DEF_KEY_SUMM = c(BASE_KEY_MS2,"an")
 
 
-SUBSET_VALS <- c(IGNORE="ignore",
+SUBSET_VALS = c(IGNORE="ignore",
                  GOOD="select good",
                  BAD="select bad")
 
@@ -263,7 +263,7 @@ SUBSET_VALS <- c(IGNORE="ignore",
 
 
 ## Empty comprehensive table.
-EMPTY_COMP_TAB <- dtable(ID=character(),
+EMPTY_COMP_TAB = dtable(ID=character(),
                          mz=numeric(),
                          rt=numeric(),
                          adduct=character(),
@@ -276,13 +276,13 @@ EMPTY_COMP_TAB <- dtable(ID=character(),
                          file=character())
 
 
-DEF_CONF_MISSING_PCS <- "do_nothing"
+DEF_CONF_MISSING_PCS = "do_nothing"
 
 
 ## Significant digits for output
-SIGNF_I <- 3
-SIGNF_MZ <- 7
-SIGNF_RT <- 4
+SIGNF_I = 3
+SIGNF_MZ = 7
+SIGNF_RT = 4
 
 
 ## Symbols to display T, or F
@@ -290,13 +290,13 @@ SYM_YES="\U002713"
 SYM_NO="\U00274C"
 
 
-CMPD_LIST_PATT <- "((*.csv)|(*.csv.gz))$"
-SET_LIST_PATT <- CMPD_LIST_PATT
-DFILES_LIST_PATT <- ".*\\.mz[Mm][Ll]$"
+CMPD_LIST_PATT = "((*.csv)|(*.csv.gz))$"
+SET_LIST_PATT = CMPD_LIST_PATT
+DFILES_LIST_PATT = ".*\\.mz[Mm][Ll]$"
 
-CINDEX_BY <- c("set","ID","adduct","tag")
-CINDEX_COLS <- c("mz", "ms1_rt","Name","qlt_ms1","qlt_ms2")
-ARRANGE_CHOICES <- c(nothing="nothing",
+CINDEX_BY = c("set","ID","adduct","tag")
+CINDEX_COLS = c("mz", "ms1_rt","Name","qlt_ms1","qlt_ms2")
+ARRANGE_CHOICES = c(nothing="nothing",
                      quality="quality",
                      set="set",
                      adduct="adduct",
@@ -304,12 +304,12 @@ ARRANGE_CHOICES <- c(nothing="nothing",
                      rt="rt",
                      id="ID")
 
-PLOT_EIC_ASPECT <- 0.75
+PLOT_EIC_ASPECT = 0.75
 
 ## Each set should have it's different colourscheme, because of the
 ## possibility that each set connects to a different collection of
 ## files.
-COLRDATA_KEY <- "set"
+COLRDATA_KEY = "set"
 
 ## METFRAG
 
diff --git a/R/shiny-ui-base.R b/R/shiny-ui-base.R
index eb07a3a..05946ad 100644
--- a/R/shiny-ui-base.R
+++ b/R/shiny-ui-base.R
@@ -1057,14 +1057,15 @@ mk_shinyscreen_server <- function(projects,init) {
             rvs$gui$compounds$sets = sels
         })
 
-        observeEvent(rvs$gui$datatab$set,{
-            if (isTruthy(rvs$gui$datatab$set)) {
+        observeEvent(rf_get_sets(),{
+            sets = rf_get_sets()
+            if (isTruthy(rf_get_sets())) {
                 updateSelectInput(session=session,
-                                  inputId="tag_set_list",
-                                  choices=rvs$gui$datatab$set,
-                                  selected=NA_character_)
+                                  inputId="tag_sets_list",
+                                  choices=sets,
+                                  selected=NULL)
             }
-        }, label="tag_set_list")
+        }, label="tag_sets_list")
 
         observeEvent(input$datafiles_b,{
             new_file = input$dfile_list
@@ -1113,15 +1114,41 @@ mk_shinyscreen_server <- function(projects,init) {
             
         }, label = "datafiles-edit")
 
-        observeEvent(input$datatab_cell_edit,{
-            df = gen_dtab(rvs$gui$datatab,sets=rf_get_sets())
-            z = DT::editData(df,
-                              input$datatab_cell_edit,
-                              rownames = F)
+        ## observeEvent(input$datatab_cell_edit,{
+        ##     df = gen_dtab(rvs$gui$datatab,sets=rf_get_sets())
+        ##     z = DT::editData(df,
+        ##                       input$datatab_cell_edit,
+        ##                       rownames = F)
 
-            rvs$gui$datatab$set = z$set
-            rvs$gui$datatab$adduct = z$adduct
-        }, label = "datatab-edit")
+        ##     rvs$gui$datatab$set = z$set
+        ##     rvs$gui$datatab$adduct = z$adduct
+        ## }, label = "datatab-edit")
+
+        observe({
+            selected_adducts = input$tag_adducts_list
+            ## selected_adducts[selected_adducts == "NA"] = NA_character_
+            selected_sets = input$tag_sets_list
+            ## selected_sets[selected_sets == "NA"] = NA_character_
+            selected_rows = input$datafiles_rows_selected
+            if (isTruthy(selected_rows)) {
+                selected_tags = rvs$gui$datafiles$tag[selected_rows]
+                dt_rows = which(rvs$gui$datatab$tag %in% selected_tags)
+                if (isTruthy(selected_sets)) {
+                    rvs$gui$datatab$set[dt_rows] = selected_sets
+                    updateSelectInput(session=session,
+                                      inputId="tag_adducts_list",
+                                      selected=NULL)
+                }
+
+                if (isTruthy(selected_adducts)) {
+                    rvs$gui$datatab$adduct[dt_rows] = selected_adducts
+                    updateSelectInput(session=session,
+                                      inputId="tag_sets_list",
+                                      selected=NULL)
+                }
+            }
+            
+        }, label = "datatab-set-associations")
 
         ## OBSERVERS: CONFIGURATION AND EXTRACTION
         
@@ -1583,8 +1610,9 @@ mk_shinyscreen_server <- function(projects,init) {
             sets = rf_get_sets()
             dtab = gen_dtab(rvs$gui$datatab,
                              sets=sets)
-            tab = scroll_dropdown_dt(dtab, callback = dt_drop_callback('1','2',sets))
-            ## tab = dropdown_dt(dtab, callback = dt_drop_callback('1','2',sets))
+            ## tab = scroll_dropdown_dt(dtab, callback = dt_drop_callback('1','2',sets))
+            tab = scroll_style_dt(dtab)
+
             tab
             
         })
diff --git a/inst/rmd/app_project.Rmd b/inst/rmd/app_project.Rmd
index 77c7599..241bf44 100644
--- a/inst/rmd/app_project.Rmd
+++ b/inst/rmd/app_project.Rmd
@@ -264,16 +264,18 @@ Repeat the same for sets.
 
 </details>
 ```{r, echo=F}
+selectInput(inputId="tag_sets_list",
+            label="Select set",
+            ## multiple=T, #TODO
+            choices=NULL,
+            selected=NULL)
+```
+```{r, echo=F}
 selectInput(inputId="tag_adducts_list",
             label="Select adducts",
             choices=shinyscreen:::DISP_ADDUCTS,
             multiple=T,
-            selected=NA_character_)
-```
-```{r, echo=F}
-selectInput(inputId="tag_set_list",
-            label="Select set",
-            choices=NULL)
+            selected=NULL)
 ```
 <!-- tag/adduct/set associations -->
 </div>
-- 
GitLab