tests/testthat/test-collocations.R

test_that("collocationScoreQuery works", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = TRUE)
  df <- collocationScoreQuery(kco, "Ameisenplage", "heimgesucht", leftContextSize = 0, rightContextSize = 1)
  expect_gt(df$logDice, 1)
  expect_equal(df$ll, ll(df$O1, df$O2, df$O, df$N, df$E, df$w))
  expect_equal(df$pmi, pmi(df$O1, df$O2, df$O, df$N, df$E, df$w))
  expect_equal(df$mi2, mi2(df$O1, df$O2, df$O, df$N, df$E, df$w))
  expect_equal(df$mi3, mi3(df$O1, df$O2, df$O, df$N, df$E, df$w))
  expect_equal(df$logDice, logDice(df$O1, df$O2, df$O, df$N, df$E, df$w))
})

test_that("collocationScoreQuery expands collocates and virtual corpora", {
  kco <- methods::new(
    "KorAPConnection",
    apiUrl = "https://example.test/",
    KorAPUrl = "https://example.test/"
  )

  fake_frequency_query <- function(kco, query, vc = "", ...) {
    expand <- length(query) != length(vc)
    combinations <- if (expand) {
      tidyr::expand_grid(query = query, vc = vc)
    } else {
      tibble::tibble(query = query, vc = vc)
    }

    combinations |>
      dplyr::mutate(
        totalResults = 10,
        webUIRequestUrl = paste0("https://example.test/", seq_len(dplyr::n())),
        total = 1000
      )
  }

  testthat::local_mocked_bindings(
    frequencyQuery = fake_frequency_query,
    .package = "RKorAPClient"
  )

  result <- collocationScoreQuery(
    kco,
    node = "node",
    collocate = c("first", "second"),
    vc = c("vc1", "vc2"),
    leftContextSize = 0,
    rightContextSize = 1
  )

  expect_equal(nrow(result), 4)
  expect_equal(result$collocate, c("first", "first", "second", "second"))
  expect_equal(result$vc, c("vc1", "vc2", "vc1", "vc2"))
  expect_true(all(mapply(
    grepl,
    pattern = result$collocate,
    x = result$query,
    MoreArgs = list(fixed = TRUE)
  )))
})

test_that("collocationScoreQuery aligns observed frequencies with collocates", {
  kco <- methods::new(
    "KorAPConnection",
    apiUrl = "https://example.test/",
    KorAPUrl = "https://example.test/"
  )

  fake_frequency_query <- function(kco, query, vc = "", ...) {
    expand <- length(query) != length(vc)
    combinations <- if (expand) {
      tidyr::expand_grid(query = query, vc = vc)
    } else {
      tibble::tibble(query = query, vc = vc)
    }

    combinations |>
      dplyr::mutate(
        totalResults = 10,
        webUIRequestUrl = "https://example.test/",
        total = 1000
      )
  }

  testthat::local_mocked_bindings(
    frequencyQuery = fake_frequency_query,
    .package = "RKorAPClient"
  )

  result <- collocationScoreQuery(
    kco,
    node = "node",
    collocate = c("first", "second"),
    vc = c("vc1", "vc2"),
    observed = c(3, 7),
    smoothingConstant = 0
  )

  expect_equal(result$O, c(3, 3, 7, 7))
})


test_that("collocationAnalysis works and warns about missing token", {
  skip_if_offline()
  kco <- KorAPConnection(
    accessToken = NULL,
    verbose = TRUE
  )
  expect_warning(
    df <-
      collocationAnalysis(
        kco,
        "focus([tt/p=ADJA] {Newstickeritis})",
        leftContextSize = 1,
        rightContextSize = 0,
      ),
    "access token"
  )
  expect_gt(df$O, df$E)
  expect_gt(df$logDice, -1)
})

test_that("collocationAnalysis on unaccounted strings does not error out", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, verbose = TRUE)
  expect_warning(
    df <- collocationAnalysis(kco, "XXXXXXXXAmeisenplage", vc = c("corpusSigle=/WDD17/", "corpusSigle=/WUD17/"), maxRecurse = 2),
    "access token"
  )
  testthat::expect_equal(nrow(df), 0)
})

# test_that("removeWithinSpanWorks", {
#  expect_equal(
#    removeWithinSpan("contains(<base/s=s>, (machen []{0,1} aufmerksam | aufmerksam []{0,1} machen))", "base/s=s"),
#    "(machen []{0,1} aufmerksam | aufmerksam []{0,1} machen)")
# })


