I'd like to generate a dynamic number of actionButtons, and then have each generated button print its number to the console. This is my best attempt so far, but I still can't get the observeEvent for each of the first 10 buttons to recognize the button clicks. How do I tie the buttons to an observeEvent?
library(shiny)
ui <- basicPage(
fluidRow(
actionButton(inputId = "add_button",
label = "Add Button")
),
uiOutput("more_buttons")
)
server <- function(input, output){
rvs <- reactiveValues(buttons = list(actionButton(inputId = "button1",
label = 1)))
observeEvent(eventExpr = input$add_button,
handlerExpr = {
len <- length(rvs$buttons) + 1
rvs$buttons[[len]] <- actionButton(inputId = paste0("button",len),
label = len)
})
output$more_buttons <- renderUI({
do.call(fluidRow, rvs$buttons)
})
# This is the part that doesn't work
for(ii in 1:10){
observeEvent(eventExpr = input[[paste0("button",ii)]],
handlerExpr = print(ii))
}
}
shinyApp(ui, server)
Your really close, just wrap the observeEvent part in local.
library(shiny)
ui <- basicPage(
fluidRow(
actionButton(inputId = "add_button",
label = "Add Button")
),
uiOutput("more_buttons")
)
server <- function(input, output){
rvs <- reactiveValues(buttons = list(actionButton(inputId = "button1",
label = 1)))
observeEvent(eventExpr = input$add_button,
handlerExpr = {
len <- length(rvs$buttons) + 1
rvs$buttons[[len]] <- actionButton(inputId = paste0("button",len),
label = len)
})
output$more_buttons <- renderUI({
do.call(fluidRow, rvs$buttons)
})
observeEvent(rvs$buttons,{
for(ii in 1:length(rvs$buttons)){
local({
i <- ii
observeEvent(eventExpr = input[[paste0("button",i)]],
handlerExpr = {print(sprintf("You clicked btn number %d",i))})
})
}
})
}
shinyApp(ui, server)
Let the inputIds of the buttons to follow a pattern like "button1", "button2", "button3", use regex to isolate those inputIds from the 'input' object in the observeEvent trigger, and convert the result to a list:
observeEvent(
lapply(
names(input)[grep("button[0-9]+",names(input))],
function(name){
input[[name]]
}
),
{
code to run when any button with inputId matching the regex is pressed
}
)
Related
I'm creating a shiny module, where I wish to display some pop-up messages to the user via shinyalerts and include dropdown menus via htlm = TRUE and shinyWidgets::pickerInput. For each shinyalert the options should be different and the alerts should appear right after each other when the user has selected the relevant option.
However, when running the shinyalerts within a for loop, only the first alert shows the drop-down, the following does not. Please have a look at the example below and screenshots. Any ideas what I'm doing wrong?
Module UI:
mod_match_columns_ui <- function(id){
ns <- NS(id)
tagList(
shinyalert::useShinyalert(),
actionButton(ns("run"), label = "Start!")
)
}
Module server:
mod_match_columns_server <- function(input, output, session){
ns <- session$ns
options <- list(c("option_1","option_2"),
c("option_3","option_4"))
observeEvent(input$run, {
for(col in 1:2){
nms <- options[[i]]
output[[paste0("dropdown",col)]] <- renderUI({
shinyWidgets::pickerInput(
inputId = ns(paste0("options",col)),
label = "Options listed below",
choices = nms,
selected = "",
multiple = FALSE,
options = shinyWidgets::pickerOptions(size = 15)
)
})
shinyalert::shinyalert(
title = "Pick an option!",
html = TRUE,
text = tagList(
uiOutput(ns(paste0("dropdown", col)))
),
inputId = ns(paste0("modal", col))
)
}
})
}
Run module:
library(shiny)
ui <- fluidPage(
mod_match_columns_ui("match_columns_ui_1")
)
server <- function(input, output, session) {
callModule(mod_match_columns_server, "match_columns_ui_1")
}
shinyApp(ui = ui, server = server)
First iteration:
Second iteration:
Why is the dropdown not shown in the second iteration?? Thanks
Try this
library(shiny)
library(shinyalert)
mod_match_columns_ui <- function(id){
ns <- NS(id)
tagList(
shinyalert::useShinyalert(),
actionButton(ns("run"), label = "Start!")
)
}
mod_match_columns_server <- function(id) {
moduleServer(id,
function(input, output, session) {
ns <- session$ns
options <- list(c("option_1","option_2"),
c("option_3","option_4"))
lapply(1:2, function(col){
output[[paste0("dropdown",col)]] <- renderUI({
shinyWidgets::pickerInput(
inputId = ns(paste0("options",col)),
label = paste("Options",col,"listed below"),
choices = options[[col]],
selected = "",
multiple = FALSE,
options = shinyWidgets::pickerOptions(size = 15)
)
})
})
observeEvent(input$run, {
shinyalert::shinyalert(
title = "Pick an option!",
html = TRUE,
text = tagList(
lapply(1:2, function(i){uiOutput(ns(paste0("dropdown",i)))})
)
# callbackR = function(x) { message("Hello ", x) },
# inputId = ns(paste0("modal"))
)
})
observe({
print(input$options1)
print(input$options2)
print(input$shinyalert)
})
})
}
ui <- fluidPage(
tagList(
mod_match_columns_ui("match_columns_ui_1")
)
)
server <- function(input, output, session) {
mod_match_columns_server("match_columns_ui_1")
}
shinyApp(ui = ui, server = server)
I want to add the input text to a vector in a Shiny app every time a button is clicked. This is the example I'm working with:
library(shiny)
ui <- fluidPage(
textInput(inputId = "inquiry", label = "enter text"),
actionButton(inputId = "searchButton", label = "Run"),
verbatimTextOutput("queryList", placeholder = FALSE)
)
server <- function(input, output, session) {
queryList <- c()
observeEvent(input$searchButton, {
queryList[length(queryList)+1] <- input$inquiry
output$queryList <- renderPrint({
queryList
})
})
}
shinyApp(ui = ui, server = server)
So if "item1" is entered and the button is clicked, then "item2" is entered and the button is clicked again, queryList should look like c("item1", "item2"), but it seems to just be replacing "item1" with "item2". I'm sure I'm missing something very simple...queryList[length(queryList)+1] looks a little strange, but it works in a non-reactive environment.
Making queryList reactive fixed it for me:
library(shiny)
ui <- fluidPage(
textInput(inputId = "inquiry", label = "enter text"),
actionButton(inputId = "searchButton", label = "Run"),
verbatimTextOutput("queryList", placeholder = FALSE)
)
server <- function(input, output, session) {
queryList <- reactiveValues()
queryList$values <- c()
observeEvent(input$searchButton, {
queryList$values[length(queryList$values) + 1] <- input$inquiry
})
output$queryList <- renderPrint({
if (!is.null(queryList$values)) {
queryList$values
}
})
}
shinyApp(ui = ui, server = server)
I want to dynamically populate a table and update a list of items selected using the checkbox.
Here is my attempt. I report some random data points into a table and uncheck some of them expecting the list at the bottom of the plot to change.
The list is correctly updated only when unchecking the last item but not the others.
Any suggestions?
library(shiny)
library(DT)
ui <- fluidPage(
fluidRow(
column(4,
plotOutput("plot1", click = "plot_click"),
textInput("collection_txt",label="Foo")),
column(4,
DT::dataTableOutput("table"))
)
)
server <- function(input, output,session) {
# collect data points
x <- reactiveValues(selected = '')
y <- reactiveValues(selected = '')
observeEvent(input$plot_click, {
x$x <- c(x$x,input$plot_click$x)
y$y <- c(y$y,input$plot_click$y)
})
output$plot1 <- renderPlot({
plot(1,1, type='n')
points(x$x,y$y)
})
# populate the table
shinyInput <- function(FUN,id,num,...) {
inputs <- character(num)
for (i in seq_len(num)) {
inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
}
inputs
}
output$table = DT::renderDataTable({
tab <- data.frame('x'=x$x ,'y'=y$y)
DT::datatable(cbind(tab, Selected=shinyInput(checkboxInput,"srows_",nrow(tab),value=TRUE,width=1)),
options = list(orderClasses = TRUE,
drawCallback= JS(
'function(settings) {
Shiny.bindAll(this.api().table().node());}'),
dom = 't', searching=FALSE),
selection='none',escape=F)
})
# show the list of selected items
rowSelect <- reactive({
rows=names(input)[grepl(pattern = "srows_",names(input))]
paste(unlist(lapply(rows,function(i){
if(input[[i]]==T){
return(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
}
})))
})
observe({
updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Selected:" )
})
}
shinyApp(ui, server)
You have to unbind the previously created Shiny objects before creating the new table, when you click on a point. For example with shinyjs:
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
......
observeEvent(input$plot_click, {
runjs("Shiny.unbindAll($('#table').find('table').DataTable().table().node());")
x$x <- c(x$x,input$plot_click$x)
y$y <- c(y$y,input$plot_click$y)
})
I want to have a set of two action buttons in Shiny where the inputID and number of duplicates is based off the number of rows in a data.frame. Attached below is my thought process that isn't currently functioning correct. Instead of adding a button whenever a button is pressed, I want "n" sets of buttons equal to the number of rows in a data.frame.
library(shiny)
ui <- basicPage(
fluidRow(
actionButton(inputId = "add_button",
label = "Add Button")
),
uiOutput("more_buttons")
)
server <- function(input, output){
rvs <- reactiveValues(buttons = list(actionButton(inputId = "button1",
label = 1)))
observeEvent(eventExpr = input$add_button,
handlerExpr = {
len <- length(rvs$buttons) + 1
rvs$buttons[[len]] <- actionButton(inputId = paste0("button",len),
label = len)
})
output$more_buttons <- renderUI({
do.call(fluidRow, rvs$buttons)
})
observeEvent(rvs$buttons,{
for(ii in 1:length(rvs$buttons)){
local({
i <- ii
observeEvent(eventExpr = input[[paste0("button",i)]],
handlerExpr = {print(sprintf("You clicked btn number %d",i))})
})
}
})
}
shinyApp(ui, server)
Here is a simplified version of what you want to accomplish
ui <- fluidPage(
selectInput("df", "choose a dataframe",
c("mtcars", "mpg")),
uiOutput("buttons")
)
server = function(input, output, session){
reactiveFrame = reactive({
if(input$df == "mtcars")
return(mtcars)
return(ggplot2::mpg)
})
nrowR = reactive({
nrow(reactiveFrame())
})
m <- 0
output$buttons = renderUI({
m <- m+1
do.call(
fluidPage,
lapply(
1:nrowR(),
function(i)
span(
actionButton(paste0("a", i, "-", m),paste0("a", i)),
actionButton(paste0("b", i, "-", m),paste0("b", i))
)
)
)
})
}
shinyApp(ui,server)
I want to retrieve the list of inputs in the current shiny session.
We can retrieve the list of inputs using names(input).
I have a uiOutput and based on different conditions I am rendering different types inputs. The current problem I am facing is that when the condition changes the inputs from previous renderUI is also present in the list. Is there a way to get only the inputs in the current session?
To explain my query better I have the following sample code:
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "slider",label = "", min = 1, max = 3, value = 1),
uiOutput("UI"),
actionButton(inputId = "btn", label = "Show Inputs"),
verbatimTextOutput(outputId = "textOp")
)
server <- function(input, output){
observeEvent(input$slider,{
if(input$slider == 1){
output$UI <- renderUI(
textInput("txt1",label = "Slider in position 1")
)
}else if(input$slider == 2){
output$UI <- renderUI(
textInput("txt2",label = "Slider in position 2")
)
}else{
output$UI <- renderUI(
textInput("txt3",label = "Slider in position 3")
)
}
})
observeEvent(input$btn,{
output$textOp <- renderText(
paste0(names(input), ",")
)
})
}
shinyApp(ui = ui, server = server)
In the above code when I first click on action button labelled "Show Input" I get the following text as the output:
btn, slider, txt1,
Now when I move the slider to 2 my output is as follows:
btn, slider, txt1, txt2,
Here txt1 was generated when the slider was at position 1, and this renderUI was overridden by output$UI <- renderUI(textInput("txt2",label = "Slider in position 2")). I want an input list where txt1 is not there. Is there a way to do that?
I came up with kind of a workaround, assuming you dont have any inputs that should take a value of NULL. You could set the values of the inputs, that you wish to remove, to NULL and filter for non - NULLs when you display the names.
library(shiny)
ui <- fluidPage(
tags$script("
Shiny.addCustomMessageHandler('resetValue', function(variableName) {
Shiny.onInputChange(variableName, null);
});
"
),
sliderInput(inputId = "slider",label = "", min = 1, max = 3, value = 1),
uiOutput("UI"),
actionButton(inputId = "btn", label = "Show Inputs"),
verbatimTextOutput(outputId = "textOp")
)
server <- function(input, output, session){
observeEvent(input$slider,{
for(nr in 1:3){
if(nr != input$slider) session$sendCustomMessage(type = "resetValue", message = paste0("txt", nr))
}
})
output$UI <- renderUI(
textInput(paste0("txt", input$slider), label = paste0("Slider in position ", input$slider))
)
global <- reactiveValues()
observe({
inp = c()
for(name in names(input)){
if(!is.null(input[[name]])){
inp <- c(inp, name)
}
}
isolate(global$inputs <- inp)
})
output$textOp <- renderText({
global$inputs
})
}
shinyApp(ui = ui, server = server)