如何在通过双击选择的数据 table 条目的条件下构建条件面板？

Question

我想构建一个由多个条件面板组成的应用程序。当反应值等于 0 时，第一个面板显示数据 table。当反应值为 1 时，其他两个面板显示。当双击数据 table 时会发生这种情况。

但是，我想对最后两个面板有一个附加条件。当指定的布尔列为双击行取 FALSE 时，其中一个面板必须显示，另一个面板是 TRUE。由于我不熟悉javascript，很遗憾我在这里失败了。

代码如下所示：

library(shiny)
library(data.table)
library(DT)

set.seed(42)
A <- rep(0, 10)
for (i in seq_len(10)) {
  random_length <- sample(1:10, 1)
  random_letters <- sample(letters, random_length)
  A[i] <- paste0(random_letters, collapse = "")
}
B <- sample(c(TRUE, FALSE), 10, replace = TRUE)
dt <- data.table(A, B)

ui <- fluidPage(
  conditionalPanel(
   condition = "output.doubleClickOutput == 0", 
    dataTableOutput("tableId")
  ),
  conditionalPanel(
    condition = "output.doubleClickOutput == 1",
    actionButton("buttonId1",
                 label = "Back 1")
  ), 
    conditionalPanel(
    condition = "output.doubleClickOutput == 1",
    actionButton("buttonId2",
                 label = "Back 2")
  ), 
)

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

  observeEvent(input$doubleClickData, {
    doubleClickIndicator$doubleClick <- 1
  })

  observeEvent(input$buttonId1, {
    doubleClickIndicator$doubleClick <- 0
  })
  
  observeEvent(input$buttonId2, {
    doubleClickIndicator$doubleClick <- 0
  })

  output$doubleClickOutput <- reactive({
    doubleClickIndicator$doubleClick
  })
  outputOptions(output,
                name = "doubleClickOutput",
                suspendWhenHidden = FALSE)
  
    doubleClickIndicator <- reactiveValues(doubleClick = 0)
  
    output$tableId <- renderDataTable(
    dt, 
    options = list(columnDefs = list(list(
      targets = 2, 
      render = JS(
        "function(data, type, row, meta) {",
        "  if(type === 'display'){",
        "    return data ? '<input type=\"checkbox\" disabled checked/>' : '<input type=\"checkbox\" disabled/>';", 
        "  }",
        "  return data;",
        "}"
      )
    ))), 
    callback = JS(
      "table.on('dblclick', 'td', ",
      "function() {",
      "var row = table.cell(this).index().row;",
      "Shiny.setInputValue('doubleClickData', {row});",
      "}",
      ");"
    )
  )
}

shinyApp(ui, server)

一切正常，除了：

  conditionalPanel(
    condition = "output.doubleClickOutput == 1",
    actionButton("buttonId1",
                 label = "Back 1")
  ), 
    conditionalPanel(
    condition = "output.doubleClickOutput == 1",
    actionButton("buttonId2",
                 label = "Back 2")
  ),

应该是这样的

  conditionalPanel(
    condition = "output.doubleClickOutput == 1 && 
    dt[name='B'].rows(input$doubleClickData) == false",
    actionButton("buttonId1",
                 label = "Back 1")
  ), 
    conditionalPanel(
    condition = "output.doubleClickOutput == 1 && 
    dt[name='B'].rows(input$doubleClickData) == true",
    actionButton("buttonId2",
                 label = "Back 2")
  ),

但正确 javascript。感谢您的帮助。

Answer 1

不确定我是否理解所有内容，但是这个呢：

library(shiny)
library(data.table) # why do you use data.table?
library(DT)

set.seed(42)
A <- rep(0, 10)
for (i in seq_len(10)) {
  random_length <- sample(1:10, 1)
  random_letters <- sample(letters, random_length)
  A[i] <- paste0(random_letters, collapse = "")
}
B <- sample(c(TRUE, FALSE), 10, replace = TRUE)
dt <- data.table(A, B)

ui <- fluidPage(
  conditionalPanel(
    condition = "output.doubleClickOutput == 0", 
    dataTableOutput("tableId")
  ),
  conditionalPanel(
    condition = 
      "output.doubleClickOutput == 1 && input.doubleClickData == false",
    actionButton("buttonId1",
                 label = "Back 1")
  ), 
  conditionalPanel(
    condition = 
      "output.doubleClickOutput == 1 && input.doubleClickData == true",
    actionButton("buttonId2",
                 label = "Back 2")
  ), 
)

server <- function(input, output, session) {
  
  doubleClickIndicator <- reactiveValues(doubleClick = 0)
  
  observeEvent(input[["doubleClickData"]], {
    doubleClickIndicator[["doubleClick"]] <- 1
  })
  
  observeEvent(input[["buttonId1"]], {
    doubleClickIndicator[["doubleClick"]] <- 0
  })
  
  observeEvent(input[["buttonId2"]], {
    doubleClickIndicator[["doubleClick"]] <- 0
  })
  
  output[["doubleClickOutput"]] <- reactive({
    doubleClickIndicator[["doubleClick"]]
  })
  outputOptions(
    output,
    name = "doubleClickOutput",
    suspendWhenHidden = FALSE
  )
  
  output[["tableId"]] <- renderDataTable(
    dt, 
    options = list(
      columnDefs = list(
        list(
          targets = 2, 
          render = JS(
            "function(data, type, row, meta) {",
            "  if(type === 'display'){",
            "    return data ? '<input type=\"checkbox\" disabled checked/>' : '<input type=\"checkbox\" disabled/>';", 
            "  }",
            "  return data;",
            "}"
          )
        )
      )
    ), 
    callback = JS(
      "table.on('dblclick', 'td:nth-child(3)', function() {",
      "  var cell = table.cell(this);",
      "  Shiny.setInputValue('doubleClickData', cell.data(), {priority: 'event'});",
      "});"
    )
  )
  
  observe({ # (test)
    print(input[["doubleClickData"]])
  })
}

shinyApp(ui, server)

请注意，您必须在复选框旁边单击一点，而不是在复选框上单击。

编辑

要通过单击一行中的任意位置来获得所需的事件，请将回调替换为以下回调：

callback = JS(
  "table.on('dblclick', 'tr', function() {",
  "  var rowIndex = table.row(this).index();",
  "  var bool = table.cell(rowIndex, 2).data();",
  "  Shiny.setInputValue('doubleClickData', bool, {priority: 'event'});",
  "});"
)

如何在通过双击选择的数据 table 条目的条件下构建条件面板？

How to build conditionaPanel on condition of data table entry that was chosen via double click?

javascript

r

shiny

datatables

dt

编辑