test_that("mergeDuplicateCollocatesWorksAsExpected", {
  ldf <- tibble::tibble(
    node = c("focus(in [tt/p=NN] {[tt/l=nehmen]})"),
    collocate = c("Anspruch"),
    label = c(""),
    vc = c(""),
    query = c("Anspruch focus(in [tt/p=NN] {[tt/l=nehmen]})"),
    webUIRequestUrl = c(
      "https://korap.ids-mannheim.de/?q=Anspruch%20focus%28in%20%5btt%2fp%3dNN%5d%20%7b%5btt%2fl%3dnehmen%5d%7d%29&ql=poliqarp"
    ),
    w = c(1),
    leftContextSize = c(1),
    rightContextSize = c(0),
    N = c(23578528381.5),
    O = c(0.5),
    O1 = c(1168410.5),
    O2 = c(1296870.5),
    E = c(64.2651265093014),
    pmi = c(11.9173498777957),
    mi2 = c(29.8406639214616),
    mi3 = c(47.7639779651274),
    logDice = c(11.6899933757298),
    ll = c(3717716.74208791)
  )
  rdf <- tibble::tibble(
    node = c("focus({[tt/l=nehmen] in} [tt/p=NN])"),
    collocate = c("Anspruch"),
    label = c(""),
    vc = c(""),
    query = c("focus({[tt/l=nehmen] in} [tt/p=NN]) Anspruch"),
    webUIRequestUrl = c(
      "https://korap.ids-mannheim.de/?q=focus%28%7b%5btt%2fl%3dnehmen%5d%20in%7d%20%5btt%2fp%3dNN%5d%29%20Anspruch&ql=poliqarp"
    ),
    w = c(1),
    leftContextSize = c(0),
    rightContextSize = c(1),
    N = c(23578528381.5),
    O = c(0.5),
    O1 = c(17077.5),
    O2 = c(1296870.5),
    E = c(0.939299756346416),
    pmi = c(7.99469408391783),
    mi2 = c(15.8990457079122),
    mi3 = c(23.8033973319065),
    logDice = c(2.57887487309409),
    ll = c(2181.35986032019)
  )
  merged <- mergeDuplicateCollocates(ldf, rdf, smoothingConstant = 0.5)
  expect_equal(merged$O, 0.5)
  expect_equal(merged$O1, 1185487.5)
  expect_equal(merged$O2, 1296870.5)
  expect_equal(merged$query, "Anspruch focus(in [tt/p=NN] {[tt/l=nehmen]}) | focus({[tt/l=nehmen] in} [tt/p=NN]) Anspruch")
})

