In R Shiny, how to make the unchecking of a checkbox input to cause an action?-CodePudding

Below MWE code works as originally intended. When invoking the App, a matrix of checkboxes appears in sidebar panel with the option of show/hide/reset (only show/hide are working for simplicity of illustration) for a 2nd input matrix and a 3rd input matrix (only 2nd input matrix presents for simplicity of illustration), either/both of which appear (or would appear in case of 3rd input matrix) in sidebar panel.

However the hide function is better addressed by simply unchecking "Show", and I would like to eliminate the "Hide" checkbox. Does anyone know how to accomplish this? Check "Show" and 2nd input matrix appears; uncheck it and 2nd input matrix disappears. By default when invoking the App the 2nd input matrix needs to be hidden. (I ended up with show/hide as separate checkboxes because I had switched from action buttons to checkboxes...oops).

This will probably need to be put in a separate post, but for the checkbox matrix in the sidebar panel I'll also need to keep the columns for "Show" and "Reset" the same width and widen the 1st column which currently show "2nd input" and "3rd input".

MWE code:

library(shiny)
library(shinyjs)

### Begin checkbox matrix ###
f <- function(action,i){as.character(checkboxInput(paste0(action,i),label=NULL))}
actions       <- c("show", "hide", "reset")
tbl           <- t(outer(actions, c(1,2), FUN = Vectorize(f)))
colnames(tbl) <- c("Show", "Hide", "Reset")
rownames(tbl) <- c("2nd input", "3rd input")
### End checkbox matrix ###

firstInput <- function(inputId){
  matrixInput(inputId, 
              value = matrix(c(5), 1, 1, dimnames = list(c("1st input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

secondInput <- function(inputId,x){
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c("2nd input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      "td .checkbox {margin-top: 0; margin-bottom: 0;}
       td .form-group {margin-bottom: 0;}"
    ))
  ),
  br(),
  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      hidden(uiOutput("secondInput")),
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output){
  
  input1      <- reactive(input$input1)
  input2      <- reactive(input$input2)
  
  output$panel <- renderUI({
    tagList(
      useShinyjs(),
      firstInput("input1"),
      strong(helpText("Generate curves (Y|X):")),
      tableOutput("checkboxes") 
    )
  })
  
  ### Begin checkbox matrix ###
  output[["checkboxes"]] <- 
    renderTable({tbl}, 
      rownames = TRUE, align = "c",
      sanitize.text.function = function(x) x
    )
  observe({
    print(input[["show1"]])
    shinyjs::show("secondInput")
  })
  
  observe({
    print(input[["hide1"]])
    shinyjs::hide("secondInput")
  })
  ### End checkbox matrix ###
 
  output$secondInput <- renderUI({
    req(input1())
    secondInput("input2",input$input1[1,1])
  })
  
  outputOptions(output,"secondInput",suspendWhenHidden = FALSE) 
  
  output$plot1 <-renderPlot({
    req(input2())
    plot(rep(input2(),times=5))
  })
  
  observeEvent(input$show,{
    shinyjs::show("secondInput")
    updateCheckboxInput(session, "hide", value = FALSE)
  })
  
  observeEvent(input$hide,{
    shinyjs::hide("secondInput")
    updateCheckboxInput(session, "show", value = FALSE)
  })
   
}

shinyApp(ui, server)

CodePudding user response：

You can use observeEvent and a condition:

library(shiny)
library(shinyjs)
library(shinyMatrix)

### Begin checkbox matrix ###
f <- function(action,i){as.character(checkboxInput(paste0(action,i),label=NULL))}
actions       <- c("show", "reset")
tbl           <- t(outer(actions, c(1,2), FUN = Vectorize(f)))
colnames(tbl) <- c("Show", "Reset")
rownames(tbl) <- c("2nd input", "3rd input")
### End checkbox matrix ###

firstInput <- function(inputId){
  matrixInput(inputId, 
              value = matrix(c(5), 1, 1, dimnames = list(c("1st input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

secondInput <- function(inputId,x){
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c("2nd input"),NULL)),
              rows =  list(extend = FALSE, names = TRUE),
              cols =  list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      "td .checkbox {margin-top: 0; margin-bottom: 0;}
       td .form-group {margin-bottom: 0;}"
    ))
  ),
  br(),
  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      hidden(uiOutput("secondInput")),
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output){
  
  input1      <- reactive(input$input1)
  input2      <- reactive(input$input2)
  
  output$panel <- renderUI({
    tagList(
      useShinyjs(),
      firstInput("input1"),
      strong(helpText("Generate curves (Y|X):")),
      tableOutput("checkboxes") 
    )
  })
  
  ### Begin checkbox matrix ###
  output[["checkboxes"]] <- 
    renderTable({tbl}, 
                rownames = TRUE, align = "c",
                sanitize.text.function = function(x) x
    )
  
  observeEvent(input[["show1"]], {
    if(input[["show1"]]){
      shinyjs::show("secondInput")
    } else {
      shinyjs::hide("secondInput")
    }
  })
  
  ### End checkbox matrix ###
  
  output$secondInput <- renderUI({
    req(input1())
    secondInput("input2",input$input1[1,1])
  })
  
  outputOptions(output,"secondInput",suspendWhenHidden = FALSE) 
  
  output$plot1 <- renderPlot({
    req(input2())
    plot(rep(input2(),times=5))
  })
  
  observeEvent(input$show,{
    shinyjs::show("secondInput")
    updateCheckboxInput(session, "hide", value = FALSE)
  })
  
  observeEvent(input$hide,{
    shinyjs::hide("secondInput")
    updateCheckboxInput(session, "show", value = FALSE)
  })
  
}

shinyApp(ui, server)