I have a R Shiny app that contains checkboxGroupInput, and I'm trying to create a "select all" button, using updateCheckboxGroupInput function.
You can see the full code below, but basically I defined the cb groups like this:
checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list)
and then, on a button click, call the function:
updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list)
I have an indication that the function ran, but what it does is actually UNselecting the checkboxes.
BTW, when I put the selected upon defining the cbGroupInput it did worked, but not on the function.
Thanks!
this is my server.R:
library(shiny)
source('usefulFunctions.R')
shinyServer(function(input, output, session) {
output$cascading <- renderUI({
provider_id <- input$provider
if (provider_id == "") return(NULL)
campaigns_list <<- t(getCampaigns(provider_id))
tagList(
checkboxGroupInput("campaigns","Choose campaign(s):",
choices = campaigns_list, selected = campaigns_list),
actionLink("selectall","Select All")
)
})
observe({
if(is.null(input$selectall)) return(NULL)
if (input$selectall > 0)
{
print(campaigns_list)
updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list)
}
})
})
I also added the select and unselect options here by checking if the button or link are divisible by 2
#rm(list = ls())
library(shiny)
campaigns_list <- letters[1:10]
ui =fluidPage(
checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list),
actionLink("selectall","Select All")
)
server = function(input, output, session) {
observe({
if(input$selectall == 0) return(NULL)
else if (input$selectall%%2 == 0)
{
updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list)
}
else
{
updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list)
}
})
}
runApp(list(ui = ui, server = server))
If campaigns_list is a list, might be because you are specifying the list of all your choices instead of the value of the boxes that should be selected in the selected argument of your updateCheckboxGroupInput.
Try replacing selected=campaigns_list by selected=unlist(campaigns_list).
Here is an example with dummy names:
library(shiny)
server<-function(input, output,session) {
observe({
if(input$selectall == 0) return(NULL)
else if (input$selectall > 0)
{
variables<-list("Cylinders" = "cyl","Transmission" = "am","Gears" = "gear")
updateCheckboxGroupInput(session,"variable","Variable:",choices=variables,selected=unlist(variables))
}
})
}
ui <- shinyUI(fluidPage(
checkboxGroupInput("variable", "Variable:",list("Cylinders" = "cyl","Transmission" = "am","Gears" = "gear")),
actionButton("selectall", "Select All")
))
shinyApp(ui = ui, server = server)
Related
In the following example, duplicate input elements seem to be created, although output$app is re-rendered with every login/logout.
library(shiny)
user <- reactiveValues(logged_on = 0)
ui <- fluidPage(
uiOutput("app")
)
server <- function(input, output) {
observe({
if (user$logged_on == 1) {
output$app <- renderUI({
list(
uiOutput("container1"),
uiOutput("container2")
)
})
output$container1 <- renderUI({
actionButton("logout", "Logout")
})
output$container2 <- renderUI({
actionButton("clickme", "Click Me")
})
observeEvent(input$clickme, {
print("got clicked!")
})
observeEvent(input$logout, ignoreInit = TRUE, {
user$logged_on <- 0
})
} else {
output$app <- renderUI({
actionButton("login", "Login")
})
observeEvent(input$login, ignoreInit = TRUE, {
user$logged_on <- 1
})
}
})
}
shinyApp(ui, server)
Clicking Login followed by Click Me prompts got clicked! once. However, after repeating the process by Logout>Login>Click Me prompts the message twice, and so on.
Examining this problem using...
x <- reactiveValuesToList(input)
print(x)
...confirms that duplicates of the input elements are created. Why does this happen and how do i prevent it?
I think it's because you have observeEvents within your observe. This isn't necessary and I've edited your code and now the duplicates seem to have been removed. (Also the ignoreInits were unnecessary here.)
library(shiny)
user <- reactiveValues(logged_on = 0)
ui <- fluidPage(
uiOutput("app")
)
server <- function(input, output) {
observe({
if (user$logged_on == 1) {
output$app <- renderUI({
list(
uiOutput("container1"),
uiOutput("container2")
)
})
output$container1 <- renderUI({
actionButton("logout", "Logout")
})
output$container2 <- renderUI({
actionButton("clickme", "Click Me")
})
} else {
output$app <- renderUI({
actionButton("login", "Login")
})
}
})
observeEvent(input$clickme, {
print("got clicked!")
})
observeEvent(input$logout, {
user$logged_on <- 0
})
observeEvent(input$login, {
user$logged_on <- 1
})
}
shinyApp(ui, server)
So I've found that nesting observeEvent() within each other, registers new observers and that caused the problem. A better example than my previous one is:
library(shiny)
ui <- fluidPage(
actionButton("clicks", "Click"),
actionButton("more_clicks", "Print")
)
server <- function(input, output) {
observeEvent(input$clicks,{
observeEvent(input$more_clicks, {
print("Hello") # you can see these piling up in the console when switching buttons
})
})
}
shinyApp(ui, server)
My guess is that this should be avoided when possible, although observeEvent()'s can be nested if the child observer is destroyed after it has gotten triggered. This can be accomplished by the argument observeEvent(eventExpr, handlerExpr, once = TRUE).
I have created a large number of data tables using mapply, however, I need to access the data tables in a following step. R assigns random IDs to these tables if the user does not specify the IDs. Here is an example of what I would like to do:
library(shiny)
ui <- fluidPage(
h2("Last clicked:"),
verbatimTextOutput("last_clicked"),
actionButton("reset", "Reset clicked value"),
h2("Datatable:"),
DT::dataTableOutput("dt")
)
server <- function(input, output) {
# the last clicke value
output$last_clicked <- renderPrint({
str(last())
})
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2), elementId = "DT_Test")
})
observeEvent(input$dt_cell_clicked, {
validate(need(length(input$dt_cell_clicked) > 0, ''))
print("You clicked something!")
})
myProxy = DT::dataTableProxy('dt')
last = reactiveVal(NULL)
observe({
last(input$dt_cell_clicked)
})
observeEvent(input$reset, {
DT::selectRows(myProxy, NULL)
last(NULL)
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2))
})
})
}
shinyApp(ui, server)
If I look at the html, the elementID did not change to what I wanted, in fact, R gives the warning:
Warning in origRenderFunc() :
Ignoring explicitly provided widget ID "DT_Test"; Shiny doesn't use them
Even after the call, still not sure what you are trying to do.
But if you have a list of datatables and you want to access them, it works rather well like this:
library(shiny)
library(purrr)
ui <- fluidPage(
h2("Last clicked:"),
verbatimTextOutput("last_clicked"),
h2("elementId values"),
verbatimTextOutput("elementId_values"),
actionButton("reset", "Reset clicked value"),
h2("Datatable:"),
DT::dataTableOutput("dt")
)
server <- function(input, output) {
# the last clicke value
output$last_clicked <- renderPrint({
str(last())
})
table <- DT::datatable(head(mtcars, 2), elementId = "DT_Test")
table2 <- DT::datatable(tail(mtcars, 1), elementId = "DT_Test2")
list_of_data_tables <- list(table, table2)
element_ids <- purrr::map(list_of_data_tables, "elementId")
output$elementId_values <- renderPrint({
element_ids
})
output$dt <- DT::renderDataTable({
list_of_data_tables[[which(element_ids == "DT_Test2")]]
})
observeEvent(input$dt_cell_clicked, {
validate(need(length(input$dt_cell_clicked) > 0, ''))
print("You clicked something!")
})
myProxy = DT::dataTableProxy('dt')
last = reactiveVal(NULL)
observe({
last(input$dt_cell_clicked)
})
observeEvent(input$reset, {
DT::selectRows(myProxy, NULL)
last(NULL)
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2))
})
})
}
shinyApp(ui, server)
I have 4 action buttons...but want same return value name. Since it is used in other elements. I initialize the reactive element as
myReactiveDF <- reactiveValues(data=NULL)
myReactiveDF <- eventReactive(input$action1, {
call functions
return(dataframe)
})
myReactiveDF <- eventReactive(input$action2, {
call functions
return(dataframe)
})
.....
However only the last button 4 works. The first three do not.
All the other elements use the same reactive element (dataframe) to get populated.
I tried observeEvent but it doesn't return values.
The following code should address your requirement as I understand them:
library(shiny)
ui <- fluidPage(
fluidRow(column(2, selectInput('action1', label = "Action1:", choices = c('a','b') )),
column(4, selectInput('action2', label = "Action2:", choices = c('A','B') ))),
fluidRow( verbatimTextOutput("outputs"))
)
server = function(input, output, session){
v <- reactiveValues(data = NULL)
observeEvent(input$action1, {
v$data <- input$action1
})
observeEvent(input$action2, {
v$data <- input$action2
})
output$outputs <- renderText({
if (is.null(v$data)) return()
v$data
})
}
shinyApp(ui = ui, server = server)
If what you need is different, please let me know so that I can amend the answer.
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)
Is it possible to capture the label of an actionButton once it is clicked?
Imagine I have 3 buttons on my ui.R and depending on which one I click I want to perform a different action on the server.R.
One caveat is that the buttons are created dynamically on the server.R with dynamic labels (thus the necessity of capturing the label on click)
Thanks
Something like that ?
library(shiny)
server <- function(input, session, output) {
output$printLabel <- renderPrint({input$btnLabel})
}
ui <- fluidPage(
actionButton("btn1", "Label1",
onclick = "Shiny.setInputValue('btnLabel', this.innerText);"),
actionButton("btn2", "Label2",
onclick = "Shiny.setInputValue('btnLabel', this.innerText);"),
verbatimTextOutput("printLabel")
)
shinyApp(ui = ui, server = server)
1) What button was clicked last by the user?
To answer this you can user observeEvent function and by setting up a a variable using reactiveValues function. Make sure you update your libraries and work in the latest version of R (version 3.1.3) as shiny is dependant on this version. Working on windows you can follow example on how to update here
rm(list = ls())
library(shiny)
ui =fluidPage(
sidebarPanel(
textInput("sample1", "Name1", value = "A"),
textInput("sample2", "Name2", value = "B"),
textInput("sample3", "Name3", value = "C"),
div(style="display:inline-block",uiOutput("my_button1")),
div(style="display:inline-block",uiOutput("my_button2")),
div(style="display:inline-block",uiOutput("my_button3"))),
mainPanel(textOutput("text1"))
)
server = function(input, output, session){
output$my_button1 <- renderUI({actionButton("action1", label = input$sample1)})
output$my_button2 <- renderUI({actionButton("action2", label = input$sample2)})
output$my_button3 <- renderUI({actionButton("action3", label = input$sample3)})
my_clicks <- reactiveValues(data = NULL)
observeEvent(input$action1, {
my_clicks$data <- input$sample1
})
observeEvent(input$action2, {
my_clicks$data <- input$sample2
})
observeEvent(input$action3, {
my_clicks$data <- input$sample3
})
output$text1 <- renderText({
if (is.null(my_clicks$data)) return()
my_clicks$data
})
}
runApp(list(ui = ui, server = server))
2) Save the clicks for further manipulation is below
Here's small example based on the work of jdharrison from Shiny UI: Save the Changes in the Inputs and the shinyStorage package.
rm(list = ls())
#devtools::install_github("johndharrison/shinyStorage")
library(shinyStorage)
library(shiny)
my_clicks <- NULL
ui =fluidPage(
#
addSS(),
sidebarPanel(
textInput("sample_text", "test", value = "0"),
uiOutput("my_button")),
mainPanel(uiOutput("text1"))
)
server = function(input, output, session){
ss <- shinyStore(session = session)
output$my_button <- renderUI({
actionButton("action", label = input$sample_text)
})
observe({
if(!is.null(input$sample_text)){
if(input$sample_text != ""){
ss$set("myVar", input$sample_text)
}
}
})
output$text1 <- renderUI({
input$action
myVar <- ss$get("myVar")
if(is.null(myVar)){
textInput("text1", "You button Name")
}else{
textInput("text1", "You button Name", myVar)
}
})
}
runApp(list(ui = ui, server = server))