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.
Related
I am trying to create a shiny app where it allows you to select an input of what operation calculate. if the user chooses "Addition" it will show the two numeric input boxes (so they can input two numbers), if the user chooses "square" it will show only one numeric input box to square.
With this, I use conditionalPanel and if the condition is satisfied, it fetches through uiOutput() the numericInputs that I want. and same thing for square.
Now when I run this app, the conditional panels do not appear. Where did I go wrong? Thanks for checking out my question.
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),#sidebar panel
)#fluidpage
server <- function(input, output) {
output$basicmath <- renderText( ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation"))))),
output$var2 <- renderUI({
helpText("this will show to input two numerics to be added")
}) ,
output$var1 <- renderUI({
helpText("this will show to input one numeric to square")
})
)}
shinyApp(ui = ui, server = server)
The key issue you were having is that you put the uiOutputs inside the calculation output that you anticipated. It is better to separate them, since the calculation output won't run until it has the necessary prerequisite values (your input values). In addition, because you hadn't specified an output location for basicmath, the app didn't know where to put anything inside that call to renderText(). Below is working code that gets the right UI elements to appear.
One other thing you were missing in your renderUI was the use of tagList(). This helps ensure that all of your elements are packaged together, not just the last one.
Note that the math part does not work, but it looks like that was just a placeholder. When you do start to use it, be sure to use unique ids for each input. You have several instances of input$a and input$b, which probably isn't a workable approach.
library(shiny)
library(shinythemes)
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),
mainPanel(
textOutput("basicmath")
)
)#fluidpage
server <- function(input, output) {
output$var2 <- renderUI({
tagList(
helpText("this will show to input two numerics to be added"),
splitLayout(
numericInput("var2a", label = "Input one number", value = NULL),
numericInput("var2b", label = "Input another number", value = NULL)
)
)
})
output$var1 <- renderUI({
tagList(
helpText("this will show to input one numeric to square"),
numericInput("var1a", label = "Input a number", value = NULL)
)
})
output$basicmath <- renderText( {ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation")))))
})
}
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 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])
})
}
))
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()
})
})