5.7 用户反馈
用户反馈旨在提高用户的使用体验。就像下载文件有个进度条，进入某个页面有个滚动圈，这些都是在提醒用户它们在工作，而非“静止”。
5.7.1 验证
5.7.1.1 输入验证
将shinyFeedback包的useShinyFeedback()函数插入到ui中，并在server里设置相应的反馈函数来提醒用户。
useShinyFeedback()必须置于UI的顶部
仅限如下组件
shiny::dateInput()
shiny::dateRangeInput()
shiny::fileInput()
shiny::numericInput()
shiny::passwordInput()
shiny::selectInput()
shiny::sliderInput()
shiny::textAreaInput()
shiny::textInput()
shinyWidgets::airDatepickerInput()
shinyWidgets::pickerInput()较常使用的反馈函数有feedback()、feedbackWarning()、feedbackDanger()、feedbackSuccess()。它们共有的参数如下所示：
inputID：哪个输入要用到反馈，指定相应的IDshow：逻辑判断是否要发出提醒text：提醒的信息color：提醒的信息颜色icon：提醒的图标
在FontAwesome中根据需要寻找图标，找到对应的标签，如
file，最后传递给参数icon=icon("file")即可
library(shiny)
ui <- fluidPage(
shinyFeedback::useShinyFeedback(),
numericInput("n", "n", value = 10),
textOutput("half")
)
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())
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)即使输入的信息不是我们期望的，shiny也可能会正常运行。此时，我们需要req()（required）来判断输入的信息是否符合规范，当为FALSE时，反应表达式会在req()处停止，不会接着运行下面的内容。
此外，如果你需要等用户输入所有信息后再更新内容，那么req()也可承接多个条件判断，只有当这些条件都满足时才会运行下面的代码。
下面展示联合使用req()与shinyFeedback的例子。
library(shiny)
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())
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)当且仅当输入了数据集的名称且该数据集存在时，才会完整的运行这个反应表达式。其中req(exists, cancelOutput = TRUE)表示当为FALSE时，取消之后的所有输出，将结果保留在上一次符合规范的结果。
5.7.1.2 输出验证
有时将验证这一环节放在输出这更好。可用validate()来反馈信息。
library(shiny)
ui <- fluidPage(
numericInput("x", "x", value = 0),
selectInput("trans", "transformation",
choices = c("square", "log", "square-root")
),
textOutput("out")
)
server <- function(input, output, session) {
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)
)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)5.7.2 通知
有三种通知类型：1.在固定时间后自动消失的通知；2.在进程开始时显示，结束后消失的通知；3.更新式通知。
5.7.2.1 在固定时间后自动消失的通知
使用observeEvent()与showNotification()来监控行为并发出通知。
library(shiny)
ui <- fluidPage(
actionButton("goodnight", "Good night")
)
server <- function(input, output, session) {
observeEvent(input$goodnight, {
showNotification("So long", duration = 5)
Sys.sleep(1)
showNotification("Farewell", type = "message")
Sys.sleep(1)
showNotification("Auf Wiedersehen", type = "warning")
Sys.sleep(1)
showNotification("Adieu", type = "error")
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)其中duration表示通知的持续时间，type表示通知的类型，也就是颜色的不同。
5.7.2.2 进程通知
对于进程通知，需要将通知的持续时间设置为duration=NULL，关闭通知右上角的关闭按钮closeButton=FALSE，并将其放在反应表达式里，这样才符合“在进程开始时出现，结束时自动消失”的样子。
此外，需要用removeNotification(id)来移除对应ID的通知。on.exit()确保了通知不会因为代码错误而卡住不消失。
on.exit()就是在函数或代码块中预先设置了一个退出处理程序，无论函数或代码块是否正常运行，当我退出时都要执行这里的退出处理程序。而参数add=TRUE表示在现有处理程序列表中添加新的处理程序，而不是覆盖旧的处理程序。另外还有参数after，大家自行了解吧
5.7.2.3 更新式通知
在第一个例子中，我们创建了多条通知，新的通知会把就通知往上顶。而创建一个通知并多次调用它，就会覆盖前一个通知，从而实现更新式通知。
library(shiny)
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()))
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)这段代码首先创建了ID为id的通知，并为其建立了退出处理机制，在后续的通知中重复调用了同一个ID的通知，从而实现更新式通知。
5.7.3 进度条
设置进度条的技术尚未成熟，已有的方法还存在缺点（你需要将完整任务分割成多个数量已知且运行时间大致相等的小任务）。下面分别介绍shiny内置的进度条与waiter包的进度条。
显然，进度条非常适合在for循环中使用
5.7.3.1 shiny
withProgress()函数的message参数用来显示进度条的文本信息，该函数默认进度条跨度为0~1，需要用{}来包裹需要显示进度条的代码块。
incProgress()函数表示每次进度更新的增量，由于默认进度条范围为0~1，因此每次进度更新的增量就是1/input$steps。
library(shiny)
ui <- fluidPage(
numericInput("steps", "How many steps?", 10),
actionButton("go", "go"),
textOutput("result")
)
server <- function(input, output, session) {
data <- eventReactive(input$go, {
withProgress(message = "Computing random number", {
for (i in seq_len(input$steps)) {
Sys.sleep(0.5)
incProgress(1 / input$steps)
}
runif(1)
})
})
output$result <- renderText(round(data(), 2))
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)5.7.3.2 Waiter
注意Waiter包需要创建一个R6对象，所有相关操作都要调用这个对象来设置。
这里就给几个示例，其余自行探索官网。
library(shiny)
ui <- fluidPage(
waiter::use_waitress(),
numericInput("steps", "How many steps?", 10),
actionButton("go", "go"),
textOutput("result")
)
server <- function(input, output, session) {
data <- eventReactive(input$go, {
waitress <- waiter::Waitress$new(max = input$steps)
on.exit(waitress$close())
for (i in seq_len(input$steps)) {
Sys.sleep(0.5)
waitress$inc(1)
}
runif(1)
})
output$result <- renderText(round(data(), 2))
}
shinyApp(ui = ui, server = server)library(shiny)
library(waiter)
ui <- fluidPage(
autoWaiter(),
actionButton(
"trigger",
"Render"
),
plotOutput("plot"),
plotOutput("plot2")
)
server <- function(input, output){
output$plot <- renderPlot({
input$trigger
Sys.sleep(3)
plot(cars)
})
output$plot2 <- renderPlot({
input$trigger
Sys.sleep(5)
plot(runif(100))
})
}
shinyApp(ui, server)library(shiny)
ui <- fluidPage(
waiter::use_waiter(),
actionButton("go", "go"),
textOutput("result")
)
server <- function(input, output, session) {
data <- eventReactive(input$go, {
waiter <- waiter::Waiter$new()
waiter$show()
on.exit(waiter$hide())
Sys.sleep(sample(5, 1))
runif(1)
})
output$result <- renderText(round(data(), 2))
}
shinyApp(ui = ui, server = server)5.7.4 确认
为了防止用户意外做出错误的选择，需要再三确认用户的操作。
5.7.4.1 确认对话框
最简单的办法就是弹出对话框让用户再次确认自己的选择。
modalDialog()函数创建了一个对话框，根据footer参数来设置按钮选项。
library(shiny)
modal_confirm <- modalDialog(
"Are you sure you want to continue?",
title = "Deleting files",
footer = tagList(
actionButton("cancel", "Cancel"),
actionButton("ok", "Delete", class = "btn btn-danger")
)
)
ui <- fluidPage(
actionButton("delete", "Delete all files?")
)
server <- function(input, output, session) {
observeEvent(input$delete, {
showModal(modal_confirm)
})
observeEvent(input$ok, {
showNotification("Files deleted")
removeModal()
})
observeEvent(input$cancel, {
removeModal()
})
}
shinyApp(ui, server)注意需要用showModal()来展现对话框，并用remobeModal()来及时移除对话框。
5.7.4.2 取消行为
用户反悔自己的行为需要有一个过程。非常典型的例子就是在网购平台下单后，发货前都能取消订单一样。
下面只展示，不细讲。
library(shiny)
ui <- fluidPage(
textAreaInput("message",
label = NULL,
placeholder = "What's happening?",
rows = 3
),
actionButton("tweet", "Tweet")
)
runLater <- function(action, seconds = 3) {
observeEvent(
invalidateLater(seconds * 1000), action,
ignoreInit = TRUE,
once = TRUE,
ignoreNULL = FALSE,
autoDestroy = FALSE
)
}
server <- function(input, output, session) {
waiting <- NULL
last_message <- NULL
observeEvent(input$tweet, {
notification <- glue::glue("Tweeted '{input$message}'")
last_message <<- input$message
updateTextAreaInput(session, "message", value = "")
showNotification(
notification,
action = actionButton("undo", "Undo?"),
duration = NULL,
closeButton = FALSE,
id = "tweeted",
type = "warning"
)
waiting <<- runLater({
cat("Actually sending tweet...\n")
removeNotification("tweeted")
})
})
observeEvent(input$undo, {
waiting$destroy()
showNotification("Tweet retracted", id = "tweeted")
updateTextAreaInput(session, "message", value = last_message)
})
}
shinyApp(ui, server)