Add helper for using highcharter / Highcharts more easily
Change-Id: I9c4d501aebcc31cf997ef4e572d107a4aa083325
diff --git a/DESCRIPTION b/DESCRIPTION
index 9f0b936..c47825f 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -9,7 +9,7 @@
License: BSD_2_clause + file LICENSE
Encoding: UTF-8
LazyData: false
-RoxygenNote: 7.0.1
+RoxygenNote: 7.0.2
Imports:
R.cache,
broom,
@@ -21,6 +21,7 @@
purrr,
lubridate,
curl,
+ highcharter,
jsonlite,
keyring,
plotly,
@@ -35,5 +36,6 @@
'RKorAPClient.R'
'KorAPQuery.R'
'ci.R'
+ 'highcharter-helper.R'
'misc.R'
'reexports.R'
diff --git a/NAMESPACE b/NAMESPACE
index 8a84580..096d676 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -10,6 +10,7 @@
export(geom_freq_by_year_ci)
export(ggplotly)
export(group_by)
+export(hc_freq_by_year_ci)
export(ipm)
export(mutate)
export(percent)
@@ -34,6 +35,7 @@
exportMethods(persistAccessToken)
exportMethods(show)
import(R.cache)
+import(highcharter)
import(httr)
import(keyring)
import(methods)
diff --git a/R/highcharter-helper.R b/R/highcharter-helper.R
new file mode 100644
index 0000000..cff6093
--- /dev/null
+++ b/R/highcharter-helper.R
@@ -0,0 +1,117 @@
+#' Experimental: Plot interactive frequency by year graphs with confidence intervals using highcharter
+#'
+#' Experimental convenience function for plotting typical frequency by year graphs with confidence intervals using highcharter.
+#' \bold{Warning:} This function may be moved to a new package.
+#'
+#' @import highcharter
+#' @export
+#'
+#' @param df data frame like the value of a \code{\link{frequencyQuery}}
+#' @param as.alternatives boolean decides whether queries should be treatet queries as mutually exclusive and exahustive wrt. to some meaningful class (e.g. spelling variants of a certain word form).
+#' @param ylabel defaults to \% if \code{as.alternatives} is \code{true} and to "ipm" otherwise.
+#'
+#' @examples
+#' new("KorAPConnection", verbose = TRUE) %>%
+#' frequencyQuery(query = c("macht []{0,3} Sinn", "ergibt []{0,3} Sinn"),
+#' vc = paste("textType = /Zeit.*/ & pubDate in", c(2010:2014)),
+#' as.alternatives = TRUE) %>%
+#' hc_freq_by_year_ci(as.alternatives = TRUE)
+#'
+hc_freq_by_year_ci <- function(df, as.alternatives = F, ylabel = if(as.alternatives) "%" else "ipm") {
+ title <- ""
+ df <- df %>%
+ { if(! as.alternatives) ipm(.) else RKorAPClient::percent(.) }
+
+ if (!"year" %in% colnames(df)) {
+ df <- df %>% mutate(year = as.integer(queryStringToLabel(df$vc, pubDateOnly = T)))
+ }
+ if (!"condition" %in% colnames(df)) {
+ if (length(base::unique(df$query)) > 1) {
+ df <- df %>% mutate(condition = query)
+ if(length(base::unique(queryStringToLabel(df$vc, excludePubDate = T ))) > 1) {
+ df <- df %>% mutate(condition = paste(condition, " & ",
+ queryStringToLabel(vc, excludePubDate = T )))
+ }
+ } else {
+ title <- base::unique(df$query)
+ if(length(base::unique(queryStringToLabel(df$vc, excludePubDate = T ))) > 1) {
+ df <- df %>% mutate(condition = queryStringToLabel(vc, excludePubDate = T ))
+ }
+ }
+ }
+ # use the D3 palette which provides 20 attractive and distinguishable colours
+ palette <- c("#1F77B4", "#FF7F0E", "#2CA02C", "#D62728", "#9467BD", "#8C564B", "#E377C2", "#7F7F7F", "#BCBD22", "#17BECF", "#AEC7E8", "#FFBB78", "#98DF8A", "#FF9896", "#C5B0D5", "#C49C94", "#F7B6D2", "#C7C7C7", "#DBDB8D", "#9EDAE5")
+ highcharter::highchart() %>%
+ hc_title(text=title) %>%
+ hc_chart(zoomType="xy") %>%
+ hc_yAxis(
+ title = list(text = if (as.alternatives) "" else ylabel),
+ ceiling = if (as.alternatives) 100 else NULL,
+ floor = 0,
+ labels = if(as.alternatives) list(format = paste0("{value}\U2009", ylabel)) else NULL
+ ) %>%
+ hc_xAxis(allowDecimals=F) %>%
+ hc_add_theme(hc_theme_google(colors=palette)) %>%
+ hc_plotOptions(
+ series = list(enabled = T),
+ line = list(cursor = 'pointer', point = list(events = list(
+ click = JS("function() { window.open(this.click, 'korap'); }")
+ )))) %>%
+ hc_credits(enabled = T,
+ text = "KorAP R Client Pakckage",
+ href = "//github.com/KorAP/RKorAPClient/") %>%
+ hc_exporting(enabled = T) %>%
+ hc_tooltip(
+ formatter = JS(paste0("function (tooltip) {
+ var str = tooltip.defaultFormatter.call(this, tooltip);
+ if(Array.isArray(str)) {
+ str = str.join('');
+ }
+ for (var i = 0; i < this.points.length; i++) {
+ str = str.replace(/([0-9.,]+.?)", ylabel, "/, this.points[i].point.count+' ($1@)');
+ }
+ return str.replace(/@/g, '", ylabel, "')
+ } ")),
+ crosshairs = T,
+ valueDecimals = 2,
+ shared = T,
+ valueSuffix = paste0('\U2009', ylabel)
+ ) %>%
+ hc_add_series_korap_frequencies(df, as.alternatives)
+}
+
+hc_add_series_korap_frequencies <- function(hc, df, as.alternatives = F) {
+ index <- 0
+ for(q in unique(df$condition)) {
+ dat <- df[df$condition==q,]
+ hc <- hc %>% hc_add_series(
+ marker = list(radius = 2),
+ name = q,
+ data = data.frame(
+ year = dat$year,
+ value = if (as.alternatives) dat$f else dat$ipm,
+ count = dat$totalResults,
+ click = dat$webUIRequestUrl
+ ),
+ hcaes(year, value),
+ type = 'line',
+ colorIndex = index,
+ zIndex = 1
+ ) %>%
+ hc_add_series(
+ name = "ci",
+ data = dat[,c('year', 'conf.low', 'conf.high')],
+ hcaes(x = year, low = conf.low, high = conf.high),
+ type = 'arearange',
+ fillOpacity = 0.3,
+ lineWidth = 0,
+ marker = list(enabled = F),
+ enableMouseTracking = F,
+ linkedTo= ':previous',
+ colorIndex = index,
+ zIndex = 0
+ )
+ index <- index+1
+ }
+ hc
+}
diff --git a/demo/highcharter-example.R b/demo/highcharter-example.R
index cdf1362..4d312ba 100644
--- a/demo/highcharter-example.R
+++ b/demo/highcharter-example.R
@@ -1,104 +1,4 @@
library(RKorAPClient)
-library(highcharter)
-
-hc_freq_by_year_ci <- function(df, as.alternatives = F, ylabel = if(as.alternatives) "%" else "ipm") {
- title <- ""
- df <- df %>%
- { if(! as.alternatives) ipm(.) else RKorAPClient::percent(.) }
-
- if (!"year" %in% colnames(df)) {
- df <- df %>% mutate(year = as.integer(queryStringToLabel(df$vc, pubDateOnly = T)))
- }
- if (!"condition" %in% colnames(df)) {
- if (length(base::unique(df$query)) > 1) {
- df <- df %>% mutate(condition = query)
- if(length(base::unique(queryStringToLabel(df$vc, excludePubDate = T ))) > 1) {
- df <- df %>% mutate(condition = paste(condition, " & ",
- queryStringToLabel(vc, excludePubDate = T )))
- }
- } else {
- title <- base::unique(df$query)
- if(length(base::unique(queryStringToLabel(df$vc, excludePubDate = T ))) > 1) {
- df <- df %>% mutate(condition = queryStringToLabel(vc, excludePubDate = T ))
- }
- }
- }
- # use the D3 palette which provides 20 attractive and distinguishable colours
- palette <- c("#1F77B4", "#FF7F0E", "#2CA02C", "#D62728", "#9467BD", "#8C564B", "#E377C2", "#7F7F7F", "#BCBD22", "#17BECF", "#AEC7E8", "#FFBB78", "#98DF8A", "#FF9896", "#C5B0D5", "#C49C94", "#F7B6D2", "#C7C7C7", "#DBDB8D", "#9EDAE5")
- highchart() %>%
- hc_title(text=title) %>%
- hc_chart(zoomType="xy") %>%
- hc_yAxis(
- title = list(text = if (as.alternatives) "" else ylabel),
- ceiling = if (as.alternatives) 100 else NULL,
- floor = 0,
- labels = if(as.alternatives) list(format = paste0("{value}\U2009", ylabel)) else NULL
- ) %>%
- hc_xAxis(allowDecimals=F) %>%
- hc_add_theme(hc_theme_google(colors=palette)) %>%
- hc_plotOptions(
- series = list(enabled = T),
- line = list(cursor = 'pointer', point = list(events = list(
- click = JS("function() { window.open(this.click, 'korap'); }")
- )))) %>%
- hc_credits(enabled = T,
- text = "KorAP R Client Pakckage",
- href = "//github.com/KorAP/RKorAPClient/") %>%
- hc_exporting(enabled = T) %>%
- hc_tooltip(
- formatter = JS(paste0("function (tooltip) {
- var str = tooltip.defaultFormatter.call(this, tooltip);
- if(Array.isArray(str)) {
- str = str.join('');
- }
- for (var i = 0; i < this.points.length; i++) {
- str = str.replace(/([0-9.,]+.?)", ylabel, "/, this.points[i].point.count+' ($1@)');
- }
- return str.replace(/@/g, '", ylabel, "')
- } ")),
- crosshairs = T,
- valueDecimals = 2,
- shared = T,
- valueSuffix = paste0('\U2009', ylabel)
- ) %>%
- hc_add_series_korap_frequencies(df, as.alternatives)
-}
-
-hc_add_series_korap_frequencies <- function(hc, df, as.alternatives = F) {
- index <- 0
- for(q in unique(df$condition)) {
- dat <- df[df$condition==q,]
- hc <- hc %>% hc_add_series(
- marker = list(radius = 2),
- name = q,
- data = data.frame(
- year = dat$year,
- value = if (as.alternatives) dat$f else dat$ipm,
- count = dat$totalResults,
- click = dat$webUIRequestUrl
- ),
- hcaes(year, value),
- type = 'line',
- colorIndex = index,
- zIndex = 1
- ) %>%
- hc_add_series(
- name = "ci",
- data = dat[,c('year', 'conf.low', 'conf.high')],
- hcaes(x = year, low = conf.low, high = conf.high),
- type = 'arearange',
- fillOpacity = 0.3,
- lineWidth = 0,
- marker = list(enabled = F),
- enableMouseTracking = F,
- linkedTo= ':previous',
- colorIndex = index,
- zIndex = 0
- )
- index <- index+1
- }
- hc
-}
plotHighchart <- function(query = "Schlumpf",
years = c(2000:2010),
@@ -120,3 +20,4 @@
h1 <- plotHighchart(c("Leser | Lesern | Lesers", 'Leserin | Leserinnen', 'LeserIn | LeserInnen', '"Leser[_\\*]in.*"'), c(1985:2018), as.alternatives = F)
#plotHighchart(c("Tollpatsch", "Tolpatsch"), c(1991:2018))
+