Add convenience bindings for ggplot2 and plotly with hyperlinks
These functions will probably be moved to a separate package.
Change-Id: Iaecd23b1401bc5df7ee4a904dca2e87466266143
diff --git a/DESCRIPTION b/DESCRIPTION
index 5e2ddf4..6faf7ee 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -22,6 +22,8 @@
lubridate,
curl,
jsonlite,
+ plotly,
+ htmlwidgets,
utils,
httr,
methods
diff --git a/NAMESPACE b/NAMESPACE
index 0e11e6f..4ba2e60 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -8,6 +8,7 @@
export(complete)
export(expand_grid)
export(geom_freq_by_year_ci)
+export(ggplotly)
export(group_by)
export(ipm)
export(mutate)
@@ -44,15 +45,23 @@
importFrom(dplyr,select)
importFrom(dplyr,starts_with)
importFrom(dplyr,summarise)
+importFrom(ggplot2,GeomPoint)
+importFrom(ggplot2,aes)
importFrom(ggplot2,element_text)
importFrom(ggplot2,geom_line)
importFrom(ggplot2,geom_point)
importFrom(ggplot2,geom_ribbon)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,ggproto)
+importFrom(ggplot2,layer)
importFrom(ggplot2,scale_x_continuous)
importFrom(ggplot2,theme)
+importFrom(htmlwidgets,onRender)
+importFrom(htmlwidgets,saveWidget)
importFrom(jsonlite,fromJSON)
importFrom(lubridate,year)
importFrom(magrittr,"%>%")
+importFrom(plotly,ggplotly)
importFrom(purrr,map_dfr)
importFrom(stats,prop.test)
importFrom(tibble,as_tibble)
diff --git a/R/misc.R b/R/misc.R
index 9a97f22..b90841e 100644
--- a/R/misc.R
+++ b/R/misc.R
@@ -22,9 +22,17 @@
}
-#' Plot frequency by year graphs with confidence intervals
+## Mute notes: "Undefined global functions or variables:"
+globalVariables(c("conf.high", "conf.low", "onRender", "webUIRequestUrl"))
+
+
+#' Experimental: Plot frequency by year graphs with confidence intervals
#'
-#' Convenience function for plotting typical frequency by year graphs with confidence intervals using ggplot2.
+#' Experimental convenience function for plotting typical frequency by year graphs with confidence intervals using ggplot2.
+#' \bold{Warning:} This function may be moved to a new package.
+#'
+#' @param mapping Set of aesthetic mappings created by aes() or aes_(). If specified and inherit.aes = TRUE (the default), it is combined with the default mapping at the top level of the plot. You must supply mapping if there is no plot mapping.
+#' @param ... Other arguments passed to geom_ribbon, geom_line, and geom_click_point.
#'
#' @examples
#' library(ggplot2)
@@ -34,18 +42,95 @@
#' cbind(frequencyQuery(kco, "[tt/l=Heuschrecke]",
#' paste0(.$condition," & pubDate in ", .$year))) %>%
#' ipm() %>%
-#' ggplot(aes(year, ipm, fill = condition, color = condition, ymin = conf.low, ymax = conf.high)) +
+#' ggplot(aes(year, ipm, fill = condition, color = condition)) +
#' geom_freq_by_year_ci()
#'
-#' @importFrom ggplot2 geom_ribbon geom_line geom_point theme element_text scale_x_continuous
+#' @importFrom ggplot2 ggplot aes geom_ribbon geom_line geom_point theme element_text scale_x_continuous
#'
#' @export
-geom_freq_by_year_ci <- function() {
+geom_freq_by_year_ci <- function(mapping = aes(ymin=conf.low, ymax=conf.high), ...) {
list(
- geom_ribbon(alpha = .3, linetype = 0, show.legend = FALSE),
- geom_line(),
- geom_point(),
- theme(axis.text.x = element_text(angle = 45, hjust = 1)),
+ geom_ribbon(mapping,
+ alpha = .3, linetype = 0, show.legend = FALSE, ...),
+ geom_line(...),
+ geom_click_point(aes(url=webUIRequestUrl), ...),
+ theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = c(0.8, 0.2)),
scale_x_continuous(breaks = function(x) seq(ceiling(x[1]), floor(x[2]), by = 1 + floor(((x[2]-x[1])/30)))))
}
+#' @importFrom ggplot2 ggproto aes GeomPoint
+GeomClickPoint <- ggproto(
+ "GeomPoint",
+ GeomPoint,
+ required_aes = c("x", "y"),
+ default_aes = aes(
+ shape = 19, colour = "black", size = 1.5, fill = NA,
+ alpha = NA, stroke = 0.5, url = NA
+ ),
+ extra_params = c("na.rm", "url"),
+ draw_panel = function(data, panel_params,
+ coord, na.rm = FALSE, showpoints = TRUE, url = NULL) {
+ GeomPoint$draw_panel(data, panel_params, coord, na.rm = na.rm)
+ }
+)
+
+#' @importFrom ggplot2 layer
+geom_click_point <- function(mapping = NULL, data = NULL, stat = "identity",
+ position = "identity", na.rm = FALSE, show.legend = NA,
+ inherit.aes = TRUE, url = NA, ...) {
+ layer(
+ geom = GeomClickPoint, mapping = mapping, data = data, stat = stat,
+ position = position, show.legend = show.legend, inherit.aes = inherit.aes,
+ params = list(na.rm = na.rm, ...)
+ )
+}
+
+
+#' @importFrom htmlwidgets onRender
+tooltip2hyperlink <- function(p, attribute="webUIRequestUrl") {
+ pattern <- paste0(attribute, ": ([^<]+)")
+ for(i in grep(attribute, p$x$data)) {
+ x <- p[["x"]][["data"]][[i]][["text"]]
+ m <- regexpr(pattern, x)
+ matches <- sub(paste0(attribute, ": "), "", regmatches(x, m))
+ p$x$data[[i]]$customdata <- matches
+ p[["x"]][["data"]][[i]][["text"]] <- sub(paste0(attribute, ":[^<]*<br ?/?>"), "", p[["x"]][["data"]][[i]][["text"]] )
+ }
+ onRender(p, "function(el, x) { el.on('plotly_click', function(d) { var url=d.points[0].customdata; if(url) { window.open(url, 'korap') } })}")
+}
+
+#' Experimental: Convert ggplot2 to plotly with hyperlinks to KorAP queries
+#'
+#' \code{RKorAPClient::ggplotly} converts a \code{ggplot2::ggplot()} object to a plotly
+#' object with hyperlinks from data points to corresponding KorAP queries.
+#' \bold{Warning:} This function may be moved to a new package.
+#'
+#' @param p a ggplot object.
+#' @param tooltip a character vector specifying which aesthetic mappings to show
+#' in the tooltip. If you want hyperlinks to KorAP queries you need to include
+#' \code{"url"} here.
+#' @param ... Other arguments passed to \code{plotly::ggplotly}
+#'
+#' @examples
+#' library(ggplot2)
+#' kco <- new("KorAPConnection", verbose=TRUE)
+#' g <- expand_grid(condition = c("textDomain = /Wirtschaft.*/", "textDomain != /Wirtschaft.*/"),
+#' year = (2002:2018)) %>%
+#' 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) +
+#' geom_freq_by_year_ci()
+#' p <- ggplotly(g)
+#' print(p)
+#' ## saveWidget(p, paste0(tmpdir(), "heuschrecke.html")
+#'
+#'
+#' @importFrom plotly ggplotly
+#' @importFrom htmlwidgets saveWidget
+#' @export
+ggplotly <- function(p = ggplot2::last_plot(), tooltip = c("x", "y", "colour", "url"), ...) {
+ pp <- plotly::ggplotly(p = p, tooltip = tooltip, ...)
+ tooltip2hyperlink(pp)
+}
diff --git a/Readme.md b/Readme.md
index 2071600..0cefd0e 100644
--- a/Readme.md
+++ b/Readme.md
@@ -33,10 +33,11 @@
library(RKorAPClient)
library(ggplot2)
kco <- new("KorAPConnection", verbose=TRUE)
-expand_grid(condition = c("textDomain = /Wirtschaft.*/", "textDomain != /Wirtschaft.*/"), year = (2002:2018)) %>%
+expand_grid(condition = c("textDomain = /Wirtschaft.*/", "textDomain != /Wirtschaft.*/"),
+ year = (2002:2018)) %>%
cbind(frequencyQuery(kco, "[tt/l=Heuschrecke]", paste0(.$condition," & pubDate in ", .$year))) %>%
ipm() %>%
- ggplot(aes(x = year, y = ipm, fill = condition, color = condition, ymin = conf.low, ymax = conf.high)) +
+ ggplot(aes(x = year, y = ipm, fill = condition, colour = condition)) +
geom_freq_by_year_ci()
```
<!-- -->
diff --git a/demo/alternativesOverTime.R b/demo/alternativesOverTime.R
index ae91ff5..dca55b3 100755
--- a/demo/alternativesOverTime.R
+++ b/demo/alternativesOverTime.R
@@ -11,19 +11,14 @@
df <- expand_grid(Variant = alternatives, year = years) %>%
cbind(corpusQuery(kco, .$Variant, sprintf("textType = /Zeit.*/ & pubDate in %d", .$year))) %>%
group_by(year) %>% mutate(tokens = sum(totalResults)) %>%
- ci()
- g <- ggplot(data = df, mapping = aes(x = year, y = f, color = Variant, fill = Variant, ymin = conf.low, ymax = conf.high)) +
+ ci() %>%
+ rename(share=f)
+ g <- ggplot(data = df, mapping = aes(x = year, y = share, colour = Variant, fill = Variant)) +
geom_freq_by_year_ci() +
ggtitle(paste0(alternatives, collapse = " vs. ")) +
xlab("TIME") +
ylab(sprintf("Observed frequency ratio"))
- pp <- ggplotly(g, tooltip = c("x", "y"))
- for (i in 1:length(alternatives)) {
- vdata <- df[df$Variant == alternatives[i],]
- pp$x$data[[2+i]]$customdata <- vdata$webUIRequestUrl
- pp$x$data[[2+i]]$text <- sprintf("%s<br />absolute: %d / %d", pp$x$data[[2+i]]$text, vdata$totalResults, vdata$tokens)
- }
- ppp <- onRender(pp, "function(el, x) { el.on('plotly_click', function(d) { var url=d.points[0].customdata; window.open(url, 'korap') })}")
+ ppp <- RKorAPClient::ggplotly(g)
print(ppp)
df
}
diff --git a/demo/conditionsOverTime.R b/demo/conditionsOverTime.R
index 9f0590d..b23d2bf 100644
--- a/demo/conditionsOverTime.R
+++ b/demo/conditionsOverTime.R
@@ -6,17 +6,19 @@
#install_git("https://korap.ids-mannheim.de/gerrit/KorAP/RKorAPClient", upgrade="never")
library(RKorAPClient)
library(ggplot2)
+library(plotly)
conditionsOverTime <- function(query, conditions, years, kco = new("KorAPConnection", verbose = TRUE)) {
g <- expand_grid(condition = conditions, year = years) %>%
cbind(frequencyQuery(kco, query, sprintf("%s & pubDate in %d", .$condition, .$year))) %>%
ipm() %>%
- ggplot(aes(x = year, y = ipm, fill=condition, color=condition, ymin=conf.low, ymax=conf.high)) +
+ ggplot(aes(x = year, y = ipm, fill=condition, color=condition)) +
geom_freq_by_year_ci() +
xlab("TIME") +
labs(color="Virtual Corpus", fill="Virtual Corpus") +
ylab(sprintf("Observed frequency/million of \u201c%s\u201d", query))
- print(g)
+ p <- RKorAPClient::ggplotly(g)
+ print(p)
}
conditionsOverTime("[tt/l=Heuschrecke]", c("textClass = /natur.*/", "textClass=/politik.*/", "textClass=/wirtschaft.*/"), (2002:2018))
diff --git a/man/geom_freq_by_year_ci.Rd b/man/geom_freq_by_year_ci.Rd
index ffdbdb3..74f8d40 100644
--- a/man/geom_freq_by_year_ci.Rd
+++ b/man/geom_freq_by_year_ci.Rd
@@ -2,12 +2,19 @@
% Please edit documentation in R/misc.R
\name{geom_freq_by_year_ci}
\alias{geom_freq_by_year_ci}
-\title{Plot frequency by year graphs with confidence intervals}
+\title{Experimental: Plot frequency by year graphs with confidence intervals}
\usage{
-geom_freq_by_year_ci()
+geom_freq_by_year_ci(mapping = aes(ymin = conf.low, ymax = conf.high),
+ ...)
+}
+\arguments{
+\item{mapping}{Set of aesthetic mappings created by aes() or aes_(). If specified and inherit.aes = TRUE (the default), it is combined with the default mapping at the top level of the plot. You must supply mapping if there is no plot mapping.}
+
+\item{...}{Other arguments passed to geom_ribbon, geom_line, and geom_click_point.}
}
\description{
-Convenience function for plotting typical frequency by year graphs with confidence intervals using ggplot2.
+Experimental convenience function for plotting typical frequency by year graphs with confidence intervals using ggplot2.
+\bold{Warning:} This function may be moved to a new package.
}
\examples{
library(ggplot2)
@@ -17,7 +24,7 @@
cbind(frequencyQuery(kco, "[tt/l=Heuschrecke]",
paste0(.$condition," & pubDate in ", .$year))) \%>\%
ipm() \%>\%
- ggplot(aes(year, ipm, fill = condition, color = condition, ymin = conf.low, ymax = conf.high)) +
+ ggplot(aes(year, ipm, fill = condition, color = condition)) +
geom_freq_by_year_ci()
}
diff --git a/man/ggplotly.Rd b/man/ggplotly.Rd
new file mode 100644
index 0000000..7aedff6
--- /dev/null
+++ b/man/ggplotly.Rd
@@ -0,0 +1,40 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/misc.R
+\name{ggplotly}
+\alias{ggplotly}
+\title{Experimental: Convert ggplot2 to plotly with hyperlinks to KorAP queries}
+\usage{
+ggplotly(p = ggplot2::last_plot(), tooltip = c("x", "y", "colour",
+ "url"), ...)
+}
+\arguments{
+\item{p}{a ggplot object.}
+
+\item{tooltip}{a character vector specifying which aesthetic mappings to show
+in the tooltip. If you want hyperlinks to KorAP queries you need to include
+\code{"url"} here.}
+
+\item{...}{Other arguments passed to \code{plotly::ggplotly}}
+}
+\description{
+\code{RKorAPClient::ggplotly} converts a \code{ggplot2::ggplot()} object to a plotly
+object with hyperlinks from data points to corresponding KorAP queries.
+\bold{Warning:} This function may be moved to a new package.
+}
+\examples{
+library(ggplot2)
+kco <- new("KorAPConnection", verbose=TRUE)
+g <- expand_grid(condition = c("textDomain = /Wirtschaft.*/", "textDomain != /Wirtschaft.*/"),
+ year = (2002:2018)) \%>\%
+ 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) +
+ geom_freq_by_year_ci()
+p <- ggplotly(g)
+print(p)
+## saveWidget(p, paste0(tmpdir(), "heuschrecke.html")
+
+
+}