Reputation: 2720
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)
Upvotes: 2
Views: 143
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:
tableOutput("checkboxes")
from output$panel <- renderUI()
.uiOutput("checkboxes"),
to the UI.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