---
title: "Animated graphics in R"
author: Abhijit Dasgupta, PhD
abstract: Animated graphics in R, with mouseovers
---

```{r setup, include=FALSE, child = here::here('slides/templates/setup.Rmd')}
```


```{r setup1, include=FALSE}
pacman::p_load(htmlwidgets)
pacman::p_load(plotly)
pacman::p_load(widgetframe)
theme_set(theme_classic()+theme(axis.text = element_text(size=14),
                                axis.title = element_text(size=16),
                                legend.text = element_text(size=14),
                                legend.title = element_text(size=16)))
Sys.setenv("RSTUDIO_PANDOC" = '/usr/bin/')
```

layout: true

<div class="my-header">
<span>BIOF 339: Practical R</span></div>

---
class: middle,inverse

# Dynamic graphics


---

## Dynamic graphics in R

There are several package in R that provide dynamic graphics meant to be consumed on the web.

Many of these are wrappers around well-known Javascript libraries like D3.js, leaflet.js and others

These packages have mostly come under the umbrella of of the `htmlwidgets` package, which allows these
HTML-based graphics to be displayed through R and R Markdown

<iframe src="https://www.htmlwidgets.org" height="300" width="100%"></iframe>

---

## Dynamic graphics in R

There are several broad categories of dynamic graphs

General purpose:

```{r, echo=FALSE }
tribble(
    ~Package, ~Description,
    'r2d3' , 'Interface for D3.js, requires D3.js code',
    'plotly', 'Interface with plot.ly, direct conversion from ggplot2',
    'highcharter', 'Using the Highcharts.js package',
    'dygraphs', 'For time series or longitudinal data'
) %>%
    knitr::kable() %>%
    kable_styling()

```

Maps: 

```{r }
tribble(
    ~Package, ~Description,
        "leaflet", "Maps using OpenStreetMaps") %>%
    kable() %>%
    kable_styling()
```

---

## Dynamic graphics in R

Networks:

```{r }
tribble(~Package, ~Description,
        'networkD3', 'Dynamic network visualizations using D3',
        'visNetwork', 'Interface to the vis.js pacman::p_load') %>%
    kable() %>% kable_styling()
        
```




---
class: middle, inverse

# Plotly
https://plotly.com/graphing-libraries

---

## Plotly

Plotly is a company that developed the `plotly.js` graphing pacman::p_load, as well as packages for R and Python. 

For the R package, it developed a turnkey method to convert `ggplot2` graphics into interactive graphs.

.pull-left[
```{r g1, echo=TRUE, fig.height=3}
plt <- ggplot(penguins,
              aes(bill_length_mm, body_mass_g,
                  color = species))+
    geom_point()
plt
```
]
.pull-right[
```{r , echo=TRUE, fig.height=4}
ggplotly(plt)
```
]

---

## Plotly

You can do some customization on the tooltips (what shows up when you put your mouse over a point). 

```{r , fig.height=5, fig.width=12, echo=TRUE}
p <- ggplot(data = diamonds, aes(x = cut, fill = clarity))+
    geom_bar(position = 'dodge')
ggplotly(p, tooltip = c('cut')) #<<

```
---

## Plotly

You can do linked plots in plotly, so interactions in one plot are reflected in a second plot. This is called _brushing_. The key here is to use `highlight_key`, which allows a data frame to be shared between multiple
plots at the same time. 

```{r brush, echo=T, fig.height=4, fig.width=9}
d <- highlight_key(penguins)
plt1 <- ggplot(d, aes(x = bill_length_mm, y = body_mass_g))+geom_point()
plt2 <- ggplot(d, aes(x = bill_length_mm, y = flipper_length_mm))+geom_point()
subplot(plt1, plt2) %>% 
    layout(title = "Click and drag to select points") %>%
    highlight("plotly_selected")
```

---

## Plotly

You can also do brushing over multiple plots drawn on the same dataset

.left-column70[
```{r brush2, echo=TRUE, fig.height=5}
 highlight_key(iris) %>%
       GGally::ggpairs(aes(colour = Species), columns = 1:4) %>%
       ggplotly(tooltip = c("x", "y", "colour")) %>%
       highlight("plotly_selected")
```
]
.right-column70[
**GGally** is a **ggplot2** extension that provides additional composite plot types like 
the pairs plot we use here.
]

---
class: middle, inverse

# Dygraphs
https://rstudio.github.io/dygraphs

---

## Dygraphs

The *dygraphs* package wraps the `dygraphs` Javascript pacman::p_load, which is build to chart time-series data.

```{r dyg1, echo=TRUE, fig.height=6}
pacman::p_load(dygraphs)
dygraph(nhtemp, main = "New Haven temperatures") %>%
    dyRangeSelector(dateWindow = c("1920-01-01","1960-01-01"))
```

-------------------------------------------------------------------------------

This package is built for linked charts, in the form of line charts + annotations + controls

---

## Dygraphs

We can also create multiple linked time series

