Using plotly animation frame in event_data

Question

I am trying to filter a plot in shiny based on the selected frame in an animated plotly plot (for this app: http://www.seabbs.co.uk/shiny/ExploreGlobalTB/#). Is this possible using the current event_data implementation (for reference: https://plotly-book.cpsievert.me/linking-views-with-shiny.html)? From reading through the ropensci GitHub I don't think this has been implemented. If not any other suggestions for getting this functionality?

A working example of reactivity between plots (on clicking) is as follows (warning this code uses getTBinR and will pull WHO TB data from here (http://www.who.int/tb/country/data/download/en/).

#install.packages(shiny)
library(shiny)
# install.packages(devtools)
# devtools::install_github("seabbs/getTBinR", ref = "improved_interactive_plots")
library(getTBinR)

ui <- fluidPage(
  plotlyOutput("map_tb_burden"),
  verbatimTextOutput("country")
)

server <- function(input, output, session) {

# Make map of metric
output$map_tb_burden <- renderPlotly({

  map <- map_tb_burden(interactive = TRUE, year = c(2000:2016))

})

#Get country clicked on map
country <- reactive({
  country <- event_data(event = "plotly_click", source = "WorldMap")

  country <- country$key[[1]]
})

output$country <- renderText({
  if (is.null(country())) {
    "Select a country for more information"
  } else {
    paste0("Showing data for ", country())
  }
})

  }

shinyApp(ui, server)

The frame for this data is Year in the ggplot object which is then converted using plotly (mapping function code: https://github.com/seabbs/getTBinR/blob/improved_interactive_plots/R/map_tb_burden.R). Ideally I would be able to use the event_data framework, but failing this would it be possible to select the current frame from the plotly object?

A second example modified from MLavoie's answer. Just to clarify the aim is to extract both country on clicking and year as this is animated over. Both examples extract country on clicking, the following makes it clear that year is not changing dynamically as it is animated.

library(shiny)
library(plotly)
library(getTBinR)

tb_burden <- get_tb_burden()

ui <- fluidPage(
  plotlyOutput("map_tb_burden"),
  dataTableOutput("country")
)

server <- function(input, output, session) {

  # Make map of metric
  output$map_tb_burden <- renderPlotly({


    key <- tb_burden$iso3

    g <- list(
      showframe = FALSE,
      showcoastlines = FALSE,
      projection = list(type = 'Mercator')
    )


    plot_ly(data  = tb_burden, frame = ~year, type = 'choropleth', z = ~e_inc_100k, text = ~country, color = ~e_inc_100k, colors = "Reds", locations = ~iso3, key = key) %>% 
      layout(geo = g)

  })

  #Get country clicked on map
  countryB <- reactive({
    d <- event_data("plotly_click")
    ff <- data.frame(d[3])
    ff
  })



  output$country <- renderDataTable({

    d <- event_data("plotly_click")

    #   if (is.null(d))
    #    return(NULL)

    withProgress(message = 'Click on a country', {
      validate(
        need(d, 'Click on a country!')
      )



      testing <- tb_burden %>% filter(iso3 == countryB()$key) 
      testing

    })

  })


}

shinyApp(ui, server)

it is not clear what you want. Do you need to use map_tb_burden? or ploy_geo is fine? Are you trying to extract some info from the map when you click on one country? — MLavoie
Apologies. The final use case is to use this function, but an example with any other approach would be great. Currently the above code extracts the country level data on clicking. I am also looking for a way to extract the current animation frame. This could either be with the same event data call, a second event data call or some other mechanism. — Sam Abbott

MLavoie MLavoie · Accepted Answer · 2018-02-01T13:12:24

I am still not sure what you want but here is something. Instead of using map_tb_burden I use plot_ly for the graphic. In the example, it only prints text but you can decide to plot instead.

library(shiny)
library(plotly)
library(getTBinR)

tb_burden <- get_tb_burden()

ui <- fluidPage(
  plotlyOutput("map_tb_burden"),
  sliderInput("animation", "Looping Animation:", min = 2000, max = 2016, value = 2000, step = 1, animate= animationOptions(interval=1000, loop=FALSE, playButton = "PLAY", pauseButton = "PAUSE")),
  dataTableOutput("country")
)

server <- function(input, output, session) {

  # Make map of metric
  output$map_tb_burden <- renderPlotly({


    key <- tb_burden$iso3

    g <- list(
      showframe = FALSE,
      showcoastlines = FALSE,
      projection = list(type = 'Mercator')
    )

    tb_burdenb <- tb_burden %>% filter(year == input$animation) 
    key <- tb_burdenb$iso3

    plot_ly(data  = tb_burdenb, type = 'choropleth', z = ~e_inc_100k, text = ~country, color = ~e_inc_100k, colors = "Reds", locations = ~iso3, key = key) %>% 
      layout(geo = g)

  })



  sliderValues <- reactive({

    # Compose data frame
    data.frame(
      Name = c("Animation"),
      Value = as.character(c(input$animation)), 
      stringsAsFactors=FALSE)
  }) 



  #Get country clicked on map
  countryB <- reactive({
    d <- event_data("plotly_click")
    ff <- data.frame(d[3])
    ff
  })



  output$country <- renderDataTable({

    d <- event_data("plotly_click")

    #   if (is.null(d))
    #    return(NULL)

    withProgress(message = 'Click on a country', {
      validate(
        need(d, 'Click on a country!')
      )



      testing <- tb_burden %>% filter(iso3 == countryB()$key) %>% filter(year == input$animation) 
      testing

    })

  })


}

shinyApp(ui, server)

Using plotly animation frame in event_data

1 Answers