Merge branch 'devel' into 'master'

Devel

See merge request !5

NAMESPACE

@@ -3,3 +3,6 @@
 export(presc.do)
 export(presc.plot)
 export(presc.shiny)
+export(gen)
+export(preProc)
+export(impCmpdList)

R/mix.R

@@ -71,8 +71,8 @@ fn_data2wd <- function(fn_data,dest) {
     f(fn_data)
 }
 
-get_presc_d <- function(wd) { file.path(wd,"prescreen")}
-gen_presc_d <- function(wd) { no_drama_mkdir(get_presc_d(wd))}
+get_presc_d <- function(wd) {wd}
+gen_presc_d <- function(wd) { no_drama_mkdir(wd)}
     
     
 
@@ -257,8 +257,7 @@ RMB_EIC_prescreen_df <- function (wd, RMB_mode, FileList, cmpd_list,
     file_list <- read.csv(FileList, stringsAsFactors = FALSE)
     cmpd_info <- read.csv(cmpd_list, stringsAsFactors = FALSE)
     ncmpd <- nrow(cmpd_info)
-    odir=file.path(wd,"prescreen")
-    no_drama_mkdir(odir)
+    odir=wd
     get_width <- function(maxid) {log10(maxid)+1}
     id_field_width <- get_width(ncmpd)
 
@@ -315,6 +314,65 @@ RMB_EIC_prescreen_df <- function (wd, RMB_mode, FileList, cmpd_list,
               row.names = F)
 }
 
+preProc <- function (fnFileTab,fnDest=paste(stripext(fnFileTab),"_candidate.csv",sep=''),noiseFac=3,rtDelta=0.5,intTresh=5e5) {
+
+    ## read in .csv file as file
+    ftable <- read.csv(file = fnFileTab, header = T, sep=",", stringsAsFactors = F)
+    
+    getWidth <- function(maxid) {log10(maxid)+1}
+    ids <- as.numeric(levels(factor(ftable$ID)))
+    id_field_width <- getWidth(max(ids))
+    fn_out<- function(id,suff) {paste(formatC(id,width=id_field_width,flag=0),suff,".csv",sep='')}
+
+    ## for loop through dataframe called file to set tresholds
+    ftable[c("MS1","MS2","Alignment","Intensity","AboveNoise")] <- T
+    ftable$Comments <- ""
+    for (ind in 1:nrow(ftable)) {
+        wd <- ftable$wd[ind]
+        id <- ftable$ID[ind]
+        odir=file.path(wd)
+        fn_eic <- file.path(wd,fn_out(id,".eic"))
+        eic <- NULL
+        maxInt <- NULL
+        eicExists <- F
+        if(!file.exists(fn_eic)) {
+            ftable[ind,"MS1"] = FALSE
+            eicExists <- T
+        }
+        else {
+            eic <- read.csv(fn_eic, sep = ",", stringsAsFactors = F)
+            maxInt <- max(eic$intensity)
+            if (maxInt < intTresh) {
+                ftable[ind,"Intensity"] = FALSE
+            }
+            ## Detect noisy signal. This is a naive implementation, so careful.
+            mInt <- mean(eic$intensity)
+            if (maxInt < noiseFac*mInt) ftable[ind,"AboveNoise"] <- F
+        }
+        fn_kids <- file.path(wd,fn_out(id,".kids"))
+        if(!file.exists(fn_kids)) {
+            ftable[ind,"MS2"] = FALSE
+        } else {
+            ## Detect RT shifts. Naive implementation, so careful.
+            if (eicExists) {
+                rtInd <- match(maxInt,eic$intensity)
+                rtMax <- eic$rt[rtInd]
+                msms <- read.csv(fn_kids, sep = ",", stringsAsFactors = F)
+                whc <- msms$rt > rtMax - rtDelta
+                whc <- whc < rtMax + rtDelta
+                ints <- msms$intensity[whc]
+                if (! any(ints>0)) ftable[ind,"Alignment"] = FALSE
+            }
+            
+        }
+    }
+
+    ## get a csv outfile
+    write.csv(ftable, file = fnDest,row.names=F)
+
+}
+
+
 ##' Helper function for rendersmiles2
 ##'
 ##' @title Render Compound from an Online Resource
