CODEWITHSUNDEEP
rshiny
DDigits
DDigits

Reputation: 157

r shiny - Checkbox Issue

This post is a reference to this one R shiny - checkboxes and action button combination issue.

To summarize the previous post, I want my graphs to be displayed when I click on the "Go" button and updated ONLY when I click on the "Go' button. Currently, after having clicked on "Go" once, they get updated every time you touch the checkboxes. I got some great answers in the previous post but the example I posted ended up being a little too simple and so I'm having a hard time to reproduce the solutions for my current code.

In the MRE that follows (also from R SHINY - Conditional panel output shifted?), there are 3 conditions/functions (instead of 2). Also, the functions output a list of object (as opposed to 1 graph).

Here is the code:

library(shiny)
library(ggplot2)

ui <- shinyUI(fluidPage(
    
    titlePanel("Construction"),
    
    sidebarLayout(
        sidebarPanel(
            checkboxInput("EF", "Efficient Frontier"),
            checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
            
            fluidRow(
                align = "center",
                actionButton("Gow", "Go!")),
            
        ),
        
        mainPanel(
            column(12,
                   br(),
                   align = "left",
                   splitLayout(cellWidths = c("70%", "30%"),
                               plotOutput("Graphw"),
                               uiOutput("mytable"))),
            column(12,
                   align = "center",
                   conditionalPanel(condition = "input.EF == true && input.MonteCarlo == false", plotOutput("GraphEF")),
                   conditionalPanel(condition = "input.MonteCarlo == true && input.EF == false", plotOutput("GraphMC")),
                   conditionalPanel(condition = "input.MonteCarlo == true && input.EF == true", plotOutput("GraphEFMC"))
            )
        )
    )
)
)


#Server
server <- shinyServer(function(input, output) {
    
    OPw <- reactiveValues()
    observeEvent(input$Gow, {
        
        OPw$PC <- Run(1,2,3)
        
        if(input$EF == TRUE && input$MonteCarlo == FALSE){
            showModal(modalDialog("Loading... Please Wait", footer=NULL)) 
            OPw$LIST1 <- Run2(1,2,3)
        }
        removeModal() 
        
        if(input$MonteCarlo == TRUE && input$EF == FALSE){
            showModal(modalDialog("Loading... Please Wait", footer=NULL)) 
            OPw$LIST2 <- Run3(1,2,3)
        }
        removeModal() 
        
        if(input$MonteCarlo == TRUE && input$EF == TRUE){
            showModal(modalDialog("Loading... Please Wait", footer=NULL)) 
            OPw$LIST3 <- Run4(1,2,3)
        }
        removeModal() 
    })
    
    #Output Variables
    output$Graphw <- renderPlot({ 
        OPw$PC}, height = 400, width = 400)
    
    output$GraphEF <- renderPlot({ 
        OPw$LIST1[[1]]
    },height = 550, width = 700)
    
    output$EFWeightsTable <- renderTable({ 
        OPw$LIST1[[2]]}, colnames = TRUE
    )
    
    output$GraphMC <- renderPlot({ 
        OPw$LIST2[[1]]
    },height = 550, width = 700)
    
    output$MCWeightsTable <- renderTable({ 
        OPw$LIST2[[2]]}, colnames = TRUE
    )
    
    output$GraphEFMC <- renderPlot({ 
        OPw$LIST3[[1]]
    },height = 550, width = 700)
    
    output$EFMCWeightsTable <- renderTable({ 
        OPw$LIST3[[2]]}, colnames = TRUE
    )
    
    output$mytable <- renderUI({
        if (input$EF & !input$MonteCarlo) {tableOutput("EFWeightsTable")
        } else if (!input$EF & input$MonteCarlo){tableOutput("MCWeightsTable")
        } else if (input$EF & input$MonteCarlo){tableOutput("EFMCWeightsTable")
        } else return(NULL)
    })
    
    #FUNCTIONS
    Run <- function(a, b, c){
        
        Plot <- ggplot(as.data.frame(cbind(c(1,2,3),c(2,3,4))), aes(c(1,2,3), c(2,3,4))) +
            geom_line() 
        
        return(Plot)
    }
    
    Run2 <- function(a,b,c){
        
        eweights <- data.frame(cbind(seq(1,9),seq(1,9),seq(1,9)))
        
        MYPLOT <- ggplot(as.data.frame(cbind(c(10,7,4),c(5,6,7))), aes(c(10,7,4), c(5,6,7))) +
            geom_line() 
        
        return(list(MYPLOT, eweights))
    }
    
    Run3 <- function(a,b,c){
        
        eweights <- data.frame(cbind(seq(2,10),seq(2,10),seq(2,10)))
        
        MYPLOT <- ggplot(as.data.frame(cbind(c(4,5,6),c(7,8,9))), aes(c(4,5,6),c(7,8,9))) +
            geom_line() 
        
        return(list(MYPLOT, eweights))
    }
    
    Run4 <- function(a,b,c){
        Run3(a,b,c)
    }
})

