R Shiny - Checkboxes and Action Button Combination Issue

  • Home
  • Languages
  • R
  • R Shiny - Checkboxes and Action Button Combination Issue

R shiny - checkboxes and action button combination issue

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", 
        uiOutput("plot1"),
        plotOutput("GraphMC")
      )
    )
  )
)

server <- function(input, output) {

  GEF <- eventReactive(input$Go, {
    if (input$EF) {
      X(5, 10, 15)
    } else {
      NULL
    }
  })
  
  showme <- eventReactive(input$Go, {
    if (input$EF) TRUE else 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()
  })
  
  output$plot1 <- renderUI({
    if (showme()) {plotOutput("GraphEF")} else NULL
  })

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

    Sys.sleep(2)
    
    removeModal() # Removes Loading Pop-up Message
  })

}

shinyApp(ui = ui, server = server)

r shiny - Checkbox Issue

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)

checkboxinput server issues in R

I think you can do this without using reactiveValues. Make the function X as independent function which can be called under renderPlot.

library(shiny)

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

ui <- fluidPage(
  
  titlePanel("title"),
  
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier")
    ),
    
    mainPanel(
      fluidRow(
        align = "center",
        plotOutput("Graphw")
      )
    )
  )
)

server <- function(input, output) {
  
  output$Graphw <- renderPlot({ 
    if(input$EF){
      X(5,10,15)
    }
  })
}

shinyApp(ui = ui, server = server)

Sample Image

Problem collecting all checkbox values from Shiny DT assembled from different sources

That is because you are trying to use the same ID for checkboxes. Try this

  # Define a function to generate the checkboxes in the table.
  shinyInput = function(FUN, len, id, ...) {
    inputs <- character(len)
    lapply(seq_len(len), function(i) {
      inputs[i] <- as.character(FUN(paste0(id, len, i), label = NULL, ...))
    })
  }
  
  # Define a function to read back the input from the checkboxes.
  shinyValue <- function(id, len) {
    sapply(seq_len(len), function(i) {
      value <- input[[paste0(id, len, i)]]
      
      if(is.null(value)) {
        NA
      } else {
        value
      }
    })
  }

R SHINY - Conditional panel output shifted?

