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

tests/testthat/test-extraction.R

+## TODO: FIXME: the NA case, is this correct behaviour? 
+test_that("Test find_ms1_max behaviour.",{
+    rt = c(1.,1.5,1.7,3.,5.6,7.,7.1,8.,9.5,10.)
+    intensity= c(NA,NA,NA,0.1,0.2,0.3,0.19,0.09,NA,NA)
+    x = find_ms1_max(rt,intensity,0.9,11.)
+
+    expect_equal(x[[1]],7.)
+    expect_equal(x[[2]],0.3)
+
+    rt = c(1.,1.5,1.7,3.,5.6,7.,7.1,8.,9.5,10.)
+    intensity= c(NA,NA,NA,0.1,0.3,0.2,0.3,0.4,0.25,NA)
+    x = find_ms1_max(rt,intensity,c(3.,7.1),c(7.,10.))
+    expect_equal(x[1,1],5.6)
+    expect_equal(x[1,2],8.)
+    expect_equal(x[2,1],0.3)
+    expect_equal(x[2,2],0.4)
+    x = find_ms1_max(rt,intensity,1.,1.7)
+    ## expect_true(is.na(x)) # This, or
+    ## expect_equal(length(x),0L) # ... that?
+
+
+})

tests/testthat/test-integration.R

+test_that("Extraction returns what is needed.",{
+    topd = Sys.getenv("SS_INTEG_TOP_DATA_DIR")
+    projd = Sys.getenv("SS_INTEG_PROJ_DIR")
+    skip_if_not(shiny::isTruthy(topd) && shiny::isTruthy(projd),"Environment variables SS_INTEG_TOP_DATA_DIR and SS_INTEG_PROJ_DIR must be present for this test to work.")
+
+    eo = init(top_data_dir=topd,projects=projd)
+    prdir = file.path(projd,"proj")
+    m = run(envopts=eo,
+                project="proj",
+                phase=c("setup","comptab","db"))
+
+    cat = m$db$cat
+
+    m = run(envopts=eo,m=m,phase="extract")
+    m = run(envopts=eo,m=m,phase="prescreen")
+    saveRDS(m,file.path(projd,"test.rds"))
+    expect_true(1==1)
+})

tests/testthat/test-metfrag.R

@@ -57,42 +57,43 @@ test_that("Do adducts affect MetFrag config generation correctly?",{
     
 })
 
