DESCRIPTION

 Package: shinyscreen
 Title: Pre-screening of Mass Spectrometry Data 
-Version: 0.8.1
+Version: 0.9.0
 Author: Todor Kondić
 Maintainer: Todor Kondić <todor.kondic@uni.lu>
 Authors@R: 
@@ -41,15 +41,20 @@ Description: Pre-screening of Mass Spectrometry Data.
 License: Apache License (>= 2.0)
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 6.1.1
+RoxygenNote: 7.1.1
 Roxygen: list(markdown = TRUE)
 Collate:
-    'resources.R'
     'base.R'
+    'resources.R'
     'mix.R'
     'extraction.R'
-    'run.R'
-    'shinyUI.R'
+    'api.R'
+    'shiny-ui-base.R'
+    'shiny-ui-config.R'
+    'shiny-ui-cmpd.R'
+    'shiny-ui-sets.R'
+    'shiny-ui-gen.R'
+    'shiny-ui-top.R'
 Depends:
     RMassBank,
     RChemMass
@@ -57,9 +62,13 @@ Imports:
     tools,
     scales,
     parallel,
+    future,
     yaml,
     mzR,
     MSnbase,
+    data.table,
+    assertthat,
+    withr,
     ggplot2,
     cowplot,
     RColorBrewer,

NAMESPACE

 # Generated by roxygen2: do not edit by hand
 
+export(app)
+export(concurrency)
+export(conf_trans)
+export(create_plots)
+export(extr_data)
+export(extract)
+export(get_fn_comp)
+export(get_fn_conf)
+export(get_fn_extr)
+export(get_fn_ftab)
+export(get_fn_summ)
 export(launch)
+export(list2rev)
+export(load_compound_input)
+export(load_data_input)
+export(load_inputs)
+export(mk_comp_tab)
+export(mk_tol_funcs)
+export(mz_input)
+export(new_rv_state)
+export(new_state)
+export(new_state_fn_conf)
+export(prescreen)
+export(report)
+export(rev2list)
+export(rt_input)
+export(run)
+export(run_in_dir)
+export(save_plots)
+export(setup_phase)
+export(sort_spectra)
+export(subset_summary)
+import(data.table)
+importFrom(shiny,validate)

R/api.R

+## Copyright (C) 2020 by University of Luxembourg
+
+## Licensed under the Apache License, Version 2.0 (the "License");
+## you may not use this file except in compliance with the License.
+## You may obtain a copy of the License at
+
+##     http://www.apache.org/licenses/LICENSE-2.0
+
+## Unless required by applicable law or agreed to in writing, software
+## distributed under the License is distributed on an "AS IS" BASIS,
+## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+## See the License for the specific language governing permissions and
+## limitations under the License.
+
+
+##' @export
+new_state <- function() {
+    m <- new_conf()
+    init_state(m)
+}
+
+##' @export
+new_rv_state <- function() react_v(m=list2rev(new_state()))
+
+##' @export
+new_state_fn_conf <- function(fn_conf) {
+    m <- new_state()
+    m$conf <- read_conf(fn_conf)
+    init_state(m)
+}
+
+##' @export
+run <- function(fn_conf) {
+    m <- new_state_fn_conf(fn_conf)
+    
+    dir.create(m$conf$project,
+               showWarnings = F,
+               recursive = T)
+    m <- withr::with_dir(new=m$conf$project,code = run_in_dir(m))
+    return(invisible(m))
+}
+
+
+##' @export
+setup_phase <- function(m) {
+    m <- mk_tol_funcs(m)
+    m <- load_inputs(m)
+    m <- concurrency(m)
+    m
+}
+
+##' @export
+run_in_dir <- function(m) {
+    m <- setup_phase(m)
+    m <- mk_comp_tab(m)
+    m <- extr_data(m)
+    m <- prescreen(m)
+    m <- sort_spectra(m)
+    m <- subset_summary(m)
+    m <- create_plots(m)
+    m <- save_plots(m)
+    invisible(m)
+    
+}
+
+
+
+
+
+##' @export
+load_compound_input <- function(m) {
+
+    coll <- list()
+    fields <- colnames(EMPTY_CMPD_LIST)
+    fns <- m$conf$compounds$lists
+    for (l in 1:length(fns)) {
+        fn <- fns[[l]]
+        # fnfields <- somehow read the file columns in
+        dt <- file2tab(fn, colClasses=c(ID="character",
+                                        SMILES="character",
+                                        Formula="character",
+                                        Name="character",
+                                        RT="numeric",
+                                        mz="numeric"))
+        verify_cmpd_l(dt=dt,fn=fn)
+        # nonexist <- setdiff(fnfields,fields)
+        coll[[l]] <- dt #if (length(nonexist)==0) dt else dt[,(nonexist) := NULL]
+        coll[[l]]$ORIG <- fn
+        
+    }
+    cmpds <- if (length(fns)>0) rbindlist(l=c(list(EMPTY_CMPD_LIST), coll), use.names = T, fill = T) else EMPTY_CMPD_LIST
+
+    dups <- duplicated(cmpds$ID)
+    dups <- dups | duplicated(cmpds$ID,fromLast = T)
+    dupIDs <- cmpds$ID[dups]
+    dupfns <- cmpds$ORIG[dups]
+
+    msg <- ""
+    for (fn in unique(dupfns)) {
+        inds <- which(dupfns %in% fn)
+        fndupID <- paste(dupIDs[inds], collapse = ',')
+        msg <- paste(paste('Duplicate IDs', fndupID,'found in',fn),msg,sep = '\n')
+    }
+
+    ## TODO: Should we just kick out the duplicates, instead of
+    ## erroring?
+
+    assert(all(!dups), msg = msg)
+    
+    cmpds[,("known"):=.(the_ifelse(!is.na(SMILES),"structure",the_ifelse(!is.na(Formula),"formula","mz")))]
+    m$input$tab$cmpds <- cmpds
+    m$input$tab$setid <- read_setid(m$conf$compounds$sets,
+                                    m$input$tab$cmpds)
+    m
+}
+
+##' @export
+load_data_input <- function(m) {
+    m$input$tab$mzml <- file2tab(m$conf$data)
+    m
+
+}
+
+##' @export
+load_inputs <- function(m) {
+    m <- load_compound_input(m)
+    m <- load_data_input(m)
+    m
+}
+
+##' @export
+mk_comp_tab <- function(m) {
+    setid <- m$input$tab$setid
+    setkey(setid,set)
+    mzml<- m$input$tab$mzml
+    setkey(mzml,set)
+    cmpds<-m$input$tab$cmpds
+    setkey(cmpds,ID)
+    mzml[,`:=`(wd=sapply(Files,add_wd_to_mzml,m$conf$project))]
+    assert(nrow(cmpds)>0,msg="No compound lists have been provided.")
+    message("Begin generation of the comprehensive table.")
+    
+    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))]
+
+    ## Known formula.
+    comp[known=="formula",`:=`(mz=calc_mz_from_formula(Formula,adduct,ID))]
+    setnames(comp,names(COMP_NAME_MAP),
+             function(o) COMP_NAME_MAP[[o]])
+    setcolorder(comp,COMP_NAME_FIRST)
+    fn_out <- get_fn_comp(m)
+    tab2file(tab=comp,file=fn_out)
+    message("Generation of comp table finished.")
+    setkeyv(comp,c("set","tag","mz"))
+    m$out$tab$comp <- comp
+    m
+}
+
+
+verify_compounds <- function(conf) {
+    ## * Existence of input files
+
+    fns_cmpds <- conf$compounds$lists
+    fn_cmpd_sets <- conf$compounds$sets
+
+    ## ** Compound lists and sets
+
+    assert(isThingFile(fn_cmpd_sets),
+           msg=paste("Cannot find the compound sets file:",fn_cmpd_sets))
+
+    for (fn in fns_cmpds) {
+        assert(isThingFile(fn), msg=paste("Cannot find compound list:",fn))
+    }
+
+    ## * Data files
+    df_sets <- file2tab(fn_cmpd_sets)
+    all_sets<-unique(df_sets$set)
+
+    return(list(conf=conf,all_sets=all_sets))
+}
+
+verify_data_df <- function(mzml,all_sets) {
+    no_files <- which(mzml[,!file.exists(Files)])
+    no_adducts <- which(mzml[,!(adduct %in% names(ADDUCTMAP))])
+    no_sets <- which(mzml[,!(set %in% all_sets)])
+    assert(length(no_files)==0,msg = paste("Non-existent data files at rows:",paste(no_files,collapse = ',')))
+    assert(length(no_adducts)==0,msg = paste("Unrecognised adducts at rows:",paste(no_adducts,collapse = ',')))
+    assert(length(no_sets)==0,msg = paste("Unknown sets at rows:",paste(no_sets,collapse = ',')))
+}
+
+verify_data <- function(conf,all_sets) {
+    ## * Existence of input files
+    fn_data <- conf$data
+    assert(isThingFile(fn_data),msg=paste("Data table does not exist:",fn_data))
+    mzml <- file2tab(fn_data)
+    verify_data_df(mzml=mzml,all_sets)
+    return(conf)
+}
+
+#' @export
+concurrency <- function(m) {
+    ## Reads the concurrency entry in the config. It is optional, if
+    ## not given, then it is up to the user to define the plan of the
+    ## futures package. If present, it contains at least the `plan'
+    ## specification. It can also contain `workers` entry specifying
+    ## the number of workers. If that entry is absent, the default
+    ## number of workers is NO_WORKERS from the resources.R.
+    workers <- m$conf$concurrency$workers
+    plan <- m$conf$concurrency$plan
+    if (!is.null(plan) && plan!=user) {
+        n <- if (!is.null(workers)) workers else NO_WORKERS
+        if (!is.na(n)) future::plan(plan,workers=workers) else future::plan(plan)
+        m$conf$concurrency$workers <- n
+
+    } else {
+        m$conf$concurrency$workers <- NA
+        m$conf$concurrency$plan <- "user"
+    }
+    message("plan: ",m$conf$concurrency$plan)
+    message("workers: ",m$conf$concurrency$workers)
+
+    ## So we can actually debug.
+    m$future <- if (!m$conf$debug)
+                    future::future
+                else {
+                    message("Debug: futures evaluate as identity")
+                    function(x,...) identity(x)
+                }
+    m
+}
+
+#' @export
+mk_tol_funcs <- function(m) {
+    ## Depending on units given when the user specified the errors,
+    ## generate functions that calculate errors given the concrete
+    ## mass.
+
+    ## Mass errors can be either in ppm, or Da.
+    ## Time errors in min, or s.
+
+    ## The mass error calculation functions and the retention time
+    ## error in minutes are in m$extr$tol.
+
+    ## TODO make these things compatible with futures.
+
+
+
+    m$extr$tol$coarse <- gen_mz_err_f(m$conf$tolerance[["ms1 coarse"]],
+                                      "ms1 coarse error: Only ppm, or Da units allowed."
+                                      )
+
+
+    m$extr$tol$fine <- gen_mz_err_f(m$conf$tolerance[["ms1 fine"]],
+                                    "ms1 fine error: Only ppm, or Da units allowed.")
+
+    m$extr$tol$eic <- gen_mz_err_f(m$conf$tolerance$eic,
+                                   "eic error: Only ppm, or Da units allowed.")
+
+ 
+    m$extr$tol$rt <- gen_rt_err(m$conf$tolerance$rt,
+                                "rt error: Only s(econds), or min(utes) allowed.")
+    
+    m
+    
+}
+
+
+##' @export
+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)]
+    allCEs <- do.call(c,args=lapply(files,function(fn) {
+        z <- MSnbase::readMSData(files=fn,msLevel = c(1,2),mode="onDisk")
+        unique(MSnbase::collisionEnergy(z),fromLast=T)
+        
+    }))
+    allCEs <- unique(allCEs)
+    allCEs <- allCEs[!is.na(allCEs)]
+    cols <-paste('CE',allCEs,sep = '')
+    vals <- rep(NA,length(cols))
+    m$out$tab$data[,(cols) := .(rep(NA,.N))]
+    files <- m$out$tab$data[,unique(Files)]
+    ftags <- m$out$tab$data[,.(tag=unique(tag)),by=Files]
+    futuref <- m$future
+    tmp <- lapply(1:nrow(ftags),function(ii) {
+        fn <- ftags[ii,Files]
+        tag <- ftags[ii,tag]
+        tab <- as.data.frame(data.table::copy(m$out$tab$data[,.(Files,adduct,mz,rt,ID)]))
+        ## err_ms1_eic <- m$extr$tol$eic
+        ## err_coarse_fun <- m$extr$tol$coarse
+        ## err_fine_fun <- m$extr$tol$fine
+        ## err_rt <- m$extr$tol$rt
+
+        err_coarse <- m$conf$tolerance[["ms1 coarse"]]
+
+
+        err_fine <- m$conf$tolerance[["ms1 fine"]]
+
+        
+        err_ms1_eic <- m$conf$tolerance$eic 
+        
+        
+        err_rt <- m$conf$tolerance$rt
+                                   
+        x <- futuref(extract(fn=fn,
+                             tab=tab,
+                             err_ms1_eic=err_ms1_eic,
+                             err_coarse = err_coarse,
+                             err_fine= err_fine,
+                             err_rt= err_rt),
+                     lazy = T)
+
+        x
+
+    })
+
+    msk <- sapply(tmp,future::resolved)
+    curr_done <- which(msk)
+    
+    for (x in curr_done) {
+        message("Done extraction for ", unique(future::value(tmp[[x]])$Files))
+    }
+    while (!all(msk)) {
+        msk <- sapply(tmp,future::resolved)
+        newly_done <- which(msk)
+        for (x in setdiff(newly_done,curr_done)) {
+            message("Done extraction for ", unique(future::value(tmp[[x]])$Files))
+        }
+        Sys.sleep(0.5)
+        curr_done <- newly_done
+    }
+    ztmp <- lapply(tmp,future::value)
+
+    ## ## We need to add in Files (after futures are resolved).
+    ## for (nn in 1:nrow(ftags)) {
+    ##     fn <- ftags[nn,Files]
+    ##     ztmp[[nn]]$Files <- fn
+    ## }
+    m$extr$ms <- data.table::rbindlist(ztmp)
+    fn_ex <- get_fn_extr(m)
+    message('Saving extracted data to ', fn_ex)
+    saveRDS(object = m$extr, file = fn_ex)
+    message('Done saving extracted data.')
+    
+    m$extr$tmp <- NULL
+    m
+    
+}
+
+##' @export
+conf_trans <- function(conf) {
+    conf$prescreen <- conf_trans_pres(conf$prescreen)
+    conf
+}
+
+##' @export
+prescreen <- function(m) {
+    ## Top-level auto prescreening function.
+
+    confpres <- conf_trans_pres(m$conf$prescreen)
+
+    ## TODO need to fix max spec intensity
+    gen_ms2_spec_tab <- function(ms) {data.table::rbindlist(lapply(1:nrow(ms), function (nr) {
+        adduct <- ms$adduct[[nr]]
+        ID <- ms$ID[[nr]]
+        Files <- ms$Files[[nr]]
+        spec <- ms$spec[[nr]]
+        ms2_sel <- ms$ms2_sel[[nr]]
+        dt <- if (length(spec[[1]]) < 3)
+                  dtable(CE=NA_real_,
+                         rt=NA_real_,
+                         spec=list(dtable(mz=NA_real_,intensity=NA_real_)),
+                         ms2_sel=NA) else {
+                                                                                dtable(
+                                                                                    CE=sapply(spec,
+                                                                                              function (x) x$CE),
+                                                                                    rt=sapply(spec,
+                                                                                              function (x) x$rt),
+                                                                                    spec=lapply(spec,
+                                                                                                function (x) x$spec),
+                                                                                    ms2_sel=F)
+                                      }
+        if (!is.na(ms2_sel)) dt$ms2_sel[[ms2_sel]] <- T
+        
+        
+        dt$Files <- Files
+        dt$ID <- ID
+        dt$adduct <- adduct
+        dt[,ms2_max_int := .(sapply(spec,function (sp) sp[,max(intensity)]))] 
+        dt
+    }))}
+
+    gen_ms1_spec_tab <- function(ms) {
+        cols <- MS1_SPEC_COLS
+        ms[,..cols]
+    }
+
+
+    m$qa <- create_qa_table(m$extr$ms,confpres)
+    mms1 <- assess_ms1(m)
+    m <- assess_ms2(mms1)
+    fields <- c("Files","adduct","ID",QA_COLS)
+    m$out$tab$ms2_spec <- gen_ms2_spec_tab(m$qa$ms)
+    m$out$tab$ms1_spec <- gen_ms1_spec_tab(m$qa$ms)
+    m$out$tab$summ <- merge(m$out$tab$comp,m$qa$ms[,..fields],by=c("Files","adduct","ID"))
+    data.table::setkeyv(m$out$tab$ms2_spec,c("adduct","Files","ID"))
+    data.table::setkeyv(m$out$tab$ms1_spec,c("adduct","Files","ID"))
+    
+    m
+}
+
+
+
+
+##' Sets the key specified by DEF_KEY_SUMM and adds second indices,
+##' either from DEF_INDEX_SUMM, or user-specified in
+##' conf[["summary table"]]$order. The order entry is a list of
+##' strings with names of columns in summ, optionally prefixed with a
+##' minus(-) sign. Columns prefixed with the minus are going to be in
+##' ascending order.
+##'
+##' @title Sort the Summary Table 
+##' @param m 
+##' @return m
+##' @author Todor Kondić
+##' @export
+sort_spectra <- function(m) {
+    ## Sorts the summary table (summ) in order specified either in
+    ## `order spectra` sublist of m$conf, or if that is null, the
+    ## DEF_INDEX_SUMM.
+
+    ## Here set default sorting keys.
+    data.table::setkeyv(m$out$tab$summ,DEF_KEY_SUMM)
+
+    ## Now, add secondary indexing.
+    cols <- if (!is.null(m$conf[["summary table"]]$order)) m$conf[["summary table"]]$order else DEF_INDEX_SUMM
+    
+    idx <- gsub("^\\s*-\\s*","",cols) #We need only column names for
+                                      #now, so remove minuses where
+                                      #needed.
+    assertthat::assert_that(all(idx %in% colnames(m$out$tab$summ)),msg = "Some column(s) in order key in conf file does not exist in the summary table.")
+
+    data.table::setindexv(m$out$tab$summ,idx)
+
+    ## Now we order based on either summary table order subkey, or
+    ## DEF_ORDER_SUMM
+    
+    tmp <- quote(data.table::setorder())
+    tmp[[2]] <- quote(m$out$tab$summ)
+    for (n in 1:length(cols)) tmp[[2+n]] <- parse(text=cols[[n]])[[1]]
+    message("Ordering expression: ",tmp)
+    eval(tmp) #Execute the setorder call
+
+    m
+}
+
+##' Subsets the summary table by applying conditions set out in the
+##' filter subkey of summary table key of the config. Each member of
+##' filter is an expression that and all of them are chained together
+##' using AND logical operation and applied to the summary table.
+##'
+##' 
+##' @title Subset the Summary Table
+##' @param m 
+##' @return m
+##' @author Todor Kondić
+##' @export
+subset_summary <- function(m) {
+    filt <- m$conf[["summary table"]]$filter
+    m$out$tab$flt_summ <- if (!is.null(filt)) {
+                              tmp <- lapply(filt, function (x) parse(text = x)[[1]])
+                              expr <- Reduce(function (x,y) {z<-call("&");z[[2]]<-x;z[[3]]<-y;z},x=tmp)
+                              message("Filtering with: ",deparse(bquote(m$out$tab$summ[.(expr)])))
+                              eval(bquote(m$out$tab$summ[.(expr)]))
+                              
+                              
+                          } else m$out$tab$summ
+    m
+}
+
+
+#' @export
+create_plots <- function(m) {
+    ## Helpers
+    textf <- ggplot2::element_text
+    x <- m$out$tab$ms1_spec
+    y <- m$out$tab$flt_summ
+    
+
+
+    ## Logarithmic, or linear y axis?
+    scale_y_ms1_eic <- if (shiny::isTruthy(m$conf$logaxes$ms1_eic_int))
+                           ggplot2::scale_y_log10 else ggplot2::scale_y_continuous
+
+    scale_y_ms2_eic <- if (shiny::isTruthy(m$conf$logaxes$ms2_eic_int))
+                           ggplot2::scale_y_log10 else ggplot2::scale_y_continuous
+
+    scale_y_ms2_spec <- if (shiny::isTruthy(m$conf$logaxes$ms2_spec_int))
+                            ggplot2::scale_y_log10 else ggplot2::scale_y_continuous
+
+    ## Colour palette.
+    tags <- y[,unique(tag)]
+    getpal <- colorRampPalette(RColorBrewer::brewer.pal(8,"Dark2"))
+    col_all_vals <- getpal(length(tags))
+    names(col_all_vals) <- tags
+    scale_colour <- function(values=col_all_vals,...) ggplot2::scale_colour_manual(values = values,name=m$conf$figures[["legend title"]],...)
+
+
+    rt_lim <- DEFAULT_RT_RANGE
+    if (!is.null(m$conf$figures$rt_min)) rt_lim[[1]] <- m$conf$figures$rt_min
+    if (!is.null(m$conf$figures$rt_max)) rt_lim[[2]] <- m$conf$figures$rt_max
+    
+    my_coord <- ggplot2::coord_cartesian(xlim = rt_lim)
+    conf_psub <- m$conf$figures[["plot subset"]]
+    psub <- if (!is.null(conf_psub)) conf_psub else FIG_DEF_SUBSET
+    assertthat::assert_that(all(psub %in% colnames(y)), msg = "Some plot subset columns are not recognised.")
+
+    mk_title<-function(txt, mass) paste(txt," ",
+                                   "m/z = ",
+                                   formatC(mass,format='f',digits=M_DIGITS),sep='')
+
+
+    mk_leg_lab<-function(tag,rt) {if (length(tag) > 0) paste(tag,"; rt= ",formatC(rt,format='f',digits=RT_DIGITS)," min",sep='') else character(0)}
+
+    sci10<-function(x) {ifelse(x==0, "0", parse(text=gsub("[+]", "", gsub("e", " %*% 10^", scales::scientific_format()(x)))))}
+    
+    my_theme <- function (...) ggplot2::theme()
+
+    plot_eic_ms1 <- function(df) {
+
+        mz <- df[,unique(mz)]
+        ID <- df[,unique(ID)]
+        tbl <- df[,.(labs=mk_leg_lab(tag,rt_peak),tag=tag),by=c("tag","rt_peak")]
+        labs <- tbl[,labs]
+        tags <- tbl[,tag]
+        df[,tag:=factor(tag)]
+        ggplot2::ggplot(df,ggplot2::aes(x=rt,y=intensity,colour=tag)) +
+            ggplot2::geom_line(key_glyph=KEY_GLYPH) +
+            ggplot2::labs(x=CHR_GRAM_X,
+                          y=CHR_GRAM_Y
+                          ## title=mk_title("EIC", mz),
+                          ## tag=ID
+                          ) +
+            scale_y_ms1_eic(labels=sci10) +
+            scale_colour(values=col_all_vals[as.character(tags)]) +
+            my_coord +
+            my_theme()
+    }
+
+    plot_eic_ms2 <- function(df) {
+        mz <- df[,unique(mz)]
+        ID <- df[,unique(ID)]
+        ddf <- df[!is.na(rt)==T]
+        ## df[,tag:=factor(tag)]
+        ggplot2::ggplot(ddf,ggplot2::aes(x=rt,ymin=0,ymax=ms2_max_int,color=tag)) +
+            ggplot2::geom_linerange(key_glyph=KEY_GLYPH) +
+            ggplot2::labs(x=CHR_GRAM_X,
+                          y=CHR_GRAM_Y
+                          ## title=mk_title("MS2 EIC for precursor",mz),
+                          ## tag=ID
+                          ) +
+            scale_y_ms2_eic(labels=sci10) +
+            scale_colour(values=col_all_vals[as.character(ddf$tag)]) +
+            my_coord +
+            my_theme()
+    }
+
+    plot_spec_ms2 <- function(df) {
+        ddf <- df[ms2_sel == T]
+        mz <- ddf[,unique(mz)]
+        ID <- ddf[,unique(ID)]
+
+        tags <- ddf[,tag]
+        specs <- ddf[,spec]
+        rts <- ddf[,rt]
+        lst <- Map(function(d,t) {d$tag<-t;d},specs,tags)
+        data <- dtable(mz=numeric(0),intensity=numeric(0),tag=factor(0))
+        data <- rbind(data,
+                      data.table::rbindlist(lst),
+                      fill=T)
+        data <- data[!(is.na(mz)),]
+
+        leglabs <- mk_leg_lab(tags,rts)
+        ggplot2::ggplot(data,ggplot2::aes(x=mz,ymin=0,ymax=intensity,color=tag)) +
+            ggplot2::geom_linerange(key_glyph=KEY_GLYPH) +
+            ggplot2::labs(x="mz",
+                          y="intensity"
+                          ## tag=ID,
+                          ## title=mk_title("MS2 spectrum for precursor",mz)
+                          ) +
+            scale_y_ms2_spec(labels=sci10) +
+            scale_colour(values=col_all_vals[as.character(tags)]) +
+            my_theme()
+    }
+
+    ## MS1
+    tmp <- y[x,.(set,adduct,Files,ID,tag,mz,rt_peak=i.ms1_rt,eicMS1=lapply(i.eicMS1,list)), on=c("adduct","Files","ID"),nomatch=NULL]
+    
+    message("Start generating MS1 EICs.")
+    z <- tmp[,.(fig= {
+        df <- .SD[,data.table::rbindlist(Map(function (a,b,c) {
+            s <- a[[1]]
+            s$tag <- b
+            s$rt_peak <- c
+            s},eicMS1,tag,rt_peak))]
+
+        df$mz <- .SD[,unique(mz)]
+        df$ID <- .SD[,unique(ID)]
+        list(plot_eic_ms1(df))
+    }),by=psub,.SDcols=c("eicMS1","tag","mz","ID")]
+    message("Done generating MS1 EICs.")
+    structab <- z[,.(ID=unique(ID))]
+    structab <- m$out$tab$comp[known=="structure",][structab,.(ID=i.ID,SMILES=SMILES),on="ID",nomatch=NULL,mult="first"]
+    message("Start generating structures.")
+    structab[,structimg:=.(lapply(SMILES,function (sm) smiles2img(sm,width = 500,height = 500, zoom = 4.5)))]
+    message("Done generating structures.")
+    
+    q <- structab[z,on="ID"][,c("structfig") := .(Map(function (st,eic) {
+        df <- eic[[1]]$data
+        ddf <- dtable(x=df$rt,
+                                    y=df$intensity)
+        ggplot2::ggplot(ddf) +
+            ggplot2::geom_blank() +
+            ggplot2::annotation_custom(st) +
+            ggplot2::theme_void()
+    },
+    structimg,
+    fig))]
+    m$out$tab$ms1_plot_eic <- q[,structimg:=NULL]
+    data.table::setkeyv(m$out$tab$ms1_plot_eic,c("set","adduct","ID"))
+
+    ## MS2
+    x <- m$out$tab$ms2_spec 
+    tmp <- y[x,.(set,adduct,Files,
+                 ID=ID,tag=factor(tag),mz,CE=i.CE,
+                 rt=i.rt,ms2_max_int,
+                 spec=i.spec,
+                 ms2_sel=i.ms2_sel), on = c("adduct","Files","ID")]
+
+    message("Start generating MS2 EICs.")
+    m$out$tab$ms2_plot <- tmp[,.(fig_eic = list(plot_eic_ms2(.SD)),
+                                 fig_spec = list(plot_spec_ms2(.SD))),
+                              .SDcols=c("rt","ms2_max_int",
+                                        "tag","spec","ms2_sel","mz","ID"),
+                              by = psub]
+    message("Done generating MS2 EICs.")
+    data.table::setkeyv(m$out$tab$ms2_plot,c("set","adduct","ID"))
+
+    
+    m
+    
+}
+
+
+#' @export
+save_plots <- function(m) {
+    topdir <- FIG_TOPDIR 
+    dir.create(topdir,showWarnings = F)
+
+    rt_lim <- DEFAULT_RT_RANGE
+    if (!is.null(m$conf$figures$rt_min)) rt_lim[[1]] <- m$conf$figures$rt_min
+    if (!is.null(m$conf$figures$rt_max)) rt_lim[[2]] <- m$conf$figures$rt_max
+    
+    my_theme <- function(...) ggplot2::theme(legend.position = "none",...)
+
+
+    clean_range<-function(def,rng) {
+        x1 <- rng[1]
+        x2 <- rng[2]
+        if (is.na(x1) || x1 == 0) x1 <- def[1]
+        if (is.na(x2) || x2 == 0) x2 <- def[2]
+        c(x1,x2)
+    }
+
+    
+    sets <- m$out$tab$flt_summ[,unique(set)]
+    for (s in sets) {
+        sdf <- m$out$tab$flt_summ[set==s,]
+        group <- sdf[,unique(adduct)]
+        for (g in group) {
+            asdf <- sdf[adduct==g,] 
+            ids <- asdf[,unique(ID)]
+            for (id in ids) {
+                message("Image ","set: ",s," group: ", g, " id: ",id)
+                tab <- asdf[ID==id,.(tag,ms1_int,ms1_rt,adduct,mz)]
+                ms1_figs <- m$out$tab$ms1_plot_eic[set==s & adduct==g & ID==id,.(fig,structfig)]
+                ms2_figs <- m$out$tab$ms2_plot[set==s & adduct==g & ID==id,.(fig_eic,fig_spec)]
+                ms1_eic <- ms1_figs$fig[[1]]
+                rt_rng <- range(ms1_eic$data[,rt])
+                if (!is.na(rt_lim[[1]])) rt_rng[[1]] <- rt_lim[[1]]
+                if (!is.na(rt_lim[[2]])) rt_rng[[2]] <- rt_lim[[2]]
+                my_coord <- ggplot2::coord_cartesian(xlim = rt_rng)
+                ms2_eic <- ms2_figs$fig_eic[[1]]+my_coord #ggplot2::coord_cartesian(xlim = rt_rng)
+                ms2_spec <- ms2_figs$fig_spec[[1]]
+                xxdf <- ms1_figs$fig[[1]]$data[,.(rt=rt,intensity=intensity)]
+                empty_fig <- ggplot2::ggplot(xxdf,ggplot2::aes(x=rt,y=intensity)) +
+                    ggplot2::geom_blank() +
+                    ggplot2::theme_void()
+
+                ## if (id == 1078) browser()
+                if (NROW(ms2_eic$data) == 0) ms2_eic <- empty_fig
+                if (NROW(ms2_spec$data) == 0) ms2_spec <- empty_fig
+                leg <- cowplot::get_legend(ms1_eic)
+                big_fig <- cowplot::plot_grid(ms1_eic+my_theme(),
+                                              ms1_figs$structfig[[1]],
+                                              ms2_eic+my_theme(),
+                                              empty_fig,
+                                              ms2_spec+my_theme(),leg,
+                                              align = "hv",
+                                              axis='l',
+                                              ncol = 2,
+                                              nrow = 3,
+                                              rel_widths = c(2,1))
+                ggplot2::ggsave(plot=big_fig,filename = fig_path(top=topdir,
+                                                                 set=s,
+                                                                 group=g,
+                                                                 id=id,
+                                                                 suff="all"))
+                
+                
+            }
+            
+        }
+    }
+
+    m
+
+    
+}
+
+#' @export
+report <- function(m) {
+    figtopdir <- FIG_TOPDIR #file.path(m$conf$project,FIG_TOPDIR)
+    pander::evalsOptions("graph.output","pdf")
+    author <- if (!is.null(m$conf$report$author)) m$conf$report$author else REPORT_AUTHOR
+    title <- if (!is.null(m$conf$report$title)) m$conf$report$title else REPORT_TITLE
+    doc <- pander::Pandoc$new(author,title)
+    doc$add(pander::pandoc.header.return("Plots",level = 1))
+    sets <- m$out$tab$flt_summ[,unique(set)]
+    rep_theme <- ggplot2::labs(title = NULL)
+    for (s in sets) {
+        doc$add(pander::pandoc.header.return(paste('Set', s), level = 2))
+        sdf <- m$out$tab$flt_summ[set==s,]
+        group <- sdf[,unique(adduct)]
+        for (g in group) {
+            asdf <- sdf[adduct==g,] 
+            ids <- asdf[,unique(ID)]
+            for (id in ids) {
+                message("Image ","set: ",s," group: ", g, " id: ",id)
+                doc$add(pander::pandoc.header.return(paste('ID',id),level = 3))
+                tab <- asdf[ID==id,.(tag,ms1_int,ms1_rt,adduct,mz,Files)]
+                ms2info <- m$out$tab$ms2_spec[adduct==g & ID==id,.(Files,ID,rt,ms2_max_int)]
+                tab2 <- tab[ms2info,on="Files"][,.(tag,mz,adduct,"$RT_{ms1}$[min]"=ms1_rt,"$RT_{ms2}$[min]"=rt,"$I{ms1}$"=formatC(ms1_int, format="e",digits = 2), "$I(ms2)$"= formatC(ms2_max_int, format="e",digits = 2))]
+                data.table::setorderv(tab2,c("$I{ms1}$","$I(ms2)$"),c(-1,-1))
+                doc$add.paragraph("")
+                figpath <- fig_path(top=figtopdir,set=s,group=g,id=id,suff="all",ext="pdf")
+                doc$add(pander::pandoc.image.return(img=paste0("file:",figpath)))
+                doc$add.paragraph("")
+                message("Adding table.")
+                doc$add.paragraph(pander::pandoc.table.return(tab2))
+                message("Done adding table.")
+                ## doc$add(print(tab))
+                doc$add.paragraph("")
+                
+            }
+            
+        }
+    }
+    doc$add(pander::pandoc.header.return("Appendix", level = 1))
+    doc$add(pander::pandoc.header.return("Configuration",level = 2))
+    doc$add(m$conf)
+    doc$add(pander::pandoc.header.return("R Session Info",level = 2))
+    doc$add(sessionInfo())
+    m$out$report <- doc
+    m$out$report$export('report.pdf')
+    m
+}
+
+
+#' @export
+app <- function() {
+    unlink(list.files(pattern = "app_run.*html$"))
+    unlink(list.files(pattern = "app_run.*Rmd$"))
+    file.copy(system.file(file.path("rmd","app.Rmd"),package = "shinyscreen"),"app_run.Rmd")
+    rmarkdown::run(file = "app_run.Rmd")
+}