.left-column30[
```{r dyg2, echo=TRUE, eval=FALSE}
dygraph(ldeaths, main = "All",
        group = "lung-deaths") #<<
dygraph(mdeaths, main = "Male",
        group = "lung-deaths") #<<
dygraph(fdeaths, main = "Female",
        group = "lung-deaths") #<<

```

You could name the group anything you like, as long as it's the same across the plots.
]
.right-column30[
```{r dyg22, echo=FALSE, eval=TRUE, fig.height=2, ref.label='dyg2'}

```
]

---

## Dygraphs

You could also annotate dygraphs

```{r ,echo=TRUE, fig.height=5}
dygraph(presidents, main = "Quarterly Presidential Approval Ratings") %>%
  dyAxis("y", valueRange = c(0, 100)) %>%
  dyEvent("1950-6-30", "Korea", labelLoc = "bottom") %>%
  dyEvent("1965-2-09", "Vietnam", labelLoc = "bottom")
```

---
class: middle, inverse

# Highcharter
https://jkunst.com/highcharter/index.html

---
## Highcharter

+ The **highcharter** package provides a rich set of plotting functions for dynamic graphics
+ The R package is, in spirit, similar to **ggplot2**
    + It uses *mappings*, *aesthetics* and *geometries* (called *types*)
    + Customization can be added using additional functions in a pipe
    + Very rich set of chart types
	
---

## Highcharter


.pull-left[
```{r hc1, echo=T, eval=FALSE}
pacman::p_load(highcharter)

hchart(object=penguins,
       type="scatter",
       mapping = hcaes(x = body_mass_g,
                       y = flipper_length_mm ,
                       group = species)) %>%
    hc_legend(align='right',
              verticalAlign='top')

```

See how the elements are similar to what you'd put in a **ggplot2** pipe, except they are in a single function

Options can be added with pipes
]
.pull-right[
```{r , echo=F, eval=T, fig.height=4, ref.label='hc1'}

```
]

---

## Highcharter

Unlike **ggplot2**, the object to be plotted doesn't have to be a data frame

.pull-left[
```{r hc2, echo=T, eval=F}
hc1=hchart(diamonds$cut, type='column')
hc1
```
]
.pull-right[
```{r ,ref.label='hc2', eval=T}

```
]

---

## Highcharter

We can make some more complex plots using **highcharter**

.pull-left[
```{r , eval=FALSE, echo=TRUE}
pacman::p_load(survival)
pacman::p_load(widgetframe)

data(lung)
lung <- dplyr::mutate(lung,
                      sex = ifelse(sex == 1, "Male", "Female"))
fit <- survfit(Surv(time, status) ~ sex, data = lung)
hchart(fit, ranges=TRUE)
```
]
.pull-right[
```{r , eval=TRUE, echo=FALSE}
pacman::p_load(survival)
pacman::p_load(widgetframe)

data(lung)
lung <- dplyr::mutate(lung,sex = ifelse(sex == 1, "Male", "Female"))
fit <- survfit(Surv(time, status) ~ sex, data = lung)
hc <- hchart(fit, ranges=TRUE)
frameWidget(hc)
```
]
---

## Highcharter

.pull-left[
```{r, echo=TRUE, eval=FALSE}
pacman::p_load(highcharter)
mtcars2 <- mtcars[1:20, ]
x <- dist(mtcars2)
hchart(x)
```
]
.pull-right[
```{r, echo=FALSE, eval=TRUE}
pacman::p_load(highcharter)
mtcars2 <- mtcars[1:20, ]
x <- dist(mtcars2)
frameWidget(hchart(x))
```
]

---

## Highcharter

### Licensing issues  ###

<quote>
Highcharter has a dependency on Highcharts, a commercial JavaScript charting pacman::p_load. Highcharts offers both a commercial license as well as a free non-commercial license. Please review the licensing options and terms before using this software, as the highcharter license neither provides nor implies a license for Highcharts.

