Modals within DataTable

[phillc73]

Is it possible to use a shinyBS Modal from within DataTable content? I haven't been able to figure it out on my own, or find an example to work from.

I'm using Shiny Dashboard and the DT package.

Below is some example code, where a column has been hyperlinked within the DataTable to show a simple JS Alert. Ideally I'd like to replace this alert with a lovely shinyBS Modal.

library("shiny")
library("shinydashboard")
library("datasets")
library("DT")

header <- dashboardHeader()

sidebar <- dashboardSidebar()

body <- dashboardBody(
  DT::dataTableOutput("mtcarsTable")
)

shinyApp(
  ui = dashboardPage(header, sidebar, body),
  server = function(input, output) {

    mtcarsLinked <- reactive({

      mtcars$mpg <- sapply(datasets::mtcars$mpg, function(x) paste0('<a href="#" onclick="alert(\'Hello World\');">',x,'</a>'))

      return(mtcars)

    })

    output$mtcarsTable <- DT::renderDataTable({
      DT::datatable(mtcarsLinked(), 
                    class = 'compact',
                    escape = FALSE
      )
  })
  }
)

[ebailey78]

I can't get your example to run, I think it is a problem with the DT package. I've never used it before. But I think you would want to do something like this:

library("shiny")
library("shinydashboard")
library("datasets")
library("DT")
library("shinyBS")

header <- dashboardHeader()

sidebar <- dashboardSidebar()

body <- dashboardBody(
  DT::dataTableOutput("mtcarsTable"),
  bsModal("mtCarsModal", "My Modal", "", tags$p("Hello World"), size = "small")
)

shinyApp(
  ui = dashboardPage(header, sidebar, body),
  server = function(input, output, session) {

    mtcarsLinked <- reactive({

      mtcars$mpg <- sapply(datasets::mtcars$mpg, function(x) {as.character(tags$a(href = "#", onclick = "$('#mtCarsModal').modal('show')", x))})
      print(class(mtcars))
      return(mtcars)

    })

    output$mtcarsTable <- DT::renderDataTable({
      return(DT::datatable(mtcars, 
                    class = 'compact',
                    escape = FALSE
      ))
    })
  }
)

Like I said, I can't get your example to actually run so this exact example might not work but something along these lines should. To have different data depending on what is clicked you would have to have extra javascript in your onclick event to update the innerHTML of $("#mtCarsModal .modal-body"), create separate modals for each link, or create a hidden input that updates on clicking a link and is attached to the server. Then have observers on the server watch for changes in that hidden input. (Use toggleModal() in the observer to open the modal)

Hope this helps,

Eric

[phillc73]

Thanks for the swift response Eric.

I had to edit your code slightly, but I have it working.

library("shiny")
library("shinydashboard")
library("datasets")
library("DT")
library("shinyBS")

header <- dashboardHeader()

sidebar <- dashboardSidebar()

body <- dashboardBody(
  DT::dataTableOutput("mtcarsTable"),
  bsModal("mtCarsModal", "My Modal", "",tags$p("Hello World"), size = "small")
)

shinyApp(
  ui = dashboardPage(header, sidebar, body),
  server = function(input, output, session) {

    mtcarsLinked <- reactive({   
      mtcars$mpg <- sapply(datasets::mtcars$mpg, function(x) {as.character(tags$a(href = "#", onclick = "$('#mtCarsModal').modal('show')", x))})
      return(mtcars)
    })

    output$mtcarsTable <- DT::renderDataTable({
      DT::datatable(mtcarsLinked(), 
                           class = 'compact',
                           escape = FALSE
      )
    })
  }
)

Next step is dynamic modal-body content based on the item selected.

Thanks for your help.

[pekaalto]

@phillc73 Did you ever proceed with the next step? I would love to have an example how to do dynamic modal based on the item clicked. Thanks

[pekaalto]

Wow I figured it out. Here is an example if someone else winds up here. Let me know if there is a better way.

library("shiny")
library("datasets")
library("DT")
library("shinyBS")

ui = shinyUI(fluidPage(
  DT::dataTableOutput("mtcarsTable"),
  bsModal("mtCarsModal", "My Modal", "",textOutput('mytext'), size = "small")
))

on_click_js = "
Shiny.onInputChange('mydata', '%s');
$('#mtCarsModal').modal('show')
"

convert_to_link = function(x) {
  as.character(tags$a(href = "#", onclick = sprintf(on_click_js,x), x))
}

shinyApp(
  ui = ui,
  server = function(input, output, session) {

    mtcarsLinked <- reactive({   
      mtcars$mpg <- sapply(
        datasets::mtcars$mpg,convert_to_link)
      return(mtcars)
    })

    output$mtcarsTable <- DT::renderDataTable({
      DT::datatable(mtcarsLinked(), 
                           class = 'compact',
                           escape = FALSE, selection='none'
      )
    })
    output$mytext = renderText(sprintf('mpg value is %s',input$mydata))
  }
)

source: https://ryouready.wordpress.com/2013/11/20/sending-data-from-client-to-server-and-back-using-shiny/