Question

实际问题

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

（*）以可维护的方式不会让你发疯; - ）

详细

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

我希望能做什么：

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

州1
这些条件用户界面部分通常包含一些输入字段和至少两个操作按钮：Create和Cancel：

州2
如果单击Create，则应正确处理输入（例如，将内容写入数据库），然后条件UI部分应在其条件“已过期”时再次“消失”：

状态3

州4
如果单击Cancel，则UI部分应在其条件“已过期”时再次“消失”：

州4
随后点击Trigger应该“再次”开始“

多个依赖项和动态依赖关系状态的问题：

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

从用户体验的角度来看，这就像多次点击元素一样，直到你得到你想要的东西（在我的timetracking app中查看这个“需要多次点击”行为的例子）。 / p>

这就是为什么我提出引入一种“依赖状态清除”层的想法（参见下面的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 /输入上线时的不稳定性的一般关注，当您需要使用此类输入时，您可以使用validate(need(input$foo, FALSE))来保护其调用。你可以把它放在例如反应式表达式的开头，如果input$foo尚未可用（即NULL，FALSE，""或者/** * @ORM\OneToMany(targetEntity="Image", mappedBy="gallery") */ private $images; public function __construct() { $this->images = new \Doctrine\Common\Collections\ArrayCollection(); }，它会默默地中止自身和任何来电者的执行许多其他的虚假价值观）。这是Shiny的一个非常有用的功能，我们做了一个非常糟糕的推广工作。我还认为我们使API过于笼统而且不易使用，我希望尽快纠正。在此期间，请参阅http://shiny.rstudio.com/articles/validation.html和/或https://www.youtube.com/watch?v=7sQ6AEDFjZ4。

Answer 2

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

您可以使用shinyjs包来按需显示或隐藏UI元素。当你需要显示/隐藏UI的非平凡条件时，我发现这是一个更简单，更简洁的解决方案。这是代码，稍微修改了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，其ID为您要显示的UI部分/ hide，并使用shinyjs::show或shinyjs::hide代替无效值。

我个人认为这更容易一些，因为它将你的UI保存在用户界面而不需要将其移动到服务器中，而且我更直观地调用显示/隐藏功能而不是使用被动值这将触发重写HTML。

然而，由于这并不完全符合Shiny的使用方式（此解决方案绕过反应性），我有兴趣知道Joe是否对使用此方法与更多本地方法有任何意见他写的闪亮的方法。

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

实际问题

详细

当前解决方案

大图

2 个答案: