EDIT: My original question asked about checkboxInput(), but I've updated to checkboxGroupInput() to better reflect my problem...
I am trying to get my Shiny app to do one of two things based on the (un)checked status of a checkboxGroupInput.
When the boxes are checked, I can get my code to work. However, I can't figure out how to make unchecking all boxes lead to a unique result.
How do I do this?
This google groups question asked this 4+ years ago, but the response then was that this is simply a bug. I'm assuming this has been addressed since??
Below is a reproducible example.
- In this example, unchecking the box leads to an error reading "Error in if: argument is of length zero."
library(shiny)
ui <- fluidPage(
checkboxGroupInput(inputId = "test.check", label = "", choices = "Uncheck For 2", selected = "Uncheck For 2"),
verbatimTextOutput(outputId = "test")
)
server <- function(input, output) {
output$test <- renderPrint({
if(input$test.check == "Uncheck For 2") {
1
} else {
2
}
})
}
shinyApp(ui = ui, server = server)
Is there perhaps an "if.unchecked" type of function I can use?
I've tried is.null after the else statement with the same result as the above example....
Here's code that works:
library(shiny)
ui <- fluidPage(
checkboxGroupInput(inputId="test.check", label="", choices="Uncheck For 2", selected="Uncheck For 2"),
verbatimTextOutput(outputId = "test")
)
server <- function(input, output) {
output$test <- renderPrint({
if(!is.null(input$test.check)) {
1
} else{
2
}
})
}
shinyApp(ui = ui, server = server)
Related
Here's my app displaying a greeting with names and showing the number of letters of the name.
I would like to change the name and rv$len on one single click, but I need to click twice to get the rv$len changed to 4. Is there anything I can do to first update the name to pikapika, then manually change rv$len to 4 with a single click?
Thanks in advance!
library(shiny)
ui <- fluidPage(
titlePanel("Thanks in advance for your help"),
sidebarLayout(
sidebarPanel(
textInput("name", "name of the user", value = "TEST"),
actionButton(inputId = "Example", label = "pikapika as an example"),
),
mainPanel(
verbatimTextOutput("greetings")
)
)
)
server <- function(input, output) {
name <- reactive(input$name)
rv <- reactiveValues(len = 4)
# by default it reads the number of characters
observe({
rv$len <- nchar(name())
})
greeting <- reactive(paste("Hello", name(), "! Your name has", rv$len, "letters."))
output$greetings <- renderPrint(greeting())
# I would like to illustrate with a custom case
observeEvent(input$Example, {
updateTextInput(inputId = "name", value = "pikapika")
rv$len <- 4
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thanks from Pikachu
I am having trouble getting Rshiny to do what I want.
I would like the user to select an input from the SelectInput choices and based on that input I would like some Text output that is mathematical notation.
I have tried to implement this with withMathJax(), but I cannot seem to get the code right.
Here is some toy code illustrating what I have already:
######################################
ui <-navbarPage(title = "test",
helpText("Here we select which parameters we want to include in our model"),
selectInput("torchp",
label = h4("Torching Parameters"),
choices = list("One parameter",
"Two parameters" ),
selected = 1),
mainPanel(
textOutput("torchvalue")
)
)
server <- function(input, output) {
withMathJax()
torchp_input <- reactive({
switch(input$torchp,
"One parameter" = '$$q$$',
"Two parameters" = '$$q_m, q_f$$'
)
})
output$torchvalue <- renderText({
paste("You have selected", torchp_input())
})
}
shinyApp(ui = ui, server = server)
###################################
The output I get does not recognise my mathematical notation.
Thanks.
Discovered an answer thanks to help in the comments by #Limey.
The issue was which rendering function I used.
In this instance you should use uiOutput and renderUI as follows:
In the UI put:
uiOutput("torchvalue")
In the server use:
output$torchvalue <- renderUI({ p( withMathJax("you have selected", torchp_input())) })
Some days ago I was answered in this post. The solution was perfect in that moment, but I realised that I forgot to ask how I can do that with more than 1 checkboxInput. Since... I have tried a lot of things and that solution doesn't fit me with 2 checkboxInput. Maybe it can be done with the same solution changing some things, but, as I am new using shiny, I cannot find a way to do it.
The difference between the code from the previous post and this one, is that I have added a conditionalPanel and two checkboxInputs instead of 1.
Since the condition here is that if the user selects the condition (play), I thought that the solution was writing eventReactive(input$play,{}). However, none of the checkboxInputs work.
On the other hand, if you write eventReactive(input$change_log2,{}) one of the checkboxInputs (the logaritm) works. But if you select the other (srqt) it won't do nothing.
I have seen that an alternative way could be using observe or observeEvent but I cannot save the results in a variable, so... I need eventReactive...
I am a bit lost.
Someone could help me? Eventually I will add more checkboxInputs... so I need a way which I could use more than 2 checkboxInputs.
Here it is the code:
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
uiOutput("selected_sample_one"),
uiOutput("selected_sample_two"),
checkboxInput("play", strong("I want to play my data"), value = FALSE),
conditionalPanel(
condition = "input.play == 1",
checkboxInput("change_log2", "Log2 transformation", value = FALSE),
checkboxInput("run_sqrt", "sqrt option", value = FALSE))
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("plot")
)
)
)
# Define server
server <- function(input, output,session) {
data <- reactive({
numbers <- c(5,345,55,10)
df<-data.frame(t(numbers))
names(df) <- c("S1", "S2", "S3", "S4")
return(df)
})
data1 <- eventReactive(input$play,{
df <- data()
if(input$change_log2 == TRUE){
df <- log2(df)
}
if(input$run_sqrt == TRUE){
df <- sqrt(df)
}
return(df)
})
samples_names <- reactive({
req(data())
samples <- colnames(data())
return(samples)
})
output$selected_sample_one <- renderUI({
selectizeInput(inputId = "sample_one_axis", "Select the 1st sample", choices=samples_names(), options=list(maxOptions = length(samples_names())))
})
# With this function you can select which sample do you want to plot in the y-axis.
output$selected_sample_two <- renderUI({
selectizeInput(inputId = "sample_two_axis", "Select the 2nd sample", choices=samples_names(), selected=samples_names()[2], options=list(maxOptions = length(samples_names())))
})
output$plot <- renderPlot({
req(input$sample_one_axis,input$sample_two_axis,data1())
barplot(c(data1()[,input$sample_one_axis], data1()[,input$sample_two_axis]))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thanks very much in advance,
Regards
You can simply wrap the relvant inputs in c().
Here's a MWE:
library(shiny)
ui <- fluidPage(
checkboxInput("check1", "Checkbox 1"),
checkboxInput("check2", "Checkbox 2"),
textOutput("text")
)
server <- function(input, output, session) {
v <- reactiveValues(text="Waiting...")
observeEvent(c(input$check1, input$check2), {
s <- "Checked: "
if (input$check1) {
s <- paste(s, "1")
}
if (input$check2) {
s <- paste(s, "2")
}
v$text <- s
},
ignoreInit=TRUE
)
output$text <- renderText({
v$text
})
}
shinyApp(ui, server)
Alternatively, you could perhaps wrap what you need to do in a function and then just call the function in a series of observeEvents, one for each relevant input.
[I started writing before you updated your post.]
Thanks to #Limey, the solution for my problem was to replace data1 <- eventReactive with data1 <- reactive.
Thanks very much.
i'd like to reuse an input field in a tabbed shiny app. my code is below.
library(shiny)
ui <- navbarPage("Iris data browser",
tabPanel("Panel 1",
selectInput("species", "Species",
unique(iris$Species)),
sliderInput("sepal.length", "Sepal length",
4.3,7.9,4.5,.1),
tableOutput("table1")),
tabPanel("Panel 2",
selectInput("species", "Species",
unique(iris$Species)),
tableOutput("table2")))
server <- function(input, output) {
output$table1 <- renderTable({
iris[iris$Species == input$species & iris$Sepal.Length <= input$sepal.length,c("Sepal.Length","Sepal.Width")]
})
output$table2 <- renderTable({
iris[iris$Species == input$species,c("Petal.Length","Petal.Width")]
})
}
# Run the application
shinyApp(ui = ui, server = server)
i'd like to use the same selectInput() on both panels. the expected result is that when i change the input value in "Panel 1" it will take on the same value in "Panel 2" and vice versa. of course, the filtering should also be applied to the tables on both panels. additionally, the input for species is shared on both panels, but the slider for sepal length should only appear on panel 1. therefore, sidebarLayout() is no solution.
thanks!
Here is a solution that uses 2 selectInputs but links them so that they have the same choices selected. Explanation of changes is below the code:
library(shiny)
ui <- navbarPage("Iris data browser",
tabPanel("Panel 1",
selectInput("species1", "Species", choices=unique(iris$Species)),
sliderInput("sepal.length", "Sepal length",
4.3,7.9,4.5,.1),
tableOutput("table1")),
tabPanel("Panel 2",
selectInput("species2", "Species", choices=unique(iris$Species) ),
uiOutput("select2"),
tableOutput("table2")))
server <- function(session, input, output) {
Selected<-reactiveValues(Species=NULL)
observeEvent(input$species1, Selected$Species<-(input$species1))
observeEvent(input$species2, Selected$Species<-(input$species2))
observeEvent(Selected$Species, updateSelectInput(session, "species1", selected=Selected$Species))
observeEvent(Selected$Species, updateSelectInput(session, "species2", selected=Selected$Species))
output$table1 <- renderTable({
iris[iris$Species == Selected$Species & iris$Sepal.Length <= input$sepal.length,c("Sepal.Length","Sepal.Width")]
})
output$table2 <- renderTable({
iris[iris$Species == Selected$Species ,c("Petal.Length","Petal.Width")]
})
}
# Run the application
shinyApp(ui = ui, server = server)
1) In the ui I changed the inputIds to "species1" and "species2"
2) I added the session parameter to your server function.
3) I created a reactiveValues object called Selected with an element called Species to store the currently selected species, it starts out as NULL.
4) The first two observeEvents will fire when the user chooses a species and stores that choice in Selected$Species. It does not matter which selector is used and will always have the value selected last.
5) The next two observeEvents update the two selectInputs to have the the selected choice be Selected$Species so that when you change the value in one tab it will change in the other automatically. You need to use the session argument here which is why I added it earlier.
6) I changed the tables to filter based on Selected$Species
There are a few advantages of this system. It would be easy to add more tabs with more selecteInputs and just add new observeEvent statements for them. If you have a bunch of these it might be worth you while to look into shiny modules.
Here, the tables just use Selected$Species but if you wanted to you could add more logic and they could sometimes update and sometimes not if that made sense for your app. That allows you to produce complicated behavior -for example if some values don't make sense for one of your displays you could catch that ahead of time and alert the user or display something else.
Not ideal, but this is what I meant in the comments:
library(shiny)
ui <- navbarPage("Iris data browser",
position = "fixed-top",
tabPanel("SideMenu",
sidebarPanel(
#push it down 70px to avoid going under navbar
tags$style(type="text/css", "body {padding-top: 70px;}"),
selectInput("species", "Species",
unique(iris$Species)),
conditionalPanel("input.myTabs == 'Panel 2'",
sliderInput("sepal.length", "Sepal length",
4.3,7.9,4.5,.1))
)
),
mainPanel(
tabsetPanel(id = "myTabs",
tabPanel("Panel 1",
tableOutput("table1")),
tabPanel("Panel 2",
tableOutput("table2"))
)
)
)
server <- function(input, output) {
output$table1 <- renderTable({
iris[iris$Species == input$species,c("Sepal.Length","Sepal.Width")]
})
output$table2 <- renderTable({
iris[iris$Species == input$species,c("Petal.Length","Petal.Width")]
})
}
# Run the application
shinyApp(ui = ui, server = server)
I know that similar question was already answered, however the solution creates a new actionButton with different label upon string-input. What I need is to keep the button(the counter of the button), because when I change the label and create a new button it has a counter of 0(not clicked).
So basically I need something like an update function to just change the label of the actionButton, when it is pressed. You press it once and the label changes.
input$Button <- renderUI({
if(input$Button >= 1) label <- "new label"
else label <- "old label"
actionButton("Button", label = label)
})
Something like this, but without reseting the value of the button(by creating a whole new one).
Thanks!
reactiveValues() can help. Check http://shiny.rstudio.com/articles/reactivity-overview.html for details.
In the following example, I renamed your input$Button to input$click to avoid double usage of the "Button" name.
Since we wrap the label in a renderUI(), input$click initially fires once it is created?!?, that's why I put the label
condition as: if(vars$counter >= 2)
An alternative solution could be to remove the read-only attribute (found here: https://github.com/rstudio/shiny/issues/167)
attr(input, "readonly") <- FALSE
input$click <- 1
For an example
paste the following in your R console:
ui <- bootstrapPage(
uiOutput('Button')
)
server <- function(input, output) {
# store the counter outside your input/button
vars = reactiveValues(counter = 0)
output$Button <- renderUI({
actionButton("click", label = label())
})
# increase the counter
observe({
if(!is.null(input$click)){
input$click
isolate({
vars$counter <- vars$counter + 1
})
}
})
label <- reactive({
if(!is.null(input$click)){
if(vars$counter >= 2) label <- "new label"
else label <- "old label"
}
})
}
# run the app
shinyApp(ui = ui, server = server)
You can use updateActionButton from native shiny package:
ui <- fluidPage(
actionButton('someButton', ""),
h3("Button value:"),
verbatimTextOutput("buttonValue"),
textInput("newLabel", "new Button Label:", value = "some label")
)
server <- function(input, output, session) {
output$buttonValue <- renderPrint({
input$someButton
})
observeEvent(input$newLabel, {
updateActionButton(session, "someButton", label = input$newLabel)
})
}
shinyApp(ui, server)
A few years later some small addition: If you want to switch between button icons, e.g. play / pause button (and switching between labels would be similar) you could do something like this (based on shosaco's answer).
library(shiny)
ui <- fluidPage(
fluidRow(
actionButton("PlayPause", NULL, icon = icon("play"))
)
)
server <- function(input, output, session) {
# whenever the ActionButton is clicked, 1 is added to input$PlayPause
# check if input$PlayPause is even or odd with modulo 2
# (returns the remainder of division by 2)
observeEvent(input$PlayPause, {
if (input$PlayPause %% 2 != 0) {
updateActionButton(session, "PlayPause", NULL, icon = icon("pause"))
} else {
updateActionButton(session, "PlayPause", NULL, icon = icon("play"))
}
})
}
shinyApp(ui = ui, server = server)