我想要建立一个应用程序,是由几个conditionalPanels。当反应值等于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。我很感谢你的帮助。
发布于 2021-07-31 14:11:17
我不确定我能理解一切,但这是怎么回事?
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'});",
"});"
)

https://stackoverflow.com/questions/68602558
复制相似问题