Parse KWIC snippets of any shape in collocation analysis
Affects only servers that do not deliver tokenized matches, where the
analysis falls back to parsing KWIC markup. Against a current KorAP
matches2FreqTable() is used instead.
The reported crash comes from findExample(), not from the regular
expression: after a failed request collectedMatches has no snippet
column, so the example was character(0) and assigning it aborted.
The expression was wrong as well, in three ways: it required the match
to be followed directly by the closing span, which a <span
class="cutted"> breaks, it required a non-empty left context, and it did
not expect a <span class="more"> in the right context. Counts stayed
correct - a guard skipped those snippets - but about 15 in every 100
hits of the query from the report were dropped silently. The two context
spans are now read one by one and stripped of whatever markup they
contain.
Also fixes both frequency table functions for their own default of an
empty stopword list, which used to leave the table without the column
the stopwords are joined on.
Resolves #14
Change-Id: I1cec847480ddb44fbf688042661019b9c5702a24
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
diff --git a/NEWS.md b/NEWS.md
index af0ae77..e9318e8 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -12,6 +12,12 @@
- **improved coverage of the doc-prompting tests**, which now range from a frequency query over time to comparing collocates across virtual corpora, keeping a result in a `cacheAs` file and labelling corpora by name. They prompt current LLMs with the Readme and check the code written from it, so that a gap in the documentation shows up as a failing test. This guards the quality of the Readme and improves vibe coding results. The approach is briefly described in [Kupietz et al. (2026)](https://doi.org/10.37307/j.1868-775X.2026.02.08)
+- fixed collocation analysis dropping snippets whose markup did not have one particular shape, which cost about 15% of the hits of a `contains(<base/s=s>, ...)` query: those are cut at the sentence boundary and carry a `<span class="cutted">` inside the match, and a match filling the whole sentence leaves an empty context span. The two context spans are now read one by one and stripped of their markup, whatever it contains ([#14](https://github.com/KorAP/RKorAPClient/issues/14)). This only concerns servers that do not deliver tokenized matches, where collocation analysis falls back to parsing the KWIC markup
+
+- `findExample()` no longer aborts with "replacement has length zero" when a failed request leaves the query without any snippet to take an example from ([#14](https://github.com/KorAP/RKorAPClient/issues/14))
+
+- `snippet2FreqTable()` and `matches2FreqTable()` work with their own default of an empty stopword list again, which used to leave the table without the column the stopwords are joined on
+
- dropped the `PTXQC` dependency, which was imported for two small string functions (`lcpCount()` and `lcsCount()`, used by `queryStringToLabel()`) but pulled in `rmzqc`, `jsonvalidate` and `V8`, and with them the only dependency requiring a `libv8` installation.
# RKorAPClient 1.3.0
diff --git a/R/collocationAnalysis.R b/R/collocationAnalysis.R
index c54b46d..d3ea450 100644
--- a/R/collocationAnalysis.R
+++ b/R/collocationAnalysis.R
@@ -1458,7 +1458,9 @@
summarise(frequency = sum(frequency), .groups = "drop") |>
arrange(desc(frequency))
} else {
- stopwordsTable <- dplyr::tibble(word = stopwords)
+ # as.character keeps the column when stopwords is empty: tibble(word = c())
+ # would drop it altogether and the anti_join below would not find it
+ stopwordsTable <- dplyr::tibble(word = as.character(stopwords))
left <- tail(unlist(matches$tokens$left[index]), leftContextSize)
@@ -1481,6 +1483,25 @@
}
}
+#' Text content of a KWIC snippet span
+#'
+#' Returns the text inside the span captured by `pattern`, with any nested
+#' markup removed, or `NA` if the snippet does not contain that span at all.
+#' The capture is greedy on purpose: the context spans contain further spans,
+#' such as `<span class="more">`, whose closing tag a lazy match would stop at.
+#'
+#' @param snippet KWIC snippet
+#' @param pattern regular expression whose first group captures the span content
+#' @return text content of the span, or `NA`
+#' @noRd
+htmlSpanContent <- function(snippet, pattern) {
+ content <- str_match(snippet, pattern)[1, 2]
+ if (is.na(content)) {
+ return(NA_character_)
+ }
+ stringr::str_trim(stringr::str_replace_all(content, "<[^>]*>", " "))
+}
+
#' @importFrom magrittr debug_pipe
#' @importFrom stringr str_match str_split str_detect
#' @importFrom dplyr as_tibble tibble rename filter anti_join tibble bind_rows case_when
@@ -1519,26 +1540,31 @@
summarise(frequency = sum(frequency), .groups = "drop") |>
arrange(desc(frequency))
} else {
- stopwordsTable <- dplyr::tibble(word = stopwords)
- match <-
- str_match(
- snippet,
- '<span class="context-left">(<span class="more"></span>)?(.*[^ ]) *</span><span class="match"><mark>.*</mark></span><span class="context-right"> *([^<]*)'
- )
+ # as.character keeps the column when stopwords is empty: tibble(word = c())
+ # would drop it altogether and the anti_join below would not find it
+ stopwordsTable <- dplyr::tibble(word = as.character(stopwords))
+
+ # The two context spans are taken one by one, up to the element that follows
+ # them, and stripped of whatever markup they contain. Matching the snippet
+ # as a whole used to require one particular shape and silently dropped every
+ # snippet of any other, which cost about 15% of the hits of a
+ # contains(<base/s=s>, ...) query: those are cut at the sentence boundary and
+ # carry a <span class="cutted"> inside the match, and a match filling the
+ # whole sentence leaves an empty context span (see issue #14).
+ leftContext <- htmlSpanContent(snippet, '<span class="context-left">(.*)</span><span class="match">')
+ rightContext <- htmlSpanContent(snippet, '<span class="context-right">(.*)</span>')
left <- if (leftContextSize > 0) {
- tail(unlist(str_split(match[1, 3], tokenizeRegex)), leftContextSize)
+ tail(unlist(str_split(leftContext, tokenizeRegex)), leftContextSize)
} else {
""
}
- # cat(paste("left:", left, "\n", collapse=" "))
right <- if (rightContextSize > 0) {
- head(unlist(str_split(match[1, 4], tokenizeRegex)), rightContextSize)
+ head(unlist(str_split(rightContext, tokenizeRegex)), rightContextSize)
} else {
""
}
- # cat(paste("right:", right, "\n", collapse=" "))
if (is.na(left[1]) || is.na(right[1]) || length(left) + length(right) == 0) {
oldTable
@@ -1639,8 +1665,13 @@
q <- corpusQuery(kco, paste0("(", query[i], ")"), vc = vc[i], metadataOnly = FALSE)
if (q@totalResults > 0) {
q <- fetchNext(q, maxFetch = 50, randomizePageOrder = F)
+ # A failed request leaves collectedMatches without a snippet column at
+ # all, so that the example is character(0) rather than NA and assigning
+ # it fails with "replacement has length zero" (see issue #14).
example <- as.character((q@collectedMatches)$snippet[1])
- out[i] <- if (matchOnly) {
+ out[i] <- if (length(example) != 1 || is.na(example)) {
+ ""
+ } else if (matchOnly) {
gsub(".*<mark>(.+)</mark>.*", "\\1", example)
} else {
stringr::str_replace(example, "<[^>]*>", "")
diff --git a/tests/testthat/test-snippet-parsing.R b/tests/testthat/test-snippet-parsing.R
new file mode 100644
index 0000000..ee89883
--- /dev/null
+++ b/tests/testthat/test-snippet-parsing.R
@@ -0,0 +1,84 @@
+# Snippets come in several shapes, and matching them as a whole used to require
+# one particular one, silently dropping the rest (issue #14).
+
+snippetOf <- function(left, match, right) {
+ paste0(
+ '<span class="context-left">', left, '</span>',
+ '<span class="match">', match, '</span>',
+ '<span class="context-right">', right, '</span>'
+ )
+}
+
+freqOf <- function(snippet, ...) {
+ RKorAPClient:::snippet2FreqTable(
+ snippet,
+ oldTable = dplyr::tibble(word = character(0), frequency = numeric(0)),
+ verbose = FALSE,
+ ...
+ )
+}
+
+test_that("the words of an ordinary snippet are counted", {
+ result <- freqOf(snippetOf("der grosse alte Baum ", "<mark>steht</mark>", " im tiefen dunklen Wald"))
+ expect_true(all(c("Baum", "Wald") %in% result$word))
+})
+
+test_that("a snippet cut at the sentence boundary is counted", {
+ # <span class="cutted"> appears inside the match of contains(<base/s=s>, ...)
+ # queries, which used to make the whole snippet be dropped
+ cut <- snippetOf(
+ 'ein linker Kontext hier ',
+ '<mark>Treffer</mark><span class="cutted"></span>',
+ ' und rechts weiter'
+ )
+ result <- freqOf(cut)
+ expect_true(all(c("Kontext", "rechts") %in% result$word))
+})
+
+test_that("a snippet with an empty context is counted on its other side", {
+ # a match filling the whole sentence leaves one context span empty
+ result <- freqOf(snippetOf("", "<mark>Treffer</mark>", " nur rechts etwas"))
+ expect_true("rechts" %in% result$word)
+
+ result <- freqOf(snippetOf("nur links etwas ", "<mark>Treffer</mark>", ""))
+ expect_true("links" %in% result$word)
+})
+
+test_that("the more markers are not counted as words", {
+ result <- freqOf(snippetOf(
+ '<span class="more"></span>links davon ',
+ "<mark>Treffer</mark>",
+ ' rechts davon<span class="more"></span>'
+ ))
+ expect_true(all(c("links", "rechts") %in% result$word))
+ expect_false(any(grepl("span|more|class", result$word)))
+})
+
+test_that("both contexts empty yields no words rather than an error", {
+ expect_equal(nrow(freqOf(snippetOf("", "<mark>Treffer</mark>", ""))), 0)
+})
+
+test_that("a snippet without the expected spans is skipped", {
+ expect_equal(nrow(freqOf("<span class=\"nothing\">kein KWIC</span>")), 0)
+})
+
+test_that("findExample survives a fetch that returned no snippet column", {
+ # after a failed request collectedMatches has no snippet column at all, so
+ # that the example was character(0) and the assignment aborted with
+ # "replacement has length zero"
+ kco <- methods::new(
+ "KorAPConnection",
+ apiUrl = "https://example.invalid/",
+ KorAPUrl = "https://example.invalid/",
+ authorizationSupported = FALSE,
+ verbose = FALSE
+ )
+
+ testthat::local_mocked_bindings(
+ corpusQuery = function(...) methods::new("KorAPQuery", korapConnection = kco, totalResults = 1),
+ fetchNext = function(q, ...) q,
+ .package = "RKorAPClient"
+ )
+
+ expect_equal(RKorAPClient:::findExample(kco, query = "irgendwas"), "")
+})