test_that("add_multi_vc_comparisons adds favorite columns", {
  sample_result <- tibble::tibble(
    node = c("n", "n"),
    collocate = c("c", "c"),
    vc = c("vc1", "vc2"),
    label = c("A", "B"),
    N = c(100, 100),
    O = c(10, 20),
    O1 = c(50, 50),
    O2 = c(30, 30),
    E = c(5, 5),
    w = c(2, 2),
    leftContextSize = c(1, 1),
    rightContextSize = c(1, 1),
    frequency = c(10, 20),
    webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
    logDice = c(5, 7),
    pmi = c(2, 3)
  )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)

  expect_true(all(c(
    "winner_logDice",
    "winner_logDice_value",
    "winner_logDice_webUIRequestUrl",
    "winner_webUIRequestUrl",
    "runner_up_logDice",
    "runner_up_logDice_value",
    "loser_logDice_webUIRequestUrl",
    "loser_webUIRequestUrl",
    "max_delta_logDice",
    "winner_rank_logDice",
    "winner_rank_logDice_value",
    "winner_rank_logDice_webUIRequestUrl",
    "runner_up_rank_logDice",
    "runner_up_rank_logDice_value",
    "loser_rank_logDice",
    "loser_rank_logDice_value",
    "loser_rank_logDice_webUIRequestUrl",
    "max_delta_rank_logDice",
    "winner_percentile_rank_logDice",
    "winner_percentile_rank_logDice_value",
    "winner_percentile_rank_logDice_webUIRequestUrl",
    "runner_up_percentile_rank_logDice",
    "runner_up_percentile_rank_logDice_value",
    "loser_percentile_rank_logDice",
    "loser_percentile_rank_logDice_value",
    "loser_percentile_rank_logDice_webUIRequestUrl",
    "max_delta_percentile_rank_logDice",
    "winner_rank_pmi",
    "winner_rank_pmi_value",
    "runner_up_rank_pmi",
    "runner_up_rank_pmi_value",
    "loser_rank_pmi",
    "loser_rank_pmi_value",
    "max_delta_rank_pmi",
    "winner_percentile_rank_pmi",
    "winner_percentile_rank_pmi_value",
    "runner_up_percentile_rank_pmi",
    "runner_up_percentile_rank_pmi_value",
    "loser_percentile_rank_pmi",
    "loser_percentile_rank_pmi_value",
    "max_delta_percentile_rank_pmi",
    "rank_A_logDice",
    "rank_B_logDice",
    "rank_A_pmi",
    "rank_B_pmi",
    "percentile_rank_A_logDice",
    "percentile_rank_B_logDice",
    "percentile_rank_A_pmi",
    "percentile_rank_B_pmi",
    "delta_rank_logDice",
    "delta_rank_pmi",
    "delta_percentile_rank_logDice",
    "delta_percentile_rank_pmi"
  ) %in% colnames(enriched)))

  expect_true(all(enriched$winner_logDice == "B"))
  expect_true(all(enriched$runner_up_logDice == "A"))
  expect_true(all(enriched$winner_logDice_value >= enriched$runner_up_logDice_value))
  expect_true(all(enriched$winner_logDice_webUIRequestUrl == "https://korap.example/B"))
  expect_true(all(enriched$loser_logDice_webUIRequestUrl == "https://korap.example/A"))
  expect_true(all(enriched$winner_webUIRequestUrl == "https://korap.example/B"))
  expect_true(all(enriched$loser_webUIRequestUrl == "https://korap.example/A"))
  expect_true(all(enriched$percentile_rank_A_logDice == 1))
  expect_true(all(enriched$percentile_rank_B_logDice == 1))
  expect_true(all(enriched$delta_percentile_rank_logDice == 0))
})

test_that("add_multi_vc_comparisons fills missing label URLs from vc", {
  sample_result <- tibble::tibble(
    node = c("n", "n", "n"),
    collocate = c("c1", "c2", "c2"),
    vc = c("corpusSigle=/A/", "corpusSigle=/A/", "corpusSigle=/B/"),
    label = c("A", "A", "B"),
    N = c(100, 100, 100),
    O = c(10, 10, 20),
    O1 = c(50, 50, 50),
    O2 = c(30, 30, 30),
    E = c(5, 5, 5),
    w = c(2, 2, 2),
    leftContextSize = c(1, 1, 1),
    rightContextSize = c(1, 1, 1),
    frequency = c(10, 10, 20),
    webUIRequestUrl = c(
      "https://korap.example/?q=q1&cq=corpusSigle%3D%2FA%2F&ql=poliqarp",
      "https://korap.example/?q=q2&cq=corpusSigle%3D%2FA%2F&ql=poliqarp",
      "https://korap.example/?q=q2&cq=corpusSigle%3D%2FB%2F&ql=poliqarp"
    ),
    logDice = c(6, 5, 7),
    pmi = c(3, 2, 4)
  )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
  c1 <- enriched[enriched$collocate == "c1", ]
  expected_b_url <- paste0(
    "https://korap.example/?q=q1&cq=",
    urltools::url_encode("corpusSigle=/B/"),
    "&ql=poliqarp"
  )

  expect_equal(
    unique(c1$loser_logDice_webUIRequestUrl),
    expected_b_url
  )
  expect_equal(
    unique(c1$loser_webUIRequestUrl),
    expected_b_url
  )
})

