I have the following dataframe:
a<-rep(c("cat","dog","bird"),each=5)
b<-letters[1:length(a)]
c<-data.frame("pet"=a,"level"=b)
I'd like to make a shiny app that has a pull down menu for selecting pet and then have a dynamic set of checkboxes that appear beneath that have corresponding values of level for checkbox options.
So, selecting cat would bring up a checkbox group of a,b,c,d,e and then selecting dog would change those checkboxes to only show f,g,h,i,j, etc.
Thanks for the help
You can use the updateCheckboxGroupInput function inside an observer (?observe The observe function "observe" input$petand and will automatically re-execute when input$pet changes, and then update the checkbox group).
For example :
a<-rep(c("cat","dog","bird"),each=5)
b<-letters[1:length(a)]
c<-data.frame("pet"=a,"level"=b)
runApp(list(
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
selectInput("pet", "Select a pet", choices = levels(c$pet), selected = levels(c$pet)[1]),
tags$hr(),
checkboxGroupInput('levels', 'Levels', choices = c$level[c$pet == levels(c$pet)[1]])
),
mainPanel()
),
server = function(input, output, session) {
observe({
pet <- input$pet
updateCheckboxGroupInput(session, "levels", choices = c$level[c$pet == pet])
})
}
))
Related
I'm using observe() to change a value of a selectInput after a user selects TRUE/FALSE in the Categorical drop down list. In the first tab of my program if you set Categorical to TRUE then Impute gets updated to mode and mean otherwise. I'm then able to change the Impute value as desired without it reverting to the value that appears when TRUE/FALSE is selected.
In the second tab I have a multiple selectInput list with a similar interface as the first tab; the interface is created for every value selected in Select covariates. In this section I also used observe() to update each selected covariates' Impute drop down list accordingly to the logic of the first tab (i.e. if TRUE is selected then Impute gets updated to mode and mean otherwise). However, the value in Impute appers to be locked in the sense that I'm not able to switch between values as I did in the first tab.
I don't know how to correct this issue and I was wondering if anyone out there has encountered this similar problem and has been able to fix it. Any advice or help would be greatly appreciated.
The code to my app can be seen below and can be ran in a single file.
library(shiny)
library(shinyjs)
ui <- shinyUI(fluidPage(
shinyjs::useShinyjs(),
navbarPage("Test",id="navbarPage",
tabPanel("First tab", id = "first_tab",
sidebarLayout(
sidebarPanel(
selectInput('covariate.L.categorical', 'Categorical', c("",TRUE,FALSE)),
selectInput('covariate.L.impute', "Impute", c("","default","mean","mode","median"))
),
mainPanel()
)
),
tabPanel("Second tab", id = "second_tab",
sidebarLayout(
sidebarPanel(
selectInput('covariates', 'Select covariates', choices = c("age","sex","race","bmi"), multiple=TRUE, selectize=TRUE),
tags$hr(),
uiOutput("covariateop")
),
mainPanel()
)
))
))
server <- shinyServer(function(input, output, session) {
rv <- reactiveValues(cov.selected = NULL)
observe({
updateSelectInput(session, "covariate.L.impute", selected = ifelse(input$covariate.L.categorical,"mode","mean"))
})
output$covariateop <- renderUI({
lapply(input$covariates, function(x){
tags$div(id = paste0("extra_criteria_for_", x),
h4(x),
selectInput(paste0(x,"_categorical"), "Categorical",
choices = c("",TRUE,FALSE)),
selectInput(paste0(x,"_impute"), "Impute",
choices = c("","default","mean","mode","median")),
textInput(paste0(x,"_impute_default_level"), "Impute default level"),
tags$hr()
)
})
})
observe({
lapply(input$covariates, function(x){
updateSelectInput(session, paste0(x,"_impute"), selected = ifelse(as.logical(reactiveValuesToList(input)[[paste0(x,"_categorical")]])==TRUE,"mode","mean"))
})
})
})
# Run the application
shinyApp(ui = ui, server = server)
In your observe in the second tab, you use reactiveValuesToList(input)[[paste0(x,"_categorical")]]. This means that this observe is reactive to any changes in any input element, so also if you change the "Imputation" input. You can just use input[[paste0(x,"_categorical")]] instead to get rid of this behaviour.
Note that the implementation of dynamic UI with lapply leads to the deletion and anew rendering of already existing input selections when an additional variable is selected. Maybe you can have a look at insertUI/removeUI to get a bit nicer UI.
I would need to re-use in multiple tabs of my UI an input provided in the first tab by the user.
It seems that it is not possible to do this using renderUI in the server and calling its outputs using uiOutput in my different tabs. Here is a reproducible code
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "xyz", label = "abc", value = "abc")),
tabPanel("b", uiOutput("v.xyz"))
,tabPanel("b", uiOutput("v.xyz"))
)
),
mainPanel())
server <- function(input,output){
output$v.xyz <- renderUI({
input$xyz
})
}
runApp(list(ui=ui,server=server))
Is there another way to achieve this ?
Many thanks in advance for any suggestion.
You can't (shouldn't) have two elements with the same ID in an HTML document (whether using Shiny or not). Certainly when using Shiny having multiple elements with the same ID will be problematic. I would also subjectively vote that you could substantially improve your code by using meaningful variable names.
It's also not really clear what you want to do with this input. Do you want the input box to be displayed on multiple tabs? Or the value of the textInput to be shown on multiple tabs?
If the former, there's not an obvious way to do that, in my mind, without violating the "multiple elements with the same ID" clause. The latter would be much easier (just use a renderText and send it to a verbatimOutput), but I don't think that's what you're asking.
So what you really want is multiple text inputs (with distinct IDs) that are synchronized. That you can do in separate observers on your server using something like this:
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
INITIAL_VAL <- "Initial text"
server <- function(input,output, session){
# Track the current value of the textInputs. Otherwise, we'll pick up that
# the text inputs are initially empty and will start setting the other to be
# empty too, rather than setting the initial value we wanted.
cur_val <- ""
observe({
# This observer depends on text1 and updates text2 with any changes
if (cur_val != input$text1){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text2", NULL, input$text1)
cur_val <<- input$text1
}
})
observe({
# This observer depends on text2 and updates text1 with any changes
if (cur_val != input$text2){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text1", NULL, input$text2)
cur_val <<- input$text2
}
})
# Define the initial state of the text boxes
updateTextInput(session, "text1", NULL, INITIAL_VAL)
updateTextInput(session, "text2", NULL, INITIAL_VAL)
}
runApp(list(ui=ui,server=server))
There's probably a cleaner way to set the initial state than the cur_val I'm tracking. But I couldn't think of something off the top of my head, so there it is.
The example from Jeff Allen works only if you keep both ui and server functions in the same file. As soon as you split them into a ui.R and server.R file you will get an error complaining about the input value not existing:
Warning: Unhandled error in observer: argument is of length zero
There is an event handler available in Shiny that solves all that. It also makes it possible to handle many input widgets, as it becomes easier to extend the code to observe multiple input widget. Thanks to Jeff's example I found the following solution:
ui.R
pageWithSidebar(
headerPanel("Minimal Event Handler example"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
server.R
function(input,output, session){
# Observe the current value of the textInputs with the Shiny Event Handler.
observeEvent(input$text1, function(){
# Observe changes in input$text1, and change text2 on event
updateTextInput(session, "text2", NULL, input$text1)
})
observeEvent(input$text2, function(){
# Observe changes in input$text2, and change text1 on event
updateTextInput(session, "text1", NULL, input$text2)
})
}
Note that ignoreNULL=TRUE by default, so this will not fail on startup.
Following up on FvD's answer, if you happen to be using uiOutput and renderUI to create UI elements, it seems that shiny does not create those elements until the appropriate tabPanel is selected, which can cause his solution to fail at the outset. (Once a user has cycled through all tabPanels with UI elements you wish to sync, everything works fine, because all UI elements have been created).
To get around this, I created a reactive variable to store the input value selected or created by the user. Then, when another tabPanel with a synched UI element is selected for the first time, the UI element is rendered with the value of this reactive variable.
As an example, I have selectInput elements on multiple panels I wish to be synched, and the choices of these elements is created when the app loads (based on whatever is present in file structure):
ui <- navbarPage("Title",
navbarMenu("Set of tabs",
tabPanel("tab1",
wellPanel(
uiOutput("selectorBin1")
)
),
tabPanel("tab2",
wellPanel(
uiOutput("selectorBin2")
)
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues()
rv$selection <- " "
getChoices <- function() {
choices <- list.dirs(getwd())
return(choices)
}
output$selectorBin1 <- renderUI({
selectInput("selector1",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
output$selectorBin2 <- renderUI({
selectInput("selector2",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector1, {
rv$selection <- input$selector1 # In case this is the first tab loaded
updateSelectInput(session,
"selector2",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector2, {
rv$selection <- input$selector2 # In case this is the first tab loaded
updateSelectInput(session,
"selector1",
choices=getChoices(),
selected=rv$selection)
})
}
shinyApp(ui = ui, server = server)
I would need to re-use in multiple tabs of my UI an input provided in the first tab by the user.
It seems that it is not possible to do this using renderUI in the server and calling its outputs using uiOutput in my different tabs. Here is a reproducible code
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "xyz", label = "abc", value = "abc")),
tabPanel("b", uiOutput("v.xyz"))
,tabPanel("b", uiOutput("v.xyz"))
)
),
mainPanel())
server <- function(input,output){
output$v.xyz <- renderUI({
input$xyz
})
}
runApp(list(ui=ui,server=server))
Is there another way to achieve this ?
Many thanks in advance for any suggestion.
You can't (shouldn't) have two elements with the same ID in an HTML document (whether using Shiny or not). Certainly when using Shiny having multiple elements with the same ID will be problematic. I would also subjectively vote that you could substantially improve your code by using meaningful variable names.
It's also not really clear what you want to do with this input. Do you want the input box to be displayed on multiple tabs? Or the value of the textInput to be shown on multiple tabs?
If the former, there's not an obvious way to do that, in my mind, without violating the "multiple elements with the same ID" clause. The latter would be much easier (just use a renderText and send it to a verbatimOutput), but I don't think that's what you're asking.
So what you really want is multiple text inputs (with distinct IDs) that are synchronized. That you can do in separate observers on your server using something like this:
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
INITIAL_VAL <- "Initial text"
server <- function(input,output, session){
# Track the current value of the textInputs. Otherwise, we'll pick up that
# the text inputs are initially empty and will start setting the other to be
# empty too, rather than setting the initial value we wanted.
cur_val <- ""
observe({
# This observer depends on text1 and updates text2 with any changes
if (cur_val != input$text1){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text2", NULL, input$text1)
cur_val <<- input$text1
}
})
observe({
# This observer depends on text2 and updates text1 with any changes
if (cur_val != input$text2){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text1", NULL, input$text2)
cur_val <<- input$text2
}
})
# Define the initial state of the text boxes
updateTextInput(session, "text1", NULL, INITIAL_VAL)
updateTextInput(session, "text2", NULL, INITIAL_VAL)
}
runApp(list(ui=ui,server=server))
There's probably a cleaner way to set the initial state than the cur_val I'm tracking. But I couldn't think of something off the top of my head, so there it is.
The example from Jeff Allen works only if you keep both ui and server functions in the same file. As soon as you split them into a ui.R and server.R file you will get an error complaining about the input value not existing:
Warning: Unhandled error in observer: argument is of length zero
There is an event handler available in Shiny that solves all that. It also makes it possible to handle many input widgets, as it becomes easier to extend the code to observe multiple input widget. Thanks to Jeff's example I found the following solution:
ui.R
pageWithSidebar(
headerPanel("Minimal Event Handler example"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
server.R
function(input,output, session){
# Observe the current value of the textInputs with the Shiny Event Handler.
observeEvent(input$text1, function(){
# Observe changes in input$text1, and change text2 on event
updateTextInput(session, "text2", NULL, input$text1)
})
observeEvent(input$text2, function(){
# Observe changes in input$text2, and change text1 on event
updateTextInput(session, "text1", NULL, input$text2)
})
}
Note that ignoreNULL=TRUE by default, so this will not fail on startup.
Following up on FvD's answer, if you happen to be using uiOutput and renderUI to create UI elements, it seems that shiny does not create those elements until the appropriate tabPanel is selected, which can cause his solution to fail at the outset. (Once a user has cycled through all tabPanels with UI elements you wish to sync, everything works fine, because all UI elements have been created).
To get around this, I created a reactive variable to store the input value selected or created by the user. Then, when another tabPanel with a synched UI element is selected for the first time, the UI element is rendered with the value of this reactive variable.
As an example, I have selectInput elements on multiple panels I wish to be synched, and the choices of these elements is created when the app loads (based on whatever is present in file structure):
ui <- navbarPage("Title",
navbarMenu("Set of tabs",
tabPanel("tab1",
wellPanel(
uiOutput("selectorBin1")
)
),
tabPanel("tab2",
wellPanel(
uiOutput("selectorBin2")
)
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues()
rv$selection <- " "
getChoices <- function() {
choices <- list.dirs(getwd())
return(choices)
}
output$selectorBin1 <- renderUI({
selectInput("selector1",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
output$selectorBin2 <- renderUI({
selectInput("selector2",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector1, {
rv$selection <- input$selector1 # In case this is the first tab loaded
updateSelectInput(session,
"selector2",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector2, {
rv$selection <- input$selector2 # In case this is the first tab loaded
updateSelectInput(session,
"selector1",
choices=getChoices(),
selected=rv$selection)
})
}
shinyApp(ui = ui, server = server)
I am facing a problem with submitButton usage in my Shiny application (which I use as some time-consuming rendering is done with the data supplied by the app-user). I also use some radioButtons with conditionalPanel to define the variables group of which user may choose the parameters. Please see the attached image to get the idea (user is selecting a list type, and - based on his list choice - a particular list appears (conditionalPanel is working) from which the user is selecting a parameter), or run a reprodicible example supplied below.
Of course, only the parameter is a value that is using in rendering an output, and I would like to force a submitButton to pass only the parameter in an automatic way. The problem is that submitButton affects also the radioButtons element, which unables the use to choose the desired value (as the values list are not switching).
QUESTION: Is there any way to define which UI elements are to be stop-from-automatic-update by submitButton so as to solve my problem? Thank you for any help!
UI:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Problem with submit button"),
sidebarPanel(
radioButtons("selectionway", "Choose list type", c(number='number', letter='letter')),
conditionalPanel(
condition = "input.selectionway == 'number'",
selectInput("numberlist", "Choose NUMBER:", choices = c("11111", "22222", "33333"))
),
conditionalPanel(
condition = "input.selectionway == 'letter'",
selectInput("letterlist", "Choose LETTER:", choices = c("A", "B", "C"))
),
submitButton("submitButton")
),
mainPanel(
verbatimTextOutput("list"),
verbatimTextOutput("value")
)
))
SERVER:
library(shiny)
shinyServer(function(input, output) {
selected.value <- reactive({
if(input$selectionway=="letter"){
return(input$letterlist)
} else {
return(input$numberlist)
}
})
output$list <- renderText({
input$selectionway
})
output$value <- renderText({
selected.value()
})
})
This maybe a general question and I will try my best to describe it explicitly. In R Shiny and the ui.R file, I use radioButtons to select one of the two methods:
radioButtons("Methods", strong("Choose a Method:"),
choices = list("method_1" = "m1",
"method_2" = "m2"),
selected="method_1"),
selectInput("method_2_ID", strong("Choose an ID (method_2"),
topIDs)
mainPanel(
tabsetPanel(
tabPanel(title = "method_1_tab1",
plotOutput("plots"),
tabPanel(title = "method_2_output1",
tableOutput("m2_output1")),
tabPanel(title = "method_2_output2",
verbatimTextOutput("m2_output2")))
))
You can see for method_2, I plan to use two different tabs to show different results, i.e. m2_output1 and m2_output2. In my server.R file, I use:
if (input$Methods == "method_2") {
# m2_output1
updateTabsetPanel(session, "method_2_output1", selected="panel2")
# drop-down menu
SelectedID = reactive(function(){
input$method_2_ID
})
# m2_output1
output$m2_output1 = renderTable({
m2[m2$ID == input$method_2_ID, ]
})
# m2_output2
updateTabsetPanel(session, "method_2_output2", selected="panel3")
[...]
output$m2_output2 = renderPrint({
[...]
}
})
However, it works only for the method_2_output1 tab when I click the ID from the drop-down menu, and when I click the method_2_ouptut2 tab, there is nothing displayed (should display verbatimTextOutput("m2_output2)", I think). Is there anything wrong with my ui.R or server.R files?
There were quite a few changes needed to get the tabs to do what you wanted.
Some of the bigger changes were:
You have to create the tabsetPanel and the tabPanels with the id arguments, so that they can be referenced.
For updateTabsetPanel to work, you have to wrap those commands inside a reactive observer using:
observe ( {
#updateTabsetPanel here
})
Called ShinyServer with a sessions argument
I made several other changes. Below is a fully working framework. When you select Method 1, it selects Tab1. If you choose Method 2, if switches between the second and the third tab, depending on the Method ID chosen.
UI.R
library("shiny")
shinyUI(pageWithSidebar(
headerPanel("Tab Switch Demo"),
sidebarPanel(
h4('Switch Tabs Based on Methods'),
radioButtons(inputId="method", label="Choose a Method",
choices = list("method_1",
"method_2")),
conditionalPanel("input.method== 'method_2' ",
selectInput("method_2_ID", strong("Choose an ID for method 2"),
choices = list("method_2_1",
"method_2_2"))
)
),
mainPanel(
tabsetPanel(id ="methodtabs",
tabPanel(title = "First Method Plot", value="panel1",
plotOutput("method_1_tab1")),
tabPanel(title = "method_2_output1", value="panel2",
tableOutput("m2_output1")),
tabPanel(title = "method_2_output2", value="panel3",
verbatimTextOutput("m2_output2"))
)
)
))
Server.R
library('shiny')
shinyServer(function(input, output, session) {
output$method_1_tab1 = renderPlot({
plot(cars)
})
output$m2_output1 = renderText({
"First Tab for Method 2, ID=1"
})
output$m2_output2 = renderText({
"Second Tab for Method 2, ID=2"
})
observe({
if (input$method == "method_1") {
updateTabsetPanel(session, inputId="methodtabs", selected="panel1")
}
else if (input$method_2_ID == "method_2_1") {
updateTabsetPanel(session, inputId="methodtabs", selected="panel2")
}
else if (input$method_2_ID == "method_2_2") {
updateTabsetPanel(session, inputId="methodtabs", selected="panel3")
}
})
Use the code above as the starting point, and start making changes.
Hope that helps you get going.