rshinybslib

How to avoid that the output flashes out after changing its position in the UI?

I am currently reading about the clicking behaviour, chapter 7 of the book Mastering Shiny.

I don't understand why after changing the location of tableOutput() in UI will cause a flash out effect on the outputs.

The shared component:

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)

This UI works, but the output is squashed. I'd like to place it below the main plot:

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

enter image description here

This UI doesn't work properly, as the output disappears after a quick flash. In addition, the other output verbatimTextOutput() also disappeared:

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

    )
  )
)

enter image description here

Please explain what caused this behaviour, and how I can correct it.

Solution

  • If you click on the plot, then the nearPoints table is filled below the plotOutput. This causes the plot to resize and re-render. However, this sets input$plot_click to NULL and therefore the output immediately disappears.

    What you need here is cancelOutput = TRUE in req() for all relevant render calls. From ?req:

    cancelOutput: If TRUE and an output is being evaluated, stop processing as usual but instead of clearing the output, leave it in whatever state it happens to be in.

    enter image description here

    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)