blob: 94bc45381bb1ea7c1f8c1e5ef85b2716656d0049 [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 Kupietzb2862d42025-10-18 10:17:49 +0200325test_that("add_multi_vc_comparisons handles more than two labels", {
326 sample_result <- tibble::tibble(
327 node = rep("n", 3),
328 collocate = rep("c", 3),
329 vc = c("vc1", "vc2", "vc3"),
330 label = c("A", "B", "C"),
331 N = rep(100, 3),
332 O = c(10, 30, 5),
333 O1 = rep(50, 3),
334 O2 = rep(30, 3),
335 E = rep(5, 3),
336 w = rep(2, 3),
337 leftContextSize = rep(1, 3),
338 rightContextSize = rep(1, 3),
339 frequency = c(10, 30, 5),
Marc Kupietz09b1c082026-05-01 14:45:47 +0200340 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B", "https://korap.example/C"),
Marc Kupietzb2862d42025-10-18 10:17:49 +0200341 logDice = c(5, 8, 4),
342 pmi = c(2, 3, 1)
343 )
344
Marc Kupietz77852b22025-10-19 11:35:34 +0200345 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietzb2862d42025-10-18 10:17:49 +0200346 expect_equal(enriched$winner_logDice[1], "B")
347 expect_equal(enriched$winner_logDice_value[1], 8)
Marc Kupietz09b1c082026-05-01 14:45:47 +0200348 expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
Marc Kupietzb2862d42025-10-18 10:17:49 +0200349 expect_equal(enriched$runner_up_logDice[1], "A")
350 expect_equal(enriched$runner_up_logDice_value[1], 5)
351 expect_equal(enriched$loser_logDice[1], "C")
352 expect_equal(enriched$loser_logDice_value[1], 4)
Marc Kupietz09b1c082026-05-01 14:45:47 +0200353 expect_equal(enriched$loser_logDice_webUIRequestUrl[1], "https://korap.example/C")
Marc Kupietzb2862d42025-10-18 10:17:49 +0200354 expect_equal(enriched$max_delta_logDice[1], 4)
355})
356
Marc Kupietz09b1c082026-05-01 14:45:47 +0200357test_that("add_multi_vc_comparisons leaves unsuffixed URLs ambiguous when scores disagree", {
358 sample_result <- tibble::tibble(
359 node = c("n", "n"),
360 collocate = c("c", "c"),
361 vc = c("vc1", "vc2"),
362 label = c("A", "B"),
363 N = c(100, 100),
364 O = c(10, 20),
365 O1 = c(50, 50),
366 O2 = c(30, 30),
367 E = c(5, 5),
368 w = c(2, 2),
369 leftContextSize = c(1, 1),
370 rightContextSize = c(1, 1),
371 frequency = c(10, 20),
372 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
373 logDice = c(5, 7),
374 pmi = c(4, 3)
375 )
376
377 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
378
379 expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
380 expect_equal(enriched$winner_pmi_webUIRequestUrl[1], "https://korap.example/A")
381 expect_true(is.na(enriched$winner_webUIRequestUrl[1]))
382 expect_true(is.na(enriched$loser_webUIRequestUrl[1]))
383})
384
Marc Kupietz28a29842025-10-18 12:25:09 +0200385test_that("add_multi_vc_comparisons computes rank deltas", {
386 base_tbl <- tidyr::expand_grid(
387 label = c("A", "B", "C"),
388 collocate = c("c1", "c2", "c3")
389 ) |>
390 dplyr::mutate(
391 node = "n",
392 vc = paste0("vc", label),
393 N = 100,
394 O = 10,
395 O1 = 50,
396 O2 = 40,
397 E = 5,
398 w = 2,
399 leftContextSize = 1,
400 rightContextSize = 1,
401 frequency = 10,
402 logDice = dplyr::case_when(
403 label == "A" & collocate == "c1" ~ 9,
404 label == "A" & collocate == "c2" ~ 6,
405 label == "A" & collocate == "c3" ~ 3,
406 label == "B" & collocate == "c1" ~ 7,
407 label == "B" & collocate == "c2" ~ 9,
408 label == "B" & collocate == "c3" ~ 5,
409 label == "C" & collocate == "c1" ~ 4,
410 label == "C" & collocate == "c2" ~ 6,
411 label == "C" & collocate == "c3" ~ 8,
412 TRUE ~ 0
413 )
414 )
415
Marc Kupietz77852b22025-10-19 11:35:34 +0200416 enriched <- RKorAPClient:::add_multi_vc_comparisons(base_tbl)
Marc Kupietz28a29842025-10-18 12:25:09 +0200417 target_row <- enriched |>
418 dplyr::filter(collocate == "c1") |>
419 dplyr::slice_head(n = 1)
420
421 expect_equal(target_row$rank_A_logDice, 1)
422 expect_equal(target_row$rank_B_logDice, 2)
423 expect_equal(target_row$rank_C_logDice, 3)
424 expect_equal(target_row$winner_rank_logDice, "A")
425 expect_equal(target_row$winner_rank_logDice_value, 1)
426 expect_equal(target_row$runner_up_rank_logDice, "B")
427 expect_equal(target_row$runner_up_rank_logDice_value, 2)
428 expect_equal(target_row$loser_rank_logDice, "C")
429 expect_equal(target_row$loser_rank_logDice_value, 3)
430 expect_equal(target_row$max_delta_rank_logDice, 2)
431})
432
433test_that("add_multi_vc_comparisons imputes missing ranks for max delta", {
434 sample_result <- tibble::tibble(
435 node = c("n", "n"),
436 collocate = c("c", "c"),
437 vc = c("vc1", "vc2"),
438 label = c("A", "B"),
439 N = c(100, 100),
440 O = c(10, 10),
441 O1 = c(50, 50),
442 O2 = c(30, 30),
443 E = c(5, 5),
444 w = c(2, 2),
445 leftContextSize = c(1, 1),
446 rightContextSize = c(1, 1),
447 frequency = c(10, 10),
448 logDice = c(5, NA)
449 )
450
Marc Kupietz77852b22025-10-19 11:35:34 +0200451 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietz28a29842025-10-18 12:25:09 +0200452
453 expect_equal(enriched$rank_A_logDice[1], 1)
454 expect_true(is.na(enriched$rank_B_logDice[1]))
455 expect_equal(enriched$winner_rank_logDice[1], "A")
456 expect_equal(enriched$loser_rank_logDice[1], "B")
457 expect_equal(enriched$loser_rank_logDice_value[1], 2)
458 expect_equal(enriched$max_delta_rank_logDice[1], 1)
459})
460
Marc Kupietz9894a372025-10-18 14:51:29 +0200461test_that("adaptive missing score imputation respects measure-specific scales", {
462 sample_result <- tibble::tibble(
463 node = c("n", "n", "n"),
464 collocate = c("c", "c", "c"),
465 vc = c("vc1", "vc2", "vc3"),
466 label = c("A", "B", "C"),
467 N = c(100, 100, 100),
468 O = c(12, 9, 7),
469 O1 = c(60, 40, 30),
470 O2 = c(33, 22, 18),
471 E = c(6, 6, 6),
472 w = c(2, 2, 2),
473 leftContextSize = c(1, 1, 1),
474 rightContextSize = c(1, 1, 1),
475 frequency = c(15, 11, 9),
476 logDice = c(-0.31, NA, -0.12),
477 pmi = c(-1.65, NA, -0.48),
478 ll = c(12.4, NA, 7.9)
479 )
480
481 enriched <- RKorAPClient:::add_multi_vc_comparisons(
482 sample_result,
Marc Kupietz9894a372025-10-18 14:51:29 +0200483 missingScoreQuantile = 0.05
484 )
485
486 row_a <- dplyr::filter(enriched, label == "A") |> dplyr::slice_head(n = 1)
487
488 expect_false(is.na(row_a$logDice_B))
489 expect_false(is.na(row_a$pmi_B))
490 expect_false(is.na(row_a$ll_B))
491
492 expect_lt(row_a$logDice_B, min(sample_result$logDice, na.rm = TRUE))
493 expect_lt(row_a$pmi_B, min(sample_result$pmi, na.rm = TRUE))
494 expect_lte(row_a$ll_B, min(sample_result$ll, na.rm = TRUE))
495
496 expect_gt(row_a$max_delta_logDice, 0)
497 expect_gt(row_a$winner_logDice_value - row_a$loser_logDice_value, 0)
498})
499
Marc Kupietz7de5f322025-06-04 17:17:22 +0200500# New tests for improved coverage of collocationAnalysis.R helper functions
501
502test_that("synsemanticStopwords returns German stopwords", {
503 stopwords <- synsemanticStopwords()
504 expect_true(is.character(stopwords))
505 expect_true(length(stopwords) > 50)
506 expect_true("der" %in% stopwords)
507 expect_true("die" %in% stopwords)
508 expect_true("und" %in% stopwords)
509 expect_true("mit" %in% stopwords)
510})
511
512test_that("removeWithinSpan removes span constraints correctly", {
513 # Test basic span removal
514 query1 <- "contains(<base/s=s>, (machen []{0,1} aufmerksam | aufmerksam []{0,1} machen))"
515 result1 <- RKorAPClient:::removeWithinSpan(query1, "base/s=s")
516 expect_equal(result1, "(machen []{0,1} aufmerksam | aufmerksam []{0,1} machen)")
517
518 # Test with different span
519 query2 <- "contains(<p/s=s>, (test query))"
520 result2 <- RKorAPClient:::removeWithinSpan(query2, "p/s=s")
521 expect_equal(result2, "(test query)")
522
523 # Test with empty span - should return original query
524 query3 <- "simple query"
525 result3 <- RKorAPClient:::removeWithinSpan(query3, "")
526 expect_equal(result3, query3)
527
528 # Test with non-matching span
529 query4 <- "contains(<base/s=s>, test)"
530 result4 <- RKorAPClient:::removeWithinSpan(query4, "other/span")
531 expect_equal(result4, query4)
532})
533
534test_that("matches2FreqTable handles empty matches", {
535 empty_matches <- data.frame()
536 result <- RKorAPClient:::matches2FreqTable(empty_matches, index = 0)
537
538 expect_true(is.data.frame(result))
539 expect_equal(nrow(result), 0)
540})
541
542test_that("matches2FreqTable processes single match correctly", {
543 # Create mock matches data
544 mock_matches <- data.frame(
545 tokens = I(list(list(
546 left = c("der", "große"),
547 match = "Test",
548 right = c("ist", "wichtig")
549 ))),
550 stringsAsFactors = FALSE
551 )
552
553 result <- RKorAPClient:::matches2FreqTable(
554 mock_matches,
555 index = 1,
556 leftContextSize = 2,
557 rightContextSize = 2,
558 stopwords = c("der", "ist") # Provide stopwords to avoid empty join
559 )
560
561 expect_true(is.data.frame(result))
562})
563
564test_that("snippet2FreqTable handles empty snippet", {
565 result <- RKorAPClient:::snippet2FreqTable(character(0))
566
567 expect_true(is.data.frame(result))
568 expect_equal(nrow(result), 0)
569})
570
571test_that("snippet2FreqTable processes single snippet correctly", {
572 snippet <- '<span class="context-left">der große </span><span class="match"><mark>Test</mark></span><span class="context-right"> ist wichtig</span>'
573
574 result <- RKorAPClient:::snippet2FreqTable(
575 snippet,
576 leftContextSize = 2,
577 rightContextSize = 2,
578 stopwords = c("der"), # Provide stopwords to avoid empty join
579 verbose = FALSE
580 )
581
582 expect_true(is.data.frame(result))
583})
584
Marc Kupietz0a292632025-10-19 14:04:36 +0200585test_that("inject_focus_into_query adds focus wrappers when span queries lack them", {
586 unfocused <- "contains(<base/s=s>, (Anspruch [tt/l=nehmen] | [tt/l=nehmen] Anspruch))"
587 focused <- RKorAPClient:::inject_focus_into_query(unfocused)
588
589 expect_equal(
590 focused,
591 "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]}) | focus({[tt/l=nehmen] Anspruch})))"
592 )
593})
594
595test_that("inject_focus_into_query leaves existing focus segments unchanged", {
596 already_focused <- "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]})))"
597 expect_identical(
598 RKorAPClient:::inject_focus_into_query(already_focused),
599 already_focused
600 )
601})
602
Marc Kupietz7de5f322025-06-04 17:17:22 +0200603# Removed hanging findExample tests as they cause infinite wait
604# These tests make API calls that don't complete properly
605
606# Removed hanging collocatesQuery tests as they cause infinite wait
607# These tests were causing the test suite to hang and not terminate
608
609test_that("collocationAnalysis handles exactFrequencies parameter", {
610 skip_if_offline()
611 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
612
613 expect_warning(
614 result <- collocationAnalysis(
615 kco,
616 "Test",
617 exactFrequencies = TRUE,
618 searchHitsSampleLimit = 5,
619 topCollocatesLimit = 5
620 ),
621 "access token"
622 )
623 expect_true(is.data.frame(result))
624})
625
626test_that("collocationAnalysis handles withinSpan parameter", {
627 skip_if_offline()
628 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
629
630 expect_warning(
631 result <- collocationAnalysis(
632 kco,
633 "Test",
634 withinSpan = "base/s=s",
635 exactFrequencies = TRUE,
636 searchHitsSampleLimit = 5,
637 topCollocatesLimit = 5
638 ),
639 "access token"
640 )
641 expect_true(is.data.frame(result))
642})
643
644test_that("collocationAnalysis handles expand parameter", {
645 skip_if_offline()
646 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
647
648 expect_warning(
649 result <- collocationAnalysis(
650 kco,
651 c("Test", "der"),
652 expand = TRUE,
653 searchHitsSampleLimit = 2,
654 topCollocatesLimit = 2
655 ),
656 "access token"
657 )
658 expect_true(is.data.frame(result))
659})
660
Marc Kupietze34a8be2025-10-17 20:13:42 +0200661test_that("collocationAnalysis honors named vc labels", {
662 skip_if_offline()
663 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
664
665 named_vc <- c(
666 Western = "textType=/.*Western.*/ & pubDate in 2012",
667 Erotic = "textType=/.*(Erotik|Gay).*/ & pubDate in 2012",
668 Historic = "textType=/.*Historisch.*/ & pubDate in 2012"
669 )
670
671 expect_warning(
672 result <- collocationAnalysis(
673 kco,
674 "[tt/l=treffen]",
675 vc = named_vc,
676 searchHitsSampleLimit = 2,
677 topCollocatesLimit = 2
678 ),
679 "access token"
680 )
681
682 if (nrow(result) > 0) {
683 expect_true("label" %in% colnames(result))
684 expect_setequal(unique(result$label), names(named_vc))
685 }
686})
687
Marc Kupietz7de5f322025-06-04 17:17:22 +0200688test_that("collocationAnalysis handles stopwords parameter", {
689 skip_if_offline()
690 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
691
692 expect_warning(
693 result <- collocationAnalysis(
694 kco,
695 "Test",
696 stopwords = c("der", "die", "und"),
697 searchHitsSampleLimit = 5,
698 topCollocatesLimit = 5
699 ),
700 "access token"
701 )
702 expect_true(is.data.frame(result))
703})
704
705test_that("collocationAnalysis handles lemmatizeNodeQuery parameter", {
706 skip_if_offline()
707 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
708
709 expect_warning(
710 result <- collocationAnalysis(
711 kco,
712 "laufen",
713 lemmatizeNodeQuery = TRUE,
714 searchHitsSampleLimit = 5,
715 topCollocatesLimit = 5
716 ),
717 "access token"
718 )
719 expect_true(is.data.frame(result))
720})
721
722test_that("collocationAnalysis handles addExamples parameter", {
723 skip_if_offline()
724 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
725
726 expect_warning(
727 result <- collocationAnalysis(
728 kco,
729 "Test",
730 addExamples = TRUE,
731 searchHitsSampleLimit = 3,
732 topCollocatesLimit = 3
733 ),
734 "access token"
735 )
736 expect_true(is.data.frame(result))
737 if (nrow(result) > 0) {
738 expect_true("example" %in% colnames(result))
739 }
740})
741
742test_that("collocationAnalysis handles maxRecurse parameter", {
743 skip_if_offline()
744 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
745
746 expect_warning(
747 result <- collocationAnalysis(
748 kco,
749 "Test",
750 maxRecurse = 1,
751 searchHitsSampleLimit = 2,
752 topCollocatesLimit = 2
753 ),
754 "access token"
755 )
756 expect_true(is.data.frame(result))
757})