---
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 <b>Department of Statistics</b>, 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 <enter>:")
    }
  }
  
  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. 

<iframe src="https://www.google.com/maps/embed?pb=!1m16!1m12!1m3!1d11854.426768727611!2d-93.65218595123748!3d42.03016910652055!2m3!1f0!2f0!3f0!3m2!1i1024!2i768!4f13.1!2m1!1srestaurants!5e0!3m2!1sen!2sus!4v1681750079611!5m2!1sen!2sus" data-external="1" width="600" height="450" style="border:0;" allowfullscreen="" loading="lazy" referrerpolicy="no-referrer-when-downgrade"></iframe>

Here is an embedded video of mine from YouTube discussing the Gibbs sampler
demonstrated above.

<iframe width="560" height="315" src="https://www.youtube.com/embed/a_08GKWHFWo" title="Gibbs sampling" frameborder="0" data-external="1" allow="accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture; web-share" allowfullscreen></iframe>

