Migrate to S4 Classes
Change-Id: I27e9452e9d59f6b414898390074908ec0e91e2a9
diff --git a/DESCRIPTION b/DESCRIPTION
index a554477..e85a540 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -12,4 +12,10 @@
Imports:
curl,
jsonlite,
- utils
+ utils,
+ httr,
+ methods
+Collate:
+ 'KorAPConnection.R'
+ 'KorAPCorpusStats.R'
+ 'KorAPQuery.R'
diff --git a/NAMESPACE b/NAMESPACE
index 8728527..4f4c1c5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,11 +1,17 @@
# Generated by roxygen2: do not edit by hand
-export(KorAPConnection)
-export(KorAPCorpusStats)
-export(KorAPFetchAll)
-export(KorAPFetchNext)
-export(KorAPFetchRest)
-export(KorAPQuery)
-import(curl)
+S3method(format,KorAPQuery)
+exportClasses(KorAPConnection)
+exportClasses(KorAPCorpusStats)
+exportClasses(KorAPQuery)
+exportMethods(corpusQuery)
+exportMethods(corpusStats)
+exportMethods(fetchAll)
+exportMethods(fetchNext)
+exportMethods(fetchRest)
+exportMethods(initialize)
+exportMethods(show)
+import(httr)
import(jsonlite)
+import(methods)
import(utils)
diff --git a/R/KorAPConnection.R b/R/KorAPConnection.R
index 85b12e4..84aec06 100644
--- a/R/KorAPConnection.R
+++ b/R/KorAPConnection.R
@@ -1,28 +1,63 @@
-#' @import jsonlite
-#' @import curl
-#' @import utils
-
-defaultKorAPUrl <- "https://korap.ids-mannheim.de/"
-
-#' Connect to a KorAP server.
+#' Class KorAPConnection
#'
-#' @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 \code{KorAPConnection}) to provide all necessary information for the query.
-#' @param apiVersion which version of KorAP's API you want to connect to
-#' @param apiUrl url of the KorAP web service
-#' @return object that contains all connection information and can be used with \code{\link{KorAPQuery}}
+#' \code{KorAPConnection} objetcs represent the connection to a KorAP server.
+#' New \code{KorAPConnection} objects can be created by \code{KorAPConnection()}
+#'
+#' @import jsonlite
+#' @import utils
+#' @import methods
+#'
+#'
+
+#' @export
+KorAPConnection <- setClass("KorAPConnection", slots=c(KorAPUrl="character", apiVersion="character", apiUrl="character"))
+
+#' @param .Object KorAPConnection object
+#' @param KorAPUrl the URL of the KorAP server instance you want to access.
+#' @param apiVersion which version of KorAP's API you want to connect to.
+#' @param apiUrl URL of the KorAP web service.
+#' @return \code{\link{KorAPConnection}} object that can be used e.g. with \code{\link{corpusQuery}}
+#'
+#' @examples
+#' kcon <- new("KorAPConnection")
+#' kq <- corpusQuery(kcon, "Ameisenplage")
+#' kq <- fetchAll(kq, verbose=TRUE)
#'
#' @note Currently it is not possible to authenticate the client
#'
+#' @rdname KorAPConnection-class
#' @export
-KorAPConnection <- function(KorAPUrl=defaultKorAPUrl, apiVersion='v1.0', apiUrl) {
- m <-regexpr("https?://[^?]+", KorAPUrl, perl = TRUE)
- KorAPUrl <- regmatches(KorAPUrl, m)
- if (!endsWith(KorAPUrl, '/')) {
- KorAPUrl <- paste0(KorAPUrl, "/")
- }
- if (missing(apiUrl)) {
- apiUrl = paste0(KorAPUrl, 'api/', apiVersion, '/')
- }
- con <- data.frame(apiUrl, KorAPUrl, apiVersion)
- return(con)
-}
+setMethod("initialize", "KorAPConnection",
+ function(.Object, KorAPUrl = "https://korap.ids-mannheim.de/", apiVersion = 'v1.0', apiUrl) {
+ .Object <- callNextMethod()
+ m <- regexpr("https?://[^?]+", KorAPUrl, perl = TRUE)
+ .Object@KorAPUrl <- regmatches(KorAPUrl, m)
+ if (!endsWith(.Object@KorAPUrl, '/')) {
+ .Object@KorAPUrl <- paste0(.Object@KorAPUrl, "/")
+ }
+ if (missing(apiUrl)) {
+ .Object@apiUrl = paste0(.Object@KorAPUrl, 'api/', apiVersion, '/')
+ } else {
+ .Object@apiUrl = apiUrl
+ }
+ .Object@apiVersion = apiVersion
+ .Object
+ })
+
+#' @rdname KorAPConnection-class
+#' @param object KorAPConnection object
+#' @export
+setMethod("show", "KorAPConnection", function(object) {
+ cat("<KorAPConnection>", "\n")
+ cat("apiUrl: ", object@apiUrl, "\n")
+})
+
+#' Funtion KorAPConnection()
+#'
+#' Wrappper function for new("KorAPConnection")
+#'
+#' @rdname KorAPConnection-constructor
+#' @name KorAPConnection-constructor
+#' @export
+# KorAPConnection <- function(...) new("KorAPConnection", ...)
+
diff --git a/R/KorAPCorpusStats.R b/R/KorAPCorpusStats.R
index fb30b5d..dc60133 100644
--- a/R/KorAPCorpusStats.R
+++ b/R/KorAPCorpusStats.R
@@ -1,21 +1,50 @@
-#' @import jsonlite
-#' @import curl
+#' Class KorAPCorpusStats
+#'
+#' \code{KorAPCorpusStats} objetcs can hold information about a corpus or virtual corpus.
+#' \code{KorAPCorpusStats} objects can be obtained by the \code{\link{corpusStats}()} method.
+#'
+#' @include KorAPConnection.R
+#'
+#' @export
+#' @slot vc definition of the virtual corpus
+#' @slot tokens number of tokens
+#' @slot documents number of documents
+#' @slot sentences number of sentences
+#' @slot paragraphs number of paragraphs
+setClass("KorAPCorpusStats", slots=c(vc="character", documents="numeric", tokens="numeric", sentences="numeric", paragraphs="numeric"))
-dummy <- NA # without this roxygen2 fails
+setGeneric("corpusStats", function(kco, ...) standardGeneric("corpusStats") )
#' Fetch information about a (virtual) corpus
-#' @param con object obtained from \code{\link{KorAPConnection}}
-#' @param query object returned from \code{\link{KorAPQuery}}
+#' @param kco \code{\link{KorAPConnection}} object (obtained e.g. from \code{new("KorAPConnection")}
#' @param vc string describing the virtual corpus. An empty string (default) means the whole corpus, as far as it is license-wise accessible.
+#' @return \code{KorAPCorpusStats} object with the slots \code{documents}, \code{tokens}, \code{sentences}, \code{paragraphs}
+#'
+#' @examples
+#' corpusStats(new("KorAPConnection"))
+#'
+#' kco <- new("KorAPConnection")
+#' corpusStats(kco, "pubDate in 2017 & articleType=/Zeitung.*/")
+#'
+#' @aliases corpusStats
#' @export
-#' @return object with the fields \code{$documents}, \code{$tokens}, \code{$sentences}, \code{$paragraphs}
-KorAPCorpusStats <- function(con, vc, query) {
- if ((missing(query) && missing(vc)) || !(missing(query) || missing(vc))) {
- stop("Exaclty one of the parameters query and vc must be specified.")
+setMethod("corpusStats", "KorAPConnection", function(kco, vc="") {
+ url <- paste0(kco@apiUrl, 'statistics?cq=', URLencode(vc, reserved=TRUE))
+ res <- fromJSON(url)
+ new("KorAPCorpusStats", vc = vc, documents = res$documents, tokens = res$tokens, sentences = res$sentences, paragraphs = res$paragraphs)
+})
+
+#' @rdname KorAPCorpusStats-class
+#' @param object KorAPCorpusStats object
+#' @export
+setMethod("show", "KorAPCorpusStats", function(object) {
+ cat("<KorAPCorpusStats>", "\n")
+ if (object@vc == "") {
+ cat("The whole corpus")
+ } else {
+ cat("The virtual corpus described by \"", object@vc, "\"", sep="")
}
- if (missing(vc)) {
- vc = query$vc
- }
- url <- paste0(con$apiUrl, 'statistics?cq=', URLencode(vc, reserved=TRUE))
- return(fromJSON(url))
-}
+ cat(" contains", formatC(object@tokens, format="f", digits=0, big.mark=","), "tokens in",
+ formatC(object@sentences, format="d", big.mark=","), "sentences in",
+ formatC(object@documents, format="d", big.mark=","), "documents.\n")
+})
diff --git a/R/KorAPQuery.R b/R/KorAPQuery.R
index 1d36e8d..c02b87b 100644
--- a/R/KorAPQuery.R
+++ b/R/KorAPQuery.R
@@ -1,13 +1,67 @@
+#' Class KorAPQuery
+#'
+#' \code{KorAPQuery} objetcs represent the current state of a query to a KorAP server.
+#' New \code{KorAPQuery} objects are typically created by the \code{\link{corpusQuery}} method.
+#'
+#' @include KorAPConnection.R
#' @import jsonlite
-#' @import curl
-#' @import utils
+#' @import httr
+#'
+#'
-defaultFields <- c("corpusSigle", "textSigle", "pubDate", "pubPlace",
- "availability", "textClass", "snippet")
+#' @export
+KorAPQuery <- setClass("KorAPQuery", slots = c(
+ "request",
+ "vc",
+ "totalResults",
+ "nextStartIndex",
+ "fields",
+ "requestUrl",
+ "webUIRequestUrl",
+ "apiResponse",
+ "collectedMatches",
+ "hasMoreMatches"
+))
-contentFields <- c("snippet")
+#' Method initialize
+#'
+#' @rdname KorAPQuery-class
+#' @param .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 boolean that signals if more query results can be fetched
+#' @param collectedMatches matches already fetched from the KorAP-API-server
+#' @export
+setMethod("initialize", "KorAPQuery",
+ function(.Object, request = NULL, vc="", totalResults=0, nextStartIndex=0, fields=c("corpusSigle", "textSigle", "pubDate", "pubPlace",
+ "availability", "textClass", "snippet"),
+ requestUrl="", webUIRequestUrl = "", apiResponse = NULL, hasMoreMatches= FALSE, collectedMatches = NULL) {
+ .Object <- callNextMethod()
+ .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
+ })
-maxResultsPerPage <- 50;
+setGeneric("corpusQuery", function(kco, ...) standardGeneric("corpusQuery") )
+setGeneric("fetchAll", function(kqo, ...) standardGeneric("fetchAll") )
+setGeneric("fetchNext", function(kqo, ...) standardGeneric("fetchNext") )
+setGeneric("fetchRest", function(kqo, ...) standardGeneric("fetchRest") )
+
+maxResultsPerPage <- 50
QueryParameterFromUrl <- function(url, parameter) {
regex <- paste0(".*[?&]", parameter, "=([^&]*).*")
@@ -22,8 +76,11 @@
return(URLdecode(gsub(".*[?&]q=([^&]*).*", '\\1', KorAPUrl, perl = TRUE)))
}
-#' Send a query to a KorAP connection.
-#' @param con object obtained from \code{\link{KorAPConnection}}, that contains all necessary connection information
+#' Method corpusQuery
+#'
+#' Perform a corpus query via a connection to a KorAP-API-server.
+#'
+#' @param kco \code{\link{KorAPConnection}} object (obtained e.g. from \code{new("KorAPConnection")}
#' @param query string that contains the corpus query. The query langauge depends on the \code{ql} parameter. Either \code{query} must be provided or \code{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 \code{KorAPConnection}) to provide all necessary information for the query.
@@ -32,99 +89,106 @@
#' @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 insufficent rights (not yet implemented)
#' @param verbose print some info
-#' @return A KorAP query object that, among other information, contains the total number of results in \code{$meta$totalResults}. The resulting object can be used to fetch all query results (with \code{\link{KorAPFetchAll}}) or the next page of results (with \code{\link{KorAPFetchNext}}).
-#' A correspunding URL to be used within a web browser is contained in \code{$webUIRequestUrl}
+#' @return A \code{\link{KorAPQuery}} object that, among other information, contains the total number of results in \code{@totalResults}. The resulting object can be used to fetch all query results (with \code{\link{fetchAll}}) or the next page of results (with \code{\link{fetchNext}}).
+#' A corresponding URL to be used within a web browser is contained in \code{@webUIRequestUrl}
#' Please make sure to check \code{$collection$rewrites} to see if any unforseen access rewrites of the query's virtual corpus had to be performed.
#'
#' @examples
-#' con <- KorAPConnection()
-#' q <- KorAPQuery(con, "Ameisenplage")
-#' q <- KorAPFetchAll(q)
-#' summary(q$collectedMatches)
+#' kco <- new("KorAPConnection")
+#' kqo <- corpusQuery(kco, "Ameisenplage")
+#' kqo <- fetchAll(kqo)
+#' kqo
#'
-#' q <- KorAPQuery(con,
+#' kqo <- corpusQuery(kco,
#' KorAPUrl = "https://korap.ids-mannheim.de/?q=Ameise&cq=pubDate+since+2017&ql=poliqarp")
-#' q$meta$totalResults
+#' kqo
#'
-#' q <- KorAPQuery(con, "Ameisenplage")
-#' q <- KorAPFetchAll(q, verbose=TRUE)
-#' tokensPerYear <- function(year) { return(KorAPCorpusStats(con, paste("pubDate in", year))$tokens) }
-#' df <- as.data.frame(table(as.numeric(format(q$collectedMatches$pubDate,"%Y")), dnn="year"),
+#' q <- corpusQuery(kco, "Ameisenplage")
+#' q <- fetchAll(q, verbose=TRUE)
+#' tokensPerYear <- function(year) { return(corpusStats(kco, paste("pubDate in", year))@tokens) }
+#' df <- as.data.frame(table(as.numeric(format(q@collectedMatches$pubDate,"%Y")), dnn="year"),
#' stringsAsFactors = FALSE)
#' df$ipm <- 1000000 * df$Freq / tokensPerYear(df$year)
#' plot(df$year, df$ipm, type="l")
#'
-#' @seealso \code{\link{KorAPConnection}}, \code{\link{KorAPFetchNext}}, \code{\link{KorAPFetchRest}}, \code{\link{KorAPFetchAll}}, \code{\link{KorAPCorpusStats}}
+#' @seealso \code{\link{KorAPConnection}}, \code{\link{fetchNext}}, \code{\link{fetchRest}}, \code{\link{fetchAll}}, \code{\link{corpusStats}}
#'
#' @references
#' \url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
#'
+#' @aliases corpusQuery
#' @export
-KorAPQuery <- function(con, query, vc="", KorAPUrl, metadataOnly = TRUE, ql = "poliqarp", fields = defaultFields,
- accessRewriteFatal = TRUE, verbose=FALSE) {
- if (missing(query) && missing(KorAPUrl) || ! (missing(query) || missing(KorAPUrl))) {
- stop("Exactly one of the parameters query and KorAPUrl must be specified.")
- }
- if (missing(query)) {
- query <- QueryParameterFromUrl(KorAPUrl, "q")
- vc <- QueryParameterFromUrl(KorAPUrl, "vc")
- ql <- QueryParameterFromUrl(KorAPUrl, "ql")
- }
- request <- paste0('?q=', URLencode(query, reserved=TRUE),
- ifelse(vc != '', paste0('&cq=', URLencode(vc, reserved=TRUE)), ''), '&ql=', ql)
- webUIRequestUrl <- paste0(con$KorAPUrl, request)
- requestUrl <- paste0(con$apiUrl, 'search', request,
- '&fields=', paste(defaultFields, collapse = ","),
- ifelse(metadataOnly, '&access-rewrite-disabled=true', ''))
- if (verbose) {
- cat(paste0(webUIRequestUrl, "\n"))
- }
- result <- fromJSON(paste0(requestUrl, '&count=1'))
- result$fields <- fields[!fields %in% contentFields]
- result$requestUrl <- requestUrl
- result$request <- request
- result$vc <- vc
- result$webUIRequestUrl <- webUIRequestUrl
- result$nextStartIndex <- 0
- result$hasMoreMatches <- (result$meta$totalResults > 0)
- return(result)
-}
+setMethod("corpusQuery", "KorAPConnection",
+ function(kco, query, vc="", KorAPUrl, metadataOnly = TRUE, ql = "poliqarp", fields = defaultFields,
+ accessRewriteFatal = TRUE, verbose=FALSE) {
+ defaultFields <- c("corpusSigle", "textSigle", "pubDate", "pubPlace",
+ "availability", "textClass", "snippet")
+ contentFields <- c("snippet")
+
+ if (missing(query) && missing(KorAPUrl) || ! (missing(query) || missing(KorAPUrl))) {
+ stop("Exactly one of the parameters query and KorAPUrl must be specified.")
+ }
+ if (missing(query)) {
+ query <- QueryParameterFromUrl(KorAPUrl, "q")
+ vc <- QueryParameterFromUrl(KorAPUrl, "vc")
+ ql <- QueryParameterFromUrl(KorAPUrl, "ql")
+ }
+ request <- paste0('?q=', URLencode(query, reserved=TRUE),
+ ifelse(vc != '', paste0('&cq=', URLencode(vc, reserved=TRUE)), ''), '&ql=', ql)
+ webUIRequestUrl <- paste0(kco@KorAPUrl, request)
+ requestUrl <- paste0(kco@apiUrl, 'search', request,
+ '&fields=', paste(defaultFields, collapse = ","),
+ ifelse(metadataOnly, '&access-rewrite-disabled=true', ''))
+ if (verbose) {
+ cat(paste0(webUIRequestUrl, "\n"))
+ }
+ res = fromJSON(paste0(requestUrl, '&count=1'))
+ KorAPQuery(
+ nextStartIndex = 0,
+ fields = fields[!fields %in% contentFields],
+ requestUrl = requestUrl,
+ request = request,
+ totalResults = res$meta$totalResults,
+ vc = vc,
+ apiResponse = res,
+ webUIRequestUrl = webUIRequestUrl,
+ hasMoreMatches = (res$meta$totalResults > 0),
+ )
+ })
#' Fetch the next bunch of results of a KorAP query.
-#' @param queryObject object obtained from \code{\link{KorAPQuery}}
+#'
+#' @param kqo object obtained from \code{\link{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
-#' @return The \code{queryObject} input parameter with updated fields \code{$collectedMatches}, \code{$matches} (latest bunch only), \code{$nextStartIndex}, , \code{$hasMoreMatches}
-#'
-#' @examples
-#' q <- KorAPFetchNext(KorAPQuery(KorAPConnection(), "Ameisenplage"))
-#'
-#' @seealso \code{\link{KorAPFetchRest}}, \code{\link{KorAPFetchAll}}
+#' @return The \code{kqo} input object with updated slots \code{collectedMatches}, \code{apiResponse}, \code{nextStartIndex}, \code{hasMoreMatches}
#'
#' @references
#' \url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
#'
+#' @aliases fetchNext
+#' @rdname KorAPQuery-class
#' @export
-KorAPFetchNext <- function(queryObject, offset = queryObject$nextStartIndex, maxFetch = maxResultsPerPage, verbose = FALSE) {
- if (queryObject$meta$totalResults == 0 || offset >= queryObject$meta$totalResults) {
- return(queryObject)
+setMethod("fetchNext", "KorAPQuery", function(kqo, offset = kqo@nextStartIndex, maxFetch = maxResultsPerPage, verbose = FALSE) {
+ if (kqo@totalResults == 0 || offset >= kqo@totalResults) {
+ return(kqo)
}
page <- 1
results <- 0
pubDate <- NULL # https://stackoverflow.com/questions/8096313/no-visible-binding-for-global-variable-note-in-r-cmd-check
- collectedMatches <- queryObject$collectedMatches
+ collectedMatches <- kqo@collectedMatches
repeat {
- res <- fromJSON(paste0(queryObject$requestUrl, '&count=', min(ifelse(!is.na(maxFetch), maxFetch - results, maxResultsPerPage), maxResultsPerPage) ,'&offset=', offset + results))
- if (res$meta$totalResults == 0) { return(data.frame()) }
- for (field in queryObject$fields) {
+ res <- fromJSON(paste0(kqo@requestUrl, '&count=', min(ifelse(!is.na(maxFetch), maxFetch - results, maxResultsPerPage), maxResultsPerPage) ,'&offset=', offset + results))
+ if (res$meta$totalResults == 0) { return(kqo) }
+ for (field in kqo@fields) {
if (!field %in% colnames(res$matches)) {
res$matches[, field] <- NA
}
}
- currentMatches <- res$matches[queryObject$fields]
+ currentMatches <- res$matches[kqo@fields]
factorCols <- colnames(subset(currentMatches, select=-c(pubDate)))
currentMatches[factorCols] <- lapply(currentMatches[factorCols], factor)
currentMatches$pubDate = as.Date(currentMatches$pubDate, format = "%Y-%m-%d")
@@ -142,50 +206,72 @@
break
}
}
- res$nextStartIndex <- res$meta$startIndex + res$meta$itemsPerPage
- res$fields <- queryObject$fields
- res$requestUrl <- queryObject$requestUrl
- res$request <- queryObject$request
- res$webUIRequestUrl <- queryObject$webUIRequestUrl
- res$hasMoreMatches <- (res$meta$totalResults > res$nextStartIndex)
- res$collectedMatches <- collectedMatches
- return(res)
-}
+ nextStartIndex <- min(res$meta$startIndex + res$meta$itemsPerPage, res$meta$totalResults)
+ KorAPQuery(nextStartIndex = nextStartIndex,
+ fields = kqo@fields,
+ requestUrl = kqo@requestUrl,
+ request = kqo@request,
+ totalResults = res$meta$totalResults,
+ vc = kqo@vc,
+ webUIRequestUrl = kqo@webUIRequestUrl,
+ hasMoreMatches = (res$meta$totalResults > nextStartIndex),
+ apiResponse = res,
+ collectedMatches = collectedMatches)
+})
#' Fetch all results of a KorAP query.
-#' @param queryObject object obtained from \code{\link{KorAPQuery}}
-#' @param verbose print progress information if true
-#' @return The \code{queryObject} input parameter with updated fields \code{$collectedMatches}, \code{$matches} (latest bunch only), \code{$nextStartIndex}, \code{$hasMoreMatches}
#'
#' @examples
-#' q <- KorAPFetchAll(KorAPQuery(KorAPConnection(), "Ameisenplage"))
-#' q$collectedMatches
+#' q <- fetchAll(corpusQuery(new("KorAPConnection"), "Ameisenplage"))
+#' q@collectedMatches
#'
-#' @seealso \code{\link{KorAPFetchRest}}, \code{\link{KorAPFetchNext}}
-#'
-#' @references
-#' \url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
-#'
+#' @aliases fetchAll
+#' @rdname KorAPQuery-class
#' @export
-KorAPFetchAll <- function(queryObject, verbose = FALSE) {
- return(KorAPFetchNext(queryObject, offset = 0, maxFetch = NA, verbose = verbose))
+setMethod("fetchAll", "KorAPQuery", function(kqo, verbose = FALSE) {
+ return(fetchNext(kqo, offset = 0, maxFetch = NA, verbose = verbose))
+})
+
+#' Fetches the remaining results of a KorAP query.
+#'
+#' @examples
+#' q <- fetchRest(fetchNext(corpusQuery(new("KorAPConnection"), "Ameisenplage")))
+#' q@collectedMatches
+#'
+#' @aliases fetchRest
+#' @rdname KorAPQuery-class
+#' @export
+setMethod("fetchRest", "KorAPQuery", function(kqo, verbose = FALSE) {
+ return(fetchNext(kqo, maxFetch = NA, verbose = verbose))
+})
+
+#´ 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$vc) && aurl$query$vc != "") {
+ cat("Virtual corpus: ", aurl$query$vc, "\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")
}
-#' Fetches all remaining results of a KorAP query.
-#' @param queryObject object obtained from \code{\link{KorAPQuery}}
-#' @param verbose print progress information if true
-#' @return The \code{queryObject} input parameter with updated fields \code{$collectedMatches}, \code{$matches} (latest bunch only), \code{$nextStartIndex}, \code{$hasMoreMatches}
+#' show()
#'
-#' @examples
-#' q <- KorAPFetchRest(KorAPFetchNext(KorAPQuery(KorAPConnection(), "Ameisenplage")))
-#' q$collectedMatches
-#'
-#' @seealso \code{\link{KorAPFetchAll}}, \code{\link{KorAPFetchNext}}
-#'
-#' @references
-#' \url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
-#'
+#' @rdname KorAPQuery-class
+#' @param object KorAPQuery object
#' @export
-KorAPFetchRest <- function(queryObject, verbose = FALSE) {
- return(KorAPFetchNext(queryObject, maxFetch = NA, verbose = verbose))
-}
+setMethod("show", "KorAPQuery", function(object) {
+ format(object)
+})
diff --git a/RKorAPClient.Rproj b/RKorAPClient.Rproj
index 270314b..6608f32 100644
--- a/RKorAPClient.Rproj
+++ b/RKorAPClient.Rproj
@@ -1,8 +1,8 @@
Version: 1.0
-RestoreWorkspace: Default
-SaveWorkspace: Default
-AlwaysSaveHistory: Default
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Yes
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
diff --git a/Readme.md b/Readme.md
index 1db9fd7..1e8e9be 100644
--- a/Readme.md
+++ b/Readme.md
@@ -14,7 +14,7 @@
library(devtools)
install_git("https://korap.ids-mannheim.de/gerrit/KorAP/RKorAPClient")
library(RKorAPClient)
-?KorAPQuery
+?corpusQuery
```
## Development and License
diff --git a/man/KorAPConnection-class.Rd b/man/KorAPConnection-class.Rd
new file mode 100644
index 0000000..2c4c60e
--- /dev/null
+++ b/man/KorAPConnection-class.Rd
@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/KorAPConnection.R
+\docType{class}
+\name{KorAPConnection-class}
+\alias{KorAPConnection-class}
+\alias{KorAPConnection}
+\alias{initialize,KorAPConnection-method}
+\alias{show,KorAPConnection-method}
+\title{Class KorAPConnection}
+\usage{
+\S4method{initialize}{KorAPConnection}(.Object,
+ KorAPUrl = "https://korap.ids-mannheim.de/", apiVersion = "v1.0",
+ apiUrl)
+
+\S4method{show}{KorAPConnection}(object)
+}
+\arguments{
+\item{.Object}{KorAPConnection object}
+
+\item{KorAPUrl}{the URL of the KorAP server instance you want to access.}
+
+\item{apiVersion}{which version of KorAP's API you want to connect to.}
+
+\item{apiUrl}{URL of the KorAP web service.}
+
+\item{object}{KorAPConnection object}
+}
+\value{
+\code{\link{KorAPConnection}} object that can be used e.g. with \code{\link{corpusQuery}}
+}
+\description{
+\code{KorAPConnection} objetcs represent the connection to a KorAP server.
+New \code{KorAPConnection} objects can be created by \code{KorAPConnection()}
+}
+\note{
+Currently it is not possible to authenticate the client
+}
+\examples{
+kcon <- new("KorAPConnection")
+kq <- corpusQuery(kcon, "Ameisenplage")
+kq <- fetchAll(kq, verbose=TRUE)
+
+}
diff --git a/man/KorAPConnection.Rd b/man/KorAPConnection.Rd
deleted file mode 100644
index 1fb436f..0000000
--- a/man/KorAPConnection.Rd
+++ /dev/null
@@ -1,25 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/KorAPConnection.R
-\name{KorAPConnection}
-\alias{KorAPConnection}
-\title{Connect to a KorAP server.}
-\usage{
-KorAPConnection(KorAPUrl = defaultKorAPUrl, apiVersion = "v1.0",
- apiUrl)
-}
-\arguments{
-\item{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 \code{KorAPConnection}) to provide all necessary information for the query.}
-
-\item{apiVersion}{which version of KorAP's API you want to connect to}
-
-\item{apiUrl}{url of the KorAP web service}
-}
-\value{
-object that contains all connection information and can be used with \code{\link{KorAPQuery}}
-}
-\description{
-Connect to a KorAP server.
-}
-\note{
-Currently it is not possible to authenticate the client
-}
diff --git a/man/KorAPCorpusStats-class.Rd b/man/KorAPCorpusStats-class.Rd
new file mode 100644
index 0000000..4b8b98a
--- /dev/null
+++ b/man/KorAPCorpusStats-class.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/KorAPCorpusStats.R
+\docType{class}
+\name{KorAPCorpusStats-class}
+\alias{KorAPCorpusStats-class}
+\alias{show,KorAPCorpusStats-method}
+\title{Class KorAPCorpusStats}
+\usage{
+\S4method{show}{KorAPCorpusStats}(object)
+}
+\arguments{
+\item{object}{KorAPCorpusStats object}
+}
+\description{
+\code{KorAPCorpusStats} objetcs can hold information about a corpus or virtual corpus.
+\code{KorAPCorpusStats} objects can be obtained by the \code{\link{corpusStats}()} method.
+}
+\section{Slots}{
+
+\describe{
+\item{\code{vc}}{definition of the virtual corpus}
+
+\item{\code{tokens}}{number of tokens}
+
+\item{\code{documents}}{number of documents}
+
+\item{\code{sentences}}{number of sentences}
+
+\item{\code{paragraphs}}{number of paragraphs}
+}}
+
diff --git a/man/KorAPCorpusStats.Rd b/man/KorAPCorpusStats.Rd
deleted file mode 100644
index 71066b2..0000000
--- a/man/KorAPCorpusStats.Rd
+++ /dev/null
@@ -1,21 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/KorAPCorpusStats.R
-\name{KorAPCorpusStats}
-\alias{KorAPCorpusStats}
-\title{Fetch information about a (virtual) corpus}
-\usage{
-KorAPCorpusStats(con, vc, query)
-}
-\arguments{
-\item{con}{object obtained from \code{\link{KorAPConnection}}}
-
-\item{vc}{string describing the virtual corpus. An empty string (default) means the whole corpus, as far as it is license-wise accessible.}
-
-\item{query}{object returned from \code{\link{KorAPQuery}}}
-}
-\value{
-object with the fields \code{$documents}, \code{$tokens}, \code{$sentences}, \code{$paragraphs}
-}
-\description{
-Fetch information about a (virtual) corpus
-}
diff --git a/man/KorAPFetchAll.Rd b/man/KorAPFetchAll.Rd
deleted file mode 100644
index 21b7036..0000000
--- a/man/KorAPFetchAll.Rd
+++ /dev/null
@@ -1,30 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/KorAPQuery.R
-\name{KorAPFetchAll}
-\alias{KorAPFetchAll}
-\title{Fetch all results of a KorAP query.}
-\usage{
-KorAPFetchAll(queryObject, verbose = FALSE)
-}
-\arguments{
-\item{queryObject}{object obtained from \code{\link{KorAPQuery}}}
-
-\item{verbose}{print progress information if true}
-}
-\value{
-The \code{queryObject} input parameter with updated fields \code{$collectedMatches}, \code{$matches} (latest bunch only), \code{$nextStartIndex}, \code{$hasMoreMatches}
-}
-\description{
-Fetch all results of a KorAP query.
-}
-\examples{
-q <- KorAPFetchAll(KorAPQuery(KorAPConnection(), "Ameisenplage"))
-q$collectedMatches
-
-}
-\references{
-\url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
-}
-\seealso{
-\code{\link{KorAPFetchRest}}, \code{\link{KorAPFetchNext}}
-}
diff --git a/man/KorAPFetchNext.Rd b/man/KorAPFetchNext.Rd
deleted file mode 100644
index 66f8aa9..0000000
--- a/man/KorAPFetchNext.Rd
+++ /dev/null
@@ -1,34 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/KorAPQuery.R
-\name{KorAPFetchNext}
-\alias{KorAPFetchNext}
-\title{Fetch the next bunch of results of a KorAP query.}
-\usage{
-KorAPFetchNext(queryObject, offset = queryObject$nextStartIndex,
- maxFetch = maxResultsPerPage, verbose = FALSE)
-}
-\arguments{
-\item{queryObject}{object obtained from \code{\link{KorAPQuery}}}
-
-\item{offset}{start offset for query results to fetch}
-
-\item{maxFetch}{maximum number of query results to fetch}
-
-\item{verbose}{print progress information if true}
-}
-\value{
-The \code{queryObject} input parameter with updated fields \code{$collectedMatches}, \code{$matches} (latest bunch only), \code{$nextStartIndex}, , \code{$hasMoreMatches}
-}
-\description{
-Fetch the next bunch of results of a KorAP query.
-}
-\examples{
-q <- KorAPFetchNext(KorAPQuery(KorAPConnection(), "Ameisenplage"))
-
-}
-\references{
-\url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
-}
-\seealso{
-\code{\link{KorAPFetchRest}}, \code{\link{KorAPFetchAll}}
-}
diff --git a/man/KorAPFetchRest.Rd b/man/KorAPFetchRest.Rd
deleted file mode 100644
index a9d4f03..0000000
--- a/man/KorAPFetchRest.Rd
+++ /dev/null
@@ -1,30 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/KorAPQuery.R
-\name{KorAPFetchRest}
-\alias{KorAPFetchRest}
-\title{Fetches all remaining results of a KorAP query.}
-\usage{
-KorAPFetchRest(queryObject, verbose = FALSE)
-}
-\arguments{
-\item{queryObject}{object obtained from \code{\link{KorAPQuery}}}
-
-\item{verbose}{print progress information if true}
-}
-\value{
-The \code{queryObject} input parameter with updated fields \code{$collectedMatches}, \code{$matches} (latest bunch only), \code{$nextStartIndex}, \code{$hasMoreMatches}
-}
-\description{
-Fetches all remaining results of a KorAP query.
-}
-\examples{
-q <- KorAPFetchRest(KorAPFetchNext(KorAPQuery(KorAPConnection(), "Ameisenplage")))
-q$collectedMatches
-
-}
-\references{
-\url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
-}
-\seealso{
-\code{\link{KorAPFetchAll}}, \code{\link{KorAPFetchNext}}
-}
diff --git a/man/KorAPQuery-class.Rd b/man/KorAPQuery-class.Rd
new file mode 100644
index 0000000..68d8907
--- /dev/null
+++ b/man/KorAPQuery-class.Rd
@@ -0,0 +1,90 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/KorAPQuery.R
+\docType{class}
+\name{KorAPQuery-class}
+\alias{KorAPQuery-class}
+\alias{KorAPQuery}
+\alias{initialize,KorAPQuery-method}
+\alias{fetchNext,KorAPQuery-method}
+\alias{fetchNext}
+\alias{fetchAll,KorAPQuery-method}
+\alias{fetchAll}
+\alias{fetchRest,KorAPQuery-method}
+\alias{fetchRest}
+\alias{format.KorAPQuery}
+\alias{show,KorAPQuery-method}
+\title{Class KorAPQuery}
+\usage{
+\S4method{initialize}{KorAPQuery}(.Object, request = NULL, vc = "",
+ totalResults = 0, nextStartIndex = 0, fields = c("corpusSigle",
+ "textSigle", "pubDate", "pubPlace", "availability", "textClass",
+ "snippet"), requestUrl = "", webUIRequestUrl = "",
+ apiResponse = NULL, hasMoreMatches = FALSE,
+ collectedMatches = NULL)
+
+\S4method{fetchNext}{KorAPQuery}(kqo, offset = kqo@nextStartIndex,
+ maxFetch = maxResultsPerPage, verbose = FALSE)
+
+\S4method{fetchAll}{KorAPQuery}(kqo, verbose = FALSE)
+
+\S4method{fetchRest}{KorAPQuery}(kqo, verbose = FALSE)
+
+\method{format}{KorAPQuery}(x, ...)
+
+\S4method{show}{KorAPQuery}(object)
+}
+\arguments{
+\item{.Object}{…}
+
+\item{request}{query part of the request URL}
+
+\item{vc}{definition of a virtual corpus}
+
+\item{totalResults}{number of hits the query has yielded}
+
+\item{nextStartIndex}{at what index to start the next fetch of query results}
+
+\item{fields}{what data / metadata fields should be collected}
+
+\item{requestUrl}{complete URL of the API request}
+
+\item{webUIRequestUrl}{URL of a web frontend request corresponding to the API request}
+
+\item{apiResponse}{data-frame representation of the JSON response of the API request}
+
+\item{hasMoreMatches}{boolean that signals if more query results can be fetched}
+
+\item{collectedMatches}{matches already fetched from the KorAP-API-server}
+
+\item{kqo}{object obtained from \code{\link{corpusQuery}}}
+
+\item{offset}{start offset for query results to fetch}
+
+\item{maxFetch}{maximum number of query results to fetch}
+
+\item{verbose}{print progress information if true}
+
+\item{x}{KorAPQuery object}
+
+\item{...}{further arguments passed to or from other methods}
+
+\item{object}{KorAPQuery object}
+}
+\value{
+The \code{kqo} input object with updated slots \code{collectedMatches}, \code{apiResponse}, \code{nextStartIndex}, \code{hasMoreMatches}
+}
+\description{
+\code{KorAPQuery} objetcs represent the current state of a query to a KorAP server.
+New \code{KorAPQuery} objects are typically created by the \code{\link{corpusQuery}} method.
+}
+\examples{
+q <- fetchAll(corpusQuery(new("KorAPConnection"), "Ameisenplage"))
+q@collectedMatches
+
+q <- fetchRest(fetchNext(corpusQuery(new("KorAPConnection"), "Ameisenplage")))
+q@collectedMatches
+
+}
+\references{
+\url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
+}
diff --git a/man/KorAPQuery.Rd b/man/KorAPQuery.Rd
deleted file mode 100644
index 1f50a83..0000000
--- a/man/KorAPQuery.Rd
+++ /dev/null
@@ -1,62 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/KorAPQuery.R
-\name{KorAPQuery}
-\alias{KorAPQuery}
-\title{Send a query to a KorAP connection.}
-\usage{
-KorAPQuery(con, query, vc = "", KorAPUrl, metadataOnly = TRUE,
- ql = "poliqarp", fields = defaultFields, accessRewriteFatal = TRUE,
- verbose = FALSE)
-}
-\arguments{
-\item{con}{object obtained from \code{\link{KorAPConnection}}, that contains all necessary connection information}
-
-\item{query}{string that contains the corpus query. The query langauge depends on the \code{ql} parameter. Either \code{query} must be provided or \code{KorAPUrl}}
-
-\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{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 \code{KorAPConnection}) to provide all necessary information for the query.}
-
-\item{metadataOnly}{boolean 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, unless the connection is authorized (currently not possible).}
-
-\item{ql}{string to choose the query language (see \href{https://github.com/KorAP/Kustvakt/wiki/Service:-Search-GET#user-content-parameters}{section on Query Parameters} in the Kustvakt-Wiki for possible values.}
-
-\item{fields}{(meta)data fields that will be fetched for every match}
-
-\item{accessRewriteFatal}{abort if query or given vc had to be rewritten due to insufficent rights (not yet implemented)}
-
-\item{verbose}{print some info}
-}
-\value{
-A KorAP query object that, among other information, contains the total number of results in \code{$meta$totalResults}. The resulting object can be used to fetch all query results (with \code{\link{KorAPFetchAll}}) or the next page of results (with \code{\link{KorAPFetchNext}}).
-A correspunding URL to be used within a web browser is contained in \code{$webUIRequestUrl}
-Please make sure to check \code{$collection$rewrites} to see if any unforseen access rewrites of the query's virtual corpus had to be performed.
-}
-\description{
-Send a query to a KorAP connection.
-}
-\examples{
-con <- KorAPConnection()
-q <- KorAPQuery(con, "Ameisenplage")
-q <- KorAPFetchAll(q)
-summary(q$collectedMatches)
-
-q <- KorAPQuery(con,
- KorAPUrl = "https://korap.ids-mannheim.de/?q=Ameise&cq=pubDate+since+2017&ql=poliqarp")
-q$meta$totalResults
-
-q <- KorAPQuery(con, "Ameisenplage")
-q <- KorAPFetchAll(q, verbose=TRUE)
-tokensPerYear <- function(year) { return(KorAPCorpusStats(con, paste("pubDate in", year))$tokens) }
-df <- as.data.frame(table(as.numeric(format(q$collectedMatches$pubDate,"\%Y")), dnn="year"),
- stringsAsFactors = FALSE)
-df$ipm <- 1000000 * df$Freq / tokensPerYear(df$year)
-plot(df$year, df$ipm, type="l")
-
-}
-\references{
-\url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
-}
-\seealso{
-\code{\link{KorAPConnection}}, \code{\link{KorAPFetchNext}}, \code{\link{KorAPFetchRest}}, \code{\link{KorAPFetchAll}}, \code{\link{KorAPCorpusStats}}
-}
diff --git a/man/corpusQuery-KorAPConnection-method.Rd b/man/corpusQuery-KorAPConnection-method.Rd
new file mode 100644
index 0000000..04abc71
--- /dev/null
+++ b/man/corpusQuery-KorAPConnection-method.Rd
@@ -0,0 +1,64 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/KorAPQuery.R
+\docType{methods}
+\name{corpusQuery,KorAPConnection-method}
+\alias{corpusQuery,KorAPConnection-method}
+\alias{corpusQuery}
+\title{Method corpusQuery}
+\usage{
+\S4method{corpusQuery}{KorAPConnection}(kco, query, vc = "", KorAPUrl,
+ metadataOnly = TRUE, ql = "poliqarp", fields = defaultFields,
+ accessRewriteFatal = TRUE, verbose = FALSE)
+}
+\arguments{
+\item{kco}{\code{\link{KorAPConnection}} object (obtained e.g. from \code{new("KorAPConnection")}}
+
+\item{query}{string that contains the corpus query. The query langauge depends on the \code{ql} parameter. Either \code{query} must be provided or \code{KorAPUrl}}
+
+\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{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 \code{KorAPConnection}) to provide all necessary information for the query.}
+
+\item{metadataOnly}{boolean 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, unless the connection is authorized (currently not possible).}
+
+\item{ql}{string to choose the query language (see \href{https://github.com/KorAP/Kustvakt/wiki/Service:-Search-GET#user-content-parameters}{section on Query Parameters} in the Kustvakt-Wiki for possible values.}
+
+\item{fields}{(meta)data fields that will be fetched for every match}
+
+\item{accessRewriteFatal}{abort if query or given vc had to be rewritten due to insufficent rights (not yet implemented)}
+
+\item{verbose}{print some info}
+}
+\value{
+A \code{\link{KorAPQuery}} object that, among other information, contains the total number of results in \code{@totalResults}. The resulting object can be used to fetch all query results (with \code{\link{fetchAll}}) or the next page of results (with \code{\link{fetchNext}}).
+A corresponding URL to be used within a web browser is contained in \code{@webUIRequestUrl}
+Please make sure to check \code{$collection$rewrites} to see if any unforseen access rewrites of the query's virtual corpus had to be performed.
+}
+\description{
+Perform a corpus query via a connection to a KorAP-API-server.
+}
+\examples{
+kco <- new("KorAPConnection")
+kqo <- corpusQuery(kco, "Ameisenplage")
+kqo <- fetchAll(kqo)
+kqo
+
+kqo <- corpusQuery(kco,
+ KorAPUrl = "https://korap.ids-mannheim.de/?q=Ameise&cq=pubDate+since+2017&ql=poliqarp")
+kqo
+
+q <- corpusQuery(kco, "Ameisenplage")
+q <- fetchAll(q, verbose=TRUE)
+tokensPerYear <- function(year) { return(corpusStats(kco, paste("pubDate in", year))@tokens) }
+df <- as.data.frame(table(as.numeric(format(q@collectedMatches$pubDate,"\%Y")), dnn="year"),
+ stringsAsFactors = FALSE)
+df$ipm <- 1000000 * df$Freq / tokensPerYear(df$year)
+plot(df$year, df$ipm, type="l")
+
+}
+\references{
+\url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
+}
+\seealso{
+\code{\link{KorAPConnection}}, \code{\link{fetchNext}}, \code{\link{fetchRest}}, \code{\link{fetchAll}}, \code{\link{corpusStats}}
+}
diff --git a/man/corpusStats-KorAPConnection-method.Rd b/man/corpusStats-KorAPConnection-method.Rd
new file mode 100644
index 0000000..6a4ccc2
--- /dev/null
+++ b/man/corpusStats-KorAPConnection-method.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/KorAPCorpusStats.R
+\docType{methods}
+\name{corpusStats,KorAPConnection-method}
+\alias{corpusStats,KorAPConnection-method}
+\alias{corpusStats}
+\title{Fetch information about a (virtual) corpus}
+\usage{
+\S4method{corpusStats}{KorAPConnection}(kco, vc = "")
+}
+\arguments{
+\item{kco}{\code{\link{KorAPConnection}} object (obtained e.g. from \code{new("KorAPConnection")}}
+
+\item{vc}{string describing the virtual corpus. An empty string (default) means the whole corpus, as far as it is license-wise accessible.}
+}
+\value{
+\code{KorAPCorpusStats} object with the slots \code{documents}, \code{tokens}, \code{sentences}, \code{paragraphs}
+}
+\description{
+Fetch information about a (virtual) corpus
+}
+\examples{
+corpusStats(new("KorAPConnection"))
+
+kco <- new("KorAPConnection")
+corpusStats(kco, "pubDate in 2017 & articleType=/Zeitung.*/")
+
+}