In running the below code, each click of the actionButton()
is correctly counted and output to the UI (using reactive value y). I'm trying to do the same with selectInput()
(counting each time a selection is made)(using reactive value x), but it doesn't completely correctly count because when first invoking the App, selecting the default choice of "Cyl" is not included in the count (I'd like it to), and clicking the same choice more than once isn't included in the count (I'd like all clicks counted). One workaround is to include "multiple = TRUE" in the selectInput()
, but I'd like to see if there's a JS solution instead so I don't have to change the UI the way including "multiple = TRUE" does.
As an aside, using "multiple = TRUE" also corrects the weird subtraction of 1 from (x) in output$clickSelInput...
; hopefully a JS solution does the same.
Code:
library(shiny)
ui = fluidPage(hr(),
selectInput("selInput",label=NULL,c("Cyl"="cyl","Trans"="am","Gears"="gear"),selected=NULL),
actionButton("addBtn","Add"), hr(),
textOutput("clickSelInput"),
textOutput("clickAddBtn"),
tableOutput("data")
)
server = function(input, output) {
x = reactiveVal(0)
y = reactiveVal(0)
output$data <- renderTable({mtcars[1:10, c("mpg", input$selInput), drop = FALSE]})
observeEvent(input$selInput,{x(x() 1)})
observeEvent(input$addBtn,{y(y() 1)})
output$clickSelInput <- renderText({paste('Select Input clicks =',x()-1)})
output$clickAddBtn <- renderText({paste('Add Button clicks =',y())})
}
shinyApp(ui, server)
CodePudding user response:
Here is a working solution, taking SamR's suggestion into account and using that example by analogy. I had to make other changes to make it work. I commented changes below from OP.
library(shiny)
library(shinyjs) # added
ui = fluidPage(hr(),
useShinyjs(), # added, this line is easy to forget to add
uiOutput("selInput"), # added, pulls renderUI output from server into UI
actionButton("addBtn","Add"), hr(),
textOutput("clickSelInput"),
textOutput("clickAddBtn"),
tableOutput("data")
)
server = function(input, output) {
x = reactiveVal(0)
y = reactiveVal(0)
output$data <- renderTable({mtcars[1:10, c("mpg", input$selInput), drop = FALSE]})
observeEvent(input$addBtn,{y(y() 1)})
# moved select input into renderUI so it can interact with JS in the observe further down:
output$selInput <- renderUI(
selectInput("selInput",label=NULL,c("Cyl"="cyl","Trans"="am","Gears"="gear"),selected=NULL)
)
output$clickSelInput <- renderText({paste('Select Input clicks =',input$rnd)}) # changed
output$clickAddBtn <- renderText({paste('Add Button clicks =',y())})
# added js:
observe({
if(is.null(input$rnd)){
runjs("
var click = 0;
Shiny.onInputChange('rnd', click)
var selInput = document.getElementById('selInput')
selInput.onclick = function() {click = 1; Shiny.onInputChange('rnd', click)};
")
}
})
}
shinyApp(ui, server)