pluralGenderVariants demo: oauthorize demo iff necessary
Change-Id: I9b166410c7c2ffb657c8f6448086f3d43b723dbf
diff --git a/demo/00Index b/demo/00Index
index 2b86b41..dd195be 100644
--- a/demo/00Index
+++ b/demo/00Index
@@ -13,6 +13,6 @@
frequency_by_country_ggplot Plot frequencies depending on country of publication using ggplot2.
frequency_by_country_highcharts Plot frequencies depending on country of publication using highcharter.
collocation_score_by_country Plot collocation scores depending on country of publication using ggplot2.
-pluralGenderVariants Plot frequencies of the plular gender variants of a word over time.
+pluralGenderVariants Plot frequencies of the plular gender variants of a word in the core corpus of the Council for German Orthography (OKK) over time.
OAuthBrowserflowHttr2 Runtime OAuth2 browser flow demonstration using the httr2 package (adjective collocates of »Gendern«)
OAuthBrowserflowHttr Runtime OAuth2 browser flow demonstration using the httr package (query results for »Vöner« including KWICs)
diff --git a/demo/pluralGenderVariants.R b/demo/pluralGenderVariants.R
index 3bca840..8ff8c3b 100644
--- a/demo/pluralGenderVariants.R
+++ b/demo/pluralGenderVariants.R
@@ -1,6 +1,10 @@
library(RKorAPClient)
library(tidyverse)
library(purrrlyr)
+library(httr2)
+library(httpuv)
+
+demo_kor_app_id = "773NHGM76N7P9b6rLfmpM4"
# The challenge in searching gender variants with KorAP and DeReKo is that,
# firstly, some characters used for gender marking, especially punctuation marks,
@@ -17,11 +21,11 @@
# closely into the KWIC snippets to see which non-indexed strings actually do appear
# between these tokens and counts the frequencies of the variants that occur.
-unravelPunctuationGenderCases <- function(df, suffix = "innen", kco = new("KorAPConnection", verbose=TRUE)) {
+unravelPunctuationGenderCases <- function(df, suffix = "innen", kco) {
if ( nrow(df) > 1) {
df %>%
dplyr::filter(totalResults > 0 & str_detect(query, paste0(" ", suffix))) %>%
- by_row(unravelPunctuationGenderCases, .collate = "rows", .labels=FALSE) %>%
+ by_row(unravelPunctuationGenderCases, kco = kco, .collate = "rows", .labels=FALSE) %>%
select(-.row) %>%
bind_rows(df %>% dplyr::filter(totalResults == 0 | ! str_detect(query, paste0(" ", suffix)))) %>%
tidyr::complete(query, nesting(vc, total), fill = list(totalResults = 0)) %>%
@@ -43,13 +47,29 @@
}
}
+oauthorizeDemo <- function(kco, app_id = demo_kor_app_id) {
+ if (is.null(kco@accessToken) || is.null(kco@welcome)) { # if access token is not set or invalid
+ kco@accessToken <- ( # request one
+ oauth_client(
+ id = app_id, # for the demo application
+ token_url = paste0(kco@apiUrl, "oauth2/token")
+ ) %>%
+ oauth_flow_auth_code(
+ scope = "search match_info",
+ auth_url = paste0(kco@KorAPUrl, "settings/oauth/authorize")
+ )
+ )$access_token
+ }
+ kco
+}
+
plotPluralGenderVariants <- function(word = "Nutzer",
years = c(1995:2022),
as.alternatives = FALSE,
vc = "referTo ratskorpus-2023-1 & pubDate in",
suffixes = c('Innen', '[\\*]innen"', '[_]innen"', ' innen'),
prefixes = c('', '"', '"', ''),
- kco = new("KorAPConnection", verbose=TRUE) ) {
+ kco = new("KorAPConnection", verbose=TRUE) %>% oauthorizeDemo()) {
hc <-
frequencyQuery(kco, paste0(prefixes, word, suffixes), paste(vc, years), as.alternatives=as.alternatives) %>%
unravelPunctuationGenderCases(kco = kco) %>%