test_that("add_multi_vc_comparisons flags imputed cells", {
  sample_result <- tibble::tibble(
    node = c("n", "n", "n"),
    collocate = c("c1", "c2", "c2"),
    vc = c("corpusSigle=/A/", "corpusSigle=/A/", "corpusSigle=/B/"),
    label = c("A", "A", "B"),
    N = c(100, 100, 100),
    O = c(10, 10, 20),
    O1 = c(50, 50, 50),
    O2 = c(30, 30, 30),
    E = c(5, 5, 5),
    w = c(2, 2, 2),
    leftContextSize = c(1, 1, 1),
    rightContextSize = c(1, 1, 1),
    frequency = c(10, 10, 20),
    webUIRequestUrl = c(
      "https://korap.example/A1",
      "https://korap.example/A2",
      "https://korap.example/B2"
    ),
    logDice = c(6, 5, 7),
    pmi = c(3, 2, 4)
  )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)

  expect_true(all(c("imputed_A", "imputed_B", "n_imputed", "imputed") %in% colnames(enriched)))

  c1 <- enriched[enriched$collocate == "c1", ]
  c2 <- enriched[enriched$collocate == "c2", ]

  # c1 only occurs in A, so B's scores had to be imputed
  expect_true(all(c1$imputed_B))
  expect_true(all(!c1$imputed_A))
  expect_true(all(c1$imputed))
  expect_true(all(c1$n_imputed == 1L))

  # c2 occurs in both, so nothing is imputed
  expect_true(all(!c2$imputed_A))
  expect_true(all(!c2$imputed_B))
  expect_true(all(!c2$imputed))
  expect_true(all(c2$n_imputed == 0L))

  # c1's delta is measured against the imputed floor rather than against observed data:
  # the absent label loses, at or below the weakest score actually attested anywhere.
  expect_true(all(is.finite(c1$max_delta_logDice)))
  expect_equal(unique(c1$loser_logDice), "B")
  expect_lte(unique(c1$loser_logDice_value), min(sample_result$logDice))
})

test_that("add_multi_vc_comparisons warns about dropped duplicate rows", {
  sample_result <- tibble::tibble(
    node = rep("n", 4),
    collocate = c("c", "c", "c", "c"),
    vc = c("vc1", "vc1", "vc2", "vc2"),
    # the same collocate twice per label, as after collecting several context positions
    label = c("A", "A", "B", "B"),
    N = rep(100, 4),
    O = c(10, 11, 20, 21),
    O1 = rep(50, 4),
    O2 = rep(30, 4),
    E = rep(5, 4),
    w = rep(2, 4),
    leftContextSize = rep(1, 4),
    rightContextSize = rep(1, 4),
    frequency = c(10, 11, 20, 21),
    logDice = c(5, 6, 7, 8),
    pmi = c(2, 2, 3, 3)
  )

  expect_warning(
    enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result),
    "occur more than once"
  )
  expect_warning(
    RKorAPClient:::add_multi_vc_comparisons(sample_result),
    "mergeDuplicateCollocates"
  )
  # the first row of each combination is what ends up in the comparison
  expect_true(all(enriched$logDice_A == 5))
  expect_true(all(enriched$logDice_B == 7))
})

test_that("add_multi_vc_comparisons is silent for unique node/collocate/label rows", {
  sample_result <- tibble::tibble(
    node = rep("n", 4),
    collocate = c("c1", "c1", "c2", "c2"),
    vc = rep(c("vc1", "vc2"), 2),
    label = rep(c("A", "B"), 2),
    N = rep(100, 4),
    O = c(10, 20, 30, 40),
    O1 = rep(50, 4),
    O2 = rep(30, 4),
    E = rep(5, 4),
    w = rep(2, 4),
    leftContextSize = rep(1, 4),
    rightContextSize = rep(1, 4),
    frequency = c(10, 20, 30, 40),
    logDice = c(5, 7, 6, 4),
    pmi = c(2, 3, 4, 1)
  )

  expect_no_warning(RKorAPClient:::add_multi_vc_comparisons(sample_result))
})

test_that("add_multi_vc_comparisons reports imputation when verbose", {
  sample_result <- tibble::tibble(
    node = c("n", "n", "n"),
    collocate = c("c1", "c2", "c2"),
    vc = c("vc1", "vc1", "vc2"),
    label = c("A", "A", "B"),
    N = rep(100, 3),
    O = c(10, 10, 20),
    O1 = rep(50, 3),
    O2 = rep(30, 3),
    E = rep(5, 3),
    w = rep(2, 3),
    leftContextSize = rep(1, 3),
    rightContextSize = rep(1, 3),
    frequency = c(10, 10, 20),
    logDice = c(6, 5, 7),
    pmi = c(3, 2, 4)
  )

  output <- capture.output(
    RKorAPClient:::add_multi_vc_comparisons(sample_result, verbose = TRUE)
  )
  expect_match(paste(output, collapse = " "), "Imputed scores for 1 of 2")
  expect_match(paste(output, collapse = " "), "queryMissingScores")

  # nothing is printed unless verbose
  expect_silent(RKorAPClient:::add_multi_vc_comparisons(sample_result, verbose = FALSE))
})

