Make collocationScoreQuery() accept a vector of collocates
Change-Id: I719c7577393f352fcfebe740a13fbf0daf790d3c
diff --git a/NEWS.md b/NEWS.md
index fb7af2b..c8e0006 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -5,6 +5,7 @@
- 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.), 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
+- `collocationScoreQuery()` now accepts a vector of collocates and queries every combination of collocate and virtual corpus
# RKorAPClient 1.2.1
diff --git a/R/collocationAnalysis.R b/R/collocationAnalysis.R
index 81ca661..7240eca 100644
--- a/R/collocationAnalysis.R
+++ b/R/collocationAnalysis.R
@@ -405,7 +405,11 @@
return(result)
}
- distinct_pairs <- dplyr::distinct(result, node, collocate)
+ distinct_pairs <- dplyr::distinct(
+ result,
+ .data$node,
+ .data$collocate
+ )
if (nrow(distinct_pairs) == 0) {
return(result)
}
diff --git a/R/collocationScoreQuery.R b/R/collocationScoreQuery.R
index bcff325..a79d72f 100644
--- a/R/collocationScoreQuery.R
+++ b/R/collocationScoreQuery.R
@@ -13,9 +13,9 @@
#' based on [frequencyQuery()]s for a target word and a collocate.
#'
#' @param kco [KorAPConnection()] object (obtained e.g. from `KorAPConnection()`
-#' @param node target word
-#' @param collocate collocate of target word
-#' @param vc string describing the virtual corpus in which the query should be performed. An empty string (default) means the whole corpus, as far as it is license-wise accessible.
+#' @param node target word or query as a single character string
+#' @param collocate character vector of one or more collocates of the target word
+#' @param vc character vector describing the virtual corpus or corpora in which the query should be performed. An empty string (default) means the whole corpus, as far as it is license-wise accessible.
#' @param lemmatizeNodeQuery logical, set to TRUE if node query should be lemmatized, i.e. `x -> [tt/l=x]`
#' @param lemmatizeCollocateQuery logical, set to TRUE if collocate query should be lemmatized, i.e. `x -> [tt/l=x]`
#' @param leftContextSize size of the left context window
@@ -76,8 +76,27 @@
# https://stackoverflow.com/questions/8096313/no-visible-binding-for-global-variable-note-in-r-cmd-check
O1 <- O2 <- O <- N <- E <- w <- 0
+ combinations <- tidyr::expand_grid(
+ collocate_index = seq_along(collocate),
+ vc_index = seq_along(vc)
+ )
+ combinations$collocate <- collocate[combinations$collocate_index]
+ combinations$vc <- vc[combinations$vc_index]
+
+ if (length(observed) == length(collocate)) {
+ observed <- observed[combinations$collocate_index]
+ } else if (length(observed) == length(vc)) {
+ observed <- observed[combinations$vc_index]
+ } else if (!length(observed) %in% c(1, nrow(combinations))) {
+ stop(
+ "`observed` must have length 1, length(collocate), ",
+ "length(vc), or length(collocate) * length(vc).",
+ call. = FALSE
+ )
+ }
+
query <- buildCollocationQuery(node,
- collocate,
+ combinations$collocate,
lemmatizeNodeQuery,
lemmatizeCollocateQuery,
leftContextSize,
@@ -85,20 +104,38 @@
ignoreCollocateCase,
withinSpan)
+ nodeFrequency <- frequencyQuery(
+ kco,
+ lemmatizeWordQuery(node, lemmatizeNodeQuery),
+ vc,
+ expand = FALSE
+ )
+ collocateFrequency <- frequencyQuery(
+ kco,
+ lemmatizeWordQuery(combinations$collocate, lemmatizeCollocateQuery),
+ combinations$vc,
+ expand = FALSE
+ )
+ collocationFrequency <- if (is.na(observed[1])) {
+ frequencyQuery(kco, query, combinations$vc, expand = FALSE)
+ } else {
+ NULL
+ }
+
tibble(
node = node,
- collocate = collocate,
- label = queryStringToLabel(vc),
- vc = vc,
+ collocate = combinations$collocate,
+ label = queryStringToLabel(vc)[combinations$vc_index],
+ vc = combinations$vc,
query = query,
webUIRequestUrl = if (is.na(observed[1]))
- frequencyQuery(kco, query, vc)$webUIRequestUrl
+ collocationFrequency$webUIRequestUrl
else
buildWebUIRequestUrl(
kco,
buildCollocationQuery(
removeWithinSpan(node, withinSpan),
- collocate,
+ combinations$collocate,
lemmatizeNodeQuery,
lemmatizeCollocateQuery,
leftContextSize,
@@ -106,15 +143,15 @@
ignoreCollocateCase,
withinSpan
),
- vc
+ combinations$vc
),
w = leftContextSize + rightContextSize,
leftContextSize,
rightContextSize,
- N = frequencyQuery(kco, lemmatizeWordQuery(node, lemmatizeNodeQuery), vc)$total + smoothingConstant,
- O = as.double( if(is.na(observed[1])) frequencyQuery(kco, query, vc)$totalResults else observed) + smoothingConstant,
- O1 = frequencyQuery(kco, lemmatizeWordQuery(node, lemmatizeNodeQuery), vc)$totalResults + smoothingConstant,
- O2 = frequencyQuery(kco, lemmatizeWordQuery(collocate, lemmatizeCollocateQuery), vc)$totalResults + smoothingConstant,
+ N = nodeFrequency$total[combinations$vc_index] + smoothingConstant,
+ O = as.double(if (is.na(observed[1])) collocationFrequency$totalResults else observed) + smoothingConstant,
+ O1 = nodeFrequency$totalResults[combinations$vc_index] + smoothingConstant,
+ O2 = collocateFrequency$totalResults + smoothingConstant,
E = w * as.double(O1) * O2 / N
) %>%
mutate(!!! lapply(scoreFunctions, mapply, .$O1, .$O2, .$O, .$N, .$E, .$w))
@@ -222,4 +259,3 @@
) |>
ungroup()
}
-
diff --git a/man/collocationScoreQuery-KorAPConnection-method.Rd b/man/collocationScoreQuery-KorAPConnection-method.Rd
index 12d8258..b7ff06a 100644
--- a/man/collocationScoreQuery-KorAPConnection-method.Rd
+++ b/man/collocationScoreQuery-KorAPConnection-method.Rd
@@ -24,11 +24,11 @@
\arguments{
\item{kco}{\code{\link[=KorAPConnection]{KorAPConnection()}} object (obtained e.g. from \code{KorAPConnection()}}
-\item{node}{target word}
+\item{node}{target word or query as a single character string}
-\item{collocate}{collocate of target word}
+\item{collocate}{character vector of one or more collocates of the target word}
-\item{vc}{string describing the virtual corpus in which the query should be performed. An empty string (default) means the whole corpus, as far as it is license-wise accessible.}
+\item{vc}{character vector describing the virtual corpus or corpora in which the query should be performed. An empty string (default) means the whole corpus, as far as it is license-wise accessible.}
\item{lemmatizeNodeQuery}{logical, set to TRUE if node query should be lemmatized, i.e. \verb{x -> [tt/l=x]}}
@@ -83,9 +83,9 @@
}
\seealso{
-Other collocation analysis functions:
+Other collocation analysis functions:
\code{\link{association-score-functions}},
\code{\link{collocationAnalysis,KorAPConnection-method}},
-\code{\link{synsemanticStopwords}()}
+\code{\link[=synsemanticStopwords]{synsemanticStopwords()}}
}
\concept{collocation analysis functions}
diff --git a/tests/testthat/test-collocations.R b/tests/testthat/test-collocations.R
index 0d5dd3e..94bc453 100644
--- a/tests/testthat/test-collocations.R
+++ b/tests/testthat/test-collocations.R
@@ -10,6 +10,94 @@
expect_equal(df$logDice, logDice(df$O1, df$O2, df$O, df$N, df$E, df$w))
})
+test_that("collocationScoreQuery expands collocates and virtual corpora", {
+ kco <- methods::new(
+ "KorAPConnection",
+ apiUrl = "https://example.test/",
+ KorAPUrl = "https://example.test/"
+ )
+
+ fake_frequency_query <- function(kco, query, vc = "", ...) {
+ expand <- length(query) != length(vc)
+ combinations <- if (expand) {
+ tidyr::expand_grid(query = query, vc = vc)
+ } else {
+ tibble::tibble(query = query, vc = vc)
+ }
+
+ combinations |>
+ dplyr::mutate(
+ totalResults = 10,
+ webUIRequestUrl = paste0("https://example.test/", seq_len(dplyr::n())),
+ total = 1000
+ )
+ }
+
+ testthat::local_mocked_bindings(
+ frequencyQuery = fake_frequency_query,
+ .package = "RKorAPClient"
+ )
+
+ result <- collocationScoreQuery(
+ kco,
+ node = "node",
+ collocate = c("first", "second"),
+ vc = c("vc1", "vc2"),
+ leftContextSize = 0,
+ rightContextSize = 1
+ )
+
+ expect_equal(nrow(result), 4)
+ expect_equal(result$collocate, c("first", "first", "second", "second"))
+ expect_equal(result$vc, c("vc1", "vc2", "vc1", "vc2"))
+ expect_true(all(mapply(
+ grepl,
+ pattern = result$collocate,
+ x = result$query,
+ MoreArgs = list(fixed = TRUE)
+ )))
+})
+
+test_that("collocationScoreQuery aligns observed frequencies with collocates", {
+ kco <- methods::new(
+ "KorAPConnection",
+ apiUrl = "https://example.test/",
+ KorAPUrl = "https://example.test/"
+ )
+
+ fake_frequency_query <- function(kco, query, vc = "", ...) {
+ expand <- length(query) != length(vc)
+ combinations <- if (expand) {
+ tidyr::expand_grid(query = query, vc = vc)
+ } else {
+ tibble::tibble(query = query, vc = vc)
+ }
+
+ combinations |>
+ dplyr::mutate(
+ totalResults = 10,
+ webUIRequestUrl = "https://example.test/",
+ total = 1000
+ )
+ }
+
+ testthat::local_mocked_bindings(
+ frequencyQuery = fake_frequency_query,
+ .package = "RKorAPClient"
+ )
+
+ result <- collocationScoreQuery(
+ kco,
+ node = "node",
+ collocate = c("first", "second"),
+ vc = c("vc1", "vc2"),
+ observed = c(3, 7),
+ smoothingConstant = 0
+ )
+
+ expect_equal(result$O, c(3, 3, 7, 7))
+})
+
test_that("collocationAnalysis works and warns about missing token", {
skip_if_offline()