-ok_return_val("metfrag_run",{
-    skip_if_not(file.exists(Sys.getenv("SS_MF_JAR")),"Environment variable SS_MF_JAR does not contain a path to MetFrag jar package.")
-    m = make_dummy_mf_project()
+## TODO: FIXME: Obsoleted.
+## ok_return_val("metfrag_run",{
+##     skip_if_not(file.exists(Sys.getenv("SS_MF_JAR")),"Environment variable SS_MF_JAR does not contain a path to MetFrag jar package.")
+##     m = make_dummy_mf_project()
                 
-    withr::with_dir(m$run$metfrag$path,{
-            stagtab = metfrag_get_stag_tab(m$out$tab$summ[ms2_sel == T])
-
-            ftab = metfrag_run(param = m$run$metfrag$param,
-                               path = m$run$metfrag$path,
-                               subpaths = m$run$metfrag$subpaths,
-                               db_file = m$run$metfrag$db_file,
-                               stag_tab = stagtab, ms2 = m$extr$ms2,
-                               runtime=m$run$metfrag$runtime,
-                               java_bin=m$run$metfrag$java_bin,
-                               nproc = 2)
-
-            expect_snapshot(ftab)
-
-            for (f in ftab[,f_res]) {
-                expect_true(file.exists(file.path(m$run$metfrag$path,
-                                                  m$run$metfrag$subpaths['results'],
-                                                  f)))
-            }
-
-            x = summarise_metfrag_results(param = m$conf$metfrag$param,
-                                          path = m$run$metfrag$path,
-                                          subpaths = m$run$metfrag$subpaths,
-                                          cand_parameters = m$conf$metfrag$cand_parameters,
-                                          db_scores = m$conf$metfrag$database_scores,
-                                          int_scores = m$conf$metfrag$intrinsic_scores,
-                                          collect_candidates= m$conf$metfrag$collect_candidates,
-                                          file_tab = ftab)
+##     withr::with_dir(m$run$metfrag$path,{
+##             stagtab = metfrag_get_stag_tab(m$out$tab$summ[ms2_sel == T])
+
+##             ftab = metfrag_run(param = m$run$metfrag$param,
+##                                path = m$run$metfrag$path,
+##                                subpaths = m$run$metfrag$subpaths,
+##                                db_file = m$run$metfrag$db_file,
+##                                stag_tab = stagtab, ms2 = m$db$extr$cgm$ms2,
+##                                runtime=m$run$metfrag$runtime,
+##                                java_bin=m$run$metfrag$java_bin,
+##                                nproc = 2)
+
+##             expect_snapshot(ftab)
+
+##             for (f in ftab[,f_res]) {
+##                 expect_true(file.exists(file.path(m$run$metfrag$path,
+##                                                   m$run$metfrag$subpaths['results'],
+##                                                   f)))
+##             }
+
+##             x = summarise_metfrag_results(param = m$conf$metfrag$param,
+##                                           path = m$run$metfrag$path,
+##                                           subpaths = m$run$metfrag$subpaths,
+##                                           cand_parameters = m$conf$metfrag$cand_parameters,
+##                                           db_scores = m$conf$metfrag$database_scores,
+##                                           int_scores = m$conf$metfrag$intrinsic_scores,
+##                                           collect_candidates= m$conf$metfrag$collect_candidates,
+##                                           file_tab = ftab)
             
-            expect_snapshot(x)
+##             expect_snapshot(x)
 
 
                                  
-    })
-})
+##     })
+## })

tests/testthat/test-plotting.R

