In R shiny, how to reverse the reactivity chain?

In the below MWE code, the 1st input box is rendered and plotted by default. A default value is presented and plotted and the user can change it. Clicking the "Show" checkbox renders a 2nd input box, whose value is linked to the 1st input box, and in this 2nd input box the user can optionally insert another value which then takes precedence over 1st input and is plotted. (In the full App this is extracted from, the 2nd input box performs other calculations so what is shown here is simplified). So the reactivity chain where works: input1 -> input2 with input2 taking precedence over input1.

However, how do I reverse this reactivity chain? So that the value presented in input1 changes to reflect what was input into input2? In the below MWE, I tried doing this in the line marked << comment/uncomment this line to see but when that line is uncommented (allowing my attempted solution to run), the 2nd input box is hidden even though the "Show" checkbox for that 2nd input remains checked for show. That 2nd input box should continue showing until unchecked.

See image below too.

MWE code:

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

### 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")
### Checkbox matrix ###

xDflt <- 5
userInput <- function(inputId,x,y){
  matrixInput(inputId, 
              value = matrix(c(x), 1, 1, dimnames = list(c(y),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(),
      userInput("input1",
                # if(isTruthy(input2())){input$input2[1,1]} else # << comment/uncomment this line to see
                  {xDflt},
                "1st input"),
      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())
    userInput("input2",input$input1[1,1],"2nd input")
  })
  
  outputOptions(output,"secondInput",suspendWhenHidden = FALSE) 
  
  output$plot1 <-renderPlot({
    req(input2())
    plot(rep(input2(),times=5))
  })

}

shinyApp(ui, server)

enter image description here

Upvotes: 2

Views: 143

Answers (1)

Jan
Jan

Reputation: 5254

Your checkboxes become unchecked because you render and re-render them along with the output$panel. You forgot to add uiOutput("checkboxes") to the UI. Here are the steps:

  1. Remove tableOutput("checkboxes") from output$panel <- renderUI().
  2. Add uiOutput("checkboxes"), to the UI.
  3. Uncomment your line if(isTruthy(input2() ....

That should do the trick.

Some remarks about the code. I find it unnecessarily complex. E.g. you use c(x) in the userInput function which is unnecessary. You wrap input$input1 in a reactive expression which does not add anything (except readability maybe) but adds complexity to the reactivity chain. There are several ways to make the code easier to understand and read, which would probably help avoid simple mistakes like a missing uiOutput.

Upvotes: 1

Related Questions