Shiny学习笔记:用户反馈

为了使Shinyapp的可用性得到提高，我们需要给用户提供反馈，比如用户输入时消息提醒，运行操作时间过长时提供进度显示等。Shiny自身就提供了多种用户反馈机制，还有一些十分优秀的扩展包也提供了一些方法。

Validation

第一个也是最重要中的一个反馈是当用户输入错误的时候，app可以发送提示信息给用户。这个就跟我们平时写R函数一样，参数错误的话会提供message给用户。由于Shinyapp只提供用户UI，所以如果不提供反馈信息的话用户不知道是否运行正常。

Validating input

如果我们需要给用户提供额外反馈的话， shinyFeedback是一个很好的选择。shinyFeedback使用非常简单，在ui中添加useShinyFeedback()即可：

ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),
  numericInput("n", "n", value = 10),
  textOutput("half")
)

shinyFeedback提供了四种反馈函数：

• feedback()
• feedbackWarning()
• feedbackDanger()
• feedbackSucess()

它们都有三个主要参数：

• inputId：指定feedback显示的输入ID位置
• show：逻辑值，用来判断显示反馈信息
• text：反馈信息

比如我们可以提供反馈信息给用户，提示用户输入偶数，不要输入奇数：

server <- function(input, output, session) {
  observeEvent(input$n,
    shinyFeedback::feedbackWarning(
      "n", 
      input$n %% 2 != 0,
      "Please select an even number"
    )  
  )
  output$half <- renderText(input$n / 2)
}

这些feedback函数还提供了color和icon参数用户修改反馈信息的颜色图案等，具体用户可以阅读文档 shinyFeedback。

我们可以看到，上面的app即使在用户输入奇数的时候仍然打印结果，我们可以通过req()函数来避免这种情况发生：

server <- function(input, output, session) {
  half <- reactive({
    even <- input$n %% 2 == 0
    shinyFeedback::feedbackWarning("n", !even, "Please select an even number")
    req(even)
    input$n / 2    
  })
  
  output$half <- renderText(half())
}

如果req()函数的输入不是TRUE的话，它就会发送一个特别的信号给shiny，告诉shiny reactive没有它需要的输入，进而中止执行，因此所有基于它的reactive consumers都将不会更新。

req()中止执行

一个Shinyapp一旦启动的话，用户无需做任何事情，整个程序实际上已经运行了一遍，由于我们一般会设置好默认输入，所以程序运行正常，但是一旦我们没有设置默认输入，Shiny的这种机制就会带来一些问题，很多时候，我们是想在用户下达指令之后运行Shinyapp，这主要涉及到三个输入函数：

• textInput()：不设置默认输入，value = ""，Shinyapp不做任何事，直到用户输入

• selectInput()：提供了空选项""，只有用户选择了选项，程序才运行

• fileInput()：用户上传文件之前，这个是空的。我们也可以设置默认文件，这个我会在后面的我的一个Shinyapp中用到，到时讲解一下

如果没有设置默认输入，这个时候我们就需要一个机制来中止这种reactive，直到用户输入。这就是req()的作用，检查输入是否符合要求，允许下一步的reactive继续。

下面通过一个小例子讲解一下：

ui <- fluidPage(
  selectInput("language", "Language", choices = c("", "English", "Maori")),
  textInput("name", "Name"),
  textOutput("greeting")
)

server <- function(input, output, session) {
  greetings <- c(
    English = "Hello", 
    Maori = "Ki ora"
  )
  output$greeting <- renderText({
    paste0(greetings[[input$language]], " ", input$name, "!")
  })
}

这个Shinyapp启动的时候时会报错的，因为selectInput()我们提供了一个空选项""，而且我们也没有设置selected，该输入就默认选择的就是第一个选项""：

我们可以通过req()来修正这个问题：

server <- function(input, output, session) {
  greetings <- c(
    English = "Hello", 
    Maori = "Ki ora"
  )
  output$greeting <- renderText({
    req(input$language, input$name)
    paste0(greetings[[input$language]], " ", input$name, "!")
  })
}

req()和确认

req()可以与shinyFeedback结合一起使用，下面这个app允许用户输入一个数据集，程序将判断该数据集是否是包datasets内置的，不是的话中止运行并打印message，req()函数用到了cancelOutput = TRUE，主要是因为req()默认是中止下游所有输出，cancelOutput = TRUE则可以保留最后一个正确的输入值，这一点很重要，输入中途很容易触发update。

ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),
  textInput("dataset", "Dataset name"), 
  tableOutput("data")
)