-test_that("make_eic_ms1_plot",{
-
-    ms1 <- PLOTTING_DATA$ms1
-    summ <- PLOTTING_DATA$summ
-    labs <- PLOTTING_DATA$labs
-
-    ## Test the corner case when no cindex entry is selected.
-    kval <- NULL
-    res <- make_eic_ms1_plot(extr_ms1=ms1,
-                             summ=summ,
-                             kval=kval,
-                             labs=labs)
-    expect_identical(res,NULL)
+test_that("narrow_summ",{
+    m = PLOTTING_TEST_STATE
+    ## kvals =  list(set="AAs",ID="5") # 5 is interesting (isobars with 19)
+    kvals = list(set="AAs",ID="4")
+    labs = c("adduct","tag")
+    ns = narrow_summ(db=m$db,m$out$tab$summ,kvals,labs,"mz","ms1_rt","ms1_int","Name","SMILES","qa_ms1_exists","scan","ms2_sel")
+    expect_snapshot(ns)
+})
 
-    ## Test getting the right plot.
-    kval <- list(set="NTs",ID=109L)
-    res <- make_eic_ms1_plot(extr_ms1=ms1,
-                             summ=summ,
-                             kval=kval,
-                             labs=labs)
-    expect_equal(NROW(res$data),4046L)
+test_that("make_eic_ms1_plot",{
+    m = PLOTTING_TEST_STATE
+    kvals = list(set="AAs",ID="4")
+    labs = c("adduct","tag")
+    cd = define_colrdata(m$out$tab$comp,labs)
+    plt = make_eic_ms1_plot(db=m$db,m$out$tab$summ,kvals,labs,colrdata=cd)
+    expect_snapshot(plt$labels)
 })
 
 test_that("make_eic_ms2_plot",{
+    m = PLOTTING_TEST_STATE
+    kvals = list(set="AAs",ID="4")
+    labs = c("adduct","tag")
+    cd = define_colrdata(m$out$tab$comp,labs)
+    plt = make_eic_ms2_plot(db=m$db,m$out$tab$summ,kvals,labs,colrdata=cd)
+    expect_snapshot(plt$labels)
+})
 
-
-    summ <- PLOTTING_DATA$summ
-    labs <- PLOTTING_DATA$labs
-
-    ## Test the corner case when no cindex entry is selected.
-    kval <- NULL
-    res <- make_eic_ms2_plot(summ=summ,
-                             kval=kval,
-                             labs=labs)
-    expect_identical(res,NULL)
-
-    ## Test getting the right plot.
-    kval <- list(set="NTs",ID=109L)
-    res <- make_eic_ms2_plot(summ=summ,
-                             kval=kval,
-                             labs=labs)
-    expect_equal(NROW(res$data),77L)
+test_that("make_spec_ms2_plot",{
+    m = PLOTTING_TEST_STATE
+    kvals = list(set="AAs",ID="4")
+    labs = c("adduct","tag")
+    cd = define_colrdata(m$out$tab$comp,labs)
+    plt = make_spec_ms2_plot(db=m$db,m$out$tab$summ,kvals,labs,colrdata=cd)
+    expect_snapshot(plt$labels)
 })
 
 test_that("plot_fname",{

tests/testthat/test-state.R

+## STATE_DATA is problematic. It is by now outdated and better to be
+## generated, than loaded from some frozen state.
+
 test_that("Test empty project creation.",{
 
     ## Generate test environment and a test project directory.
@@ -10,13 +13,13 @@ test_that("Test empty project creation.",{
     expect_snapshot(res)
 })
 
-test_that("pack_ms2_w_summ",{
-    summ = STATE_DATA$out$tab$summ
-    ms2 = STATE_DATA$extr$ms2
-    res = pack_ms2_w_summ(summ,ms2)
-    expect_snapshot(res[1])
-    expect_snapshot(res[2])
-})
+## test_that("pack_ms2_w_summ",{
+##     summ = STATE_DATA$out$tab$summ
+##     ms2 = STATE_DATA$db$extr$cgm$ms2
+##     res = pack_ms2_w_summ(summ,ms2)
+##     expect_snapshot(res[1])
+##     expect_snapshot(res[2])
+## })
 
 
 test_that("pack_project",{
@@ -33,3 +36,35 @@ test_that("pack_project",{
     })
     expect_snapshot(fls)
 })
+
+test_that("join_compound_lists with empty input returns empty output",{
+    x = join_compound_lists(character(0))
+    expect_true(nrow(x)==0L)
+})
+
+test_that("process_cmpd_sets",{
+
+    ## Test case when no base filename is the same.
+    cmpdl = data.table(ID=1:5,ORIG=c("f1.csv","f1.csv","f2.csv","f3.csv","f3.csv"),set=c(NA_character_,NA_character_,"aks","se31","se32"))
+    x = process_cmpd_sets(cmpdl)
+    expect_snapshot(x)
+
+    ## Test case with similar base filenames.
+    cmpdl = data.table(ID=1:5,ORIG=c("b/f2.csv","a/f1.csv","q/f/g/f2.csv","d/e/f/f3.csv","m/n/q/f3.csv"),set=c(NA_character_,NA_character_,"aks","se31","se32"))
+    x = process_cmpd_sets(cmpdl)
+    expect_snapshot(x)
+
+    ## Test semi-filled cmpd.
+    cmpdl1 = data.table(ID=1:5,ORIG=rep("a/fn.csv",5),set=c(NA_character_,NA_character_,"set","set2",NA_character_))
+    cmpdl2 = data.table(ID=6:9,ORIG=rep("b/fn.csv",4),set=c(NA_character_,"set2","set2",NA_character_))
+    cmpdl = rbindlist(list(cmpdl1,cmpdl2))
+    x = process_cmpd_sets(cmpdl)
+    expect_snapshot(x)
+    
+    ## Empty input.
+    cmpdl = EMPTY_CMPD_LIST
+    x = process_cmpd_sets(cmpdl)
+    expect_snapshot(x)
+
+
+})