blob: 183de993f70c5ad1dbe55e3c9c282c122902a5fa [file] [log] [blame]
Marc Kupietzdbd431a2021-08-29 12:17:45 +02001test_that("collocationScoreQuery works", {
Marc Kupietz83d0af32022-02-24 12:49:28 +01002 skip_if_offline()
Marc Kupietz617266d2025-02-27 10:43:07 +01003 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = TRUE)
Marc Kupietz7de5f322025-06-04 17:17:22 +02004 df <- collocationScoreQuery(kco, "Ameisenplage", "heimgesucht", leftContextSize = 0, rightContextSize = 1)
Marc Kupietzdbd431a2021-08-29 12:17:45 +02005 expect_gt(df$logDice, 1)
6 expect_equal(df$ll, ll(df$O1, df$O2, df$O, df$N, df$E, df$w))
7 expect_equal(df$pmi, pmi(df$O1, df$O2, df$O, df$N, df$E, df$w))
8 expect_equal(df$mi2, mi2(df$O1, df$O2, df$O, df$N, df$E, df$w))
9 expect_equal(df$mi3, mi3(df$O1, df$O2, df$O, df$N, df$E, df$w))
10 expect_equal(df$logDice, logDice(df$O1, df$O2, df$O, df$N, df$E, df$w))
11})
12
Marc Kupietz9c53e412026-06-21 12:13:44 +020013test_that("collocationScoreQuery expands collocates and virtual corpora", {
14 kco <- methods::new(
15 "KorAPConnection",
16 apiUrl = "https://example.test/",
17 KorAPUrl = "https://example.test/"
18 )
19
20 fake_frequency_query <- function(kco, query, vc = "", ...) {
21 expand <- length(query) != length(vc)
22 combinations <- if (expand) {
23 tidyr::expand_grid(query = query, vc = vc)
24 } else {
25 tibble::tibble(query = query, vc = vc)
26 }
27
28 combinations |>
29 dplyr::mutate(
30 totalResults = 10,
31 webUIRequestUrl = paste0("https://example.test/", seq_len(dplyr::n())),
32 total = 1000
33 )
34 }
35
36 testthat::local_mocked_bindings(
37 frequencyQuery = fake_frequency_query,
38 .package = "RKorAPClient"
39 )
40
41 result <- collocationScoreQuery(
42 kco,
43 node = "node",
44 collocate = c("first", "second"),
45 vc = c("vc1", "vc2"),
46 leftContextSize = 0,
47 rightContextSize = 1
48 )
49
50 expect_equal(nrow(result), 4)
51 expect_equal(result$collocate, c("first", "first", "second", "second"))
52 expect_equal(result$vc, c("vc1", "vc2", "vc1", "vc2"))
53 expect_true(all(mapply(
54 grepl,
55 pattern = result$collocate,
56 x = result$query,
57 MoreArgs = list(fixed = TRUE)
58 )))
59})
60
61test_that("collocationScoreQuery aligns observed frequencies with collocates", {
62 kco <- methods::new(
63 "KorAPConnection",
64 apiUrl = "https://example.test/",
65 KorAPUrl = "https://example.test/"
66 )
67
68 fake_frequency_query <- function(kco, query, vc = "", ...) {
69 expand <- length(query) != length(vc)
70 combinations <- if (expand) {
71 tidyr::expand_grid(query = query, vc = vc)
72 } else {
73 tibble::tibble(query = query, vc = vc)
74 }
75
76 combinations |>
77 dplyr::mutate(
78 totalResults = 10,
79 webUIRequestUrl = "https://example.test/",
80 total = 1000
81 )
82 }
83
84 testthat::local_mocked_bindings(
85 frequencyQuery = fake_frequency_query,
86 .package = "RKorAPClient"
87 )
88
89 result <- collocationScoreQuery(
90 kco,
91 node = "node",
92 collocate = c("first", "second"),
93 vc = c("vc1", "vc2"),
94 observed = c(3, 7),
95 smoothingConstant = 0
96 )
97
98 expect_equal(result$O, c(3, 3, 7, 7))
99})
100
Marc Kupietz581a29b2021-09-04 20:51:04 +0200101
102test_that("collocationAnalysis works and warns about missing token", {
Marc Kupietz83d0af32022-02-24 12:49:28 +0100103 skip_if_offline()
Marc Kupietz617266d2025-02-27 10:43:07 +0100104 kco <- KorAPConnection(
Marc Kupietz7de5f322025-06-04 17:17:22 +0200105 accessToken = NULL,
106 verbose = TRUE
107 )
108 expect_warning(
109 df <-
110 collocationAnalysis(
111 kco,
112 "focus([tt/p=ADJA] {Newstickeritis})",
113 leftContextSize = 1,
114 rightContextSize = 0,
115 ),
116 "access token"
117 )
Marc Kupietzdbd431a2021-08-29 12:17:45 +0200118 expect_gt(df$O, df$E)
Marc Kupietzf9129592025-01-26 19:17:54 +0100119 expect_gt(df$logDice, -1)
Marc Kupietzdbd431a2021-08-29 12:17:45 +0200120})
121
122test_that("collocationAnalysis on unaccounted strings does not error out", {
Marc Kupietz83d0af32022-02-24 12:49:28 +0100123 skip_if_offline()
Marc Kupietz617266d2025-02-27 10:43:07 +0100124 kco <- KorAPConnection(accessToken = NULL, verbose = TRUE)
Marc Kupietz581a29b2021-09-04 20:51:04 +0200125 expect_warning(
Marc Kupietz7de5f322025-06-04 17:17:22 +0200126 df <- collocationAnalysis(kco, "XXXXXXXXAmeisenplage", vc = c("corpusSigle=/WDD17/", "corpusSigle=/WUD17/"), maxRecurse = 2),
Marc Kupietz581a29b2021-09-04 20:51:04 +0200127 "access token"
128 )
Marc Kupietzdbd431a2021-08-29 12:17:45 +0200129 testthat::expect_equal(nrow(df), 0)
130})
Marc Kupietzd6314b62021-12-22 12:49:09 +0100131
Marc Kupietz7de5f322025-06-04 17:17:22 +0200132# test_that("removeWithinSpanWorks", {
Marc Kupietz76dee312025-04-06 16:24:47 +0200133# expect_equal(
134# removeWithinSpan("contains(<base/s=s>, (machen []{0,1} aufmerksam | aufmerksam []{0,1} machen))", "base/s=s"),
135# "(machen []{0,1} aufmerksam | aufmerksam []{0,1} machen)")
Marc Kupietz7de5f322025-06-04 17:17:22 +0200136# })
Marc Kupietzdbdbb1f2025-02-19 10:33:06 +0100137
138
139test_that("mergeDuplicateCollocatesWorksAsExpected", {
Marc Kupietz5057f502025-04-06 16:55:57 +0200140 ldf <- tibble::tibble(
Marc Kupietzdbdbb1f2025-02-19 10:33:06 +0100141 node = c("focus(in [tt/p=NN] {[tt/l=nehmen]})"),
142 collocate = c("Anspruch"),
143 label = c(""),
144 vc = c(""),
145 query = c("Anspruch focus(in [tt/p=NN] {[tt/l=nehmen]})"),
146 webUIRequestUrl = c(
147 "https://korap.ids-mannheim.de/?q=Anspruch%20focus%28in%20%5btt%2fp%3dNN%5d%20%7b%5btt%2fl%3dnehmen%5d%7d%29&ql=poliqarp"
148 ),
149 w = c(1),
150 leftContextSize = c(1),
151 rightContextSize = c(0),
152 N = c(23578528381.5),
153 O = c(0.5),
154 O1 = c(1168410.5),
155 O2 = c(1296870.5),
156 E = c(64.2651265093014),
157 pmi = c(11.9173498777957),
158 mi2 = c(29.8406639214616),
159 mi3 = c(47.7639779651274),
160 logDice = c(11.6899933757298),
161 ll = c(3717716.74208791)
162 )
Marc Kupietz5057f502025-04-06 16:55:57 +0200163 rdf <- tibble::tibble(
Marc Kupietzdbdbb1f2025-02-19 10:33:06 +0100164 node = c("focus({[tt/l=nehmen] in} [tt/p=NN])"),
165 collocate = c("Anspruch"),
166 label = c(""),
167 vc = c(""),
168 query = c("focus({[tt/l=nehmen] in} [tt/p=NN]) Anspruch"),
169 webUIRequestUrl = c(
170 "https://korap.ids-mannheim.de/?q=focus%28%7b%5btt%2fl%3dnehmen%5d%20in%7d%20%5btt%2fp%3dNN%5d%29%20Anspruch&ql=poliqarp"
171 ),
172 w = c(1),
173 leftContextSize = c(0),
174 rightContextSize = c(1),
175 N = c(23578528381.5),
176 O = c(0.5),
177 O1 = c(17077.5),
178 O2 = c(1296870.5),
179 E = c(0.939299756346416),
180 pmi = c(7.99469408391783),
181 mi2 = c(15.8990457079122),
182 mi3 = c(23.8033973319065),
183 logDice = c(2.57887487309409),
184 ll = c(2181.35986032019)
185 )
186 merged <- mergeDuplicateCollocates(ldf, rdf, smoothingConstant = 0.5)
187 expect_equal(merged$O, 0.5)
188 expect_equal(merged$O1, 1185487.5)
189 expect_equal(merged$O2, 1296870.5)
190 expect_equal(merged$query, "Anspruch focus(in [tt/p=NN] {[tt/l=nehmen]}) | focus({[tt/l=nehmen] in} [tt/p=NN]) Anspruch")
191})
Marc Kupietz7de5f322025-06-04 17:17:22 +0200192
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200193test_that("add_multi_vc_comparisons adds favorite columns", {
194 sample_result <- tibble::tibble(
195 node = c("n", "n"),
196 collocate = c("c", "c"),
197 vc = c("vc1", "vc2"),
198 label = c("A", "B"),
199 N = c(100, 100),
200 O = c(10, 20),
201 O1 = c(50, 50),
202 O2 = c(30, 30),
203 E = c(5, 5),
204 w = c(2, 2),
205 leftContextSize = c(1, 1),
206 rightContextSize = c(1, 1),
207 frequency = c(10, 20),
Marc Kupietz09b1c082026-05-01 14:45:47 +0200208 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200209 logDice = c(5, 7),
210 pmi = c(2, 3)
211 )
212
Marc Kupietz77852b22025-10-19 11:35:34 +0200213 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200214
215 expect_true(all(c(
216 "winner_logDice",
217 "winner_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200218 "winner_logDice_webUIRequestUrl",
219 "winner_webUIRequestUrl",
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200220 "runner_up_logDice",
Marc Kupietz28a29842025-10-18 12:25:09 +0200221 "runner_up_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200222 "loser_logDice_webUIRequestUrl",
223 "loser_webUIRequestUrl",
Marc Kupietz28a29842025-10-18 12:25:09 +0200224 "max_delta_logDice",
225 "winner_rank_logDice",
226 "winner_rank_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200227 "winner_rank_logDice_webUIRequestUrl",
Marc Kupietz28a29842025-10-18 12:25:09 +0200228 "runner_up_rank_logDice",
229 "runner_up_rank_logDice_value",
230 "loser_rank_logDice",
231 "loser_rank_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200232 "loser_rank_logDice_webUIRequestUrl",
Marc Kupietz28a29842025-10-18 12:25:09 +0200233 "max_delta_rank_logDice",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200234 "winner_percentile_rank_logDice",
235 "winner_percentile_rank_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200236 "winner_percentile_rank_logDice_webUIRequestUrl",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200237 "runner_up_percentile_rank_logDice",
238 "runner_up_percentile_rank_logDice_value",
239 "loser_percentile_rank_logDice",
240 "loser_percentile_rank_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200241 "loser_percentile_rank_logDice_webUIRequestUrl",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200242 "max_delta_percentile_rank_logDice",
Marc Kupietz28a29842025-10-18 12:25:09 +0200243 "winner_rank_pmi",
244 "winner_rank_pmi_value",
245 "runner_up_rank_pmi",
246 "runner_up_rank_pmi_value",
247 "loser_rank_pmi",
248 "loser_rank_pmi_value",
249 "max_delta_rank_pmi",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200250 "winner_percentile_rank_pmi",
251 "winner_percentile_rank_pmi_value",
252 "runner_up_percentile_rank_pmi",
253 "runner_up_percentile_rank_pmi_value",
254 "loser_percentile_rank_pmi",
255 "loser_percentile_rank_pmi_value",
256 "max_delta_percentile_rank_pmi",
Marc Kupietz28a29842025-10-18 12:25:09 +0200257 "rank_A_logDice",
258 "rank_B_logDice",
259 "rank_A_pmi",
260 "rank_B_pmi",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200261 "percentile_rank_A_logDice",
262 "percentile_rank_B_logDice",
263 "percentile_rank_A_pmi",
264 "percentile_rank_B_pmi",
Marc Kupietz28a29842025-10-18 12:25:09 +0200265 "delta_rank_logDice",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200266 "delta_rank_pmi",
267 "delta_percentile_rank_logDice",
268 "delta_percentile_rank_pmi"
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200269 ) %in% colnames(enriched)))
270
271 expect_true(all(enriched$winner_logDice == "B"))
272 expect_true(all(enriched$runner_up_logDice == "A"))
273 expect_true(all(enriched$winner_logDice_value >= enriched$runner_up_logDice_value))
Marc Kupietz09b1c082026-05-01 14:45:47 +0200274 expect_true(all(enriched$winner_logDice_webUIRequestUrl == "https://korap.example/B"))
275 expect_true(all(enriched$loser_logDice_webUIRequestUrl == "https://korap.example/A"))
276 expect_true(all(enriched$winner_webUIRequestUrl == "https://korap.example/B"))
277 expect_true(all(enriched$loser_webUIRequestUrl == "https://korap.example/A"))
Marc Kupietz130a2a22025-10-18 16:09:23 +0200278 expect_true(all(enriched$percentile_rank_A_logDice == 1))
279 expect_true(all(enriched$percentile_rank_B_logDice == 1))
280 expect_true(all(enriched$delta_percentile_rank_logDice == 0))
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200281})
282
Marc Kupietz09b1c082026-05-01 14:45:47 +0200283test_that("add_multi_vc_comparisons fills missing label URLs from vc", {
284 sample_result <- tibble::tibble(
285 node = c("n", "n", "n"),
286 collocate = c("c1", "c2", "c2"),
287 vc = c("corpusSigle=/A/", "corpusSigle=/A/", "corpusSigle=/B/"),
288 label = c("A", "A", "B"),
289 N = c(100, 100, 100),
290 O = c(10, 10, 20),
291 O1 = c(50, 50, 50),
292 O2 = c(30, 30, 30),
293 E = c(5, 5, 5),
294 w = c(2, 2, 2),
295 leftContextSize = c(1, 1, 1),
296 rightContextSize = c(1, 1, 1),
297 frequency = c(10, 10, 20),
298 webUIRequestUrl = c(
299 "https://korap.example/?q=q1&cq=corpusSigle%3D%2FA%2F&ql=poliqarp",
300 "https://korap.example/?q=q2&cq=corpusSigle%3D%2FA%2F&ql=poliqarp",
301 "https://korap.example/?q=q2&cq=corpusSigle%3D%2FB%2F&ql=poliqarp"
302 ),
303 logDice = c(6, 5, 7),
304 pmi = c(3, 2, 4)
305 )
306
307 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
308 c1 <- enriched[enriched$collocate == "c1", ]
309 expected_b_url <- paste0(
310 "https://korap.example/?q=q1&cq=",
311 urltools::url_encode("corpusSigle=/B/"),
312 "&ql=poliqarp"
313 )
314
315 expect_equal(
316 unique(c1$loser_logDice_webUIRequestUrl),
317 expected_b_url
318 )
319 expect_equal(
320 unique(c1$loser_webUIRequestUrl),
321 expected_b_url
322 )
323})
324
Marc Kupietzd7bb5cb2026-08-31 10:18:02 +0200325test_that("add_multi_vc_comparisons flags imputed cells", {
326 sample_result <- tibble::tibble(
327 node = c("n", "n", "n"),
328 collocate = c("c1", "c2", "c2"),
329 vc = c("corpusSigle=/A/", "corpusSigle=/A/", "corpusSigle=/B/"),
330 label = c("A", "A", "B"),
331 N = c(100, 100, 100),
332 O = c(10, 10, 20),
333 O1 = c(50, 50, 50),
334 O2 = c(30, 30, 30),
335 E = c(5, 5, 5),
336 w = c(2, 2, 2),
337 leftContextSize = c(1, 1, 1),
338 rightContextSize = c(1, 1, 1),
339 frequency = c(10, 10, 20),
340 webUIRequestUrl = c(
341 "https://korap.example/A1",
342 "https://korap.example/A2",
343 "https://korap.example/B2"
344 ),
345 logDice = c(6, 5, 7),
346 pmi = c(3, 2, 4)
347 )
348
349 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
350
351 expect_true(all(c("imputed_A", "imputed_B", "n_imputed", "imputed") %in% colnames(enriched)))
352
353 c1 <- enriched[enriched$collocate == "c1", ]
354 c2 <- enriched[enriched$collocate == "c2", ]
355
356 # c1 only occurs in A, so B's scores had to be imputed
357 expect_true(all(c1$imputed_B))
358 expect_true(all(!c1$imputed_A))
359 expect_true(all(c1$imputed))
360 expect_true(all(c1$n_imputed == 1L))
361
362 # c2 occurs in both, so nothing is imputed
363 expect_true(all(!c2$imputed_A))
364 expect_true(all(!c2$imputed_B))
365 expect_true(all(!c2$imputed))
366 expect_true(all(c2$n_imputed == 0L))
367
368 # c1's delta is measured against the imputed floor rather than against observed data:
369 # the absent label loses, at or below the weakest score actually attested anywhere.
370 expect_true(all(is.finite(c1$max_delta_logDice)))
371 expect_equal(unique(c1$loser_logDice), "B")
372 expect_lte(unique(c1$loser_logDice_value), min(sample_result$logDice))
373})
374
375test_that("add_multi_vc_comparisons reports no imputation when all labels are complete", {
376 sample_result <- tibble::tibble(
377 node = rep("n", 4),
378 collocate = c("c1", "c1", "c2", "c2"),
379 vc = rep(c("vc1", "vc2"), 2),
380 label = rep(c("A", "B"), 2),
381 N = rep(100, 4),
382 O = c(10, 20, 30, 40),
383 O1 = rep(50, 4),
384 O2 = rep(30, 4),
385 E = rep(5, 4),
386 w = rep(2, 4),
387 leftContextSize = rep(1, 4),
388 rightContextSize = rep(1, 4),
389 frequency = c(10, 20, 30, 40),
390 logDice = c(5, 7, 6, 4),
391 pmi = c(2, 3, 4, 1)
392 )
393
394 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
395
396 expect_true(all(!enriched$imputed))
397 expect_true(all(enriched$n_imputed == 0L))
398})
399
Marc Kupietzb2862d42025-10-18 10:17:49 +0200400test_that("add_multi_vc_comparisons handles more than two labels", {
401 sample_result <- tibble::tibble(
402 node = rep("n", 3),
403 collocate = rep("c", 3),
404 vc = c("vc1", "vc2", "vc3"),
405 label = c("A", "B", "C"),
406 N = rep(100, 3),
407 O = c(10, 30, 5),
408 O1 = rep(50, 3),
409 O2 = rep(30, 3),
410 E = rep(5, 3),
411 w = rep(2, 3),
412 leftContextSize = rep(1, 3),
413 rightContextSize = rep(1, 3),
414 frequency = c(10, 30, 5),
Marc Kupietz09b1c082026-05-01 14:45:47 +0200415 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B", "https://korap.example/C"),
Marc Kupietzb2862d42025-10-18 10:17:49 +0200416 logDice = c(5, 8, 4),
417 pmi = c(2, 3, 1)
418 )
419
Marc Kupietz77852b22025-10-19 11:35:34 +0200420 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietzb2862d42025-10-18 10:17:49 +0200421 expect_equal(enriched$winner_logDice[1], "B")
422 expect_equal(enriched$winner_logDice_value[1], 8)
Marc Kupietz09b1c082026-05-01 14:45:47 +0200423 expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
Marc Kupietzb2862d42025-10-18 10:17:49 +0200424 expect_equal(enriched$runner_up_logDice[1], "A")
425 expect_equal(enriched$runner_up_logDice_value[1], 5)
426 expect_equal(enriched$loser_logDice[1], "C")
427 expect_equal(enriched$loser_logDice_value[1], 4)
Marc Kupietz09b1c082026-05-01 14:45:47 +0200428 expect_equal(enriched$loser_logDice_webUIRequestUrl[1], "https://korap.example/C")
Marc Kupietzb2862d42025-10-18 10:17:49 +0200429 expect_equal(enriched$max_delta_logDice[1], 4)
430})
431
Marc Kupietz09b1c082026-05-01 14:45:47 +0200432test_that("add_multi_vc_comparisons leaves unsuffixed URLs ambiguous when scores disagree", {
433 sample_result <- tibble::tibble(
434 node = c("n", "n"),
435 collocate = c("c", "c"),
436 vc = c("vc1", "vc2"),
437 label = c("A", "B"),
438 N = c(100, 100),
439 O = c(10, 20),
440 O1 = c(50, 50),
441 O2 = c(30, 30),
442 E = c(5, 5),
443 w = c(2, 2),
444 leftContextSize = c(1, 1),
445 rightContextSize = c(1, 1),
446 frequency = c(10, 20),
447 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
448 logDice = c(5, 7),
449 pmi = c(4, 3)
450 )
451
452 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
453
454 expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
455 expect_equal(enriched$winner_pmi_webUIRequestUrl[1], "https://korap.example/A")
456 expect_true(is.na(enriched$winner_webUIRequestUrl[1]))
457 expect_true(is.na(enriched$loser_webUIRequestUrl[1]))
458})
459
Marc Kupietz28a29842025-10-18 12:25:09 +0200460test_that("add_multi_vc_comparisons computes rank deltas", {
461 base_tbl <- tidyr::expand_grid(
462 label = c("A", "B", "C"),
463 collocate = c("c1", "c2", "c3")
464 ) |>
465 dplyr::mutate(
466 node = "n",
467 vc = paste0("vc", label),
468 N = 100,
469 O = 10,
470 O1 = 50,
471 O2 = 40,
472 E = 5,
473 w = 2,
474 leftContextSize = 1,
475 rightContextSize = 1,
476 frequency = 10,
477 logDice = dplyr::case_when(
478 label == "A" & collocate == "c1" ~ 9,
479 label == "A" & collocate == "c2" ~ 6,
480 label == "A" & collocate == "c3" ~ 3,
481 label == "B" & collocate == "c1" ~ 7,
482 label == "B" & collocate == "c2" ~ 9,
483 label == "B" & collocate == "c3" ~ 5,
484 label == "C" & collocate == "c1" ~ 4,
485 label == "C" & collocate == "c2" ~ 6,
486 label == "C" & collocate == "c3" ~ 8,
487 TRUE ~ 0
488 )
489 )
490
Marc Kupietz77852b22025-10-19 11:35:34 +0200491 enriched <- RKorAPClient:::add_multi_vc_comparisons(base_tbl)
Marc Kupietz28a29842025-10-18 12:25:09 +0200492 target_row <- enriched |>
493 dplyr::filter(collocate == "c1") |>
494 dplyr::slice_head(n = 1)
495
496 expect_equal(target_row$rank_A_logDice, 1)
497 expect_equal(target_row$rank_B_logDice, 2)
498 expect_equal(target_row$rank_C_logDice, 3)
499 expect_equal(target_row$winner_rank_logDice, "A")
500 expect_equal(target_row$winner_rank_logDice_value, 1)
501 expect_equal(target_row$runner_up_rank_logDice, "B")
502 expect_equal(target_row$runner_up_rank_logDice_value, 2)
503 expect_equal(target_row$loser_rank_logDice, "C")
504 expect_equal(target_row$loser_rank_logDice_value, 3)
505 expect_equal(target_row$max_delta_rank_logDice, 2)
506})
507
508test_that("add_multi_vc_comparisons imputes missing ranks for max delta", {
509 sample_result <- tibble::tibble(
510 node = c("n", "n"),
511 collocate = c("c", "c"),
512 vc = c("vc1", "vc2"),
513 label = c("A", "B"),
514 N = c(100, 100),
515 O = c(10, 10),
516 O1 = c(50, 50),
517 O2 = c(30, 30),
518 E = c(5, 5),
519 w = c(2, 2),
520 leftContextSize = c(1, 1),
521 rightContextSize = c(1, 1),
522 frequency = c(10, 10),
523 logDice = c(5, NA)
524 )
525
Marc Kupietz77852b22025-10-19 11:35:34 +0200526 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietz28a29842025-10-18 12:25:09 +0200527
528 expect_equal(enriched$rank_A_logDice[1], 1)
529 expect_true(is.na(enriched$rank_B_logDice[1]))
530 expect_equal(enriched$winner_rank_logDice[1], "A")
531 expect_equal(enriched$loser_rank_logDice[1], "B")
532 expect_equal(enriched$loser_rank_logDice_value[1], 2)
533 expect_equal(enriched$max_delta_rank_logDice[1], 1)
534})
535
Marc Kupietz9894a372025-10-18 14:51:29 +0200536test_that("adaptive missing score imputation respects measure-specific scales", {
537 sample_result <- tibble::tibble(
538 node = c("n", "n", "n"),
539 collocate = c("c", "c", "c"),
540 vc = c("vc1", "vc2", "vc3"),
541 label = c("A", "B", "C"),
542 N = c(100, 100, 100),
543 O = c(12, 9, 7),
544 O1 = c(60, 40, 30),
545 O2 = c(33, 22, 18),
546 E = c(6, 6, 6),
547 w = c(2, 2, 2),
548 leftContextSize = c(1, 1, 1),
549 rightContextSize = c(1, 1, 1),
550 frequency = c(15, 11, 9),
551 logDice = c(-0.31, NA, -0.12),
552 pmi = c(-1.65, NA, -0.48),
553 ll = c(12.4, NA, 7.9)
554 )
555
556 enriched <- RKorAPClient:::add_multi_vc_comparisons(
557 sample_result,
Marc Kupietz9894a372025-10-18 14:51:29 +0200558 missingScoreQuantile = 0.05
559 )
560
561 row_a <- dplyr::filter(enriched, label == "A") |> dplyr::slice_head(n = 1)
562
563 expect_false(is.na(row_a$logDice_B))
564 expect_false(is.na(row_a$pmi_B))
565 expect_false(is.na(row_a$ll_B))
566
567 expect_lt(row_a$logDice_B, min(sample_result$logDice, na.rm = TRUE))
568 expect_lt(row_a$pmi_B, min(sample_result$pmi, na.rm = TRUE))
569 expect_lte(row_a$ll_B, min(sample_result$ll, na.rm = TRUE))
570
571 expect_gt(row_a$max_delta_logDice, 0)
572 expect_gt(row_a$winner_logDice_value - row_a$loser_logDice_value, 0)
573})
574
Marc Kupietz7de5f322025-06-04 17:17:22 +0200575# New tests for improved coverage of collocationAnalysis.R helper functions
576
577test_that("synsemanticStopwords returns German stopwords", {
578 stopwords <- synsemanticStopwords()
579 expect_true(is.character(stopwords))
580 expect_true(length(stopwords) > 50)
581 expect_true("der" %in% stopwords)
582 expect_true("die" %in% stopwords)
583 expect_true("und" %in% stopwords)
584 expect_true("mit" %in% stopwords)
585})
586
587test_that("removeWithinSpan removes span constraints correctly", {
588 # Test basic span removal
589 query1 <- "contains(<base/s=s>, (machen []{0,1} aufmerksam | aufmerksam []{0,1} machen))"
590 result1 <- RKorAPClient:::removeWithinSpan(query1, "base/s=s")
591 expect_equal(result1, "(machen []{0,1} aufmerksam | aufmerksam []{0,1} machen)")
592
593 # Test with different span
594 query2 <- "contains(<p/s=s>, (test query))"
595 result2 <- RKorAPClient:::removeWithinSpan(query2, "p/s=s")
596 expect_equal(result2, "(test query)")
597
598 # Test with empty span - should return original query
599 query3 <- "simple query"
600 result3 <- RKorAPClient:::removeWithinSpan(query3, "")
601 expect_equal(result3, query3)
602
603 # Test with non-matching span
604 query4 <- "contains(<base/s=s>, test)"
605 result4 <- RKorAPClient:::removeWithinSpan(query4, "other/span")
606 expect_equal(result4, query4)
607})
608
609test_that("matches2FreqTable handles empty matches", {
610 empty_matches <- data.frame()
611 result <- RKorAPClient:::matches2FreqTable(empty_matches, index = 0)
612
613 expect_true(is.data.frame(result))
614 expect_equal(nrow(result), 0)
615})
616
617test_that("matches2FreqTable processes single match correctly", {
618 # Create mock matches data
619 mock_matches <- data.frame(
620 tokens = I(list(list(
621 left = c("der", "große"),
622 match = "Test",
623 right = c("ist", "wichtig")
624 ))),
625 stringsAsFactors = FALSE
626 )
627
628 result <- RKorAPClient:::matches2FreqTable(
629 mock_matches,
630 index = 1,
631 leftContextSize = 2,
632 rightContextSize = 2,
633 stopwords = c("der", "ist") # Provide stopwords to avoid empty join
634 )
635
636 expect_true(is.data.frame(result))
637})
638
639test_that("snippet2FreqTable handles empty snippet", {
640 result <- RKorAPClient:::snippet2FreqTable(character(0))
641
642 expect_true(is.data.frame(result))
643 expect_equal(nrow(result), 0)
644})
645
646test_that("snippet2FreqTable processes single snippet correctly", {
647 snippet <- '<span class="context-left">der große </span><span class="match"><mark>Test</mark></span><span class="context-right"> ist wichtig</span>'
648
649 result <- RKorAPClient:::snippet2FreqTable(
650 snippet,
651 leftContextSize = 2,
652 rightContextSize = 2,
653 stopwords = c("der"), # Provide stopwords to avoid empty join
654 verbose = FALSE
655 )
656
657 expect_true(is.data.frame(result))
658})
659
Marc Kupietz0a292632025-10-19 14:04:36 +0200660test_that("inject_focus_into_query adds focus wrappers when span queries lack them", {
661 unfocused <- "contains(<base/s=s>, (Anspruch [tt/l=nehmen] | [tt/l=nehmen] Anspruch))"
662 focused <- RKorAPClient:::inject_focus_into_query(unfocused)
663
664 expect_equal(
665 focused,
666 "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]}) | focus({[tt/l=nehmen] Anspruch})))"
667 )
668})
669
670test_that("inject_focus_into_query leaves existing focus segments unchanged", {
671 already_focused <- "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]})))"
672 expect_identical(
673 RKorAPClient:::inject_focus_into_query(already_focused),
674 already_focused
675 )
676})
677
Marc Kupietz7de5f322025-06-04 17:17:22 +0200678# Removed hanging findExample tests as they cause infinite wait
679# These tests make API calls that don't complete properly
680
681# Removed hanging collocatesQuery tests as they cause infinite wait
682# These tests were causing the test suite to hang and not terminate
683
684test_that("collocationAnalysis handles exactFrequencies parameter", {
685 skip_if_offline()
686 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
687
688 expect_warning(
689 result <- collocationAnalysis(
690 kco,
691 "Test",
692 exactFrequencies = TRUE,
693 searchHitsSampleLimit = 5,
694 topCollocatesLimit = 5
695 ),
696 "access token"
697 )
698 expect_true(is.data.frame(result))
699})
700
701test_that("collocationAnalysis handles withinSpan parameter", {
702 skip_if_offline()
703 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
704
705 expect_warning(
706 result <- collocationAnalysis(
707 kco,
708 "Test",
709 withinSpan = "base/s=s",
710 exactFrequencies = TRUE,
711 searchHitsSampleLimit = 5,
712 topCollocatesLimit = 5
713 ),
714 "access token"
715 )
716 expect_true(is.data.frame(result))
717})
718
719test_that("collocationAnalysis handles expand parameter", {
720 skip_if_offline()
721 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
722
723 expect_warning(
724 result <- collocationAnalysis(
725 kco,
726 c("Test", "der"),
727 expand = TRUE,
728 searchHitsSampleLimit = 2,
729 topCollocatesLimit = 2
730 ),
731 "access token"
732 )
733 expect_true(is.data.frame(result))
734})
735
Marc Kupietze34a8be2025-10-17 20:13:42 +0200736test_that("collocationAnalysis honors named vc labels", {
737 skip_if_offline()
738 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
739
740 named_vc <- c(
741 Western = "textType=/.*Western.*/ & pubDate in 2012",
742 Erotic = "textType=/.*(Erotik|Gay).*/ & pubDate in 2012",
743 Historic = "textType=/.*Historisch.*/ & pubDate in 2012"
744 )
745
746 expect_warning(
747 result <- collocationAnalysis(
748 kco,
749 "[tt/l=treffen]",
750 vc = named_vc,
751 searchHitsSampleLimit = 2,
752 topCollocatesLimit = 2
753 ),
754 "access token"
755 )
756
757 if (nrow(result) > 0) {
758 expect_true("label" %in% colnames(result))
759 expect_setequal(unique(result$label), names(named_vc))
760 }
761})
762
Marc Kupietz7de5f322025-06-04 17:17:22 +0200763test_that("collocationAnalysis handles stopwords parameter", {
764 skip_if_offline()
765 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
766
767 expect_warning(
768 result <- collocationAnalysis(
769 kco,
770 "Test",
771 stopwords = c("der", "die", "und"),
772 searchHitsSampleLimit = 5,
773 topCollocatesLimit = 5
774 ),
775 "access token"
776 )
777 expect_true(is.data.frame(result))
778})
779
780test_that("collocationAnalysis handles lemmatizeNodeQuery parameter", {
781 skip_if_offline()
782 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
783
784 expect_warning(
785 result <- collocationAnalysis(
786 kco,
787 "laufen",
788 lemmatizeNodeQuery = TRUE,
789 searchHitsSampleLimit = 5,
790 topCollocatesLimit = 5
791 ),
792 "access token"
793 )
794 expect_true(is.data.frame(result))
795})
796
797test_that("collocationAnalysis handles addExamples parameter", {
798 skip_if_offline()
799 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
800
801 expect_warning(
802 result <- collocationAnalysis(
803 kco,
804 "Test",
805 addExamples = TRUE,
806 searchHitsSampleLimit = 3,
807 topCollocatesLimit = 3
808 ),
809 "access token"
810 )
811 expect_true(is.data.frame(result))
812 if (nrow(result) > 0) {
813 expect_true("example" %in% colnames(result))
814 }
815})
816
817test_that("collocationAnalysis handles maxRecurse parameter", {
818 skip_if_offline()
819 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
820
821 expect_warning(
822 result <- collocationAnalysis(
823 kco,
824 "Test",
825 maxRecurse = 1,
826 searchHitsSampleLimit = 2,
827 topCollocatesLimit = 2
828 ),
829 "access token"
830 )
831 expect_true(is.data.frame(result))
832})