Label virtual corpora by the names they were given
Passing c(before = ..., since = ...) said what the two corpora are to be
called, and only collocationAnalysis() listened. frequencyQuery() dropped
the names in the expand_grid() it builds its queries from and returned no
label at all; corpusStats() let them become row names, which the first
bind_rows() throws away; collocationScoreQuery() ignored them and derived
a label from the corpus definitions instead, so that the pair above came
out as "1990 & pubDat..." and "2010".
All three now prefer the names, falling back to queryStringToLabel()
where a vector is named only in part, as collocationAnalysis() has been
doing. A vector without names is left alone: no label column appears
where there is nothing to put in it.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Change-Id: I72c7c8d5f14b649df853cae94a4d90c0be19d1f4
diff --git a/NEWS.md b/NEWS.md
index a4650ca..587eed0 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,8 @@
- **`cacheAs` files record the version that wrote them** and are refused, with a warning, when that is older than 1.4.0. Their contents are finished results including the association scores, which this version computes differently, so an old file would silently hand back numbers that would not be arrived at again - something no comparison of parameters can notice. The file is then recomputed and overwritten; pass a different name to keep it. How loud a query is no longer counts as a parameter either: `verbose` does not change what is returned
+- **the names of a named `vc` vector are now used as labels** by `frequencyQuery()`, `corpusStats()` and `collocationScoreQuery()`, as `collocationAnalysis()` already did. `frequencyQuery()` ignored them, `corpusStats()` put them into row names, which the first `bind_rows()` drops, and `collocationScoreQuery()` derived a label from the corpus definitions instead, so that `c(before = ..., since = ...)` came out as `"1990 & pubDat…"`. Where a vector carries no names, nothing changes: no `label` column appears that was not there before
+
- **`collocationAnalysis()` now discards collocates that occur less often than expected** by chance. `logDice`, by which it ranks and thresholds, expresses how salient a pair is rather than how surprising, so a frequent word could appear among the top collocates although the node does not attract it at all: for *Grund* in a 5+5 window, *Berlin* reaches a logDice of 3.84, close to *triftiger* at 3.96, while co-occurring 1.74 bits *less* often than expected. The new `minObservedExpectedRatio` parameter defaults to 1 and keeps such pairs out. Raise it to demand a stronger contrast, e.g. 2 for collocates occurring at least twice as often as expected, or set it to 0 for the unfiltered result of earlier versions, e.g. to study repulsion. `collocationScoreQuery()` is unaffected, as there the pairs to score are given explicitly
- **changed `logDice` values**: `logDice()` is now computed as defined by Rychlý (2008), `14 + log2(2 * O / (O1 + O2))`, so that its values are comparable to those of Sketch Engine and other tools. It previously multiplied the node frequency by the window size, `14 + log2(2 * O / (w * O1 + O2))`, which added a count of window positions to a count of word tokens and made the coefficient asymmetric, so that swapping node and collocate changed the score. Because `w * O1` dominated the denominator for a frequent node, rare collocates were penalised: for *triftiger* as a collocate of *Grund* in a 5+5 window, logDice was 0.64, below *Berlin* at 2.03, although *Berlin* co-occurs with *Grund* less often than chance predicts. The values are now 3.96 and 3.84. Scores rise by up to `log2(w)`, that is by up to 3.32 for the default context of 5 left and 5 right, so `collocationAnalysis()` with the default `thresholdScore = "logDice"` and `threshold = 2` is now somewhat more permissive when recursing. Results computed with a total window size of 1, as in the light verb construction example of the Readme, are unaffected. The other association scores are unchanged: they take the window size into account through the expected frequency `E`, which is correct
diff --git a/R/KorAPCorpusStats.R b/R/KorAPCorpusStats.R
index fcd77df..6fe44d8 100644
--- a/R/KorAPCorpusStats.R
+++ b/R/KorAPCorpusStats.R
@@ -75,6 +75,9 @@
verbose = kco@verbose,
as.df = FALSE) {
if (length(vc) > 1) {
+ # the names of a named vc vector would end up as row names, which the first
+ # bind_rows() drops, so they are kept as a column instead
+ vcLabel <- vcLabels(vc)
# ETA calculation for multiple virtual corpora
total_items <- length(vc)
start_time <- Sys.time()
@@ -94,6 +97,9 @@
# Process current virtual corpus
result <- corpusStats(kco, current_vc, verbose = FALSE, as.df = TRUE)
+ if (!is.null(vcLabel)) {
+ result <- tibble::add_column(result, label = vcLabel[i], .after = "vc")
+ }
results[[i]] <- result
# Record individual processing time
@@ -149,7 +155,9 @@
))
}
- do.call(rbind, results)
+ stats <- do.call(rbind, results)
+ rownames(stats) <- NULL
+ stats
} else {
url <-
paste0(
diff --git a/R/KorAPQuery.R b/R/KorAPQuery.R
index a8372e3..77774c8 100644
--- a/R/KorAPQuery.R
+++ b/R/KorAPQuery.R
@@ -215,14 +215,20 @@
as.df = FALSE,
context = NULL) {
if (length(query) > 1 || length(vc) > 1) {
+ # expand_grid() and tibble() drop the names of vc, so the labels the
+ # caller gave their virtual corpora are carried along as a column
+ vcLabel <- vcLabels(vc)
grid <- if (expand) expand_grid(query = query, vc = vc) else tibble(query = query, vc = vc)
+ if (!is.null(vcLabel)) {
+ grid$label <- if (expand) rep(vcLabel, times = length(query)) else vcLabel
+ }
# Initialize timing variables for ETA calculation
total_queries <- nrow(grid)
current_query <- 0
start_time <- Sys.time()
- results <- purrr::pmap(grid, function(query, vc, ...) {
+ results <- purrr::pmap(grid, function(query, vc, label = NULL, ...) {
current_query <<- current_query + 1
# Execute the single query directly (avoiding recursive call)
@@ -297,6 +303,9 @@
webUIRequestUrl = webUIRequestUrl,
stringsAsFactors = FALSE
)
+ if (!is.null(label)) {
+ result <- tibble::add_column(result, label = label, .after = "vc")
+ }
return(result)
})
diff --git a/R/collocationScoreQuery.R b/R/collocationScoreQuery.R
index a79d72f..6f28bc4 100644
--- a/R/collocationScoreQuery.R
+++ b/R/collocationScoreQuery.R
@@ -125,7 +125,9 @@
tibble(
node = node,
collocate = combinations$collocate,
- label = queryStringToLabel(vc)[combinations$vc_index],
+ # the names the caller gave their virtual corpora, where there
+ # are any, rather than a label guessed from the definitions
+ label = vcLabelsOrGuess(vc)[combinations$vc_index],
vc = combinations$vc,
query = query,
webUIRequestUrl = if (is.na(observed[1]))
diff --git a/R/misc.R b/R/misc.R
index 6e7340f..e120ea4 100644
--- a/R/misc.R
+++ b/R/misc.R
@@ -162,6 +162,40 @@
substring(data, leftCommon + 1, nchar(data) - rightCommon)
}
+#' Labels for a vector of virtual corpora
+#'
+#' The names of a named vector are what the caller chose to call their virtual
+#' corpora, so they are what a label should say. Where a vector is named only in
+#' part, [queryStringToLabel()] derives the rest from the definitions.
+#'
+#' @param vc character vector of virtual corpus definitions
+#' @return character vector of labels, or `NULL` if `vc` carries no names at all
+#' @noRd
+vcLabels <- function(vc) {
+ labels <- names(vc)
+ if (is.null(labels)) {
+ return(NULL)
+ }
+ unnamed <- is.na(labels) | !nzchar(labels)
+ if (any(unnamed)) {
+ labels[unnamed] <- queryStringToLabel(vc)[unnamed]
+ }
+ unname(labels)
+}
+
+#' Labels for a vector of virtual corpora, always giving one
+#'
+#' Like [vcLabels()], but falling back to [queryStringToLabel()] where the
+#' vector carries no names, for callers that label unconditionally.
+#'
+#' @param vc character vector of virtual corpus definitions
+#' @return character vector of labels, one per element of `vc`
+#' @noRd
+vcLabelsOrGuess <- function(vc) {
+ labels <- vcLabels(vc)
+ if (is.null(labels)) queryStringToLabel(vc) else labels
+}
+
## Mute notes: "Undefined global functions or variables:"
globalVariables(c("conf.high", "conf.low", "onRender", "webUIRequestUrl"))
diff --git a/tests/testthat/test-vc-labels.R b/tests/testthat/test-vc-labels.R
new file mode 100644
index 0000000..a614ec6
--- /dev/null
+++ b/tests/testthat/test-vc-labels.R
@@ -0,0 +1,63 @@
+test_that("vcLabels prefers the names a vector was given", {
+ vcLabels <- RKorAPClient:::vcLabels
+
+ expect_equal(
+ vcLabels(c(before = "pubDate until 2009", since = "pubDate since 2010")),
+ c("before", "since")
+ )
+ # nothing to prefer, so nothing is invented
+ expect_null(vcLabels(c("pubDate until 2009", "pubDate since 2010")))
+ # a partly named vector is filled in from the definitions
+ expect_equal(
+ vcLabels(c(before = "pubDate until 2009", "pubDate since 2010")),
+ c("before", "since 2010")
+ )
+})
+
+test_that("vcLabelsOrGuess always gives a label", {
+ expect_equal(
+ RKorAPClient:::vcLabelsOrGuess(c("pubDate until 2009", "pubDate since 2010")),
+ RKorAPClient:::queryStringToLabel(c("pubDate until 2009", "pubDate since 2010"))
+ )
+})
+
+test_that("the query functions label virtual corpora by their names", {
+ skip_if_offline()
+ kco <- KorAPConnection(accessToken = NULL, verbose = FALSE)
+ vcs <- c(before = "pubDate until 2009", since = "pubDate since 2010")
+
+ expect_equal(frequencyQuery(kco, "Ameisenplage", vcs)$label, c("before", "since"))
+ expect_equal(corpusStats(kco, vc = vcs, as.df = TRUE)$label, c("before", "since"))
+ expect_equal(
+ collocationScoreQuery(kco, "Grund", "triftiger", vc = vcs)$label,
+ c("before", "since")
+ )
+})
+
+test_that("an unnamed vector leaves the result as it was", {
+ skip_if_offline()
+ kco <- KorAPConnection(accessToken = NULL, verbose = FALSE)
+ vcs <- c("pubDate until 2009", "pubDate since 2010")
+
+ # no column appears where there is nothing to put in it
+ expect_false("label" %in% names(frequencyQuery(kco, "Ameisenplage", vcs)))
+ expect_false("label" %in% names(corpusStats(kco, vc = vcs, as.df = TRUE)))
+ # collocationScoreQuery has always labelled, and keeps deriving one
+ expect_equal(
+ collocationScoreQuery(kco, "Grund", "triftiger", vc = vcs)$label,
+ RKorAPClient:::queryStringToLabel(vcs)
+ )
+})
+
+test_that("corpusStats does not hide the labels in row names", {
+ skip_if_offline()
+ kco <- KorAPConnection(accessToken = NULL, verbose = FALSE)
+ stats <- corpusStats(
+ kco,
+ vc = c(before = "pubDate until 2009", since = "pubDate since 2010"),
+ as.df = TRUE
+ )
+ # row names are lost by the first bind_rows(), a column is not
+ expect_equal(rownames(stats), c("1", "2"))
+ expect_true("label" %in% names(stats))
+})