Highcharts (http://highcharts.com) is a Highsoft product which is not free for commercial and Governmental use.
</quote>

---
class: middle, inverse

# rbokeh
http://hafen.github.io/rbokeh/

---

## rbokeh

**rbokeh** wraps the **bokeh** plotting pacman::p_load in Python

It uses a layering concept similar to **ggplot2**

---

.pull-left[
```{r rb1, echo=TRUE, eval=TRUE}
pacman::p_load(rbokeh)
p <- figure(width=400,height=400) %>%
    ly_points(bill_length_mm, body_mass_g,
              data=penguins,
              color=species, glyph = species,
              hover=list(bill_length_mm,body_mass_g))
p
```
]
.pull-right[
```{r, echo=TRUE }
z <- lm(dist ~ speed, data = cars)
p <- figure(width = 400, height = 400) %>%
  ly_points(cars, hover = cars) %>%
  ly_lines(lowess(cars), legend = "lowess") %>%
  ly_abline(z, type = 2, legend = "lm")
p
```
]

---
class: middle, inverse

# Maps
 
---

## Maps

We've already seen maps with **leaflet** that allow data to be overlayed over cartographic maps

Using the packages introduced here, we also have mapping capabilities. See the respective websites for 
details

.pull-left[
**rbokeh**
```{r , echo=FALSE}
pacman::p_load(maps)
data(world.cities)
caps <- subset(world.cities, capital == 1)
caps$population <- prettyNum(caps$pop, big.mark = ",")
figure(width = 400, height = 250, padding_factor = 0) %>%
  ly_map("world", col = "gray") %>%
  ly_points(long, lat, data = caps, size = 5,
    hover = c(name, country.etc, population))
```
]
.pull-right[
**highcharter**
```{r , echo=FALSE}
data <- tibble(
  country = 
    c("PT", "IE", "GB", "IS",
      
      "NO", "SE", "DK", "DE", "NL", "BE", "LU", "ES", "FR", "PL", "CZ", "AT",
      "CH", "LI", "SK", "HU", "SI", "IT", "SM", "HR", "BA", "YF", "ME", "AL", "MK",
      
      "FI", "EE", "LV", "LT", "BY", "UA", "MD", "RO", "BG", "GR", "TR", "CY",
      
      "RU"),  
  tz = c(rep("UTC", 4), rep("UTC + 1",25), rep("UCT + 2",12), "UTC + 3")
  )

# auxiliar variable
data <- data %>% 
  mutate(value = cumsum(!duplicated(tz)))


# now we'll create the dataClasses
dta_clss <- data %>% 
  mutate(value = cumsum(!duplicated(tz))) %>% 
  group_by(tz) %>% 
  summarise(value = unique(value)) %>% 
  arrange(value) %>% 
  rename(name = tz, from = value) %>% 
  mutate(to = from + 1) %>% 
  list_parse()

hcmap(
  map = "custom/europe",
  data = data, 
  joinBy = c("iso-a2","country"),
  name = "Time zone",
  value = "value",
  tooltip = list(pointFormat = "{point.name} {point.tz}"),
  dataLabels = list(enabled = TRUE, format = "{point.country}")
  ) %>%
  hc_colorAxis(
    dataClassColor = "category",
    dataClasses = dta_clss
    ) %>% 
    hc_title(text = "Europe Time Zones") %>%
    hc_size(width=400, height=250)

```
]

---
class: middle, inverse

# Using D3.js in R

---

## r2d3

[D3.js](https://d3js.org) is a state-of-the-art Javascript pacman::p_load for data-driven graphics

It is widely used in data journalism, including the New York Times and the Guardian

However, it controls each aspect of a chart and so can require rather long JS scripts

<iframe src="https://d3js.org" width="100%" height="300"></iframe>

---

## r2d3

If you know D3.js, you can use it pretty easily embed them in R using the **r2d3** package

```{r echo=TRUE, eval=TRUE}
pacman::p_load(r2d3)

r2d3(data =  read_csv('../data/flare.csv'), d3_version = 4, script = 'bubbles.js')
```

---

## r2d3

```{r echo=TRUE}

r2d3(data = jsonlite::read_json('../data/miserables.json'), d3_version = 4, script = 'forcegraph.js')
```

---

## networkD3

You can also draw networks slightly more easily using the **networkD3** package.

.pull-left[
```{r nd3, echo=T, eval=F}
pacman::p_load(networkD3)
lemis <- jsonlite::fromJSON('../data/miserables.json')
lemis$links <- lemis$links %>%
    mutate(ID = 1:n()) %>% 
    gather(location, nm, source, target) %>%
    mutate(nm = as.integer(as.factor(nm))-1) %>%
    spread(location, nm)

forceNetwork(Links = lemis$links, Nodes = lemis$nodes,
             Source='source', Target='target',
             Value = 'value',
             NodeID = 'id', Group = 'group', opacity=0.7,
             zoom = TRUE, fontSize = 20)
```
]
.pull-right[
```{r , echo=FALSE, eval=TRUE, ref.label="nd3"}

```
]

---

## Crosstalk

**Crosstalk** is a package that allows multiple HTML widgets to share data and interact together. 

Not all packages in the **htmlwidgets** family are **crosstalk**-compatible.

```{r , echo=TRUE, eval=FALSE}
load('data/exdata.rda')
pacman::p_load(leaflet); pacman::p_load(crosstalk); pacman::p_load(d3scatter)

gpx1 <- gpx %>%
   mutate(Minutes = as.numeric(difftime(Time, min(Time), units = 'mins'))) %>%
   filter(Minutes <= 50) %>%
   left_join(run_data)

 shared_gpx1 <- SharedData$new(gpx1)
 bscols(
   leaflet(data = shared_gpx1, width="100%", height=450) %>% addTiles() %>%
     addCircleMarkers(~Longitude, ~Latitude, radius=1, color='blue'),
   list(
   d3scatter(shared_gpx1, ~Minutes, ~ HR, width="100%", height=450)
   )
 )
 bscols(
   filter_slider("Minutes","Time", shared_gpx1, ~Minutes, width="100%")
 )
```

.center[`leaflet` + `d3scatter` + `crosstalk`]

---

## Linked graphs

<iframe src="https://webbedfeet.github.io/DC_R2018/Presentation.html#23" width="100%" height="500"></iframe>

---

## Conclusions

+ There are many many resources today to create interactive graphics
+ For many of them, there are wrappers in R
+ You can explore the respective packages for many more details about the different kinds of charts and customizations that are possible.