blob: 2094dbdd5a53e94090b6d31d7d220c52238aca36 [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
Marc Kupietz424cb782026-08-31 10:19:29 +0200375test_that("add_multi_vc_comparisons reports imputation when verbose", {
376 sample_result <- tibble::tibble(
377 node = c("n", "n", "n"),
378 collocate = c("c1", "c2", "c2"),
379 vc = c("vc1", "vc1", "vc2"),
380 label = c("A", "A", "B"),
381 N = rep(100, 3),
382 O = c(10, 10, 20),
383 O1 = rep(50, 3),
384 O2 = rep(30, 3),
385 E = rep(5, 3),
386 w = rep(2, 3),
387 leftContextSize = rep(1, 3),
388 rightContextSize = rep(1, 3),
389 frequency = c(10, 10, 20),
390 logDice = c(6, 5, 7),
391 pmi = c(3, 2, 4)
392 )
393
394 output <- capture.output(
395 RKorAPClient:::add_multi_vc_comparisons(sample_result, verbose = TRUE)
396 )
397 expect_match(paste(output, collapse = " "), "Imputed scores for 1 of 2")
398 expect_match(paste(output, collapse = " "), "queryMissingScores")
399
400 # nothing is printed unless verbose
401 expect_silent(RKorAPClient:::add_multi_vc_comparisons(sample_result, verbose = FALSE))
402})
403
Marc Kupietzd7bb5cb2026-08-31 10:18:02 +0200404test_that("add_multi_vc_comparisons reports no imputation when all labels are complete", {
405 sample_result <- tibble::tibble(
406 node = rep("n", 4),
407 collocate = c("c1", "c1", "c2", "c2"),
408 vc = rep(c("vc1", "vc2"), 2),
409 label = rep(c("A", "B"), 2),
410 N = rep(100, 4),
411 O = c(10, 20, 30, 40),
412 O1 = rep(50, 4),
413 O2 = rep(30, 4),
414 E = rep(5, 4),
415 w = rep(2, 4),
416 leftContextSize = rep(1, 4),
417 rightContextSize = rep(1, 4),
418 frequency = c(10, 20, 30, 40),
419 logDice = c(5, 7, 6, 4),
420 pmi = c(2, 3, 4, 1)
421 )
422
423 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
424
425 expect_true(all(!enriched$imputed))
426 expect_true(all(enriched$n_imputed == 0L))
427})
428
Marc Kupietzb2862d42025-10-18 10:17:49 +0200429test_that("add_multi_vc_comparisons handles more than two labels", {
430 sample_result <- tibble::tibble(
431 node = rep("n", 3),
432 collocate = rep("c", 3),
433 vc = c("vc1", "vc2", "vc3"),
434 label = c("A", "B", "C"),
435 N = rep(100, 3),
436 O = c(10, 30, 5),
437 O1 = rep(50, 3),
438 O2 = rep(30, 3),
439 E = rep(5, 3),
440 w = rep(2, 3),
441 leftContextSize = rep(1, 3),
442 rightContextSize = rep(1, 3),
443 frequency = c(10, 30, 5),
Marc Kupietz09b1c082026-05-01 14:45:47 +0200444 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B", "https://korap.example/C"),
Marc Kupietzb2862d42025-10-18 10:17:49 +0200445 logDice = c(5, 8, 4),
446 pmi = c(2, 3, 1)
447 )
448
Marc Kupietz77852b22025-10-19 11:35:34 +0200449 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietzb2862d42025-10-18 10:17:49 +0200450 expect_equal(enriched$winner_logDice[1], "B")
451 expect_equal(enriched$winner_logDice_value[1], 8)
Marc Kupietz09b1c082026-05-01 14:45:47 +0200452 expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
Marc Kupietzb2862d42025-10-18 10:17:49 +0200453 expect_equal(enriched$runner_up_logDice[1], "A")
454 expect_equal(enriched$runner_up_logDice_value[1], 5)
455 expect_equal(enriched$loser_logDice[1], "C")
456 expect_equal(enriched$loser_logDice_value[1], 4)
Marc Kupietz09b1c082026-05-01 14:45:47 +0200457 expect_equal(enriched$loser_logDice_webUIRequestUrl[1], "https://korap.example/C")
Marc Kupietzb2862d42025-10-18 10:17:49 +0200458 expect_equal(enriched$max_delta_logDice[1], 4)
459})
460
Marc Kupietz09b1c082026-05-01 14:45:47 +0200461test_that("add_multi_vc_comparisons leaves unsuffixed URLs ambiguous when scores disagree", {
462 sample_result <- tibble::tibble(
463 node = c("n", "n"),
464 collocate = c("c", "c"),
465 vc = c("vc1", "vc2"),
466 label = c("A", "B"),
467 N = c(100, 100),
468 O = c(10, 20),
469 O1 = c(50, 50),
470 O2 = c(30, 30),
471 E = c(5, 5),
472 w = c(2, 2),
473 leftContextSize = c(1, 1),
474 rightContextSize = c(1, 1),
475 frequency = c(10, 20),
476 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
477 logDice = c(5, 7),
478 pmi = c(4, 3)
479 )
480
481 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
482
483 expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
484 expect_equal(enriched$winner_pmi_webUIRequestUrl[1], "https://korap.example/A")
485 expect_true(is.na(enriched$winner_webUIRequestUrl[1]))
486 expect_true(is.na(enriched$loser_webUIRequestUrl[1]))
487})
488
Marc Kupietz28a29842025-10-18 12:25:09 +0200489test_that("add_multi_vc_comparisons computes rank deltas", {
490 base_tbl <- tidyr::expand_grid(
491 label = c("A", "B", "C"),
492 collocate = c("c1", "c2", "c3")
493 ) |>
494 dplyr::mutate(
495 node = "n",
496 vc = paste0("vc", label),
497 N = 100,
498 O = 10,
499 O1 = 50,
500 O2 = 40,
501 E = 5,
502 w = 2,
503 leftContextSize = 1,
504 rightContextSize = 1,
505 frequency = 10,
506 logDice = dplyr::case_when(
507 label == "A" & collocate == "c1" ~ 9,
508 label == "A" & collocate == "c2" ~ 6,
509 label == "A" & collocate == "c3" ~ 3,
510 label == "B" & collocate == "c1" ~ 7,
511 label == "B" & collocate == "c2" ~ 9,
512 label == "B" & collocate == "c3" ~ 5,
513 label == "C" & collocate == "c1" ~ 4,
514 label == "C" & collocate == "c2" ~ 6,
515 label == "C" & collocate == "c3" ~ 8,
516 TRUE ~ 0
517 )
518 )
519
Marc Kupietz77852b22025-10-19 11:35:34 +0200520 enriched <- RKorAPClient:::add_multi_vc_comparisons(base_tbl)
Marc Kupietz28a29842025-10-18 12:25:09 +0200521 target_row <- enriched |>
522 dplyr::filter(collocate == "c1") |>
523 dplyr::slice_head(n = 1)
524
525 expect_equal(target_row$rank_A_logDice, 1)
526 expect_equal(target_row$rank_B_logDice, 2)
527 expect_equal(target_row$rank_C_logDice, 3)
528 expect_equal(target_row$winner_rank_logDice, "A")
529 expect_equal(target_row$winner_rank_logDice_value, 1)
530 expect_equal(target_row$runner_up_rank_logDice, "B")
531 expect_equal(target_row$runner_up_rank_logDice_value, 2)
532 expect_equal(target_row$loser_rank_logDice, "C")
533 expect_equal(target_row$loser_rank_logDice_value, 3)
534 expect_equal(target_row$max_delta_rank_logDice, 2)
535})
536
537test_that("add_multi_vc_comparisons imputes missing ranks for max delta", {
538 sample_result <- tibble::tibble(
539 node = c("n", "n"),
540 collocate = c("c", "c"),
541 vc = c("vc1", "vc2"),
542 label = c("A", "B"),
543 N = c(100, 100),
544 O = c(10, 10),
545 O1 = c(50, 50),
546 O2 = c(30, 30),
547 E = c(5, 5),
548 w = c(2, 2),
549 leftContextSize = c(1, 1),
550 rightContextSize = c(1, 1),
551 frequency = c(10, 10),
552 logDice = c(5, NA)
553 )
554
Marc Kupietz77852b22025-10-19 11:35:34 +0200555 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietz28a29842025-10-18 12:25:09 +0200556
557 expect_equal(enriched$rank_A_logDice[1], 1)
558 expect_true(is.na(enriched$rank_B_logDice[1]))
559 expect_equal(enriched$winner_rank_logDice[1], "A")
560 expect_equal(enriched$loser_rank_logDice[1], "B")
561 expect_equal(enriched$loser_rank_logDice_value[1], 2)
562 expect_equal(enriched$max_delta_rank_logDice[1], 1)
563})
564
Marc Kupietz9894a372025-10-18 14:51:29 +0200565test_that("adaptive missing score imputation respects measure-specific scales", {
566 sample_result <- tibble::tibble(
567 node = c("n", "n", "n"),
568 collocate = c("c", "c", "c"),
569 vc = c("vc1", "vc2", "vc3"),
570 label = c("A", "B", "C"),
571 N = c(100, 100, 100),
572 O = c(12, 9, 7),
573 O1 = c(60, 40, 30),
574 O2 = c(33, 22, 18),
575 E = c(6, 6, 6),
576 w = c(2, 2, 2),
577 leftContextSize = c(1, 1, 1),
578 rightContextSize = c(1, 1, 1),
579 frequency = c(15, 11, 9),
580 logDice = c(-0.31, NA, -0.12),
581 pmi = c(-1.65, NA, -0.48),
582 ll = c(12.4, NA, 7.9)
583 )
584
585 enriched <- RKorAPClient:::add_multi_vc_comparisons(
586 sample_result,
Marc Kupietz9894a372025-10-18 14:51:29 +0200587 missingScoreQuantile = 0.05
588 )
589
590 row_a <- dplyr::filter(enriched, label == "A") |> dplyr::slice_head(n = 1)
591
592 expect_false(is.na(row_a$logDice_B))
593 expect_false(is.na(row_a$pmi_B))
594 expect_false(is.na(row_a$ll_B))
595
596 expect_lt(row_a$logDice_B, min(sample_result$logDice, na.rm = TRUE))
597 expect_lt(row_a$pmi_B, min(sample_result$pmi, na.rm = TRUE))
598 expect_lte(row_a$ll_B, min(sample_result$ll, na.rm = TRUE))
599
600 expect_gt(row_a$max_delta_logDice, 0)
601 expect_gt(row_a$winner_logDice_value - row_a$loser_logDice_value, 0)
602})
603
Marc Kupietz7de5f322025-06-04 17:17:22 +0200604# New tests for improved coverage of collocationAnalysis.R helper functions
605
606test_that("synsemanticStopwords returns German stopwords", {
607 stopwords <- synsemanticStopwords()
608 expect_true(is.character(stopwords))
609 expect_true(length(stopwords) > 50)
610 expect_true("der" %in% stopwords)
611 expect_true("die" %in% stopwords)
612 expect_true("und" %in% stopwords)
613 expect_true("mit" %in% stopwords)
614})
615
616test_that("removeWithinSpan removes span constraints correctly", {
617 # Test basic span removal
618 query1 <- "contains(<base/s=s>, (machen []{0,1} aufmerksam | aufmerksam []{0,1} machen))"
619 result1 <- RKorAPClient:::removeWithinSpan(query1, "base/s=s")
620 expect_equal(result1, "(machen []{0,1} aufmerksam | aufmerksam []{0,1} machen)")
621
622 # Test with different span
623 query2 <- "contains(<p/s=s>, (test query))"
624 result2 <- RKorAPClient:::removeWithinSpan(query2, "p/s=s")
625 expect_equal(result2, "(test query)")
626
627 # Test with empty span - should return original query
628 query3 <- "simple query"
629 result3 <- RKorAPClient:::removeWithinSpan(query3, "")
630 expect_equal(result3, query3)
631
632 # Test with non-matching span
633 query4 <- "contains(<base/s=s>, test)"
634 result4 <- RKorAPClient:::removeWithinSpan(query4, "other/span")
635 expect_equal(result4, query4)
636})
637
638test_that("matches2FreqTable handles empty matches", {
639 empty_matches <- data.frame()
640 result <- RKorAPClient:::matches2FreqTable(empty_matches, index = 0)
641
642 expect_true(is.data.frame(result))
643 expect_equal(nrow(result), 0)
644})
645
646test_that("matches2FreqTable processes single match correctly", {
647 # Create mock matches data
648 mock_matches <- data.frame(
649 tokens = I(list(list(
650 left = c("der", "große"),
651 match = "Test",
652 right = c("ist", "wichtig")
653 ))),
654 stringsAsFactors = FALSE
655 )
656
657 result <- RKorAPClient:::matches2FreqTable(
658 mock_matches,
659 index = 1,
660 leftContextSize = 2,
661 rightContextSize = 2,
662 stopwords = c("der", "ist") # Provide stopwords to avoid empty join
663 )
664
665 expect_true(is.data.frame(result))
666})
667
668test_that("snippet2FreqTable handles empty snippet", {
669 result <- RKorAPClient:::snippet2FreqTable(character(0))
670
671 expect_true(is.data.frame(result))
672 expect_equal(nrow(result), 0)
673})
674
675test_that("snippet2FreqTable processes single snippet correctly", {
676 snippet <- '<span class="context-left">der große </span><span class="match"><mark>Test</mark></span><span class="context-right"> ist wichtig</span>'
677
678 result <- RKorAPClient:::snippet2FreqTable(
679 snippet,
680 leftContextSize = 2,
681 rightContextSize = 2,
682 stopwords = c("der"), # Provide stopwords to avoid empty join
683 verbose = FALSE
684 )
685
686 expect_true(is.data.frame(result))
687})
688
Marc Kupietz0a292632025-10-19 14:04:36 +0200689test_that("inject_focus_into_query adds focus wrappers when span queries lack them", {
690 unfocused <- "contains(<base/s=s>, (Anspruch [tt/l=nehmen] | [tt/l=nehmen] Anspruch))"
691 focused <- RKorAPClient:::inject_focus_into_query(unfocused)
692
693 expect_equal(
694 focused,
695 "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]}) | focus({[tt/l=nehmen] Anspruch})))"
696 )
697})
698
699test_that("inject_focus_into_query leaves existing focus segments unchanged", {
700 already_focused <- "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]})))"
701 expect_identical(
702 RKorAPClient:::inject_focus_into_query(already_focused),
703 already_focused
704 )
705})
706
Marc Kupietz7de5f322025-06-04 17:17:22 +0200707# Removed hanging findExample tests as they cause infinite wait
708# These tests make API calls that don't complete properly
709
710# Removed hanging collocatesQuery tests as they cause infinite wait
711# These tests were causing the test suite to hang and not terminate
712
713test_that("collocationAnalysis handles exactFrequencies parameter", {
714 skip_if_offline()
715 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
716
717 expect_warning(
718 result <- collocationAnalysis(
719 kco,
720 "Test",
721 exactFrequencies = TRUE,
722 searchHitsSampleLimit = 5,
723 topCollocatesLimit = 5
724 ),
725 "access token"
726 )
727 expect_true(is.data.frame(result))
728})
729
730test_that("collocationAnalysis handles withinSpan parameter", {
731 skip_if_offline()
732 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
733
734 expect_warning(
735 result <- collocationAnalysis(
736 kco,
737 "Test",
738 withinSpan = "base/s=s",
739 exactFrequencies = TRUE,
740 searchHitsSampleLimit = 5,
741 topCollocatesLimit = 5
742 ),
743 "access token"
744 )
745 expect_true(is.data.frame(result))
746})
747
748test_that("collocationAnalysis handles expand parameter", {
749 skip_if_offline()
750 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
751
752 expect_warning(
753 result <- collocationAnalysis(
754 kco,
755 c("Test", "der"),
756 expand = TRUE,
757 searchHitsSampleLimit = 2,
758 topCollocatesLimit = 2
759 ),
760 "access token"
761 )
762 expect_true(is.data.frame(result))
763})
764
Marc Kupietze34a8be2025-10-17 20:13:42 +0200765test_that("collocationAnalysis honors named vc labels", {
766 skip_if_offline()
767 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
768
769 named_vc <- c(
770 Western = "textType=/.*Western.*/ & pubDate in 2012",
771 Erotic = "textType=/.*(Erotik|Gay).*/ & pubDate in 2012",
772 Historic = "textType=/.*Historisch.*/ & pubDate in 2012"
773 )
774
775 expect_warning(
776 result <- collocationAnalysis(
777 kco,
778 "[tt/l=treffen]",
779 vc = named_vc,
780 searchHitsSampleLimit = 2,
781 topCollocatesLimit = 2
782 ),
783 "access token"
784 )
785
786 if (nrow(result) > 0) {
787 expect_true("label" %in% colnames(result))
788 expect_setequal(unique(result$label), names(named_vc))
789 }
790})
791
Marc Kupietz7de5f322025-06-04 17:17:22 +0200792test_that("collocationAnalysis handles stopwords parameter", {
793 skip_if_offline()
794 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
795
796 expect_warning(
797 result <- collocationAnalysis(
798 kco,
799 "Test",
800 stopwords = c("der", "die", "und"),
801 searchHitsSampleLimit = 5,
802 topCollocatesLimit = 5
803 ),
804 "access token"
805 )
806 expect_true(is.data.frame(result))
807})
808
809test_that("collocationAnalysis handles lemmatizeNodeQuery parameter", {
810 skip_if_offline()
811 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
812
813 expect_warning(
814 result <- collocationAnalysis(
815 kco,
816 "laufen",
817 lemmatizeNodeQuery = TRUE,
818 searchHitsSampleLimit = 5,
819 topCollocatesLimit = 5
820 ),
821 "access token"
822 )
823 expect_true(is.data.frame(result))
824})
825
826test_that("collocationAnalysis handles addExamples parameter", {
827 skip_if_offline()
828 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
829
830 expect_warning(
831 result <- collocationAnalysis(
832 kco,
833 "Test",
834 addExamples = TRUE,
835 searchHitsSampleLimit = 3,
836 topCollocatesLimit = 3
837 ),
838 "access token"
839 )
840 expect_true(is.data.frame(result))
841 if (nrow(result) > 0) {
842 expect_true("example" %in% colnames(result))
843 }
844})
845
846test_that("collocationAnalysis handles maxRecurse parameter", {
847 skip_if_offline()
848 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
849
850 expect_warning(
851 result <- collocationAnalysis(
852 kco,
853 "Test",
854 maxRecurse = 1,
855 searchHitsSampleLimit = 2,
856 topCollocatesLimit = 2
857 ),
858 "access token"
859 )
860 expect_true(is.data.frame(result))
861})