Всплывающее окно после нажатия на DT в блестящем

Question

Я пытаюсь получить всплывающее окно после нажатия кнопки действия, находящейся внутри таблицы данных. Все кнопки имеют одинаковый идентификатор. Может ли кто-нибудь помочь мне на примере ниже?

Пример:

rm(list = ls()) 
library("shiny") 
library("shinydashboard") 
library("shinyBS") 
mymtcars = mtcars 
mymtcars$id = 1:nrow(mtcars) 

header <- dashboardHeader(title = "Example") 

body <- dashboardBody(
    mainPanel(
     dataTableOutput("mytable"), 
     bsModal("myModal", "Your plot", "button", size = "large",plotOutput("plot")) 
    )    ) 
sidebar <- dashboardSidebar() 
ui <- dashboardPage(header,sidebar,body,skin="red") 
server = function(input, output, session) { 

    randomVals <- eventReactive(input$button, { 
     runif(50)  }) 

    output$plot <- renderPlot({ 
     hist(randomVals()) 
    }) 



    output$mytable = renderDataTable({ 
    # addCheckboxButtons <- paste('<button id=\"button\" type=\"button\" data-toggle=\"modal\" class=\"btn btn-default action-button\">Show modal</button>') 
     addCheckboxButtons <- paste('<button id=\"button\" type=\"button\" class=\"btn btn-default action-button\" data-toggle=\"modal\" data-target=\"myModal\">Open Modal</button>') 

     cbind(Pick=addCheckboxButtons, mymtcars) 
    }, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25),escape=F 
    ) 

    observeEvent(input$button, { 
     toggleModal(session, "myModal", "open") 
    }) 
    } 

runApp(list(ui = ui, server = server)) 

Answer 1

Я получил его на работу, но это требует много вещей. Во-первых, я сделал каждую кнопку уникальной. Вы не можете дублировать идентификаторы HTML. Затем, чтобы использовать Блестящие входы в DataTables, вам нужно отменить использование javascript в событиях обратного вызова. Из-за того факта дублирования HTML, о котором я упомянул ранее, я создал уникальный файл bsModal и график для каждой кнопки. Я использовал много lapply. Вам также понадобится пакет DT. Вот код:

rm(list = ls()) 
library("shiny") 
library("DT") 
library("shinydashboard") 
library("shinyBS") 
mymtcars = mtcars 
mymtcars$id = 1:nrow(mtcars) 

shinyInput = function(FUN, len, id, ...) 
{ 
    inputs = character(len) 
    for (i in seq_len(len)) 
    { 
    inputs[i] = as.character(FUN(paste0(id, i), ...)) 
    } 
    inputs 
} 

header <- dashboardHeader(title = "Example") 

body <- dashboardBody(mainPanel(DT::dataTableOutput("mytable"), 
           lapply(seq_len(nrow(mtcars)), 
           function(i) 
            { 
            bsModal(paste0("myModal", i), "Your plot", paste0("btn", i), size = "large", 
             plotOutput(paste0("plot", i))) 
            }))) 
sidebar <- dashboardSidebar() 
ui <- dashboardPage(header, sidebar, body, skin = "red") 
server = function(input, output, session) 
{ 
    randomVals <- reactive({ 
    # call input from each button arbitrarily in code to force reactivity 
    lapply(seq_len(nrow(mymtcars)), function(i) 
    { 
     input[[paste0("btn",i)]] 
     }) 

    runif(50) 
    }) 

    plot <- reactive({ 
    hist(randomVals()) 
    }) 

    lapply(seq_len(nrow(mymtcars)), function(i) 
    { 

    output[[paste0("plot", i)]] <- renderPlot(plot()) 


    observeEvent(input[[paste0("btn", i)]], { 
     toggleModal(session, paste0("myModal", i), "open") 
    }) 

    }) 

    output$mytable = DT::renderDataTable({ 

    btns <- shinyInput(actionButton, nrow(mymtcars), "btn", label = "Show modal") 

    cbind(Pick = btns, mymtcars) 

    }, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25, 
        preDrawCallback = JS("function() { 
             Shiny.unbindAll(this.api().table().node()); }"), 
        drawCallback = JS("function() { 
             Shiny.bindAll(this.api().table().node()); } ")), 
    escape = F) 

    } 

runApp(list(ui = ui, server = server))