闪亮-功能完成后不会呈现元素

Shiny - elements are not being rendered once function is complete

我正在动态创建要插入到 fluidRow 中的元素,我面临的问题是所有元素都被同时渲染。因此,它们不会在 renderUI 函数结束时渲染每个元素,而是一直等待直到最后一个 renderUI 完成。因此,my_dataset 中有很多元素会使渲染非常慢。

我预计一旦 print(str_glue('End: {i}')) 显示,该元素就会被渲染。然而,情况并非如此,它一直在等待所有元素(包括那些在屏幕上不可见的元素)。

我尝试使用 outputOptions(..., suspendWhenHidden = TRUE) 但它没有任何区别(正如预期的那样,因为这是默认设置)。

MWE

library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
library(shinycssloaders)

qtd <- 500

my_dataset <- data.frame(
  stringsAsFactors = F,
  Name = rep('Sample', qtd),
  Value = runif(qtd)
)

ui <- function() {
  fluidPage(
    fluidRow(
      column(12, textInput(inputId = 'my_text_input', label = NULL, placeholder = 'Search', width = '100%')),
      uiOutput('custom_ui')
    )
  )
}

server <- function(input, output, session) {
  output[['custom_ui']] <- renderUI({
    filtered_dataset <- my_dataset %>%
      filter(grepl(input[['my_text_input']], Name, ignore.case = T)) %>%
      arrange(Name)
    
    map(1:nrow(filtered_dataset), function(i) {
      item <- filtered_dataset[i,]
      custom_id <- str_glue('custom_id_{i}')
      output[[custom_id]] <- renderUI({
        print(str_glue('Start: {i}'))
        print(item)
        result <- box(
          width = 3,
          title = item$Name,
          item$Value
        )
        print(str_glue('End: {i}'))
        result
      })
      
      column(width = 3, uiOutput(custom_id, style = 'height: 350px;') %>% withSpinner(type = 6))
    })
  })
}


runApp(shinyApp(ui = ui, server = server), launch.browser = T)

您所描述的是预期的行为。在所有计算完成之前,服务器不会 return 向 UI 发送任何内容。

我看到你非常依赖 renderUI。这往往会使 Shiny 应用变慢。当应用程序启动时,它必须加载,意识到它缺少 UI 的一部分,请求服务器创建 UI - 然后服务器将为您的所有创建 HTML框并在显示任何内容之前将它们发送到 UI。您应该尽量保持 UI 静态。

根据您想要实现的目标,可能有很多不同的方法可以在没有 renderUI 的情况下实现。

下面是一个示例,其中框的 HTML 是在 renderUI 之外创建的。这将起作用,只要您不需要框中的输入控件或输出 - 因为那样它们需要自己的 ID。


library(shiny)
library(shinydashboard)
library(dplyr)
library(purrr)

qtd <- 500

my_dataset <- data.frame(
  stringsAsFactors = FALSE,
  Name = rep('Sample', qtd),
  Value = runif(qtd)
) %>%
  mutate(
    x = map2(
      Name,
      Value,
      ~column(
        width = 3,
        box(
          width = 3,
          title = .x,
          .y
        )
      )
    )
  )


ui <- function() {
  fluidPage(
    fluidRow(
      column(
        12,
        textInput(
          inputId = 'my_text_input',
          label = NULL,
          placeholder = 'Search',
          width = '100%'
        )
      ),
      uiOutput('custom_ui')
    )
  )
}

server <- function(input, output, session) {

  # Only the filtering of the data is done inside `renderUI`
  output[['custom_ui']] <- renderUI({

    filtered_dataset <-
      my_dataset %>%
      filter(grepl(input[['my_text_input']], Name, ignore.case = TRUE)) %>%
      arrange(Name) %>%
      pull(x)

  })

}


runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)


Last I just want to recommend this book by Hadley Wickham. I think reading this (or parts of this) book before working with Shiny will make everything easier for you.