app and others: Extraction now works and config is handled correctly

R/api.R

@@ -143,7 +143,7 @@ mk_comp_tab <- function(m) {
     comp <- cmpds[setid,on="ID"][mzml,.(tag,adduct,ID,RT,set,Name,Files,wd,SMILES,Formula,mz,known),on="set",allow.cartesian=T]
     tab2file(tab=comp,file=paste0("setidmerge",".csv"))
     setkey(comp,known,set,ID)
-
+    
     ## Known structure.
     ## comp[,`:=`(mz=mapply(calc_mz_from_smiles,SMILES,adduct,ID,USE.NAMES = F))]
     comp[known=="structure",`:=`(mz=calc_mz_from_smiles(SMILES,adduct,ID))]
@@ -275,6 +275,7 @@ extr_data <- function(m) {
 
     ## Reduce the comp table to only unique masses (this is because
     ## different sets can have same masses).
+    
     m$out$tab$data <- m$out$tab$comp[,head(.SD,1),by=c('adduct','tag','ID')]
     m$out$tab$data[,set:=NULL] #This column is meaningless now.
     files <- m$out$tab$data[,unique(Files)]
@@ -352,6 +353,9 @@ extr_data <- function(m) {
     message('Done saving extracted data.')
     
     m$extr$tmp <- NULL
+    timetag <- format(Sys.time(), "%Y%m%d_%H%M%S")
+    saveRDS(object = m, file = file.path(m$conf$project,
+                                         paste0(timetag,"_",FN_EXTR_STATE)))
     m
     
 }

R/mix.R

@@ -89,7 +89,7 @@ calc_mz_from_formula <- function(chform,adduct,id) {
                                                       charge=Charge),on=""])
     names(uadds) <- uad
     adds <- rbindlist(l=lapply(adduct,function(a) uadds[[a]]))
