Add winner and loser URLs to multi-VC collocation comparisons
Change-Id: Ia3bea5f400713c6b513e1cc1033c9c5c869d957f
diff --git a/NEWS.md b/NEWS.md
index bfa6f18..fb7af2b 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -3,7 +3,7 @@
- added `cacheAs` parameter to `collocationAnalysis()` for transparent result caching: if the specified RDS file exists, the cached result is returned immediately; otherwise the analysis runs and the result is saved to the file (`.rds` extension is added automatically if omitted)
- fixed score threshold in recursive CA
- focus is now injected into webUIRequestUrls in collocationAnalysis results, when possible
-- added support for comparing collocation analyses across multiple vcs (`max_delta_<score>`, `winner<score>`, `loser_score<score>` columns etc.)
+- added support for comparing collocation analyses across multiple vcs (`max_delta_<score>`, `winner<score>`, `loser_score<score>` columns etc.), including explicit winner/loser `webUIRequestUrl` columns for association scores, ranks, and percentile ranks. Missing per-label concordance URLs are now derived by replacing the `cq` parameter of an available row URL with the target label's vc, and unsuffixed consensus `winner_webUIRequestUrl` / `loser_webUIRequestUrl` columns are populated when score-based URL choices agree
- added support for passing condition labels when comparing multiple vcs by allowing for named vc lists
# RKorAPClient 1.2.1
diff --git a/R/collocationAnalysis.R b/R/collocationAnalysis.R
index 806eb7f..81ca661 100644
--- a/R/collocationAnalysis.R
+++ b/R/collocationAnalysis.R
@@ -59,7 +59,7 @@
#' \item Per-labelled association scores produced by multi-VC comparisons using the pattern \code{<measure>_<label>}.
#' \item Ranks per label/measure with the pattern \code{rank_<label>_<measure>} (1 is best) and the corresponding percentile ranks \code{percentile_rank_<label>_<measure>}.
#' \item Pairwise contrasts for two-label comparisons, e.g. \code{delta_<measure>}, \code{delta_rank_<measure>}, and \code{delta_percentile_rank_<measure>}.
-#' \item Summary columns describing the strongest labels per measure (\code{winner_*}, \code{runner_up_*}, \code{loser_*}, and \code{max_delta_*}).
+#' \item Summary columns describing the strongest labels per measure (\code{winner_*}, \code{runner_up_*}, \code{loser_*}, and \code{max_delta_*}), including winner/loser \code{webUIRequestUrl} columns. In multi-VC comparisons, missing per-label concordance URLs are derived from another available row URL for the same \code{node}/\code{collocate} by replacing the \code{cq} parameter with the target label's virtual corpus. Unsuffixed \code{winner_webUIRequestUrl} and \code{loser_webUIRequestUrl} columns are populated only when the score-based URL choices agree.
#' \item Optional helper columns such as \code{query}, \code{example}, or \code{url} when example retrieval is requested.
#' }
#' @importFrom dplyr arrange desc slice_head bind_rows group_by mutate ungroup left_join select row_number all_of first
@@ -535,7 +535,7 @@
}
add_multi_vc_comparisons <- function(result, missingScoreQuantile = 0.05) {
- label <- node <- collocate <- NULL
+ label <- node <- collocate <- vc <- webUIRequestUrl <- NULL
if (!"label" %in% names(result) || dplyr::n_distinct(result$label) < 2) {
return(result)
@@ -625,6 +625,70 @@
raw_labels <- unique(result$label)
labels <- make.names(raw_labels)
label_map <- stats::setNames(raw_labels, labels)
+ vc_map <- result |>
+ dplyr::select(label, vc) |>
+ dplyr::filter(!is.na(label), label != "") |>
+ dplyr::distinct(label, .keep_all = TRUE)
+ vc_map <- stats::setNames(vc_map$vc, make.names(vc_map$label))
+
+ replace_web_ui_cq <- function(url, vc_value) {
+ if (length(url) == 0 || is.na(url) || url == "") {
+ return(NA_character_)
+ }
+ if (length(vc_value) == 0 || is.na(vc_value)) {
+ vc_value <- ""
+ }
+ encoded_vc <- urltools::url_encode(enc2utf8(as.character(vc_value)))
+ if (grepl("([?&]cq=)[^&]*", url, perl = TRUE)) {
+ return(sub("([?&]cq=)[^&]*", paste0("\\1", encoded_vc), url, perl = TRUE))
+ }
+ if (encoded_vc == "") {
+ return(url)
+ }
+ paste0(url, ifelse(grepl("\\?", url), "&", "?"), "cq=", encoded_vc)
+ }
+
+ if ("webUIRequestUrl" %in% names(result)) {
+ url_data <- result |>
+ dplyr::select(node, collocate, label, webUIRequestUrl) |>
+ tidyr::pivot_wider(
+ names_from = label,
+ values_from = webUIRequestUrl,
+ names_glue = "webUIRequestUrl_{make.names(label)}",
+ values_fn = dplyr::first
+ )
+
+ comparison <- dplyr::left_join(comparison, url_data, by = c("node", "collocate"))
+
+ url_cols <- paste0("webUIRequestUrl_", labels)
+ present_url_cols <- intersect(url_cols, names(comparison))
+ fallback_urls <- vapply(seq_len(nrow(comparison)), function(i) {
+ urls <- unlist(comparison[i, present_url_cols, drop = FALSE], use.names = FALSE)
+ urls <- as.character(urls)
+ urls <- urls[!is.na(urls) & urls != ""]
+ if (length(urls) == 0) {
+ NA_character_
+ } else {
+ urls[1]
+ }
+ }, character(1))
+
+ for (safe_label in labels) {
+ url_col <- paste0("webUIRequestUrl_", safe_label)
+ if (!url_col %in% names(comparison)) {
+ comparison[[url_col]] <- NA_character_
+ }
+ missing_urls <- is.na(comparison[[url_col]]) | comparison[[url_col]] == ""
+ if (any(missing_urls)) {
+ comparison[[url_col]][missing_urls] <- vapply(
+ fallback_urls[missing_urls],
+ replace_web_ui_cq,
+ character(1),
+ vc_value = vc_map[[safe_label]]
+ )
+ }
+ }
+ }
rank_data <- result |>
dplyr::distinct(node, collocate)
@@ -698,6 +762,18 @@
paste(unique(labs), collapse = ", ")
}
+ collapse_url_values <- function(indices, url_values) {
+ if (length(indices) == 0 || is.null(url_values)) {
+ return(NA_character_)
+ }
+ urls <- as.character(url_values[indices])
+ urls <- urls[!is.na(urls) & urls != ""]
+ if (length(urls) == 0) {
+ return(NA_character_)
+ }
+ paste(unique(urls), collapse = ", ")
+ }
+
if (length(labels) == 2) {
fill_scores <- function(x, y, measure_col) {
replacement <- score_replacements[[measure_col]]
@@ -810,19 +886,30 @@
winner_label_col <- paste0("winner_", col)
winner_value_col <- paste0("winner_", col, "_value")
+ winner_url_col <- paste0("winner_", col, "_webUIRequestUrl")
runner_label_col <- paste0("runner_up_", col)
runner_value_col <- paste0("runner_up_", col, "_value")
loser_label_col <- paste0("loser_", col)
loser_value_col <- paste0("loser_", col, "_value")
+ loser_url_col <- paste0("loser_", col, "_webUIRequestUrl")
max_delta_col <- paste0("max_delta_", col)
+ url_cols <- paste0("webUIRequestUrl_", safe_labels)
+ has_urls <- all(url_cols %in% names(comparison))
+ url_values <- if (has_urls) comparison[, url_cols, drop = FALSE] else NULL
if (nrow(score_values) == 0) {
comparison[[winner_label_col]] <- character(0)
comparison[[winner_value_col]] <- numeric(0)
+ if (has_urls) {
+ comparison[[winner_url_col]] <- character(0)
+ }
comparison[[runner_label_col]] <- character(0)
comparison[[runner_value_col]] <- numeric(0)
comparison[[loser_label_col]] <- character(0)
comparison[[loser_value_col]] <- numeric(0)
+ if (has_urls) {
+ comparison[[loser_url_col]] <- character(0)
+ }
comparison[[max_delta_col]] <- numeric(0)
next
}
@@ -833,10 +920,12 @@
n_rows <- nrow(score_matrix)
winner_labels <- rep(NA_character_, n_rows)
winner_values <- rep(NA_real_, n_rows)
+ winner_urls <- rep(NA_character_, n_rows)
runner_labels <- rep(NA_character_, n_rows)
runner_values <- rep(NA_real_, n_rows)
loser_labels <- rep(NA_character_, n_rows)
loser_values <- rep(NA_real_, n_rows)
+ loser_urls <- rep(NA_character_, n_rows)
max_deltas <- rep(NA_real_, n_rows)
if (n_rows > 0) {
@@ -868,6 +957,9 @@
max_idx <- which(numeric_row == max_val)
winner_labels[i] <- collapse_label_values(max_idx, safe_labels)
winner_values[i] <- max_val
+ if (has_urls) {
+ winner_urls[i] <- collapse_url_values(max_idx, url_values[i, ])
+ }
unique_vals <- sort(unique(numeric_row), decreasing = TRUE)
if (length(unique_vals) >= 2) {
@@ -881,6 +973,9 @@
min_idx <- which(numeric_row == min_val)
loser_labels[i] <- collapse_label_values(min_idx, safe_labels)
loser_values[i] <- min_val
+ if (has_urls) {
+ loser_urls[i] <- collapse_url_values(min_idx, url_values[i, ])
+ }
if (is.finite(max_val) && is.finite(min_val)) {
max_deltas[i] <- max_val - min_val
@@ -891,10 +986,16 @@
comparison[, value_cols] <- score_matrix
comparison[[winner_label_col]] <- winner_labels
comparison[[winner_value_col]] <- winner_values
+ if (has_urls) {
+ comparison[[winner_url_col]] <- winner_urls
+ }
comparison[[runner_label_col]] <- runner_labels
comparison[[runner_value_col]] <- runner_values
comparison[[loser_label_col]] <- loser_labels
comparison[[loser_value_col]] <- loser_values
+ if (has_urls) {
+ comparison[[loser_url_col]] <- loser_urls
+ }
comparison[[max_delta_col]] <- max_deltas
}
@@ -910,19 +1011,30 @@
winner_rank_label_col <- paste0("winner_rank_", col)
winner_rank_value_col <- paste0("winner_rank_", col, "_value")
+ winner_rank_url_col <- paste0("winner_rank_", col, "_webUIRequestUrl")
runner_rank_label_col <- paste0("runner_up_rank_", col)
runner_rank_value_col <- paste0("runner_up_rank_", col, "_value")
loser_rank_label_col <- paste0("loser_rank_", col)
loser_rank_value_col <- paste0("loser_rank_", col, "_value")
+ loser_rank_url_col <- paste0("loser_rank_", col, "_webUIRequestUrl")
max_delta_rank_col <- paste0("max_delta_rank_", col)
+ url_cols <- paste0("webUIRequestUrl_", safe_labels)
+ has_urls <- all(url_cols %in% names(comparison))
+ url_values <- if (has_urls) comparison[, url_cols, drop = FALSE] else NULL
if (nrow(rank_values) == 0) {
comparison[[winner_rank_label_col]] <- character(0)
comparison[[winner_rank_value_col]] <- numeric(0)
+ if (has_urls) {
+ comparison[[winner_rank_url_col]] <- character(0)
+ }
comparison[[runner_rank_label_col]] <- character(0)
comparison[[runner_rank_value_col]] <- numeric(0)
comparison[[loser_rank_label_col]] <- character(0)
comparison[[loser_rank_value_col]] <- numeric(0)
+ if (has_urls) {
+ comparison[[loser_rank_url_col]] <- character(0)
+ }
comparison[[max_delta_rank_col]] <- numeric(0)
next
}
@@ -933,10 +1045,12 @@
n_rows <- nrow(rank_matrix)
winner_labels <- rep(NA_character_, n_rows)
winner_values <- rep(NA_real_, n_rows)
+ winner_urls <- rep(NA_character_, n_rows)
runner_labels <- rep(NA_character_, n_rows)
runner_values <- rep(NA_real_, n_rows)
loser_labels <- rep(NA_character_, n_rows)
loser_values <- rep(NA_real_, n_rows)
+ loser_urls <- rep(NA_character_, n_rows)
max_deltas <- rep(NA_real_, n_rows)
for (i in seq_len(n_rows)) {
@@ -960,6 +1074,9 @@
min_positions <- valid_idx[which(valid_values == min_val)]
winner_labels[i] <- collapse_label_values(min_positions, safe_labels)
winner_values[i] <- min_val
+ if (has_urls) {
+ winner_urls[i] <- collapse_url_values(min_positions, url_values[i, ])
+ }
ordered_vals <- sort(unique(valid_values), decreasing = FALSE)
if (length(ordered_vals) >= 2) {
@@ -973,6 +1090,9 @@
max_positions <- valid_idx[which(valid_values == max_val)]
loser_labels[i] <- collapse_label_values(max_positions, safe_labels)
loser_values[i] <- max_val
+ if (has_urls) {
+ loser_urls[i] <- collapse_url_values(max_positions, url_values[i, ])
+ }
if (is.finite(max_val) && is.finite(min_val)) {
max_deltas[i] <- max_val - min_val
@@ -981,10 +1101,16 @@
comparison[[winner_rank_label_col]] <- winner_labels
comparison[[winner_rank_value_col]] <- winner_values
+ if (has_urls) {
+ comparison[[winner_rank_url_col]] <- winner_urls
+ }
comparison[[runner_rank_label_col]] <- runner_labels
comparison[[runner_rank_value_col]] <- runner_values
comparison[[loser_rank_label_col]] <- loser_labels
comparison[[loser_rank_value_col]] <- loser_values
+ if (has_urls) {
+ comparison[[loser_rank_url_col]] <- loser_urls
+ }
comparison[[max_delta_rank_col]] <- max_deltas
}
@@ -1000,19 +1126,30 @@
winner_pct_label_col <- paste0("winner_percentile_rank_", col)
winner_pct_value_col <- paste0("winner_percentile_rank_", col, "_value")
+ winner_pct_url_col <- paste0("winner_percentile_rank_", col, "_webUIRequestUrl")
runner_pct_label_col <- paste0("runner_up_percentile_rank_", col)
runner_pct_value_col <- paste0("runner_up_percentile_rank_", col, "_value")
loser_pct_label_col <- paste0("loser_percentile_rank_", col)
loser_pct_value_col <- paste0("loser_percentile_rank_", col, "_value")
+ loser_pct_url_col <- paste0("loser_percentile_rank_", col, "_webUIRequestUrl")
max_delta_pct_col <- paste0("max_delta_percentile_rank_", col)
+ url_cols <- paste0("webUIRequestUrl_", safe_labels)
+ has_urls <- all(url_cols %in% names(comparison))
+ url_values <- if (has_urls) comparison[, url_cols, drop = FALSE] else NULL
if (nrow(pct_values) == 0) {
comparison[[winner_pct_label_col]] <- character(0)
comparison[[winner_pct_value_col]] <- numeric(0)
+ if (has_urls) {
+ comparison[[winner_pct_url_col]] <- character(0)
+ }
comparison[[runner_pct_label_col]] <- character(0)
comparison[[runner_pct_value_col]] <- numeric(0)
comparison[[loser_pct_label_col]] <- character(0)
comparison[[loser_pct_value_col]] <- numeric(0)
+ if (has_urls) {
+ comparison[[loser_pct_url_col]] <- character(0)
+ }
comparison[[max_delta_pct_col]] <- numeric(0)
next
}
@@ -1023,10 +1160,12 @@
n_rows <- nrow(pct_matrix)
winner_labels <- rep(NA_character_, n_rows)
winner_values <- rep(NA_real_, n_rows)
+ winner_urls <- rep(NA_character_, n_rows)
runner_labels <- rep(NA_character_, n_rows)
runner_values <- rep(NA_real_, n_rows)
loser_labels <- rep(NA_character_, n_rows)
loser_values <- rep(NA_real_, n_rows)
+ loser_urls <- rep(NA_character_, n_rows)
max_deltas <- rep(NA_real_, n_rows)
if (n_rows > 0) {
@@ -1045,6 +1184,9 @@
max_idx <- which(numeric_row == max_val)
winner_labels[i] <- collapse_label_values(max_idx, safe_labels)
winner_values[i] <- max_val
+ if (has_urls) {
+ winner_urls[i] <- collapse_url_values(max_idx, url_values[i, ])
+ }
unique_vals <- sort(unique(numeric_row), decreasing = TRUE)
if (length(unique_vals) >= 2) {
@@ -1058,6 +1200,9 @@
min_idx <- which(numeric_row == min_val)
loser_labels[i] <- collapse_label_values(min_idx, safe_labels)
loser_values[i] <- min_val
+ if (has_urls) {
+ loser_urls[i] <- collapse_url_values(min_idx, url_values[i, ])
+ }
if (is.finite(max_val) && is.finite(min_val)) {
max_deltas[i] <- max_val - min_val
@@ -1068,13 +1213,50 @@
comparison[, pct_cols] <- pct_matrix
comparison[[winner_pct_label_col]] <- winner_labels
comparison[[winner_pct_value_col]] <- winner_values
+ if (has_urls) {
+ comparison[[winner_pct_url_col]] <- winner_urls
+ }
comparison[[runner_pct_label_col]] <- runner_labels
comparison[[runner_pct_value_col]] <- runner_values
comparison[[loser_pct_label_col]] <- loser_labels
comparison[[loser_pct_value_col]] <- loser_values
+ if (has_urls) {
+ comparison[[loser_pct_url_col]] <- loser_urls
+ }
comparison[[max_delta_pct_col]] <- max_deltas
}
+ collapse_consensus_url_columns <- function(url_cols) {
+ if (length(url_cols) == 0) {
+ return(rep(NA_character_, nrow(comparison)))
+ }
+ vapply(seq_len(nrow(comparison)), function(i) {
+ urls <- unlist(comparison[i, url_cols, drop = FALSE], use.names = FALSE)
+ urls <- as.character(urls)
+ urls <- urls[!is.na(urls) & urls != ""]
+ urls <- unique(urls)
+ if (length(urls) == 1) {
+ urls
+ } else {
+ NA_character_
+ }
+ }, character(1))
+ }
+
+ winner_score_url_cols <- intersect(paste0("winner_", score_cols, "_webUIRequestUrl"), names(comparison))
+ loser_score_url_cols <- intersect(paste0("loser_", score_cols, "_webUIRequestUrl"), names(comparison))
+ if (length(winner_score_url_cols) > 0) {
+ comparison$winner_webUIRequestUrl <- collapse_consensus_url_columns(winner_score_url_cols)
+ }
+ if (length(loser_score_url_cols) > 0) {
+ comparison$loser_webUIRequestUrl <- collapse_consensus_url_columns(loser_score_url_cols)
+ }
+
+ url_helper_cols <- intersect(paste0("webUIRequestUrl_", labels), names(comparison))
+ if (length(url_helper_cols) > 0) {
+ comparison <- dplyr::select(comparison, -dplyr::all_of(url_helper_cols))
+ }
+
dplyr::left_join(result, comparison, by = c("node", "collocate"))
}
diff --git a/man/collocationAnalysis-KorAPConnection-method.Rd b/man/collocationAnalysis-KorAPConnection-method.Rd
index 095ffeb..109bce1 100644
--- a/man/collocationAnalysis-KorAPConnection-method.Rd
+++ b/man/collocationAnalysis-KorAPConnection-method.Rd
@@ -98,7 +98,7 @@
\item Per-labelled association scores produced by multi-VC comparisons using the pattern \code{<measure>_<label>}.
\item Ranks per label/measure with the pattern \code{rank_<label>_<measure>} (1 is best) and the corresponding percentile ranks \code{percentile_rank_<label>_<measure>}.
\item Pairwise contrasts for two-label comparisons, e.g. \code{delta_<measure>}, \code{delta_rank_<measure>}, and \code{delta_percentile_rank_<measure>}.
-\item Summary columns describing the strongest labels per measure (\code{winner_*}, \code{runner_up_*}, \code{loser_*}, and \code{max_delta_*}).
+\item Summary columns describing the strongest labels per measure (\code{winner_*}, \code{runner_up_*}, \code{loser_*}, and \code{max_delta_*}), including winner/loser \code{webUIRequestUrl} columns. In multi-VC comparisons, missing per-label concordance URLs are derived from another available row URL for the same \code{node}/\code{collocate} by replacing the \code{cq} parameter with the target label's virtual corpus. Unsuffixed \code{winner_webUIRequestUrl} and \code{loser_webUIRequestUrl} columns are populated only when the score-based URL choices agree.
\item Optional helper columns such as \code{query}, \code{example}, or \code{url} when example retrieval is requested.
}
}
diff --git a/tests/testthat/test-collocations.R b/tests/testthat/test-collocations.R
index 14508f6..0d5dd3e 100644
--- a/tests/testthat/test-collocations.R
+++ b/tests/testthat/test-collocations.R
@@ -117,6 +117,7 @@
leftContextSize = c(1, 1),
rightContextSize = c(1, 1),
frequency = c(10, 20),
+ webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
logDice = c(5, 7),
pmi = c(2, 3)
)
@@ -126,22 +127,30 @@
expect_true(all(c(
"winner_logDice",
"winner_logDice_value",
+ "winner_logDice_webUIRequestUrl",
+ "winner_webUIRequestUrl",
"runner_up_logDice",
"runner_up_logDice_value",
+ "loser_logDice_webUIRequestUrl",
+ "loser_webUIRequestUrl",
"max_delta_logDice",
"winner_rank_logDice",
"winner_rank_logDice_value",
+ "winner_rank_logDice_webUIRequestUrl",
"runner_up_rank_logDice",
"runner_up_rank_logDice_value",
"loser_rank_logDice",
"loser_rank_logDice_value",
+ "loser_rank_logDice_webUIRequestUrl",
"max_delta_rank_logDice",
"winner_percentile_rank_logDice",
"winner_percentile_rank_logDice_value",
+ "winner_percentile_rank_logDice_webUIRequestUrl",
"runner_up_percentile_rank_logDice",
"runner_up_percentile_rank_logDice_value",
"loser_percentile_rank_logDice",
"loser_percentile_rank_logDice_value",
+ "loser_percentile_rank_logDice_webUIRequestUrl",
"max_delta_percentile_rank_logDice",
"winner_rank_pmi",
"winner_rank_pmi_value",
@@ -174,11 +183,57 @@
expect_true(all(enriched$winner_logDice == "B"))
expect_true(all(enriched$runner_up_logDice == "A"))
expect_true(all(enriched$winner_logDice_value >= enriched$runner_up_logDice_value))
+ expect_true(all(enriched$winner_logDice_webUIRequestUrl == "https://korap.example/B"))
+ expect_true(all(enriched$loser_logDice_webUIRequestUrl == "https://korap.example/A"))
+ expect_true(all(enriched$winner_webUIRequestUrl == "https://korap.example/B"))
+ expect_true(all(enriched$loser_webUIRequestUrl == "https://korap.example/A"))
expect_true(all(enriched$percentile_rank_A_logDice == 1))
expect_true(all(enriched$percentile_rank_B_logDice == 1))
expect_true(all(enriched$delta_percentile_rank_logDice == 0))
})
+test_that("add_multi_vc_comparisons fills missing label URLs from vc", {
+ sample_result <- tibble::tibble(
+ node = c("n", "n", "n"),
+ collocate = c("c1", "c2", "c2"),
+ vc = c("corpusSigle=/A/", "corpusSigle=/A/", "corpusSigle=/B/"),
+ label = c("A", "A", "B"),
+ N = c(100, 100, 100),
+ O = c(10, 10, 20),
+ O1 = c(50, 50, 50),
+ O2 = c(30, 30, 30),
+ E = c(5, 5, 5),
+ w = c(2, 2, 2),
+ leftContextSize = c(1, 1, 1),
+ rightContextSize = c(1, 1, 1),
+ frequency = c(10, 10, 20),
+ webUIRequestUrl = c(
+ "https://korap.example/?q=q1&cq=corpusSigle%3D%2FA%2F&ql=poliqarp",
+ "https://korap.example/?q=q2&cq=corpusSigle%3D%2FA%2F&ql=poliqarp",
+ "https://korap.example/?q=q2&cq=corpusSigle%3D%2FB%2F&ql=poliqarp"
+ ),
+ logDice = c(6, 5, 7),
+ pmi = c(3, 2, 4)
+ )
+
+ enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
+ c1 <- enriched[enriched$collocate == "c1", ]
+ expected_b_url <- paste0(
+ "https://korap.example/?q=q1&cq=",
+ urltools::url_encode("corpusSigle=/B/"),
+ "&ql=poliqarp"
+ )
+
+ expect_equal(
+ unique(c1$loser_logDice_webUIRequestUrl),
+ expected_b_url
+ )
+ expect_equal(
+ unique(c1$loser_webUIRequestUrl),
+ expected_b_url
+ )
+})
+
test_that("add_multi_vc_comparisons handles more than two labels", {
sample_result <- tibble::tibble(
node = rep("n", 3),
@@ -194,6 +249,7 @@
leftContextSize = rep(1, 3),
rightContextSize = rep(1, 3),
frequency = c(10, 30, 5),
+ webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B", "https://korap.example/C"),
logDice = c(5, 8, 4),
pmi = c(2, 3, 1)
)
@@ -201,13 +257,43 @@
enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
expect_equal(enriched$winner_logDice[1], "B")
expect_equal(enriched$winner_logDice_value[1], 8)
+ expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
expect_equal(enriched$runner_up_logDice[1], "A")
expect_equal(enriched$runner_up_logDice_value[1], 5)
expect_equal(enriched$loser_logDice[1], "C")
expect_equal(enriched$loser_logDice_value[1], 4)
+ expect_equal(enriched$loser_logDice_webUIRequestUrl[1], "https://korap.example/C")
expect_equal(enriched$max_delta_logDice[1], 4)
})
+test_that("add_multi_vc_comparisons leaves unsuffixed URLs ambiguous when scores disagree", {
+ sample_result <- tibble::tibble(
+ node = c("n", "n"),
+ collocate = c("c", "c"),
+ vc = c("vc1", "vc2"),
+ label = c("A", "B"),
+ N = c(100, 100),
+ O = c(10, 20),
+ O1 = c(50, 50),
+ O2 = c(30, 30),
+ E = c(5, 5),
+ w = c(2, 2),
+ leftContextSize = c(1, 1),
+ rightContextSize = c(1, 1),
+ frequency = c(10, 20),
+ webUIRequestUrl = c("https://korap.example/A", "https://korap.example/B"),
+ logDice = c(5, 7),
+ pmi = c(4, 3)
+ )
+
+ enriched <- RKorAPClient:::add_multi_vc_comparisons(sample_result)
+
+ expect_equal(enriched$winner_logDice_webUIRequestUrl[1], "https://korap.example/B")
+ expect_equal(enriched$winner_pmi_webUIRequestUrl[1], "https://korap.example/A")
+ expect_true(is.na(enriched$winner_webUIRequestUrl[1]))
+ expect_true(is.na(enriched$loser_webUIRequestUrl[1]))
+})
+
test_that("add_multi_vc_comparisons computes rank deltas", {
base_tbl <- tidyr::expand_grid(
label = c("A", "B", "C"),