data-model: Fix precid/isocoarse merge for isobars.

test-data-model: New test suite for data-model.R

R/data-model.R

@@ -18,12 +18,29 @@ make_db_catalogue <- function(m) {
 }
 
 
+
+merge_precid_4_isobars <- function(orig_precids,masses,up_masses) {
+    start = head(orig_precids,1L)
+    n = length(orig_precids)
+    precid = orig_precids
+    i = 1L
+    while (i < n) {
+        theprecid = orig_precids[[i]]
+        themz = masses[[i]]
+        mzup = up_masses[[i]]
+        w = which(masses[(i+1L):n]<mzup)
+        precid[(i+1L):n][w] = theprecid
+        i = i + length(w) + 1L
+    }
+    precid
+}
+
 make_db_precursors <- function(m) {
     ## Generate masses and label isobars.
 
     cat = m$db$cat
-    masses = m$out$tab$comp[cat,.(catid=catid,mz=mz,rt=rt),on=key(cat)]
-    setkey(masses,mz)
+    masses = m$out$tab$comp[cat,.(tag=tag,catid=catid,mz=mz,rt=rt),on=key(cat)]
+    setkey(masses,tag,mz)
 
     ## Retention time.
     tmp = get_val_unit(m$conf$tolerance[['rt']])
@@ -61,33 +78,12 @@ make_db_precursors <- function(m) {
         stop('make_db_precursors: Unknown mass unit (coarse).')
     }
     ## TODO: FIXME: Should precids be unique, or not?
-    browser()
-    masses$precid = -1L
-    start = 1L
-    while (start <= NROW(masses)) {
-        sel = masses[start:.N]
-        themz = sel[1L,mz]
-        id = sel[1L,catid]
-        upmz = sel[1L,mz_fine_max]
-        x = sel[mz<(upmz)]
-        stop = start + NROW(x) - 1L
-        masses[(start):(stop),`:=`(precid=..id,degfine=(1L+stop-start))]
-        start = stop + 1L
-    }
 
-    masses$isocoarse = -1L
-    start = 1L
-    while (start <= NROW(masses)) {
-        sel = masses[start:.N]
-        themz = sel[1L,mz]
-        id = sel[1L,catid]
-        upmz = sel[1L,mz_coarse_max]
-        x = sel[mz<(upmz)]
-        stop = start + NROW(x) - 1L
-        masses[(start):(stop),`:=`(isocoarse=..id,degcoarse=(1L+stop-start))]
-        start = stop + 1L
-    }
+    ## Assign "fine" isobars to same isocoarse number.
+    masses[,precid:=merge_precid_4_isobars(catid,mz,mz_fine_max),by="tag"]
 
+    ## Assign "coarse" isobars to same isocoarse number.
+    masses[,isocoarse:=merge_precid_4_isobars(catid,mz,mz_coarse_max),by="tag"]
     
 
     masses[,`:=`(iso_coarse_min=min(mz_coarse_min),

tests/testthat/test-data-model.R

+test_that("Test merge_precid_4_isobars.",{
+    orig_precids = 1L:10L
+    masses = c(1.,1.5,2.5,2.6,2.65,3.5,3.6,3.7,5,6)
+    up_masses = c(1.2,2.4,2.7,2.9,2.85,3.59,3.9,4,5.5,6.5)
+    x = merge_precid_4_isobars(orig_precids,masses,up_masses)
+    expect_equal(x,c(1L,2L,3L,3L,3L,6L,7L,7L,9L,10))
+
+    orig_precids = integer(0)
+    masses = numeric(0)
+    up_masses = numeric(0)
+    x = merge_precid_4_isobars(orig_precids,masses,up_masses)
+    expect_equal(x,integer(0))
+    
+    
+})
+
+test_that("Test merge_precid_4_isobars on real data.",{
+    orig = c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)
+    msms = c(76.039304862,90.054954926,106.049869546,116.07060499,118.086255054,120.06551961,122.027025656,132.101905118,132.101905118,133.060768588,134.044784166,147.076418652,147.11280416,148.06043423,150.058325784,156.07675301,166.086255054,175.11895218,182.081169674,205.097154096)
+    up = c(76.0400652550486,90.0558554755493,106.050930044695,116.07176569605,118.087435916551,120.066720265196,122.028245926257,132.103226137051,132.103226137051,133.062099195686,134.046124613842,147.077889416187,147.114275288042,148.061914834342,150.059826367258,156.07831377753,166.087915916551,175.120703369522,182.082990485697,205.099205067541)
+
+    x = merge_precid_4_isobars(orig,msms,up)
+    expect_equal(x,c(1,2,3,4,5,6,7,8,8,10,11,12,13,14,15,16,17,18,19,20))
+})