带有条件 plotOut 的闪亮仪表板

Question

I am just starting with shiny and dashboard, so any help is greatly appreciated!

I have a shinydashboard app displaying one row with two elements: A tabBox on the left with two tabPanel s, and a box on the right (to display a plot).

What I want is to display a particular plot in the box depending on the active tabPanel . The plot should be not clickable when the first tab is active, but clickable when the second tab is active.

My problem is that I only know how to set up the clickable property in the ui through the plotOutput function using the option click = "plot_click" . But this sets both plots as clickable. Of course, removing the option click = "plot_click" sets both plots as not-clickable. How can I make the clickable property depend on the active tab?

What I tried: Place an if statement inside box() such that, depending on the id of the tabPanel , it would activate the option click = "plot_click" for the correct plot. I failed at this.

Here's the code. You can play with either plot by (un)commenting the desired plot inside box() .

library(shiny)
library(shinydashboard)
library(ggplot2)

ui <- dashboardPage(

  dashboardHeader(title = "Conditional plotOutput click", titleWidth = 450),

  dashboardSidebar(disable = TRUE), 

  dashboardBody(

    fluidRow(
      tabBox(title = "Choose tab", id = "choose.tab", height = 250, selected = "Automatic", 
             tabPanel(title = "Automatic", id = "auto", sliderInput("slider", "Nobs:", 1, 10, 5)), 
             tabPanel(title = "Manual", id = "man")
      ), 

      box(title = "Plot", solidHeader = TRUE, 
          # plotOutput("plot1", height = 250)                     # Try me!
          plotOutput("plot2", height = 250, click = "plot_click") # Or me!
      )
    )
  )
)

server <- function(input, output) {
  set.seed(123)

  react.vals <- reactiveValues( 
    df     = data.frame(x = numeric(), y = numeric()), 
    plot1  = ggplot(), 
    plot2  = ggplot()
  )

  # Plot 1 - Automatic scatterplot:
  observe({
    scatter.data     <- data.frame(x = runif(input$slider), y = runif(input$slider))
    react.vals$plot1 <- ggplot(scatter.data, aes(x, y)) + geom_point(color = "red", size = 4) + 
      scale_x_continuous("x", breaks = seq(0, 1, .2), limits = c(0, 1), expand = c(0,0)) +
      scale_y_continuous("y", breaks = seq(0, 1, .2), limits = c(0, 1), expand = c(0,0)) + 
      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
  })
  observeEvent(react.vals$plot1, { 
    output$plot1 <- renderPlot({ react.vals$plot1 })
  })

  # Plot 2 - Manual scatterplot through clicking:
  observeEvent(input$plot_click, {
    new.point     <- data.frame(x = input$plot_click$x,
                                y = input$plot_click$y)
    react.vals$df <- rbind(react.vals$df, new.point)
  })
  observe({
    react.vals$plot2 <- ggplot(react.vals$df, aes(x = x, y = y)) + geom_point(color = "red", size = 4) + 
      scale_x_continuous("x", breaks = seq(0, 1, .2), limits = c(0, 1), expand = c(0,0)) +
      scale_y_continuous("y", breaks = seq(0, 1, .2), limits = c(0, 1), expand = c(0,0)) + 
      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
  })
  observeEvent(react.vals$plot2, { 
    output$plot2 <- renderPlot({ react.vals$plot2 })
  })
}

shinyApp(ui, server)

Thanks in advance, jorge

Answer 1

You can use uiOutput to define the characteristics of plotOutput according to the active tabPanel . Below is your example adapted with uiOutput :

library(shiny)
library(shinydashboard)
library(ggplot2)

ui <- dashboardPage(

  dashboardHeader(title = "Conditional plotOutput click", titleWidth = 450),

  dashboardSidebar(disable = TRUE), 

  dashboardBody(

    fluidRow(
      tabBox(title = "Choose tab", id = "choose_tab", height = 250, selected = "Automatic", 
             tabPanel(title = "Automatic", id = "auto", sliderInput("slider", "Nobs:", 1, 10, 5)), 
             tabPanel(title = "Manual", id = "man")
      ), 

      box(title = "Plot", solidHeader = TRUE, 
          uiOutput("test")
      )
    )
  )
)

server <- function(input, output) {
  set.seed(123)

  react.vals <- reactiveValues( 
    df     = data.frame(x = numeric(), y = numeric()), 
    plot1  = ggplot(), 
    plot2  = ggplot()
  )

  observe({
    if (input$choose_tab == "Automatic") {
      output$test <- renderUI({
        plotOutput("plot1", height = 250)
      })
    }
    else if(input$choose_tab == "Manual") {
      output$test <- renderUI({
        plotOutput("plot2", height = 250, click = "plot_click")
      })
    }
  })

  # Plot 1 - Automatic scatterplot:
  observe({
    scatter.data     <- data.frame(x = runif(input$slider), y = runif(input$slider))
    react.vals$plot1 <- ggplot(scatter.data, aes(x, y)) + geom_point(color = "red", size = 4) + 
      scale_x_continuous("x", breaks = seq(0, 1, .2), limits = c(0, 1), expand = c(0,0)) +
      scale_y_continuous("y", breaks = seq(0, 1, .2), limits = c(0, 1), expand = c(0,0)) + 
      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
  })
  observeEvent(react.vals$plot1, { 
    output$plot1 <- renderPlot({ react.vals$plot1 })
  })

  # Plot 2 - Manual scatterplot through clicking:
  observeEvent(input$plot_click, {
    new.point     <- data.frame(x = input$plot_click$x,
                                y = input$plot_click$y)
    react.vals$df <- rbind(react.vals$df, new.point)
  })
  observe({
    react.vals$plot2 <- ggplot(react.vals$df, aes(x = x, y = y)) + geom_point(color = "red", size = 4) + 
      scale_x_continuous("x", breaks = seq(0, 1, .2), limits = c(0, 1), expand = c(0,0)) +
      scale_y_continuous("y", breaks = seq(0, 1, .2), limits = c(0, 1), expand = c(0,0)) + 
      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
  })
  observeEvent(react.vals$plot2, { 
    output$plot2 <- renderPlot({ react.vals$plot2 })
  })
}

shinyApp(ui, server)

Edit: Fixed a small typo in the R code.

Answer 2

Thanks, bretauv , this solves it!

I still needed to add two final changes to the code to have exactly what I wanted:

• Remove the plotOutput() inside box (not needed anymore).
• Change plot2 to plot1 inside the first renderUI() call.

Perhaps you want to edit your answer using these tips for future reference.

Thanks a lot! I've upvoted this answer.