Reactive radiobuttons depending on choice of other radionButtons - r

I have this shiny app where I want to use a set of radioBuottons to determine the vector of choices for another set of radioBuottons. I've tried using conditionalPanel but I cannot figure out how to bind different sets of radioBuottons to a single output entry (if that is even possible).
So I came up with defining a list for the second set of radioBuottons and try to select them depending on the choice of the first set of radioBuottons.
Here is an example of code:
ui.r:
library(shiny)
secondInput <- list(
"a" = c("one", "two", "three"),
"b" = c("four", "five")
)
shinyUI(fluidPage(
titlePanel("Test reactive RadioButtons"),
column(4,
radioButtons("input1", label = "1st input", choices = c("a","b"))),
column(4,
radioButtons("input2", label = "2nd input depend on 1st input", choices = secondInput[[input$input1]])),
column(4,
textOutput("IN1"))
))
server.r:
library(shiny)
shinyServer(function(input, output) {
out <- reactive(input$input1)
output$IN1 <- renderText(out())
})
I get an error saying that object 'input' was not found.
How can I manage this?

I think the updateRadioButtons would be better as there is no need to re-create the widget every time input1 changes
library(shiny)
secondInput <- list(
"a" = c("one", "two", "three"),
"b" = c("four", "five")
)
ui <- fluidPage(
titlePanel("Test reactive RadioButtons"),
column(4,radioButtons("input1", label = "1st input", choices = c("a","b"))),
column(4,radioButtons("input2", label = "2nd input depend on 1st input", choices = "")),
column(4,textOutput("IN1"))
)
# Define server logic
server <- function(input, output, session) {
observeEvent(input$input1,{
updateRadioButtons(session,"input2",choices = secondInput[[input$input1]])
})
out <- reactive(input$input1)
output$IN1 <- renderText(out())
}
# Run the application
shinyApp(ui = ui, server = server)

The radioButtons that you generated are not reactive. If you want to use one input to make another input or output dependent on it, you have to build the logic for that in reactive expressions in the server. You could use uiOutput and renderUI for this. A working example is given below, hope this helps!
library(shiny)
secondInput <- list(
"a" = c("one", "two", "three"),
"b" = c("four", "five")
)
ui <- fluidPage(
radioButtons("input1", label = "1st input", choices = c("a","b")),
uiOutput('radiobuttons2')
)
server <- function(input, output, session) {
output$radiobuttons2 <- renderUI({
radioButtons('input2',label='2nd input', choices = secondInput[[input$input1]])
})
}
shinyApp(ui, server)

Related

Display input label instead of identifier

In my shiny app I want to display the label of input instead of the input code. Anyone knows how to do this? Here is an example below, in this example when one select First Variable, "var1" is returned, however I want "First Variable" to be returned.
I could write something reactive (i.e. ifelse input_variable equals var1 then return "First Variable" but if var2 then return "Second Variable" and so on). But there must be a more efficient way right?
Thank you!
library(shiny)
ui <- fluidPage(
selectInput(inputId = "input_variable", label = "Variable",
choices = c("First Variable" = "var1", "Second Variable" = "var2", "Third Variable" = "var3"),
selected = "var1"),
verbatimTextOutput("out")
)
server <- function(input, output){
output$out <- renderPrint({
input$input_variable
})
}
shinyApp(ui, server)
Instead of hard-coding the values twice, create a lookup vector and use that for both the UI and the server logic:
values <- c('First variable', 'Second variable', 'Third variable')
vars <- paste0('var', seq_along(values))
ui <- fluidPage(
selectInput(inputId = "input_variable", label = "Variable",
choices = setNames(vars, values),
selected = "var1"),
verbatimTextOutput("out")
)
server <- function(input, output){
output$out <- renderPrint({
values[match(input$input_variable, vars)]
})
}
shinyApp(ui, server)

hide/show parameter2 based on parameter1 value in shiny app

I am new to shiny apps/R and would require your help to address my below scenario.
ui <- fluidPage(
selectInput(inputId = "para1",label = "parameter1", choices = c("var1","Var2")),
selectInput(inputId = "para2",label = "parameter2", choices = c("cars","trucks"))
)
server <- function(input,output,session){
output$text <- renderText("control parameters")
}
shinyApp(ui,server)
my requirement is to show/hide "parameter2" based on selecting the "parameter1" values.
Let's say if I select parameter1=="var1", then show "parameter2" otherwise hide entire "parameter2".
You could use shinyjs::toggle combined with uiOutput:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
selectInput(inputId = "para1",label = "parameter1", choices = c("var1","var2")),
uiOutput("selectPara2")
)
server <- function(input,output,session){
output$selectPara2 <- renderUI(selectInput(inputId = "para2",label = "parameter2", choices = c("cars","trucks")))
shiny::observeEvent(input$para1, {
shinyjs::toggle("selectPara2", condition = input$para1 == "var1")
})
}
shinyApp(ui,server)
note that useShinyjs() needs to be called in the UI for this to work.

