需要处理多个条件时的条件闪亮 UI

Question

实际问题

我如何设计（*）一个闪亮的应用程序，其中某些 UI 元素依赖于需要系统处理的多个条件？

(*) 以一种不会让你发疯的可维护方式 ;-)

---

详情

我读过Build a dynamic UI that reacts to user input 和喜欢conditionalPanel()，但我觉得它对于我想要构建的timetracking app (source code on GitHub) 来说太“一维”了。

我想做的事：

1. 拥有一个（或多个）可以触发条件 UI 部分的 UI 元素：

   状态 1

2. 那些有条件的 UI 部分通常有一些输入字段和至少两个操作按钮：Create 和 Cancel：

   状态 2

3. 如果单击Create，则应适当处理输入（例如将内容写入数据库），然后条件 UI 部分应再次“消失”，因为其条件“已过期”：

   状态 3

   状态 4

4. 如果Cancel被点击，UI部分应该再次“消失”，因为它的状态“过期”：

   状态 4

5. 随后点击Trigger 应再次“开始循环”

多依赖和动态依赖状态的问题：

AFAIU，如果我只是将依赖项（即下面的 input$action_trigger、input$action_create 和 input$action_cancel）放入构建条件 UI 的反应式上下文中，那么我将面临多轮失效，直到所有依赖项都达到稳定状态（参见下面的output$ui_conditional <- renderUI({})）。

从用户体验的角度来看，这感觉就像必须多次单击元素直到获得所需的内容（查看我的 timetracking app 中的这种“多次单击必要”行为的示例）。

这就是为什么我想出引入某种“依赖状态清除”层的想法（参见下面的ui_decision <- reactive({})）

当前解决方案

我目前的解决方案感觉非常错误，非常脆弱且维护成本很高。你也可以在GitHub找到它

全局：

library(shiny)

GLOBALS <- list()
GLOBALS$debug$enabled <- TRUE

# Auxiliary functions -----------------------------------------------------

createDynamicUi_conditional <- function(
  input,
  output,
  ui_decision,
  debug = GLOBALS$debug$enabled
) {
  if (debug) {
    message("Dynamic UI: conditional ----------")
    print(Sys.time())
  }

  ## Form components //
  container <- list()

  field <- "title"
  name <- "Title"
  value <- ""
  container[[field]] <- textInput(field, name, value)

  field <- "description"
  name <- "Description"
  value <- ""
  container[[field]] <- textInput(field, name, value)

  ## Bundle in box //
  value <- if (ui_decision == "hide") {
    div()
  } else if (ui_decision == "show" || ui_decision == "create") {
    container$buttons <- div(style="display:inline-block",
      actionButton("action_create", "Create"),
      actionButton("action_cancel", "Cancel")
    )
    do.call(div, args = list(container, title = "conditional dynamic UI"))
  } else {
    "Not implemented yet"
  }
  # print(value)
  value
}

用户界面部分：

# UI ----------------------------------------------------------------------

ui <- fluidPage(
  actionButton("action_trigger", "Trigger 1"),
  h3("Database state"),
  textOutput("result"),
  p(),
  uiOutput("ui_conditional")
)

服务器部分：

# Server ------------------------------------------------------------------

server <- function(input, output, session) {
  #####################
  ## REACTIVE VALUES ##
  #####################

  db <- reactiveValues(
    title = "",
    description = ""
  )

  ui_control <- reactiveValues(
    action_trigger = 0,
    action_trigger__last = 0,
    action_create = 0,
    action_create__last = 0,
    action_cancel = 0,
    action_cancel__last = 0
  )

  #################
  ## UI DECISION ##
  #################

  ui_decision <- reactive({
    ## Dependencies //
    ## Trigger button:
    value <- input$action_trigger
    if (ui_control$action_trigger != value) ui_control$action_trigger <- value

    ## Create button:
    ## Dynamically created within `createDynamicUi_conditional`
    value <- input$action_create
    if (is.null(value)) {
      value <- 0
    }
    if (ui_control$action_create != value) {
      ui_control$action_create <- value
    }

    ## Cancel button:
    ## Dynamically created within `createDynamicUi_conditional`
    value <- input$action_cancel
    if (is.null(value)) {
      value <- 0
    }
    if (ui_control$action_cancel != value) {
      ui_control$action_cancel <- value
    }

    if (GLOBALS$debug$enabled) {
      message("Dependency clearance -----")
      message("action_trigger:")
      print(ui_control$action_trigger)
      print(ui_control$action_trigger__last)
      message("action_create:")
      print(ui_control$action_create)
      print(ui_control$action_create__last)
      message("action_cancel:")
      print(ui_control$action_cancel)
      print(ui_control$action_cancel__last)
    }
    ui_decision <- if (
      c (ui_control$action_trigger == 0 && ui_control$action_trigger == 0) ||
        c(
          ui_control$action_trigger > 0 &&
            ui_control$action_trigger <= ui_control$action_trigger__last &&

            ui_control$action_cancel > 0 &&
            ui_control$action_cancel > ui_control$action_cancel__last
        ) ||
        c(
          ui_control$action_create == 0 &&
            ui_control$action_create__last > 0
        )
    ) {
      "hide"
    } else if (
      ui_control$action_trigger >= ui_control$action_trigger__last &&
        ui_control$action_create == ui_control$action_create__last
    ) {
      ## Synchronize //
      ui_control$action_cancel__last <- ui_control$action_cancel
      "show"
    } else if (
      ui_control$action_create > ui_control$action_create__last
    ) {
      "create"
    } else {
      "Not implemented yet"
    }
    if (GLOBALS$debug$enabled) {
      print(ui_decision)
    }
    ## Synchronize //
    ui_control$action_trigger__last <- ui_control$action_trigger
    ui_control$action_create__last <- ui_control$action_create

    ui_decision
  })

  output$ui_conditional <- renderUI({
    createDynamicUi_conditional(input, output, ui_decision = ui_decision())
  })

  #################
  ## WRITE TO DB ##
  #################

  writeToDb <- reactive({
    ui_decision <- ui_decision()
    if (ui_decision == "create") {
      db$title <- input$title
      db$description <- input$description
    }
  })

  ###################
  ## RENDER RESULT ##
  ###################

  output$result <- renderText({
    writeToDb()
    c(
      paste0("Title: ", db$title),
      paste0("Description: ", db$description)
    )
  })
}