@@ -609,6 +667,7 @@ presc.shiny <-function(prescdf,mode,fn_cmpd_l,pal="Dark2",cex=0.75,rt_digits=2,m
 
     QANAMES <- c("MS1","MS2","Alignment","Intensity","AboveNoise")
 
+    prescdf$tag <- as.character(prescdf$tag)
     tags <- levels(factor(prescdf$tag))
     wd <- prescdf$wd[match(tags,prescdf$tag)]
     
@@ -628,7 +687,6 @@ presc.shiny <-function(prescdf,mode,fn_cmpd_l,pal="Dark2",cex=0.75,rt_digits=2,m
     }
 
 
-
     ## Get the basenames of eic files.
     eics <- list.files(path=wd[[1]],patt=".*eic.csv")
     maybekids <- sapply(strsplit(eics,split="\\."),function(x) {paste(x[[1]][1],'.kids.csv',sep='')})
@@ -654,7 +712,6 @@ presc.shiny <-function(prescdf,mode,fn_cmpd_l,pal="Dark2",cex=0.75,rt_digits=2,m
         q
     }
     
-    
     server <- function(input, output, session) {
         rv <- shiny::reactiveValues(prescList=list(),
                                     prescdf=prescdf,

R/run.R

@@ -20,26 +20,49 @@ attch<-function(...) paste(...,sep='')
 ##' @return Nothing useful.
 ##' @author Todor Kondić
 ##' @export
-presc.do<-function(fn_data,fn_cmpd_l,mode,dest=".",proc=F,...) {
-    conf(fn_data,fn_cmpd_l,dest)
-
-    fread <- function(fn_data) {
-        wd <- fn_data2wd(fn_data,dest)
+presc.do<-function(fnData,fnStgs=attch(stripext(fnData),".ini"),wd,fnCmpdList,mode,dest=".",proc=F,fnLog='prescreen.log',...) {
+    
+    RMassBank::loadRmbSettings(fnStgs[[1]])
+    RMassBank::loadList(fnCmpdList)
+    cmpd <- read.csv(file=fnCmpdList,stringsAsFactors = F)
+    n_cmpd <- nrow(cmpd)
+    
+    fread <- function(fnData,fnStgs,wd) {
         gen_presc_d(wd)
-        reconf(wd)
+        RMassBank::loadRmbSettings(fnStgs)
+        RMassBank::loadList(fnCmpdList)
         message("Currently processing: ",wd)
+        gen_ftable(fnData,wd,n_cmpd)
         fn_ftable <- get_ftable_fn(wd)
-        fn_cmpd_l <- get_cmpd_l_fn(wd)
         RMB_EIC_prescreen_df(wd=wd,RMB_mode=mode,FileList=fn_ftable,
-                             cmpd_list=fn_cmpd_l,...)
+                             cmpd_list=fnCmpdList,...)
     }
 
     if (proc) {
-        cl<-parallel::makeCluster(proc)
+        cl<-parallel::makeCluster(proc,type='PSOCK',outfile=fnLog)
         parallel::clusterEvalQ(cl,library(shinyscreen))
-        parallel::clusterMap(cl,fread,fn_data)
+        parallel::clusterMap(cl,fread,fnData,fnStgs,wd)
     } else {
-        lapply(fn_data,fread)
+        Map(fread,fnData,fnStgs,wd)
     }
 }
 
+impCmpdList <- function(fnSrc,fnDest=file.path(".",basename(fnSrc))) {
+    gen_cmpd_l(src_fn=fnSrc,dest_fn=fnDest)
+}
+
+gen<-function(fnFileTab,fnCmpdList,mode,fnDestFileTable=attch(stripext(fnFiletable),"_candidate.csv"),dest=".",fnLog='prescreen.log',proc=F,intTresh=5e5,noiseFac=3,rtDelta=0.5,ppmLimFine=10,eicLim=1e-3) {
+    message("*** Started to generate prescreen data ...")
+    
+    ## Read in the file table.
+    fTab <- read.csv(file = fnFileTab, header = T, sep=",", stringsAsFactors = F)
+
+    ## Get files and the associated work directories.
+    fnData <- levels(factor(fTab$Files))
+    wd <- fTab$wd[match(fnData,fTab$Files)]
+
+    ## Do the prescreen.
+    presc.do(fnData=fnData,wd=wd,fnCmpdList=fnCmpdList,mode=mode,dest=dest,ppm_limit_fine=ppmLimFine,EIC_limit=eicLim,proc=proc,fnLog=fnLog)
+    message("*** ... done generating prescreen data.")
+}
+