Question

我已经在ShinyApp的DataTable中成功实现了操作按钮，但是它仅在没有模块的情况下有效。通过闪亮的模块实现它不会给出任何响应。

我想知道，通过闪亮的模块在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是名称空间。对象NS_select_button不存在，因此，单击按钮将引发错误。您需要引号：

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

要添加一些引号，您可以执行以下操作：

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

如何通过闪亮模块在DataTable中使用闪亮动作按钮？

1 个答案: