如何避免输出在 UI 中更改位置后闪烁？

Question

我目前正在阅读有关点击行为的书《掌握闪亮》第 7 章。 我不明白为什么在UI中更改

tableOutput()

的位置后会导致输出出现闪出效果。

共享组件：

library(shiny)
library(bslib)

server <- function(input, output, session) {
  
  output$plot <- renderPlot({
    plot(mtcars$wt, mtcars$mpg)
  }, res = 96)
  
  output$info <- renderPrint({
    req(input$plot_click)
    x <- round(input$plot_click$x, digits = 2)
    y <- round(input$plot_click$y, digits = 2)
    cat("[", x, ", ", y, " ]", sep = "")
  })
  
  output$data <- renderTable({
    nearPoints(mtcars, coordinfo = input$plot_click, xvar = "wt", yvar = "mpg")
  })
  
}

shinyApp(ui, server)

此 UI 可以工作，但输出被压缩。我想把它放在主图下方：

ui <- page_sidebar(
  
  sidebar = sidebar(
    title = "Global controls",
    
    varSelectInput(inputId = "x", label = "X:", data = df),
    
    varSelectInput(inputId = "y", label = "Y:", data = df)
  ),
  
  card(
    full_screen = TRUE,
    layout_sidebar(
      sidebar = sidebar(
        title = "Coordinate of where you click:",
        position = "left",
        
        verbatimTextOutput(outputId = "info"),

        ########### the position of this line #################
        tableOutput(outputId = "data")
        #######################################################
      ),
      
      plotOutput(outputId = "plot", click = "plot_click")
    )
  )
)

此 UI 无法正常工作，因为输出在快速闪烁后消失。另外，另一个输出

verbatimTextOutput()

也消失了：

ui <- page_sidebar(
  
  sidebar = sidebar(
    title = "Global controls",
    
    varSelectInput(inputId = "x", label = "X:", data = df),
    
    varSelectInput(inputId = "y", label = "Y:", data = df)
  ),
  
  card(
    full_screen = TRUE,
    layout_sidebar(
      sidebar = sidebar(
        title = "Coordinate of where you click:",
        position = "left",
        
        verbatimTextOutput(outputId = "info")
      ),
      
      plotOutput(outputId = "plot", click = "plot_click"),

      ########### the position of this line #################
      tableOutput(outputId = "data")
      #######################################################

    )
  )
)

请解释导致此行为的原因，以及如何纠正它。

Answer 1

nearPoints

表将填充到

plotOutput

下方。这会导致绘图调整大小并重新渲染。但是，这会将

input$plot_click

设置为

NULL

，因此输出立即消失。您需要的是

cancelOutput = TRUE

中的

req()

，用于所有相关的

render

调用。来自

?req

：

cancelOutput：如果为 TRUE 并且正在评估输出，则停止 像往常一样处理，但不是清除输出，而是将其保留在 无论它处于什么状态。

library(shiny)
library(bslib)

ui <- page_sidebar(
  
  sidebar = sidebar(
    title = "Global controls",
    
    varSelectInput(inputId = "x", label = "X:", data = df),
    
    varSelectInput(inputId = "y", label = "Y:", data = df)
  ),
  
  card(
    full_screen = TRUE,
    layout_sidebar(
      sidebar = sidebar(
        title = "Coordinate of where you click:",
        position = "left",
        
        verbatimTextOutput(outputId = "info")
      ),
      
      plotOutput(outputId = "plot", click = "plot_click"),
      
      ########### the position of this line #################
      tableOutput(outputId = "data")
      #######################################################
      
    )
  )
)


server <- function(input, output, session) {
  
  output$plot <- renderPlot({
    plot(mtcars$wt, mtcars$mpg)
  }, res = 96)
  
  output$info <- renderPrint({
    req(input$plot_click, cancelOutput = TRUE)
    x <- round(input$plot_click$x, digits = 2)
    y <- round(input$plot_click$y, digits = 2)
    cat("[", x, ", ", y, " ]", sep = "")
  })
  
  output$data <- renderTable({
    req(input$plot_click, cancelOutput = TRUE)
    nearPoints(mtcars, coordinfo = input$plot_click, xvar = "wt", yvar = "mpg")
  })
  
}

shinyApp(ui, server)