test_that("add_multi_vc_comparisons reports no imputation when all labels are complete", {
  sample_result <- tibble::tibble(
    node = rep("n", 4),
    collocate = c("c1", "c1", "c2", "c2"),
    vc = rep(c("vc1", "vc2"), 2),
    label = rep(c("A", "B"), 2),
    N = rep(100, 4),
    O = c(10, 20, 30, 40),
    O1 = rep(50, 4),
    O2 = rep(30, 4),
    E = rep(5, 4),
    w = rep(2, 4),
    leftContextSize = rep(1, 4),
    rightContextSize = rep(1, 4),
    frequency = c(10, 20, 30, 40),
    logDice = c(5, 7, 6, 4),
    pmi = c(2, 3, 4, 1)
  )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)

  expect_true(all(!enriched$imputed))
  expect_true(all(enriched$n_imputed == 0L))
})

test_that("add_multi_vc_comparisons handles more than two labels", {
  sample_result <- tibble::tibble(
    node = rep("n", 3),
    collocate = rep("c", 3),
    vc = c("vc1", "vc2", "vc3"),
    label = c("A", "B", "C"),
    N = rep(100, 3),
    O = c(10, 30, 5),
    O1 = rep(50, 3),
    O2 = rep(30, 3),
    E = rep(5, 3),
    w = rep(2, 3),
    leftContextSize = rep(1, 3),
    rightContextSize = rep(1, 3),
    frequency = c(10, 30, 5),
    webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B", "https://korap.example/C"),
    logDice = c(5, 8, 4),
    pmi = c(2, 3, 1)
  )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
  expect_equal(enriched$winner_logDice[1], "B")
  expect_equal(enriched$winner_logDice_value[1], 8)
  expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
  expect_equal(enriched$runner_up_logDice[1], "A")
  expect_equal(enriched$runner_up_logDice_value[1], 5)
  expect_equal(enriched$loser_logDice[1], "C")
  expect_equal(enriched$loser_logDice_value[1], 4)
  expect_equal(enriched$loser_logDice_webUIRequestUrl[1], "https://korap.example/C")
  expect_equal(enriched$max_delta_logDice[1], 4)
})

test_that("add_multi_vc_comparisons leaves unsuffixed URLs ambiguous when scores disagree", {
  sample_result <- tibble::tibble(
    node = c("n", "n"),
    collocate = c("c", "c"),
    vc = c("vc1", "vc2"),
    label = c("A", "B"),
    N = c(100, 100),
    O = c(10, 20),
    O1 = c(50, 50),
    O2 = c(30, 30),
    E = c(5, 5),
    w = c(2, 2),
    leftContextSize = c(1, 1),
    rightContextSize = c(1, 1),
    frequency = c(10, 20),
    webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
    logDice = c(5, 7),
    pmi = c(4, 3)
  )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)

  expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
  expect_equal(enriched$winner_pmi_webUIRequestUrl[1], "https://korap.example/A")
  expect_true(is.na(enriched$winner_webUIRequestUrl[1]))
  expect_true(is.na(enriched$loser_webUIRequestUrl[1]))
})

test_that("add_multi_vc_comparisons computes rank deltas", {
  base_tbl <- tidyr::expand_grid(
    label = c("A", "B", "C"),
    collocate = c("c1", "c2", "c3")
  ) |>
    dplyr::mutate(
      node = "n",
      vc = paste0("vc", label),
      N = 100,
      O = 10,
      O1 = 50,
      O2 = 40,
      E = 5,
      w = 2,
      leftContextSize = 1,
      rightContextSize = 1,
      frequency = 10,
      logDice = dplyr::case_when(
        label == "A" & collocate == "c1" ~ 9,
        label == "A" & collocate == "c2" ~ 6,
        label == "A" & collocate == "c3" ~ 3,
        label == "B" & collocate == "c1" ~ 7,
        label == "B" & collocate == "c2" ~ 9,
        label == "B" & collocate == "c3" ~ 5,
        label == "C" & collocate == "c1" ~ 4,
        label == "C" & collocate == "c2" ~ 6,
        label == "C" & collocate == "c3" ~ 8,
        TRUE ~ 0
      )
    )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(base_tbl)
  target_row <- enriched |>
    dplyr::filter(collocate == "c1") |>
    dplyr::slice_head(n = 1)

  expect_equal(target_row$rank_A_logDice, 1)
  expect_equal(target_row$rank_B_logDice, 2)
  expect_equal(target_row$rank_C_logDice, 3)
  expect_equal(target_row$winner_rank_logDice, "A")
  expect_equal(target_row$winner_rank_logDice_value, 1)
  expect_equal(target_row$runner_up_rank_logDice, "B")
  expect_equal(target_row$runner_up_rank_logDice_value, 2)
  expect_equal(target_row$loser_rank_logDice, "C")
  expect_equal(target_row$loser_rank_logDice_value, 3)
  expect_equal(target_row$max_delta_rank_logDice, 2)
})

