---
title: "Interactivity"
author: "Jarad Niemi"
date: "`r Sys.Date()`"
output:
html_document:
toc: yes
toc_float: yes
layout: page
---
```{r setup, include=FALSE, purl=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
[R Markdown file](https://raw.githubusercontent.com/jarad/jarad.github.com/master/courses/stat486/slides/25-interactivity/25-interactivity.Rmd)
```{r packages}
library("tidyverse"); theme_set(theme_bw())
library("Sleuth3")
# Tables
library("knitr") # for kable
library("kableExtra")
library("formattable")
library("DT")
# Figures
library("maps")
library("sf")
library("tigris")
library("leaflet")
library("scales")
library("plotly")
library("gifski")
```
Rmarkdown documents that produce HTML files can include a variety of features
that provide an interactive document for the user.
Primarily this interactivity is implemented as will concern stand-alone tables,
figures, and animations (movies).
Typically this interactivity is available via an R package interface to a
javascript library.
We'll take a look at the construction of tables using the
[knitr](https://yihui.org/knitr/),
[formattable](https://www.rdocumentation.org/packages/formattable/versions/0.2.1),
and [DT](https://rstudio.github.io/DT/) packages.
Technically, the first two packages provide non-interactive tables while the
third provides interactivity.
But we'll start with the first two as they provide some nice functionality to
make nice looking HTML tables.
# Tables
We will take a look at the `diamonds` data set.
```{r}
dim(diamonds)
```
These data are too large for interactive scatterplots and thus
we will take a random sample of these data.
## kable
The `kable()` function in the `knitr` package provides an easy display of
tables in an HTML document.
By default, the kable function will show the entire table.
So, let's just show the first few lines.
```{r diamonds-head}
d <- diamonds %>%
group_by(cut) %>% # ensure we have all cuts for grouping
sample_n(3)
```
Also, by default, the table looks pretty bad, so let's add some styling.
```{r kable-diamonds}
knitr::kable(d) %>%
kable_styling()
```
### Formatting
```{r kable-diamonds-formatting}
d %>%
knitr::kable(
caption = "Diamonds data",
align = c("rlllrrrrrr")
) %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed')) %>%
scroll_box(height = "200px")
```
### Grouping
```{r kable-diamonds-grouping}
groups <- table(d$cut)
d %>%
knitr::kable(
caption = "Diamonds data",
align = c("rlllrrrrrr")
) %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed')) %>%
pack_rows(
index = setNames(groups, names(groups))
)
```
### Highlighting
```{r kable-diamonds-highlighting}
d %>%
# Conditional highlighting
mutate(
carat = cell_spec(carat, "html", color = ifelse(carat > .7, "red", "black")),
price = cell_spec(price, "html", color = ifelse(price < 5000, "blue", "black"))
) %>%
knitr::kable(
escape = FALSE,
caption = "Diamonds data",
align = c("rlllrrrrrr")
) %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed'))
```
## formattable
Another function is `formattable()` in the `formattable` package.
The default table is reasonable.
```{r formattable-diamonds}
d %>%
formattable::formattable()
```
```{r formattable-diamonds-highlighting}
d %>%
# Conditional highlighting
mutate(
carat = cell_spec(carat, "html", color = ifelse(carat > .7, "red", "black")),
price = cell_spec(price, "html", color = ifelse(price < 5000, "blue", "black"))
) %>%
formattable::formattable(
list(
# Width depends on proportion from 0 to max value
x = color_bar("#C8102E"),
y = color_bar("#C8102E"),
z = color_bar("#C8102E"),
# Color depends on proportion from min to max value
depth = color_tile("#CAC7A7","#524727")
)
)
```
## DT
As we will see, with the pagination, `datatable()` provides the capability to
succinctly display much larger tables.
So we will use more data
```{r diamonds-sample}
set.seed(20230416)
d <- diamonds %>%
sample_n(1000)
```
A basic interactive table using `DT::datatable()`.
```{r datatable-diamonds}
DT::datatable(d)
```
Many options can be added
### Filtering
```{r datatable-diamonds-filtering}
DT::datatable(d, rownames = FALSE, filter = "top")
```
### Buttons
```{r datatable-diamonds-buttons}
DT::datatable(d, rownames = FALSE,
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = c("copy","csv","excel","pdf","print")
))
```
### Editing
```{r datatable-diamonds-editing}
DT::datatable(d, rownames = FALSE,
editable = TRUE,
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = c("copy","csv","excel","pdf","print")
))
```
# Figures
In this section, I am combining graphics, i.e. plots, as well as maps and
animations (movies).
## Plots
There are a variety of approaches to including interactivity in graphics in
rmarkdown documents.
We'll focus on using the
[plotly](https://plotly.com/r/getting-started/) library
and specifically the `ggplotly()` function which provides interactivity for
ggplot2 created graphics.
### plotly::ggplotly()
The `ggplotly()` function from the
[plotly](https://plotly.com/r/getting-started/) package provides
interactivity for (all?) ggplot2 constructed graphics.
The interactivity provide allows the user to
- resize (zoom, rescale, reset)
- pan
- hover (show vs compare)
- toggle spike lines
- download
#### Boxplot
```{r}
g <- ggplot(case0501, aes(x = Diet, y = Lifetime)) +
geom_boxplot() +
coord_flip()
ggplotly(g)
```
#### Histogram
```{r}
g <- ggplot(diamonds, aes(x = price)) +
geom_histogram(bins = 100)
ggplotly(g)
```
#### Scatterplot
Here is a static plot of the diamonds data set.
```{r}
d <- diamonds %>% sample_n(1000)
g <- ggplot(d,
aes(
x = carat,
y = price,
shape = cut,
color = color)) +
geom_point() +
scale_y_log10() +
scale_x_log10(breaks = scales::breaks_pretty())
g
```
```{r}
ggplotly(g)
```
It seems [plotly.js does not support multiple legends](https://github.com/plotly/plotly.js/issues/1668).
### dygraphs()
Another package from constructing interactive graphics is
[dygraphs](https://rstudio.github.io/dygraphs/).
## Maps
### ggplot2()
Maps can be drawn with ggplot2, but these are not interactive.
```{r}
ggplot(map_data("county","iowa"),
aes(x = long, y = lat, fill = subregion)) +
geom_polygon(color = "black") +
guides(fill = "none")
```
### leaflet()
An open source R package and JavaScript library for mobile-friendly
interactive maps is [LeafLet](https://leafletjs.com/).
World map:
```{r}
leaflet::leaflet() %>%
addTiles()
```
In order to set the view, you will need the latitude (y) and longitude (x) in
decimal format.
I typically use Google maps, but there are other options,
e.g. [LatLong.net](https://www.latlong.net/).
Here is Ames:
```{r}
leaflet::leaflet() %>%
addTiles() %>%
setView(lng = -93.65, lat = 42.0285, zoom = 12)
```
Example taken from [here](https://bookdown.org/yihui/rmarkdown/interactive-documents.html).
```{r out.width='100%'}
leaflet::leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 17) %>%
addPopups(
-93.65, 42.0285,
'Here is the Department of Statistics, ISU'
)
```
Modified from [here](https://community.rstudio.com/t/r-shiny-make-a-reactive-map-of-state-by-county/63224/3)
```{r iowa_counties, cache=TRUE, results='hide'}
counties <- tigris::counties(state = "IA", class = "sf")
```
```{r, dependson="iowa_counties"}
leaflet() %>%
addTiles() %>%
addPolygons(data = counties, color = "grey")
```
## Animations
```{r bivariate_normal_mcmc, cache=TRUE}
gibbs_bivariate_normal = function(theta0, n_points, rho) {
theta = matrix(theta0, nrow=n_points, ncol=2, byrow=TRUE)
v = sqrt(1-rho^2)
for (i in 2:n_points) {
theta[i,1] = rnorm(1, rho*theta[i-1,2], v)
theta[i,2] = rnorm(1, rho*theta[i ,1], v)
}
return(theta)
}
theta = gibbs_bivariate_normal(c(-3,3), n<-20, rho=rho<-0.9)
```
```{r bivariate_normal, dependson='bivariate_normal_mcmc', cache=TRUE}
bivariate_normal_animation = function(x, rho, ask=interactive()) {
# Create contour plot
n.out = 101
xx <- seq(-3, 3, length=n.out)
grid <- expand.grid(x=xx, y=xx)
Sigma = diag(rep(.1,2))+rho
like <- matrix(apply(grid, 1, function(x) mvtnorm::dmvnorm(x,sigma=Sigma)),n.out,n.out)
for (i in 2:nrow(x)) {
jj = (2:i)[-(i-1)] # vector from 2:(i-1) and NULL if i=2
for (j in 1:6) {
plot.new()
# All previous plotting
contour(xx, xx, like, drawlabels=F, nlevels=10, xlim=c(-3,3), ylim=c(-3,3),
xlab=expression(theta[1]), ylab=expression(theta[2]))
segments(x[jj-1,1], x[jj-1,2], x[jj,1], x[jj-1,2], col="gray")
segments(x[jj ,1], x[jj-1,2], x[jj,1], x[jj ,2], col="gray")
points(x[(1:(i-1)),1], x[(1:(i-1)),2], col="red", pch=19)
# New plotting
if (j>1 & j<4) abline(h=x[i-1,2], lty=2)
if (j>2) arrows(x[i-1,1], x[i-1,2], x[i,1], x[i-1,2], length=0.1)
if (j>3 & j<6) abline(v=x[i,1], lty=2)
if (j>4) arrows(x[i,1], x[i-1,2], x[i,1], x[i,2], length=0.1)
if (j>5) points(x[i,1], x[i,2], col="red", pch=19)
if (ask) readline("hit :")
}
}
jj=2:nrow(x)
contour(xx, xx, like, drawlabels=F, nlevels=10, xlim=c(-3,3), ylim=c(-3,3),
xlab=expression(theta[1]), ylab=expression(theta[2]))
segments(x[jj-1,1], x[jj-1,2], x[jj,1], x[jj-1,2], col="gray")
segments(x[jj ,1], x[jj-1,2], x[jj,1], x[jj ,2], col="gray")
points(x[,1], x[,2], col="red", pch=19)
}
```
```{r bivariate_normal_animation, dependson=c('bivariate_normal_mcmc','bivariate_normal'), animation.hook='gifski', cache=TRUE, aniopts="controls,loop"}
bivariate_normal_animation(theta, rho = 0.9)
```
# Additional resources
## Galleries
Official:
- [ggplotly gallery](https://plotly.com/ggplot2/)
- [tmap package](https://cran.r-project.org/web/packages/tmap)
## Individual sites
Individuals:
- [Alex Kaechele](https://rstudio-pubs-static.s3.amazonaws.com/379188_3a2e3e316c604840a53c73151713d7a7.html)
- [richardlent](https://richardlent.github.io/rnotebooks/maps.nb.html)
- [unknown](https://rstudio-pubs-static.s3.amazonaws.com/307862_b8c8460272dc4a2a9023d033d5f3ec34.html)
## Embed
You can always embed additional interactivity.
To get this to work, you need to add the option `data-external="1"` to the
iframe options.
For example, here is a google map.
Here is an embedded video of mine from YouTube discussing the Gibbs sampler
demonstrated above.