点击reactable中的同一行后，modalDialog未打开

Question

我目前正在构建一个闪亮的应用程序，我允许用户单击可反应中的一行，并显示一个模态对话框，其中包含基于该行的更多信息。我按照这篇文章（如何从可反应的单元格渲染按钮中使用observeEvent触发modalBox？）来获取

onclick

JavaScript函数。

但是，当我使用此逻辑单击同一行时，什么也没有发生。在单击返回同一行之前，我必须单击另一行。我相信这是因为如果单击同一行，

input$foo

不会更改其值。

我尝试在

input$foo

打开时将

modalDialog

设置为不同的值，但这也不起作用。有谁知道如何解决这个问题或在打开后重置

input$foo

值？我在 JavaScript 方面没有丰富的经验。下面显示了一个基本的 Shiny 示例，其中

modalDialog

的标题在单击特定行后显示汽车名称。

library(shiny)
library(tidyverse)
library(reactable)

ui <- fluidPage(
  fluidRow(
    column(12, align = 'center',reactableOutput("tbl"))
    )
)


server <- function(input, output, session) {
  
  data = reactive({
    mtcars %>% add_rownames('car')
  })
  
  output$tbl = renderReactable(
    reactable(
      data(),
      defaultPageSize = 10,
      compact = T,
      highlight = T,
      defaultColDef = colDef(headerClass = "bar-sort-header",
                             sortNALast = T, align = 'center',
                             headerVAlign = 'center',
                             vAlign = 'center',
                             minWidth = 60
      ),
      onClick = JS("function(rowInfo, colInfo) {
                              Shiny.setInputValue('foo', rowInfo.id)
                            }"),
      rowStyle = list(cursor = "pointer")
    )
  )
  
  observeEvent(input$foo, {
    print(input$foo)
    showModal(
      modalDialog(
        size = 'l',
        easyClose = T,
        title = data()$car[as.numeric(input$foo)+1],
      )
    )
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

我也经常遇到这个问题，我的方法是在调用

input$foo

后将

null

设置为

showModal

，这样我们就可以再次单击同一行：

library(shiny)
library(tidyverse)
library(reactable)

ui <- fluidPage(
  
  tags$head(
    tags$script(
    "Shiny.addCustomMessageHandler('update_input_foo', function(value) {
      Shiny.setInputValue('foo', null)
    });
    ")
  ),
  
  fluidRow(
    column(12, align = 'center',reactableOutput("tbl"))
  )
)


server <- function(input, output, session) {
  
  data = reactive({
    mtcars %>% add_rownames('car')
  })
  
  output$tbl = renderReactable(
    reactable(
      data(),
      defaultPageSize = 10,
      compact = T,
      highlight = T,
      defaultColDef = colDef(headerClass = "bar-sort-header",
                             sortNALast = T, align = 'center',
                             headerVAlign = 'center',
                             vAlign = 'center',
                             minWidth = 60
      ),
      onClick = JS("function(rowInfo, colInfo) {
                              Shiny.setInputValue('foo', rowInfo.id)
                            }"),
      rowStyle = list(cursor = "pointer")
    )
  )
  
  r <- reactiveVal(NULL)
  
  observeEvent(input$foo, {
    
    if (!is.null(input$foo)) {
    showModal(
      modalDialog(
        size = 'l',
        easyClose = T,
        title = data()$car[as.numeric(input$foo)+1],
      )
    )
    
    session$sendCustomMessage("update_input_foo", 1)

    }
  })

}

shinyApp(ui = ui, server = server)

Answer 2

我也经常遇到这个问题，这是一种更简单的方法，每次单击该行时都会发送一个随机值。

library(shiny)
library(tidyverse)
library(reactable)

ui <- fluidPage(
  fluidRow(
    column(12, align = 'center',reactableOutput("tbl"))
  )
)


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

  data = reactive({
    mtcars %>% tibble::rownames_to_column('car')
  })

  output$tbl = renderReactable(
    reactable(
      data(),
      defaultPageSize = 10,
      compact = T,
      highlight = T,
      defaultColDef = colDef(headerClass = "bar-sort-header",
                             sortNALast = T, align = 'center',
                             headerVAlign = 'center',
                             vAlign = 'center',
                             minWidth = 60
      ),
      onClick = JS("function(rowInfo, colInfo) {
                              Shiny.setInputValue('foo', {id:rowInfo.id, nonce:Math.random()})
                             }"),
      rowStyle = list(cursor = "pointer")
    )
  )

  observeEvent(input$foo, {
    print(input$foo)

    id <- input$foo$id
    row_nr <- as.numeric(id)+1

    showModal(
      modalDialog(
        size = 'l',
        easyClose = T,
        title = data()$car[row_nr],
      )
    )
  })

}

shinyApp(ui = ui, server = server)

Answer 3

我发现解决这个问题的唯一方法是将事件优先级添加到输入更改中。 通常，如果值没有改变，闪亮的输入不会触发observeEvent，但是您可以通过将

{ priority: 'event' }

添加到

Shiny.setInputValue

来强制执行该行为

这是问题中代码的完整编辑：

library(shiny)
library(tidyverse)
library(reactable)

ui <- fluidPage(
  fluidRow(
    column(12, align = 'center',reactableOutput("tbl"))
    )
)


server <- function(input, output, session) {
  
  data = reactive({
    mtcars %>% add_rownames('car')
  })
  
  output$tbl = renderReactable(
    reactable(
      data(),
      defaultPageSize = 10,
      compact = T,
      highlight = T,
      defaultColDef = colDef(headerClass = "bar-sort-header",
                             sortNALast = T, align = 'center',
                             headerVAlign = 'center',
                             vAlign = 'center',
                             minWidth = 60
      ),
      onClick = JS("function(rowInfo, colInfo) {
                              Shiny.setInputValue('foo', rowInfo.id, {priority: 'event' })
                            }"),
      rowStyle = list(cursor = "pointer")
    )
  )
  
  observeEvent(input$foo, {
    print(input$foo)
    showModal(
      modalDialog(
        size = 'l',
        easyClose = T,
        title = data()$car[as.numeric(input$foo)+1],
      )
    )
  })
  
}

shinyApp(ui = ui, server = server)