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/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/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))
+    }
+}

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

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ć
-}