Shiny-basic-4-Feedback

1
2
3
4
5
6
7

req() # 值若为 NULL, FALSE, "" 就不往下执行

req(input$dataset)

req(input$data1, input$data2)  #需要两个条件同时为真才行

req(input$dataset, cancelOutput = TRUE) #若中止执行，则output保持上一次有效的输出

1
2
3
4
5
6
7

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")
    }
  )
}

1
2
3
4
5
6
7
8
9

server <- function(input, output) {
  output$plot <- renderPlot({
    validate(
      need(input$in1, 'Check at least one letter!'),  ## 表达式：希望的情况
      need(input$in2 != '', 'Please choose a state.') #可以输入多个条件
    )
    plot(1:10, main = paste(c(input$in1, input$in2), collapse = ', '))
  })
}

1
2
3
4
5
6

feedback(inputId = , #输入控件id
         show = ,  #条件：不希望的情况
         text = )  #文本提醒
feedbackWarning()
feedbackDanger()
feedbackSuccess()

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17

ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),  ## 需要在UI代码里声明
  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())
}

## 虽然提醒，但仍然执行；可进一步配合req()， 中止执行

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12

# 用法1：默认出现5s，然后自动消失
server <- function(input, output, session) {
  observeEvent(input$goodnight, {
    showNotification("So long")
    Sys.sleep(1)
    showNotification("Farewell")
    Sys.sleep(1)
  })
}

# duration 参数设置持续时间
# type 参数设置ui主题   “message”, “warning”, or “error”.

1
2
3
4
5
6
7
8
9

# 用法2：直至动作（文件读取）完成，notification才会消失
server <- function(input, output, session) {
  data <- reactive({
    id <- showNotification("Reading data...", duration = NULL, closeButton = FALSE)
    on.exit(removeNotification(id), add = TRUE)  #reactive语句执行完毕时，运行remove命令
    
    read.csv(input$file$datapath)
  })
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22

# 用法3： 直至动作完成，notification才会消失，期间多个过程有不同的notification
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)
        
    mtcars
  })
  
  output$data <- renderTable(head(data()))
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

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)
        #从0开始，直至1结束。incProgress表示每次增加的值
        incProgress(1 / input$steps, details = paste0("Now: ",i)) 
      }
      runif(1)
    })
  })
  output$result <- renderText(round(data(), 2))
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

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))
}

waitress <- Waitress$new(selector = "#steps", theme = "overlay")
#theme参数除默认外可选：overlay, overlay-opacity, overlay-percent ；
#selector参数默认覆盖整个界面，如上可将进度条仅覆盖到某个input/output控件

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

library(waiter)

ui <- fluidPage(
  waiter::use_waiter(),
  actionButton("go", "go"),
  textOutput("result")
)

server <- function(input, output, session) {
  data <- eventReactive(input$go, {
    waiter <- waiter::Waiter$new()  # 覆盖整个页面
	# waiter <- waiter::Waiter$new(id = ns("result"), html = spin_pulse()) #覆盖result对应的控件
    waiter$show()
    on.exit(waiter$hide())
      
    Sys.sleep(sample(5, 1))
    runif(1)
  })
  output$result <- renderText(round(data(), 2))
}

# id类似上面的sector，不设置则会覆盖整个屏幕
# html 设置浮窗的样式 ?waiter::spinners

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16

shinyApp(
  ui = basicPage(
    actionButton("show", "Show modal dialog")
  ),
  server = function(input, output) {
    observeEvent(input$show, {
      showModal(modalDialog(
        title = "Important message",
        size = "l",
        "This is an important message!",
        ...ui...,
        footer = modalButton("Dismiss") # 退出按钮
      ))
    })
  }
)