--- 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.