New internal functions for better handling of ambiguity

Author: antaldaniel

R/handle_search_term_ambiguity.R

@@ -0,0 +1,34 @@
+#' @title Handle Search Term Ambiguity
+#' @description Resolves ambiguity in search results by selecting a preferred
+#'   match or returning NULL.
+#' @param search_results A list of search results from the Wikibase API.
+#' @param search_term The original search term used in the query.
+#' @param language The language code used in the search.
+#' @param prefer_first Logical; if TRUE, returns the first match when multiple
+#'   matches are found.
+#' @return A single search result or NULL if ambiguity cannot be resolved.
+#' @keywords internal
+handle_search_term_ambiguity <- function(search_results,
+                                         search_term,
+                                         language,
+                                         strategy = c("return_null", "return_first"),
+                                         csrf = NULL) {
+  strategy <- match.arg(strategy)
+
+  # Filter for exact label-language matches
+  exact_matches <- purrr::keep(search_results, function(item) {
+    item$label == search_term && item$match$language == language
+  })
+
+  if (length(exact_matches) == 1) {
+    return(exact_matches[[1]])
+  } else if (length(exact_matches) > 1) {
+    if (strategy == "return_first") {
+      return(exact_matches[[1]])
+    } else {
+      return(NULL)
+    }
+  } else {
+    return(NULL)
+  }
+}

R/search_wikibase_entities.R

@@ -0,0 +1,51 @@
+#' @title Search Wikibase Entities
+#' @description This internal function interfaces with the Wikibase API to
+#'   search for entities matching a given search term and language.
+#' @param search_term A character string representing the term to search for.
+#' @param language A character string specifying the language code (e.g., "en").
+#' @param type A character string indicating the type of entity to search for.
+#'   Defaults to "item".
+#' @param wikibase_api_url A character string providing the URL of the Wikibase
+#'   API endpoint.
+#' @importFrom httr POST content
+#' @return A list containing search results from the Wikibase API.
+#' @keywords internal
+search_wikibase_entities <- function(search_term,
+                                     language = "en",
+                                     wikibase_api_url = "https://www.wikidata.org/w/api.php",
+                                     csrf = NULL) {
+  # Construct the body of the POST request
+  body <- list(
+    action = "wbsearchentities",
+    search = search_term,
+    language = language,
+    formatversion = 2,
+    format = "json",
+    type = "item",
+    strictlanguage = "true"
+  )
+
+  # Include CSRF token if provided
+  if (!is.null(csrf)) {
+    body$token <- csrf
+  }
+
+  # Make the POST request
+  response <- httr::POST(
+    url = wikibase_api_url,
+    body = body,
+    encode = "form"
+  )
+
+  # Parse the response
+  content <- httr::content(response, as = "parsed", type = "application/json")
+
+  # Check for errors in the response
+  if (!is.null(content$error)) {
+    stop(paste(content$error$code, ":", content$error$info))
+  }
+
+  # Return the search results
+  return(content$search)
+}
+

tests/testthat/test-handle_search_term_ambiguity.R

@@ -0,0 +1,38 @@
+test_that("handle_search_term_ambiguity returns correct match", {
+  search_results <- list(
+    list(label = "Orange", match = list(language = "en"), id = "Q1"),
+    list(label = "Orange", match = list(language = "fr"), id = "Q2")
+  )
+
+  result <- handle_search_term_ambiguity(search_results, "Orange", "en")
+  expect_equal(result$id, "Q1")
+})
+
+test_that("handle_search_term_ambiguity returns NULL when no match", {
+  search_results <- list(
+    list(label = "Apple", match = list(language = "en"), id = "Q3")
+  )
+
+  result <- handle_search_term_ambiguity(search_results, "Orange", "en")
+  expect_null(result)
+})
+
+test_that("handle_search_term_ambiguity returns first match when prefer_first is TRUE", {
+  search_results <- list(
+    list(label = "Orange", match = list(language = "en"), id = "Q1"),
+    list(label = "Orange", match = list(language = "en"), id = "Q2")
+  )
+
+  result <- handle_search_term_ambiguity(search_results, "Orange", "en", prefer_first = TRUE)
+  expect_equal(result$id, "Q1")
+})
+
+test_that("handle_search_term_ambiguity returns NULL when multiple matches and prefer_first is FALSE", {
+  search_results <- list(
+    list(label = "Orange", match = list(language = "en"), id = "Q1"),
+    list(label = "Orange", match = list(language = "en"), id = "Q2")
+  )
+
+  result <- handle_search_term_ambiguity(search_results, "Orange", "en", prefer_first = FALSE)
+  expect_null(result)
+})

tests/testthat/test-search_wikibase_entities.R

@@ -0,0 +1,34 @@
+test_that("search_wikibase_entities returns expected results for valid input", {
+  results <- search_wikibase_entities(
+    search_term = "Estonian National Museum",
+    language = "en",
+    wikibase_api_url = "https://www.wikidata.org/w/api.php"
+  )
+
+  expect_type(results, "list")
+  expect_true(length(results) > 0)
+  expect_true(any(sapply(results, function(x) x$label == "Estonian National Museum")))
+})
+
+test_that("search_wikibase_entities handles no matches gracefully", {
+  results <- search_wikibase_entities(
+    search_term = "NonExistentEntity12345",
+    language = "en",
+    wikibase_api_url = "https://www.wikidata.org/w/api.php"
+  )
+
+  expect_type(results, "list")
+  expect_length(results, 0)
+})
+
+test_that("search_wikibase_entities handles invalid API URL gracefully", {
+  expect_error(
+    search_wikibase_entities(
+      search_term = "Estonian National Museum",
+      language = "en",
+      wikibase_api_url = "https://invalid.wikidata.org/w/api.php"
+    ),
+    regexp = "Could not resolve host|Failed to connect|Name or service not known",
+    info = "Expected a network-related error due to invalid API URL"
+  )
+})