blob: 7abed6a587145c3519f2627c4960825c875f030e [file] [log] [blame]
#' Class KorAPQuery
#'
#' This class provides methods to perform different kinds of queries on the KorAP API server.
#' `KorAPQuery` objects, which are typically created by the [corpusQuery()] method,
#' represent the current state of a query to a KorAP server.
#'
#' @include KorAPConnection.R
#' @import httr
#'
#' @include RKorAPClient-package.R
#' @export
KorAPQuery <- setClass("KorAPQuery", slots = c(
"korapConnection",
"request",
"vc",
"totalResults",
"nextStartIndex",
"fields",
"requestUrl",
"webUIRequestUrl",
"apiResponse",
"collectedMatches",
"hasMoreMatches"
))
#' Method initialize
#'
#' @rdname KorAPQuery-class
#' @param .Object …
#' @param korapConnection KorAPConnection object
#' @param request query part of the request URL
#' @param vc definition of a virtual corpus
#' @param totalResults number of hits the query has yielded
#' @param nextStartIndex at what index to start the next fetch of query results
#' @param fields what data / metadata fields should be collected
#' @param requestUrl complete URL of the API request
#' @param webUIRequestUrl URL of a web frontend request corresponding to the API request
#' @param apiResponse data-frame representation of the JSON response of the API request
#' @param hasMoreMatches logical that signals if more query results can be fetched
#' @param collectedMatches matches already fetched from the KorAP-API-server
#'
#' @importFrom tibble tibble
#' @export
setMethod("initialize", "KorAPQuery",
function(.Object, korapConnection = NULL, request = NULL, vc="", totalResults=0, nextStartIndex=0, fields=c("corpusSigle", "textSigle", "pubDate", "pubPlace",
"availability", "textClass", "snippet", "tokens"),
requestUrl="", webUIRequestUrl = "", apiResponse = NULL, hasMoreMatches= FALSE, collectedMatches = NULL) {
.Object <- callNextMethod()
.Object@korapConnection = korapConnection
.Object@request = request
.Object@vc = vc
.Object@totalResults = totalResults
.Object@nextStartIndex = nextStartIndex
.Object@fields = fields
.Object@requestUrl = requestUrl
.Object@webUIRequestUrl = webUIRequestUrl
.Object@apiResponse = apiResponse
.Object@hasMoreMatches = hasMoreMatches
.Object@collectedMatches = collectedMatches
.Object
})
setGeneric("corpusQuery", function(kco, ...) standardGeneric("corpusQuery") )
setGeneric("fetchAll", function(kqo, ...) standardGeneric("fetchAll") )
setGeneric("fetchNext", function(kqo, ...) standardGeneric("fetchNext") )
setGeneric("fetchRest", function(kqo, ...) standardGeneric("fetchRest") )
setGeneric("frequencyQuery", function(kco, ...) standardGeneric("frequencyQuery") )
maxResultsPerPage <- 50
## quiets concerns of R CMD check re: the .'s that appear in pipelines
if(getRversion() >= "2.15.1") utils::globalVariables(c("."))
#' Corpus query
#'
#' **`corpusQuery`** performs a corpus query via a connection to a KorAP-API-server
#'
#' @rdname KorAPQuery-class
#' @aliases corpusQuery
#'
#' @importFrom urltools url_encode
#' @importFrom purrr pmap
#' @importFrom dplyr bind_rows
#'
#' @param kco [KorAPConnection()] object (obtained e.g. from `new("KorAPConnection")`
#' @param query string that contains the corpus query. The query language depends on the `ql` parameter. Either `query` must be provided or `KorAPUrl`.
#' @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 KorAPUrl instead of providing the query and vc string parameters, you can also simply copy a KorAP query URL from your browser and use it here (and in `KorAPConnection`) to provide all necessary information for the query.
#' @param metadataOnly logical that determines whether queries should return only metadata without any snippets. This can also be useful to prevent access rewrites. Note that the default value is TRUE.
#' If you want your corpus queries to return not only metadata, but also KWICS, you need to authorize
#' your RKorAPClient application as explained in the
#' [authorization section](https://github.com/KorAP/RKorAPClient#authorization)
#' of the RKorAPClient Readme on GitHub and set the `metadataOnly` parameter to
#' `FALSE`.
#' @param ql string to choose the query language (see [section on Query Parameters](https://github.com/KorAP/Kustvakt/wiki/Service:-Search-GET#user-content-parameters) in the Kustvakt-Wiki for possible values.
#' @param fields (meta)data fields that will be fetched for every match.
#' @param accessRewriteFatal abort if query or given vc had to be rewritten due to insufficient rights (not yet implemented).
#' @param verbose print some info
#' @param as.df return result as data frame instead of as S4 object?
#' @param expand logical that decides if `query` and `vc` parameters are expanded to all of their combinations
#' @param context string that specifies the size of the left and the right context returned in `snippet`
#' (provided that `metadataOnly` is set to `false` and that the necessary access right are met).
#' The format of the context size specifcation (e.g. `3-token,3-token`) is described in the [Service: Search GET documentation of the Kustvakt Wiki](https://github.com/KorAP/Kustvakt/wiki/Service:-Search-GET).
#' If the parameter is not set, the default context size secification of the KorAP server instance will be used.
#' Note that you cannot overrule the maximum context size set in the KorAP server instance,
#' as this is typically legally motivated.
#' @return Depending on the `as.df` parameter, a table or a [KorAPQuery()] object that, among other information, contains the total number of results in `@totalResults`. The resulting object can be used to fetch all query results (with [fetchAll()]) or the next page of results (with [fetchNext()]).
#' A corresponding URL to be used within a web browser is contained in `@webUIRequestUrl`
#' Please make sure to check `$collection$rewrites` to see if any unforeseen access rewrites of the query's virtual corpus had to be performed.
#'
#' @examples
#' \dontrun{
#'
#' # Fetch metadata of every query hit for "Ameisenplage" and show a summary
#' new("KorAPConnection") %>% corpusQuery("Ameisenplage") %>% fetchAll()
#' }
#'
#' \dontrun{
#'
#' # Use the copy of a KorAP-web-frontend URL for an API query of "Ameise" in a virtual corpus
#' # and show the number of query hits (but don't fetch them).
#'
#' new("KorAPConnection", verbose = TRUE) %>%
#' corpusQuery(KorAPUrl =
#' "https://korap.ids-mannheim.de/?q=Ameise&cq=pubDate+since+2017&ql=poliqarp")
#' }
#'
#' \dontrun{
#'
#' # Plot the time/frequency curve of "Ameisenplage"
#' new("KorAPConnection", verbose=TRUE) %>%
#' { . ->> kco } %>%
#' corpusQuery("Ameisenplage") %>%
#' fetchAll() %>%
#' slot("collectedMatches") %>%
#' mutate(year = lubridate::year(pubDate)) %>%
#' dplyr::select(year) %>%
#' group_by(year) %>%
#' summarise(Count = dplyr::n()) %>%
#' mutate(Freq = mapply(function(f, y)
#' f / corpusStats(kco, paste("pubDate in", y))@tokens, Count, year)) %>%
#' dplyr::select(-Count) %>%
#' complete(year = min(year):max(year), fill = list(Freq = 0)) %>%
#' plot(type = "l")
#' }
#' @seealso [KorAPConnection()], [fetchNext()], [fetchRest()], [fetchAll()], [corpusStats()]
#'
#' @references
#' <https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026>
#'
#' @export
setMethod("corpusQuery", "KorAPConnection",
function(kco,
query = if (missing(KorAPUrl))
stop("At least one of the parameters query and KorAPUrl must be specified.", call. = FALSE)
else
httr::parse_url(KorAPUrl)$query$q,
vc = if (missing(KorAPUrl)) "" else httr::parse_url(KorAPUrl)$query$cq,
KorAPUrl,
metadataOnly = TRUE,
ql = if (missing(KorAPUrl)) "poliqarp" else httr::parse_url(KorAPUrl)$query$ql,
fields = c(
"corpusSigle",
"textSigle",
"pubDate",
"pubPlace",
"availability",
"textClass",
"snippet",
"tokens"
),
accessRewriteFatal = TRUE,
verbose = kco@verbose,
expand = length(vc) != length(query),
as.df = FALSE,
context = NULL) {
if (length(query) > 1 || length(vc) > 1) {
grid <- if (expand) expand_grid(query=query, vc=vc) else tibble(query=query, vc=vc)
purrr::pmap(grid, function(query, vc, ...)
corpusQuery(kco, query=query, vc=vc, ql=ql, verbose=verbose, as.df = TRUE)) %>%
bind_rows()
} else {
contentFields <- c("snippet", "tokens")
if (metadataOnly) {
fields <- fields[!fields %in% contentFields]
}
request <-
paste0('?q=',
url_encode(enc2utf8(query)),
ifelse (!metadataOnly && ! is.null(context) && context != '', paste0('&context=', url_encode(enc2utf8(context))), ''),
ifelse (vc != '', paste0('&cq=', url_encode(enc2utf8(vc))), ''),
ifelse (!metadataOnly, '&show-tokens=true', ''),
'&ql=', ql)
webUIRequestUrl <- paste0(kco@KorAPUrl, request)
requestUrl <- paste0(
kco@apiUrl,
'search',
request,
'&fields=',
paste(fields, collapse = ","),
if (metadataOnly) '&access-rewrite-disabled=true' else ''
)
log_info(verbose, "Searching \"", query, "\" in \"", vc, "\"", sep =
"")
res = apiCall(kco, paste0(requestUrl, '&count=0'))
if (is.null(res)) {
log_info(verbose, " [failed]\n")
message("API call failed.")
totalResults <- 0
} else {
totalResults <-as.integer(res$meta$totalResults)
log_info(verbose, ": ", totalResults, " hits")
if(!is.null(res$meta$cached))
log_info(verbose, " [cached]\n")
else
log_info(verbose, ", took ", res$meta$benchmark, "\n", sep = "")
}
if (as.df)
data.frame(
query = query,
totalResults = totalResults,
vc = vc,
webUIRequestUrl = webUIRequestUrl,
stringsAsFactors = FALSE
)
else
KorAPQuery(
korapConnection = kco,
nextStartIndex = 0,
fields = fields,
requestUrl = requestUrl,
request = request,
totalResults = totalResults,
vc = vc,
apiResponse = res,
webUIRequestUrl = webUIRequestUrl,
hasMoreMatches = (totalResults > 0),
)
}
})
#' @importFrom purrr map
repair_data_strcuture <- function(x) {
if (is.list(x))
as.character (purrr::map(x, ~ if (length(.x) > 1) {
paste(.x, collapse = " ")
} else {
.x
}))
else
ifelse(is.na(x), "", x)
}
#' Fetch the next bunch of results of a KorAP query.
#'
#' **`fetchNext`** fetches the next bunch of results of a KorAP query.
#'
#' @param kqo object obtained from [corpusQuery()]
#' @param offset start offset for query results to fetch
#' @param maxFetch maximum number of query results to fetch
#' @param verbose print progress information if true
#' @param randomizePageOrder fetch result pages in pseudo random order if true. Use [set.seed()] to set seed for reproducible results.
#' @return The `kqo` input object with updated slots `collectedMatches`, `apiResponse`, `nextStartIndex`, `hasMoreMatches`
#'
#' @examples
#' \dontrun{
#'
#' q <- new("KorAPConnection") %>% corpusQuery("Ameisenplage") %>% fetchNext()
#' q@collectedMatches
#' }
#'
#' @references
#' <https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026>
#'
#' @aliases fetchNext
#' @rdname KorAPQuery-class
#' @importFrom dplyr rowwise mutate bind_rows select summarise n select
#' @importFrom tibble enframe
#' @importFrom tidyr unnest unchop pivot_wider
#' @importFrom purrr map
#' @export
setMethod("fetchNext", "KorAPQuery", function(kqo,
offset = kqo@nextStartIndex,
maxFetch = maxResultsPerPage,
verbose = kqo@korapConnection@verbose,
randomizePageOrder = FALSE) {
if (kqo@totalResults == 0 || offset >= kqo@totalResults) {
return(kqo)
}
use_korap_api <- Sys.getenv("USE_KORAP_API", unset = NA)
page <- kqo@nextStartIndex / maxResultsPerPage + 1
results <- 0
pubDate <- NULL # https://stackoverflow.com/questions/8096313/no-visible-binding-for-global-variable-note-in-r-cmd-check
collectedMatches <- kqo@collectedMatches
if (randomizePageOrder) {
pages <- head(sample.int(ceiling(kqo@totalResults / maxResultsPerPage)), maxFetch) - 1
}
if(is.null(collectedMatches)) {
collectedMatches <- data.frame()
}
repeat {
page = nrow(collectedMatches) %/% maxResultsPerPage + 1
currentOffset = ifelse(randomizePageOrder, pages[page], page - 1) * maxResultsPerPage
query <- paste0(kqo@requestUrl, '&count=', min(if (!is.na(maxFetch)) maxFetch - results else maxResultsPerPage, maxResultsPerPage) ,'&offset=', currentOffset, '&cutoff=true')
res <- apiCall(kqo@korapConnection, query)
if (length(res$matches) == 0) {
break
}
if ("fields" %in% colnames(res$matches) && (is.na(use_korap_api) || as.numeric(use_korap_api) >= 1.0)) {
if (verbose) cat("Using fields API: ")
currentMatches <- res$matches$fields %>%
purrr::map(~ mutate(.x, value = repair_data_strcuture(value))) %>%
tibble::enframe() %>%
tidyr::unnest(cols = value) %>%
tidyr::pivot_wider(names_from = key, id_cols = name, names_repair = "unique") %>%
dplyr::select(-name)
if("snippet" %in% colnames(res$matches)) {
currentMatches$snippet <- res$matches$snippet
}
} else {
currentMatches <- res$matches
}
for (field in kqo@fields) {
if (!field %in% colnames(currentMatches)) {
currentMatches[, field] <- NA
}
}
currentMatches <- currentMatches %>% select(kqo@fields)
if (!is.list(collectedMatches)) {
collectedMatches <- currentMatches
} else {
collectedMatches <- bind_rows(collectedMatches, currentMatches)
}
if (verbose) {
cat(paste0(
"Retrieved page ",
ceiling(nrow(collectedMatches) / res$meta$itemsPerPage),
"/",
if (!is.na(maxFetch) && maxFetch < kqo@totalResults)
sprintf("%d (%d)", ceiling(maxFetch / res$meta$itemsPerPage), ceiling(kqo@totalResults / res$meta$itemsPerPage))
else
sprintf("%d", ceiling(kqo@totalResults / res$meta$itemsPerPage)),
' in ',
res$meta$benchmark,
'\n'
))
}
page <- page + 1
results <- results + res$meta$itemsPerPage
if (nrow(collectedMatches) >= kqo@totalResults || (!is.na(maxFetch) && results >= maxFetch)) {
break
}
}
nextStartIndex <- min(res$meta$startIndex + res$meta$itemsPerPage, kqo@totalResults)
KorAPQuery(nextStartIndex = nextStartIndex,
korapConnection = kqo@korapConnection,
fields = kqo@fields,
requestUrl = kqo@requestUrl,
request = kqo@request,
totalResults = kqo@totalResults,
vc = kqo@vc,
webUIRequestUrl = kqo@webUIRequestUrl,
hasMoreMatches = (kqo@totalResults > nextStartIndex),
apiResponse = res,
collectedMatches = collectedMatches)
})
#' Fetch all results of a KorAP query.
#'
#' **`fetchAll`** fetches all results of a KorAP query.
#'
#' @examples
#' \dontrun{
#'
#' q <- new("KorAPConnection") %>% corpusQuery("Ameisenplage") %>% fetchAll()
#' q@collectedMatches
#' }
#'
#' @aliases fetchAll
#' @rdname KorAPQuery-class
#' @export
setMethod("fetchAll", "KorAPQuery", function(kqo, verbose = kqo@korapConnection@verbose, ...) {
return(fetchNext(kqo, offset = 0, maxFetch = NA, verbose = verbose, ...))
})
#' Fetches the remaining results of a KorAP query.
#'
#' @examples
#' \dontrun{
#'
#' q <- new("KorAPConnection") %>% corpusQuery("Ameisenplage") %>% fetchRest()
#' q@collectedMatches
#' }
#'
#' @aliases fetchRest
#' @rdname KorAPQuery-class
#' @export
setMethod("fetchRest", "KorAPQuery", function(kqo, verbose = kqo@korapConnection@verbose, ...) {
return(fetchNext(kqo, maxFetch = NA, verbose = verbose, ...))
})
#' Query relative frequency of search term(s)
#'
#' **`frequencyQuery`** combines [corpusQuery()], [corpusStats()] and
#' [ci()] to compute a table with the relative frequencies and
#' confidence intervals of one ore multiple search terms across one or multiple
#' virtual corpora.
#'
#' @aliases frequencyQuery
#' @rdname KorAPQuery-class
#' @examples
#' \dontrun{
#'
#' new("KorAPConnection", verbose = TRUE) %>%
#' frequencyQuery(c("Mücke", "Schnake"), paste0("pubDate in ", 2000:2003))
#' }
#'
#' @param kco [KorAPConnection()] object (obtained e.g. from `new("KorAPConnection")`
#' @param query string that contains the corpus query. The query language depends on the `ql` parameter. Either `query` must be provided or `KorAPUrl`.
#' @param conf.level confidence level of the returned confidence interval (passed through [ci()] to [prop.test()]).
#' @param as.alternatives LOGICAL that specifies if the query terms should be treated as alternatives. If `as.alternatives` is TRUE, the sum over all query hits, instead of the respective vc token sizes is used as total for the calculation of relative frequencies.
#' @export
setMethod("frequencyQuery", "KorAPConnection",
function(kco, query, vc = "", conf.level = 0.95, as.alternatives = FALSE, ...) {
(if (as.alternatives) {
corpusQuery(kco, query, vc, metadataOnly = TRUE, as.df = TRUE, ...) %>%
group_by(vc) %>%
mutate(total = sum(totalResults))
} else {
corpusQuery(kco, query, vc, metadataOnly = TRUE, as.df = TRUE, ...) %>%
mutate(total = corpusStats(kco, vc=vc, as.df=TRUE)$tokens)
} ) %>%
ci(conf.level = conf.level)
})
#' buildWebUIRequestUrlFromString
#'
#' @rdname KorAPQuery-class
#' @importFrom urltools url_encode
#' @export
buildWebUIRequestUrlFromString <- function(KorAPUrl,
query,
vc = "",
ql = "poliqarp"
) {
if ("KorAPConnection" %in% class(KorAPUrl)) {
KorAPUrl <- KorAPUrl@KorAPUrl
}
request <-
paste0(
'?q=',
urltools::url_encode(enc2utf8(as.character(query))),
ifelse(vc != '',
paste0('&cq=', urltools::url_encode(enc2utf8(vc))),
''),
'&ql=',
ql
)
paste0(KorAPUrl, request)
}
#' buildWebUIRequestUrl
#'
#' @rdname KorAPQuery-class
#' @importFrom httr parse_url
#' @export
buildWebUIRequestUrl <- function(kco,
query = if (missing(KorAPUrl))
stop("At least one of the parameters query and KorAPUrl must be specified.", call. = FALSE)
else
httr::parse_url(KorAPUrl)$query$q,
vc = if (missing(KorAPUrl)) "" else httr::parse_url(KorAPUrl)$query$cq,
KorAPUrl,
ql = if (missing(KorAPUrl)) "poliqarp" else httr::parse_url(KorAPUrl)$query$ql) {
buildWebUIRequestUrlFromString(kco@KorAPUrl, query, vc, ql)
}
#´ format()
#' @rdname KorAPQuery-class
#' @param x KorAPQuery object
#' @param ... further arguments passed to or from other methods
#' @export
format.KorAPQuery <- function(x, ...) {
cat("<KorAPQuery>\n")
q <- x
aurl = parse_url(q@request)
cat(" Query: ", aurl$query$q, "\n")
if (!is.null(aurl$query$cq) && aurl$query$cq != "") {
cat(" Virtual corpus: ", aurl$query$cq, "\n")
}
if (!is.null(q@collectedMatches)) {
cat("==============================================================================================================", "\n")
print(summary(q@collectedMatches))
cat("==============================================================================================================", "\n")
}
cat(" Total results: ", q@totalResults, "\n")
cat(" Fetched results: ", q@nextStartIndex, "\n")
}
#' show()
#'
#' @rdname KorAPQuery-class
#' @param object KorAPQuery object
#' @export
setMethod("show", "KorAPQuery", function(object) {
format(object)
})