如何在Shiny的renderPrint()输出中完整显示waiter加载动画？

基础错误修正 #

你的代码存在两个核心逻辑错误，需要先修正：

• UI中textOutput("text")需替换为verbatimTextOutput("text")——renderPrint()对应的输出控件是verbatimTextOutput，textOutput仅适配renderText()。
• Server中不能在renderPrint()内部嵌套observeEvent，这会导致响应式逻辑混乱，应将事件监听移至顶层，用响应式对象处理计算逻辑。

解决输出区域过窄的三种方案 #

方案1：给输出控件添加CSS样式扩大显示区域 #

通过自定义CSS强制设置verbatimTextOutput的宽度和最小高度，为waiter动画预留足够空间：

library(shiny)
library(shinydashboard)
library(waiter)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    waiter::use_waiter(),
    # 添加CSS调整输出区域尺寸
    tags$style(
      "#text {
        width: 100%;
        min-height: 150px;
        padding: 10px;
        border: 1px solid #eee;
      }"
    ),
    fluidRow(
      column(width = 4,
             sliderInput("slider", "Number of observations:", 1, 100, 50),
             actionButton("go", "go", class = "btn-warning")
      ),
      column(width = 8,
             verbatimTextOutput("text") # 替换为正确的输出控件
      )
    )
  )
)

server <- function(input, output) {
  # 用eventReactive处理点击触发的计算逻辑
  result <- eventReactive(input$go, {
    w <- waiter::Waiter$new(id = "text")
    w$show()
    Sys.sleep(3) 
    on.exit(w$hide())
    paste0(input$slider, " selected.")
  })
  
  # 渲染最终输出
  output$text <- renderPrint({
    req(result()) # 等待计算完成后再渲染
    cat(result())
  })
}

shinyApp(ui, server)

方案2：让waiter动画覆盖整个列区域 #

给右侧列添加ID，让waiter以整个列为目标，动画会占据列的全部空间：

library(shiny)
library(shinydashboard)
library(waiter)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    waiter::use_waiter(),
    fluidRow(
      column(width = 4,
             sliderInput("slider", "Number of observations:", 1, 100, 50),
             actionButton("go", "go", class = "btn-warning")
      ),
      # 给列添加ID，作为waiter的目标
      column(width = 8, id = "output_column",
             verbatimTextOutput("text")
      )
    )
  )
)

server <- function(input, output) {
  result <- eventReactive(input$go, {
    # 将waiter目标设为整个列的ID
    w <- waiter::Waiter$new(id = "output_column")
    w$show()
    Sys.sleep(3) 
    on.exit(w$hide())
    paste0(input$slider, " selected.")
  })
  
  output$text <- renderPrint({
    req(result())
    cat(result())
  })
}

shinyApp(ui, server)

方案3：自定义waiter动画的尺寸 #

通过html参数自定义动画元素的大小，使其适配窄区域：

library(shiny)
library(shinydashboard)
library(waiter)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    waiter::use_waiter(),
    fluidRow(
      column(width = 4,
             sliderInput("slider", "Number of observations:", 1, 100, 50),
             actionButton("go", "go", class = "btn-warning")
      ),
      column(width = 8,
             verbatimTextOutput("text")
      )
    )
  )
)

server <- function(input, output) {
  result <- eventReactive(input$go, {
    # 自定义动画的尺寸和样式
    custom_spinner <- tagList(
      tags$div(style = "width: 80px; height: 80px; margin: 0 auto;",
               waiter::spin_ring()) # 可替换为其他waiter动画样式
    )
    w <- waiter::Waiter$new(id = "text", html = custom_spinner)
    w$show()
    Sys.sleep(3) 
    on.exit(w$hide())
    paste0(input$slider, " selected.")
  })
  
  output$text <- renderPrint({
    req(result())
    cat(result())
  })
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Wang