Access input ID of reactive radioButtons in shiny app

I am trying to create a shiny app which includes radioButtons which are reactive to some user input.
I was successful to implement the code from this related question:
Add n reactive radioButtons to shiny app depending on user input
However, in this question it is not described how to access this values.
Here is the example:
server.R
library(shiny)
shinyServer( function(input, output, session) {
output$variables <- renderUI({
numVar <- length(as.integer(input$in0))
lapply(input$in0, function(x) {
list(radioButtons(paste0("dynamic",x), x,
choices = c("Choice one" = "one",
"Choice two" = "two"), selected = "one"))
})
})
})
ui.R
library(shiny)
shinyUI(pageWithSidebar (
headerPanel("mtcars subset"),
sidebarPanel(
selectInput(inputId = 'in0', label = 'Choose variables',
choices = colnames(mtcars),
multiple = TRUE, selectize = TRUE),
uiOutput("variables")
),
mainPanel()
))
What I have tried so far:
numVar <- length(as.integer(input$in0))
for(i in 1:numVar){
in <- noquote(paste0("dynamic",input$in0[i]))
input$in
}
However, this does not work. Any suggestions?
I'm not sure exactly of your use case but to access the values you could edit your code as below:
numVar <- length(as.integer(input$in0))
for(i in 1:numVar){
value <- paste0("dynamic",input$in0[i])
input[[value]]
}
Basically you need to use input[[value]] as opposed to input$value in this case. It doesn't seem that R allows you to use in as a variable (probably because it's already used in other contexts). You don't need noquote() anymore.
Welcome to stackoverflow!
You were almost there. However, you'll have to make sure, that you are accessing the inputs in a reactive context.
Here is a working example:
library(shiny)
ui <- fluidPage(
pageWithSidebar (
headerPanel("mtcars subset"),
sidebarPanel(
selectInput(inputId = 'in0', label = 'Choose variables',
choices = colnames(mtcars),
multiple = TRUE, selectize = TRUE),
uiOutput("variables")
),
mainPanel(
textOutput("myChoicesDisplay")
)
)
)
server <- function(input, output, session) {
output$variables <- renderUI({
lapply(input$in0, function(x) {
list(radioButtons(paste0("dynamic", x), x,
choices = c("Choice one" = "one",
"Choice two" = "two"), selected = "one"))
})
})
myChoices <- reactive({
dynInputList <- list()
for(dynInputs in paste0("dynamic", input$in0)){
dynInputList[[dynInputs]] <- input[[dynInputs]]
}
return(dynInputList)
})
output$myChoicesDisplay <- renderText({
paste(input$in0, myChoices(), sep = ": ", collapse = ", ")
})
}
shinyApp(ui, server)

R shiny favourites in long selectInput lists

How do I deal with long lists of options? In the example below, I have a subset of the options as favourites, but want to be able to select all options including the non-favourites. How do I get the input$selected to return what I selected last based on both the radiogroupbutton() and the selectInput()?
EDIT: I would like to keep the look, which has radiobuttons AND a drop down list. Therefore, I assume both will need different inputID's which then could be combined (somehow) in the server site (as Joris suggested). I am not sure how to combine them on the server site, and how to identify what was selected last.
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
h3("Favourites:"),
radioGroupButtons(inputId="selected",
choices = sort(favourites),
individual = TRUE,
selected = NULL,
width="20%"),
selectInput(inputId="selected", label = "Other options",
choices = ALL.options,
selected = NULL),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
)
server <- function(input, output) {
output$choice <- renderPrint(
input$selected
)
}
shinyApp(ui, server)
Perhaps it suffices to use a single selectInput or selectizeInput that lists the Favourites and Other options in separate option groups (see e.g. Shiny: Option groups for selectize input):
library(shiny)
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
selectizeInput(inputId = "selected", label = "All options", choices = list(
Favourites = favourites,
`Other options` = setdiff(ALL.options, favourites)
),
options = list(
placeholder = '<None selected>',
onInitialize = I('function() { this.setValue(""); }')
)
),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
server <- function(input, output) {
output$choice <- renderPrint({
validate(need(input$selected, "None selected"))
input$selected
})
}
shinyApp(ui, server)
NB: If you instead use two separate inputs (radioGroupButtons and selectInput) you could combine the selected choices server-side in a reactive object. For instance:
library(shiny)
library(shinyWidgets)
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
h3("Favourites:"),
radioGroupButtons(inputId = "radio",
choices = sort(favourites),
individual = TRUE,
selected = character(0),
width="20%"),
selectizeInput(inputId="select", label = "Other options",
choices = ALL.options,
options = list(
placeholder = '<None selected>',
onInitialize = I('function() { this.setValue(""); }')
)
),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
server <- function(input, output) {
## initialize reactive value
currentSelected <- reactiveVal(NULL)
## update based on radioGroupButtons
observeEvent(input$radio, {
currentSelected(input$radio)
})
## update based on selectInput
observeEvent(input$select, {
currentSelected(input$select)
})
output$choice <- renderPrint({
validate(need(currentSelected(), "None selected"))
currentSelected()
})
}
shinyApp(ui, server)
Created on 2019-06-17 by the reprex package (v0.3.0)
I am not sure if I understand fully what you are trying to achieve. I also notice that both the radioGroupButtons and the selectInput have the same inputId. If the idea is to print both the choices, you could change the inputId of the selectInput to say, select and just modify the renderPrint as:
output$choice <- renderPrint(
c(input$selected, input$select)
)
Is this what you are looking for?

