Don't run long running and redundant tests by default
use --run-donttest to run them
Change-Id: Idec047eff02b9a3e2dababc6c6fc0347ca43e5de
diff --git a/R/KorAPConnection.R b/R/KorAPConnection.R
index 9247af9..13a3b39 100644
--- a/R/KorAPConnection.R
+++ b/R/KorAPConnection.R
@@ -44,9 +44,11 @@
#' \code{\link{corpusQuery}}
#'
#' @examples
+#' \donttest{
#' kcon <- new("KorAPConnection", verbose = TRUE)
#' kq <- corpusQuery(kcon, "Ameisenplage")
#' kq <- fetchAll(kq)
+#' }
#'
#' \dontrun{
#' kcon <- new("KorAPConnection", verbose = TRUE, accessToken="e739u6eOzkwADQPdVChxFg")
diff --git a/R/KorAPQuery.R b/R/KorAPQuery.R
index cf848f0..26393d3 100644
--- a/R/KorAPQuery.R
+++ b/R/KorAPQuery.R
@@ -111,6 +111,7 @@
#' "https://korap.ids-mannheim.de/?q=Ameise&cq=pubDate+since+2017&ql=poliqarp")
#'
#' # Plot the time/frequency curve of "Ameisenplage"
+#' \donttest{
#' new("KorAPConnection", verbose=TRUE) %>%
#' { . ->> kco } %>%
#' corpusQuery("Ameisenplage") %>%
@@ -125,7 +126,7 @@
#' dplyr::select(-Count) %>%
#' complete(year = min(year):max(year), fill = list(Freq = 0)) %>%
#' plot(type = "l")
-#'
+#' }
#' @seealso \code{\link{KorAPConnection}}, \code{\link{fetchNext}}, \code{\link{fetchRest}}, \code{\link{fetchAll}}, \code{\link{corpusStats}}
#'
#' @references
@@ -226,6 +227,10 @@
#' @param verbose print progress information if true
#' @return The \code{kqo} input object with updated slots \code{collectedMatches}, \code{apiResponse}, \code{nextStartIndex}, \code{hasMoreMatches}
#'
+#' @examples
+#' q <- new("KorAPConnection") %>% corpusQuery("Ameisenplage") %>% fetchNext()
+#' q@collectedMatches
+#'
#' @references
#' \url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
#'
@@ -295,8 +300,10 @@
#' Fetch all results of a KorAP query.
#'
#' @examples
+#' \donttest{
#' q <- new("KorAPConnection") %>% corpusQuery("Ameisenplage") %>% fetchAll()
#' q@collectedMatches
+#' }
#'
#' @aliases fetchAll
#' @rdname KorAPQuery-class
@@ -308,8 +315,10 @@
#' Fetches the remaining results of a KorAP query.
#'
#' @examples
-#' q <- new("KorAPConnection") %>% corpusQuery("Ameisenplage") %>% fetchAll()
+#' \donttest{
+#' q <- new("KorAPConnection") %>% corpusQuery("Ameisenplage") %>% fetchRest()
#' q@collectedMatches
+#' }
#'
#' @aliases fetchRest
#' @rdname KorAPQuery-class
@@ -328,8 +337,10 @@
#' @aliases frequencyQuery
#' @rdname KorAPQuery-class
#' @examples
+#' \donttest{
#' new("KorAPConnection", verbose = TRUE) %>%
#' frequencyQuery(c("Mücke", "Schnake"), paste0("pubDate in ", 2000:2003))
+#' }
#'
#' @param kco \code{\link{KorAPConnection}} object (obtained e.g. from \code{new("KorAPConnection")}
#' @param query string that contains the corpus query. The query language depends on the \code{ql} parameter. Either \code{query} must be provided or \code{KorAPUrl}.
diff --git a/R/ci.R b/R/ci.R
index 5bb81ea..d3b1102 100644
--- a/R/ci.R
+++ b/R/ci.R
@@ -20,6 +20,7 @@
#' @importFrom tibble remove_rownames
#' @importFrom dplyr enquo rename starts_with
#' @examples
+#' \donttest{
#' library(ggplot2)
#' kco <- new("KorAPConnection", verbose=TRUE)
#' expand_grid(year=2015:2018, alternatives=c("Hate Speech", "Hatespeech")) %>%
@@ -28,7 +29,7 @@
#' ci() %>%
#' ggplot(aes(x=year, y=f, fill=query, color=query, ymin=conf.low, ymax=conf.high)) +
#' geom_point() + geom_line() + geom_ribbon(alpha=.3)
-#'
+#' }
ci <- function(df,
x = totalResults,
N = total,
diff --git a/R/highcharter-helper.R b/R/highcharter-helper.R
index 981d4d7..46d3e8e 100644
--- a/R/highcharter-helper.R
+++ b/R/highcharter-helper.R
@@ -11,12 +11,14 @@
#' @param ylabel defaults to \% if \code{as.alternatives} is \code{true} and to "ipm" otherwise.
#'
#' @examples
+#' \donttest{year <- c(1990:2018)}\dontshow{year <- c(2013:2014)}
#' new("KorAPConnection", verbose = TRUE) %>%
#' frequencyQuery(query = c("macht []{0,3} Sinn", "ergibt []{0,3} Sinn"),
-#' vc = paste("textType = /Zeit.*/ & pubDate in", c(2010:2014)),
+#' vc = paste("textType = /Zeit.*/ & pubDate in", year),
#' as.alternatives = TRUE) %>%
#' hc_freq_by_year_ci(as.alternatives = TRUE)
#'
+#' \donttest{
#' kco <- new("KorAPConnection", verbose = TRUE)
#' expand_grid(
#' condition = c("textDomain = /Wirtschaft.*/", "textDomain != /Wirtschaft.*/"),
@@ -28,6 +30,7 @@
#' paste0(.$condition, " & pubDate in ", .$year)
#' )) %>%
#' hc_freq_by_year_ci()
+#' }
#'
hc_freq_by_year_ci <- function(df, as.alternatives = F, ylabel = if(as.alternatives) "%" else "ipm") {
title <- ""
diff --git a/R/misc.R b/R/misc.R
index feafbf5..f438e0f 100644
--- a/R/misc.R
+++ b/R/misc.R
@@ -15,7 +15,9 @@
#' @importFrom dplyr .data
#'
#' @examples
+#' \donttest{
#' new("KorAPConnection") %>% frequencyQuery("Test", paste0("pubDate in ", 2000:2002)) %>% ipm()
+#' }
ipm <- function(df) {
df %>%
mutate(ipm = .data$f * 10^6, conf.low = .data$conf.low * 10^6, conf.high = .data$conf.high * 10^6)
@@ -34,11 +36,13 @@
#' @importFrom dplyr .data
#'
#' @examples
+#' \donttest{
#' new("KorAPConnection") %>%
#' frequencyQuery(c("Tollpatsch", "Tolpatsch"),
#' vc=paste0("pubDate in ", 2000:2002),
#' as.alternatives = TRUE) %>%
#' percent()
+#' }
percent <- function(df) {
df %>%
mutate(f = .data$f * 10^2, conf.low = .data$conf.low * 10^2, conf.high = .data$conf.high * 10^2)
@@ -96,6 +100,7 @@
#' @examples
#' library(ggplot2)
#' kco <- new("KorAPConnection", verbose=TRUE)
+#' \donttest{
#' expand_grid(condition = c("textDomain = /Wirtschaft.*/", "textDomain != /Wirtschaft.*/"),
#' year = (2005:2011)) %>%
#' cbind(frequencyQuery(kco, "[tt/l=Heuschrecke]",
@@ -103,7 +108,7 @@
#' ipm() %>%
#' ggplot(aes(year, ipm, fill = condition, color = condition)) +
#' geom_freq_by_year_ci()
-#'
+#' }
#' @importFrom ggplot2 ggplot aes geom_ribbon geom_line geom_point theme element_text scale_x_continuous
#'
#' @export
@@ -173,13 +178,14 @@
#' @examples
#' library(ggplot2)
#' kco <- new("KorAPConnection", verbose=TRUE)
+#' \donttest{year = (2003:2011)}\dontshow{year = (2005:2006)}
#' g <- expand_grid(condition = c("textDomain = /Wirtschaft.*/", "textDomain != /Wirtschaft.*/"),
-#' year = (2002:2018)) %>%
+#' year) %>%
#' cbind(frequencyQuery(kco, "[tt/l=Heuschrecke]",
#' paste0(.$condition," & pubDate in ", .$year))) %>%
#' ipm() %>%
#' ggplot(aes(year, ipm, fill = condition, color = condition)) +
-#' ## theme_light(base_size = 20) +
+#' ## theme_light(base_size = 20) +
#' geom_freq_by_year_ci()
#' p <- ggplotly(g)
#' print(p)