R shiny - 复选框和操作按钮组合问题

Question

I have 2 checkboxes and 1 action button. When clicking on either of the checkboxes, a graph should output BUT only after clicking on the action button. The code I have bellow does this well already. My issue here is that once the action button has been clicked and the graph generated, unclicking the checkbox removes the graph. Similarly, clicking again generates a new graph without clicking on the action button. I would like for the graph to stay on the screen for as long as I dont click on the action button again. I imagine this has to do with "isolating" the checkboxes but Im not too sure how to do so.

As a side note, imagine there was a third function generating a plot in my server when clicking on the action button (regardless of the checkboxes). Is there a way to code my "showmodal, removemodal" such that the pop up stays while all functions are running (instead of only during the first function)?

Here is my code

library(shiny)

#Function 1
X <- function(a,b,c){
    plot(c(a,b),c(b,c))
}

#Function 2
Y <- function(d,e,f){
    plot(c(d,e),c(e,f))
}

ui <- fluidPage(
    
    titlePanel("title"),
    
    sidebarLayout(
        sidebarPanel(
            checkboxInput("EF", "Efficient Frontier"),
            checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
            actionButton("Go", "Go", style="color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
        ),
        
        mainPanel(
            fluidRow(
                align = "center",
                conditionalPanel(condition = "input.EF == true", plotOutput("GraphEF")),
                conditionalPanel(condition = "input.MonteCarlo == true", plotOutput("GraphMC"))
            )
        )
    )
)

server <- function(input, output) {
    
    OPw <- reactiveValues()
    output$Graphw <- renderPlot({ 
        OPw$PC}, height = 400, width = 400)
    
    observeEvent(input$Go, {
        showModal(modalDialog("Loading... Please Wait", footer=NULL)) 
    
        output$GraphEF <- renderPlot({ #Efficient Frontier
            if(input$EF){
                X(5,10,15)
            }
        }, height = 550, width = 700)
        
        output$GraphMC <- renderPlot({ #Monte Carlo Simulation
            if(input$MonteCarlo){
                Y(5,10,15)
            }
        },height = 550, width = 700)
        
        removeModal() #Removes Loading Pop-up Message
        
        
    })
}

shinyApp(ui = ui, server = server)

Thanks a lot for your help!

Answer 1

Leaving a conditionalPanel -approach, which is referring to a discussion over here :

library(shiny)

# Function 1
X <- function(a, b, c) {
  plot(c(a, b), c(b, c))
}

# Function 2
Y <- function(d, e, f) {
  plot(c(d, e), c(e, f))
}

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier"),
      checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
      actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
    ),
    mainPanel(
      fluidRow(
        align = "center", 
        conditionalPanel("output.showme == true", plotOutput("GraphEF")),
        plotOutput("GraphMC")
      )
    )
  )
)

server <- function(input, output) {
  
  GEF <- eventReactive(input$Go, {
    if (input$EF) {
      X(5, 10, 15)
    } else {
      NULL
    }
  })
  
  output$showme <- eventReactive(input$Go, {
    if (input$EF) TRUE else FALSE
  })
  outputOptions(output, "showme", suspendWhenHidden = FALSE)
  
  GMC <- eventReactive(input$Go, {
    if (isolate(input$MonteCarlo)) {
      Y(5, 10, 15)
    } else {
      NULL
    }
  })
  
  output$GraphMC <- renderPlot({
    GMC()
  })
  
  output$GraphEF <- renderPlot({ # Efficient Frontier
    GEF()
  })
  
  observeEvent(input$Go, {
    showModal(modalDialog("Loading... Please Wait", footer = NULL))
    
    Sys.sleep(2)
    
    removeModal() # Removes Loading Pop-up Message
  })
  
}

shinyApp(ui = ui, server = server)

Furthermore, please see this related answer .

Answer 2

The modal is working well, because both functions take so little time to run it creates de sensation than is there less than it should be. We can show this by adding a sys.sleep to simulate a long calculation.

Regarding the checkboxes, using conditionalPanel will hide or show the plots independently of the presence of isolate inside the server. A workaround is just to return NULL when the checkbox is not clicked.

library(shiny)

# Function 1
X <- function(a, b, c) {
  plot(c(a, b), c(b, c))
}

# Function 2
Y <- function(d, e, f) {
  plot(c(d, e), c(e, f))
}

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier"),
      checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
      actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
    ),
    mainPanel(
      fluidRow(
        align = "center",
        plotOutput("GraphEF"),
        plotOutput("GraphMC")
      )
    )
  )
)

server <- function(input, output) {
  OPw <- reactiveValues()
  output$Graphw <- renderPlot(
    {
      OPw$PC
    },
    height = 400,
    width = 400
  )

  observeEvent(input$Go, {
    showModal(modalDialog("Loading... Please Wait", footer = NULL))

    output$GraphEF <- renderPlot(
      { # Efficient Frontier
        if (isolate(input$EF)) {
          X(5, 10, 15)
        } else {
          NULL
        }
      },
      height = 550,
      width = 700
    )
    Sys.sleep(2)
    output$GraphMC <- renderPlot(
      { # Monte Carlo Simulation
        if (isolate(input$MonteCarlo)) {
          Y(5, 10, 15)
        } else {
          NULL
        }
      },
      height = 550,
      width = 700
    )

    removeModal() # Removes Loading Pop-up Message
  })
}

shinyApp(ui = ui, server = server)

Answer 3

Perhaps you should use eventReactive() . Try this

library(shiny)

# Function 1
X <- function(a, b, c) {
  plot(c(a, b), c(b, c))
}

# Function 2
Y <- function(d, e, f) {
  plot(c(d, e), c(e, f))
}

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier"),
      checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
      actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
    ),
    mainPanel(
      fluidRow(
        align = "center",
        plotOutput("GraphEF", height = 550, width = 700),
        plotOutput("GraphMC", height = 550, width = 700)
      )
    )
  )
)

server <- function(input, output) {
  
  GEF <- eventReactive(input$Go, {
    if (input$EF) {
      X(5, 10, 15)
    } else {
      NULL
    }
  })
  
  GMC <- eventReactive(input$Go, {
    if (input$MonteCarlo) {
      Y(5, 10, 15)
    } else {
      NULL
    }
  })
  
  output$GraphEF <- renderPlot({ # Efficient Frontier
    GEF()
  })
  
  output$GraphMC <- renderPlot({ # Efficient Frontier
    GMC()
  })
  
  observeEvent(input$Go, {
    showModal(modalDialog("Loading... Please Wait", footer = NULL))
 
    Sys.sleep(2)
    
    removeModal() # Removes Loading Pop-up Message
  })
  
}

shinyApp(ui = ui, server = server)