R Shiny synchronize filters on multiple tabs

I built a R Shiny application with multiple tabs, which have some filters in common. Right now, all filters are stand-alone and do not synchronize across multiple tabs. Hence, when I change selectInput1 from value "a" to value "b", I have to repeat this handling on the next tab which contains selectInput2 with the same options/meaning.
I thought about making the filters dynamic, hence rendering them using the server side of R Shiny. Then of course, I can always make selectInput2 equal to selectInput1. But what if the user changes selectInput2 rather than selectInput1? It creates kind of a loop in the logic.
I spent quite some time finding a solution for this problem, and somehow I'm sure I'm not the first one encountering this problem. Suggestions or useful links would be really helpful!
Example:
## UI.R
shinyUI(
dashboardPage("Dashboard",
# Create tabs
tabPanel("Start",
p("This is the frontpage")
),
tabPanel("tab1",
uiOutput("selectInput1")
),
tabPanel("tab2",
uiOutput("selectInput2")
)
)
)
and:
## Server.R
library(shiny)
shinyServer(function(input, output,session){
output$selectInput1 <- renderUI({
selectInput(inputId = "id1",
label = "select",
choices = c("a","b","c"),
selected = "a")
})
output$selectInput2 <- renderUI({
selectInput(inputId = "id2",
label = "select",
choices = c("a","b","c"),
selected = "a")
})
})
I would personally use a single input control to control the different tab panels. One way is to include that single input under your tabs:
shinyApp(
fluidPage(
fluidRow(
tabsetPanel(
tabPanel("Tab1",
verbatimTextOutput("choice1")),
tabPanel("Tab2",
verbatimTextOutput("choice2"))
)
),
fluidRow(
selectInput("id1", "Pick something",
choices = c("a","b","c"),
selected = "a")
)
),
function(input, output, session){
output$choice1 <- renderPrint(input$id1)
output$choice2 <- renderPrint({
paste("The choice is:", input$id1)
})
}
)
Or, as you use a shinydashboard, you could actually add that control in the sidebar, possibly again in its own row under a set of tabs if you must.
I can't think of a reason to have multiple inputs who automatigically select the same thing. Other than slowing down your app, I can't see any gain. But if you insist, you make the selected choice a reactive value using reactiveVal and you use eg observeEvent() to update that reactive value. A small example using shinydashboard:
library(shinydashboard)
library(shiny)
ui <- shinyUI(
dashboardPage(title = "Dashboard",
dashboardHeader(),
dashboardSidebar(
tabsetPanel(
tabPanel("tab1",
uiOutput("selectInput1")
),
tabPanel("tab2",
uiOutput("selectInput2")
)
)),
dashboardBody(
verbatimTextOutput("selected")
)
)
)
server <- shinyServer(function(input, output,session){
thechoice <- reactiveVal("a")
output$selectInput1 <- renderUI({
selectInput(inputId = "id1",
label = "select",
choices = c("a","b","c"),
selected = thechoice())
})
output$selectInput2 <- renderUI({
selectInput(inputId = "id2",
label = "select",
choices = c("a","b","c"),
selected = thechoice())
})
observeEvent(input$id2,{
thechoice(input$id2)
})
observeEvent(input$id1,{
thechoice(input$id1)
})
output$selected <- renderPrint({
c(input$id1, input$id2)
})
})
shinyApp(ui, server)

Resources