class: center, middle, inverse, title-slide # Interactive dataviz on the web with R & plotly
(adapted from
@cpsievert
’s book) ### State of the R - Atelier R de l’AG MIA/NUMM ### 2019-05-22 --- background-image: url(figs/workflow.svg) background-size: contain class: inverse <style> .principles { font-size: 150%; } </style> # Data science workflow --- # Typical example .pull-left[ ```r ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, color = Species)) + geom_point() + geom_smooth(method = "lm", se = FALSE) + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1-1.png" width="864" /> ] --- background-image: url(figs/workflow1.svg) background-size: contain class: inverse # Web graphics are great for communication! --- A Typically French Example [Résultats des élections législatives de 2017](https://abonnes.lemonde.fr/data/france/legislatives-2017/) --- background-image: url(figs/workflow2.svg) background-size: contain class: inverse # Interactive graphics great for exploration! --- class: middle # Interactive graph example .pull-left[ ```r diamonds %>% count(cut, clarity) %>% DT::datatable(list( dom = "tp", pageLength = 6)) ```
] .pull-right[
] --- class: inverse, middle # How to combine both? .pull-left[ ### Rapid iteration with extensibility & reproducibility <img src="figs/workflow2.svg" width="100%" > ] .pull-right[ ### Simple, scalable, and secure hosting <img src="figs/workflow1.svg" width="100%" > ] --- class: middle, principles, inverse # A simple solution: **plotly for R** 1. Powered by [plotly.js](https://github.com/plotly/plotly.js), a JavaScript-library for creating interactive graphs. 2. `plot_ly()`: a direct interface to plotly.js with abstractions to reduce typing (similar to `ggplot2`) 3. `ggplotly()`: translates `ggplot2` to plotly objects. --- # Simple example ```r plot_ly(diamonds, x = ~cut, color = ~clarity, colors = "Accent") %>% add_histogram() ```
--- <img src="figs/printing.svg" width="100%" > --- class: inverse, center, middle # Interactive ggplots --- ### Replace plot with ggplotly ```r library(plotly) p <- ggplot(diamonds, aes(x = log(carat), y = log(price))) + geom_hex(bins = 100) ggplotly(p) ``` <iframe src="01_diamonds_basic.html" width = "100%" height = "500" seamless="seamless" frameBorder="0"> </iframe> --- ### Works out of the box with ggplot core geom_* ```r p <- ggplot(diamonds, aes(x = log(price), color = clarity)) + geom_freqpoly(stat = "density") + facet_grid(~cut) ggplotly(p) ``` <iframe src="02_diamonds_density.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- class: inverse, center, middle # A few features of plotly: tooltip and highlight --- ### Tooltip ```r p <- ggplot(diamonds, aes(x = log(price), color = clarity)) + geom_freqpoly(stat = "density") + facet_grid(~cut) *ggplotly(p, tooltip = c("colour", "x")) # color != colour ``` <iframe src="03_diamonds_tooltip.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ### Highlight ```r *diams <- highlight_key(diamonds, ~clarity) p <- ggplot(diams, aes(x = log(price), color = clarity)) + geom_freqpoly(stat = "density") + facet_grid(~cut) gg <- ggplotly(p, tooltip = c("colour")) *highlight(gg, on = "plotly_click") ``` <iframe src="04_diamonds_hl.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ### A better use of higlight ```r DT::datatable(txhousing) ```
--- ### A better use of higlight ```r tx <- highlight_key(txhousing, ~city) p <- ggplot(tx) + geom_line(aes(date, median, group = city, text = city)) gg <- ggplotly(p, tooltip = "text", width = 800, height = 350) highlight(gg, on = "plotly_click") ``` <iframe src="05_texas_hl.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ### Dynamic highlighting ```r gg <- ggplotly(p, tooltip = "text", width = 800, height = 350) highlight(gg, on = "plotly_hover", selectize = TRUE, dynamic = TRUE) ``` <iframe src="06_texas_dynamic_hl.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ### Persistent highlighting ```r gg <- ggplotly(p, tooltip = "text", width = 800, height = 350) highlight(gg, on = "plotly_hover", selectize = TRUE, dynamic = TRUE, * persistent = TRUE, defaultValues = "Paris" ) ``` <iframe src="07_texas_persistent_hl.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- class: inverse, center, middle # Track data across multiple panels --- ### Highlight a specific year in 4 cities of interest: static version .pull-left[ ```r tx <- txhousing %>% filter( city %in% c("Austin", "Dallas", "Houston", "Paris")) p <- ggplot(tx, aes(x = month, y = median, group = year)) + geom_line(alpha = 0.2) + * geom_line(data = filter(tx, year == 2010), * color = "red") + facet_wrap(~city, ncol = 2) + theme(legend.position = "n") plot(p) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-2-1.png" width="504" /> ] --- ### Highlight a specific year in 4 cities of interest: dynamic version ```r ggplotly(p, tooltip = "year") %>% highlight(on = "plotly_click", persistent = TRUE, dynamic = TRUE, selectize = TRUE) ``` <iframe src="08_texas_tracking_dynamic.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ### Animation via the `frame` argument/aesthetic ```r p <- ggplot(tx, aes(x = month, y = median)) + geom_line(aes(group = year)) + * geom_line(aes(frame = year), color = "red") + facet_wrap(~city, ncol = 2) ggplotly(p) ``` <iframe src="09_texas_animate.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ### Gapminder ```r data(gapminder, package = "gapminder") p <- ggplot(gapminder, aes(gdpPercap, lifeExp, color = continent)) + * geom_point(aes(size = pop, frame = year, ids = country)) + scale_x_log10() ggplotly(p) ``` <iframe src="10_gapminder_animate.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ### Gapminder (Hans Rosling's talk) <div style="float:center ; width:80%"> <video width="854" height="480" controls> <source src="videos/hans_rosling.webm" type="video/webm"> </video> </div> --- class: inverse, center, middle # Saving a plotly object --- ### Saving your interactive graphic ```r p <- plot_ly(x = 1:10, y = 1:10) %>% add_markers() ``` - With `htmlwidgets::saveWidget` ```r htmlwidgets::saveWidget(p, file = "my_widget.html") #> Size = 3.244 MB ``` The resulting html file is fully self-contained. - You can use `partial_bundle` to reduce the file size (by keeping only the parts of plolty.js used in the graphic) ```r htmlwidgets::saveWidget(partial_bundle(p), file = "my_widget.html") #> Size = 1.044 MB ``` --- ### Saving multiple graphics If you create multiple graphics (e.g. for a presentation), don't make every single one *self-contained* but specify a *shared lib directory* ```r htmlwidgets::saveWidget(p, file = "my_widget.html", selfcontained = FALSE, libdir = "my_libdir") htmlwidgets::saveWidget(p, file = "my_other_widget.html", selfcontained = FALSE, libdir = "my_libdir") #> Total size = 3.813 MB ``` <i class="fa fa-exclamation-triangle"></i> If you share it with someone, be sure to share the lib folder <i class="fa fa-folder"></i> at the same time. --- class: middle, center, inverse # Linking multiple views: highlight --- ### Highlight key `highlight_key` creates a *key* used to *link* data ```r # declare the key and build a plotly object tx <- txhousing %>% highlight_key(~city) %>% plot_ly(color = I('black')) %>% group_by(city) # initiate a plotly object (a view) p1 <- tx %>% group_by(city) %>% add_lines(x = ~date, y = ~median) # Initiate a second plotly object (a second view) p2 <- tx %>% group_by(city) %>% summarise(miss = sum(is.na(median))) %>% filter(miss > 0) %>% ungroup() %>% mutate(city = forcats::fct_reorder(city, miss)) %>% add_markers(x = ~miss, y = ~city) ``` --- ```r p1 <- tx %>% group_by(city) %>% add_lines(x = ~date, y = ~median) ``` <iframe src="11_linking_example_left.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ```r p2 <- tx %>% group_by(city) %>% summarise(miss = sum(is.na(median))) %>% filter(miss > 0) %>% ungroup() %>% mutate(city = forcats::fct_reorder(city, miss)) %>% add_markers(x = ~miss, y = ~city) ``` <iframe src="12_linking_example_right.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- ### Combine both plots ```r subplot(p2, p1, widths = c(0.2, 0.8), titleX = TRUE) %>% layout(showlegend = FALSE) %>% highlight(on = "plotly_click", dynamic = TRUE, selectize = TRUE) ``` <iframe src="13_subplot.html" width="100%" height="500" scrolling="no" seamless="seamless" frameBorder="0"> </iframe> --- class: middle, center, inverse # Linking multiple views: filters --- ### Filters ```r library(crosstalk) # No key specified, data are indexed by row number # Allows for the use of multiple keys tx <- highlight_key(txhousing) ## Build plot p <- ggplot(tx) + geom_line(aes(date, median, group = city)) *gg <- ggplotly(p, dynamicTicks = TRUE) ## Build filter *filter <- filter_select("id", "Select a city", tx, ~city) ## Combine filter and plot bscols(filter, gg, widths = c(12, 12)) ``` --- ### Filters
Select a city
--- ### Filters (advanced) ```r tx <- highlight_key(txhousing) ## Many filters widgets <- bscols( widths = c(12, 12, 12), * filter_select("city", "Cities", tx, ~city), * filter_slider("sales", "Sales", tx, ~sales), * filter_checkbox("year", "Years", tx, ~year, inline = TRUE) ) ## A plot p <- ggplot(tx, aes(x = date, y = median, group = city)) + geom_line() + theme(legend.position = "none") *gg <- ggplotly(p) ## Combining both bscols(widgets, gg, widths = c(4, 8)) ``` --- ### Fiters (advanced)
Cities
Sales
Years
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
--- class: middle, center, inverse # Plotly and other htmlwidgets --- ### Leaflet + Plotly ```r library(leaflet) ## index data eqs <- highlight_key(quakes) ## Filter stations <- filter_slider("station", "Number of Stations", eqs, ~stations) ## Plot p <- ggplot(eqs, aes(x = depth, y = mag)) + geom_point(alpha = 0.5) gg <- ggplotly(p) %>% highlight(on = "plotly_selected") ## Map map <- leaflet(eqs) %>% addTiles() %>% addCircles() ## Combine bscols( widths = c(6, 6, 3), gg, map, stations ) ``` --- ### Leaflet + Plotly
Number of Stations
--- ### DT + Plotly ```r ir <- highlight_key(iris) bscols( ## Plot plot_ly(ir, x = ~Sepal.Width, y = ~Sepal.Length, color = ~Species) %>% highlight(on = "plotly_selected", off = "plotly_deselect"), ## datatable widget DT::datatable(ir) ) ``` ---
--- # Thanks! Resources for more learning: https://plotly-r.com/ <br /> https://rstudio.github.io/crosstalk/index.html <br /> <br />