R/base.R

@@ -12,16 +12,18 @@
 ## See the License for the specific language governing permissions and
 ## limitations under the License.
 
+
+##' @import data.table
+## Redirections
+the_ifelse <- data.table::fifelse
+dtable <- data.table::data.table
+
 tab2file<-function(tab,file,...) {
-    write.csv(x=tab,file=file,row.names=F,...)
+    data.table::fwrite(x=tab,file=file,...)
 }
 
-file2tab<-function(file,stringsAsFactors=F,comment.char='',sep=',',...) {
-    read.csv(file=file,
-             header=T,
-             stringsAsFactors=stringsAsFactors,
-             comment.char=comment.char,
-             na.strings=c("","NA"),...)
+file2tab<-function(file,na.strings=c("","NA","\"\""),...) {
+    data.table::fread(file=file,na.strings = na.strings, ...)
 }
 
 isThingFile<-function(fn) {
@@ -30,3 +32,24 @@ isThingFile<-function(fn) {
     } else F
 }
 
+## Stolen from Stack Overflow
+split_path <- function(path) {
+  if (dirname(path) %in% c(".", path)) return(basename(path))
+  return(c(basename(path), split_path(dirname(path))))
+}
+
+
+print_table <- function (df) {
+    paste(apply(df,1,function (row) paste(row,collapse=',')),collapse = "\n")
+}
+
+assert <- function(expr,msg) shiny::validate(shiny::need(expr,message=msg))
+
+
+gen_uniq_lab <- function(prev,pref='',suff='') {
+    l <- length(prev)
+    gen <- function() paste0(pref,as.integer(runif(1,min=l,max=2L*l+1L)),suff)
+    cand <- gen()
+    while (cand %in% prev) cand <- gen()
+    c(prev,cand)
+}

R/extraction.R

@@ -19,6 +19,30 @@ load_raw_data<-function(fn,mode="inMemory") {
 }
 
 
+centroided1 <- function(ms) {
+    if (all(MSnbase::centroided(ms)) == T)
+        return(T) else {
+                      state <- MSnbase::isCentroided(ms)
+                      N <- length(state)
+                      fls <-length(which(state == F))
+                      if (fls/(1.*N) < 0.01) T else F
+                  }
+                                                         
+}
+
+centroided <- function(msvec) {
+    if (is.vector(msvec)) {
+        f <- list()
+        for (i in 1:length(msvec)) {
+            f[[i]] <- future::future(centroided1(msvec[[i]]))
+        }
+        lapply(f, FUN = future::value)
+    } else {
+        centroided1(msvec)
+    }
+    
+}
+
 acq_mz<-function(tabFn) {
     df<-read.csv(tabFn,
                  stringsAsFactors=F,
@@ -33,17 +57,15 @@ id2name<-function(id) {paste("ID:",id,sep='')}
 
 ppm2dev<-function(m,ppm) 1e-6*ppm*m
 
-
-
 gen_mz_range<-function(mz,err) {
-    mat<-matrix(data=numeric(1),nrow=length(mz),ncol=2,dimnames=list(as.character(names(mz))))
+    mat<-matrix(data=numeric(1),nrow=length(mz),ncol=2)
     mat[,1]<-mz - err
     mat[,2]<-mz + err
     mat
 }
 
 gen_rt_range<-function(rt,err) {
-    mat<-matrix(data=numeric(1),nrow=length(rt),ncol=2,dimnames=list(as.character(names(rt))))
+    mat<-matrix(data=numeric(1),nrow=length(rt),ncol=2)
     rV<-which(!is.na(rt))
     rNA<-which(is.na(rt))
     mat[rV,1]<-(rt[rV] - err)*60
@@ -53,10 +75,7 @@ gen_rt_range<-function(rt,err) {
     mat
 }
 
-filt_ms2_by_prcs <- function(ms2,mz,errCoarse) {
-
-    mzRng<-gen_mz_range(mz,err=errCoarse)
-    ids<-rownames(mzRng)
+filt_ms2_by_prcs <- function(ms2,mzrng,ids,adduct) {
     pre<-MSnbase::precursorMz(ms2)
     psn<-MSnbase::precScanNum(ms2)
     acN<-MSnbase::acquisitionNum(ms2)
@@ -64,37 +83,41 @@ filt_ms2_by_prcs <- function(ms2,mz,errCoarse) {
 
     inRange<-function(i) {
         mp<-pre[[i]]
-        x<-mzRng[,1]<mp & mp<mzRng[,2]
-        mRows<-which(x)
-        sids<-ids[mRows]
-        sids
+        x<-mzrng[,1]<mp & mp<mzrng[,2]
+        ind<-which(x)
+        sids <- ids[ind]
+        add <- adduct[ind]
+        dtable(ID=sids,adduct=add)
     }
-    lst<-lapply(1:nR,function(i) list(n=i,prec_scan=psn[[i]],aN=acN[[i]],ids=inRange(i)))
+    lst<-lapply(1:nR,function(i) {
+        dt <- inRange(i)
+        list(n=i,prec_scan=psn[[i]],aN=acN[[i]],ids=dt$ID,adduct=dt$adduct)
+    })
     nemp<-sapply(lst,function(m) length(m$ids)>0)
     wrk<-lst[nemp]
     dfL<-sum(sapply(wrk,function(w) length(w$ids)))
-    df<-data.frame(ID=character(dfL),
-                   prec_scan=integer(dfL),
-                   aN=integer(dfL),
-                   OK=logical(dfL),
-                   stringsAsFactors=F)
+    df<-dtable(ID=character(dfL),
+               adduct=character(dfL),
+               prec_scan=integer(dfL),
+               aN=integer(dfL),
+               OK=logical(dfL))
     df$OK<-T #TODO Introduced for testing, be careful.
 
     offD<-0
     for (m in wrk) {
         l<-length(m$ids)
         rng<-(offD+1):(offD+l)
-        df[rng,"ID"]<-m$ids
-        df[rng,"prec_scan"]=m$prec_scan
-        df[rng,"aN"]<-m$aN
+        df[rng,"ID"] <- m$ids
+        df[rng,"prec_scan"] <- m$prec_scan
+        df[rng,"aN"] <- m$aN
+        df[rng,"adduct"] <- m$adduct
         offD<-offD+l
     }
     df[order(df$aN),]
 }
 
-filt_ms2_by_prcs_ht<-function(ms2,mz,errCoarse) {
-    lgnd<-filt_ms2_by_prcs(ms2,mz,errCoarse)
-
+filt_ms2_by_prcs_ht<-function(ms2,mzrng,ids,adduct) {
+    lgnd<-filt_ms2_by_prcs(ms2,mzrng=mzrng,ids=ids,adduct=adduct)
     scans<-unique(lgnd$aN)
     ns<-which(MSnbase::acquisitionNum(ms2) %in% scans)
     sms2<-ms2[ns]
@@ -105,29 +128,37 @@ filt_ms2_by_prcs_ht<-function(ms2,mz,errCoarse) {
 pick_unique_precScans<-function(idx) {
     ps<-unique(idx$prec_scan)
     mind<-match(ps,idx$prec_scan)
-    ids<-idx$ID[mind]
-    data.frame(prec_scan=idx$prec_scan[mind],ID=ids,stringsAsFactors=F)
+    data.frame(prec_scan=idx$prec_scan[mind],
+               ID=idx$ID[mind],
+               adduct=idx$adduct[mind],
+               stringsAsFactors=F)
     
 }
 
 pick_uniq_pscan<-function(leg) {
-    ids<-unique(leg$ID)
-    x<-lapply(ids,function(id) {ups<-unique(leg[id==leg$ID,"prec_scan"]);data.frame(ID=rep(id,length(ups)),prec_scan=ups,stringsAsFactors = F)})
-    res<-do.call(rbind,c(x,list(stringsAsFactors=F)))
-    res[order(res$prec_scan),]
+    res <- leg[,.(prec_scan=unique(prec_scan)),by=c("ID","adduct")]
+    res[order(prec_scan),]
+    ## ids<-unique(leg$ID)
+    ## x<-lapply(ids,function(id) {ups<-unique(leg[id==leg$ID,"prec_scan"]);data.frame(ID=rep(id,length(ups)),prec_scan=ups,stringsAsFactors = F)})
+    ## res<-do.call(rbind,c(x,list(stringsAsFactors=F)))
+    ## res[order(res$prec_scan),]
 }
 
-verif_prec_fine_ht<-function(preLeg,ms1,mz,errFinePPM) {
-    mzRng<-gen_mz_range(mz,err=ppm2dev(mz,errFinePPM))
+verif_prec_fine_ht<-function(preLeg,ms1,mz,mzrng,ids,adduct) {
+    ## TODO FIXME TESTPHASE Something goes wrong here, all mapply results are
+    ## not OK. More testing needed.
     df<-preLeg
-    df$mz<-mz[df$ID]
-    mz1<-mzRng[df$ID,1]
-    mz2<-mzRng[df$ID,2]
-    ipns<-match(df$prec_scan,MSnbase::acquisitionNum(ms1))
-    rms1<-ms1[ipns]
-    mzsp<-MSnbase::mz(rms1)
-    df$OK<-mapply(function(m1,sp,m2) any((m1<sp) & (sp<m2)),mz1,mzsp,mz2)
-    df[df$OK,]     
+    xx <- dtable(adduct=adduct,ID=ids,mz=mz,mz1=mzrng[,1],mz2=mzrng[,2])
+    df <- preLeg[xx,on=c("ID","adduct")]
+    df$ipns<-match(df$prec_scan,MSnbase::acquisitionNum(ms1))
+    df[, ("mzsp") := .(lapply(ipns,function (ip) if (!is.na(ip)) MSnbase::mz(ms1[[ip]]) else NA_real_))]
+    df$OK<-mapply(function(m1,sp,m2) any((m1<sp) & (sp<m2)),df$mz1,df$mzsp,df$mz2)
+    res<-df[df$OK,]
+    res$ipns<-NULL
+    res$mz1<-NULL
+    res$mz2<-NULL
+    res$mzsp<-NULL
+    res
 }
 
 filt_ms2<-function(ms1,ms2,mz,errCoarse,errFinePPM) {
@@ -150,6 +181,55 @@ filt_ms2<-function(ms1,ms2,mz,errCoarse,errFinePPM) {
     names(res)<-uids
     res
 }
+filt_ms2_fine <- function(ms1,ms2,mz,ids,adduct,err_coarse_fun,err_fine_fun) {
+    ## This function is supposed to extract only those MS2 spectra for
+    ## which it is proven that the precursor exists within the fine
+    ## error range.
+    mzrng_c <- gen_mz_range(mz,err_coarse_fun(mz))
+    mzrng_f <- gen_mz_range(mz,err_fine_fun(mz))
+    
+    tmp<-filt_ms2_by_prcs_ht(ms2,mzrng=mzrng_c,ids=ids,adduct=adduct)
+    legMS2<-tmp$leg
+    legPcs<-pick_uniq_pscan(legMS2)
+    legPcs<-verif_prec_fine_ht(legPcs,ms1=ms1,mz=mz,mzrng=mzrng_f,ids=ids,adduct=adduct)
+    ## x<-Map(function (id,psn,a) {legMS2[id==legMS2$ID & a==legMS2$adduct & psn==legMS2$prec_scan,]},legPcs[,"ID"],legPcs[,"prec_scan"],legPcs[,"adduct"])
+    ## x <- data.table::rbindlist(x)[,.(ID,adduct,aN)]
+    x <- legMS2[legPcs[,.(ID,adduct,prec_scan)],on=c("ID","adduct","prec_scan")]
+    ## x<-do.call(rbind,c(x,list(make.row.names=F,stringsAsFactors=F)))[c("ID","aN")]
+    ## rownames(x)<-NULL
+    x<-x[order(x$aN),]
+    x
+}
+extr_ms2<-function(ms1,ms2,ids,mz,adduct,err_coarse_fun, err_fine_fun) {
+    ## Extraction of MS2 EICs and spectra.
+    x <- filt_ms2_fine(ms1=ms1,
+                       ms2=ms2,
+                       mz=mz,
+                       ids=ids,
+                       adduct=adduct,
+                       err_coarse_fun=err_coarse_fun,
+                       err_fine_fun=err_fine_fun)
+    
+    uids <- unique(x$ID)
+    uadds <- unique(x$adduct)
+    acN<-MSnbase::acquisitionNum(ms2)
+    chunks <- Map(function(id,ad) {
+        ans <- x[id==x$ID & ad==x$adduct,]$aN
+        sp<-ms2[which(acN %in% ans)]
+        r<-list()
+        n <- length(sp)
+        dtable(ID=rep(id,n),
+               adduct=rep(ad,n),
+               CE=MSnbase::collisionEnergy(sp),
+               rt=MSnbase::rtime(sp)/60.,
+               maspI=spectrapply(sp,function (s) max(MSnbase::intensity(s))),
+               spec=MSnbase::spectrapply(sp,function (s) list(spec=dtable(mz=MSnbase::mz(s),
+                                                                          intensity=MSnbase::intensity(s)),
+                                                              rt = MSnbase::rtime(s)/60.,
+                                                              CE = MSnbase::collisionEnergy(s))))}, uids,uadds)
+    data.table::rbindlist(chunks)
+}
+
 
 add_ms2_prcs_scans<-function(ms2,idx) {
 
@@ -167,11 +247,6 @@ add_ms2_prcs_scans<-function(ms2,idx) {
     df
 }
 
-
-
-
-
-
 refn_ms2_by_prec<-function(idxMS2,preFine) {
     pf<-preFine[preFine$OK,]
     pf$ID<-as.character(pf$ID)
@@ -214,7 +289,7 @@ grab_ms2_spec<-function(idx,raw) {
     names(res)<-IDs
     res
 }
-               
+
 
 gen_ms2_chrom<-function(ms2Spec) {
     lapply(ms2Spec, function(sp)
@@ -241,19 +316,18 @@ gen_ms2_chrom<-function(ms2Spec) {
 }
 
 
-gen_ms1_chrom<-function(raw,mz,errEIC,rt=NULL,errRT=NULL) {
-    mzRng<-gen_mz_range(mz,err=errEIC)
-    rtRng<-gen_rt_range(rt,err=errRT)
-    ids<-dimnames(mzRng)[[1]]
+gen_ms1_chrom <- function(raw,mz,errEIC,id,rt=NULL,errRT=NULL) {
+    mzRng<-gen_mz_range(mz,err = errEIC)
+    rtRng<-gen_rt_range(rt,err = errRT)
     x<-MSnbase::chromatogram(raw,mz=mzRng,msLevel=1,missing=0.0,rt=rtRng)
 
     res<-lapply(x,function (xx) {
         rt<-MSnbase::rtime(xx)/60.
         ints<-MSnbase::intensity(xx)
-        df<-data.frame(rt=rt,intensity=ints,stringsAsFactors=F)
+        df<-dtable(rt=rt,intensity=ints)
         df
     })
-    names(res)<-ids
+    names(res)<-id
     res
     
 }
@@ -267,20 +341,6 @@ gen_ms1_chrom_ht<-function(raw,mz,errEIC,rt=NULL,errRT=NULL) {
     res
 }
 
-
-
-tab2file<-function(tab,file,...) {
-    write.csv(x=tab,file=file,row.names=F,...)
-}
-
-file2tab<-function(file,stringsAsFactors=F,comment.char='',...) {
-    read.csv(file=file,
-             header=T,
-             stringsAsFactors=stringsAsFactors,
-             comment.char=comment.char,
-             na.strings=c("","NA"),...)
-}
-
 get_ext_width <- function(maxid) {as.integer(log10(maxid)+1)}
 id_fn_ext<-function(width,id) {
     formatC(as.numeric(id),width=width,flag=0)
@@ -351,7 +411,7 @@ extr_msnb <-function(file,wd,mz,errEIC, errFinePPM,errCoarse=0.5,rt=NULL,errRT=N
     message("Extracting MS2 spectra.")
     idxMS2<-filt_ms2_by_prcs(ms2=ms2,mz=mz,errCoarse=errCoarse)
     message("Resampling MS2 spectra.")
-    # idxMS2<-add_ms2_prcs_scans(ms2,idxMS2)
+                                        # idxMS2<-add_ms2_prcs_scans(ms2,idxMS2)
     prsc<-pick_unique_precScans(idxMS2)
     vprsc<-verif_prec_fine(preSc=prsc,ms1=ms1,mz=mz,errFinePPM = errFinePPM)
     idxMS2<-refn_ms2_by_prec(idxMS2=idxMS2,preFine=vprsc)
@@ -411,39 +471,86 @@ extr_msnb_ht <-function(file,wd,mz,errEIC, errFinePPM,errCoarse,fnSpec,rt=NULL,e
     x
 }
 
-##' Extracts data from mzML files.
-##'
-##' @title Data Extraction from mzML Files
-##' @param fTab File table with Files,ID,wd,Name,mz and RT
-##'     columns. Column Files, as well as wd must have all rows
-##'     identical.
-##' @param extr_fun Extraction function from the backend.
-##' @param errEIC Absolute mz tolerance used to extract precursor EICs.
-##' @param errFinePPM Tolerance given in PPM used to associate input
-##'     masses with what the instrument assigned as precursors to MS2.
-##' @param errCoarse Absolute tolerance for preliminary association of
-##'     precursors (from precursorMZ), to MS2 spectra.
-##' @param errRT The half-width of the retention time window.
-##' @param fnSpec Output file specification.
-##' @return Nothing useful.
-##' @author Todor Kondić
-extract<-function(fTab,extr_fun,errEIC,errFinePPM,errCoarse,fnSpec,errRT) {
-    fnData<-fTab$Files[[1]]
-    wd<-fTab$wd[[1]]
-    ID<-fTab$ID
-    mz<-fTab$mz
-    rt<-fTab$rt
-    names(mz)<-id2name(ID)
-    if (!is.null(rt)) names(rt)<-ID
-    dir.create(wd,showWarnings=F)
-    extr_fun(file=fnData,
-             wd=wd,
-             mz=mz,
-             rt=rt,
-             errRT=errRT,
-             errEIC=errEIC,
-             errFinePPM=errFinePPM,
-             errCoarse=errCoarse,
-             fnSpec=fnSpec)
+
+
+
+extr_eic_ms1 <- function(tab,err) {
+    ## Asynchronous extraction of ms1 spectra. The result is a list of
+    ## running futures.
+    files <- unique(tab$Files)
+
+    res <-lapply(files,function (fn) future::futur(extr_fn(fn), lazy=T))
+    names(res) <- files
+    res
+}
+
+##' @export
+extract <- function(fn,tab,err_ms1_eic.,err_coarse,err_fine,err_rt.) {
+    ## Extracts MS1 and MS2 EICs, as well as MS2 spectra, subject to
+    ## tolerance specifications.
+
+    ## TODO: Still detecting external references ... but which?
+    err_coarse_fun <- gen_mz_err_f(err_coarse,
+                                   "ms1 coarse error: Only ppm, or Da units allowed.")
+
+    err_fine_fun <- gen_mz_err_f(err_fine,
+                                 "ms1 fine error: Only ppm, or Da units allowed.")
+
+    err_ms1_eic <- gen_mz_err_f(err_ms1_eic.,
+                                "eic error: Only ppm, or Da units allowed.")
+
+    err_rt <- gen_rt_err(err_rt.,
+                         "rt error: Only s(econds), or min(utes) allowed.")
     
+    tab <- data.table::as.data.table(tab)
+    chunk <- tab[Files==fn]
+    mz <- chunk$mz
+    rt <- chunk$rt
+    id <- chunk$ID
+    adduct <- chunk$adduct
+    names(mz) <- id
+    names(rt) <- id
+    mzerr <- err_coarse_fun(mz)
+    mzrng <- gen_mz_range(mz=mz,err=mzerr)
+    rtrng <- gen_rt_range(rt=rt,err=err_rt)
+    mzmin <- min(mzrng)
+    mzmax <- max(mzrng)
+    read_ms1 <- function() {
+        message("Opening ", fn, " to read MS1")
+        ms1 <- MSnbase::readMSData(file=fn,msLevel=1,mode="onDisk")
+        ms1 <- MSnbase::filterMz(ms1,c(mzmin,mzmax))
+        message("Done opening ", fn, " to read MS1.")
+        ms1
+    }
+    read_ms2 <- function() {
+        message("Opening ", fn, " to read MS2")
+        ms2 <- MSnbase::readMSData(file=fn,msLevel=2,mode="onDisk")
+        message("Done opening ", fn, " to read MS2.")
+        ms2
+    }
+    extr_ms1_eic <- function(ms1) {
+        message("Extracting EICs from ", fn, " .")
+        eic <- MSnbase::chromatogram(ms1,mz=mzrng,msLevel=1,missing=0.0,rt=rtrng)
+        eiccol <- lapply(eic,function (e) dtable(rt=MSnbase::rtime(e)/60.,intensity=MSnbase::intensity(e)))
+        ## names(res) <- id
+        res <- dtable(ID=id,adduct=adduct,eicMS1=eiccol)
+        message("Done extracting EICs from ", fn, " .")
+        res
+    }
+    ms1 <- read_ms1()
+    ms2 <- read_ms2()
+    res_ms1 <- extr_ms1_eic(ms1)
+    rms2full <- extr_ms2(ms1=ms1,
+                         ms2=ms2,
+                         ids=id,
+                         mz=mz,
+                         adduct=adduct,
+                         err_coarse_fun=err_coarse_fun,
+                         err_fine_fun=err_fine_fun)
+    res_ms2 <- rms2full[,.(eicMS2=list(dtable(CE=.SD$CE,rt=.SD$rt,intensity=.SD$maspI)),
+                           spec=list(spec)),by=c("adduct","ID")]
+    res <- res_ms2[res_ms1,on=c("adduct","ID"),allow.cartesian=T]
+    res[sapply(eicMS2,is.null),c("eicMS2","spec"):=.(NA,NA)]
+    res$Files <- fn
+    res
 }

R/mix.R

@@ -16,7 +16,7 @@ stripext<-function(fn) {
     bits<-strsplit(fn,split="\\.")[[1]]
     if (length(bits)> 1) paste(head(bits,-1),collapse=".") else fn}
 
-get_mz_cmp_l<-function(id,mode,cmpL) {
+get_mz_cmp_l<-function(id,adduct,cmpL) {
     ind<-match(id,cmpL$ID)
     mz<-cmpL$mz[[ind]]
     smiles<-cmpL$SMILES[[ind]]
@@ -24,13 +24,123 @@ get_mz_cmp_l<-function(id,mode,cmpL) {
              mz
          } else if (nchar(smiles)>0)
          {
-             mde<-as.character(mode)
-             wh<-MODEMAP[[mde]]
+             mde<-as.character(adduct)
+             wh<-ADDUCTMAP[[mde]]
              RChemMass::getSuspectFormulaMass(smiles)[[wh]]
          } else stop("Both SMILES and mz fields, for ID ",id,", found empty in the compound list. Aborting.")
     res
 }
 
+calc_mz_from_formula_outer <- function(chform,adduct,id) {
+    check_chform <- enviPat::check_chemform(ISOTOPES,chform)
+    wind <- which(check_chform$warning)
+    if (length(wind) > 0) stop("Cannot understand the following formulas: ",
+                               paste(check_chform$new_formula[wind],collapse = ","))
+    mol_form <- check_chform$new_formula
+    l_mol <- length(mol_form)
+    l_add <- length(adduct)
+    
+    adds <- ADDUCTS[Name %in% adduct,.(Name,
+                                       add=as.character(Formula_add),
+                                       ded=as.character(Formula_ded),
+                                       charge=Charge)]
+
+    dt <- dtable(ID = rep(id,each = l_add),
+                 mol_form = rep(mol_form,each = l_add),
+                 adduct = rep(adds$Name,l_mol),
+                 add = rep(adds$add,l_mol),
+                 ded = rep(adds$ded,l_mol),
+                 charge= rep(adds$charge,l_mol))
+    
+    merger <- function (mol_form,add,ded) {
+        full_form <- rep(NA_character_,length(mol_form))
+        both_ind <- which(add != 'FALSE' & ded != 'FALSE')
+        add_only_ind <- which(add != 'FALSE' & ded == 'FALSE')
+        ded_only_ind <- which(ded != 'FALSE' & add == 'FALSE')
+        ainds <- c(both_ind,add_only_ind)
+        full_form[ainds] <- vapply(ainds,function (i) enviPat::mergeform(mol_form[[i]],add[[i]]),FUN.VALUE = character(1), USE.NAMES = F)
+        dinds <- c(both_ind,ded_only_ind)
+        full_form[dinds] <- vapply(dinds,function (i) {
+            z <- check_ded2(mol_form[[i]],ded[[i]])
+            if (z) enviPat::subform(mol_form[[i]],ded[[i]]) else NA_character_
+        },
+        FUN.VALUE = character(1))
+        full_form
+    }
+    dt[,("full_form"):=.(merger(mol_form,add,ded))]
+    dt[!is.na(full_form),("mz"):=.(mapply(function(ff,ch) enviPat::isopattern(ISOTOPES,chemforms = ff,
+                                                                              charge = ch, verbose = F)[[1]][1],
+                                          full_form,
+                                          charge, USE.NAMES = F))]
+    dt[is.na(full_form),("mz"):=NA_real_]
+    dt
+}
+
+calc_mz_from_formula <- function(chform,adduct,id) {
+    check_chform <- enviPat::check_chemform(ISOTOPES,chform)
+    wind <- which(check_chform$warning)
+    if (length(wind) > 0) stop("Cannot understand the following formulas: ",
+                               paste(check_chform$new_formula[wind],collapse = ","))
+    mol_form <- check_chform$new_formula
+    uad <- unique(adduct)
+    uadds <- lapply(uad,function(a) ADDUCTS[Name==a,.(Name,
+                                                      add=as.character(Formula_add),
+                                                      ded=as.character(Formula_ded),
+                                                      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')
+        add_only_ind <- which(add != 'FALSE' & ded == 'FALSE')
+        ded_only_ind <- which(ded != 'FALSE' & add == 'FALSE')
+        ainds <- c(both_ind,add_only_ind)
+        res[ainds] <- vapply(ainds,function (i) enviPat::mergeform(mol_form[[i]],add[[i]]),FUN.VALUE = character(1), USE.NAMES = F)
+        dinds <- c(both_ind,ded_only_ind)
+        res[dinds] <- vapply(dinds,function (i) {
+            z <- check_ded2(mol_form[[i]],ded[[i]])
+            if (z) enviPat::subform(mol_form[[i]],ded[[i]]) else NA_character_
+        },
+        FUN.VALUE = character(1))
+        res
+    }
+    forms  <- merger(mol_form,adds$add,adds$ded)
+    mz <- the_ifelse(!is.na(forms),
+                     mapply(function(ff,ch) enviPat::isopattern(ISOTOPES,chemforms = ff,
+                                                                charge = ch, verbose = F)[[1]][1],
+                            forms,
+                            adds$charge, USE.NAMES = F),
+                     NA_real_)
+    mz
+}
+
+calc_mz_from_smiles <- function(smiles,adduct,id) {
+    mol <- lapply(smiles,function(s) try(RMassBank::getMolecule(s), silent = T))
+    check <- which(is.atomic(mol))
+    if (length(check) > 0)
+        stop("Errors in SMILES with IDs:",paste(id[which],collapse = ','))
+
+    mol_form <- sapply(mol,function(x) (rcdk::get.mol2formula(x))@string,USE.NAMES = F)
+    names(mol_form) <- id
+    calc_mz_from_formula(mol_form,adduct,id)
+    
+    
+}
+
+calc_mz_from_smiles_outer <- function(smiles,adduct,id) {
+    mol <- lapply(smiles,function(s) try(RMassBank::getMolecule(s), silent = T))
+    check <- which(is.atomic(mol))
+    if (length(check) > 0)
+        stop("Errors in SMILES with IDs:",paste(id[which],collapse = ','))
+
+    mol_form <- sapply(mol,function(x) (rcdk::get.mol2formula(x))@string,USE.NAMES = F)
+    names(mol_form) <- id
+    calc_mz_from_formula_outer(mol_form,adduct,id)
+    
+    
+}
+
 get_col_from_cmp_l<-function(id,cname,cmpL) {
     ind<-match(id,cmpL$ID)
     x<-cmpL[[cname]][[ind]]
@@ -38,23 +148,23 @@ get_col_from_cmp_l<-function(id,cname,cmpL) {
     
 }
 
-gen_clean_state_ftab<-function(ftable) {
-    ftable$Comments <- ""
-    ftable[c("MS1","MS2","Alignment","AboveNoise")] <- T
-    ftable["MS2rt"] <- NA_real_
-    ftable["iMS2rt"] <- NA_integer_
-    ftable["rt"]<-NA_real_
-    ftable["checked"]<-'NONE'
-    ftable
+gen_clean_state_summ<-function(summ) {
+    summ$Comments <- ""
+    summ[c("MS1","MS2","Alignment","AboveNoise")] <- T
+    summ["MS2rt"] <- NA_real_
+    summ["iMS2rt"] <- NA_integer_
+    summ["rt"]<-NA_real_
+    summ["checked"]<-'NONE'
+    summ
 }
 
-pp_touch_q<-function(ftab) {
+pp_touch_q<-function(summ) {
     ## Returns indices that are ok to be auto processed.
-    which(ftab$checked==FTAB_CHK_NONE | ftab$checked==FTAB_CHK_AUTO)
+    which(summ$checked==SUMM_CHK_NONE | summ$checked==SUMM_CHK_AUTO)
 }
 
-preProc <- function (ftable,noiseFac=3,errRT=0.5,intThreshMS1=1e5,intThreshMS2=0.05) {
-    wds<-unique(ftable$wd)
+preProc <- function (summ,noiseFac=3,errRT=0.5,intThreshMS1=1e5,intThreshMS2=5000.) {
+    wds<-unique(summ$wd)
     fn_spec<-function(wd) readRDS(file.path(wd,FN_SPEC))
     message("Loading RDS-es ...")
     allData<-lapply(wds,fn_spec)
@@ -80,10 +190,10 @@ preProc <- function (ftable,noiseFac=3,errRT=0.5,intThreshMS1=1e5,intThreshMS2=0
     ## during the dataframe generation stage. In this case, the file
     ## with the corresponding ID will not be there.
 
-    okinds<- pp_touch_q(ftable)
+    okinds<- pp_touch_q(summ)
     for (ind in okinds) {
-        wd <- ftable$wd[ind]
-        id <- ftable$ID[ind]
+        wd <- summ$wd[ind]
+        id <- summ$ID[ind]
         eics<-allData[[wd]]$eic
         nid<-id2name(id)
         ii<-match(nid,MSnbase::fData(eics)[["ID"]]) #id, because id-s, not nid-s are in fData for ms1 eics;
@@ -99,20 +209,20 @@ preProc <- function (ftable,noiseFac=3,errRT=0.5,intThreshMS1=1e5,intThreshMS2=0
         
         ms1MaxInd<-which.max(eic$intensity)
         maxInt<-eic$intensity[[ms1MaxInd]]
-        ftable[ind,"rt"]<-eic$rt[[ms1MaxInd]]
+        summ[ind,"rt"]<-eic$rt[[ms1MaxInd]]
         ##If MS1 does not exist, set entry to F.
         if (maxInt < intThreshMS1) {
-            ftable[ind,"MS1"] <- F
+            summ[ind,"MS1"] <- F
             ## Other checks automatically fail, too.
-            ftable[ind,"Alignment"] <- F
-            ftable[ind,"AboveNoise"] <- F
+            summ[ind,"Alignment"] <- F
+            summ[ind,"AboveNoise"] <- F
         } else {
             ## Noisy?
-            if (ftable[ind,"AboveNoise"]) {
+            if (summ[ind,"AboveNoise"]) {
                 mInt <- mean(eic$intensity)
                 if (maxInt < noiseFac*mInt) {
-                    ftable[ind,"AboveNoise"] <- F
-                    ftable[ind,"Alignment"] <- F ## If noisy, this is
+                    summ[ind,"AboveNoise"] <- F
+                    summ[ind,"Alignment"] <- F ## If noisy, this is
                                                  ## probably meaningles, so
                                                  ## F.
                 }
@@ -126,12 +236,12 @@ preProc <- function (ftable,noiseFac=3,errRT=0.5,intThreshMS1=1e5,intThreshMS2=0
         ms2<-allData[[wd]]$ms2
         ms2nids<-names(ms2)
         if (! (nid %in% ms2nids)) {
-            ftable[ind,"MS2"] <- F
-            ftable[ind,"Alignment"] <- F
+            summ[ind,"MS2"] <- F
+            summ[ind,"Alignment"] <- F
         } else {
             sp<-ms2[[nid]]
             ## Alignment still makes sense to be checked?
-            if (ftable[ind,"Alignment"]) {
+            if (summ[ind,"Alignment"]) {
                 ## rtInd <- ms1MaxInd #match(maxInt,eic$intensity)
                 rtMS1Peak <- eic$rt[[ms1MaxInd]]
                 msms<-MSnbase::fData(sp)[,c("rtm","maxI")]
@@ -145,22 +255,22 @@ preProc <- function (ftable,noiseFac=3,errRT=0.5,intThreshMS1=1e5,intThreshMS2=0
                 eicFilt<- eic[rtIndMS1,]
                 eicFilt<- eicFilt[which(eicFilt$intensity>intThreshMS1),]
                 mInt<- maxInt #mean(eicFilt$intensity)
-                rtInd <- rtInd[which(msms$intensity[rtInd]>intThreshMS2*mInt)] #Intense enough?
+                rtInd <- rtInd[which(msms$intensity[rtInd]>intThreshMS2)] #Intense enough?
                 msmsRT <- msms$rt[rtInd]
                 msmsInt<- msms$intensity[rtInd]
                 if (length(msmsRT) > 0) {
                     msmsRTind <- which.min(abs(msmsRT - rtMS1Peak))
-                    ftable[ind,"iMS2rt"] <- rtInd[msmsRTind]
-                    ftable[ind,"MS2rt"] <- msmsRT[msmsRTind]
+                    summ[ind,"iMS2rt"] <- rtInd[msmsRTind]
+                    summ[ind,"MS2rt"] <- msmsRT[msmsRTind]
                 } else {
-                    ftable[ind,"Alignment"] <- F
+                    summ[ind,"Alignment"] <- F
                 }
             }
         }
-        ftable[ind,"checked"]<-FTAB_CHK_AUTO
+        summ[ind,"checked"]<-SUMM_CHK_AUTO
     }
           
-    ftable
+    summ
 }
 
 smiles2img <- function(smiles, kekulise=TRUE, width=300, height=300,
@@ -203,12 +313,12 @@ gen_ms2_spec_data <- function(id,tag,iMS2rt,data,luckyN=NA) {
     } else return(NULL)
 }
 
-gen_ms2_spec_fn <- function(id,tag,mode,set,width=6) {
+gen_ms2_spec_fn <- function(id,tag,adduct,set,width=6) {
     suppressWarnings({
         iid<-as.numeric(id)
         iid<- if (!is.na(iid)) iid else id
         num <- formatC(iid,width = width,format='d',flag='0')
-        ss<-trimws(paste(num,mode,tag,set,sep="_"),which='both')
+        ss<-trimws(paste(num,adduct,tag,set,sep="_"),which='both')
         paste(ss,".csv",sep='')
     })
 }
@@ -225,7 +335,7 @@ plot_id_msn <- function(ni,
                         mass,
                         smile,
                         tags,
-                        fTab,
+                        summ,
                         prop,
                         theme,
                         pal="Dark2",
@@ -447,58 +557,26 @@ plot_id_msn <- function(ni,
     res
 }
 
-
-
-adornmzMLTab<-function(df,projDir=getwd()) {
-    pref<-df$set
-    mask<-is.na(pref)
-    drop<-df$files[mask]
-    for (d in drop) warning("Dropping",d,"because no set specified for it.")
-    df<-df[!mask,]
-    pref<-df$set
-    wd<-basename(tools::file_path_sans_ext(df$Files))
-    wd<-file.path(projDir,pref,wd)
-    df$wd<-wd
-    df
+add_wd_to_mzml <- function(fn,proj) {
+    wd<-basename(tools::file_path_sans_ext(fn))
+    file.path(proj,wd)
 }
 
-genSuprFileTab <- function(fileTab,compTab) {
-    genOne<-function(ids,fn) {
 
-        K<-length(ids)
-        fTabRow<-fileTab[fileTab$Files == fn,]
-        cols<-lapply(names(fileTab),function(n) rep(fTabRow[[n]],K))
-        names(cols)<-NULL
-        cols<-c(cols,list(ids))
-        names(cols)<-c(names(fileTab),"ID")
-        df<-as.data.frame(cols,stringsAsFactors = F)
-        df
-    }
-    
-    tabs<-lapply(fileTab$Files,function(fn)
-    {
-        wh<-which(fileTab$Files==fn)
-        set<-fileTab$set[[wh]]
-        md<-fileTab$mode[[wh]]
-        sel<-(compTab$set %in% set) & (compTab$mode %in% md)
-        ids<-compTab$ID[sel]
-        genOne(ids,fn)
-        
-    })
-    res<-do.call(rbind,tabs)
-    res
-}
-
-getEntryFromComp<-function(entry,id,set,mode,compTab) {
+getEntryFromComp<-function(entry,id,set,adduct,compTab) {
     ind <- which(compTab$ID %in% id &
                  compTab$set %in% set &
-                 compTab$mode %in% mode)
+                 compTab$adduct %in% adduct)
 
     res<- if (length(ind)==1) compTab[ind,entry] else {
                                                      if (length(ind)>1) {
-                                                         stop("Nonunique entry selection in comprehensive table.")
+                                                         warning("Nonunique selection in comprehensive table:")
+                                                         for (i in ind) {
+                                                             message('ID: ',compTab$ID[[i]],' set: ',compTab$set[[i]],' adduct: ',compTab$adduct[[i]])
+                                                         }
+                                                         warning("The compound set table likely containes duplicate IDs per set/adduct combination. Please correct this.")
                                                      } else {
-                                                         stop("Entries not found for id ", id,"set ",set, "and mode ", mode, " .")
+                                                         warning("Entries not found for id ", id,"set ",set, "and adduct ", adduct, " .")
                                                      } 
                                                  }
     res
@@ -506,29 +584,32 @@ getEntryFromComp<-function(entry,id,set,mode,compTab) {
     res
         
 }
-addCompColsToFileTbl<-function(ft,compTab) {
-    nR<-nrow(ft)
-    mzCol<-rep(NA,nR)
-    nmCol<-rep("",nR)
-    rtCol<-rep(NA,nR)
-    
-    for (ir in 1:nR) {
-        id<-ft[ir,"ID"]
-        set<-ft[ir,"set"]
-        m<-ft[ir,"mode"]
-        entries<-getEntryFromComp(c("mz","Name","rt"),id,set,m,compTab)
-        mzCol[[ir]]<-  entries[["mz"]]
-        nm<-entries[["Name"]]
-        nmCol[[ir]]<- if (!is.na(nm)) nm else ""
-        rtCol[[ir]]<- entries[["rt"]]
-    }
-    ft$mz<-mzCol
-    ft$Name<-nmCol
-    ft$rt<-rtCol
-    ft
+## add_comp_summ <- function(ft,ctab) {
+##     nR<-nrow(ft)
+##     mzCol<-rep(NA,nR)
+##     nmCol<-rep("",nR)
+##     rtCol<-rep(NA,nR)
+    
+##     for (ir in 1:nR) {
+##         id<-ft[ir,"ID"]
+##         set<-ft[ir,"set"]
+##         m<-ft[ir,"adduct"]
+##         entries<-getEntryFromComp(c("mz","Name","rt"),id,set,m,ctab)
+##         mzCol[[ir]]<-  entries[["mz"]]
+##         nm<-entries[["Name"]]
+##         nmCol[[ir]]<- if (!is.na(nm)) nm else ""
+##         rtCol[[ir]]<- entries[["rt"]]
+##     }
+##     ft$mz<-mzCol
+##     ft$Name<-nmCol
+##     ft$rt<-rtCol
+##     ft
+## }
+
+get_set_adduct <- function(s,mzml) {
+    unique(mzml[set == s,adduct])
 }
 
-
 vald_comp_tab<-function(df,ndf,checkSMILES=F,checkMz=F,checkNames=F) {
     ## Fields.
     if (is.null(df$ID)) stop("Column ID missing in ",ndf," .")
@@ -574,7 +655,6 @@ vald_comp_tab<-function(df,ndf,checkSMILES=F,checkMz=F,checkNames=F) {
         ll<-length(unique(df$SMILES))
         if (ll<lsmiles) {
             warning("There are duplicate SMILES in the compound list. Trouble ahead.")
-            return(NULL)
         }
     }
 
@@ -591,3 +671,347 @@ vald_comp_tab<-function(df,ndf,checkSMILES=F,checkMz=F,checkNames=F) {
 
     df
 }
+
+read_setid <- function(fn,cmpds) {
+    assert(file.exists(fn),msg=paste("Please provide valid compounds set table:", fn))
+    assert(nrow(cmpds) > 0,msg="Please provide at least one compounds list.")
+    setid <- file2tab(fn,colClasses=c(ID="character"))
+    x<-cmpds[setid,on='ID'][,.SD,.SDcols=c(colnames(setid),'known')]
+
+    sids <- unique(setid$ID)
+    cids <- unique(cmpds$ID)
+    diff <- setdiff(sids,cids)
+    assert(length(diff)==0,msg=paste("The following IDs from set table have not been found in the compound table:","------",print_table(dtable(diff)),"------",sep = "\n"))
+    x
+}
+
+
+write_conf <- function(m,fn) {
+    m$conf$data <- get_fn_ftab(m)
+    yaml::write_yaml(x=m$conf,file=fn)
+    
+    
+    
+}
+write_state <- function(m,fn_conf) {
+    write_conf(m,fn_conf)
+    tab2file(tab=m$input$tab$mzml,file=file.path(m$conf$project,FN_DATA_TAB))
+}
+
+read_conf <- function(fn) {
+    cf <- yaml::yaml.load_file(fn)
+    fnl <- cf$compound$lists
+    if (length(fnl)>0) {
+        nms <- character(0)
+        for (i in 1:length(fnl)) {
+            nms <- gen_uniq_lab(nms,pref = 'L')
+        }
+        names(fnl) <- nms
+        
+    }
+    cf$compound$lists <- fnl
+    ## conf_trans(cf)
+    cf
+}
+
+
+
+##' @export
+get_fn_comp <- function(m) {
+    file.path(m$conf$project,FN_COMP_TAB)
+}
+
+##' @export
+get_fn_summ <- function(m) {
+    file.path(m$conf$project, FN_SUMM)
+}
+
+##' @export
+get_fn_extr <- function(m) {
+    file.path(m$conf$project, "extracted.rds")
+}
+
+##' @export
+get_fn_conf <- function(m) {
+    file.path(m$conf$project, FN_CONF)
+}
+
+
+##' @export
+get_fn_ftab <- function(m) {
+    file.path(m$conf$project, FN_DATA_TAB)
+}
+
+init_state <- function(m) {
+    m$out$tab <- list()
+    m$input$datafiles <- NULL
+    m$input$tab$mzml <- EMPTY_MZML
+    lab <- gen_uniq_lab(list(),pref="L")
+    m$input$tab$lists <- list()
+    m$input$tab[[lab[[1]]]] <- EMPTY_CMPD_LIST
+    m
+}
+
+base_conf <- function () {
+    m <- list()
+    m$conf <- list(project=getwd(),
+                   compounds=list(lists=list(),
+                                  sets="",
+                                  data=""),
+                   extr=list(fn=""),
+                   debug = F)
+    m
+}
+
+extr_conf <- function(m) {
+    m$conf$tolerance <- list("ms1 coarse"=MS1_ERR_COARSE,
+                             "ms1 fine"=MS1_ERR_FINE,
+                             "eic"=EIC_ERR,
+                             "rt"=RT_EXTR_ERR)
+    m
+}
+
+presc_conf <- function(m) {
+    m$conf$prescreen <- list("ms1_int_thresh"=1e5,
+                             "ms2_int_thresh"=2.5e3,
+                             "s2n"=3,
+                             "ret_time_shift_tol"=0.5)
+    m
+}
+
+
+new_conf <- function() presc_conf(
+                           extr_conf(
+                               base_conf()))
+
+
+
+verify_cmpd_l <- function(dt,fn) {
+    fields <- colnames(EMPTY_CMPD_LIST)
+    dtflds <- colnames(dt)
+
+    assert('ID' %in% dtflds, msg = paste('ID column must be present and filled in', fn))
+    ess <- c('SMILES','Formula','mz')
+    pres <- ess %in% dtflds
+    assert(length(pres) > 0,
+           msg = paste('Compound list from ',fn,
+                       'does not contain any of "SMILES", "Formula", or "mz". \nThe compound list needs at least one of those to be valid.'))
+    exst <- ess[pres]
+    x <- lapply(exst,function (nm) do.call(all,as.list(is.na(dt[[nm]]))))
+    assert(!do.call(all,x), msg = paste('At least one of', paste(exst,collapse = ','),
+                                '\nmust contain some values in compound list from',fn))
+    
+    invisible(T)
+}
+
+
+## INPUT TRANSLATORS
+grab_unit <- function(entry,unit) {
+    what <- paste0("\\<",unit,"\\>$")
+    entry <- trimws(entry,which="both")
+    if (grepl(what,entry))
+        suppressWarnings(as.numeric(sub(paste0("^(.*)",unit),"\\1",entry))) else NA_real_
+}
+
+
+conf_trans_pres <- function(pres_list) {
+    ## Translate and validate prescreening input.
+    pres_list[CONF_PRES_NUM] <- sapply(pres_list[CONF_PRES_NUM],as.numeric)
+    for (par in CONF_PRES_NUM) {
+        assert(!suppressWarnings(is.na(pres_list[[par]])),msg=paste("Prescreen parameter",par,"is not a number."))
+    }
+    for (par in CONF_PRES_TU) {
+        xs <- grab_unit(pres_list[[par]],"s")
+        xm <- grab_unit(pres_list[[par]],"min")
+        x <- if (is.na(xm)) xs else xm
+        assert(!is.na(x),msg = paste("Time unit parameter error for",par,"Only s(econds) or min(utes) allowed."))
+        pres_list[[par]] <- x
+    }
+    pres_list
+}
+
+## PRESCREENING
+
+create_qa_table <- function(ms,conf_presc) {
+    ## The first input argument is the extracted `ms`, table
+    ## containing MS1 and MS2 spectra. The argument `conf_presc` is
+    ## m$conf$prescreen, the prescreening parameters given in the conf
+    ## file.
+
+    ## The qa table is just a copy of ms with added quality control
+    ## columns QA_COLS.
+
+    ## The QA_FLAGS columns are flags specifying which properties of
+    ## compounds are known well, or not.
+
+    ## For each compound (mass) we ask the following questions:
+    ## qa_ms1_exists -- does the MS1 spectrum exist at all?
+    ## qa_ms2_exists -- do we have any MS2 spectra at all?
+    ## qa_ms1_above_noise -- is MS1 above the noise treshold?
+    ## qa_ms2_near -- is there any MS2 spectrum inside the tolerated
+    ## retention time window around the MS1 peak? That is, are we
+    ## non-RT-shifted?
+    ## qa_ms2_good_int -- Is there any MS2 spectral intensity greater
+    ## than the MS2 threshold and less than the MS1 peak?
+    ## qa_pass -- did the spectrum pass all the checks?
+    
+
+    ## The columns in QA_NUM_REAL are:
+    ## 
+    ## ms1_int -- the maximum intensity of MS1 spectrum over the
+    ## entire run;
+    ##
+    ## ms1_rt -- the retention time of the peak MS1.
+
+    ## The columns in QA_NUM_INT are:
+    ##
+    ## ms2_sel -- index of the selected MS2 spectrum; if not NA, the
+    ## associated spectrum passed all the checks (qa_pass == T); the
+    ## spectrum itself is in one of the member sublists of the `spec'
+    ## column. The integer `ms2_sel' is then the index of the spectrum
+    ## in that sublist.
+    ##
+    ## ms1_rt_ind -- TODO (but not important to end users).
+    
+    
+    qa <- list(prescreen=conf_presc)
+    qa$ms <- data.table::copy(ms)
+    qa$ms[,(QA_FLAGS):=T]               # All checks true by default. Dangerous,
+                                        # but we need to believe in our
+                                        # filters. Also, the humans who check the
+                                        # results. :)
+    qa$ms[,(QA_NUM_INT):=NA_integer_]
+    qa$ms[,(QA_NUM_REAL):=NA_real_]
+    qa
+}
+
+assess_ms1 <- function(m) {
+    qa <- m$qa
+    ## Calculate auxiliary variables and indices.
+    qa$ms[,c("ms1_rt_ind"):=.(sapply(eicMS1,function(e) which.max(e$intensity)))]
+    qa$ms[length(ms1_rt_ind)==0,("ms1_rt_ind"):=NA_integer_]
+    qa$ms[,c("ms1_rt","ms1_int","ms1_mean"):=.(NA_real_,NA_real_,NA_real_)]
+    qa$ms[!is.na(ms1_rt_ind),c("ms1_int","ms1_rt","ms1_mean"):=.(mapply(function (e,i) e$intensity[[i]],eicMS1,ms1_rt_ind),
+                                                          mapply(function (e,i) e$rt[[i]],eicMS1,ms1_rt_ind),
+                                                          mapply(function (e,i) mean(e$intensity),eicMS1,ms1_rt_ind))]
+
+    check_ms1 <- function(qa) {
+        qa$ms[(!is.na(ms1_int)),"qa_ms1_exists" := .(ms1_int > qa$prescreen$ms1_int_thresh)]
+        qa$ms[is.na(ms1_int),("qa_ms1_exists"):=F]
+        qa$ms[(!qa_ms1_exists),(QA_FLAGS):=F]
+        qa
+    }
+
+    check_ms1_noise <- function(qa) {
+        qa$ms[(qa_ms1_exists==T),"qa_ms1_above_noise" := .(ms1_int > qa$prescreen$s2n*ms1_mean)]
+        qa$ms[(!qa_ms1_above_noise),c("qa_ms2_good_int","qa_ms2_near","qa_ms2_exists","qa_pass"):=F]
+        qa
+    }
+
+    
+
+    qa <- check_ms1_noise(check_ms1(qa))
+    m$qa <- qa
+    m
+    
+    
+    
+}
+
+assess_ms2 <- function(m) {
+
+    presconf <- conf_trans_pres(m$conf$prescreen)
+
+    ## This function takes a spectral list, looks for the members
+    ## inside the retention time window and returns either the indices
+    ## of those that are, or NA.
+    pick_ms2_rtwin <- function(rtMS1,sp_list,rt_win) {
+        rt <- sapply(sp_list,function (x) x$rt)
+
+        rtl <- rtMS1 - rt_win/2.
+        rtr <- rtMS1 + rt_win/2.
+        which(rt > rtl & rt < rtr)
+    }
+
+    ## Only return the index which satisfies the intensity
+    ## range.
+    pick_ms2_int <- function(sp_list,int_lo,int_hi) {
+        ints <- sapply(sp_list,function (x) max(x$spec$intensity))
+        which(int_lo < ints & ints < int_hi)
+    }
+
+    
+    ## Test only rows that passed MS1 checks and have MS2 spec. To
+    ## test existence of MS2, it is only necessary to make sure that
+    ## either spec member sublist has more than one entry, or if not,
+    ## that the single entry in the sublist is not NA.
+    m$qa$ms[qa_ms1_exists==T,qa_ms2_exists := .(sapply(spec,function (sl) length(sl)>1 || !is.na(sl[[1]])))]
+    irows <- which(m$qa$ms$qa_ms1_exists & m$qa$ms$qa_ms2_exists)
+    rt_win <- 2 * presconf$ret_time_shift_tol
+
+    ## List of lists of spec indices where MS2 are within the rt
+    ## window.
+    okind_rt_ms2 <- m$qa$ms[irows, ][, .(tmp=mapply(function (rt1,spl) pick_ms2_rtwin(rt1,spl,rt_win),
+                                                    ms1_rt,
+                                                    spec,
+                                                    USE.NAMES=F,
+                                                    SIMPLIFY=F))]$tmp
+    m$qa$ms[irows,"qa_ms2_near"] <- sapply(okind_rt_ms2,function (x) length(x) > 0)
+    m$qa$ms[-irows,"qa_ms2_near"] <- F
+    
+    ## List of lists of spec indices where MS2 are within the desired
+    ## intensity range.
+    okind_int_ms2 <- m$qa$ms[irows, ][, .(tmp=mapply(pick_ms2_int,
+                                                     spec,
+                                                     presconf$ms2_int_thresh,
+                                                     ms1_int,
+                                                     SIMPLIFY=F))]$tmp
+
+    m$qa$ms[irows,"qa_ms2_good_int"] <- sapply(okind_int_ms2,function (x) length(x) > 0)
+    m$qa$ms[-irows,"qa_ms2_good_int"] <- F
+
+    ## Candidates for the MS2 choices.
+    okind <- mapply(intersect,okind_int_ms2,okind_rt_ms2)
+
+    m$qa$ms[irows,"qa_pass"] <- sapply(okind,function (x) length(x) > 0)
+    m$qa$ms[-irows,"qa_pass"] <- F
+    
+    ## Throw out the possibly empty members.
+    really_okind <- okind[m$qa$ms[irows, ]$qa_pass]
+    m$qa$ms[which(qa_pass),ms2_sel:=.(mapply(function (spl,inds,ms1rt) {
+        rtdiff <- sapply(spl[inds],function (x) abs(x$rt-ms1rt))
+        closest <- which.min(rtdiff)
+        inds[[closest]]
+    },
+    spec,
+    really_okind,
+    ms1_rt,
+    SIMPLIFY=T))]
+
+    m    
+}
+
+gen_mz_err_f <- function(entry,msg) {
+    eppm <- grab_unit(entry,"ppm")
+    eda <- grab_unit(entry,"Da")
+    shinyscreen:::assert(xor(is.na(eda), is.na(eppm)), msg = msg)
+    if (is.na(eda)) function(mz) eppm*1e-6*mz else function (mz) eda
+}
+
+
+gen_rt_err <- function(entry,msg) {
+    em <- grab_unit(entry,"min")
+    es <- grab_unit(entry,"s")
+    shinyscreen:::assert(xor(is.na(em), is.na(es)), msg = msg)
+    if (is.na(em)) es/60. else em
+}
+
+fig_path <- function(top,set,group,id,suff,ext="pdf") {
+    base <- paste("plot",set,group,id,suff,sep="_")
+    fn <- paste0(base,".",ext)
+    fn <- gsub("\\[","",fn)
+    fn <- gsub("\\]","",fn)
+    fn <- gsub("\\+","p",fn)
+    fn <- gsub("-","m",fn)
+    if (!is.null(top)) file.path(top,fn) else fn
+}

R/resources.R

@@ -14,28 +14,50 @@
 
 
 
+
+## Config defaults
+CONF <- list(data=NA_character_,
+             project=getwd(),
+             compounds=list(lists=list(),
+                            sets=NA_character_))
+
 ## Constants
-FN_FTAB_BASE<-"ftable.base.csv"
-FN_FTAB_PP<-"ftable.pp.csv"
+FN_SUMM_BASE<-"summ.base.csv"
+FN_SUMM_PP<-"summ.pp.csv"
 FN_PP_OUT_PREF<-"PP.filetable"
-FN_FTAB_STATE<-"ftable_state.csv"
-FN_FTAB_DEF_OUT<-"ftable.csv"
+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"
-MODEMAP<-list(pH="MpHp_mass",
-              mH="MmHm_mass",
-              pNH4="MpNH4_mass",
-              pNa="MpNa_mass")
-
-TAG_DEF<-"unspecified"
+FN_CONF <- "conf-state.yaml"
+.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,"]-"))
+## names(ADDUCTMAP) <- apply(ADDUCTS,1,function(row) {
+##     nm <- row[["Name"]]
+##     sgn <- row[["Charge"]]
+##     suff <- if (sgn > 0) "+" else if (sgn < 0) "-" else ""
+##     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"
 DEFAULT_RT_RANGE=c(NA,NA)
 DEFAULT_INT_RANGE=c(NA,NA)
 DEFAULT_MZ_RANGE=c(NA,NA)
 
-QANAMES <- c("MS1","MS2","Alignment","AboveNoise")
+## QANAMES <- c("MS1","MS2","Alignment","AboveNoise")
 PLOT_DEF_TAGS<-NA
 PLOT_DEF_SET<-NA
 
@@ -44,11 +66,6 @@ RT_DIGITS=2
 M_DIGITS=4
 PAL="Dark2"
 
-REST_TXT_INP<-c("fnKnownL",
-                "fnUnkL",
-                "fnSetId",
-                "tagsInp")
-
 REST_TAB<-c("mzml")
 
 
@@ -76,11 +93,11 @@ EXTR_MS2_DIR<-"MS2"
 EXTR_MS2_FLAG<-file.path(EXTR_MS2_DIR,'.ms2.DONE')
 
 
-FTAB_CHK_NONE<-'NONE'
+SUMM_CHK_NONE<-'NONE'
 
-FTAB_CHK_AUTO<-'AUTO'
+SUMM_CHK_AUTO<-'AUTO'
 
-FTAB_CHK_MANL<-'MANUAL'
+SUMM_CHK_MANL<-'MANUAL'
 
 
 MS1_ERR_COARSE<-0.5                     # Da
@@ -90,7 +107,7 @@ RT_EXTR_ERR<-0.5                       # min
 RT_SHIFT_ERR <- 0.5               # min
 
 MS1_INT_THOLD <- 1e5
-MS2_INT_THOLD <- 0.05
+MS2_INT_THOLD <- 5000.
 
 MS1_SN_FAC <- 3.0
 
@@ -98,3 +115,79 @@ MS1_SN_FAC <- 3.0
 ## Shiny objects
 
 NUM_INP_WIDTH="15%"
+NUM_INP_HEIGHT="5%"
+
+
+
+## Possible compound list fields
+EMPTY_CMPD_LIST <- dtable(ID=character(),
+                          SMILES=character(),
+                          Name=character(),
+                          Formula=character(),
+                          RT=numeric(),
+                          mz=numeric(),
+                          known=character(),
+                          ORIG=character())
+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","Files","wd")
+
+## File table properties
+SUMM_KEY=c("set","tag","mz")
+SUMM_NAMES=c("ID", "mz", "rt", "tag", "adduct", "set", "Name", "SMILES", "Files" , "wd","known")
+
+## Trivial data table
+EMPTY_MZML <- dtable(Files=character(0),
+                     tag=character(0),
+                     adduct=character(0),
+                     set=character(0))
+
+FN_DATA_TAB <- "data-files.csv"
+
+
+## Default number of concurrent workers
+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")
+
+
+## Prescreening columns
+QA_FLAGS <- c("qa_ms1_exists",
+              "qa_ms2_exists",
+              "qa_ms1_above_noise",
+              "qa_ms2_near",
+              "qa_ms2_good_int",
+              "qa_pass")
+
+QA_NUM_REAL <- c("ms1_int","ms1_rt","ms1_mean")
+
+QA_NUM_INT <- c("ms2_sel","ms1_rt_ind")
+
+QA_COLS <- c(QA_FLAGS,QA_NUM_REAL,QA_NUM_INT)
+
+## MS2 spectral table columns
+MS2_SPEC_COLS <- c("adduct","ID","CE","rt","Files","spec","ms2_max_int")
+
+## MS1 spectral table columns
+MS1_SPEC_COLS <- c("adduct","Files","ID","eicMS1","ms1_int","ms1_rt","ms1_mean")
+
+## Default sorting keys of spectra in the summary table
+DEF_KEY_SUMM <- c("set","qa_pass","ms1_int","adduct","mz","tag")
+
+## Default secondary indexing in the summary table
+DEF_INDEX_SUMM <- c("set", "-qa_pass", "-ms1_int", "adduct","-mz")
+
+## Top-level directory to store the figures
+FIG_TOPDIR <- "figures"
+
+## Figure filter
+FIG_DEF_FILTER <- ""
+
+FIG_DEF_SUBSET <- c("set","adduct","ID")
+
+
+REPORT_AUTHOR <- "Anonymous"
+REPORT_TITLE <- "Plots of EICs and MS2 Spectra"

R/run.R

-## Copyright (C) 2020 by University of Luxembourg
-
-## Licensed under the Apache License, Version 2.0 (the "License");
-## you may not use this file except in compliance with the License.
-## You may obtain a copy of the License at
-
-##     http://www.apache.org/licenses/LICENSE-2.0
-
-## Unless required by applicable law or agreed to in writing, software
-## distributed under the License is distributed on an "AS IS" BASIS,
-## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-## See the License for the specific language governing permissions and
-## limitations under the License.
-
-is_gen_done<-function(dest) {
-    fnFlag<-file.path(dest,".gen.DONE")
-    file.exists(fnFlag)
-}
-
-is_ms2_done<-function(set,dest) {
-    fnFlag<-file.path(dest,paste('.',set,'.DONE',sep=''))
-    file.exists(fnFlag)
-}
-
-set_ms2_done<-function(set,dest) {
-    fnFlag<-file.path(dest,paste('.',set,'.DONE',sep=''))
-    file.create(fnFlag)
-}
-
-set_gen_done<-function(dest) {
-    fnFlag<-file.path(dest,".gen.DONE")
-    file.create(fnFlag)
-}
-
-unset_gen_done<-function(dest) {
-    fnFlag<-file.path(dest,".gen.DONE")
-    if (is_gen_done(dest)) unlink(fnFlag,force=T)
-}
-
-
-##' Paste with no separator.
-##'
-##' 
-##' @title Paste With No Separator
-##' @param ... Strings to paste together.
-##' @return Pasted string.
-##' @author Todor Kondić
-attch<-function(...) paste(...,sep='')
-
-##' Do the prescreening.
-##'
-##' @title Prescreening on bunch of files.
-##' @param fTab File table with Files,ID,wd,Name and mz
-##'     columns. Column Files, as well as wd must have all rows
-##'     identical.
-##' @param extr_fun Extraction function from the backend. 
-##' @param errEIC Absolute mz tolerance used to extract precursor EICs.
-##' @param errFinePPM Tolerance given in PPM used to associate input
-##'     masses with what the instrument assigned as precutsors to MS2.
-##' @param proc Amount of processors, or FALSE. 
-##' @param fnLog For parallel execution, dump messages there.
-##' @return Nothing useful.
-##' @author Todor Kondić
-##' @export
-gen<-function(fTab,
-              errEIC,
-              errFinePPM,
-              errCoarse,
-              errRT,
-              proc=F,fnLog='prescreen.log',extr_fun=extr_msnb_ht) {
-    message("*** Started to generate prescreen data ...")
-    unlink(fnLog)
-    fread<-function(fTab) {
-        extract(fTab=fTab,
-                extr_fun=extr_fun,
-                errEIC=errEIC,
-                errFinePPM=errFinePPM,
-                errRT=errRT,
-                errCoarse=errCoarse,
-                fnSpec=FN_SPEC)
-        
-        return(T)
-    }
-
-
-    fns<-unique(fTab$Files)
-    fTabs<-lapply(fns,function(fn) fTab[fTab$Files==fn,])
-    if (proc>1) {
-        cl<-parallel::makeCluster(spec=proc,type='PSOCK',outfile=fnLog)
-        parallel::clusterEvalQ(cl,library(shinyscreen))
-        ## parallel::clusterExport(cl,c("extract"),envir=environment())
-        res<-parallel::parLapply(cl,fTabs,fread)
-        parallel::stopCluster(cl)
-        res
-    } else {
-        lapply(fTabs,fread)
-    }
-    message("*** ... done generating prescreen data.")
-}
-

R/shiny-ui-base.R

+## Copyright (C) 2020 by University of Luxembourg
+
+## Licensed under the Apache License, Version 2.0 (the "License");
+## you may not use this file except in compliance with the License.
+## You may obtain a copy of the License at
+
+##     http://www.apache.org/licenses/LICENSE-2.0
+
+## Unless required by applicable law or agreed to in writing, software
+## distributed under the License is distributed on an "AS IS" BASIS,
+## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+## See the License for the specific language governing permissions and
+## limitations under the License.
+
+##' @importFrom shiny validate
+
+react_v <- shiny::reactiveValues
+react_f <- shiny::reactive
+react_e <- shiny::eventReactive
+obsrv <- shiny::observe
+obsrv_e <- shiny::observeEvent
+isol <- shiny::isolate
+
+# volumes <- function() c(wd=getwd(), shinyFiles::getVolumes()())
+validate1 <- function(expr,msg) shiny::validate(shiny::need(expr,msg))
+
+
+path2vol <- function(path) {
+    ## This function returns shinyFiles compatible volumes.
+    splits <- split_path(path)
+    file.path(tail(splits,1),'')
+}
+
+
+prim_box<-function(...) {shinydashboard::box(...,
+                                             status="primary",
+                                             solidHeader=T)}
+good_box<-function(...) {shinydashboard::box(...,
+                                             status="success",
+                                             solidHeader=T)}
+err_box<-function(...) {shinydashboard::box(...,
+                                            status="danger",
+                                            solidHeader=T)}
+
+inact_box<-function(...) {shinydashboard::box(...,
+                                            status="danger",
+                                            solidHeader=T)}
+
+
+html<-function(...) {shiny::tags$div(shiny::HTML(...))}
+
+## num_input<-function(...,width=NUM_INP_WIDTH) {shiny::tags$div(id="inline",shiny::textInput(...,width=width))}
+
+num_input <- function(inputId,label,...,width=NUM_INP_WIDTH) {
+    shiny::tags$div(style="display:inline-block",
+                    shiny::tags$label(label, `for` = inputId),
+                    shiny::tags$input(id = inputId, type = "text",style=paste("width:",width,sep = ""),...))
+}
+num_input_unit <- function(inputId,l1,l2,width=NUM_INP_WIDTH,...) {
+    shiny::tags$div(style="display:inline-block",
+                    shiny::tags$label(l1, `for` = inputId), 
+                    shiny::tags$input(id = inputId, type = "text",style=paste("width:",width,sep = ""),...),
+                    shiny::tags$label(paste(" ",l2,sep=""), `for` = inputId))
+}
+
+txt_file_input <- function(inputId,input,fileB,label,volumes,default = "") {
+
+    fnobj<-shinyFiles::parseFilePaths(roots = volumes,
+                                      selection = input[[fileB]])
+    fn <- fnobj[['datapath']]
+    
+    if (isThingFile(fn)) {
+        shiny::textInput(inputId = inputId,
+                         label = label,
+                         value = fn)
+    } else {
+        shiny::isolate(currFn <- input[[inputId]])
+        if (!isThingFile(currFn)) {
+            shiny::textInput(inputId = inputId,
+                             label = label,
+                             value = default)
+        } else {
+            shiny::textInput(inputId = inputId,
+                             label = label,
+                             value = currFn)
+        }
+    }
+    
+}
+
+##' @export
+mz_input <- function(input_mz,input_unit,width=NUM_INP_WIDTH,height=NUM_INP_HEIGHT,def_mz=0,def_unit="Da",pref="+/-") {
+    style <- "display: inline-block; vertical-align:top; width: "
+    stylel <- "display: inline-block; vertical-align:top;"
+    style=paste0(style,width,"; ")
+    shiny::div(shiny::div(style=stylel,
+                          shiny::tags$label(pref,`for`=input_mz)),
+               shiny::div(style=style,
+                          shiny::numericInput(input_mz,
+                                              label=NULL,
+                                              value = def_mz)),
+               shiny::div(style=style,
+                          shiny::selectInput(input_unit,
+                                             label=NULL,
+                                             c("ppm","Da"),
+                                             selected=def_unit)))
+}
+
+##' @export
+rt_input <- function(input_rt,input_unit,width=NUM_INP_WIDTH,height=NUM_INP_HEIGHT,def_rt=0,def_unit="min",pref="+/-") {
+    style="display: inline-block; vertical-align:top; width: "
+    style=paste0(style,width,"; ")
+    stylel <- "display: inline-block; vertical-align:top;"
+    shiny::div(shiny::div(style=stylel,
+                          shiny::tags$label(pref,`for`=input_rt)),
+               shiny::div(style=style,
+                          shiny::numericInput(input_rt,
+                                              label=NULL,
+                                              value = def_rt)),
+               shiny::div(style=style,
+                          shiny::selectInput(input_unit,
+                                             label=NULL,
+                                             c("min","s"),
+                                             selected=def_unit)))
+
+}
+
+##'@export
+rev2list <- function(rv) {
+    ## Take reactive values structure and convert them to nested
+    ## lists.
+    if (class(rv)[[1]] != "reactivevalues")
+        rv else lapply(shiny::reactiveValuesToList(rv),rev2list)
+}
+
+##' @export
+list2rev <- function(lst) {
+    ## Take nested named list and create reactive values from it.
+    if (class(lst)[[1]] != "list")
+        lst else do.call(react_v,lapply(lst,list2rev))
+}
+
+mk_roots <- function(wd) local({
+    addons <- c("project"=normalizePath(wd,winslash = '/'))
+    def_vol <- function() {
+             path <- addons[['project']]
+             svols <- shinyFiles::getVolumes()()
+             vol <- path2vol(path)
+             sel <- match(vol,svols)
+             res <- names(svols)[[sel]]
+             res
+         }
+    list(set=function (rts) {addons <<- rts},
+         get=function () c(addons,shinyFiles::getVolumes()()),
+         def_vol=def_vol,
+         def_path=function() {
+             vol <- def_vol()
+             svols <- shinyFiles::getVolumes()()
+             pref <- svols[[vol]]
+             res <- sub(paste0(pref,'(.*)'),'\\1',addons[["project"]])
+             message('Relative path: ',res)
+             res
+         })
+})

R/shiny-ui-cmpd.R

+## Copyright (C) 2020 by University of Luxembourg
+
+## Licensed under the Apache License, Version 2.0 (the "License");
+## you may not use this file except in compliance with the License.
+## You may obtain a copy of the License at
+
+##     http://www.apache.org/licenses/LICENSE-2.0
+
+## Unless required by applicable law or agreed to in writing, software
+## distributed under the License is distributed on an "AS IS" BASIS,
+## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+## See the License for the specific language governing permissions and
+## limitations under the License. 
+
+## Commentary:
+##
+## Defines compound lists tab.
+
+
+mk_ui_cmpd <- function() {
+    ## ***** Compound List Tab *****
+
+    cmpdsListBox<-prim_box(title="Compounds List",
+                         rhandsontable::rHandsontableOutput("cmpdsCtrl"),
+                         width=NULL)
+
+    compFileList <- shiny::verbatimTextOutput("filelist")
+    ## shiny::tags$style(type="text/css", "#filelist {white-space: pre-wrap;}")
+    cmpListLayout <- shiny::fluidRow(shiny::column(
+                                                compFileList,
+                                                cmpdsListBox,
+                                                   width = 12))
+
+    
+    
+    
+    
+    
+    cmpListTab <- shinydashboard::tabItem(tabName="compList",
+                                          cmpListLayout)
+
+    
+    compListSideItem <- shinydashboard::menuItem(text="Compound list",
+                                                 tabName="compList",
+                                                 icon=shiny::icon("table"))
+
+    
+
+    return(list(tab=cmpListTab,
+                side=compListSideItem))
+}
+
+server_cmpd <- function(input,output,session,rv,rf,roots) {
+
+    output$filelist <- shiny::renderText({
+        header <- "Compounds list generated from files:"
+        cmpds <- rv$m$input$tab$cmpds
+
+        files <- unique(cmpds$ORIG)
+        entries <- sapply(files,function(fn) paste0('- ',fn))
+        paste(c(header,entries),collapse = '\n')
+    })
+    
+    output$cmpdsCtrl <- rhandsontable::renderRHandsontable({
+        df<-rv$m$input$tab$cmpds
+        out<-if (!is.null(df)) {
+                 df
+             } else {
+                 EMPTY_CMPD_LIST
+             }
+        rhandsontable::rhandsontable(out,stretchH="all")
+    })
+    rv
+}

R/shiny-ui-config.R

+## Copyright (C) 2020 by University of Luxembourg
+
+## Licensed under the Apache License, Version 2.0 (the "License");
+## you may not use this file except in compliance with the License.
+## You may obtain a copy of the License at
+
+##     http://www.apache.org/licenses/LICENSE-2.0
+
+## Unless required by applicable law or agreed to in writing, software
+## distributed under the License is distributed on an "AS IS" BASIS,
+## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+## See the License for the specific language governing permissions and
+## limitations under the License.
+
+## Commentary:
+##
+## Defines config tab.
+
+mk_ui_config <- function() {
+    browseFile <- function(title,
+                           buttonName,
+                           txtName,
+                           buttonTxt="Import compound list.",
+                           txtTxt="",
+                           icon="file",
+                           description=NULL,
+                           ...) {
+        prim_box(title=title,
+                 shiny::h5(description),
+                 collapsible=F,...)}
+    
+    confImport <- prim_box(title="Import",
+                           shiny::includeMarkdown(system.file("ui/compounds-list-button.md",package="shinyscreen")),
+                           shinyFiles::shinyFilesButton("impCmpdsListB",
+                                                        label="Import compound lists.",
+                                                        title="",
+                                                        icon=shiny::icon("file"),
+                                                        multiple=T),
+                           shiny::includeMarkdown(system.file("ui/compound-sets-button.md",package="shinyscreen")),
+                           shinyFiles::shinyFilesButton("impSetIdB",
+                                                        label="Import set ID table.",
+                                                        title="",
+                                                        icon=shiny::icon("file"),
+                                                        multiple=T),
+                           shiny::uiOutput("fnDataFilesCtrl"),
+                           shinyFiles::shinyFilesButton("impDataFilesB",
+                                                        label="Import data files table.",
+                                                        title="",
+                                                        icon=shiny::icon("file"),
+                                                        multiple=F),
+                           width=NULL)
+
+    confmzMLTags <- prim_box(title="Tags",
+                             shiny::textInput("tagPropInp",
+                                              "What is a tag? (optional)",
+                                              value=TAG_DEF_DESC),
+                             shiny::textInput("tagsInp",
+                                              "Comma-delimited list of tag types.",
+                                              value=""),
+                             shiny::actionButton("updTagsB",
+                                                 label = "Update tags.",
+                                                 icon=shiny::icon("bomb")),
+
+                             width=NULL)
+
+    confState <- prim_box(title="Configuration State",
+                          shinyFiles::shinySaveButton(id="saveConfB",
+                                                      label="Save project configuration.",
+                                                      title="Save",
+                                                      filename = FN_CONF,
+                                                      "yaml"),
+                          shinyFiles::shinyFilesButton(id="restoreConfB",
+                                                       label="Restore project configuration.",
+                                                       multiple=F,
+                                                       title="Restore"),
+                          shinyFiles::shinyDirButton(id="switchProjB",
+                                                     label="Switch project.",
+                                                     title="Switch project.",
+                                                     icon=shiny::icon("recycle")),
+                          shiny::actionButton(inputId="resetConfB",
+                                              label="Reset config (CAUTION!)",
+                                              icon=shiny::icon("trash")),
+                          width=NULL)
+
+
+    confmzMLtab <-prim_box(title="Raw Files in mzML Format",
+                           shiny::h5("Use this file table to assign adduct modes and tags to the data files."),
+                           shinyFiles::shinyFilesButton("mzMLB",
+                                                        label="Select mzML files",
+                                                        title="Select mzML files",
+                                                        icon=shiny::icon("files-o"),
+                                                        multiple=T),
+                           rhandsontable::rHandsontableOutput("mzMLtabCtrl"),
+                           width=NULL)
+
+    
+    confLayout <- shiny::fluidRow(shiny::column(confImport,
+                                                confmzMLTags,
+                                                confState,
+                                                width=4),
+                                  shiny::column(width=8,
+                                                confmzMLtab))
+
+
+    consumm <- shinydashboard::tabItem(tabName="config",
+                                       shiny::h2(GUI_TAB_TITLE[["conf"]]),
+                                       confLayout)
+
+    confSideItem <- shinydashboard::menuItem(text=GUI_SIDE_TITLE[["conf"]],
+                                             tabName="config",
+                                             icon=shiny::icon("user-cog"))
+
+    return(list(tab=consumm,
+                side=confSideItem))
+}
+
+react_conf_f <- function(input,output,session,rv,rf) {
+    ## Reactive functions.
+
+
+
+    rf$get_tags_from_txt <- react_f({
+        ## Tags in the text box.
+        input$updTagsB
+        isol(if (isTruthy(input$tagsInp)) unique(txt2tags(input$tagsInp)) else TAG_DEF)
+    })
+
+    rf$ctrl2mzml_df <- react_f({
+        x <- tryCatch(rhandsontable::hot_to_r(input$mzMLtabCtrl),error=function(m) NULL)
+        shiny::req(x)
+        x
+    })
+
+    rf$ctrl2mzml <- react_f({
+        dtable(rf$ctrl2mzml_df())
+    })
+
+    rf$get_all_sets <- react_f({
+        m <- rf$m_input_cmpds()
+        unique(m$input$tab$setid$set)})
+
+    rf$m_conf <- react_f({
+        m <- list()
+        m$conf$project <- rv$project_path
+        m$conf$compounds$cmpds <- input$cmpds #TODO multi-lists.
+        m$conf$compounds$sets <- input$sets
+        m$conf$data <- input$datafiles
+        verify_compounds(m$conf)
+        m
+    })
+
+    rf$m_input_cmpds <- react_f({
+        m <- rf$m_conf()
+        load_compound_input(m)
+    })
+
+    rf$m_input <- react_f({
+        m <- rf$m_input_cmpds()
+        mzml <- rf$ctrl2mzml()
+        verify_data_df(mzml=mzml,all_sets=rf$get_all_sets())
+        m$input$tab$mzml <- mzml
+        m
+    })
+
+    
+
+    rf$m <- react_f(rf$m_input())
+    
+    rf
+}
+
+server_conf <- function(input,output,session,rv,rf,roots) {
+    
+    ## ***** shinyFiles observers *****
+
+
+
+    shinyFiles::shinyFileChoose(input, 'impCmpdsListB',defaultRoot=roots$def_vol(),
+                                defaultPath=roots$def_path(),roots=roots$get)
+    shinyFiles::shinyFileChoose(input, 'impSetIdB',defaultRoot=roots$def_vol(),
+                                defaultPath=roots$def_path(),roots=roots$get)
+    shinyFiles::shinyFileChoose(input, 'impDataFilesB',defaultRoot=roots$def_vol(),
+                                defaultPath=roots$def_path(),roots=roots$get)
+
+    
+    shinyFiles::shinyFileSave(input, 'saveConfB',defaultRoot=roots$def_vol(),
+                              defaultPath=roots$def_path(),roots=roots$get)
+    shinyFiles::shinyFileChoose(input, 'restoreConfB',defaultRoot=roots$def_vol(),
+                                defaultPath=roots$def_path(),roots=roots$get)
+    shinyFiles::shinyFileChoose(input, 'mzMLB',defaultRoot=roots$def_vol(),
+                                defaultPath=roots$def_path(),roots=roots$get)
+    shinyFiles::shinyDirChoose(input, 'switchProjB',
+                               roots=roots$get,
+                               defaultRoot = "Computer",
+                               defaultPath = "")
+
+
+    obsrv_e(input$switchProjB,{
+        ## Update volumes function as needed.
+        spath<-shinyFiles::parseDirPath(roots=roots$get,
+                                        selection=input$switchProjB)
+        path<- if(length(spath)>0) spath[[1]] else NA
+        if (shiny::isTruthy(path)) {
+            rv$project_path <- path
+        }
+    })
+
+    obsrv_e(input$saveConfB, {
+        m <- rf$m()
+        fn <- shinyFiles::parseSavePath(roots=roots$get,input$saveConfB)[["datapath"]]
+        validate1(fn,msg="Invalid file to save config to.")
+        write_state(m,fn)
+    })
+
+    obsrv_e(input$restoreConfB,{
+        fn <- shinyFiles::parseFilePaths(roots=roots$get,input$restoreConfB)[["datapath"]]
+        assert(file.exists(fn), msg="The file is unreadable.")
+        conf <- read_conf(fn)
+        rv$project_path <- conf$project
+        for (nm in names(conf$compounds)) {
+            shiny::updateTextInput(session=session,
+                                   inputId=nm,
+                                   value=conf$compounds[[nm]])
+        }
+
+        shiny::updateTextInput(session = session,
+                               inputId = "datafiles",
+                               value = conf$data)
+
+        fn <- conf$data
+        assert(fn,msg = "Bad data file table path.")
+        rv$work_mzml_pre <- file2tab(fn)
+        
+    })
+
+    obsrv({
+        ## update-files-on-restore
+        message("update-files-on-restore")
+        rv$work_mzml_pre
+        m <- rf$m_input_cmpds()
+        if (shiny::isTruthy(m$input$tab$setid)) {
+            isol({
+                all_sets <- rf$get_all_sets()
+                dt <- rv$work_mzml_pre
+                txt_tags <- rf$get_tags_from_txt()
+                dt_tags <- unique(dt$tag)
+                tags <- combine_tags(dt_tags,txt_tags)
+                inp_tags <- setdiff(tags,TAG_DEF)
+                shiny::updateTextInput(session = session,
+                                       inputId = "tagsInp",
+                                       value = inp_tags)
+                rv$work_mzml <- mzml2disp(dt, sets = all_sets, tags = tags)
+            })
+        } else assert(m$input$tab$setid, msg = "Compounds set table not built yet.")
+    })
+
+    obsrv_e(input$mzMLB,{
+        ## update-files-on-mzmlb
+        m <- rf$m_input()
+        df <- tryCatch(rhandsontable::hot_to_r(input$mzMLtabCtrl),error=function (e) NULL)
+        shiny::req(df)
+        fchoice<-shinyFiles::parseFilePaths(roots = roots$get,input$mzMLB)
+        paths<-fchoice[["datapath"]]
+        tags <- rf$get_tags_from_txt()
+        
+        
+        df <- add_mzML_files(df,paths)
+        rv$work_mzml <- df
+        
+    })
+
+    obsrv_e(input$updTagsB,{
+        message("update-tags:",Sys.time())
+        df <- rf$ctrl2mzml_df()
+        tags <- rf$get_tags_from_txt()
+        z <- factor(as.character(df$tag), levels = tags)
+        df$tag <- factor(sapply(as.character(z),function(x) if (!is.na(x)) x else TAG_DEF),levels = tags)
+
+        rv$work_mzml <- df
+    })
+
+    obsrv_e(rv$project_path,{
+        ## update-roots
+        message("update-roots:",Sys.time())
+        shiny::req(rv$project_path)
+        dir <- normalizePath(rv$project_path,winslash = '/')
+        if (roots$get()[["project"]] != dir) {
+            roots$set(c("start"= roots$get()[['project']] ,
+                        "project" = dir))
+            
+        } else {
+            roots$set(c("project" = dir))
+        }
+        
+    })
+
+    ## ***** Render *****
+
+    ##     txt_file_input(inputId = 'cmpds',
+    ##                    input = input,
+    ##                    label = html("The list of cmpds. Required columns: <i>ID</i>, <i>SMILES</i>, <i>Name</i> and <i>RT</i> (the last two can be empty). Remember to quote <i>SMILES</i> and <i>Name</i> entries!"),
+    ##                    fileB = 'impCmpdsListB',
+    ##                    volumes=roots$get) #TODO multi-lists
+    ## })
+    output$fnSetIdCtrl <- shiny::renderUI({
+        txt_file_input(inputId = 'sets',
+                       input = input,
+                       label = html("Compounds set table. Required columns <i>ID</i> and <i>set</i>."),
+                       fileB = 'impSetIdB',
+                       volumes=roots$get)
+    })
+    output$fnDataFilesCtrl <- shiny::renderUI({
+        m <- rf$m_conf()
+        txt_file_input(inputId = 'datafiles',
+                       input = input,
+                       label = html("Data files table. Required columns <i>Files</i>, <i>tag</i>, <i>set</i> and <i>adduct</i>."),
+                       fileB = 'impDataFilesB',
+                       volumes=roots$get,
+                       default = file.path(m$conf$project, FN_DATA_TAB))
+    })
+
+    output$mzMLtabCtrl <- rhandsontable::renderRHandsontable({
+        df <- rv$work_mzml
+        m <- rf$m_input_cmpds()
+        if (!shiny::isTruthy(df)) {
+            all_sets <- rf$get_all_sets()
+            txt_tags <- rf$get_tags_from_txt()
+            df <- mzml2disp(EMPTY_MZML, sets = all_sets, tags = txt_tags)
+        }
+        rhandsontable::rhandsontable(df,stretchH="all")
+    })
+    
+    rv
+}
+
+
+mzml2disp <- function(mzml,sets, tags) {
+    ## Add factors for nicer rhandsontable output.
+    df <- as.data.frame(mzml,stringsAsFactors=F)
+    df$set <- factor(as.character(df$set),levels=c(SET_NA,sets))
+    df$set <- factor(sapply(as.character(df$set),function (x) if (!is.na(x)) x else SET_NA),levels = c(SET_NA,sets))
+    df$tag <- factor(df$tag,levels=tags)
+    df$adduct <- factor(df$adduct,levels=names(DISP_ADDUCTMAP))
+    df
+}
+
+disp2mzml <- function(df) {
+    df$set <- as.character(df$set)
+    df$adduct <- as.character(df$adduct)
+    df$tag <- as.character(df$tag)
+    dtable(df)
+}
+
+
+txt2tags <- function(txt) {
+    ## Turns a string into tags
+    x <- if (shiny::isTruthy(txt)) {
+             trimws(unlist(strsplit(txt, ",")))
+         } else list()
+    
+    
+    as.list(c(TAG_DEF,x))
+}
+
+combine_tags <- function(df_tags,txt_tags) {
+    unique(c(TAG_DEF,df_tags,txt_tags))
+}
+
+add_mzML_files<-function(df,paths) {
+    lSet<-levels(df$set)
+    if (length(lSet > 0) && !is.na(lSet)) {
+        
+        nR<-length(paths)
+        if (nR > 0) {
+            st <- nrow(df)+1
+            fi <- nrow(df)+nR
+            df[st:fi,'tag'] <- levels(df$tag)[[1]]
+            df[st:fi,'set'] <- levels(df$set)[[1]]
+            df[st:fi,'adduct'] <- levels(df$adduct)[[1]]
+            df[st:fi,'Files'] <- paths
+        }
+    } else {
+        warning("Define sets using the compound set table before trying to add files!")
+        
+    }
+    df
+}

R/shiny-ui-gen.R

+## Copyright (C) 2020 by University of Luxembourg
+
+## Licensed under the Apache License, Version 2.0 (the "License");
+## you may not use this file except in compliance with the License.
+## You may obtain a copy of the License at
+
+##     http://www.apache.org/licenses/LICENSE-2.0
+
+## Unless required by applicable law or agreed to in writing, software
+## distributed under the License is distributed on an "AS IS" BASIS,
+## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+## See the License for the specific language governing permissions and
+## limitations under the License. 
+
+## Commentary:
+##
+## Defines gen tab.
+
+
+mk_ui_gen <- function() {
+    genBoxExtract<-prim_box(title="Extract Spectra",
+                            num_input(inputId="genNoProc",
+                                      label="Number of processes:  ",
+                                      value=1),
+                            num_input_unit(inputId="errCoarse",
+                                           l1="Precursor m/z error (coarse) (+/-):  ",
+                                           l2="[Da]",
+                                           value=MS1_ERR_COARSE),
+                            num_input_unit("errFinePPM",
+                                           l1="Precursor m/z error (fine) (+/-):  ",
+                                           l2="[ppm]",
+                                           value=MS1_ERR_FINE),
+                            num_input_unit("errEIC",
+                                           l1="EIC m/z error (+/-): ",
+                                           l2="[Da]",
+                                           value=EIC_ERR),
+                            num_input_unit("errRTWin",
+                                           l1="Retention time tolerance (+/-): ",
+                                           l2="[min]",
+                                           value=RT_EXTR_ERR),
+                            shiny::uiOutput("genSetSelInpCtrl"),
+                            shiny::actionButton(inputId="genRunB",
+                                                label="Run!",
+                                                icon=shiny::icon("bomb")),
+                            width=NULL)
+    
+    genBoxAutoQA<-prim_box(title="Automatic Quality Control",
+                           num_input("intThreshMS1",
+                                     label="Intensity threshold (MS1): ",
+                                     value=MS1_INT_THOLD),
+                           num_input("intThreshMS2",
+                                     label="Intensity threshold (MS2): ",
+                                     value=MS2_INT_THOLD),
+                           num_input("noiseFac",
+                                     label="Signal-to-noise ratio: ",
+                                     value=MS1_SN_FAC),
+                           num_input_unit("errRT",
+                                          l1="Retention time shift tolerance (+/-): ",
+                                          value=RT_SHIFT_ERR,
+                                          l2="[min]"),
+                           shiny::actionButton(inputId="qaAutoB",
+                                               label="Preprocess!",
+                                               icon=shiny::icon("bomb")),
+                           width=NULL)
+    
+    genBoxProcessed<-prim_box(title="Processed Sets",
+                              rhandsontable::rHandsontableOutput("genTabProcCtrl"),
+                              width=NULL)
+    
+    genTab<-shinydashboard::tabItem(tabName = "gen",
+                                    shiny::h2(GUI_TAB_TITLE[["gen"]]),
+                                    shiny::fluidRow(shiny::column(genBoxExtract,
+                                                                  width=4),
+                                                    shiny::column(genBoxProcessed,
+                                                                  genBoxAutoQA,width=4)))
+    genSideItem <- shinydashboard::menuItem(text=GUI_SIDE_TITLE[["gen"]],
+                                            tabName="gen",
+                                            icon=shiny::icon("cogs"))
+
+    return(list(tab=genTab,
+                side=genSideItem))
+}
+
+
+server_gen <- function(input,output,session,rv,rf,roots) {
+    
+
+    ## **** Observers ****
+    obsrv({
+        ## Run
+        message("run!")
+        m <- rf$m()
+        m <- mk_comp_tab(m)
+        message("done!")
+    })
+
+    rv
+}

R/shiny-ui-sets.R

+## Copyright (C) 2020 by University of Luxembourg
+
+## Licensed under the Apache License, Version 2.0 (the "License");
+## you may not use this file except in compliance with the License.
+## You may obtain a copy of the License at
+
+##     http://www.apache.org/licenses/LICENSE-2.0
+
+## Unless required by applicable law or agreed to in writing, software
+## distributed under the License is distributed on an "AS IS" BASIS,
+## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+## See the License for the specific language governing permissions and
+## limitations under the License. 
+
+## Commentary:
+##
+## Defines compounds sets tab.
+
+
+mk_ui_sets <- function() {
+    ## ***** Sets of compounds *****
+    setIdBox<-prim_box(title="Compound Sets",
+                       rhandsontable::rHandsontableOutput("setIdCtrl"),
+                       width = NULL)
+
+    setIdLayout<-shiny::fluidRow(shiny::column(setIdBox,
+                                               width = 12))
+
+    setIdTab<-shinydashboard::tabItem(tabName="setId",
+                                      setIdLayout)
+
+    setIdSideItem <- shinydashboard::menuItem(text="Compound sets",
+                                              tabName="setId",
+                                              icon=shiny::icon("table"))
+    return(list(tab=setIdTab,
+                side=setIdSideItem))
+
+}
+
+
+server_sets <- function(input,output,session,rv,rf,roots) {
+    output$setIdCtrl<- rhandsontable::renderRHandsontable({
+        df<-rv$m$input$tab$setid
+        rhandsontable::rhandsontable(df,stretchH="all")
+    })
+
+    rv
+
+}

R/shiny-ui-top.R

+## Copyright (C) 2020 by University of Luxembourg
+
+## Licensed under the Apache License, Version 2.0 (the "License");
+## you may not use this file except in compliance with the License.
+## You may obtain a copy of the License at
+
+##     http://www.apache.org/licenses/LICENSE-2.0
+
+## Unless required by applicable law or agreed to in writing, software
+## distributed under the License is distributed on an "AS IS" BASIS,
+## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+## See the License for the specific language governing permissions and
+## limitations under the License. 
+
+## Commentary:
+##
+## This is a top-level Shiny file to bind them all.
+
+mk_ui <- function (fn_style) {
+    ## Top-level UI function.
+
+    headerText <- "Shinyscreen"
+    header <- shinydashboard::dashboardHeader(title=headerText,
+                                              shinydashboard::dropdownMenuOutput("notify"))
+
+
+    ## plugin-ui
+    conf <- mk_ui_config()
+    cmpd <- mk_ui_cmpd()
+    sets <- mk_ui_sets()
+    gen <- mk_ui_gen()
+    
+    sidebar <- shinydashboard::dashboardSidebar(shinydashboard::sidebarMenu(id='tabs',
+                                                                            conf$side,
+                                                                            gen$side,
+                                                                            shiny::hr(),
+                                                                            shiny::h5("Inputs"),
+                                                                            cmpd$side,
+                                                                            sets$side,
+                                                                            shiny::hr()))
+    body <- shinydashboard::dashboardBody(
+                                shiny::tags$head(shiny::tags$style(shiny::includeHTML(fn_style))),
+                                shinydashboard::tabItems(conf$tab,
+                                                         cmpd$tab,
+                                                         gen$tab,
+                                                         sets$tab))
+
+    shinydashboard::dashboardPage(
+                        header,
+                        sidebar,
+                        body)
+
+}
+
+mk_shinyscreen <- function(wd=getwd(),fn_style=system.file('www/custom.css',package = 'shinyscreen')) {
+    roots <- mk_roots(wd)
+    
+
+
+    server <- function(input,output,session) {
+        ## Top-level server function.
+        
+        rf <- list()           # Container for all
+                               # reactive functions.
+    
+        rv <- new_rv_state(project=wd)   # Container for all
+                                         # reactive values.        
+        
+
+
+
+        
+        rf <- react_conf_f(input,output,session,rv=rv,rf=rf) # Config related r. functions.
+
+        ## plugin-servers
+        rv <- server_conf(input,output,session,rv=rv,rf=rf,roots=roots)
+        rv <- server_cmpd(input,output,session,rv=rv,rf=rf,roots=roots)
+        rv <- server_sets(input,output,session,rv=rv,rf=rf,roots=roots)
+        rv <- server_gen(input,output,session,rv=rv,rf=rf,roots=roots)
+
+
+        
+        obsrv_e(rv,{
+            message(paste("rv changed at ",Sys.time()))
+        })
+        
+        session$onSessionEnded(function () {
+            stopApp()
+        })
+    }
+    shiny::shinyApp(ui=mk_ui(fn_style=fn_style),server=server)
+
+}
+
+
+##' @export
+launch <- function(GUI=T,fn_conf="",wd=getwd(),...) {
+    if (GUI) {
+        app<-mk_shinyscreen(wd=wd)
+        shiny::runApp(appDir = app,...)
+    } else {
+        if (nchar(fn_conf)==0) {
+            fn_conf <- commandArgs(trailingOnly=T)[[1]]
+        }
+        return(run(fn_conf))
+    }
+}

R/shinyUI.R

-## Copyright (C) 2020 by University of Luxembourg
-
-## Licensed under the Apache License, Version 2.0 (the "License");
-## you may not use this file except in compliance with the License.
-## You may obtain a copy of the License at
-
-##     http://www.apache.org/licenses/LICENSE-2.0
-
-## Unless required by applicable law or agreed to in writing, software
-## distributed under the License is distributed on an "AS IS" BASIS,
-## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-## See the License for the specific language governing permissions and
-## limitations under the License.
-
-prim_box<-function(...) {shinydashboard::box(...,
-                                             status="primary",
-                                             solidHeader=T)}
-good_box<-function(...) {shinydashboard::box(...,
-                                             status="success",
-                                             solidHeader=T)}
-err_box<-function(...) {shinydashboard::box(...,
-                                            status="danger",
-                                            solidHeader=T)}
-
-inact_box<-function(...) {shinydashboard::box(...,
-                                            status="danger",
-                                            solidHeader=T)}
-
-
-html<-function(...) {shiny::tags$div(shiny::HTML(...))}
-
-## num_input<-function(...,width=NUM_INP_WIDTH) {shiny::tags$div(id="inline",shiny::textInput(...,width=width))}
-
-num_input <- function(inputId,label,...,width=NUM_INP_WIDTH) {
-    shiny::tags$div(style="display:inline-block",
-                    shiny::tags$label(label, `for` = inputId),
-                    shiny::tags$input(id = inputId, type = "text",style=paste("width:",width,sep = ""),...))
-}
-num_input_unit <- function(inputId,l1,l2,width=NUM_INP_WIDTH,...) {
-    shiny::tags$div(style="display:inline-block",
-                    shiny::tags$label(l1, `for` = inputId), 
-                    shiny::tags$input(id = inputId, type = "text",style=paste("width:",width,sep = ""),...),
-                    shiny::tags$label(paste(" ",l2,sep=""), `for` = inputId))
-}
-
-txt_file_input <- function(inputId,input,fileB,label,volumes) {
-
-    fnobj<-shinyFiles::parseFilePaths(roots = volumes,
-                                      selection = input[[fileB]])
-    fn <- fnobj[['datapath']]
-    
-    if (isThingFile(fn)) {
-        shiny::textInput(inputId = inputId,
-                         label = label,
-                         value = fn)
-    } else {
-        shiny::isolate(currFn <- input[[inputId]])
-        if (!isThingFile(currFn)) {
-            shiny::textInput(inputId = inputId,
-                             label = label,
-                             value = "")
-        } else {
-            message('Why is this happening so much?')
-            shiny::textInput(inputId = inputId,
-                             label = label,
-                             value = currFn)
-        }
-    }
-    
-} 
-
-mkUI <- function(fnStyle) {
-    browseFile <- function(title,
-                           buttonName,
-                           txtName,
-                           buttonTxt="Import compound list.",
-                           txtTxt="",
-                           icon="file",
-                           description=NULL,
-                           ...) {
-        prim_box(title=title,
-                 shiny::h5(description),
-                 collapsible=F,...)}
-    
-    confImport <- prim_box(title="Import",
-                           shiny::uiOutput("fnKnownLCtrl"),
-                           shiny::uiOutput("fnUnkLCtrl"),
-                           shiny::uiOutput("fnSetIdCtrl"),
-                           shinyFiles::shinyFilesButton("impKnownListB",
-                                                        label="Import knowns.",
-                                                        title="",
-                                                        icon=shiny::icon("file"),
-                                                        multiple=F),
-                           shinyFiles::shinyFilesButton("impUnkListB",
-                                                        label="Import unknowns.",
-                                                        title="",
-                                                        icon=shiny::icon("file"),
-                                                        multiple=F),
-                           shinyFiles::shinyFilesButton("impSetIdB",
-                                                        label="Import set ID table.",
-                                                        title="",
-                                                        icon=shiny::icon("file"),
-                                                        multiple=T),
-                           width=NULL)
-
-    confmzMLTags <- prim_box(title="Tags",
-                             shiny::textInput("tagPropInp",
-                                              "What is a tag? (optional)",
-                                              value=TAG_DEF_DESC),
-                             shiny::textInput("tagsInp",
-                                              "Comma-delimited list of tag types.",
-                                              value=""),
-                             width=NULL)
-
-    confState <- prim_box(title="Configuration State",
-                          shinyFiles::shinySaveButton("saveConfB",
-                                                      "Save configuration.",
-                                                      title="Save",
-                                                      filename = "conf-state.rds",
-                                                      "rds"),
-                          shinyFiles::shinyFilesButton("restoreConfB",
-                                                       label="Restore configuration.",
-                                                       multiple=F,
-                                                       title="Restore"),
-                          shiny::actionButton(inputId="resetConfB",
-                                              label="Reset config (CAUTION!)",
-                                              icon=shiny::icon("trash")),
-                          width=NULL)
-
-
-    confmzMLtab <-prim_box(title="Raw Files in mzML Format",
-                           shiny::h5("Use this file table to assign adduct modes and tags to the data files."),
-                           shinyFiles::shinyFilesButton("mzMLB",
-                                                        label="Select mzML files",
-                                                        title="Select mzML files",
-                                                        icon=shiny::icon("files-o"),
-                                                        multiple=T),
-                           rhandsontable::rHandsontableOutput("mzMLtabCtrl"),
-                           width=NULL)
-
-    
-    confLayout <- shiny::fluidRow(shiny::column(confImport,
-                                                confmzMLTags,
-                                                confState,
-                                                width=4),
-                                  shiny::column(width=8,
-                                                confmzMLtab))
-
-
-    confTab <- shinydashboard::tabItem(tabName="config",
-                                       shiny::h2(GUI_TAB_TITLE[["conf"]]),
-                                       confLayout)
-
-    ## ***** Compound List Tab *****
-
-    knownListBox<-prim_box(title="Known Compounds List",
-                         rhandsontable::rHandsontableOutput("knownCtrl"),
-                         width=NULL)
-
-    unkListBox<-prim_box(title="Unknown Compounds List",
-                         rhandsontable::rHandsontableOutput("unkCtrl"),
-                         width=NULL)
-    
-    cmpListLayout <- shiny::fluidRow(shiny::column(knownListBox,
-                                                   unkListBox,
-                                                   width = 12))
-
-    cmpListTab <- shinydashboard::tabItem(tabName="compList",
-                                          cmpListLayout)
-
-    ## ***** Sets of compounds *****
-    setIdBox<-prim_box(title="Compound Sets",
-                       rhandsontable::rHandsontableOutput("setIdCtrl"),
-                       width = NULL)
-
-    setIdLayout<-shiny::fluidRow(shiny::column(setIdBox,
-                                               width = 12))
-
-    setIdTab<-shinydashboard::tabItem(tabName="setId",
-                                      setIdLayout)
-
-    genBoxExtract<-prim_box(title="Extract Spectra",
-                            num_input(inputId="genNoProc",
-                                      label="Number of processes:  ",
-                                      value=1),
-                            num_input_unit(inputId="errCoarse",
-                                           l1="Precursor m/z error (coarse) (+/-):  ",
-                                           l2="[Da]",
-                                           value=MS1_ERR_COARSE),
-                            num_input_unit("errFinePPM",
-                                           l1="Precursor m/z error (fine) (+/-):  ",
-                                           l2="[ppm]",
-                                           value=MS1_ERR_FINE),
-                            num_input_unit("errEIC",
-                                           l1="EIC m/z error (+/-): ",
-                                           l2="[Da]",
-                                      value=EIC_ERR),
-                            num_input_unit("errRTWin",
-                                           l1="Retention time tolerance (+/-): ",
-                                           l2="[min]",
-                                           value=RT_EXTR_ERR),
-                            shiny::uiOutput("genSetSelInpCtrl"),
-                            shiny::actionButton(inputId="genRunB",
-                                                label="Run!",
-                                                icon=shiny::icon("bomb")),
-                            width=NULL)
-    
-    genBoxAutoQA<-prim_box(title="Automatic Quality Control",
-                           num_input("intThreshMS1",
-                                     label="Intensity threshold (MS1): ",
-                                     value=MS1_INT_THOLD),
-                           num_input("intThreshMS2",
-                                     label="Intensity threshold (MS2; relative to MS1 peak intensity): ",
-                                     value=MS2_INT_THOLD),
-                           num_input("noiseFac",
-                                     label="Signal-to-noise ratio: ",
-                                     value=MS1_SN_FAC),
-                           num_input_unit("errRT",
-                                     l1="Retention time shift tolerance (+/-): ",
-                                     value=RT_SHIFT_ERR,
-                                     l2="[min]"),
-                           shiny::actionButton(inputId="qaAutoB",
-                                               label="Preprocess!",
-                                               icon=shiny::icon("bomb")),
-                           width=NULL)
-    
-    genBoxProcessed<-prim_box(title="Processed Sets",
-                              rhandsontable::rHandsontableOutput("genTabProcCtrl"),
-                              width=NULL)
-    
-    genTab<-shinydashboard::tabItem(tabName = "gen",
-                                    shiny::h2(GUI_TAB_TITLE[["gen"]]),
-                                    shiny::fluidRow(shiny::column(genBoxExtract,
-                                                                  width=4),
-                                                    shiny::column(genBoxProcessed,
-                                                                  genBoxAutoQA,width=4)))
-
-    ## ***** Prescreening *****
-
-
-
-    ## Prescreening elements
-    presTitle <- shinydashboard::box(title = "MS Prescreening",
-                                     width = NULL,
-                                     height = "80px",
-                                     background = "blue",
-                                     "")
-    presCompDsc <- shinydashboard::box(title = "Compound ID N°",
-                                       width = NULL,
-                                       height = "80px",
-                                       background = "olive",
-                                       shiny::textOutput("compoundID"))
-
-
-
-    ## presPlotBox <- shinydashboard::box(title = "Plot",
-    ##                                    width = NULL,color = "olive",
-    ##                                    solidHeader = FALSE,
-    ##                                    collapsible = TRUE,
-    ##                                    shiny::plotOutput("chromGram",
-    ##                                                      width = "100%",
-    ##                                                      height = "750px",
-    ##                                                      click = NULL,
-    ##                                                      dblclick = NULL,
-    ##                                                      hover = NULL,
-    ##                                                      hoverDelay = NULL,
-    ##                                                      hoverDelayType = NULL,
-    ##                                                      brush = NULL,
-    ##                                                      clickId = NULL,
-    ##                                                      hoverId = NULL))
-
-    ## Marc Omar Warmoes fix for newer versions of R/Shiny.
-    presPlotBox <- shinydashboard::box(title = "Plot",
-                                       width = NULL,color = "olive",
-                                       solidHeader = FALSE,
-                                       collapsible = TRUE,
-                                       shiny::plotOutput("chromGram",
-                                                         width = "100%",
-                                                         height = "750px",
-                                                         click = NULL,
-                                                         dblclick = NULL,
-                                                         hover = NULL))
-
-    presChromPropMS1<-shinydashboard::box(title="Chromatogram (MS1)",
-                                       width=NULL,
-                                       solidHeader = F,
-                                       collapsible = F,
-                                       shiny::numericInput("min_ms1_rt",
-                                                           "Minimal RT",
-                                                           DEFAULT_RT_RANGE[[1]]),
-                                       shiny::numericInput("max_ms1_rt",
-                                                           "Maximal RT",
-                                                           DEFAULT_RT_RANGE[[2]]),
-                                       shiny::numericInput("min_ms1_int",
-                                                           "Minimal Intensity",
-                                                           DEFAULT_INT_RANGE[[1]]),
-                                       shiny::numericInput("max_ms1_int",
-                                                           "Maximal Intensity",
-                                                           DEFAULT_INT_RANGE[[2]]),
-                                       shiny::radioButtons("int_ms1_axis",
-                                                      "Intensity Scale",
-                                                      c(linear = "linear",
-                                                        log = "log")))
-    
-    presChromPropMS2<-shinydashboard::box(title="Chromatogram (MS2)",
-                                       width=NULL,
-                                       solidHeader = F,
-                                       collapsible = F,
-                                       shiny::numericInput("min_ms2_rt",
-                                                           "Minimal RT",
-                                                           DEFAULT_RT_RANGE[[1]]),
-                                       shiny::numericInput("max_ms2_rt",
-                                                           "Maximal RT",
-                                                           DEFAULT_RT_RANGE[[2]]),
-                                       shiny::numericInput("min_ms2_int",
-                                                           "Minimal Intensity",
-                                                           DEFAULT_INT_RANGE[[1]]),
-                                       shiny::numericInput("max_ms2_int",
-                                                           "Maximal Intensity",
-                                                           DEFAULT_INT_RANGE[[2]]),
-                                       shiny::radioButtons("int_ms2_axis",
-                                                      "Intensity Scale",
-                                                      c(linear = "linear",
-                                                        log = "log")))
-
-    presSpecPropMS2<-shinydashboard::box(title="MS2 Spectrum",
-                                         width=NULL,
-                                         solidHeader = F,
-                                         collapsible = F,
-                                         shiny::numericInput("min_ms2_mz",
-                                                             "Minimal m/z",
-                                                             DEFAULT_MZ_RANGE[[1]]),
-                                         shiny::numericInput("max_ms2_mz",
-                                                             "Maximal m/z",
-                                                             DEFAULT_MZ_RANGE[[2]]),
-                                         shiny::numericInput("min_ms2_sp_int",
-                                                             "Minimal Intensity",
-                                                             DEFAULT_INT_RANGE[[1]]),
-                                         shiny::numericInput("max_ms2_sp_int",
-                                                             "Maximal Intensity",
-                                                             DEFAULT_INT_RANGE[[2]]),
-                                         shiny::radioButtons("int_ms2_sp_axis",
-                                                             "Intensity Scale",
-                                                             c(linear = "linear",
-                                                               log = "log")))
-    
-
-    presSaveBox<-shinydashboard::box(title = "Saving Plots",
-                                     width = NULL,
-                                     solidHeader = F,
-                                     collapsible = F,
-                                     shiny::textInput("plotname",
-                                                      "Insert plot name: (e.g. plotname_%i.pdf)",
-                                                      value="plotCpdID_%i.pdf"),
-                                     shiny::actionButton("saveplot",
-                                                         "Save",
-                                                         icon = shiny::icon("save")),
-                                     shiny::actionButton("saveallplots",
-                                                         "Save All Plots",
-                                                         icon = shiny::icon("save")))
-
-
-
-    presCompSelBox <- shinydashboard::box(title = "Compounds",
-                                          width=NULL,
-                                          solidHeader = FALSE,
-                                          color = "olive",
-                                          collapsible = TRUE,
-                                          "",
-                                          shiny::br(),
-                                          shiny::uiOutput("presSelSetCtrl"),
-                                          shiny::uiOutput("presSelModeCtrl"),
-                                          shiny::actionButton("presPrev",
-                                                              "Previous compound.",
-                                                              icon = shiny::icon("backward")),
-                                          shiny::actionButton("presNext",
-                                                              "Next compound.",
-                                                              icon = shiny::icon("forward")),
-                                          shiny::uiOutput("presSelCmpdCtrl"))
-
-    presQABox <- shinydashboard::box(title = "Prescreening analysis",
-                                     width = NULL,
-                                     solidHeader = FALSE,
-                                     collapsible = TRUE,
-                                     shiny::uiOutput("nvPanel"),
-                                     shiny::actionButton("submitQA",
-                                                         "Submit",
-                                                         icon = shiny::icon("save")),
-                                     shiny::textInput("fn_ftable",
-                                                      "File table Name",
-                                                      value=FN_FTAB_DEF_OUT),
-                                     shiny::actionButton("savefiletable",
-                                                         "Save File Table",
-                                                         icon = shiny::icon("save")))
-
-    presTab <- shinydashboard::tabItem(tabName = "prescreen",
-                                       shiny::h2(GUI_TAB_TITLE[["pres"]]),
-                                       shiny::fluidRow(shiny::column(width=9,
-                                                                     presTitle),
-                                                       shiny::column(width=3,
-                                                                     presCompDsc)),
-                                       shiny::fluidRow(shiny::column(width=9,
-                                                                     presPlotBox),
-                                                       shiny::column(width=3,
-                                                                     presCompSelBox,
-                                                                     presQABox)),
-                                       shiny::fluidRow(shiny::column(width=2,
-                                                                     presChromPropMS1),
-                                                       shiny::column(width=2,
-                                                                     presChromPropMS2),
-                                                       shiny::column(width=2,
-                                                                     presSpecPropMS2),
-                                                       shiny::column(width = 3,
-                                                                     presSaveBox)))
-
-    
-
-
-    ## ***** Log tab *****
-
-    logTab <- shinydashboard::tabItem(tabName="log",
-                                      shiny::h2(GUI_TAB_TITLE[["log"]]),
-                                      shinydashboard::box(rhandsontable::rHandsontableOutput("logCtrl"),
-                                                          width = 12))
-
-
-    ## ***** top-level Elements *****
-    
-    headerText <- "Shinyscreen"
-
-    
-
-    confSideItem <- shinydashboard::menuItem(text=GUI_SIDE_TITLE[["conf"]],
-                                             tabName="config",
-                                             icon=shiny::icon("user-cog"))
-    
-    compListSideItem <- shinydashboard::menuItem(text="Compound list",
-                                                 tabName="compList",
-                                                 icon=shiny::icon("table"))
-
-    setIdSideItem <- shinydashboard::menuItem(text="Compound sets",
-                                              tabName="setId",
-                                              icon=shiny::icon("table"))
-
-    genSideItem <- shinydashboard::menuItem(text=GUI_SIDE_TITLE[["gen"]],
-                                            tabName="gen",
-                                            icon=shiny::icon("cogs"))
-
-    presSideItem <- shinydashboard::menuItem(text=GUI_SIDE_TITLE[["pres"]],
-                                             tabName="prescreen",
-                                             icon=shiny::icon("chart-bar"))
-    
-    logSideItem <- shinydashboard::menuItem(text=GUI_SIDE_TITLE[["log"]],
-                                            tabName = "log",
-                                            icon=shiny::icon("history"))
-
-    header <- shinydashboard::dashboardHeader(title=headerText,
-                                              shinydashboard::dropdownMenuOutput("notify"))
-    
-    sidebar <- shinydashboard::dashboardSidebar(shinydashboard::sidebarMenu(id='tabs',
-                                                                            confSideItem,
-                                                                            genSideItem,
-                                                                            presSideItem,
-                                                                            shiny::hr(),
-                                                                            shiny::h5("Inputs"),
-                                                                            compListSideItem,
-                                                                            setIdSideItem,
-                                                                            shiny::hr(),
-                                                                            logSideItem))
-
-
-    body <- shinydashboard::dashboardBody(
-                                shiny::tags$head(shiny::tags$style(shiny::includeHTML(fnStyle))),
-                                ## shiny::tags$head(
-                                ##                 shiny::tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
-                                ##             ),
-                                shinydashboard::tabItems(confTab,
-                                                         cmpListTab,
-                                                         setIdTab,
-                                                         genTab,
-                                                         presTab,
-                                                         logTab))
-
-
-    
-    shinydashboard::dashboardPage(
-                        header,
-                        sidebar,
-                        body)}
-
-mk_shinyscreen <- function(projDir=getwd(),
-                           fnStyle=system.file('www/custom.css',package = 'shinyscreen')) {
-    message("projDir=",projDir)
-    modeLvl<- c("pH","pNa","pM",
-                "mH","mFA")
-    vols<-shinyFiles::getVolumes()
-    volumes <- c(project=projDir,
-                 home="~",
-                 vols())
-
-    mk_mzMLtab<-function() {
-        modeLvl<- c("pH","pNa","pM",
-                    "mH","mFA")
-        res<-data.frame(Files=character(),
-                        mode=factor(levels=modeLvl),
-                        set=factor(),
-                        tag=factor(),
-                        stringsAsFactors=F)
-        res
-        
-    }
-
-    mk_cmpList<-function() {
-        data.frame(ID=integer(),
-                   Name=character(),
-                   SMILES=character(),
-                   RT=double(),
-                   CAS=character(),
-                   stringsAsFactors = F)
-    }
-
-    mk_setId<-function() {
-        data.frame(ID=integer(),
-                   set=character())}
-    
-    extd_mzMLtab<-function(ft,fn,sets,tags) {
-        modeLvl<- c("select",names(MODEMAP))
-        res<- if (is.null(ft)) {
-                  data.frame(Files=fn,
-                             mode=factor(modeLvl[[1]],levels=modeLvl),
-                             set=factor(sets[[1]],levels=sets),
-                             tag=factor(tags[[1]],levels=tags),
-                             stringsAsFactors=F)
-                  
-              } else {
-                  nR<-nrow(ft)
-                  ft[nR+1,]<-c(Files=fn,
-                               mode=modeLvl[[1]],
-                               set=sets[[1]],
-                               tag=tags[[1]])
-                  ft
-              }
-        res
-    }
-
-    getMz<-function(ids,cmpdL) {
-        mz<-sapply(ids,function(i) {mzs<-cmpdL$mz[cmpdL$ID==i]
-            if (length(mzs)>1) mzs[[1]] else mzs
-        })
-        names(mz)<-NULL
-        mz
-    }
-    mk_cmpd_drop<-function(set,setTab) {
-        wh<-which(setTab$set %in% set)
-        ids<-setTab$ID[wh]
-        mz<-setTab$mz[wh]
-        entries<-base::Map(function(i,m) paste(i,'; ','mz: ',m,sep=''),ids,mz)
-        entries
-    }
-
-    queryFileTable <- function(df,set,mode,id) {
-        sdf<-df[df$set %in% set,]
-        msdf<-sdf[sdf$mode %in% mode,]
-        msdf[msdf$ID %in% id,]
-    }
-
-
-    updateFileTable <- function(df,set,mode,id,linput) {
-        for (tag in names(linput)) {
-            entries <- names(linput[[tag]])
-            cond <- (df$ID %in% id) & (df$tag == tag) & (df$mode %in% mode) & (df$set %in% set)
-            wh<-which(cond)
-
-            df[wh,entries] <- linput[[tag]]
-            df[wh,'checked']<-FTAB_CHK_MANL
-        }
-        df
-    }
-    
-    getCheckboxValues <- function(tag,input,sprops) {
-        chkbox <- input[[sprops[[tag]]]]
-        q <- sapply(QANAMES,function (qn) {
-            if (qn %in% chkbox) T else F
-        })
-        names(q) <- QANAMES
-        q
-    }
-
-    getSetMode <- function(set,mzMLtab) {
-        sdf<-mzMLtab[which(mzMLtab$set %in% set),]
-        levels(factor(as.character(sdf$mode)))
-    }
-
-
-    mtr_set_mode <- function(mtr,set,mode=NULL) {
-        smtr<-mtr[mtr$set %in% set,]
-        res<-if (!is.null(mode)) {
-                 smtr[smtr$mode %in% mode,]
-             } else smtr
-        res
-    }
-    
-    mk_mzML_work<-function() {
-        df<-data.frame(Files=character(),
-                       mode=factor(),
-                       set=factor(),
-                       tag=factor(),
-                       stringsAsFactors=F)
-        levels(df$mode)<-names(MODEMAP)
-        df
-    }
-
-    prep_mzML_work <- function(df,sets,tags) {
-        ## Keeps the dataframe behind the mzML control in shape.
-        if (is.null(df)) df<-mk_mzML_work()
-
-        if (length(tags)>0 && !is.na(tags)) {
-            oldlvl<-levels(df$tag)
-            exttag<-unique(c(unlist(tags),oldlvl))
-            x<-as.character(df$tag)
-            df$tag<-factor(x,levels=exttag)
-            ina<-which(is.na(df$tag))
-            df$tag[ina]<-TAG_DEF
-        }
-        if (length(sets)>0 && !is.na(sets)) {
-            y<-as.character(df$set)
-            df$set<-factor(y,levels=sets)
-        }
-        df
-    }
-
-    add_mzML_files<-function(df,paths) {
-        lSet<-levels(df$set)
-        if (length(lSet>0) && !is.na(lSet)) {
-            nR<-length(paths)
-            if (nR>0) {
-                st<-nrow(df)+1
-                fi<-nrow(df)+nR
-                df[st:fi,'tag']<-levels(df$tag)[[1]]
-                df[st:fi,'set']<-levels(df$set)[[1]]
-                df[st:fi,'mode']<-levels(df$mode)[[1]]
-                df[st:fi,'Files']<-paths
-            }
-            df
-        } else {
-            warning("Define sets using the compound set table before trying to add files!")
-            df
-        }
-    }
-
-    get_ms2_dir<-function(projDir) file.path(projDir,EXTR_MS2_DIR)
-    
-    mk_ms2_dir<-function(projDir) {
-        dir<-get_ms2_dir(projDir)
-        dir.create(path=dir,showWarnings=F)
-        dir
-    }
-
-    proc_qa_todo <- function(df,mtr) {
-        ## Return the sets that should be auto-checked. The sets that
-        ## should be auto-checked are those that have not been
-        ## manually checked/prescreened.
-
-        ind<-which(mtr$checked == FTAB_CHK_NONE |
-              mtr$checked == FTAB_CHK_AUTO)
-        nppsets<-unique(mtr$set[ind])
-        eset<-df$set[df$extracted]
-        eset[eset %in% nppsets]
-    }
-    
-    proc_set<-function(df,set) {
-        i<-which(df$set %in% set)
-        df[i,'extracted']<-T
-        df
-    }
-
-    proc_extr_done <- function(df) {
-        df$set[df$extracted]
-    }
-
-
-    
-    proc_ms2_todo <- function(df) {
-        todo<-which(df$qa & !df$ms2)
-        df$set[todo]
-    }
-
-    proc_done<-function(df) {
-        ind<-which(df$extracted)
-        df$set[ind]
-    }
-
-    proc_read<-function(wd) {
-        readRDS(file.path(wd,FN_SPEC))}
-
-    bak_fstate_pref <- function() {
-        format(Sys.time(),'%Y%m%d_%H_%M_%S_')
-    }
-    server <- function(input,output,session) {
-
-        ## ***** reactive values *****
-        rvConf <- shiny::reactiveValues(
-                             QANAMES=QANAMES,
-                             MODEMAP=MODEMAP,
-                             REST_TXT_INP=REST_TXT_INP,
-                             fnLocSetId=FN_LOC_SETID,
-                             fnFTBase=FN_FTAB_BASE,
-                             fnFTPP=FN_FTAB_PP,
-                             fnComp=FN_COMP_TAB,
-                             mode=modeLvl,
-                             projDir=projDir,
-                             currIDpos=1,
-                             fnFT=FN_FTAB_STATE,
-                             notify=data.frame(time=character(),
-                                               message=character(),
-                                               stringsAsFactors = F))
-        rvTab<-shiny::reactiveValues(
-                          dfProc=NULL,
-                          mzml=NULL,    # mzML file table
-                          mtr=NULL)     # master table (everything combined)
-        rvPres<-shiny::reactiveValues(cex=CEX,
-                                      rt_digits=RT_DIGITS,
-                                      m_digits=M_DIGITS,
-                                      pal=PAL,
-                                      data=NULL,
-                                      plot_id=NULL)
-
-        ## ***** shinyFiles observers *****
-        wdroot<-c(wd=projDir)
-        shinyFiles::shinyFileChoose(input, 'impKnownListB',roots=volumes)
-        shinyFiles::shinyFileChoose(input, 'impUnkListB',roots=volumes)
-        shinyFiles::shinyFileChoose(input, 'impSetIdB',roots=volumes)
-        
-        shinyFiles::shinyFileSave(input, 'saveConfB',roots=wdroot)
-        shinyFiles::shinyFileChoose(input, 'restoreConfB',roots=wdroot)
-        shinyFiles::shinyFileChoose(input, 'mzMLB',roots=volumes)
-
-        ## ***** reactive function definitions *****
-
-        ## get_knowns_from_b <- shiny::eventReactive(input$impKnownListB,
-        ## {
-        ##     fnobj<-shinyFiles::parseFilePaths(roots=volumes,input$impKnownListB)
-        ##     x <- fnobj[["datapath"]]
-        ##     if (isThingFile(x)) x else ""
-        ## },ignoreInit = T)
-        
-        get_all_tags<-shiny::reactive({
-            ## Returns all tags from the input box.
-            tagsInp<-input$tagsInp
-            x<-if (length(tagsInp)>0 && !is.na(tagsInp) && nchar(tagsInp)>0) unlist(strsplit(tagsInp, ",")) else list()
-            as.list(c(x,"unspecified"))
-        })
-
-        get_all_sets<-shiny::reactive({
-            ## Returns all sets defined in a setid table.
-            df<-get_setid_file()
-            sets<-levels(factor(df$set))
-            sets
-        })
-
-        get_sets<-shiny::reactive({
-            ## Returns only the sets set for the mzML files. This
-            ## takes precedense over the sets in setid table.
-            mzml<-get_mzml()
-            shiny::validate(need(mzml,"Please add the mzML files."))
-            sets<-as.character(mzml$set)
-            
-            levels(factor(sets))
-        })
-
-        get_curr_tags<-shiny::reactive({
-            ## Tags in the currently selected set.
-            ft<- get_mtr() 
-            set<-input$presSelSet
-            ftSec<-ft[ft$set %in% set,]
-            tags<-levels(factor(as.character(ftSec$tag)))
-            tags
-        })
-
-        get_known_setid<-shiny::reactive({
-            setid<-get_setid_tab()
-            df<-setid[setid$orig=="known",]
-            df$set<-factor(as.character(df$set))
-            df
-        })
-
-        get_unknown_setid<-shiny::reactive({
-            setid<-get_setid_tab()
-            df<-setid[setid$orig=="unknown",]
-            df$set<-factor(as.character(df$set))
-            df
-        })
-        
-        get_known_sets<-shiny::reactive({
-            fsets<-get_sets()
-            ktab<-get_known_setid()
-            intersect(levels(ktab$set),fsets)
-        })
-
-
-        get_unknown_sets<-shiny::reactive({
-            fsets<-get_sets()
-            utab<-get_unknown_setid()
-            usets<-levels(utab$set)
-            intersect(usets,fsets)
-        })
-
-        get_setid_file<-shiny::reactive({
-            fn<-input$fnSetId
-            shiny::validate(need(fn,"Please set the compounds set CSV filename."),
-                            need(isThingFile(fn),"Cannot find the set CSV file."))
-            
-            message("Importing compound sets from: ",fn)
-            df<-file2tab(file=fn,
-                         colClasses=c(set="factor"))
-            df$set<-factor(df$set)
-            message("Done importing compound sets from: ",fn)
-            df
-        })
-
-        get_setid_tab<-shiny::reactive({
-            setId<-get_setid_file()
-            unk<-get_unk()
-            known<-get_known()
-            idKnown<-known$ID
-            idUnk<-unk$ID
-
-            no_id_clash<-length(intersect(idKnown,idUnk))==0
-            shiny::validate(need(no_id_clash,"IDs of known and unknown compounds must be different. Change this in your compound lists and compounds set input CSV tables."))
-            
-            setId$orig<-rep("",nrow(setId))
-            lKnown<-setId$ID %in% idKnown
-            lUnk<-setId$ID %in% idUnk
-            iKnown<-which(lKnown)
-            iUnk<-which(lUnk)
-            setId[iKnown,"orig"]<-"known"
-            setId[iUnk,"orig"]<-"unknown"
-            setId
-        })
-
-        get_known<-shiny::reactive({
-            fn<-input$fnKnownL
-            res<- if (isThingFile(fn)) {
-                      message("Importing knowns/suspects from: ",fn)
-                      df<-file2tab(file=fn)
-                      x <-vald_comp_tab(df,fn,checkSMILES=T,checkNames=T)
-                      shiny::validate(need(x,"Errors in the known compound list. For reasons, check the messages output to the R session."))
-                      message("Done knowns/suspects from: ",fn)
-                      x
-
-                  } else NULL
-            res
-        })
-
-        get_unk<-shiny::reactive({
-            fn<-input$fnUnkL
-            if (isThingFile(fn)) {
-                message("Importing unknowns list from: ",fn)
-                df<-file2tab(file=fn)
-                res<-vald_comp_tab(df,fn,checkSMILES=F,checkMz=T)
-                shiny::validate(need(res,"Errors in the unknown compound list. For reasons, check the messages output to the R session."))
-                message("Done importing unknowns list from: ",fn)
-                res
-
-            } else NULL
-        })
-
-
-
-        get_curr_set<-shiny::reactive({
-            set<-input$presSelSet
-            shiny::validate(need(set,"Initialising set selection control ..."))
-            set
-        })
-
-        get_mset_comp_tab<-shiny::reactive({
-            set<-get_curr_set()
-            md<-get_curr_mode()
-            comp<-get_comp_tab()
-            scomp<-comp[comp$set %in% set,]
-            mscomp<-scomp[scomp$mode %in% md,]
-            mscomp
-        })
-
-        get_set_modes<-shiny::reactive({
-            set<-get_curr_set()
-            mzML<-get_mzml()
-            levels(factor(mzML$mode[mzML$set %in% set]))
-            
-        })
-        get_curr_mode<-shiny::reactive({
-            md<-input$presSelMode
-            modes<-get_set_modes()
-            shiny::req(md)
-            shiny::req(md %in% modes)
-            md
-        })
-
-        get_curr_set_ids<-shiny::reactive({
-            comp<-get_comp_tab()
-            set<-get_curr_set()
-            md<-get_curr_mode()
-            comp<-comp[comp$set %in% set,]
-            comp<-comp[comp$mode %in% md,]
-            comp$ID
-        })
-
-        get_curr_id_pos<-shiny::reactive({
-            pos<-as.numeric(input$presSelCmpd)
-            lids<-length(get_curr_set_ids())
-            shiny::req(pos <= lids)
-            ## shiny::validate(need(pos,"Initialising compound selection control ..."))
-            ## pos
-            ## rvConf$currIDpos
-            pos
-        })
-
-        get_curr_id<-shiny::reactive({
-            pos<-get_curr_id_pos()
-            ids<-get_curr_set_ids()
-            ids[[pos]]
-        })
-
-        saveConf<-shiny::reactive({
-            fn<-shinyFiles::parseSavePath(root=c(wd=rvConf$projDir),input$saveConfB)[["datapath"]]
-            if ((! is.na(fn)) && length(fn)>0) {
-                message("Saving config to",fn)
-                sav<-list(input=list())
-                for (nm in rvConf$REST_TXT_INP) {
-                    sav$input[[nm]]<-input[[nm]]
-                    
-                }
-                sav$tab<-list()
-                for (nm in REST_TAB) {
-                    df<-rvTab[[nm]]
-                    sav$tab[[nm]]<-df
-                }
-                
-                saveRDS(object=sav,file=fn)
-                message("Saving config finished.")
-            }
-        })
-
-        restoreConf<-shiny::reactive({
-            input$restoreConfB
-            fnobj<-shinyFiles::parseFilePaths(root=c(wd=rvConf$projDir),input$restoreConfB)
-            fn<-fnobj[["datapath"]]
-            if (length(fn)>0 && !is.na(fn) && nchar(fn)>0) {
-                message("Restoring config from",fn)
-                sav<-readRDS(fn)
-
-                for (nm in rvConf$REST_TXT_INP) {
-                    shiny::updateTextInput(session=session,
-                                           inputId=nm,
-                                           value=sav$input[[nm]])
-                }
-                for (nm in REST_TAB) {
-                    rvTab[[nm]]<-sav$tab[[nm]]
-                }
-            }
-        })
-
-        get_mzml_work<-shiny::reactive({
-            tags<-get_all_tags()
-            sets<-get_all_sets()
-            prep_mzML_work(rvTab$mzml,sets,tags)
-        })
-
-        get_mzml <- shiny::reactive({
-            mzml<-get_mzml_work()
-            chset<-as.character(mzml$set)
-            shiny::validate(need(chset,"Sets not properly specified for the mzML files."))
-            mzml$set<-factor(chset)
-            sets<-levels(mzml$set)
-            for (s in sets) {
-                smzml<-mzml[mzml$set %in% s,]
-                modes<-smzml$mode
-                for (m in modes) {
-                    msmzml<-smzml[smzml$mode %in% m,]
-                    tags<-as.character(msmzml$tag)
-                    shiny::validate(need(length(tags)==length(unique(tags)),paste("Tags for a single mode in a set `",s,"' must be unique. Please change!",sep='')))
-                }
-            }
-            tag<-as.character(mzml$tag)
-            mzml$tag<-factor(tag)
-            mzml
-        })
-        
-        gen_pres_set_menu<-shiny::reactive({
-            ids<-get_curr_set_ids()
-            set<-get_curr_set()
-            smcomp<-get_mset_comp_tab()
-            shiny::validate(need(ids,"Bad return from get_curr_set_ids."),
-                            need(set,"Bad return from get_curr_set."),
-                            need(smcomp,"Bad return from get_mset_comp_tab"))
-
-            entries<-mk_cmpd_drop(set,smcomp)
-            ch<-as.list(1:length(ids))
-            names(ch)<-entries
-            ch
-
-        })
-        
-        gen_mset_plot_f<-shiny::reactive({
-            set<-get_curr_set()
-            md<-get_curr_mode()
-            fTab<-get_mtr()
-            
-            comp<-get_mset_comp_tab()
-            compIds<-comp[,"ID"]
-            compSMILES<-comp[,"SMILES"]
-            compMz<-comp[,"mz"]
-            tags<-get_curr_tags()
-            iSet<-which(set==fTab$set & md==fTab$mode)
-            sfTab<-fTab[iSet,]
-            sfTab$tag<-as.character(sfTab$tag)
-            tags<-unique(sfTab$tag)
-            ## Associate wd-s with tags.
-            wdTag<- match(tags,sfTab$tag)
-            wd<-sfTab$wd[wdTag]
-
-            ## Preload the required data for a give set/mode combination.
-            pData<-lapply(wd,function (w) readRDS(file.path(w,FN_SPEC)))
-            names(pData)<-sfTab$tag[wdTag]
-
-
-            preID<-compIds
-            smiles<-compSMILES
-            mz<-compMz
-            names(smiles)<-id2name(preID)
-            names(mz)<-id2name(preID)
-
-            theme<-cowplot::theme_half_open
-            plot_id <- function (id,
-                                 prop,
-                                 log=input$int_axis) {
-                ni=id2name(id)
-                mz=mz[[ni]]
-                smile<-smiles[[ni]]
-
-                ## Extract metadata for the required ID.
-                idTab<-sfTab[sfTab$ID==id,]
-                tags<-idTab$tag
-                rtMS1<-idTab$rt
-                rtMS2<-idTab$MS2rt
-                iMS2rt<-idTab$iMS2rt
-
-                names(rtMS1)<-tags
-                names(rtMS2)<-tags
-                names(iMS2rt)<-tags
-                
-                plot_id_msn(ni,data=pData,
-                            rtMS1=rtMS1,
-                            rtMS2=rtMS2,
-                            iMS2rt=iMS2rt,
-                            mass=mz,
-                            smile=smile,
-                            tags=tags,
-                            prop=prop,
-                            theme=theme,
-                            cex=rvPres$cex,
-                            pal=rvPres$pal,
-                            rt_digits=rvPres$rt_digits,
-                            m_digits=rvPres$m_digits,
-                            fTab=sfTab)
-            }
-
-            plot_id
-        })
-
-        gen_base_ftab<-shiny::reactive({
-            message("Generating basic file table in file ",rvConf$fnFTBase)
-            mzML<-get_mzml_work()
-            files<-adornmzMLTab(mzML,projDir=rvConf$projDir)
-            comp<- get_comp_tab()
-            df<-genSuprFileTab(files,comp)
-            df<-addCompColsToFileTbl(df,comp)
-            df$mode<-as.character(df$mode)
-            tab2file(tab=df,file=rvConf$fnFTBase)
-            message("Done generating basic file table in file ",rvConf$fnFTBase)
-            df
-        })
-
-        mtr_from_inps <- shiny::reactive({
-            fnFT<-rvConf$fnFT
-            if (!file.exists(fnFT)) {
-                message("Generating the first instance of the state file table")
-                bdf <- gen_base_ftab()
-                df<-gen_clean_state_ftab(bdf)
-                tab2file(tab=df,file=fnFT)
-                message("Done generating the first instance of the state file table.")
-                df
-            } else {
-                message("Reading in the state file table.")
-                df<-file2tab(fnFT,colClasses=c("rt"="numeric",
-                                               "MS2rt"="numeric",
-                                               "iMS2rt"="numeric"))
-                message("Done reading in the state file table.")
-                df
-            }
-        })
-
-        get_mtr<-shiny::reactive({
-            mtr<-rvTab$mtr
-            str(mtr)
-            if (!is.null(mtr)) {
-                message("Grabbing existing mtr")
-                return(mtr)
-            } else {
-                mtr <- mtr_from_inps()
-                rvTab$mtr <- mtr
-                return(mtr)
-            }
-        })
-
-        get_comp_tab<-shiny::reactive({
-
-            post_note("Started assembling the lists of knowns and unknowns into the `comprehensive' table.")
-            setId<-get_setid_tab()
-            mzML<-get_mzml()
-            unk<-get_unk()
-            known<-get_known()
-            shiny::validate(need(!(is.null(unk) && is.null(known)),"No compound lists have been provided. At least one of the known, or unknown compound lists is required."))
-            message("Begin generation of comp table.")
-            idKnown<-known$ID
-            idUnk<-unk$ID
-            ## knowns
-            setIdKnown<-get_known_setid()
-            sets<-get_known_sets()
-            nRow<-0
-            for (s in sets) {
-                sMode<-getSetMode(s,mzML)
-                n<-length(sMode)
-                nRow<-nRow+n*length(which(setIdKnown$set %in% s))
-                
-            }
-            compKnown<-data.frame(
-                ID=rep(0,nRow),
-                mz=rep(0.0,nRow),
-                rt=rep(NA,nRow),
-                mode=rep("",nRow),
-                set=rep("",nRow),
-                orig=rep("known",nRow),
-                Name=rep("",nRow),
-                SMILES=rep("",nRow),
-                stringsAsFactors=F)
-
-            i<-1
-            for (s in sets) {
-                sMode<-getSetMode(s,mzML)
-                for (m in sMode) {
-                    for (id in setIdKnown[setIdKnown$set %in% s,"ID"]) {
-                        compKnown[i,"ID"]<-id
-                        compKnown[i,"mode"]<-m
-                        compKnown[i,"set"]<-s
-                        compKnown[i,"mz"]<-get_mz_cmp_l(id,m,known)
-                        sm<-get_col_from_cmp_l(id,"SMILES",known)
-                        nm<-get_col_from_cmp_l(id,"Name",known)
-                        rt<-get_col_from_cmp_l(id,"rt",known)
-                        compKnown[i,"SMILES"]<-sm
-                        compKnown[i,"Name"]<-nm
-                        compKnown[i,"rt"]<-rt
-                        i<-i+1
-                    }
-                    
-                }
-            }
-
-            message("Generation of comp table: knowns done.")
-            ## unknows
-            setIdUnk<-get_unknown_setid()
-            sets<-get_unknown_sets()
-            nRow<-0
-            for (s in sets) {
-                sMode<-getSetMode(s,mzML)
-                n<-length(sMode)
-                if (n>1) stop("Set of unknowns ",s,"has more than one mode. Sets of unknowns cannot have more than one mode.")
-
-                nRow<-nRow+length(which(setIdUnk$set %in% s))
-                
-            }
-            compUnk<-data.frame(
-                ID=rep(0,nRow),
-                mz=rep(0.0,nRow),
-                rt=rep(NA,nRow),
-                mode=rep("",nRow),
-                set=rep("",nRow),
-                orig=rep("unknown",nRow),
-                Name=rep("",nRow),
-                SMILES=rep("",nRow),
-                stringsAsFactors=F)
-
-
-            i<-1
-            for (s in sets) {
-                m<-getSetMode(s,mzML)
-                for (id in setIdUnk[setIdUnk$set %in% s,"ID"]) {
-                    compUnk[i,"ID"]<-id
-                    compUnk[i,"mode"]<-m
-                    compUnk[i,"set"]<-s
-                    compUnk[i,"mz"]<-get_col_from_cmp_l(id,"mz",unk)
-                    nm<-get_col_from_cmp_l(id,"Name",unk)
-                    rt<-get_col_from_cmp_l(id,"rt",unk)
-                    compUnk[i,"Name"]<-nm
-                    compUnk[i,"rt"]<-rt
-                    i<-i+1
-                }
-            }
-            message("Generation of comp table: unknowns done.")
-            df<-rbind(compKnown,compUnk,stringsAsFactors=F)
-            tab2file(df,rvConf$fnComp)
-            message("Generation of comp table finished.")
-            post_note("Finished creating `comprehensive' table.")
-            df   
-
-            
-
-        })
-
-
-        plotProps<-shiny::reactive({
-            prop<-list(ms1=list(rtrng=c(input$min_ms1_rt,
-                                        input$max_ms1_rt),
-                                irng= c(input$min_ms1_int,
-                                        input$max_ms1_int),
-                                axis=input$int_ms1_axis),
-                       ms2=list(rtrng=c(input$min_ms2_rt,
-                                        input$max_ms2_rt),
-                                irng= c(input$min_ms2_int,
-                                        input$max_ms2_int),
-                                axis=input$int_ms2_axis),
-                       spec=list(mzrng=c(input$min_ms2_mz,
-                                         input$max_ms2_mz),
-                                 irng=c(input$min_ms2_sp_int,
-                                        input$max_ms2_sp_int),
-                                 axis=input$int_ms2_sp_axis))
-
-            prop
-        })
-
-        proc_scan <- shiny::reactive({
-            ## Which sets are done.
-            sets<-get_sets()
-            sapply(sets,is_gen_done)
-        })
-
-        extr_ms2_scan <- shiny::reactive({
-            sets<-get_sets()
-            dir<-get_ms2_dir(rvConf$projDir)
-            sapply(sets,is_ms2_done,dest=dir)
-        })
-
-        proc_prep <- shiny::reactive({
-            sets<-get_sets()
-            L<-length(sets)
-            data.frame(set=sets,extracted=rep(F,L),
-                       qa=rep(F,L),
-                       ms2=rep(F,L),stringsAsFactors = F)
-        })
-
-
-        proc_curr<- shiny::reactive({
-            ## Set up the status data frame.
-            message("Detecting processed data.")
-            df <- proc_prep()
-            dsets<-proc_scan()
-            dms2<-extr_ms2_scan()
-            df$extracted<-dsets
-            df$ms2<-dms2
-            message("Detecting processed data finished.")
-            df
-        })
-
-
-        proc_mzml<-shiny::reactive({
-            ## Extract data for selected sets and return the status
-            ## dataframe.
-            shiny::isolate({orig<-if (is.data.frame(rvTab$dfProc)) rvTab$dfProc else NULL})
-            dfProc<-if (is.data.frame(orig)) {
-                     message("Starting from existing proc info.")
-                     orig
-                    } else {
-                        proc_curr()
-            
-                    }
-            input$genRunB
-            shiny::isolate({
-                fTab<-gen_base_ftab()
-                nProc<-as.integer(input$genNoProc)
-                sets<-input$genSetSelInp
-                intThreshMS1<-as.numeric(input$intThreshMS1)
-                noiseFac<-as.numeric(input$noiseFac)
-                errRT<-as.numeric(input$errRT)
-                errFinePPM<-as.numeric(input$errFinePPM)
-                errCoarse <- as.numeric(input$errCoarse)
-                errEIC<-as.numeric(input$errEIC)
-                errRT<-as.numeric(input$errRTWin)
-                for (s in sets) {
-                    message("***** BEGIN set ",s, " *****")
-                    post_note(paste("Extracting data for set",s,". Please wait."))
-                    dest<-rvConf$projDir
-                    gc()
-                    dir.create(s,showWarnings=F)
-                    unset_gen_done(s)
-                    gen(fTab=fTab[fTab$set==s,],
-                        proc=nProc,
-                        errFinePPM=errFinePPM,
-                        errCoarse=errCoarse,
-                        errEIC=errEIC,
-                        errRT=errRT)
-                    set_gen_done(s)
-                    dfProc<-proc_set(dfProc,s)
-                    message("***** END set ",s, " *****")
-                    post_note(paste("Done extracting data for set",s,"."))
-                }
-                gc()
-            })
-            dfProc
-        })
-
-        proc_qa <- shiny::reactive({
-            dfProc<-proc_mzml()
-            input$qaAutoB
-            if (input$qaAutoB>0) {
-                shiny::isolate({
-                    sets<-proc_extr_done(dfProc)
-                    mtr<- get_mtr()
-                    tdsets<-proc_qa_todo(dfProc,mtr)
-                    if (length(tdsets)>0) {
-                        intThreshMS1<-as.numeric(input$intThreshMS1)
-                        intThreshMS2<-as.numeric(input$intThreshMS2)
-                        noiseFac<-as.numeric(input$noiseFac)
-                        errRT<-as.numeric(input$errRT)
-
-
-
-                        ## Which have been already prescreened, or QA checked.
-                        dsets<-setdiff(sets,tdsets)
-                        ind<-which(dfProc$set %in% dsets)
-                        dfProc$qa[ind]<-T
-                        ctdsets<-do.call(paste,c(as.list(tdsets),list(sep=', ')))
-                        message("Starting preprocessing.")
-                        post_note(paste("Started preprocessing these sets: ",ctdsets))
-                        mtrDone<-mtr[mtr$set %in% tdsets,]
-
-                        mtrPP<-preProc(ftable=mtrDone,
-                                       intThreshMS1=intThreshMS1,
-                                       intThreshMS2=intThreshMS2,
-                                       noiseFac=noiseFac,
-                                       errRT=errRT)
-
-                        ## In case preProc added more names to the
-                        ## table.
-                        extNms<-names(mtrPP)
-                        basNms<-names(mtr)
-                        diffNms<-setdiff(extNms,basNms)
-                        nrf<-nrow(mtr)
-                        for (nm in diffNms) {
-                            z<-logical(length=nrf)
-                            z<-T
-                            mtr[[nm]]<-z
-                        }
-                        
-                        mtr[mtr$set %in% tdsets,]<-mtrPP
-                        tab2file(tab=mtr,file=rvConf$fnFT)
-
-                        rvTab$mtr<-mtr
-                        message("Finished preprocessing.")
-                        post_note("Preprocessing done.")
-
-                        idx<-which(dfProc$set %in% tdsets)
-                        dfProc$qa[idx]<-T
-                        dfProc$ms2[idx]<-F #Different preproc params
-                                           #may invalidate extracted
-                                           #spectra.
-                    }
-                })
-            }
-            dfProc
-        })
-
-        proc_ms2 <- shiny::reactive({
-            ## After qa is done, process the ms2 spectra.
-            dfProc <- proc_qa()
-            shiny::isolate({
-                todoSets <- proc_ms2_todo(dfProc)
-                if (length(todoSets)>0) {
-                    mtr <- get_mtr()
-                    dirMS2<-mk_ms2_dir(rvConf$projDir)
-                    ctdsets<-do.call(paste,c(as.list(todoSets),list(sep=', ')))
-                    post_note(paste("Started extracting MS2 from these sets: ",ctdsets))
-                    for (s in todoSets) {
-                        smtr <- mtr_set_mode(mtr=mtr,set=s)
-                        wds <- unique(smtr$wd)
-                        data <- lapply(wds,proc_read)
-                        names(data) <- wds
-                        for (wd in wds) {
-                            d<-data[[wd]]
-                            wsmtr<-smtr[smtr$wd %in% wd,]
-                            tag<-unique(wsmtr$tag)
-                            modes<-unique(wsmtr$mode)
-                            for (m in modes) {
-                                tb<-wsmtr[modes %in% m,c('ID','iMS2rt')]
-                                post_note(paste("Extracting MS2 for set",s,"mode",m, "and tag",tag,"."))
-                                for (n in 1:nrow(tb)) {
-                                    id<-tb[n,'ID']
-                                    ims2<-tb[n,'iMS2rt']
-                                    fn <- file.path(dirMS2,
-                                                    gen_ms2_spec_fn(id=id,
-                                                                    tag=tag,
-                                                                    mode=m,
-                                                                    set=s))
-                                    ms2<-gen_ms2_spec_data(id=id,
-                                                           tag=tag,
-                                                           iMS2rt=ims2,
-                                                           data=d)
-                                    
-                                    if (!is.null(ms2)) tab2file(tab=ms2,file=fn)
-                                    
-
-                                }
-                                post_note(paste("MS2 for set",s, "mode",m,"and tag",tag,"has been extracted."))
-                            }
-                        }
-                        set_ms2_done(s,dirMS2)
-                        is<-which(dfProc$set %in% s)
-                        dfProc[is,'ms2']<-T
-                        post_note("Extraction of the MS2 spectra has been completed.")
-                        
-                    }
-                    return(dfProc)
-                    
-                }
-            })
-            dfProc
-        })
-
-        proc<-shiny::reactive({
-            ## Top-level call to start the chain of reactions needed
-            ## to extract data from sets.
-            df<-proc_ms2()
-            shiny::isolate({rvTab$dfProc<-df})
-            df})
-
-
-        gen_spec_props<-shiny::reactive({
-            tags<-get_curr_tags()
-            spectProps<-sapply(tags,function (tag) paste("spectProps",tag,sep=""))
-            names(spectProps) <- tags
-            spectProps
-        })
-
-        gen_spec_chk_box<-shiny::reactive({
-            id<-get_curr_id()
-            set<-get_curr_set()
-            md<-get_curr_mode()
-            mtr<-get_mtr()
-            QANAMES<-rvConf$QANAMES
-            sdf <- queryFileTable(df=mtr,set=set,mode=md,id=id)
-            sdf$tag<-as.character(sdf$tag)
-            sprops<-gen_spec_props()
-            res<-lapply(sdf$tag,function(t) {
-                sprop <- sprops[[t]]
-                sdfSel<-sdf[sdf$tag %in% t,QANAMES]
-                sel <- as.logical(sdfSel)
-                selected <- QANAMES[sel]
-                names(selected) <- QANAMES[sel]
-                selected
-            })
-            names(res)<-sdf$tag
-            res
-        })
-
-        ## ***** Functions Involving Reactive Values *****
-        post_note<-function(msg) {
-            shiny::isolate({
-                stamp<-Sys.time()
-                df<-rvConf$notify
-                nr<-nrow(df)
-                df[nr+1,'time']<-as.character(stamp)
-                df[nr+1,'message']<-msg
-                rvConf$notify<-df
-            })
-        }
-
-        ## ***** Observe Event *****
-
-        shiny::observeEvent(input$saveConfB,{
-            saveConf()
-        })
-
-        shiny::observeEvent(input$resetConfB,{
-            pDir <- rvConf$projDir
-            shiny::req(rvTab$mtr,pDir,rvConf$fnFT)
-            post_note('Started cleaning up state.')
-            pref<-bak_fstate_pref()
-            fnCurr <- paste0(file.path(pDir,pref),
-                             rvConf$fnFT,'.current.bak.csv')
-            fnLast <- paste0(file.path(pDir,pref),
-                             rvConf$fnFT,'.prev.bak.csv')
-            tab2file(tab=rvTab$mtr,file=fnCurr)
-            post_note(paste('Current state backed up to ',fnCurr,' .',sep=''))
-            maybeSaved <- file.path(pDir,rvConf$fnFT)
-            if (isThingFile(maybeSaved)) {
-                file.copy(maybeSaved,fnLast)
-                post_note(paste('Also, last saved state backed up to ',fnLast,' .',sep=''))
-                unlink(maybeSaved,force = T)
-            }
-            rvTab$mtr<-NULL
-            post_note('State is now less dirty.')
-        })
-
-        shiny::observeEvent(input$restoreConfB,{
-            message("Restore event observed.")
-            restoreConf()
-            message("Restore event finished.")
-        })
-        
-        shiny::observeEvent(input$mzMLtabCtrl,
-        {
-            df<-rhandsontable::hot_to_r(input$mzMLtabCtrl)
-            rvTab$mzml<-df
-        })
-
-        shiny::observeEvent(input$mzMLB,
-        {
-            fchoice<-shinyFiles::parseFilePaths(root=volumes,input$mzMLB)
-            paths<-fchoice[["datapath"]]
-            rvTab$mzml<-add_mzML_files(rvTab$mzml,paths)
-        })
-        
-
-        shiny::observeEvent(input$presSelSet,{
-            rvConf$currIDpos<-1
-        })
-
-        shiny::observeEvent(input$presSelCmpd,{
-            pos<-input$presSelCmpd
-            rvConf$currIDpos<-as.numeric(pos)
-        })
-
-        shiny::observeEvent(input$presPrev,{
-            x<-rvConf$currIDpos-1
-            if (x>0) rvConf$currIDpos<-x
-        })
-
-        shiny::observeEvent(input$presNext,{
-            len<-length(get_curr_set_ids())
-            x<-rvConf$currIDpos+1
-            if (x<=len) rvConf$currIDpos<-x
-        })
-
-        shiny::observeEvent(input$submitQA,{
-            tags<-get_curr_tags()
-            sprops<-gen_spec_props()
-            res <- lapply(tags,getCheckboxValues,input,sprops)
-            names(res) <- tags
-            df<-get_mtr()
-            rvTab$mtr <- updateFileTable(df=df,
-                                         set=get_curr_set(),
-                                         mode=get_curr_mode(),
-                                         id=get_curr_id(),
-                                         linput=res)
-            tab2file(tab=rvTab$mtr,file=rvConf$fnFT)
-
-        })
-        
-        shiny::observeEvent(input$savefiletable,
-        {
-            fn<-input$fn_ftable
-            message("Writing current file table to ",fn)
-            mtr<-get_mtr()
-            tab2file(tab=mtr,file=fn)
-        })
-
-        shiny::observeEvent(input$saveplot,
-        {
-            id=get_curr_id()
-            pfn <-input$plotname
-            if (is.na(pfn)) pfn <- "plotCpdID_%i.pdf"
-            fn <- sprintf(pfn,id)
-            plot_id<-gen_mset_plot_f()
-            prop<-plotProps()
-            pdf(file=fn, width=12, height=8)
-            print(plot_id(id,prop=prop))
-            dev.off()
-            message("Plotting compound ", id," to ",fn," done.")
-        })
-
-        shiny::observeEvent(input$saveallplots,
-        {
-            id=get_curr_id()
-            pfn <-input$plotname
-            if (is.na(pfn)) pfn <- "plotall.pdf"
-            fn <- sprintf(pfn,id)
-            pdf(file=fn, width=12, height=8)
-            ids<-get_curr_set_ids()
-            plot_id<-gen_mset_plot_f()
-            prop<-plotProps()
-            for (id in ids) {
-                print(plot_id(id,prop=prop))
-                message("Plotting compound ", id," done.")
-            }
-            dev.off()
-        })
-
-        ## ***** Observe *****
-
-
-
-
-        ## ***** Render *****
-        output$fnKnownLCtrl <- shiny::renderUI({
-            txt_file_input(inputId = 'fnKnownL',
-                           input = input,
-                           label = html("The list of knowns. Required columns: <i>ID</i>, <i>SMILES</i>, <i>Name</i> and <i>RT</i> (the last two can be empty). Remember to quote <i>SMILES</i> and <i>Name</i> entries!"),
-                           fileB = 'impKnownListB',
-                           volumes=volumes)
-        })
-        output$fnUnkLCtrl <- shiny::renderUI({
-            txt_file_input(inputId = 'fnUnkL',
-                           input = input,
-                           label = html("The list of unknowns. Required columns: <i>ID</i>, <i>mz</i> and <i>RT</i> (<i>RT</i> can be empty)."),
-                           fileB = 'impUnkListB',
-                           volumes=volumes)
-        })
-        output$fnSetIdCtrl <- shiny::renderUI({
-            txt_file_input(inputId = 'fnSetId',
-                           input = input,
-                           label = html("Set table. Required columns <i>ID</i> and <i>set</i>."),
-                           fileB = 'impSetIdB',
-                           volumes=volumes)
-        })
-        output$notify <- shinydashboard::renderMenu({
-            ntf<-rvConf$notify
-            shiny::req(nrow(ntf)>0)
-            msg<-apply(ntf,1,function(x) shinydashboard::notificationItem(text=paste(x['time'],'>',x['message'])))
-            shinydashboard::dropdownMenu(type='notifications',
-                                         .list = msg[length(msg):1])
-        })
-        output$logCtrl <- rhandsontable::renderRHandsontable({
-            df<-rvConf$notify
-            shiny::req(nrow(df)>0)
-            rhandsontable::rhandsontable(df[nrow(df):1,],
-                                         stretchH='all',
-                                         readOnly = T)
-            
-        })
-        
-        output$knownCtrl <- rhandsontable::renderRHandsontable({
-            df<-get_known()
-            out<-if (!is.null(df)) {
-                     df
-                 } else {
-                     data.frame(ID=numeric(),Name=character(),SMILES=character(),RT=numeric())
-                 }
-            rhandsontable::rhandsontable(out,stretchH="all")
-        })
-
-        output$unkCtrl <- rhandsontable::renderRHandsontable({
-            df<-get_unk()
-            out<-if (!is.null(df)) {
-                     df
-                 } else {
-                     data.frame(ID=numeric(),mz=numeric())
-                 }
-            rhandsontable::rhandsontable(out,stretchH="all")
-        })
-
-        output$setIdCtrl<- rhandsontable::renderRHandsontable({
-            df<-get_setid_tab()
-            rhandsontable::rhandsontable(df,stretchH="all")
-        })
-
-        output$mzMLtabCtrl <- rhandsontable::renderRHandsontable({
-            df<-get_mzml_work()
-            rhandsontable::rhandsontable(df,stretchH="all")
-        })
-
-
-        output$genTabProcCtrl<-rhandsontable::renderRHandsontable({
-            df<-proc()
-            rhandsontable::rhandsontable(df,
-                                         stretchH="all",
-                                         rowHeaders = F,
-                                         readOnly = T)
-            
-        })
-
-        output$genSetSelInpCtrl<-shiny::renderUI({
-            sets<-get_sets()
-            shiny::selectInput("genSetSelInp",
-                               label="Select set(s).",
-                               choices=sets,
-                               multiple=T)
-        })
-
-        output$presSelSetCtrl<-shiny::renderUI({
-            sets<-get_sets()
-            shiny::selectInput("presSelSet",
-                               "Set",
-                               choices=sets,
-                               selected=sets[[1]],
-                               multiple=F)
-        })
-        
-        output$presSelModeCtrl<-shiny::renderUI({
-            mds<-get_set_modes()
-            shiny::selectInput("presSelMode",
-                               "Mode",
-                               choices=mds,
-                               selected = mds[[1]],
-                               multiple=F)
-        })
-
-
-        output$presSelCmpdCtrl <- shiny::renderUI({
-            choices<-gen_pres_set_menu()
-            lids<-length(get_curr_set_ids())
-            x<-rvConf$currIDpos
-            req(x<=lids)
-            shiny::selectInput("presSelCmpd",
-                               "Compound",
-                               choices = choices,
-                               selected = x,
-                               multiple = F)
-        })
-        
-        output$nvPanel<-shiny::renderUI({
-            message("Rendering panel started")
-            QANms<-rvConf$QANAMES
-            names(QANms)<-QANms
-            tags<-get_curr_tags()
-            sprops<-gen_spec_props()
-            schoices<-gen_spec_chk_box()
-            tabPanelList <- lapply(tags, function(tag) {
-                shiny::tabPanel(tag, shiny::checkboxGroupInput(inputId = sprops[[tag]],
-                                                               label = "Quality Control",
-                                                               choices = QANms,
-                                                               selected = schoices[[tag]]),
-                                shiny::textAreaInput(paste("caption",tag,sep=""), "Comments: ", "Insert your comment here..."),
-                                shiny::verbatimTextOutput(paste("value",tag,sep=""))
-                                )})
-                
-                
-            message("done rendering panel")
-            do.call(shiny::navlistPanel, tabPanelList)
-        })
-
-        output$chromGram <- renderPlot(
-        {
-
-            plot_id<-gen_mset_plot_f()
-            shiny::validate(need(plot_id,"Initialising the plotting function ..."))
-            id=get_curr_id()
-            prop<-plotProps()
-            plot_id(id=id,prop=prop)
-        })
-
-        
-        session$onSessionEnded(function () stopApp())
-        
-
-        
-    }
-    shiny::shinyApp(ui=mkUI(fnStyle=fnStyle),server=server)
-}
-
-##' @export
-launch<-function(projDir=getwd(),...) {
-    app<-mk_shinyscreen(projDir=projDir)
-    shiny::runApp(appDir = app,...)
-}

README.org

@@ -239,26 +239,51 @@
 
 ***  Data Files
     These should be in mzML format.
-** Sets, Tags, Modes, Files and IDs
-   Each file is labelled by a tag, mode and set. Sets are defined in
+** Sets, Tags, Adducts, Files and IDs
+   Each file is labelled by a tag, adduct and set. Sets are defined in
    the compound set CSV file and group compounds according to their
-   IDs. Modes correspond to the adducts. Tags label files in the
+   IDs. Adducts correspond to the adducts. Tags label files in the
    plots.
 
-   For known compounds, each set can contain multiple modes. Sets of
-   unknowns can only contain a single mode. Any files belonging to the
-   same set that have been acquired in a single mode, must carry
+   For known compounds, each set can contain multiple adducts. Sets of
+   unknowns can only contain a single adduct. Any files belonging to the
+   same set that have been acquired in a single adduct, must carry
    unique tags. 
 
-   In addition, the IDs of compounds belonging to the same set/mode
+   In addition, the IDs of compounds belonging to the same set/adduct
    combination must be unique. Different ID sets may overlap.
 
+   Essentially, sets serve the purpouse of visually grouping files in
+   the plots. Also, set combines those groups of files with particular
+   collections of compounds (from the compound set CSV file).
+
 ** Config Screen
    This is the start tab. Import the compound and set lists first,
    then proceed to import the mzML files. Provide tags in the tag text
-   box and then assign the sets, modes and tags to the imported mzML
+   box and then assign the sets, adducts and tags to the imported mzML
    files using table widget. Once this is done, move on to the
-   `Spectra Extraction' tab.
+   ~Spectra Extraction~ tab.
+
+*** Resetting State
+    In case some inputs have been changed, but the program for some
+    reason does not seem to respond to those changes, perhaps
+    resetting the state using the button ~Reset State~ will help. This
+    will clean the current compound state tables (but, all the inputs
+    remain unchanged).
+
+*** Switching Projects
+    The ~Switch project.~ button can be used to start new projects, or
+    change between them in the middle of processing.  
+
+    Switching projects while the program is running makes most sense
+    if it is desired to change some of the inputs (e.g. different set
+    configuration, or same compound lists but different files) while
+    retaining the others. The user is presented with a directory
+    change dialogue which is then used to select the new project
+    directory. If needed, a new project directory can be created from
+    the same dialogue. All the inputs that currently exist on the
+    configuration tab will be kept during switching. This way, only
+    what needs to be changed can be changed.
 
 ** Spectra Extraction
    Set the extraction parameters and then select a certain number of

inst/rmd/app.Rmd

+---
+output: html_document
+runtime: shiny_prerendered
+author: Environmental Cheminformatics Group, LCSB, University of Luxembourg
+title: "`r paste('Shinyscreen', packageVersion('shinyscreen'))`"
+---
+
+```{r, context='setup', include='false'}
+def_state <- new_state()
+def_datafiles <- shinyscreen:::dtable(File=character(0),
+                                      tag=character(0))
+def_datatab <- shinyscreen:::dtable("tag"=factor(),
+                                    "adduct"=factor(levels=shinyscreen:::DISP_ADDUCTS),
+                                    "set"=factor())
+
+def_summ_subset <- shinyscreen:::dtable("QA Column"=shinyscreen:::QA_FLAGS,
+                                        "Select"=factor("il irrilevante",levels=c("il irrilevante",
+                                                                                  "il buono",
+                                                                                  "il cattivo")))
+## def_state$input$tab$tags <- def_datatab
+rv_state <- list2rev(def_state)
+compl_sets <- eventReactive(rv_state$input$tab$setid,
+                            rv_state$input$tab$setid[,unique(set)])
+## Reactive values to support some of the UI elements.
+## rv_ui <- reactiveValues(datatab=def_tags)
+
+```
+
+
+# Configuration {.tabset}
+
+## Inputs
+
+
+<details>
+<summary>Specify the project directory</summary>
+This is where the output files and the state of the analysis will be
+saved.
+</details>
+```{r, echo=FALSE}
+actionButton(inputId = "project_b",
+             label= "Project")
+
+```
+
+Current project directory is `r textOutput("project", inline=T)`
+
+<details><summary>Load the compound list(s)</summary>
+A compound list is composed of entries describing compounds. This
+description is used to search for its spectrum in the data file. The
+list is a table in the ***CSV*** format and contains these columns,
+
+* ***ID*** : required column, must be filled; this is a user-defined
+  ID, uniquely associated with a compound
+  
+* ***Name*** : this column can be left blank; if not, it should contain the
+  names of the compounds
+  
+* ***SMILES*** : a _SMILES_ string, describing the structure of the
+  compound; this entry can be left empty only if one of either
+  ***Formula***, or ***mz*** entries are not
+  
+* ***Formula*** : a chemical formula of a compound; this field can be
+  empty only if one of either ***SMILES***, or ***mz*** entries are
+  not
+  
+* ***mz*** : mass of the ionised compound; this field can be left
+  empty only if one of either ***SMILES***, or ***Formula*** is not
+  
+* ***CAS*** : the CAS number of the compound; it can be left empty
+
+* ***RT*** : retention time of the MS1 peak in minutes, if known; can
+  be left empty.
+  
+Only ***ID*** and one of ***SMILES***, ***Formula*** or ***mz*** must
+be filled. When structure, or a formula of a compound is known, it is
+also possible to look for various adducts in the sample. Of course,
+scanning for completely unknown compounds is also supported by the
+***mz*** column. In this case, ***mz*** is the mass of the ion.
+
+It is strongly recommended to quote SMILES, names and formulas in the
+CSV file used with Shinyscreen.
+</details>
+```{r, echo=FALSE}
+actionButton(inputId = "comp_list_b",
+             label= "Compound list(s)")
+
+```
+
+`r htmlOutput("comp_lists")`
+
+<details><summary>Load compound set list (_setid_ table)</summary>
+The compound lists can contain more entries than is necessary. Using
+the _setid_ lists, it is possible to create _compound sets_ which
+contain only those compounds that will actually be searched for in the
+data files. A _setid table_ is a _CSV_ containing at least two
+columns,
+
+* ***ID*** : the ID entry from the compound list
+
+* ***set*** : an user-defined set name.
+</details>
+```{r, echo=FALSE}
+actionButton(inputId = "setid_b",
+             label= "Load the setid table")
+
+```
+
+`r htmlOutput("setids", inline=T)`
+
+## Data files
+<details><summary>Load data files</summary>
+Shinyscreen currently supports only the **mzML** file format. After
+loading the files, set file tags in the file table (column
+**tag**). Additionally, specify a set of compounds that is supposed
+to be extracted from the file using the **set** column. Finally,
+specify the **adduct** in the adduct column. In case of compounds
+with unknown structure and formula, the adduct is ignored for obvious
+reasons.
+</details>
+```{r, echo=FALSE}
+actionButton(inputId = "datafiles_b",
+             label= "Load data files.")
+
+```
+
+
+
+
+<details><summary>Assign tags to data files.</summary>
+Each tag designates an unique file. Use the table below to assign
+tags.
+</details>
+
+```{r, echo=FALSE}
+rhandsontable::rHandsontableOutput("datafiles")
+
+```
+
+
+
+
+<details><summary>Assign sets to tags.</summary>
+For each tag, assign a set and an adduct (if the structure information
+exists, otherwise _adduct_ column is ignored).
+</details>
+
+```{r, echo=F}
+rhandsontable::rHandsontableOutput("datatab")
+```
+
+## Extraction
+
+### Spectra extraction based settings
+
+<details><summary>MS1 coarse error</summary>
+
+Extract all entries matching the target mass within this error in the
+precursor table.
+</details>
+```{r, echo=F}
+shinyscreen::mz_input(input_mz = "ms1_coarse",
+                       input_unit = "ms1_coarse_unit",
+                       def_mz = def_state$conf$tolerance[["ms1 coarse"]],
+                       def_unit = "Da")
+```
+
+<details><summary>MS1 fine error</summary>
+
+The precursor table masses can be of lower accuracy. Once there is a
+match within the coarse error, it can be further checked versus the
+fine error bounds directly in the mass spectrum.
+
+</details>
+```{r, echo=F}
+shinyscreen::mz_input(input_mz = "ms1_fine",
+                      input_unit = "ms1_fine_unit",
+                      def_mz = def_state$conf$tolerance[["ms1 fine"]],
+                      def_unit = "ppm")
+```
+
+<details><summary>MS1 EIC window</summary>
+
+The mz interval over which the intensities are aggregated to generate
+a chromatogram.
+
+</details>
+```{r, echo=F}
+shinyscreen::mz_input(input_mz = "ms1_eic",
+                      input_unit = "ms1_eic_unit",
+                      def_mz = def_state$conf$tolerance[["eic"]],
+                      def_unit = "Da")
+```
+
+<details><summary>Retention time window</summary>
+
+If the expected retention time has been specified for the compound,
+then search for the MS1 signature inside the window defined by this
+range.
+
+</details>
+```{r, echo=F}
+shinyscreen::rt_input(input_rt = "ms1_rt_win",
+                      input_unit = "ms1_rt_win_unit",
+                      def_rt = def_state$conf$tolerance[["rt"]],
+                      def_unit = "min")
+```
+
+## Prescreening
+
+<details><summary>MS1 intensity threshold</summary>
+
+Ignore MS1 signal below the threshold.
+
+</details>
+```{r, echo=F}
+
+numericInput(inputId = "ms1_int_thresh",
+             label = NULL,
+             value = def_state$conf$prescreen$ms1_int_thresh)
+```
+
+<details><summary>MS2 intensity threshold</summary>
+
+Ignore MS2 signal below the threshold.
+
+</details>
+```{r, echo=F}
+
+numericInput(inputId = "ms2_int_thresh",
+             label = NULL,
+             value = def_state$conf$prescreen$ms2_int_thresh)
+```
+
+
+MS1 signal-to-noise ratio.
+
+```{r, echo=F}
+
+numericInput(inputId = "s2n",
+             label = NULL,
+             value = def_state$conf$prescreen$s2n)
+```
+
+
+<details><summary>MS1/MS2 retention delay.</summary>
+
+Look for associated MS2 spectrum within this window around the MS1
+peak.
+
+</details>
+```{r, echo=F}
+shinyscreen::rt_input(input_rt = "ret_time_shift_tol",
+                      input_unit = "ret_time_shift_tol_unit",
+                      def_rt = def_state$conf$prescreen[["ret_time_shift_tol"]],
+                      def_unit = "min")
+```
+
+## Filter and order the summary table
+<div style= "display: flex; vertical-align:top; ">
+
+<div style="padding-right: 0.5em">
+<details><summary>Filter summary table</summary>
+
+Filter entries in the summary table according to the QA criteria.
+
+* **qa_pass** : entries that passed all checks
+
+* **qa_ms1_exists** : MS1 intensity is above the MS1 threshold
+
+* **qa_ms2_exists** : those entries for which some MS2 spectra have been found
+
+* **qa_ms1_above_noise** : MS1 is intense enough and above the noise level
+
+* **qa_ms2_good_int** : MS2 intensity is above the MS2 threshold
+
+* **qa_ms2_near** : MS2 spectrum is close enough to the MS1 peak
+
+For those who do not speak Italian (and do not dig the bad Sergio
+Leone pun):
+
+* **il irrelevante** : ignore QA criterion
+* **il buono** : entry passed QA
+* **il cattivo** : entry failed QA
+
+</details>
+```{r, echo=F}
+
+rhandsontable::rHandsontableOutput("summ_subset")
+
+## checkboxGroupInput("summ_subset",
+##                    label=NULL,
+##                    choiceNames = shinyscreen:::QA_FLAGS,
+##                    choiceValues = shinyscreen:::QA_FLAGS)
+
+
+```
+</div>
+
+<div style="padding-left: 0.5em">
+
+<details><summary>Ordering by columns</summary>
+It is possible to order the summary table using columns (keys): 
+*`r paste(gsub("^-(.+)","\\1",shinyscreen:::DEF_INDEX_SUMM), collapse = ',')`*.
+The sequence of columns in the table below describes the
+sequence of ordering steps -- the key in the first row sorts the
+entire summary table and subsequent keys break the ties.
+
+</details>
+
+```{r, echo=F}
+rhandsontable::rHandsontableOutput("order_summ")
+```
+
+</div>
+
+</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
+
+```{r, echo=F}
+checkboxGroupInput("plot_log",
+                   label=NULL,
+                   choiceNames = c("MS1 EIC","MS2 EIC","MS2 Spectrum"),
+                   choiceValues = c(F,F,F))
+```
+
+### Global retention time range
+```{r, echo=F}
+shinyscreen::rt_input(input_rt = "plot_rt_min",
+                      input_unit = "plot_rt_min_unit",
+                      def_rt = NA_real_,
+                      def_unit = "min",
+                      pref = "min:")
+
+shinyscreen::rt_input(input_rt = "plot_rt_max",
+                      input_unit = "plot_rt_max_unit",
+                      def_rt = NA_real_,
+                      def_unit = "min",
+                      pref = "max:")
+```
+
+## Report
+
+```{r, echo=F}
+shiny::textInput(inputId = "rep_aut", label = "Report author", value = def_state$conf$report$author)
+shiny::textInput(inputId = "rep_tit", label = "Report title", value = def_state$conf$report$title)
+```
+
+# View compound Lists and Sets {.tabset}
+
+## Compound List
+
+```{r, echo=F}
+DT::dataTableOutput("comp_table")
+```
+
+## Setid Table
+```{r, echo=F}
+DT::dataTableOutput("setid_table")
+```
+
+# Save and Restore Config
+
+Load the config file if needed.
+
+```{r, echo=FALSE}
+actionButton(inputId = "conf_file_load_b",
+             label= "Load project config")
+
+```
+
+
+
+Save the config file if needed.
+
+```{r, echo=FALSE}
+actionButton(inputId = "conf_file_save_b",
+             label= "Save config")
+
+```
+
+# Extract Data and Prescreen
+
+<details><summary>Extract spectra from data files.</summary>
+
+After Shinyscreen is configured, the compound and setid lists loaded, it
+is possible to proceed with extracting the data. This is potentially a
+time-intensive step, so some patience might be needed.
+
+Once the data is extracted, it will be possible to quality check the
+spectra associated with the compounds specified in the _setid_ list,
+to subset that data, look at the plots and publish a report.
+
+</details>
+```{r, echo=FALSE}
+actionButton(inputId = "extract",
+             label = "Extract")
+```
+
+
+# Browse Results
+
+<!-- Setup is here  -->
+
+```{r, include="false", context='setup'}
+
+ord_nms <- gsub("^-(.+)","\\1",shinyscreen:::DEF_INDEX_SUMM)
+ord_asc <- grepl("^-.+",shinyscreen:::DEF_INDEX_SUMM)
+ord_asc <- factor(ifelse(ord_asc, "descending", "ascending"),levels = c("ascending","descending"))
+def_ord_summ <- shinyscreen:::dtable("Column Name"=ord_nms,"Direction"=ord_asc)
+
+```
+
+```{r, include="false", context='server'}
+## reactive functions
+
+observeEvent(input$setid_b, {
+    filters <- matrix(c("CSV files", ".csv",
+                        "All files", "*"),
+                       2, 2, byrow = TRUE)
+    setids <- tcltk::tk_choose.files(filters=filters)
+    message("(config) Selected compound sets (setid): ", paste(setids,collapse = ","))
+    rv_state$conf$compounds$sets <- if (length(setids)>0 && nchar(setids[[1]])>0) setids else "Nothing selected."
+})
+
+
+
+rf_compound_input_state <- reactive({
+    sets <- rv_state$conf$compounds$sets
+    lst <- as.list(rv_state$conf$compounds$lists)
+    validate(need(length(lst)>0,
+                  message = "Load the compound lists(s) first."))
+    validate(need(nchar(sets)>0,
+                  message = "Load the setid table first."))
+    isolate({
+        state <- rev2list(rv_state)
+        m <- load_compound_input(state)
+        ## Side effect! This is because my pipeline logic does not
+        ## work nicely with reactive stuff.
+        rv_state$input$tab$cmpds <- list2rev(m$input$tab$cmpds)
+        rv_state$input$tab$setid <- m$input$tab$setid
+        m
+        })
+})
+
+rf_get_dfiles <- reactive({
+    input$datafiles_b
+    if (input$datafiles_b > 0) {
+        filters <- matrix(c("mzML files", ".mzML",
+                            "All files", "*"),
+                          2, 2, byrow = TRUE)
+        mzMLs <- tcltk::tk_choose.files(filters=filters)
+        message("(config) Selected data files: ", paste(mzMLs,collapse = ","))
+        mzMLs
+    } else character(0)
+})
+
+rf_dfiles_tab <- reactive({
+    mzMLs <- rf_get_dfiles()
+    isolate({oldtab <- data.table::as.data.table(rhandsontable::hot_to_r(input$datafiles))})
+    newf <- setdiff(mzMLs,oldtab$File)
+    nr <- NROW(oldtab)
+    tmp <- if (length(newf)>0) shinyscreen:::dtable(File=newf,tag=paste0('F',(nr+1):(nr + length(newf)))) else shinyscreen:::dtable(File=character(),tag=character())
+    rbind(oldtab,
+          tmp)
+})
+rf_tag_tab <- reactive({
+    state <- rf_compound_input_state()
+    isolate({oldtab <- rhandsontable::hot_to_r(input$datatab)})
+    oldt <- oldtab$tag
+    sets <- compl_sets()
+    sets <- if (length(sets)==1) sets <- c(sets,"invalid") #Just
+                                                           #because
+                                                           #when one
+                                                           #level,
+                                                           #rhandsontable
+                                                           #has issues
+                                                           #displaying
+                                                           #it.
+
+    otagch <- as.character(oldt)
+    df_tab <- rhandsontable::hot_to_r(input$datafiles)
+    tagl <- df_tab$tag
+    diff <- setdiff(tagl,
+                    otagch)
+    if (length(diff)!=0) {
+        ## Only change the tag names in the old ones.
+        pos_tag <- 1:length(tagl)
+        pos_old <- 1:NROW(oldtab)
+        pos_mod <- intersect(pos_tag,pos_old)
+        new_tag <- tagl[pos_mod]
+        if (NROW(oldtab)>0) oldtab[pos_mod,tag := ..new_tag]
+
+        ## Now add tags for completely new files, if any.
+        rest_new <- if (NROW(oldtab) > 0) setdiff(diff,new_tag) else diff
+        tmp <- shinyscreen:::dtable(tag=factor(rest_new,levels=tagl),
+                                    adduct=factor(levels = shinyscreen:::DISP_ADDUCTS),
+                                    set=factor(levels = sets))
+
+        dt <-data.table::as.data.table(rbind(as.data.frame(oldtab),
+                                             as.data.frame(tmp)))
+        dt[tag %in% df_tab$tag,]
+    } else oldtab
+})
+
+rf_conf_proj <- reactive({
+   
+    state <- rev2list(rv_state)
+    dir.create(state$conf$project,showWarnings = F)
+    state
+    
+})
+
+rf_conf_state <- reactive({
+    state <- rf_conf_proj()
+    message("L 1")
+    mzml1 <- tryCatch(rhandsontable::hot_to_r(input$datatab),
+                      error = function(e) def_datatab)
+    message("L 2")
+    mzml2 <- tryCatch(rhandsontable::hot_to_r(input$datafiles),
+                      error = function(e) def_datafiles)
+    message("L 3")
+    mzml <- mzml1[mzml2,on="tag"]
+    setnames(mzml,"File","Files")
+    ftab <- get_fn_ftab(state)
+    state$conf$data <- ftab
+    state$input$tab$mzml <- mzml
+    message("L 4")
+    state$conf[["summary table"]]$filter <- rf_get_subset()
+    message("L 5")
+    state$conf[["summary table"]]$order <- rf_get_order()
+    state
+})
+
+rf_get_subset <- reactive({
+    dt <- tryCatch(rhandsontable::hot_to_r(input$summ_subset),
+                   error = function(e) def_summ_subset)
+    dt[Select == "il buono", extra := T]
+    dt[Select == "il cattivo", extra := F]
+    sdt <- dt[!is.na(extra)]
+    if (NROW(sdt) > 0) {
+        sdt[,paste0(`QA Column`," == ",extra)]
+    } else NULL
+})
+
+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`]
+})
+```
+
+```{r, include="false", context='server'}
+
+observeEvent(input$project_b,{
+    wd <- tcltk::tk_choose.dir(default = getwd(),
+                               caption = "Choose project directory")
+    message("Set project dir to ", wd)
+    rv_state$conf$project <- wd
+})
+
+observeEvent(input$comp_list_b, {
+    filters <- matrix(c("CSV files", ".csv",
+                        "All files", "*"),
+                       2, 2, byrow = TRUE)
+    compfiles <- tcltk::tk_choose.files(filters=filters)
+    message("(config) Selected compound lists: ", paste(compfiles,collapse = ","))
+    rv_state$conf$compounds$lists <- if (length(compfiles)>0 && nchar(compfiles[[1]])>0) compfiles else "Nothing selected."
+})
+
+observeEvent(input$extract,{
+    tmp <- rev2list(rv_state)
+    fn_c_state <- file.path(tmp$conf$project,
+                            shinyscreen:::FN_CONF)
+    yaml::write_yaml(x=tmp$conf,file=fn_c_state)
+    message("(extract) Config written to ", fn_c_state)
+})
+
+observeEvent(input$conf_file_save_b,
+{
+    state <- rf_conf_state()
+    ftab <- get_fn_ftab(state)
+    fconf <- get_fn_conf(state)
+    yaml::write_yaml(state$conf,
+                     file = fconf)
+    shinyscreen:::tab2file(tab=state$input$tab$mzml,file=ftab)
+    message("Written data-file table to ",ftab)
+    message("Written config to ",fconf)
+})
+
+observeEvent(input$conf_file_load_b,
+{
+    upd_unit <- function(entry,inp_val,inp_unit,choices) {
+        cntnt <- strsplit(entry,split = "[[:space:]]+")[[1]]
+        cntnt <- cntnt[nchar(cntnt) > 0]
+        if (length(cntnt)!=2) stop("(upd_unit) ","Unable to interpret ", entry)
+        val <- cntnt[[1]]
+        unit <- cntnt[[2]]
+        updateNumericInput(session = session,
+                           inputId = inp_val,
+                           value = as.numeric(val))
+        updateSelectInput(session = session,
+                          inputId = inp_unit,
+                          selected = unit,
+                          choices = choices)
+    }
+
+    upd_num <- function(entry,inp_val) {
+        updateNumericInput(session = session,
+                           inputId = inp_val,
+                           value = as.numeric(entry))
+    }
+
+    filters <- matrix(c("YAML files", ".yaml",
+                        "All files", "*"),
+                      2, 2, byrow = TRUE)
+    fn <- tcltk::tk_choose.files(filters=filters,
+                                 multi = F)
+    message("(config) Loading config from: ", paste(fn,collapse = ","))
+    fn <- if (length(fn)>0 && nchar(fn[[1]])>0) fn else ""
+    if (nchar(fn) > 0) {
+        state <- new_state_fn_conf(fn)
+        conf <- state$conf
+        isolate({
+            ## Tolerance
+            
+            upd_unit(conf$tolerance[["ms1 fine"]],
+                     "ms1_fine",
+                     "ms1_fine_unit",
+                     choices=c("ppm","Da"))
+            upd_unit(conf$tolerance[["ms1 coarse"]],
+                     "ms1_coarse",
+                     "ms1_coarse_unit",
+                     choices=c("ppm","Da"))
+
+            upd_unit(conf$tolerance[["eic"]],
+                     "ms1_eic",
+                     "ms1_eic_unit",
+                     choices=c("ppm","Da"))
+            upd_unit(conf$tolerance[["rt"]],
+                     "ms1_rt_win",
+                     "ms1_rt_win_unit",
+                     choices=c("min","s"))
+
+            ## Prescreen
+            upd_num(conf$prescreen[["ms1_int_thresh"]],
+                    "ms1_int_thresh")
+            upd_num(conf$prescreen[["ms2_int_thresh"]],
+                    "ms2_int_thresh")
+            upd_num(conf$prescreen[["s2n"]],
+                    "s2n")
+            upd_unit(conf$prescreen[["ret_time_shift_tol"]],
+                     "ret_time_shift_tol",
+                     "ret_time_shift_tol_unit",
+                     choices=c("min","s"))
+        })
+        
+    }
+
+    
+})
+
+
+
+```
+
+<!-- Tolerance -->
+```{r, include='false', context = 'server'}
+uni_ass <- function(val,unit) {
+    paste(input[[val]],
+          input[[unit]])
+}
+observe({
+    
+    rv_state$conf$tolerance[["ms1 fine"]] <- uni_ass("ms1_fine",
+                                                     "ms1_fine_unit")
+    
+    rv_state$conf$tolerance[["ms1 coarse"]] <- uni_ass("ms1_coarse",
+                                                       "ms1_coarse_unit")
+
+    rv_state$conf$tolerance[["eic"]] <- uni_ass("ms1_eic",
+                                                "ms1_eic_unit")
+
+    rv_state$conf$tolerance[["rt"]] <- uni_ass("ms1_rt_win",
+                                               "ms1_rt_win_unit")
+
+
+})
+```
+
+<!-- Prescreen -->
+```{r, include='false', context = 'server'}
+## uni_ass <- function(val,unit) {
+##     paste(input[[val]],
+##           input[[unit]])
+## }
+observe({
+    
+    rv_state$conf$prescreen[["ms1_int_thresh"]] <- input[["ms1_int_thresh"]]
+    rv_state$conf$prescreen[["ms2_int_thresh"]] <- input[["ms2_int_thresh"]]
+    rv_state$conf$prescreen[["s2n"]] <- input$s2n
+    rv_state$conf$prescreen[["ret_time_shift_tol"]] <- uni_ass("ret_time_shift_tol",
+                                                               "ret_time_shift_tol_unit")
+
+})
+```
+
+<!-- Render -->
+```{r, include="false", context="server"}
+output$project <- renderText(rv_state$conf$project)
+
+output$comp_lists <- renderText({
+    lsts <- rev2list(rv_state$conf$compounds$lists)
+    if (length(lsts) > 0 &&
+        isTruthy(lsts) &&
+        lsts != "Nothing selected.") {
+        paste(c("<ul>",
+                sapply(lsts,
+                       function (x) paste("<li>",x,"</li>")),
+                "</ul>"))
+    } else "No compound list selected yet."
+})
+
+output$setids <- renderText({
+    sets <- rv_state$conf$compounds$sets
+    if (isTruthy(sets) && sets != "Nothing selected.")
+        paste("selected <em>setid</em> table:",
+              sets) else "No <em>setid</em> table selected."
+})
+
+output$order_summ <- rhandsontable::renderRHandsontable(rhandsontable::rhandsontable(def_ord_summ,
+                                                                                     manualRowMove = T))
+
+output$datafiles <- rhandsontable::renderRHandsontable(
+{
+    res <- if (length(rf_get_dfiles())>0) {
+               rf_dfiles_tab()
+
+           } else def_datafiles
+    rhandsontable::rhandsontable(as.data.frame(res),
+                                 width = "50%",
+                                 height = "25%",
+                                 allowInvalid=F)
+})
+
+output$datatab <- rhandsontable::renderRHandsontable(
+{
+    df <- rhandsontable::hot_to_r(input$datafiles)
+    setid <- rv_state$input$tab$setid
+    
+    message("NROW setid:",NROW(setid))
+    message("NROW df:",NROW(df))
+    res <- if (NROW(setid) > 0 &&
+               NROW(df) > 0) rf_tag_tab() else def_datatab
+
+    rhandsontable::rhandsontable(res,stretchH="all",
+                                 allowInvalid=F)
+})
+
+output$comp_table <- DT::renderDataTable({
+    state <- rf_compound_input_state()
+
+
+    DT::datatable(state$input$tab$cmpds,
+                  style = 'bootstrap',
+                  class = 'table-condensed',
+                  extensions = 'Scroller',
+                  options = list(scrollX = T,
+                                 scrollY = 200,
+                                 deferRender = T,
+                                 scroller = T))
+})
+
+output$setid_table <- DT::renderDataTable({
+    state <- rf_compound_input_state()
+
+    DT::datatable(state$input$tab$setid,
+                  style = 'bootstrap',
+                  class = 'table-condensed',
+                  extensions = 'Scroller',
+                  options = list(scrollX = T,
+                                 scrollY = 200,
+                                 deferRender = T,
+                                 scroller = T))
+})
+
+output$summ_subset <- rhandsontable::renderRHandsontable({
+    
+
+    rhandsontable::rhandsontable(def_summ_subset)
+})
+```
+
+```{r, echo=F, context = 'server'}
+session$onSessionEnded(function () stopApp())
+```

man/RMB_EIC_prescreen_df.Rd

-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/mix.R
-\name{RMB_EIC_prescreen_df}
-\alias{RMB_EIC_prescreen_df}
-\title{Prescreen}
-\usage{
-RMB_EIC_prescreen_df(wd, RMB_mode, FileList, cmpd_list,
-  ppm_limit_fine = 10, EIC_limit = 0.001)
-}
-\arguments{
-\item{wd}{Absolute path to the directory that will contain the
-resulting data frame.}
-
-\item{RMB_mode}{...}
-
-\item{FileList}{...}
-
-\item{cmpd_list}{...}
-
-\item{ppm_limit_fine}{...}
-
-\item{EIC_limit}{...}
-}
-\description{
-Prescreens. Writes data out. Adapted from ReSOLUTION
-}
-\author{
-Emma Schymanski, Todor Kondić
-}

man/attch.Rd

-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/run.R
-\name{attch}
-\alias{attch}
-\title{Paste With No Separator}
-\usage{
-attch(...)
-}
-\arguments{
-\item{...}{Strings to paste together.}
-}
-\value{
-Pasted string.
-}
-\description{
-Paste with no separator.
-}
-\author{
-Todor Kondić
-}

man/gen_cmpd_l.Rd

-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/mix.R
-\name{gen_cmpd_l}
-\alias{gen_cmpd_l}
-\title{Generate Compound List File}
-\usage{
-gen_cmpd_l(src_fn, dest_fn)
-}
-\arguments{
-\item{src_fn}{The input compound list CSV filename.}
-
-\item{dest_fn}{The resulting compound list CSV filename.}
-}
-\value{
-Number of compounds.
-}
-\description{
-Generate the RMassBank compound list from the input compound list
-in CSV file src_fn. The input compound list format is either a
-Chemical Dashboard csv file with, at least, PREFERRED_ SMILES
-columns \emph{filled} out, or just an ordinary CSV file with columns
-SMILES and Names filled. Argument dest_fn is the destination
-filename. Returns the number of compounds.
-}
-\author{
-Todor Kondić
-}