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

Question

真题

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

(*) 以可维护的方式，不会让您发疯；-)

详情

我读过 Build a dynamic UI that reacts to user input and like conditionalPanel(), but I have the feeling it's too "one-dimensional" for the timetracking app I would like to build (source code on GitHub).

我希望能够做的事情：

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

状态 1
那些条件 UI 部分通常有一些输入字段和至少两个操作按钮：Create 和 Cancel:

状态 2
如果单击 Create，输入应该被适当处理（例如，将内容写入数据库）然后条件 UI 部分应该再次 "disappear"作为其条件 "expired":

状态 3

状态 4
如果单击 Cancel，UI 部分应再次 "disappear" 作为其条件 "expired":

状态 4
随后点击 Trigger 应该再次 "start the cycle"

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

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

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

这就是为什么我想出引入某种 "dependency state clearance" 层的想法（参见下面的 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 ----------------------------------------------------------------------

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 响应式代码更加健壮和可维护——通常也更简单。

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

Answer 2

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

您可以使用 shinyjs 包根据需要显示或隐藏 UI 元素。当你为 showing/hiding UI 做 require 一个非平凡的条件时，我发现这是一个更简单和更清晰的解决方案。这是代码，根据 Joe 的回答稍作修改：

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 创建，添加了 div 与您想要 show/hide 的 UI 部分的 id，并使用 shinyjs::show 或 shinyjs::hide 而不是反应值。

我个人觉得这更容易一些，因为它将您的 UI 保留在您的 UI 中而不需要将其移动到服务器中，而且它也更直观 ui对我来说只是调用一个 show/hide 函数而不是使用一个会触发 HTML.

重写的反应值

但是，由于这并不是 Shiny 的确切使用方式（此解决方案绕过了反应性），我很想知道 Joe 是否对使用这种方法与更原生的 Shiny 方法有任何评论他写的。

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

Conditional shiny UI when multiple conditions need to be handled

javascript

user-interface

conditional

r

shiny

真题

详情

当前解决方案

大图