tests/testthat/test-check.R

In RGLab/cytoqc: Quality control and standardization of cytometry data

context("cqc_check")
path <- "~/remote/fh/fast/gottardo_r/mike_working/lyoplate_out/parsed"

skip_if_not(dir.exists(path))

centers <- c('BIIR','CIMR','Miami','NHLBI','Stanford','UCLA','Yale')

##load gs
panel <- "tcell"
test_results <- test_results_all[[panel]]
# test_results <- list()
gslist <- sapply(centers, function(center) {
  # message("Center: ", center)
  gs <- load_gs(file.path(path, center, panel), select = 1)
})

cqc_data <- list()
test_that("cqc_gs_list", {
  cqc_data <<- cqc_gs_list(gslist)
  names(cqc_data) <<- centers#fix the guid of gs between runs to avoid the random ids generated by boost::uuids::random_generator(), which isn't controled by R set.seed
  expect_is(cqc_data, "cqc_gs_list")
})

test_that("cf_get_panel", {
  cf <- get_cytoframe_from_cs(cqc_data[[1]], 1)
  tbl <- cf_get_panel(cf)
  expect_equal(colnames(tbl), c("channel", "marker"))
  expect_equal(as.vector(tbl[["channel"]]), colnames(cf))
  expect_equal(as.vector(tbl[["marker"]]),as.vector(pData(parameters(cf))[["desc"]]))

})


test_that("keywords insertion", {
  test_results_keys <- test_results[["keywords"]]
  check_res <- cqc_check_keyword(cqc_data)
  expect_is(check_res, "cqc_check_keyword")

  expect_equivalent(check_res, test_results_keys[["check"]][["result"]])

  match_result <- cqc_match(check_res, ref = 3)
  expect_equivalent(match_result, test_results_keys[["match"]][["result"]])
  expect_equal(match_result_color_tbl(match_result), test_results_keys[["match"]][["match_result_color_tbl"]])

  match_result <- cqc_match_delete_unmatched(match_result, c("EXPORT_GATE","PARENT_GUID"))
  expect_equivalent(match_result, test_results_keys[["match"]][["result1"]])

  cqc_fix(match_result)
  expect_equivalent(cqc_check(cqc_data, "keyword"), test_results_keys[["check"]][["fixed_result"]])

})
test_that("cqc_check_gate", {
  test_results_gate <- test_results[["gate"]]

  groups <- cqc_check(cqc_data, "gate")
  expect_is(groups, "cqc_check_gate")
  expect_equivalent(groups, test_results_gate[["check"]][["result"]])
  expect_equivalent(summary(groups), test_results_gate[["check"]][["summary"]])
  expect_equivalent(diff(groups), test_results_gate[["check"]][["diff"]])

  expect_error(cqc_match(cqc_data, ref = 1), "not a valid")
  match_result <- cqc_match(groups, ref = 1)
  expect_equivalent(match_result, test_results_gate[["match"]][["result"]])#strange that this test fail at package check (but succeed in console)
  expect_equal(match_result_color_tbl(match_result), test_results_gate[["match"]][["match_result_color_tbl"]])

  expect_error(cqc_fix(groups), "not a valid")
  cqc_fix(match_result)
  expect_equivalent(cqc_check(cqc_data, "gate"), test_results_gate[["check"]][["fixed_result"]])

})

test_that("cqc_check_marker", {
  test_results_marker <- test_results[["marker"]]

  groups <- cqc_check(cqc_data, "marker")
  expect_equivalent(groups, test_results_marker[["check"]][["result"]])

  match_result <- cqc_match(groups, ref = 3)
  expect_equivalent(match_result, test_results_marker[["match"]][["result"]])
  expect_equal(format(match_result), test_results_marker[["match"]][["format"]])
  expect_equal(match_result_color_tbl(match_result), test_results_marker[["match"]][["match_result_color_tbl"]])

  expect_error(
    cqc_match_update(match_result,  map = c("AA" = "CCR7"))
    , "not found")
  #attempt to change exact match
  expect_error(
    cqc_match_update(match_result,  map = c("CD3" = "CCR7"))
    , "are reference")
  #attempt to create match for the value that already has matched ref
  expect_error(
    expect_output(cqc_match_update(match_result,  map = c("HLADR" = "CCR7")))
    , "Found the existing match")
  #attempt to match to the ref that has been already used
  expect_error(
    expect_output(cqc_match_update(match_result,  map = c("CD197" = "LIVE")))
    , "Found the existing match")
  #attempt to match to the ref that has already have exact match
  expect_error(
    cqc_match_update(match_result,  map = c("CD197" = "CD3"))
    , "already perfectly matched")
  #attempt to use in valid ref
  expect_error(
    cqc_match_update(match_result,  map = c("CD197" = "AA"))
    , "not valid reference")
  match_result <- cqc_match_update(match_result,  map = c("CD197" = "CCR7"))
  expect_equivalent(match_result, test_results_marker[["match"]][["result_update"]])

  match_result <- cqc_match_remove(match_result,  map = c("CD197"))
  expect_equivalent(match_result, test_results_marker[["match"]][["result"]])
  expect_error(match_result <- cqc_match_remove(match_result,  map = c("CD197")), "No existing")
  expect_equivalent(match_result, test_results_marker[["match"]][["result"]])


  match_result <- cqc_match_update(match_result,  map = c("CD197" = "CCR7"))
  cqc_fix(match_result)
  expect_equivalent(cqc_check(cqc_data, "marker"), test_results_marker[["check"]][["fixed_result"]])

})

