Reputation: 359
I am trying to create a reactive group checkbox based on the number of periods and phenotypes as user input and set a default selected option in the checkbox (with period >1) based on the user choices in period 1. For example, there are three options of method1, 2, and 3 in the checkbox and if the user selected "method1" in period 1, the later period (>1) will automatically have the "method1" selected within each phenotype. Otherwise, there is no interaction across the period if user selected other options in period 1.
In the demo code below, I was able to do this using an if-else in the server code. However, I can not select other options (i.e., methods 2 and 3) in Phenotype1: period1 checkbox like in Phenotype1: period2 checkbox (see attachment 1). My goal is to be able to select other options in Phenotype1: period1 checkbox and also automatically select "method1" in Phenotype1: period2 conditioned on method1 is selected in Phenotype1: period1 checkbox.
Modification:
I added back another reactive variable nPheno
(the real case I have) to properly illustrate the problem I have. In this case I can not hard code the Phenotypej: period1 checkbox as this is user specified.
Any help/suggestions are appreciated!
library(shiny)
ui <- basicPage(
numericInput("nPheno", "Number of phenotypes", value = 1,
min = 1),
numericInput("nPeriod", "Number of periods", value = 1,
min = 1),
uiOutput("idx1")
)
server <- shinyServer(function(input, output, session){
output$idx1 <- renderUI({
Nperiod <- as.integer(input$nPeriod)
Npheno <- as.integer(input$nPheno)
lapply(1:Npheno, function(j){
lapply(1:Nperiod, function(i){
# Here I used if else to set checkbox when Nperiod = 1 (selected = NULL)
# and > 1 (selected = based on selection in Npreiod = 1)
if (Nperiod == 1){
list(fluidRow(column(6, wellPanel(
checkboxGroupInput(paste0("phenotype", j, "period", i),
label = paste0("Phenotype", j, ": period", i),
choices = c("method1", "method2", "method3"),
# when period = 1, the defaulted selected is set as NULL
selected = NULL)))))
} else {
list(fluidRow(column(6, wellPanel(
checkboxGroupInput(paste0("phenotype", j, "period", i),
label = paste0("Phenotype", j, ": period: ", i),
choices = c("method1", "method2", "method3"),
# when period > 1, the defaulted selected is
# set as "method1" if user selected "method1" in preiod 1 otherwise NULL
selected = switch("method1" %in% input[[paste0("phenotype", j, "period", 1)]],
"method1", NULL))
)))) }
})
})
})
})
shinyApp(ui, server)
Upvotes: 1
Views: 809
Reputation: 21287
Split the renderUI
into two parts. As you are using info from the first renderUI
in the second one, it will be better this way. Try this
library(shiny)
ui <- basicPage(
numericInput("nPheno", "Number of phenotypes", value = 1, min = 1),
numericInput("nPeriod", "Number of periods", value = 1, min = 1),
uiOutput("idx"),
uiOutput("idx1")
)
server <- shinyServer(function(input, output, session){
mychoices <- list("method1", "method2", "method3")
output$idx <- renderUI({
Npheno <- as.integer(input$nPheno)
lapply(1:Npheno, function(j){
list(fluidRow(column(6, wellPanel(
checkboxGroupInput(paste0("phenotype", j, "period", 1),
label = paste0("Phenotype", j, ": period", 1),
choices = mychoices,
# when period = 1, the defaulted selected is set as NULL
selected = NULL
)))))
})
})
output$idx1 <- renderUI({
Nperiod <- as.integer(input$nPeriod)
Npheno <- as.integer(input$nPheno)
if (Nperiod > 1){
lapply(2:Nperiod, function(i){
lapply(1:Npheno, function(j){
list(fluidRow(column(6, wellPanel(
checkboxGroupInput(paste0("phenotype", j, "period", i),
label = paste0("Phenotype", j, ": period: ", i),
choices = mychoices,
# when period > 1, the defaulted selected is set as "method1"
# if user selected "method1" in period 1 otherwise NULL
selected = switch("method1" %in% as.character(input[[paste0("phenotype", j, "period", 1)]]),
"method1", NULL))
))))
})
})
}
})
})
shinyApp(ui, server)
Upvotes: 1