blob: 0d5dd3e0f79970b0daaaf95584dc85e38628e4ae [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 Kupietz581a29b2021-09-04 20:51:04 +020013
14test_that("collocationAnalysis works and warns about missing token", {
Marc Kupietz83d0af32022-02-24 12:49:28 +010015 skip_if_offline()
Marc Kupietz617266d2025-02-27 10:43:07 +010016 kco <- KorAPConnection(
Marc Kupietz7de5f322025-06-04 17:17:22 +020017 accessToken = NULL,
18 verbose = TRUE
19 )
20 expect_warning(
21 df <-
22 collocationAnalysis(
23 kco,
24 "focus([tt/p=ADJA] {Newstickeritis})",
25 leftContextSize = 1,
26 rightContextSize = 0,
27 ),
28 "access token"
29 )
Marc Kupietzdbd431a2021-08-29 12:17:45 +020030 expect_gt(df$O, df$E)
Marc Kupietzf9129592025-01-26 19:17:54 +010031 expect_gt(df$logDice, -1)
Marc Kupietzdbd431a2021-08-29 12:17:45 +020032})
33
34test_that("collocationAnalysis on unaccounted strings does not error out", {
Marc Kupietz83d0af32022-02-24 12:49:28 +010035 skip_if_offline()
Marc Kupietz617266d2025-02-27 10:43:07 +010036 kco <- KorAPConnection(accessToken = NULL, verbose = TRUE)
Marc Kupietz581a29b2021-09-04 20:51:04 +020037 expect_warning(
Marc Kupietz7de5f322025-06-04 17:17:22 +020038 df <- collocationAnalysis(kco, "XXXXXXXXAmeisenplage", vc = c("corpusSigle=/WDD17/", "corpusSigle=/WUD17/"), maxRecurse = 2),
Marc Kupietz581a29b2021-09-04 20:51:04 +020039 "access token"
40 )
Marc Kupietzdbd431a2021-08-29 12:17:45 +020041 testthat::expect_equal(nrow(df), 0)
42})
Marc Kupietzd6314b62021-12-22 12:49:09 +010043
Marc Kupietz7de5f322025-06-04 17:17:22 +020044# test_that("removeWithinSpanWorks", {
Marc Kupietz76dee312025-04-06 16:24:47 +020045# expect_equal(
46# removeWithinSpan("contains(<base/s=s>, (machen []{0,1} aufmerksam | aufmerksam []{0,1} machen))", "base/s=s"),
47# "(machen []{0,1} aufmerksam | aufmerksam []{0,1} machen)")
Marc Kupietz7de5f322025-06-04 17:17:22 +020048# })
Marc Kupietzdbdbb1f2025-02-19 10:33:06 +010049
50
51test_that("mergeDuplicateCollocatesWorksAsExpected", {
Marc Kupietz5057f502025-04-06 16:55:57 +020052 ldf <- tibble::tibble(
Marc Kupietzdbdbb1f2025-02-19 10:33:06 +010053 node = c("focus(in [tt/p=NN] {[tt/l=nehmen]})"),
54 collocate = c("Anspruch"),
55 label = c(""),
56 vc = c(""),
57 query = c("Anspruch focus(in [tt/p=NN] {[tt/l=nehmen]})"),
58 webUIRequestUrl = c(
59 "https://korap.ids-mannheim.de/?q=Anspruch%20focus%28in%20%5btt%2fp%3dNN%5d%20%7b%5btt%2fl%3dnehmen%5d%7d%29&ql=poliqarp"
60 ),
61 w = c(1),
62 leftContextSize = c(1),
63 rightContextSize = c(0),
64 N = c(23578528381.5),
65 O = c(0.5),
66 O1 = c(1168410.5),
67 O2 = c(1296870.5),
68 E = c(64.2651265093014),
69 pmi = c(11.9173498777957),
70 mi2 = c(29.8406639214616),
71 mi3 = c(47.7639779651274),
72 logDice = c(11.6899933757298),
73 ll = c(3717716.74208791)
74 )
Marc Kupietz5057f502025-04-06 16:55:57 +020075 rdf <- tibble::tibble(
Marc Kupietzdbdbb1f2025-02-19 10:33:06 +010076 node = c("focus({[tt/l=nehmen] in} [tt/p=NN])"),
77 collocate = c("Anspruch"),
78 label = c(""),
79 vc = c(""),
80 query = c("focus({[tt/l=nehmen] in} [tt/p=NN]) Anspruch"),
81 webUIRequestUrl = c(
82 "https://korap.ids-mannheim.de/?q=focus%28%7b%5btt%2fl%3dnehmen%5d%20in%7d%20%5btt%2fp%3dNN%5d%29%20Anspruch&ql=poliqarp"
83 ),
84 w = c(1),
85 leftContextSize = c(0),
86 rightContextSize = c(1),
87 N = c(23578528381.5),
88 O = c(0.5),
89 O1 = c(17077.5),
90 O2 = c(1296870.5),
91 E = c(0.939299756346416),
92 pmi = c(7.99469408391783),
93 mi2 = c(15.8990457079122),
94 mi3 = c(23.8033973319065),
95 logDice = c(2.57887487309409),
96 ll = c(2181.35986032019)
97 )
98 merged <- mergeDuplicateCollocates(ldf, rdf, smoothingConstant = 0.5)
99 expect_equal(merged$O, 0.5)
100 expect_equal(merged$O1, 1185487.5)
101 expect_equal(merged$O2, 1296870.5)
102 expect_equal(merged$query, "Anspruch focus(in [tt/p=NN] {[tt/l=nehmen]}) | focus({[tt/l=nehmen] in} [tt/p=NN]) Anspruch")
103})
Marc Kupietz7de5f322025-06-04 17:17:22 +0200104
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200105test_that("add_multi_vc_comparisons adds favorite columns", {
106 sample_result <- tibble::tibble(
107 node = c("n", "n"),
108 collocate = c("c", "c"),
109 vc = c("vc1", "vc2"),
110 label = c("A", "B"),
111 N = c(100, 100),
112 O = c(10, 20),
113 O1 = c(50, 50),
114 O2 = c(30, 30),
115 E = c(5, 5),
116 w = c(2, 2),
117 leftContextSize = c(1, 1),
118 rightContextSize = c(1, 1),
119 frequency = c(10, 20),
Marc Kupietz09b1c082026-05-01 14:45:47 +0200120 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200121 logDice = c(5, 7),
122 pmi = c(2, 3)
123 )
124
Marc Kupietz77852b22025-10-19 11:35:34 +0200125 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200126
127 expect_true(all(c(
128 "winner_logDice",
129 "winner_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200130 "winner_logDice_webUIRequestUrl",
131 "winner_webUIRequestUrl",
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200132 "runner_up_logDice",
Marc Kupietz28a29842025-10-18 12:25:09 +0200133 "runner_up_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200134 "loser_logDice_webUIRequestUrl",
135 "loser_webUIRequestUrl",
Marc Kupietz28a29842025-10-18 12:25:09 +0200136 "max_delta_logDice",
137 "winner_rank_logDice",
138 "winner_rank_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200139 "winner_rank_logDice_webUIRequestUrl",
Marc Kupietz28a29842025-10-18 12:25:09 +0200140 "runner_up_rank_logDice",
141 "runner_up_rank_logDice_value",
142 "loser_rank_logDice",
143 "loser_rank_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200144 "loser_rank_logDice_webUIRequestUrl",
Marc Kupietz28a29842025-10-18 12:25:09 +0200145 "max_delta_rank_logDice",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200146 "winner_percentile_rank_logDice",
147 "winner_percentile_rank_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200148 "winner_percentile_rank_logDice_webUIRequestUrl",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200149 "runner_up_percentile_rank_logDice",
150 "runner_up_percentile_rank_logDice_value",
151 "loser_percentile_rank_logDice",
152 "loser_percentile_rank_logDice_value",
Marc Kupietz09b1c082026-05-01 14:45:47 +0200153 "loser_percentile_rank_logDice_webUIRequestUrl",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200154 "max_delta_percentile_rank_logDice",
Marc Kupietz28a29842025-10-18 12:25:09 +0200155 "winner_rank_pmi",
156 "winner_rank_pmi_value",
157 "runner_up_rank_pmi",
158 "runner_up_rank_pmi_value",
159 "loser_rank_pmi",
160 "loser_rank_pmi_value",
161 "max_delta_rank_pmi",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200162 "winner_percentile_rank_pmi",
163 "winner_percentile_rank_pmi_value",
164 "runner_up_percentile_rank_pmi",
165 "runner_up_percentile_rank_pmi_value",
166 "loser_percentile_rank_pmi",
167 "loser_percentile_rank_pmi_value",
168 "max_delta_percentile_rank_pmi",
Marc Kupietz28a29842025-10-18 12:25:09 +0200169 "rank_A_logDice",
170 "rank_B_logDice",
171 "rank_A_pmi",
172 "rank_B_pmi",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200173 "percentile_rank_A_logDice",
174 "percentile_rank_B_logDice",
175 "percentile_rank_A_pmi",
176 "percentile_rank_B_pmi",
Marc Kupietz28a29842025-10-18 12:25:09 +0200177 "delta_rank_logDice",
Marc Kupietz130a2a22025-10-18 16:09:23 +0200178 "delta_rank_pmi",
179 "delta_percentile_rank_logDice",
180 "delta_percentile_rank_pmi"
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200181 ) %in% colnames(enriched)))
182
183 expect_true(all(enriched$winner_logDice == "B"))
184 expect_true(all(enriched$runner_up_logDice == "A"))
185 expect_true(all(enriched$winner_logDice_value >= enriched$runner_up_logDice_value))
Marc Kupietz09b1c082026-05-01 14:45:47 +0200186 expect_true(all(enriched$winner_logDice_webUIRequestUrl == "https://korap.example/B"))
187 expect_true(all(enriched$loser_logDice_webUIRequestUrl == "https://korap.example/A"))
188 expect_true(all(enriched$winner_webUIRequestUrl == "https://korap.example/B"))
189 expect_true(all(enriched$loser_webUIRequestUrl == "https://korap.example/A"))
Marc Kupietz130a2a22025-10-18 16:09:23 +0200190 expect_true(all(enriched$percentile_rank_A_logDice == 1))
191 expect_true(all(enriched$percentile_rank_B_logDice == 1))
192 expect_true(all(enriched$delta_percentile_rank_logDice == 0))
Marc Kupietz5e35d7a2025-10-17 21:21:22 +0200193})
194
Marc Kupietz09b1c082026-05-01 14:45:47 +0200195test_that("add_multi_vc_comparisons fills missing label URLs from vc", {
196 sample_result <- tibble::tibble(
197 node = c("n", "n", "n"),
198 collocate = c("c1", "c2", "c2"),
199 vc = c("corpusSigle=/A/", "corpusSigle=/A/", "corpusSigle=/B/"),
200 label = c("A", "A", "B"),
201 N = c(100, 100, 100),
202 O = c(10, 10, 20),
203 O1 = c(50, 50, 50),
204 O2 = c(30, 30, 30),
205 E = c(5, 5, 5),
206 w = c(2, 2, 2),
207 leftContextSize = c(1, 1, 1),
208 rightContextSize = c(1, 1, 1),
209 frequency = c(10, 10, 20),
210 webUIRequestUrl = c(
211 "https://korap.example/?q=q1&cq=corpusSigle%3D%2FA%2F&ql=poliqarp",
212 "https://korap.example/?q=q2&cq=corpusSigle%3D%2FA%2F&ql=poliqarp",
213 "https://korap.example/?q=q2&cq=corpusSigle%3D%2FB%2F&ql=poliqarp"
214 ),
215 logDice = c(6, 5, 7),
216 pmi = c(3, 2, 4)
217 )
218
219 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
220 c1 <- enriched[enriched$collocate == "c1", ]
221 expected_b_url <- paste0(
222 "https://korap.example/?q=q1&cq=",
223 urltools::url_encode("corpusSigle=/B/"),
224 "&ql=poliqarp"
225 )
226
227 expect_equal(
228 unique(c1$loser_logDice_webUIRequestUrl),
229 expected_b_url
230 )
231 expect_equal(
232 unique(c1$loser_webUIRequestUrl),
233 expected_b_url
234 )
235})
236
Marc Kupietzb2862d42025-10-18 10:17:49 +0200237test_that("add_multi_vc_comparisons handles more than two labels", {
238 sample_result <- tibble::tibble(
239 node = rep("n", 3),
240 collocate = rep("c", 3),
241 vc = c("vc1", "vc2", "vc3"),
242 label = c("A", "B", "C"),
243 N = rep(100, 3),
244 O = c(10, 30, 5),
245 O1 = rep(50, 3),
246 O2 = rep(30, 3),
247 E = rep(5, 3),
248 w = rep(2, 3),
249 leftContextSize = rep(1, 3),
250 rightContextSize = rep(1, 3),
251 frequency = c(10, 30, 5),
Marc Kupietz09b1c082026-05-01 14:45:47 +0200252 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B", "https://korap.example/C"),
Marc Kupietzb2862d42025-10-18 10:17:49 +0200253 logDice = c(5, 8, 4),
254 pmi = c(2, 3, 1)
255 )
256
Marc Kupietz77852b22025-10-19 11:35:34 +0200257 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietzb2862d42025-10-18 10:17:49 +0200258 expect_equal(enriched$winner_logDice[1], "B")
259 expect_equal(enriched$winner_logDice_value[1], 8)
Marc Kupietz09b1c082026-05-01 14:45:47 +0200260 expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
Marc Kupietzb2862d42025-10-18 10:17:49 +0200261 expect_equal(enriched$runner_up_logDice[1], "A")
262 expect_equal(enriched$runner_up_logDice_value[1], 5)
263 expect_equal(enriched$loser_logDice[1], "C")
264 expect_equal(enriched$loser_logDice_value[1], 4)
Marc Kupietz09b1c082026-05-01 14:45:47 +0200265 expect_equal(enriched$loser_logDice_webUIRequestUrl[1], "https://korap.example/C")
Marc Kupietzb2862d42025-10-18 10:17:49 +0200266 expect_equal(enriched$max_delta_logDice[1], 4)
267})
268
Marc Kupietz09b1c082026-05-01 14:45:47 +0200269test_that("add_multi_vc_comparisons leaves unsuffixed URLs ambiguous when scores disagree", {
270 sample_result <- tibble::tibble(
271 node = c("n", "n"),
272 collocate = c("c", "c"),
273 vc = c("vc1", "vc2"),
274 label = c("A", "B"),
275 N = c(100, 100),
276 O = c(10, 20),
277 O1 = c(50, 50),
278 O2 = c(30, 30),
279 E = c(5, 5),
280 w = c(2, 2),
281 leftContextSize = c(1, 1),
282 rightContextSize = c(1, 1),
283 frequency = c(10, 20),
284 webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
285 logDice = c(5, 7),
286 pmi = c(4, 3)
287 )
288
289 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
290
291 expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
292 expect_equal(enriched$winner_pmi_webUIRequestUrl[1], "https://korap.example/A")
293 expect_true(is.na(enriched$winner_webUIRequestUrl[1]))
294 expect_true(is.na(enriched$loser_webUIRequestUrl[1]))
295})
296
Marc Kupietz28a29842025-10-18 12:25:09 +0200297test_that("add_multi_vc_comparisons computes rank deltas", {
298 base_tbl <- tidyr::expand_grid(
299 label = c("A", "B", "C"),
300 collocate = c("c1", "c2", "c3")
301 ) |>
302 dplyr::mutate(
303 node = "n",
304 vc = paste0("vc", label),
305 N = 100,
306 O = 10,
307 O1 = 50,
308 O2 = 40,
309 E = 5,
310 w = 2,
311 leftContextSize = 1,
312 rightContextSize = 1,
313 frequency = 10,
314 logDice = dplyr::case_when(
315 label == "A" & collocate == "c1" ~ 9,
316 label == "A" & collocate == "c2" ~ 6,
317 label == "A" & collocate == "c3" ~ 3,
318 label == "B" & collocate == "c1" ~ 7,
319 label == "B" & collocate == "c2" ~ 9,
320 label == "B" & collocate == "c3" ~ 5,
321 label == "C" & collocate == "c1" ~ 4,
322 label == "C" & collocate == "c2" ~ 6,
323 label == "C" & collocate == "c3" ~ 8,
324 TRUE ~ 0
325 )
326 )
327
Marc Kupietz77852b22025-10-19 11:35:34 +0200328 enriched <- RKorAPClient:::add_multi_vc_comparisons(base_tbl)
Marc Kupietz28a29842025-10-18 12:25:09 +0200329 target_row <- enriched |>
330 dplyr::filter(collocate == "c1") |>
331 dplyr::slice_head(n = 1)
332
333 expect_equal(target_row$rank_A_logDice, 1)
334 expect_equal(target_row$rank_B_logDice, 2)
335 expect_equal(target_row$rank_C_logDice, 3)
336 expect_equal(target_row$winner_rank_logDice, "A")
337 expect_equal(target_row$winner_rank_logDice_value, 1)
338 expect_equal(target_row$runner_up_rank_logDice, "B")
339 expect_equal(target_row$runner_up_rank_logDice_value, 2)
340 expect_equal(target_row$loser_rank_logDice, "C")
341 expect_equal(target_row$loser_rank_logDice_value, 3)
342 expect_equal(target_row$max_delta_rank_logDice, 2)
343})
344
345test_that("add_multi_vc_comparisons imputes missing ranks for max delta", {
346 sample_result <- tibble::tibble(
347 node = c("n", "n"),
348 collocate = c("c", "c"),
349 vc = c("vc1", "vc2"),
350 label = c("A", "B"),
351 N = c(100, 100),
352 O = c(10, 10),
353 O1 = c(50, 50),
354 O2 = c(30, 30),
355 E = c(5, 5),
356 w = c(2, 2),
357 leftContextSize = c(1, 1),
358 rightContextSize = c(1, 1),
359 frequency = c(10, 10),
360 logDice = c(5, NA)
361 )
362
Marc Kupietz77852b22025-10-19 11:35:34 +0200363 enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
Marc Kupietz28a29842025-10-18 12:25:09 +0200364
365 expect_equal(enriched$rank_A_logDice[1], 1)
366 expect_true(is.na(enriched$rank_B_logDice[1]))
367 expect_equal(enriched$winner_rank_logDice[1], "A")
368 expect_equal(enriched$loser_rank_logDice[1], "B")
369 expect_equal(enriched$loser_rank_logDice_value[1], 2)
370 expect_equal(enriched$max_delta_rank_logDice[1], 1)
371})
372
Marc Kupietz9894a372025-10-18 14:51:29 +0200373test_that("adaptive missing score imputation respects measure-specific scales", {
374 sample_result <- tibble::tibble(
375 node = c("n", "n", "n"),
376 collocate = c("c", "c", "c"),
377 vc = c("vc1", "vc2", "vc3"),
378 label = c("A", "B", "C"),
379 N = c(100, 100, 100),
380 O = c(12, 9, 7),
381 O1 = c(60, 40, 30),
382 O2 = c(33, 22, 18),
383 E = c(6, 6, 6),
384 w = c(2, 2, 2),
385 leftContextSize = c(1, 1, 1),
386 rightContextSize = c(1, 1, 1),
387 frequency = c(15, 11, 9),
388 logDice = c(-0.31, NA, -0.12),
389 pmi = c(-1.65, NA, -0.48),
390 ll = c(12.4, NA, 7.9)
391 )
392
393 enriched <- RKorAPClient:::add_multi_vc_comparisons(
394 sample_result,
Marc Kupietz9894a372025-10-18 14:51:29 +0200395 missingScoreQuantile = 0.05
396 )
397
398 row_a <- dplyr::filter(enriched, label == "A") |> dplyr::slice_head(n = 1)
399
400 expect_false(is.na(row_a$logDice_B))
401 expect_false(is.na(row_a$pmi_B))
402 expect_false(is.na(row_a$ll_B))
403
404 expect_lt(row_a$logDice_B, min(sample_result$logDice, na.rm = TRUE))
405 expect_lt(row_a$pmi_B, min(sample_result$pmi, na.rm = TRUE))
406 expect_lte(row_a$ll_B, min(sample_result$ll, na.rm = TRUE))
407
408 expect_gt(row_a$max_delta_logDice, 0)
409 expect_gt(row_a$winner_logDice_value - row_a$loser_logDice_value, 0)
410})
411
Marc Kupietz7de5f322025-06-04 17:17:22 +0200412# New tests for improved coverage of collocationAnalysis.R helper functions
413
414test_that("synsemanticStopwords returns German stopwords", {
415 stopwords <- synsemanticStopwords()
416 expect_true(is.character(stopwords))
417 expect_true(length(stopwords) > 50)
418 expect_true("der" %in% stopwords)
419 expect_true("die" %in% stopwords)
420 expect_true("und" %in% stopwords)
421 expect_true("mit" %in% stopwords)
422})
423
424test_that("removeWithinSpan removes span constraints correctly", {
425 # Test basic span removal
426 query1 <- "contains(<base/s=s>, (machen []{0,1} aufmerksam | aufmerksam []{0,1} machen))"
427 result1 <- RKorAPClient:::removeWithinSpan(query1, "base/s=s")
428 expect_equal(result1, "(machen []{0,1} aufmerksam | aufmerksam []{0,1} machen)")
429
430 # Test with different span
431 query2 <- "contains(<p/s=s>, (test query))"
432 result2 <- RKorAPClient:::removeWithinSpan(query2, "p/s=s")
433 expect_equal(result2, "(test query)")
434
435 # Test with empty span - should return original query
436 query3 <- "simple query"
437 result3 <- RKorAPClient:::removeWithinSpan(query3, "")
438 expect_equal(result3, query3)
439
440 # Test with non-matching span
441 query4 <- "contains(<base/s=s>, test)"
442 result4 <- RKorAPClient:::removeWithinSpan(query4, "other/span")
443 expect_equal(result4, query4)
444})
445
446test_that("matches2FreqTable handles empty matches", {
447 empty_matches <- data.frame()
448 result <- RKorAPClient:::matches2FreqTable(empty_matches, index = 0)
449
450 expect_true(is.data.frame(result))
451 expect_equal(nrow(result), 0)
452})
453
454test_that("matches2FreqTable processes single match correctly", {
455 # Create mock matches data
456 mock_matches <- data.frame(
457 tokens = I(list(list(
458 left = c("der", "große"),
459 match = "Test",
460 right = c("ist", "wichtig")
461 ))),
462 stringsAsFactors = FALSE
463 )
464
465 result <- RKorAPClient:::matches2FreqTable(
466 mock_matches,
467 index = 1,
468 leftContextSize = 2,
469 rightContextSize = 2,
470 stopwords = c("der", "ist") # Provide stopwords to avoid empty join
471 )
472
473 expect_true(is.data.frame(result))
474})
475
476test_that("snippet2FreqTable handles empty snippet", {
477 result <- RKorAPClient:::snippet2FreqTable(character(0))
478
479 expect_true(is.data.frame(result))
480 expect_equal(nrow(result), 0)
481})
482
483test_that("snippet2FreqTable processes single snippet correctly", {
484 snippet <- '<span class="context-left">der große </span><span class="match"><mark>Test</mark></span><span class="context-right"> ist wichtig</span>'
485
486 result <- RKorAPClient:::snippet2FreqTable(
487 snippet,
488 leftContextSize = 2,
489 rightContextSize = 2,
490 stopwords = c("der"), # Provide stopwords to avoid empty join
491 verbose = FALSE
492 )
493
494 expect_true(is.data.frame(result))
495})
496
Marc Kupietz0a292632025-10-19 14:04:36 +0200497test_that("inject_focus_into_query adds focus wrappers when span queries lack them", {
498 unfocused <- "contains(<base/s=s>, (Anspruch [tt/l=nehmen] | [tt/l=nehmen] Anspruch))"
499 focused <- RKorAPClient:::inject_focus_into_query(unfocused)
500
501 expect_equal(
502 focused,
503 "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]}) | focus({[tt/l=nehmen] Anspruch})))"
504 )
505})
506
507test_that("inject_focus_into_query leaves existing focus segments unchanged", {
508 already_focused <- "contains(<base/s=s>, (focus({Anspruch [tt/l=nehmen]})))"
509 expect_identical(
510 RKorAPClient:::inject_focus_into_query(already_focused),
511 already_focused
512 )
513})
514
Marc Kupietz7de5f322025-06-04 17:17:22 +0200515# Removed hanging findExample tests as they cause infinite wait
516# These tests make API calls that don't complete properly
517
518# Removed hanging collocatesQuery tests as they cause infinite wait
519# These tests were causing the test suite to hang and not terminate
520
521test_that("collocationAnalysis handles exactFrequencies parameter", {
522 skip_if_offline()
523 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
524
525 expect_warning(
526 result <- collocationAnalysis(
527 kco,
528 "Test",
529 exactFrequencies = TRUE,
530 searchHitsSampleLimit = 5,
531 topCollocatesLimit = 5
532 ),
533 "access token"
534 )
535 expect_true(is.data.frame(result))
536})
537
538test_that("collocationAnalysis handles withinSpan parameter", {
539 skip_if_offline()
540 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
541
542 expect_warning(
543 result <- collocationAnalysis(
544 kco,
545 "Test",
546 withinSpan = "base/s=s",
547 exactFrequencies = TRUE,
548 searchHitsSampleLimit = 5,
549 topCollocatesLimit = 5
550 ),
551 "access token"
552 )
553 expect_true(is.data.frame(result))
554})
555
556test_that("collocationAnalysis handles expand parameter", {
557 skip_if_offline()
558 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
559
560 expect_warning(
561 result <- collocationAnalysis(
562 kco,
563 c("Test", "der"),
564 expand = TRUE,
565 searchHitsSampleLimit = 2,
566 topCollocatesLimit = 2
567 ),
568 "access token"
569 )
570 expect_true(is.data.frame(result))
571})
572
Marc Kupietze34a8be2025-10-17 20:13:42 +0200573test_that("collocationAnalysis honors named vc labels", {
574 skip_if_offline()
575 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
576
577 named_vc <- c(
578 Western = "textType=/.*Western.*/ & pubDate in 2012",
579 Erotic = "textType=/.*(Erotik|Gay).*/ & pubDate in 2012",
580 Historic = "textType=/.*Historisch.*/ & pubDate in 2012"
581 )
582
583 expect_warning(
584 result <- collocationAnalysis(
585 kco,
586 "[tt/l=treffen]",
587 vc = named_vc,
588 searchHitsSampleLimit = 2,
589 topCollocatesLimit = 2
590 ),
591 "access token"
592 )
593
594 if (nrow(result) > 0) {
595 expect_true("label" %in% colnames(result))
596 expect_setequal(unique(result$label), names(named_vc))
597 }
598})
599
Marc Kupietz7de5f322025-06-04 17:17:22 +0200600test_that("collocationAnalysis handles stopwords parameter", {
601 skip_if_offline()
602 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
603
604 expect_warning(
605 result <- collocationAnalysis(
606 kco,
607 "Test",
608 stopwords = c("der", "die", "und"),
609 searchHitsSampleLimit = 5,
610 topCollocatesLimit = 5
611 ),
612 "access token"
613 )
614 expect_true(is.data.frame(result))
615})
616
617test_that("collocationAnalysis handles lemmatizeNodeQuery parameter", {
618 skip_if_offline()
619 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
620
621 expect_warning(
622 result <- collocationAnalysis(
623 kco,
624 "laufen",
625 lemmatizeNodeQuery = TRUE,
626 searchHitsSampleLimit = 5,
627 topCollocatesLimit = 5
628 ),
629 "access token"
630 )
631 expect_true(is.data.frame(result))
632})
633
634test_that("collocationAnalysis handles addExamples parameter", {
635 skip_if_offline()
636 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
637
638 expect_warning(
639 result <- collocationAnalysis(
640 kco,
641 "Test",
642 addExamples = TRUE,
643 searchHitsSampleLimit = 3,
644 topCollocatesLimit = 3
645 ),
646 "access token"
647 )
648 expect_true(is.data.frame(result))
649 if (nrow(result) > 0) {
650 expect_true("example" %in% colnames(result))
651 }
652})
653
654test_that("collocationAnalysis handles maxRecurse parameter", {
655 skip_if_offline()
656 kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = FALSE)
657
658 expect_warning(
659 result <- collocationAnalysis(
660 kco,
661 "Test",
662 maxRecurse = 1,
663 searchHitsSampleLimit = 2,
664 topCollocatesLimit = 2
665 ),
666 "access token"
667 )
668 expect_true(is.data.frame(result))
669})