test_that("cqc_check_panel", {
  test_results_panel <- test_results[["panel"]]

  groups <- cqc_check(cqc_data, "panel")
  expect_equivalent(groups, test_results_panel[["check"]][["result"]])
  expres <- test_results_panel[["check"]][["format"]]
  expect_error(match_res <- cqc_match(groups, ref = 1), "not consistent")

  groups <- cqc_check(cqc_data, "panel", by = "marker")

  expect_equal(format(groups), test_results_panel[["check"]][["format_by_marker"]])
  match_res <- cqc_match(groups, ref = 1)
  cqc_fix(match_res)
  groups <- cqc_check(cqc_data, "panel")

  # Panel check still shows non-overlapping scatter channels (handled in next test block)
  expect_equivalent(groups, test_results_panel[["check"]][["fixed_result"]])
  groups <- cqc_check(cqc_data, "channel")
  expect_equivalent(groups, test_results_panel[["check"]][["post_panel_fix"]])
  match_res <- cqc_match(groups, ref = 4)
  expect_equivalent(match_res, test_results_panel[["check"]][["post_panel_channel_match"]])

})

test_that("cqc_check_channel", {
  test_results_channel <- test_results[["channel"]]

  groups <- cqc_check(cqc_data, "channel")
  expect_equivalent(groups, test_results_channel[["check"]][["result"]])

  match_result <- cqc_match(groups, ref = 4)
  expect_equivalent(match_result, test_results_channel[["match"]][["result"]])
  expect_equal(format(match_result), test_results_channel[["match"]][["format"]])
  expect_equal(match_result_color_tbl(match_result), test_results_channel[["match"]][["match_result_color_tbl"]])

  cqc_fix(match_result)
  expect_equivalent(cqc_check(cqc_data, "channel"), test_results_channel[["check"]][["fixed_result"]])

})

test_that("missing_markers", {

  skip_if_not(require(flowWorkspaceData))

  test_results_missing <- test_results[["missing_markers"]]

  # Construct case with missing markers to be filled in by panel check aligned on channels
  cs <- load_cytoset_from_fcs(list.files(system.file("extdata", package = "flowWorkspaceData"), pattern = "a2004", full.names = TRUE))
  drop_cols <- which(grepl("-A", colnames(cs)))
  cs <- realize_view(cs[,-drop_cols])
  empty_markers <- rep("",8)
  names(empty_markers) <- colnames(cs)[5:12]
  markernames(cs[[2]]) <- empty_markers
  cqc_data <- cqc_cf_list(cytoset_to_list(cs))

  # Test error message for case where no samples have values to match up
  # This could happen if the user chooses the wrong ref in the example below
  expect_error(cqc_check(cqc_cf_list(cytoset_to_list(cs[2])), type = "panel", by = "channel"), "No markers available for panel check")

  # Check should show 2 groups due to missing markers
  check_res <- cqc_check(cqc_data, type = "panel", by = "channel")
  expect_equivalent(check_res, test_results_missing[["pre_check"]])

  # Match to the sample with channels present and apply fix
  match_res <- cqc_match(check_res, ref = 1)
  expect_equivalent(match_res, test_results_missing[["match"]])

  cqc_fix(match_res)

  check_res <- cqc_check(cqc_data, type = "panel", by = "channel")
  expect_equivalent(check_res, test_results_missing[["post_fix_check"]])
})