test_that("add_multi_vc_comparisons imputes missing ranks for max delta", {
  sample_result <- tibble::tibble(
    node = c("n", "n"),
    collocate = c("c", "c"),
    vc = c("vc1", "vc2"),
    label = c("A", "B"),
    N = c(100, 100),
    O = c(10, 10),
    O1 = c(50, 50),
    O2 = c(30, 30),
    E = c(5, 5),
    w = c(2, 2),
    leftContextSize = c(1, 1),
    rightContextSize = c(1, 1),
    frequency = c(10, 10),
    logDice = c(5, NA)
  )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)

  expect_equal(enriched$rank_A_logDice[1], 1)
  expect_true(is.na(enriched$rank_B_logDice[1]))
  expect_equal(enriched$winner_rank_logDice[1], "A")
  expect_equal(enriched$loser_rank_logDice[1], "B")
  expect_equal(enriched$loser_rank_logDice_value[1], 2)
  expect_equal(enriched$max_delta_rank_logDice[1], 1)
})

test_that("adaptive missing score imputation respects measure-specific scales", {
  sample_result <- tibble::tibble(
    node = c("n", "n", "n"),
    collocate = c("c", "c", "c"),
    vc = c("vc1", "vc2", "vc3"),
    label = c("A", "B", "C"),
    N = c(100, 100, 100),
    O = c(12, 9, 7),
    O1 = c(60, 40, 30),
    O2 = c(33, 22, 18),
    E = c(6, 6, 6),
    w = c(2, 2, 2),
    leftContextSize = c(1, 1, 1),
    rightContextSize = c(1, 1, 1),
    frequency = c(15, 11, 9),
    logDice = c(-0.31, NA, -0.12),
    pmi = c(-1.65, NA, -0.48),
    ll = c(12.4, NA, 7.9)
  )

  enriched <- RKorAPClient:::add_multi_vc_comparisons(
    sample_result,
    missingScoreQuantile = 0.05
  )

  row_a <- dplyr::filter(enriched, label == "A") |> dplyr::slice_head(n = 1)

  expect_false(is.na(row_a$logDice_B))
  expect_false(is.na(row_a$pmi_B))
  expect_false(is.na(row_a$ll_B))

  expect_lt(row_a$logDice_B, min(sample_result$logDice, na.rm = TRUE))
  expect_lt(row_a$pmi_B, min(sample_result$pmi, na.rm = TRUE))
  expect_lte(row_a$ll_B, min(sample_result$ll, na.rm = TRUE))

  expect_gt(row_a$max_delta_logDice, 0)
  expect_gt(row_a$winner_logDice_value - row_a$loser_logDice_value, 0)
})

# New tests for improved coverage of collocationAnalysis.R helper functions

test_that("synsemanticStopwords returns German stopwords", {
  stopwords <- synsemanticStopwords()
  expect_true(is.character(stopwords))
  expect_true(length(stopwords) > 50)
  expect_true("der" %in% stopwords)
  expect_true("die" %in% stopwords)
  expect_true("und" %in% stopwords)
  expect_true("mit" %in% stopwords)
})

test_that("removeWithinSpan removes span constraints correctly", {
  # Test basic span removal
  query1 <- "contains(<base/s=s>, (machen []{0,1} aufmerksam | aufmerksam []{0,1} machen))"
  result1 <- RKorAPClient:::removeWithinSpan(query1, "base/s=s")
  expect_equal(result1, "(machen []{0,1} aufmerksam | aufmerksam []{0,1} machen)")

  # Test with different span
  query2 <- "contains(<p/s=s>, (test query))"
  result2 <- RKorAPClient:::removeWithinSpan(query2, "p/s=s")
  expect_equal(result2, "(test query)")

  # Test with empty span - should return original query
  query3 <- "simple query"
  result3 <- RKorAPClient:::removeWithinSpan(query3, "")
  expect_equal(result3, query3)

  # Test with non-matching span
  query4 <- "contains(<base/s=s>, test)"
  result4 <- RKorAPClient:::removeWithinSpan(query4, "other/span")
  expect_equal(result4, query4)
})