shinyApp (ui = ui, server = server)

As always, I really appreciate your help! Thank you

Upvotes: 1

Views: 398

Answers (1)

ismirsehregal
ismirsehregal

Reputation: 33580

There is a lot of unnecessary repetition in your code. You can reduce it drastically by using eventReactive and directly pass it to the render* functions - without creating a separate output for each plot - this also avoids the need to use e.g. conditionalPanel or renderUI.

Please check the follwing

library(shiny)
library(ggplot2)

# Functions ---------------------------------------------------------------
Run <- function(a, b, c) {
  Plot <- ggplot(as.data.frame(cbind(c(1, 2, 3), c(2, 3, 4))), aes(c(1, 2, 3), c(2, 3, 4))) +
    geom_line()
  return(Plot)
}

Run2 <- function(a, b, c) {
  eweights <- data.frame(cbind(seq(1, 9), seq(1, 9), seq(1, 9)))
  MYPLOT <- ggplot(as.data.frame(cbind(c(10, 7, 4), c(5, 6, 7))), aes(c(10, 7, 4), c(5, 6, 7))) +
    geom_line()
  return(list(MYPLOT, eweights))
}

Run3 <- function(a, b, c) {
  eweights <- data.frame(cbind(seq(2, 10), seq(2, 10), seq(2, 10)))
  MYPLOT <- ggplot(as.data.frame(cbind(c(4, 5, 6), c(7, 8, 9))), aes(c(4, 5, 6), c(7, 8, 9))) +
    geom_line()
  return(list(MYPLOT, eweights))
}

Run4 <- function(a, b, c) {
  Run3(a, b, c)
}


# UI ----------------------------------------------------------------------
ui <- fluidPage(titlePanel("Construction"),
                sidebarLayout(
                  sidebarPanel(
                    checkboxInput("EF", "Efficient Frontier"),
                    checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
                    fluidRow(align = "center",
                             actionButton("Gow", "Go!")),
                  ),
                  mainPanel(
                    column(
                      12,
                      br(),
                      align = "left",
                      splitLayout(
                        cellWidths = c("70%", "30%"),
                        plotOutput("Graphw"),
                        tableOutput("myTable")
                      )
                    ),
                    column(12,
                           align = "center",
                           plotOutput("myGraph"))
                  )
                ))

# Server ------------------------------------------------------------------
server <- function(input, output, session) {
  OPwPC <- eventReactive(input$Gow, {
    Run(1, 2, 3)
  })
  
  OPw <- eventReactive(input$Gow, {
                         selectedRun <- NULL
                         showModal(modalDialog("Loading... Please Wait", footer = NULL))
                         if (input$EF == TRUE && input$MonteCarlo == FALSE) {
                           selectedRun <- Run2(1, 2, 3)
                         } else if (input$MonteCarlo == TRUE && input$EF == FALSE) {
                           selectedRun <- Run3(1, 2, 3)
                         } else if (input$MonteCarlo == TRUE && input$EF == TRUE) {
                           selectedRun <- Run4(1, 2, 3)
                         }
                         removeModal()
                         return(selectedRun)
                       })
  
# Output Variables --------------------------------------------------------
  output$Graphw <- renderPlot({
    OPwPC()
  }, height = 400, width = 400)
  
  output$myGraph <- renderPlot({
    OPw()[[1]]
  }, height = 550, width = 700)
  
  output$myTable <- renderTable({
    OPw()[[2]]
  }, colnames = TRUE)
}

shinyApp (ui = ui, server = server)

Upvotes: 1

Related Questions