What I'm trying to do is create an arbitrary number of action button, each of which has their own event based on their own individual values.
Let's say we want to create a number of buttons. What we do is draw a random number between 1 and 100 and call it n. Then we create n buttons, each with a value between 1 and n (covering every number once). Then, when we press one of those buttons, we render a text message being the number that we pressed.
To set up the buttons, we have:
ui.R
shinyUI(fluidPage(
actionButton('roll','roll'),
uiOutput('buttons')
))
Server.R
shinyServer(function(input, output) {
n <- eventReactive(input$roll, {
num <- sample(1:100,1)
sample(1:num, num, replace=FALSE)
})
output$buttons <- renderUI({
lapply(1:length(n()), function(i) {
actionButton(as.character(n()[i]), as.character(n()[i]) )
})
})
})
This generates the buttons. However, I'm struggling to find a way to create all the necessary eventReactive()s. I tried calling eventReactive() inside a loop, and in a lapply call. However, in order to make that loop or lapply, you need the value of length(n()), which can only be called inside another reactive or observe command.
Given the buttons generated from the above script, how do we make a reactive expression for each button, and then output the text corresponding to the number pressed?
You can search through the input looking for buttons that have been triggered. Once a button is clicked, its value is greater than 0, so all the picked values will print this way (not sure if that is desired?)
library(shiny)
shinyApp(
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton('roll','roll'),
uiOutput('buttons')
),
mainPanel(
textOutput('stuff')
)
)
)),
shinyServer(function(input, output) {
n <- eventReactive(input$roll, {
num <- sample(1:100,1)
sample(1:num, num, replace=FALSE)
})
output$buttons <- renderUI({
lapply(1:length(n()), function(i) {
actionButton(as.character(n()[i]), as.character(n()[i]) )
})
})
output$stuff <- renderText({
val <- which(lapply(paste(n()), function(i) input[[i]]) == TRUE)
if (length(val))
sprintf("Picked %s!", paste(n())[val])
})
})
)
Related
In the code posted at the bottom, I'm trying to cap the value of the second reactive object (y) at the value of the first reactive object (x) using two observeEvents() as action button click counters, as explained in the illustration below. The illustration shows the results of clicking the "Pos" button 3 times and the "Neg" button 4 times. How would this be done?
I commented-out one of my attempts in the below code.
Illustration:
Code:
library(shiny)
ui <- fluidPage(br(),
actionButton("Btn1", "Pos"),
actionButton("Btn2", "Neg"),
br(),br(),
textOutput("posClicks"),
textOutput("negClicks"),
textOutput("netClicks")
)
server <- function(input, output, session) {
x = reactiveVal(0)
y = reactiveVal(0)
observeEvent(input$Btn1,{x(x()+1)})
observeEvent(input$Btn2,{y(y()+1)})
# below is commented-out because it gives strange results counting in leaps of 2's
# observeEvent(input$Btn2,{
# if(x()-y(y()+1) >= 0){y(y()+1)}
# })
output$posClicks <- renderText({paste('Pos clicks =',x())})
output$negClicks <- renderText({paste('Neg clicks =',y())})
output$netClicks <- renderText({paste('Net clicks =',x()-y())})
}
shinyApp(ui, server)
If you really need to have two separate observes, you could do
observeEvent(input$Btn1,{x(x()+1)})
observeEvent(input$Btn2,{y(y()+1)})
observe({
if (y()>x()) {y(x())}
})
Rather than listening for clicks on the button, you just observe the value of y() and if it gets bigger than x(), just reset it. If you can, it would be easier just to change the Btn2 logic
observeEvent(input$Btn1,{x(x()+1)})
observeEvent(input$Btn2,{y(min(y()+1, x()))})
In the shiny application multiple numeric input widgets are generated dynamically each having an initial value inside which are row-column numbers. The sum of those values are also displayed in main panel.
As the user changes the numeric input values the sum updates accordingly. Currently it is instantly. I want to delay the process of inputs in main panel for all numeric inputs by adding action/submit button till I change more than one numeric Inputs.
But I am getting the following error if action/submit buttons are used inside the render functions.
Warning: Error in <<-: number of items to replace is not a multiple of replacement length.
If not inside render functions where else to place as these widgets are generated inside renderUI only.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel(title = "Use of action/submit button for multiple inputs"),
sidebarLayout(
sidebarPanel(numericInput("rows","Input No. of rows",value = 3,min=1),
br(),
numericInput("col","Input No. of cols",value = 1,min=1)),
mainPanel(textOutput("display"),
uiOutput("plo")
))))
Server.r
server <- function(input,output){
# creating input widgets dynamically
output$plo <- renderUI({
z <- input$col
lapply(seq(input$col), function(j){
column(width=3,
lapply(seq(input$rows),function(i){
numericInput(inputId = paste0("range",paste0(i,j)),label = j,value = paste0(i,j))
})
)
})
})
# capturing the value of input widgets in a matrix
cm <- reactive({
c <- input$col
r <- input$rows
changed_m <- matrix(nrow = r,ncol = c)
lapply(seq(input$col), function(j){
lapply(seq(input$rows),function(i){
changed_m[i,j] <<- input[[paste0("range",paste0(i,j))]]
})
})
changed_m
})
# display the sum
output$display <- renderText({
paste0("Sum of matrix: ",sum(cm()))
})
}
Here is a working example of a possible solution. You can store the string to display (or just the sum of course) in a reactiveVal, and update this only when the user clicks the button, or display an alternative text when one of the inputs has changed so the user knows the sum is no longer correct.
Hope this helps!
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel(title = "Use of action/submit button for multiple inputs"),
sidebarLayout(
sidebarPanel(numericInput("rows","Input No. of rows",value = 3,min=1),
br(),
numericInput("col","Input No. of cols",value = 1,min=1),
actionButton('update' ,'update!')),
mainPanel(textOutput("display"),
uiOutput("plo")
))))
server <- function(input,output){
# creating input widgets dynamically
output$plo <- renderUI({
z <- input$col
lapply(seq(input$col), function(j){
column(width=3,
lapply(seq(input$rows),function(i){
numericInput(inputId = paste0("range",paste0(i,j)),label = j,value = paste0(i,j))
})
)
})
})
# capturing the value of input widgets in a matrix
cm <- reactive({
c <- input$col
r <- input$rows
changed_m <- matrix(nrow = r,ncol = c)
lapply(seq(input$col), function(j){
lapply(seq(input$rows),function(i){
x=input[[paste0("range",paste0(i,j))]]
changed_m[i,j] <<- ifelse(!is.null(x),x,0)
})
})
changed_m
})
# initialize our reactiveVal with an empty string
my_sum <- reactiveVal('')
# observer that listens to the button click, then updates the sum string.
observeEvent(input$update,{
my_sum(paste0("Sum of matrix: ",sum(cm())))
})
# observer that listens to changes in the input, then updates the sum string.
observeEvent(cm(),ignoreNULL = T,ignoreInit = T, {
isolate(my_sum('invalidated. Press button to update.'))
})
# display the sum string
output$display <- renderText({
my_sum()
})
}
shinyApp(ui,server)
I want to create a dynamic UI in Shiny, where each time a button is clicked, a new UI element is created with several input fields. I was hoping that I could do this using reactiveValues, however the ui code can't access them, so I can't tell it how many elements to show.
Here's a reproducible example with just a single UI field created on each click - it works for the first two clicks of the button, but since the lapply in the ui section is coded to a fixed value (3 in this example), after that the new ones stop being displayed. I know I could set the ui value at a higher number, but what I'd like is for it to be reactive. (In the full version I'd like to have nested elements within each of these that work the same way, and buttons to remove each field as well.)
server <- function(input, output) {
rv <- reactiveValues(numFields = 1)
#
# start with one input box
#
output$textUI1 <- renderUI(textInput("textInput1", "Input #1"))
#
# each time the button is clicked, increase the reactive value
#
observeEvent(input$addField, rv$numFields <- rv$numFields + 1)
#
# render any additional UI input fields according to value of rv$numFields
#
observe({
if(rv$numFields > 1)
{
lapply(2:rv$numFields, function(i) {
output[[paste0("textUI", i)]] <- renderUI({
textInput(paste0("textInput", i), paste0("Input #", i))
})
})
}
})
}
ui <- fluidPage(sidebarLayout(
sidebarPanel(
actionButton("addField", "Add text input box")
),
mainPanel(
# UI output
lapply(1:3, function(i) { # instead of 3 I want something like rv$numFields here
uiOutput(paste0("textUI", i))
})
)
))
shinyApp(ui, server)
Instead of passing the variable from server to ui why don't you create the whole dynamic ui inside your server. Something like this:
library (shiny)
server <- function(input, output) {
rv <- reactiveValues(numFields = 1)
#
# start with one input box
#
output$textUI <- renderUI(textInput("textInput1", "Input #1"))
#
# each time the button is clicked, increase the reactive value and add a new text input
observeEvent(input$addField,{
rv$numFields <- rv$numFields + 1
output$textUI <- renderUI({
lapply(1:rv$numFields, function(i) {textInput(paste0("textInput", i), paste0("Input #", i))
})
})
})
}
ui <- fluidPage(sidebarLayout(
sidebarPanel(
actionButton("addField", "Add text input box")
),
mainPanel(
uiOutput("textUI")
)
))
shinyApp(ui, server)
I'm new to shiny and trying to accomplish rather a simple task using an action button:
User clicks a button and a function is called
This function does some calculations using input variables and updates/creates several global variables (reactiveValues, probably inside an observe block?)
I'd like to display those values back on the UI (using render* function)
Whenever user changes input values, the UI is automatically updated
Relevant code bits are:
server.R
...
rv <- reactiveValues()
observe({
if(input$run){
rv$a <- someFunc(input$aa)
}
})
output$msg = renderText({ rv$a })
...
ui.R
...
selectInput("aa", ...)
...
actionButton("run", "Run")
...
textOutput("msg")
How can I change msg based on the input aa each time user clicks the button?
I am not convinced I understood what you want, but I imagine it to be something like this:
library(shiny)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(
sliderInput("vv", "Choose a value",min=-3.14,max=3.14,value=0),
selectInput("aa", "Choose a function", choices=c("sin","cos","exp")),
actionButton("run", "Change Function and Run")
),
mainPanel(
h2("Results"),
verbatimTextOutput("msg")
)))
s <- function(input,output){
rv <- reactiveValues(func=NULL)
observeEvent(input$run,{ rv$func <- input$aa })
funcval <- reactive({
v <- 0
if (rv$func=="sin") v <- sin(input$vv)
if (rv$func=="cos") v <- cos(input$vv)
if (rv$func=="exp") v <- exp(input$vv)
v
})
output$msg = renderPrint({
if (is.null(rv$func)) return("not running")
fv <- funcval()
sprintf("%s(%.3f)=%.3f",rv$func,input$vv,fv)
})
}
shinyApp(ui=u,server=s)
Yielding this:
Note that the slider input value formats its current value rather badly when the min and max values are not even. Not sure what one can do about this.
In my below example, once run in RStudio, by clicking on the "play" button on the slider, the number of rows displaced gradually increases. But by pausing, and then changing the data set name to iris, then clicking the button "Show" and re-clicking "play", the same animated increase in number of rows does not occur...why? and how do i adjust my code to do so...i.e. let the animation occur with a different data set?
The example below is partially adapted from the eventReactive() function
require(shiny)
if (interactive()) {
ui <- fluidPage(
column(4,
sliderInput('x',label='Num Rows',min=2,max=30,step=1,value=3,animate = TRUE),
textInput('tbl_nm',label='Data Set',value='cars'),
br(),
actionButton("button", "Show")
),
column(8, tableOutput("table"))
)
server <- function(input, output) {
# reactively adjust the number of rows
ll <- eventReactive(input$x,{
input$x
})
# change the data sets after clicking the button
dat <- eventReactive(input$button,{
if(input$tbl_nm=='cars'){
dat <- cars
} else {
dat <- get(input$tbl_nm)
}
return(dat)
})
# Take a reactive dependency on input$button, but
# not on any of the stuff inside the function
df <- eventReactive(input$button, {
yy <- ll()
# choose only the relevant data...
head(dat(),yy)
})
# show the final table
output$table <- renderTable({
if(input$button==0){
# show the first few lines of cars at the begining
head(cars, ll())
} else {
# show the selected data
df()
}
})
}
shinyApp(ui=ui, server=server)
}
The reason this is happening is:
output$table <- renderTable({
if(input$button==0){
# show the first few lines of cars at the begining
head(cars, ll())
} else {
# show the selected data
df()
}
})
Every time a button is pressed, its value (input$button) increments by one. It is only 0 when the app opens. Therefore,
head(cars, ll()) only runs before the button is pressed the first time. Afterwards, input$button increments and its value is 2, 3, 4, ... etc.
ll() is an event reactive that depends on input$x (your slider). Therefore, when your slider updates, or when the play sign is pressed, ll() updates, and your table redisplays.
For every time after the first press, df() runs instead. This is an event reactive that depends on input$button - it only runs when the button is pressed. Your table is prevented from updating until the button is pressed.
To fix this, you can use:
df <- eventReactive(input$button | input$x, {
yy <- ll()
# choose only the relevant data...
head(dat(),yy)
})
as your df() instead. It will now update if the button is pressed or if the slider updates