test_that("matches2FreqTable handles empty matches", {
  empty_matches <- data.frame()
  result <- RKorAPClient:::matches2FreqTable(empty_matches, index = 0)

  expect_true(is.data.frame(result))
  expect_equal(nrow(result), 0)
})

test_that("matches2FreqTable processes single match correctly", {
  # Create mock matches data
  mock_matches <- data.frame(
    tokens = I(list(list(
      left = c("der", "große"),
      match = "Test",
      right = c("ist", "wichtig")
    ))),
    stringsAsFactors = FALSE
  )

  result <- RKorAPClient:::matches2FreqTable(
    mock_matches,
    index = 1,
    leftContextSize = 2,
    rightContextSize = 2,
    stopwords = c("der", "ist") # Provide stopwords to avoid empty join
  )

  expect_true(is.data.frame(result))
})

test_that("snippet2FreqTable handles empty snippet", {
  result <- RKorAPClient:::snippet2FreqTable(character(0))

  expect_true(is.data.frame(result))
  expect_equal(nrow(result), 0)
})

test_that("snippet2FreqTable processes single snippet correctly", {
  snippet <- '<span class="context-left">der große </span><span class="match"><mark>Test</mark></span><span class="context-right"> ist wichtig</span>'

  result <- RKorAPClient:::snippet2FreqTable(
    snippet,
    leftContextSize = 2,
    rightContextSize = 2,
    stopwords = c("der"), # Provide stopwords to avoid empty join
    verbose = FALSE
  )

  expect_true(is.data.frame(result))
})

test_that("inject_focus_into_query adds focus wrappers when span queries lack them", {
  unfocused <- "contains(<base/s=s>, (Anspruch [tt/l=nehmen] | [tt/l=nehmen] Anspruch))"
  focused <- RKorAPClient:::inject_focus_into_query(unfocused)

  expect_equal(
    focused,
    "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]}) | focus({[tt/l=nehmen] Anspruch})))"
  )
})

test_that("inject_focus_into_query leaves existing focus segments unchanged", {
  already_focused <- "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]})))"
  expect_identical(
    RKorAPClient:::inject_focus_into_query(already_focused),
    already_focused
  )
})

# Removed hanging findExample tests as they cause infinite wait
# These tests make API calls that don't complete properly

# Removed hanging collocatesQuery tests as they cause infinite wait
# These tests were causing the test suite to hang and not terminate

test_that("collocationAnalysis handles exactFrequencies parameter", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  expect_warning(
    result <- collocationAnalysis(
      kco,
      "Test",
      exactFrequencies = TRUE,
      searchHitsSampleLimit = 5,
      topCollocatesLimit = 5
    ),
    "access token"
  )
  expect_true(is.data.frame(result))
})

test_that("collocationAnalysis handles withinSpan parameter", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  expect_warning(
    result <- collocationAnalysis(
      kco,
      "Test",
      withinSpan = "base/s=s",
      exactFrequencies = TRUE,
      searchHitsSampleLimit = 5,
      topCollocatesLimit = 5
    ),
    "access token"
  )
  expect_true(is.data.frame(result))
})

test_that("collocationAnalysis handles expand parameter", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  expect_warning(
    result <- collocationAnalysis(
      kco,
      c("Test", "der"),
      expand = TRUE,
      searchHitsSampleLimit = 2,
      topCollocatesLimit = 2
    ),
    "access token"
  )
  expect_true(is.data.frame(result))
})

test_that("collocationAnalysis honors named vc labels", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  named_vc <- c(
    Western = "textType=/.*Western.*/ & pubDate in 2012",
    Erotic = "textType=/.*(Erotik|Gay).*/ & pubDate in 2012",
    Historic = "textType=/.*Historisch.*/ & pubDate in 2012"
  )

  expect_warning(
    result <- collocationAnalysis(
      kco,
      "[tt/l=treffen]",
      vc = named_vc,
      searchHitsSampleLimit = 2,
      topCollocatesLimit = 2
    ),
    "access token"
  )

  if (nrow(result) > 0) {
    expect_true("label" %in% colnames(result))
    expect_setequal(unique(result$label), names(named_vc))
  }
})

test_that("collocationAnalysis handles stopwords parameter", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  expect_warning(
    result <- collocationAnalysis(
      kco,
      "Test",
      stopwords = c("der", "die", "und"),
      searchHitsSampleLimit = 5,
      topCollocatesLimit = 5
    ),
    "access token"
  )
  expect_true(is.data.frame(result))
})

