在 R Shiny 中，如何扭转反应链？

Question

在下面的 MWE 代码中，默认情况下会渲染和绘制第一个输入框。显示和绘制默认值，用户可以更改它。单击“显示”复选框呈现第二个输入框，其值链接到第一个输入框，并且在这个第二个输入框中，用户可以选择插入另一个值，然后优先于第一个输入并被绘制。 （在完整的应用程序中，第二个输入框执行其他计算，因此此处显示的内容被简化）。所以反应链起作用：输入1->输入2，输入2优先于输入1。

但是，我如何扭转这个反应链？那么 input1 中显示的值会发生变化以反映 input2 中的输入内容吗？在下面的 MWE 中，我尝试在标记为 << comment/uncomment this line to see 的行中执行此操作，但是当取消注释该行时（允许我尝试的解决方案运行），即使第二个输入的“显示”复选框保持选中状态，第二个输入框也会隐藏表演。第二个输入框应继续显示，直到未选中。

也见下图。

MWE 代码：

library(shiny)
library(shinyjs)
library(shinyMatrix)

### Checkbox matrix ###
f <- function(action,i){as.character(checkboxInput(paste0(action,i),label=NULL))}
actions       <- c("show", "reset")
tbl           <- t(outer(actions, c(1,2), FUN = Vectorize(f)))
colnames(tbl) <- c("Show", "Reset")
rownames(tbl) <- c("2nd input", "3rd input")
### Checkbox matrix ###

xDflt <- 5
userInput <- function(inputId,x,y){
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c(y),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      "td .checkbox {margin-top: 0; margin-bottom: 0;}
       td .form-group {margin-bottom: 0;}"
    ))
  ),
  br(),
  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      hidden(uiOutput("secondInput")),
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output){
  
  input1      <- reactive(input$input1)
  input2      <- reactive(input$input2)
  
  output$panel <- renderUI({
    tagList(
      useShinyjs(),
      userInput("input1",
                # if(isTruthy(input2())){input$input2[1,1]} else # << comment/uncomment this line to see
                  {xDflt},
                "1st input"),
      strong(helpText("Generate curves (Y|X):")),
      tableOutput("checkboxes") 
    )
  })
  
  ### Begin checkbox matrix ###
  output[["checkboxes"]] <- 
    renderTable({tbl}, 
      rownames = TRUE, align = "c",
      sanitize.text.function = function(x) x
    )

  observeEvent(input[["show1"]], {
    if(input[["show1"]] ){
      shinyjs::show("secondInput")
    } else {
      shinyjs::hide("secondInput")
    }
  })
  ### End checkbox matrix ###
 
  output$secondInput <- renderUI({
    req(input1())
    userInput("input2",input$input1[1,1],"2nd input")
  })
  
  outputOptions(output,"secondInput",suspendWhenHidden = FALSE) 
  
  output$plot1 <-renderPlot({
    req(input2())
    plot(rep(input2(),times=5))
  })

}

shinyApp(ui, server)

Answer 1

您的复选框未选中，因为您将它们与output$panel 一起渲染和重新渲染。您忘记在 UI 中添加 uiOutput("checkboxes")。步骤如下：

1. 从output$panel <- renderUI() 中删除tableOutput("checkboxes")。
2. 将uiOutput("checkboxes"), 添加到用户界面。
3. 取消注释您的行 if(isTruthy(input2() ...。

这应该可以解决问题。

关于代码的一些评论。我觉得它不必要地复杂。例如。您在 userInput 函数中使用 c(x) 是不必要的。您将input$input1 包装在一个反应​​式表达式中，它不会添加任何东西（可能除了可读性），但会增加反应链的复杂性。有几种方法可以使代码更易于理解和阅读，这可能有助于避免简单的错误，例如缺少 uiOutput。