Кнопки в DT :: datatable Shiny с bsModal () ломаются без сообщения об ошибке - PullRequest
Новая
       16

Кнопки в DT :: datatable Shiny с bsModal () ломаются без сообщения об ошибке

0 голосов
/ 28 августа 2018

Я пытаюсь расширить ответ, приведенный здесь. R Shiny: Нажмите кнопку внутри таблицы, чтобы отобразить всплывающее окно Дважды подряд от SBista. Я хочу включить столбец действий Кнопки, которые запускают всплывающее модальное окно с помощью selectInputs, с выбранными вариантами, которые сохраняются в реактиве и запоминаются при повторном нажатии кнопки

Вот мой код: 

library(shiny)
library(DT)
library(shinyBS)

shinyApp(
  ui <- fluidPage(

shinyjs::useShinyjs(),
#js function to reset a button, variableName is the button name whose value we want to reset
tags$script("Shiny.addCustomMessageHandler('resetInputValue', function(variableName){
            Shiny.onInputChange(variableName, null);
            });
            "),
DT::dataTableOutput("data"),

uiOutput("modal")
),

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

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

df <- reactiveValues(data = data.frame(
  Assessment = shinyInput(actionButton, 10, 'button_', label = "Assessment", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),
  Value1 = 1:10,
  Value2 = c("A", "B", "C", "D", "E"),
  stringsAsFactors = FALSE,
  row.names = 1:10
))

observeEvent(input$Enter, {
    test$selected[[s$value]] <- input$text
})

output$data <- DT::renderDataTable(
  df$data, server = FALSE, escape = FALSE, selection = 'none'
)

test <- reactiveValues(selected = lapply(1:10, function(x) NULL))
s <- reactiveValues(value = NULL)   

observeEvent(input$select_button, {
  s$value <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
  output$modal <- renderUI({
    tagList(
      bsModal(paste('model', s$value ,sep=''), "Assessment", "select_button", size = "small",
              selectInput(paste0("text", s$value), label = h3("Enter Assessment") , choices = c("1", "2"), multiple = TRUE),
              actionButton("Enter", "Enter")
      ),
    updateSelectInput(session, paste0("text", s$value), selected = test$selected[[s$value]])
    )
  })
  toggleModal(session,paste('model', s$value ,sep=''), toggle = "Assessment")
  ##Reset the select_button
  session$sendCustomMessage(type = 'resetInputValue', message =  "select_button")
})      
})

Проблема в том, что приложение разрывается, когда я нажимаю кнопку actionButton и нажимаю «Enter», что не является значением по умолчанию. Например. выбрав третью кнопку и нажав «2», нажмите «Enter». Когда это происходит, сообщения об ошибке нет.

Любые идеи с благодарностью!

...