server <- function(input, output, session) {
  data <- reactive({
    req(input$dataset)
    
    exists <- exists(input$dataset, "package:datasets")
    shinyFeedback::feedbackDanger("dataset", !exists, "Unknown dataset")
    req(exists, cancelOutput = TRUE)

    get(input$dataset, "package:datasets")
  })
  
  output$data <- renderTable({
    head(data())
  })
}

Validate output

shinyFeedback在处理单个输入的时候很好用，当时一旦遇到需要处理多个输入一起反馈的时候就不好用了，你不好判断该message放到哪个输入合适，此时更适合的是将message打印到output中。validate()此时就很适合使用。当在reactive或者output中使用validate()的时候，validate(message)会终止剩余的所有程序，并将message打印到任何一个output中。下面的app不允许用户给log和square-root输入负值：

ui <- fluidPage(
  numericInput("x", "x", value = 0),
  selectInput("trans", "transformation", choices = c("square", "log", "square-root")),
  textOutput("out")
)

server <- function(input, output, server) {
  output$out <- renderText({
    if (input$x < 0 && input$trans %in% c("log", "square-root")) {
      validate("x can not be negative for this transformation")
    }
    
    switch(input$trans,
      square = input$x ^ 2,
      "square-root" = sqrt(input$x),
      log = log(input$x)
    )
  })
}

Notifications

有时Shinyapp没啥问题，只是想提示用户message，此时可以用notification。notifications由shoeNotification()创建，展现在app的右下角。shoeNotification()有三种基本使用方法：

• Transient notification：短暂提醒，自动消失
• Removing on completion：提示某一程序正在运行，运行结束自动移除
• Progressive updates：随着不同程序运行，提示信息不断更新

Transient notification

showNotification()最简单的用法就是直接提供需要展示的message就行：

ui <- fluidPage(
  actionButton("goodnight", "Good night")
)
server <- function(input, output, session) {
  observeEvent(input$goodnight, {
    showNotification("So long")
    Sys.sleep(1)
    showNotification("Farewell")
    Sys.sleep(1)
    showNotification("Auf Wiedersehen")
    Sys.sleep(1)
    showNotification("Adieu")
  })
}

默认情况下，message会在5秒后自动消失，可以通过参数duration修改，也可以点击关闭按钮让message消失，还有一个参数type可以展示不同类型的message。

server <- function(input, output, session) {
  observeEvent(input$goodnight, {
    showNotification("So long")
    Sys.sleep(1)
    showNotification("Farewell", type = "message")
    Sys.sleep(1)
    showNotification("Auf Wiedersehen", type = "warning")
    Sys.sleep(1)
    showNotification("Adieu", type = "error")
  })
}

Removing on completion

Transient actions会在固定的时间后消失，但是很多时候我们需要运行一些长时间的任务，此时我们希望在任务运行期间message一直显示，直到运行结束：

• 设置duration = NULL以及closeButton = FALSE
• 储存showNotification()返回的id,并将之传递给removeNotification()。最可靠的实现方式是on.exit()，这样不管任务正常运行结束还是中途出错提前中止，notification都会被移除

比如我们需要上传一个大的csv文件，展示提醒信息：

server <- function(input, output, session) {
  data <- reactive({
    id <- showNotification("Reading data...", duration = NULL, closeButton = FALSE)
    on.exit(removeNotification(id), add = TRUE)
    
    read.csv(input$file$datapath)
  })
}

一般这类通知信息都是在reactive中运行的，可以保证一些大的长时间的任务只有在必需时运行，提高效率

Progressive updates

可以通过捕获id来更新notification，如果一个长时间的任务由很多部分组成，那么这个就很好用了：

ui <- fluidPage(
  tableOutput("data")
)

server <- function(input, output, session) {
  notify <- function(msg, id = NULL) {
    showNotification(msg, id = id, duration = NULL, closeButton = FALSE)
  }

  data <- reactive({ 
    id <- notify("Reading data...")
    on.exit(removeNotification(id), add = TRUE)
    Sys.sleep(1)
      
    notify("Reticulating splines...", id = id)
    Sys.sleep(1)
    
    notify("Herding llamas...", id = id)
    Sys.sleep(1)

    notify("Orthogonalizing matrices...", id = id)
    Sys.sleep(1)
        
    mtcars
  })
  
  output$data <- renderTable(head(data()))
}

参考：https://mastering-shiny.org/action-feedback.html