test_that("collocationAnalysis handles lemmatizeNodeQuery parameter", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  expect_warning(
    result <- collocationAnalysis(
      kco,
      "laufen",
      lemmatizeNodeQuery = TRUE,
      searchHitsSampleLimit = 5,
      topCollocatesLimit = 5
    ),
    "access token"
  )
  expect_true(is.data.frame(result))
})

test_that("collocationAnalysis handles addExamples parameter", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  expect_warning(
    result <- collocationAnalysis(
      kco,
      "Test",
      addExamples = TRUE,
      searchHitsSampleLimit = 3,
      topCollocatesLimit = 3
    ),
    "access token"
  )
  expect_true(is.data.frame(result))
  if (nrow(result) > 0) {
    expect_true("example" %in% colnames(result))
  }
})

test_that("collocationAnalysis handles maxRecurse parameter", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  expect_warning(
    result <- collocationAnalysis(
      kco,
      "Test",
      maxRecurse = 1,
      searchHitsSampleLimit = 2,
      topCollocatesLimit = 2
    ),
    "access token"
  )
  expect_true(is.data.frame(result))
})

test_that("collocationAnalysis returns cached result without contacting the server", {
  kco <- methods::new(
    "KorAPConnection",
    apiUrl = "https://example.invalid/",
    KorAPUrl = "https://example.invalid/",
    authorizationSupported = FALSE,
    verbose = FALSE
  )

  cache_file <- tempfile(fileext = ".rds")
  on.exit(unlink(cache_file), add = TRUE)

  # written by the package itself, so that it carries the record saying what
  # produced it - a file without one is refused, as one from an older version
  cached <- local({
    testthat::local_mocked_bindings(
      collocatesQuery = function(...) tibble::tibble(),
      .package = "RKorAPClient"
    )
    collocationAnalysis(kco, "n", cacheAs = cache_file)
  })

  testthat::local_mocked_bindings(
    corpusQuery = function(...) stop("server must not be contacted"),
    collocatesQuery = function(...) stop("server must not be contacted"),
    .package = "RKorAPClient"
  )

  expect_equal(
    collocationAnalysis(kco, "n", cacheAs = cache_file),
    cached
  )
})

test_that("collocationAnalysis appends the .rds extension to cacheAs", {
  kco <- methods::new(
    "KorAPConnection",
    apiUrl = "https://example.invalid/",
    KorAPUrl = "https://example.invalid/",
    verbose = FALSE
  )

  base_path <- tempfile()
  on.exit(unlink(paste0(base_path, ".rds")), add = TRUE)

  # given without extension, .rds is appended when writing
  cached <- local({
    testthat::local_mocked_bindings(
      collocatesQuery = function(...) tibble::tibble(),
      .package = "RKorAPClient"
    )
    collocationAnalysis(kco, "n", cacheAs = base_path)
  })
  expect_true(file.exists(paste0(base_path, ".rds")))

  testthat::local_mocked_bindings(
    corpusQuery = function(...) stop("server must not be contacted"),
    collocatesQuery = function(...) stop("server must not be contacted"),
    .package = "RKorAPClient"
  )

  # and the same file is found again, given with or without the extension
  expect_equal(collocationAnalysis(kco, "n", cacheAs = base_path), cached)
  expect_equal(collocationAnalysis(kco, "n", cacheAs = paste0(base_path, ".rds")), cached)
})

test_that("collocationAnalysis writes and reuses its cache file", {
  skip_if_offline()
  kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)

  cache_file <- tempfile(fileext = ".rds")
  on.exit(unlink(cache_file), add = TRUE)
  expect_false(file.exists(cache_file))

  expect_warning(
    first <- collocationAnalysis(
      kco,
      "Ameisenplage",
      searchHitsSampleLimit = 2,
      topCollocatesLimit = 2,
      cacheAs = cache_file
    ),
    "access token"
  )

  expect_true(file.exists(cache_file))
  # the file records the analysis parameters, the returned value does not
  cached <- readRDS(cache_file)
  expect_false(is.null(attr(cached, RKorAPClient:::cacheAsAttribute)))
  attr(cached, RKorAPClient:::cacheAsAttribute) <- NULL
  expect_equal(cached, first)

  # the second call is served from the cache and therefore issues no token warning
  second <- collocationAnalysis(
    kco,
    "Ameisenplage",
    searchHitsSampleLimit = 2,
    topCollocatesLimit = 2,
    cacheAs = cache_file
  )
  expect_equal(second, first)
})