R/api.R: Add mk_comp_tab

R/api.R (mk_comp_tab): New function.

R/api.R

@@ -25,12 +25,131 @@ run <- function(fn_conf) {
 }
 
 
-
+##' @export
 run_in_dir <- function(conf) {
-    conf
+    m <- load_inputs(conf)
+    m <- mk_comp_tab(m)
+    m
+    
 }
 
+##' @export
+load_inputs <- function(conf) {
+    m<-list()
+    m$conf <- conf
+    m$input$tab$mzml <- file2tab(m$conf$data)
+    m$input$tab$known <- file2tab(m$conf$compounds$known)
+    if (shiny::isTruthy(m$input$tab$unknown)) m$input$tab$unknown <- file2tab(m$conf$compounds$unknown)
+    m$input$tab$setid <- read_setid(m$conf$compounds$sets,m$input$tab$known,m$input$tab$unknown)#file2tab(m$conf$compounds$sets)
+    m
+}
+
+
+
+mk_comp_tab <- function(m) {
+    message("Started assembling the lists of knowns and unknowns into the `comprehensive' table.")
+    setid <- m$input$tab$setid
+    mzML<- m$input$tab$mzml
+    
+    unk<-m$input$tab$unknown
+    known<-m$input$tab$known
+    assertthat::assert_that(xor(is.null(unk),is.null(known)),msg="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<- setid[origin=="known",]
+    sets<-setid[origin=="known",unique(set)]
+    nRow<-0
+    for (s in sets) {
+        sMode<-get_set_mode(s,mzML)
+        n<-length(sMode)
+        nRow<-nRow+n*length(which(setidKnown$set %in% s))
+        
+    }
+    compKnown<-dtable(
+        ID=rep(0,nRow),
+        mz=rep(0.0,nRow),
+        rt=rep(NA,nRow),
+        mode=rep("",nRow),
+        set=rep("",nRow),
+        origin=rep("known",nRow),
+        Name=rep("",nRow),
+        SMILES=rep("",nRow))
+
+    i<-1
+    for (s in sets) {
+        sMode<-get_set_mode(s,mzML)
+        
+
+        for (md in sMode) {
+            for (id in setidKnown[set == s,ID]) {
+                compKnown[i,"ID"]<-id
+                compKnown[i,"mode"]<-md
+                compKnown[i,"set"]<-s
+                compKnown[i,"mz"]<-get_mz_cmp_l(id,md,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<-setid[origin=="unknown",]
+    sets<-setid[origin=="unknown",unique(set)]
+    nRow<-0
+    for (s in sets) {
+        sMode<-get_set_mode(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<-dtable(
+        ID=rep(0,nRow),
+        mz=rep(0.0,nRow),
+        rt=rep(NA,nRow),
+        mode=rep("",nRow),
+        set=rep("",nRow),
+        origin=rep("unknown",nRow),
+        Name=rep("",nRow),
+        SMILES=rep("",nRow),
+        stringsAsFactors=F)
+
+
+    i<-1
+    for (s in sets) {
+        md<-get_set_mode(s,mzML)
+        for (id in setidUnk[ set == s, ID]) {
+            compUnk[i,"ID"]<-id
+            compUnk[i,"mode"]<-md
+            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<-rbindlist(l=list(compKnown, compUnk))
+    fn_out <- file.path(m$conf$project,FN_COMP_TAB)
+    tab2file(tab=df,file=fn_out)
+    message("Generation of comp table finished.")
+    m$out$tab$comp <- df
+    m
+}
 
+##' @export
 read_conf <- function(fn_conf) {
     assertthat::assert_that(file.exists(fn_conf),msg=paste("Unable to read the configuration file:", fn_conf))
     conf <- yaml::yaml.load_file(fn_conf)