时间戳

首页 > 解决方案 > 在背景中的反应值变化上绘制 ggplot，在非焦点选项卡上

r - 在背景中的反应值变化上绘制 ggplot，在非焦点选项卡上

问题描述

客观的

通过减少等待时间来增加用户体验的流动性。

问题

我正在构建一个数据探索仪表板。有两个选项卡：1）（默认选项卡）显示数据表的选项卡，以及 2）显示 ggplots 的选项卡。用户可以通过从侧边栏中选择选项来探索数据（例如，选择要显示的点数）。该表会在更改时进行反应性更新，但另一个选项卡上的 ggplot 不会 - 直到选择该选项卡，然后才会绘制 ggplot。

这很烦人，因为已经指定了数据，但是直到人们单击绘图选项卡才开始处理……因此在大型数据集上浪费了时间。

我试过的

我尝试查看 SO 和 google 以获取有关此问题的提示，但我一定无法正确搜索，因为这似乎是一个简单的问题。我已经考虑过实现一个功能，在指定一个值以强制绘制之后切换到每个非焦点选项卡一秒钟，但对于这样一个小问题，这是 UX 不友好且令人难以置信的 hacky。

MCVE

# Load libraries
library(shiny)
library(shinydashboard)
library(DT)
library(ggplot2)
library(ggthemes)

# Set seed to arbitrary value for reproducibility
set.seed(1)

# Create random dataset of 100K points
test.df <- data.frame(a = 1:100000, b = rnorm(n = 100000, mean= 2, sd=1))

# Create ui
ui <- dashboardPage(dashboardHeader(),
                    dashboardSidebar(
                      sidebarMenu(
                        id = "tabs",
                        # Tab to show table
                        menuItem("Tab 1", tabName = "item1"),
                        # Tab to show plot
                        menuItem("Tab 1", tabName = "item2"),
                        numericInput("numeric", "Length of data", value = 1)
                    )),
                    dashboardBody(
                      tabItems(
                        tabItem("item1", dataTableOutput("table")),
                        tabItem("item2", plotOutput("plot"))
                      )
                    )
                  )

server <- function(input, output) {

  # Get first n rows
  test.df.sample <- reactive({
    head(test.df, n=input$numeric)
  })

  # Render table
  output$table <- DT::renderDataTable({
    datatable(test.df.sample())
  })

  # Render ggplot
  output$plot <-  renderPlot({
    ggplot(test.df.sample()) +
      geom_point(aes(x=a, y=b)) +
      theme_tufte()
  })
}

shinyApp(ui = ui, server = server)

进度更新

更新 1 - 发布日期 + 2

在时间的压力下，我决定实现一个 hacky 方法，即调用 updateTabItems() 以在选项卡之间即时切换。此方法有效，因为它触发了更新每个 tabItem 内容但会留下不希望的视觉效果（例如，我正在使用 googleway 绘制地图，但它会缩小到最大级别，因此您会看到世界地图重复 4 次的条带，如果它在这个 hacky 方法中得到更新）

标签： rggplot2shinyshinydashboard

解决方案

我认为您可以使用 中的选项suspendWhenHidden来outputOptions获得您正在寻找的行为。但是，这本身是不够的，因为要使其正常工作，用户必须通过转到第二个选项卡来初始化绘图一次。我们可以通过将绘图的高度和宽度设置为非零值来解决此问题，请参见此处。

请注意，现在表格仅在表格和绘图都完成渲染后才渲染，因此需要更长的时间。因此，用户必须等待 60 秒一次，而不是 6 次等待 10 秒。新行为的好处是，至少用户可以得到一杯咖啡，并且知道当他回来时一切都准备好了。我希望这是你想要的行为。如果您的目标是按顺序渲染所有内容-恐怕我不确定 Shiny 是否可行...

下面给出了一个工作示例，希望对您有所帮助！

# Load libraries
library(shiny)
library(shinydashboard)
library(DT)
library(ggplot2)
library(ggthemes)

# Set seed to arbitrary value for reproducibility
set.seed(1)

# Create random dataset of 100K points
test.df <- data.frame(a = 1:100000, b = rnorm(n = 100000, mean= 2, sd=1))

# Create ui
ui <- dashboardPage(dashboardHeader(),
                    dashboardSidebar(
                      sidebarMenu(
                        id = "tabs",
                        # Tab to show table
                        menuItem("Tab 1", tabName = "item1"),
                        # Tab to show plot
                        menuItem("Tab 1", tabName = "item2"),
                        numericInput("numeric", "Length of data", value = 1)
                      )),
                    dashboardBody(
                      tabItems(
                        tabItem("item1", dataTableOutput("table")),
                        tabItem("item2", plotOutput("plot"))
                      )
                    )
)

server <- function(input, output) {

  # Get first n rows
  test.df.sample <- reactive({
    head(test.df, n=input$numeric)
  })

  # Render table
  output$table <- DT::renderDataTable({
    datatable(test.df.sample())
  })

  # Render ggplot
  output$plot <-  renderPlot({
    ggplot(test.df.sample()) +
      geom_point(aes(x=a, y=b))
    }, height = 450, width = 800)
  outputOptions(output, "plot", suspendWhenHidden = FALSE)
}

shinyApp(ui = ui, server = server)

推荐阅读