如何通过shiny模块在DataTable中使用shiny的actionButton？

Question

我已经在闪亮的应用程序 DataTable 中成功实现了 actionButton。但是，它只能在没有模块的情况下工作。通过闪亮模块实现它没有给出任何响应。

我想知道，通过 shiny 模块在 DataTable 内实现操作按钮需要进行哪些更改？

没有模块的应用程序

library(shiny)
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable
  ui <- fluidPage(
    fluidRow(
      DT::dataTableOutput(outputId = "my_data_table"),
      textOutput(outputId = "myText")  
    )
  )
  
  
  server <- function(input, output) {
    
    myValue <- reactiveValues(check = '')
    
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- character(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), ...))
      }
      inputs
    }
    
    
    my_data_table <- reactive({
      tibble::tibble(
        Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
        Motivation = c(62, 73, 3, 99, 52),
        Actions = shinyInput(actionButton, 5,
                             'button_',
                             label = "Fire",
                             onclick = paste0('Shiny.onInputChange( \"select_button\" , this.id)') 
        )    
      )
    })
    
    output$my_data_table <- renderDataTable({
      my_data_table()
    }, escape = FALSE)
    
    
    observeEvent(input$select_button, {
      selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
      myValue$check <<- paste('click on ', my_data_table()[selectedRow,1])
    })
    
    
    output$myText <- renderText({
      myValue$check
    })
    
    
  }

  shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:3424

^{由 reprex package (v0.3.0)}

于 2019-09-17 创建

带有模块的应用程序

library(shiny)
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable


## module UI
test_data_table_ui  <- function(id){
  ns <- NS(id)
  tagList(
    DT::dataTableOutput(outputId = ns("my_data_table")),
    textOutput(outputId = ns("my_text"))  
  )
  
}
  
## module server
test_data_table_server <- function(input, output, session ){
  ns = session$ns
  
  myValue <- reactiveValues(check = '')
  
  shinyInput <- function(FUN, len, id, ns, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }
  
  
  my_data_table <- reactive({
    tibble::tibble(
      Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
      Motivation = c(62, 73, 3, 99, 52),
      Actions = shinyInput(actionButton, 5,
                           'button_',
                           label = "Fire",
                           onclick = paste0('Shiny.onInputChange(' , ns("select_button"), ', this.id)')
      )
    )
  })
  
  output$my_data_table <- DT::renderDataTable({
    return(my_data_table())
  }, escape = FALSE)
  
  
  observeEvent(input$select_button, {
    print(input$select_button)
    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
    myValue$check <<- paste('click on ',my_data_table()[selectedRow,1])
  })


  output$my_text <- renderText({
    myValue$check
  })
  
  
}


ui <- fluidPage(
  test_data_table_ui(id = "test_dt_inside_module")
)

server <- function(input, output, session) {
  callModule(module = test_data_table_server , id = "test_dt_inside_module")
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:7922

^{由 reprex package (v0.3.0)}

于 2019-09-17 创建

Answer 1

您的代码：

paste0('Shiny.onInputChange(' , ns("select_button"), ', this.id)')

生成

"Shiny.onInputChange(NS_select_button, this.id)"

其中 NS 是姓名 space。对象 NS_select_button 不存在，因此单击该按钮会引发错误。您需要引号：

"Shiny.onInputChange('NS_select_button', this.id)"

要包含一些引号，您可以这样做：

onclick = sprintf("Shiny.onInputChange('%s', this.id)", ns("select_button"))

如何通过shiny模块在DataTable中使用shiny的actionButton？

How to use shiny's actionButton in DataTable through shiny module?

r

shiny

dt