1 plotly-within-subplot

p1 <- ohio %>% 
      highlight_key(~county) %>%
      plot_ly(x = ~lt25k, y=~repvote, text=~county,  
              textposition="top", hoverinfo="x+y") %>% 
      add_markers()

p2 <- ohio %>% 
      highlight_key(~county) %>%
      plot_ly(x = ~over60_pop, y=~repvote, text=~county,  
              textposition="top", hoverinfo="x+y") %>% 
      add_markers() 
subplot(p1, p2) %>% 
  highlight(on = "plotly_selected", off="plotly_doubleclick", persistent=FALSE) %>% 
  layout(height=400, width=800,
         xaxis=list(title="White Proportion"), 
         xaxis2 = list(title="Over 60 Proportion"), 
         yaxis = list(title="Republican Vote Share"))

2 Crosstalk - scatterplots

library(crosstalk)
s <- SharedData$new(ohio)

p1 <- s %>% 
  plot_ly(x=~lt25k, y=~repvote, text=~county) %>% 
  add_markers() %>% 
  layout(xaxis=list(title="Households Making < $25k"), 
         yaxis = list(title="Republican Share of Vote")) 
p2 <- s %>% 
  plot_ly(x=~white_pop, y=~repvote, text=~county) %>% 
  add_markers() %>% 
  layout(xaxis=list(title="White Share of Population"), 
         yaxis = list(title="Republican Share of Vote"))
bscols(p1, p2)

3 crosstalk - d3scatter

library(d3scatter)

bscols(
  d3scatter(s, ~lt25k, ~asinh(cases), ~urban_rural, width="100%", height=400), 
  d3scatter(s, ~BAplus, ~asinh(cases), ~urban_rural, width="100%", height=400)
)

4 crosstalk with leaflet and dt

library(rio)
library(DT)

shoot <- import("stanford_mass_shooting.dta")

shoot <- shoot %>% 
  select(latitude, longitude, 
         date, city, 
         numberofcivilianfatalities, 
         numberofcivilianinjured,
         numberofenforcementfatalities,
         numberofenforcementinjured)
shoot$date <- as.Date(shoot$date, 
                      format="%m/%d/%Y")
names(shoot) <- c("lat", "long", 
                  "date", "city",
                  "num_civ_fatal", 
                  "num_civ_injur", 
                  "num_pol_fatal", 
                  "num_pol_injur")
shoot <- shoot %>% 
  mutate(year = lubridate::year(date))
rownames(shoot) <- NULL

shoot2 <- SharedData$new(shoot)

library(leaflet)
lmap <- leaflet(shoot2, 
                width="100%", 
                height=400) %>% 
  addTiles() %>% 
  addMarkers()

dts <- datatable(shoot2, 
    extensions="Scroller", 
    style="bootstrap", 
    class="compact", 
    width="100%", 
    rownames=FALSE, 
    colnames=c("Longitude", "Latitude", 
               "Date", "City", 
               "# Civilians Killed", 
               "# Civilians Injured", 
               "# Police Killed", 
               "# Police Injured", "Year"),
            options = list(paging=FALSE, 
                           pageLength = 20, 
                           scrollY = "200px"), 
            fillContainer = TRUE) %>%
    formatRound(columns=c("lat", "long"), digits=1)
bscols(lmap, dts, widths=c(6,6))

5 selection and filtering

bscols(widths = c(6,6), 
  list(
    lmap, 
    filter_slider("yr", "Year", shoot2, ~year, sep=""), 
    filter_select("cty", "City", shoot2, ~city)),
  dts)

6 plotly with animation

library(gapminder)
gapminder %>% 
  mutate(text = paste0(
    country, "\n Life Expectancy = ", lifeExp, 
    "\n GDP/Capita = ", round(gdpPercap), 
    "\n Population = ", round(pop/1000000), "M")) %>% 
  plot_ly(x = ~gdpPercap,  y = ~lifeExp, size = ~pop, 
          color = ~continent, frame = ~year, text = ~text, 
          hoverinfo = "text", type = 'scatter',
          mode = 'markers') %>% 
  layout(xaxis = list(type = "log"))