Use of renderUI() should help you. Try this

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 1", footer=NULL)) 
      OPw$LIST1 <- Run2(1,2,3)
    }
    removeModal() 
    
    if(input$MonteCarlo == TRUE && input$EF == FALSE){
      showModal(modalDialog("Loading... Please Wait 2", footer=NULL)) 
      OPw$LIST2 <- Run3(1,2,3)
    }
    removeModal() 
    
    if(input$MonteCarlo == TRUE && input$EF == TRUE){
      showModal(modalDialog("Loading... Please Wait 3", 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)

Uncheck box but be able to recheck R Shiny

Please try again. After correcting some bracket issues, this works for me:

library(shiny)

ui <- fluidPage(

  # Application title
  titlePanel("Preflop Trainer"),

  sidebarLayout(mainPanel = 
      mainPanel(),
      sidebarPanel = 
      sidebarPanel(
        checkboxInput("checkbox",
                      "Check Box"),
        actionButton("reset",
                     "Reset the box")
      )

  )
)
server <- function(input, output,session) {

  #this works for me
  observeEvent(input$reset, {
    updateCheckboxInput(session, "checkbox", "Check Box", value = F)
  }
  )
}

shinyApp(ui, server)

Errors in if statements in R Shiny checkBoxGroupInput

Please note that I normally prefer to post some working code, but this time I couldn't because I do not have access to your data: my apologies.

Some consideration:

  • In checkboxGroupInput you just need a plain character vector, i.e. you don't need to name columns etc.

    • The resulting input$checkbox is another character vector
    • checkboxGroupInput is designed to allow more than one input at a time, so the output can be a vector with more than one entry.
    • (minor) Rather than a cascade of if I normally prefer to use switch (edited: but it works only for 1 element comparisons), as it makes the code more readable (but it is personal taste).

In your case, to decrease the risk of errors (often due to a reactive calling the code more than once), in output$plot1 you could use

cols <- isolate(input$checkbox)

Also, rather than the existing code for output$plot1, you could eliminate an observeEvent in this way:

# snippet - not tested
#
# observeEvent(input$visualize, {  # this is redundant
    output$plot1 <- renderPlot( 
      if(is.null(input$visualize)) return()  # this is all you need to make output$plot1 reactive to input$visualize
      cols <- isolate(input$checkbox)
      if (cols == c("Mona Island"))
        {

The proliferation of nested reactive elements is never a good thing in shiny (among other things it causes unnecessarily the code to run repeatedly, burning CPU cycles).

If useful, I recently posted on SO a code example with checkboxGroupInput. See it here

If you still get errors I would suggest to post the links to allow me or others to get your data and post back a working example.

Working Example and "new comments"

library(shiny)
library(leaflet)
library(DT)
library(ggplot2)
library(dplyr)

r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()

plotdata <- read.csv("RShinyCoral.csv")
colnames(plotdata) <- c("Year1", "RLIMona", "Year2", "RLICatalina", "Year3", "RLILaParguera1998", "Year4", "RLILAPARGUERA2004")
parguera <- read.csv("RShinyCoral.csv")
parguera <- select(parguera, 5:8)
colnames(parguera) <- c("Year", "1998 Expedition", "Year", "2004 Expedition")
monaisland <- read.csv("RShinyCoral.csv")
monaisland <- select(monaisland, 1:2)
colnames(monaisland) <- c("Year", "Mona Island RLI")
islacatalina <- read.csv("RShinyCoral.csv")
islacatalina <- select(islacatalina, 3:4)
colnames(islacatalina) <- c("Year", "Isla Catalina RLI")

ui <- fluidPage(
  titlePanel("NOAA Coral Luminescence Data (RLI, 5-year Running Average)"),
  leafletOutput("mymap"),
  p(),
  fluidRow(
    column(3, actionButton("laparguera", "La Parguera Data"),
           actionButton("mona", "Mona Island Data"),
           actionButton("isla", "Isla Catalina Data")),

    column(9, 
      actionButton("visualize", "Add to Plot"),

      checkboxGroupInput("checkbox", label = NULL, 
                                             c("La Parguera",  "Mona Island", "Isla Catalina"))
      )),
    fluidRow(column(6, DT::dataTableOutput('tbl')), 
     column(6,  plotOutput("plot1"))
     )
)
server <- function(input, output, session) {

  output$mymap <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(lat = 17.95, lng = - 67.05, popup = "La Parguera ") %>%
      addMarkers(lat = 18.00, lng = -67.50, popup = "Mona Island") %>%
      addMarkers(lat = 18.2, lng = -69.00, popup = "Isla Catalina")
  })
  observeEvent(input$laparguera, {
    output$tbl <- DT::renderDataTable(DT::datatable(parguera, options = list(pagelength = 25)))
  })
  observeEvent(input$mona, {
    output$tbl <- DT::renderDataTable(DT::datatable(monaisland, options = list(pagelength = 25)))
  })
  observeEvent(input$isla, {
    output$tbl <- DT::renderDataTable(DT::datatable(islacatalina, options = list(pagelength = 25)))
  })

  output$plot1 <- renderPlot({
    if(length(input$visualize) == 0 ) return()
    isolate({
      if(length(input$checkbox) == 0) return()
      incheckbox <- input$checkbox
    }) # end isolate
    if(length(incheckbox) == 1) {
    switch(incheckbox,
      "Mona Island"= { gplot <- ggplot(data = plotdata) +
                          geom_polygon(mapping = aes(x = Year1, y = RLIMona), na.rm = TRUE) +
                          ylab("Candelas (5-year Running Average)" )
                       print(gplot) },
      "Isla Catalina"= { gplot6 <- ggplot(data = plotdata) +
                          geom_polygon(mapping = aes(x = Year1, y = RLIMona), na.rm = TRUE) +
                          ylab("Candelas (5-year Running Average)" )
                         print(gplot6) },
      "La Parguera"= { gplot7 <- ggplot(data = plotdata) +
                          geom_polygon(mapping = aes(x = Year1, y = RLIMona), na.rm = TRUE) +
                          ylab("Candelas (5-year Running Average)" )
                       print(gplot7) }
                       ) # end switch
    } else if(length(incheckbox) == 2) {
             if(all(c("La Parguera", "Mona Island") %in% incheckbox)) {
                gplot2 <- ggplot(data = plotdata) +
                  geom_polygon(mapping = aes(x = Year1, y = RLIMona), na.rm = TRUE) +
                  ylab("Candelas (5-year Running Average)" )
                print(gplot2)
          }  else if( all(c("Mona Island", "Isla Catalina") %in% incheckbox))  {
                  gplot4 <- ggplot(data = plotdata) +
                    geom_polygon(mapping = aes(x = Year1, y = RLIMona), na.rm = TRUE) +
                    ylab("Candelas (5-year Running Average)" )
                  print(gplot4)
          } else if(all(c("La Parguera", "Isla Catalina") %in% incheckbox))    {
                  gplot5 <- ggplot(data = plotdata) +
                    geom_polygon(mapping = aes(x = Year1, y = RLIMona), na.rm = TRUE) +
                    ylab("Candelas (5-year Running Average)" )
                  print(gplot5)  
                }
         }  else if ( all(c("La Parguera", "Mona Island", "Isla Catalina") %in% incheckbox)) {
                  gplot3 <- ggplot(data = plotdata) +
                    geom_polygon(mapping = aes(x = Year1, y = RLIMona), na.rm = TRUE) +
                    ylab("Candelas (5-year Running Average)" )
                  print(gplot3)
          } 

    })

}

shinyApp(ui, server)

The code above works for me :)

Apart the UI changes (made to get a bit tidier UI and see what was happening), the key is the if cascade`.
Take into account:

  • if only works for one element. If you compare a vector of length >1 with another vector >1, only the first matching element of the first vector is considered.
  • I do not consider my code particular elegant (I do not exclude later to get some better ideas!), but it should work (please let me know if it doesn't).

  • Suppose you have selected 3 elements. all(c("La Parguera", "Mona Island") %in% incheckbox) would always be true. This is why currently I split the comparisons by number of elements (but there are probably other alternatives using other set operators like setdiff).

    Please let me know if it works for you.


Related Topics

Add Months of Zero Demand to Zoo Time Series

Weird Case with Data Tables in R, Column Names Are Mixed

How to Convert All Column Data Type to Numeric and Character Dynamically

Subset Panel Data by Group

Solve Homogenous System Ax = 0 for Any M * N Matrix a in R (Find Null Space Basis for A)

Include a Comma Separator for Data Labels

Ribbon Chart in R

R: Reading a Binary File That Is Zipped

Is There Something Like a Pmax Index

How to Load Comma Separated Data into R

Filtering Multiple Columns with Str_Detect

Chi Square Test for Each Row in Data Frame

Scale Value Inside of Aes_String()

Using Predict() and Table() in R

Parallel R on a Windows Cluster

Convert Month's Number to Month Name

Annotation_Custom with Npc Coordinates in Ggplot2

Splitting Text to Words with R and Csplit()


Leave a reply



Submit