运行应用：

shinyApp(ui, server)

大图

这是我真正想到的应用程序：timetrackr

Source code on GitHub.

它是在没有引入上面草拟的间隙层的情况下构建的。虽然它确实提供了所需的功能，但很多时候，您需要多次单击 UI 元素，直到达到稳定的依赖状态，这真的很烦人。

Answer 1

我将从解决方案开始：

library(shiny)

ui <- fluidPage(
  actionButton("action_trigger", "Trigger 1"),
  h3("Database state"),
  textOutput("result"),
  p(),
  uiOutput("ui_conditional")
)

server <- function(input, output, session) {
  ui_control <- reactiveValues(show = FALSE)

  output$ui_conditional <- renderUI({
    if (!ui_control$show) return()

    tagList(
      textInput("title", "Title"),
      textInput("description", "Description"),
      div(style="display:inline-block",
        actionButton("action_create", "Create"),
        actionButton("action_cancel", "Cancel")
      )
    )
  })

  observeEvent(input$action_trigger, {
    ui_control$show <- TRUE
  })
  observeEvent(input$action_create, {
    writeToDb()
    ui_control$show <- FALSE
  })
  observeEvent(input$action_cancel, {
    ui_control$show <- FALSE
  })

  writeToDb <- function() {
    # ...
  }
}

shinyApp(ui, server)

我希望这足够简单以至于不言自明。如果不是，请告诉我。

您可以遵循几个原则来使您的 Shiny 反应式代码更加健壮和可维护——而且通常也更简单。

1. 每个操作按钮都应该有自己的observeEvent，并且您通常不需要在任何地方使用操作按钮值，而是将其作为observeEvent 的第一个参数。很少建议以任何其他方式使用操作按钮，即使它可能很诱人；尤其是当您将操作按钮的值与其之前的值进行比较时，这是一个非常确定的信号，表明您走错了方向。
2. 反应式表达式永远不应该有副作用——例如。写入磁盘，或分配给非局部变量（当您从反应表达式内部设置它们时，像 ui_control 这样的反应值对象算作非局部变量）。这些类型的操作应该在observe() 或observeEvent() 中完成。我将在 2016 年初对此进行详细说明。
3. 与常规函数一样，反应式表达式和观察者在理想情况下应该有一个单一的职责——一个计算或一组连贯的计算（在反应式表达式的情况下），或者一个动作或一组连贯的动作（在观察者的情况下） .如果您在想一个功能丰富且具体的名称时遇到困难，这可能表明该功能做得太多；反应式表达式也是如此（在这种情况下，ui_decision 非常模糊）。
4. 为了回应您对动态构建的 UI/输入在线时不稳定的普遍担忧，当您需要使用此类输入时，您可以使用 validate(need(input$foo, FALSE)) 保护它们的调用。你可以把它放在例如反应式表达式的开头，如果input$foo 尚不可用（即NULL、FALSE、"" 或许多其他虚假值），它将静默中止自身和任何调用者的执行。这是 Shiny 的一个非常有用的功能，我们在推广方面做得非常糟糕。我还认为我们的 API 过于笼统，使用起来不够简单，我希望尽快纠正。同时，请参阅http://shiny.rstudio.com/articles/validation.html 和/或https://www.youtube.com/watch?v=7sQ6AEDFjZ4。

Answer 2

Joe 给出的解决方案很棒（很明显，正如他写的 Shiny...），并且有很多有用的详细信息，所以我不想从中删除，但我想提供另一种方法来解决解决条件 UI 问题。

您可以使用 shinyjs 包按需显示或隐藏 UI 元素。当您确实需要一个重要的条件来显示/隐藏 UI 时，我发现这是一个更简单、更清洁的解决方案。这是代码，根据乔的回答稍作修改：

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  actionButton("action_trigger", "Trigger 1"),
  h3("Database state"),
  textOutput("result"),
  p(),
  div(
    id = "ui_control",
    textInput("title", "Title"),
    textInput("description", "Description"),
    div(style="display:inline-block",
        actionButton("action_create", "Create"),
        actionButton("action_cancel", "Cancel")
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$action_trigger, {
    show("ui_control")
  })
  observeEvent(input$action_create, {
    writeToDb()
    hide("ui_control")
  })
  observeEvent(input$action_cancel, {
    hide("ui_control")
  })

  writeToDb <- function() {
    # ...
  }
}

shinyApp(ui, server)

如您所见，这里唯一的区别是我将 UI 移回了 ui 部分，而不是使用 renderUI 创建，向要显示/隐藏的 UI 部分添加了一个带有 id 的 div , 并使用 shinyjs::show 或 shinyjs::hide 而不是反应值。

我个人觉得这更容易一些，因为它将你的 UI 保留在你的 UI 中，而不需要将它移动到服务器中，而且对我来说，只调用一个显示/隐藏函数而不是使用一个反应值更直观这将触发 HTML 的重写。

但是，由于这不完全是 Shiny 的使用方式（此解决方案绕过反应性），我很想知道 Joe 是否有任何关于使用这种方法的 cmets 与他更本机的 Shiny 方法写的。