Use bsModal in the shinyBS package with plotly R p

问题:

Here is my code for a basic shiny app using plotly_click event to optionally show another plot. I would like that side box plot to render in a modal pop up instead of on the side within the page.

library(shiny)
library(plotly)

df1 <- data.frame(x = 1:10, y = 1:10)
df2 <- data.frame(x = c(rep('a', 10), rep('b', 10)),
                  y = c(rnorm(10), rnorm(10, 3, 1)))

ui <- fluidPage(
  column(6, plotlyOutput('scatter')),
  column(6, plotlyOutput('box'))
)

server <- function(input, output) {
  output$scatter <- renderPlotly({
    plot_ly(df1, x = x, y = y, mode = 'markers', source = 'scatter')
  })

  output$box <- renderPlotly({
    eventdata <- event_data('plotly_click', source = 'scatter')
    validate(need(!is.null(eventdata),
                  'Hover over the scatter plot to populate this boxplot'))


    plot_ly(df2, x = x, y = y, type = 'box')
  })
}

shinyApp(ui = ui, server = server)

I was able to follow this question (Shiny: plot results in popup window) and response, and tried to use it with the trigger of plotly_click without success. Any idea how to pull the same thing off with a plotly hover click event?

UPDATE: I can clearly see that a plotly plot can be rendered in a shinyBS modal pop up window as demonstrated by this code.

df1 <- data.frame(x = 1:10, y = 1:10)
ui <- fluidPage(
  actionButton('go', 'Click Go'),
  bsModal('plotlyPlot', 'Here is a Plot', 'go', plotlyOutput('scatter1'))
)

server <- function(input, output) {
  output$scatter1 <- renderPlotly({
    plot_ly(df2, x = x, y = y, mode = 'markers', source = 'scatter1')
  })
}

shinyApp(ui = ui, server = server)

Instead of an actionButton as the trigger, I want the plotly_click or plotly_hover as there trigger (in the original example).

回答1:

You can use toggleModal, just add this to your server:

observeEvent(event_data("plotly_click", source = "scatter"), {
 toggleModal(session, "boxPopUp", toggle = "toggle")
})

and put the box Plot in an bsModal (Title and trigger is empty):

ui <- fluidPage(
  column(6, plotlyOutput('scatter')),
  bsModal('boxPopUp', '', '', plotlyOutput('box'))
)

UPDATE: with shiny-build-in Modal functionality (since Shiny 0.14), only the server addition is needed:

 observeEvent(event_data("plotly_click", source = "scatter"), {
                showModal(modalDialog(
                        renderPlotly({
                                plot_ly(df2, x = ~x, y = ~y, type = 'box')
                        })
                ))
        })

回答2:

Using CSS

You can use HTML builder to contain the plots and use stylesheet to add dynamic effects.

ui <- fluidPage(
  includeCSS(path_to_css_file),
  div( class='mainchart',
    column(6, plotlyOutput('scatter')),
    div(  class='popup',
        column(6, plotlyOutput('box'))
       )
    )
)

CSS

div.popup {
   display : none;
   position: absolute;
}
div.mainchart : focus > div.popup {
   display : block;
}
div.mainchart {
   position: relative;
}

Using Javascript

You can use the plotly embeded-API to set the visibility of your side box.

shinyBS

Since you want to stick to shinyBS, you can use the bsPopover function with a little trick. I assume you already know how to use bsModel which is similar to the example below.

Pass the following argument to fluidPage

bsTooltip(id, title, placement = "bottom", trigger = "click", content=column(6, plotlyOutput('box'))  )

This will create the plot with a Popover wraper. I didn't test it yet. In case of error, you can also try

options = list()
options$content = column(6, plotlyOutput('box'))
options$html = T # otherwise the conent will be converted to text
bsTooltip(id, title, placement = "bottom", trigger = "click",  options=options  )

Visit this source file of shinyBS and the popover(options) function of bootstrap for more info.