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

Posted 2023-03-24

【中文标题】如何在通过双击选择的数据表条目的条件下构建条件面板？

【英文标题】：How to build conditionaPanel on condition of data table entry that was chosen via double click?

【发布时间】：2021-10-06 16:24:14

【问题描述】：

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

但是，我想为最后两个面板添加一个附加条件。当指定的布尔列将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。感谢您的帮助。

【参考方案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');",
  ");"
)

【讨论】：

非常感谢您的回答。这非常接近我想要的。目前必须单击复选框旁边的。如果在表格中的任何一点双击也能正常工作，那就太好了。我为示例数据加载 data.table。

@FireSalamander 好吧。稍后会告诉你，我现在很忙。不需要data.table，一个普通的dataframe就够了。

非常感谢。我意识到我过度简化了我的示例代码。实际上，第二个和第三个条件面板应该显示表格中与所选行相对应的内容。例如，当我双击第一行时，我应该能够显示e。当我使用两个回调时，一个来自我的问题，一个来自您的答案，我可以实现这一点。所以你的回答解决了我的问题，非常感谢。