-    
+
     merger <- function (mol_form,add,ded) {
         res <- numeric(length(mol_form))
         both_ind <- which(add != 'FALSE' & ded != 'FALSE')
@@ -106,6 +106,19 @@ calc_mz_from_formula <- function(chform,adduct,id) {
         res
     }
     forms  <- merger(mol_form,adds$add,adds$ded)
+    
+    ## Check if formulas actually calculated.
+    bad_idx <- which(forms=="0")
+    bad_adducts <- adduct[bad_idx]
+    bad_ids <- id[bad_idx]
+    non_dups <- !duplicated(bad_idx)
+    bad_ids <- bad_ids[non_dups]
+    bad_adducts <- bad_adducts[non_dups]
+    if (length(bad_idx)>0) stop(paste0("Unable to process the adducts:\n",
+                                        paste(bad_adducts,collapse = ","),
+                                        "\nfor id-s:",
+                                        paste(bad_ids,collapse = ",")))
+    
     mz <- the_ifelse(!is.na(forms),
                      mapply(function(ff,ch) enviPat::isopattern(ISOTOPES,chemforms = ff,
                                                                 charge = ch, verbose = F)[[1]][1],

R/resources.R

@@ -33,6 +33,7 @@ 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"
 .envp <- new.env(parent = emptyenv())
 data(adducts,package = "enviPat", envir = .envp)
 data(isotopes,package = "enviPat", envir = .envp)

inst/rmd/app.Rmd

@@ -300,12 +300,6 @@ Leone pun):
 
 rhandsontable::rHandsontableOutput("summ_subset")
 
-## checkboxGroupInput("summ_subset",
-##                    label=NULL,
-##                    choiceNames = shinyscreen:::QA_FLAGS,
-##                    choiceValues = shinyscreen:::QA_FLAGS)
-
-
 ```
 </div>
 
@@ -328,23 +322,6 @@ rhandsontable::rHandsontableOutput("order_summ")
 
 </div>
 
-
-
-
-<!-- <details><summary>Order entries</summary> -->
-
-<!-- Sequence of column a -->
-
-<!-- </details> -->
-<!-- ```{r, echo=F} -->
-<!-- checkboxGroupInput("summ_subset", -->
-<!--                    label=NULL, -->
-<!--                    choiceNames = shinyscreen:::QA_FLAGS, -->
-<!--                    choiceValues = 1:length(shinyscreen:::QA_FLAGS)) -->
-
-<!-- ``` -->
-
-
 ## Plots
 
 ### Logarithmic axis
@@ -488,17 +465,16 @@ rf_conf_proj <- reactive({
 
 rf_conf_state <- reactive({
     state <- rf_conf_proj()
-    mzml1 <- rf_get_inp_datatab()
-    mzml1[,`:=`(tag=as.character(tag),
-                set=as.character(set),
-                adduct=as.character(adduct))]
-    mzml2 <- rf_get_inp_datafiles()
+    ## mzml1 <- rf_get_inp_datatab()
+    ## mzml1[,`:=`(tag=as.character(tag),
+    ##             set=as.character(set),
+    ##             adduct=as.character(adduct))]
+    ## mzml2 <- rf_get_inp_datafiles()
+    
+    ## mzml <- mzml1[mzml2,on="tag"]
     
-    mzml <- mzml1[mzml2,on="tag"]
-    data.table::setnames(mzml,"File","Files")
     ftab <- get_fn_ftab(state)
     state$conf$data <- ftab
-    state$input$tab$mzml <- mzml
     state$conf[["summary table"]]$filter <- rf_get_subset()
     state$conf[["summary table"]]$order <- rf_get_order()
     state
@@ -517,8 +493,8 @@ rf_get_subset <- reactive({
 
 rf_get_order <- reactive({
     dt <- tryCatch(rhandsontable::hot_to_r(input$order_summ),error = function(e) def_ord_summ)
-    dt[Direction == "descending",`Column Name` := paste0("-",`Column Name`)]
-    dt[,`Column Name`]
+    tmp <- dt[Direction == "descending",.(`Column Name`=paste0("-",`Column Name`))]
+    tmp[,`Column Name`]
 })
 
 rf_get_inp_datatab <- eventReactive(input$datatab,{
@@ -582,11 +558,9 @@ observeEvent(input$datafiles_b,{
 observe({
     df_tab <- rf_get_inp_datafiles()
     state <- rf_compound_input_state()
-    
     isolate(oldtab <- rf_get_inp_datatab())
-
+    
     oldt <- oldtab$tag
-
     tagl <- df_tab$tag
     diff <- setdiff(tagl,
                     oldt)
@@ -613,20 +587,39 @@ observe({
     rv_datatab(res)
 })
 
+observe({
+    dtab <- rv_datatab()
+    dfiles <- rv_dfiles()
 
+    message("(config) Generating mzml from rv.")
+    isolate(rv_state$input$tab$mzml <- dtab[dfiles,on="tag"])
 
+    
+}, label = "mzml_from_rv")
+
+observe({
+    dtab <- rf_get_inp_datatab()
+    dfiles <- rf_get_inp_datafiles()
+
+    message("(config) Generating mzml from inputs.")
+    res <- dtab[dfiles,on="tag"]
+    data.table::setnames(res,"File","Files")
+    isolate(rv_state$input$tab$mzml <- res)
+
+    
+}, label = "mzml_from_inp")
 
 observeEvent(input$extract_b,{
-    tmp <- rf_conf_state()
-    fn_c_state <- file.path(tmp$conf$project,
+    m <- rf_conf_state()
+    fn_c_state <- file.path(m$conf$project,
                             paste0("extract.",shinyscreen:::FN_CONF))
-    yaml::write_yaml(x=tmp$conf,file=fn_c_state)
+    yaml::write_yaml(x=m$conf,file=fn_c_state)
     message("(extract) Config written to ", fn_c_state)
-    state <- withr::with_dir(new=tmp$conf$project,
+    state <- withr::with_dir(new=m$conf$project,
                              code = {
-                                 m <- setup_phase(tmp)
-                                 m <- mk_comp_tab(tmp)
-                                 extr_data(tmp)
+                                 m <- setup_phase(m)
+                                 m <- mk_comp_tab(m)
+                                 extr_data(m)
                              })
     message("(extract) Done extracting.")
     rv_state <- list2rev(state)
@@ -732,7 +725,7 @@ observeEvent(input$conf_file_load_b,
 
             ## Files
             df <- shinyscreen:::file2tab(conf$data)
-            
+            df[,tag:=as.character(tag),with=T]
             rv_dfiles(df[,.(File=Files,tag)])
             nms <- colnames(df)
             nms <- nms[nms!="Files"]