| Marc Kupietz | dbd431a | 2021-08-29 12:17:45 +0200 | [diff] [blame] | 1 | test_that("collocationScoreQuery works", { |
| Marc Kupietz | 83d0af3 | 2022-02-24 12:49:28 +0100 | [diff] [blame] | 2 | skip_if_offline() |
| Marc Kupietz | 617266d | 2025-02-27 10:43:07 +0100 | [diff] [blame] | 3 | kco <- KorAPConnection(accessToken = NULL, cache = TRUE, verbose = TRUE) |
| Marc Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 4 | df <- collocationScoreQuery(kco, "Ameisenplage", "heimgesucht", leftContextSize = 0, rightContextSize = 1) |
| Marc Kupietz | dbd431a | 2021-08-29 12:17:45 +0200 | [diff] [blame] | 5 | 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 Kupietz | 581a29b | 2021-09-04 20:51:04 +0200 | [diff] [blame] | 13 | |
| 14 | test_that("collocationAnalysis works and warns about missing token", { |
| Marc Kupietz | 83d0af3 | 2022-02-24 12:49:28 +0100 | [diff] [blame] | 15 | skip_if_offline() |
| Marc Kupietz | 617266d | 2025-02-27 10:43:07 +0100 | [diff] [blame] | 16 | kco <- KorAPConnection( |
| Marc Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 17 | 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 Kupietz | dbd431a | 2021-08-29 12:17:45 +0200 | [diff] [blame] | 30 | expect_gt(df$O, df$E) |
| Marc Kupietz | f912959 | 2025-01-26 19:17:54 +0100 | [diff] [blame] | 31 | expect_gt(df$logDice, -1) |
| Marc Kupietz | dbd431a | 2021-08-29 12:17:45 +0200 | [diff] [blame] | 32 | }) |
| 33 | |
| 34 | test_that("collocationAnalysis on unaccounted strings does not error out", { |
| Marc Kupietz | 83d0af3 | 2022-02-24 12:49:28 +0100 | [diff] [blame] | 35 | skip_if_offline() |
| Marc Kupietz | 617266d | 2025-02-27 10:43:07 +0100 | [diff] [blame] | 36 | kco <- KorAPConnection(accessToken = NULL, verbose = TRUE) |
| Marc Kupietz | 581a29b | 2021-09-04 20:51:04 +0200 | [diff] [blame] | 37 | expect_warning( |
| Marc Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 38 | df <- collocationAnalysis(kco, "XXXXXXXXAmeisenplage", vc = c("corpusSigle=/WDD17/", "corpusSigle=/WUD17/"), maxRecurse = 2), |
| Marc Kupietz | 581a29b | 2021-09-04 20:51:04 +0200 | [diff] [blame] | 39 | "access token" |
| 40 | ) |
| Marc Kupietz | dbd431a | 2021-08-29 12:17:45 +0200 | [diff] [blame] | 41 | testthat::expect_equal(nrow(df), 0) |
| 42 | }) |
| Marc Kupietz | d6314b6 | 2021-12-22 12:49:09 +0100 | [diff] [blame] | 43 | |
| Marc Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 44 | # test_that("removeWithinSpanWorks", { |
| Marc Kupietz | 76dee31 | 2025-04-06 16:24:47 +0200 | [diff] [blame] | 45 | # 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 Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 48 | # }) |
| Marc Kupietz | dbdbb1f | 2025-02-19 10:33:06 +0100 | [diff] [blame] | 49 | |
| 50 | |
| 51 | test_that("mergeDuplicateCollocatesWorksAsExpected", { |
| Marc Kupietz | 5057f50 | 2025-04-06 16:55:57 +0200 | [diff] [blame] | 52 | ldf <- tibble::tibble( |
| Marc Kupietz | dbdbb1f | 2025-02-19 10:33:06 +0100 | [diff] [blame] | 53 | 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 Kupietz | 5057f50 | 2025-04-06 16:55:57 +0200 | [diff] [blame] | 75 | rdf <- tibble::tibble( |
| Marc Kupietz | dbdbb1f | 2025-02-19 10:33:06 +0100 | [diff] [blame] | 76 | 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 Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 104 | |
| Marc Kupietz | 5e35d7a | 2025-10-17 21:21:22 +0200 | [diff] [blame] | 105 | test_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 Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 120 | webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"), |
| Marc Kupietz | 5e35d7a | 2025-10-17 21:21:22 +0200 | [diff] [blame] | 121 | logDice = c(5, 7), |
| 122 | pmi = c(2, 3) |
| 123 | ) |
| 124 | |
| Marc Kupietz | 77852b2 | 2025-10-19 11:35:34 +0200 | [diff] [blame] | 125 | enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result) |
| Marc Kupietz | 5e35d7a | 2025-10-17 21:21:22 +0200 | [diff] [blame] | 126 | |
| 127 | expect_true(all(c( |
| 128 | "winner_logDice", |
| 129 | "winner_logDice_value", |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 130 | "winner_logDice_webUIRequestUrl", |
| 131 | "winner_webUIRequestUrl", |
| Marc Kupietz | 5e35d7a | 2025-10-17 21:21:22 +0200 | [diff] [blame] | 132 | "runner_up_logDice", |
| Marc Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 133 | "runner_up_logDice_value", |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 134 | "loser_logDice_webUIRequestUrl", |
| 135 | "loser_webUIRequestUrl", |
| Marc Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 136 | "max_delta_logDice", |
| 137 | "winner_rank_logDice", |
| 138 | "winner_rank_logDice_value", |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 139 | "winner_rank_logDice_webUIRequestUrl", |
| Marc Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 140 | "runner_up_rank_logDice", |
| 141 | "runner_up_rank_logDice_value", |
| 142 | "loser_rank_logDice", |
| 143 | "loser_rank_logDice_value", |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 144 | "loser_rank_logDice_webUIRequestUrl", |
| Marc Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 145 | "max_delta_rank_logDice", |
| Marc Kupietz | 130a2a2 | 2025-10-18 16:09:23 +0200 | [diff] [blame] | 146 | "winner_percentile_rank_logDice", |
| 147 | "winner_percentile_rank_logDice_value", |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 148 | "winner_percentile_rank_logDice_webUIRequestUrl", |
| Marc Kupietz | 130a2a2 | 2025-10-18 16:09:23 +0200 | [diff] [blame] | 149 | "runner_up_percentile_rank_logDice", |
| 150 | "runner_up_percentile_rank_logDice_value", |
| 151 | "loser_percentile_rank_logDice", |
| 152 | "loser_percentile_rank_logDice_value", |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 153 | "loser_percentile_rank_logDice_webUIRequestUrl", |
| Marc Kupietz | 130a2a2 | 2025-10-18 16:09:23 +0200 | [diff] [blame] | 154 | "max_delta_percentile_rank_logDice", |
| Marc Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 155 | "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 Kupietz | 130a2a2 | 2025-10-18 16:09:23 +0200 | [diff] [blame] | 162 | "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 Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 169 | "rank_A_logDice", |
| 170 | "rank_B_logDice", |
| 171 | "rank_A_pmi", |
| 172 | "rank_B_pmi", |
| Marc Kupietz | 130a2a2 | 2025-10-18 16:09:23 +0200 | [diff] [blame] | 173 | "percentile_rank_A_logDice", |
| 174 | "percentile_rank_B_logDice", |
| 175 | "percentile_rank_A_pmi", |
| 176 | "percentile_rank_B_pmi", |
| Marc Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 177 | "delta_rank_logDice", |
| Marc Kupietz | 130a2a2 | 2025-10-18 16:09:23 +0200 | [diff] [blame] | 178 | "delta_rank_pmi", |
| 179 | "delta_percentile_rank_logDice", |
| 180 | "delta_percentile_rank_pmi" |
| Marc Kupietz | 5e35d7a | 2025-10-17 21:21:22 +0200 | [diff] [blame] | 181 | ) %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 Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 186 | 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 Kupietz | 130a2a2 | 2025-10-18 16:09:23 +0200 | [diff] [blame] | 190 | 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 Kupietz | 5e35d7a | 2025-10-17 21:21:22 +0200 | [diff] [blame] | 193 | }) |
| 194 | |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 195 | test_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 Kupietz | b2862d4 | 2025-10-18 10:17:49 +0200 | [diff] [blame] | 237 | test_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 Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 252 | webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B", "https://korap.example/C"), |
| Marc Kupietz | b2862d4 | 2025-10-18 10:17:49 +0200 | [diff] [blame] | 253 | logDice = c(5, 8, 4), |
| 254 | pmi = c(2, 3, 1) |
| 255 | ) |
| 256 | |
| Marc Kupietz | 77852b2 | 2025-10-19 11:35:34 +0200 | [diff] [blame] | 257 | enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result) |
| Marc Kupietz | b2862d4 | 2025-10-18 10:17:49 +0200 | [diff] [blame] | 258 | expect_equal(enriched$winner_logDice[1], "B") |
| 259 | expect_equal(enriched$winner_logDice_value[1], 8) |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 260 | expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B") |
| Marc Kupietz | b2862d4 | 2025-10-18 10:17:49 +0200 | [diff] [blame] | 261 | 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 Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 265 | expect_equal(enriched$loser_logDice_webUIRequestUrl[1], "https://korap.example/C") |
| Marc Kupietz | b2862d4 | 2025-10-18 10:17:49 +0200 | [diff] [blame] | 266 | expect_equal(enriched$max_delta_logDice[1], 4) |
| 267 | }) |
| 268 | |
| Marc Kupietz | 09b1c08 | 2026-05-01 14:45:47 +0200 | [diff] [blame] | 269 | test_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 Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 297 | test_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 Kupietz | 77852b2 | 2025-10-19 11:35:34 +0200 | [diff] [blame] | 328 | enriched <- RKorAPClient:::add_multi_vc_comparisons(base_tbl) |
| Marc Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 329 | 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 | |
| 345 | test_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 Kupietz | 77852b2 | 2025-10-19 11:35:34 +0200 | [diff] [blame] | 363 | enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result) |
| Marc Kupietz | 28a2984 | 2025-10-18 12:25:09 +0200 | [diff] [blame] | 364 | |
| 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 Kupietz | 9894a37 | 2025-10-18 14:51:29 +0200 | [diff] [blame] | 373 | test_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 Kupietz | 9894a37 | 2025-10-18 14:51:29 +0200 | [diff] [blame] | 395 | 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 Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 412 | # New tests for improved coverage of collocationAnalysis.R helper functions |
| 413 | |
| 414 | test_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 | |
| 424 | test_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 | |
| 446 | test_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 | |
| 454 | test_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 | |
| 476 | test_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 | |
| 483 | test_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 Kupietz | 0a29263 | 2025-10-19 14:04:36 +0200 | [diff] [blame] | 497 | test_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 | |
| 507 | test_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 Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 515 | # 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 | |
| 521 | test_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 | |
| 538 | test_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 | |
| 556 | test_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 Kupietz | e34a8be | 2025-10-17 20:13:42 +0200 | [diff] [blame] | 573 | test_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 Kupietz | 7de5f32 | 2025-06-04 17:17:22 +0200 | [diff] [blame] | 600 | test_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 | |
| 617 | test_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 | |
| 634 | test_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 | |
| 654 | test_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 | }) |