From 8fca83312dbcfd501f119d1a936838d2c5f4c538 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <kontrapunkt@uclmail.net>
Date: Fri, 31 Mar 2023 16:03:09 +0200
Subject: [PATCH] data-model: Fix precid/isocoarse merge for isobars.
test-data-model: New test suite for data-model.R
---
R/data-model.R | 50 +++++++++++++++-----------------
tests/testthat/test-data-model.R | 24 +++++++++++++++
2 files changed, 47 insertions(+), 27 deletions(-)
create mode 100644 tests/testthat/test-data-model.R
diff --git a/R/data-model.R b/R/data-model.R
index c53bdf8..b85f2c3 100644
--- a/R/data-model.R
+++ b/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),
diff --git a/tests/testthat/test-data-model.R b/tests/testthat/test-data-model.R
new file mode 100644
index 0000000..c6a9fa8
--- /dev/null
+++ b/tests/testthat/test-data-model.R
@@ -0,0 +1,24 @@
+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))
+})
--
GitLab