I'm trying to build an step by step app using Shiny. My aim is creating an examen consisting in a bunch of questions written in a database. What I need is a "next" button which when you click another question shows up.
I've been triying with an "action button" but it just works the first time, that is, the first time that it is clicked a question shows up, but it becomes unclickable once clicked for first time (it doesn't work as a "next button" as I wish).
Here is the code:
Server.R:
library(xlsx)
data<-read.xlsx("data/base.xlsx",sheetName="Full1")
shinyServer(function(input, output) {
data[,2]<-as.character(data[,2])
question<-data[2,2]
ntext <- eventReactive(input$goButton, {
question
})
output$nText <- renderText({
ntext()
})
})
ui.R:
shinyUI(pageWithSidebar(
headerPanel("Exam"),
sidebarPanel(
actionButton("goButton", "Next"),
p("Next Question")
),
mainPanel(
verbatimTextOutput("nText")
)
))
Thank you so much.
You can do something like this. Please note the comments in the code
rm(list = ls())
library(shiny)
questions <- c("What is your name?","Can you code in R?","Do you find coding fun?","Last Question:How old are you?")
ui <- pageWithSidebar(
headerPanel("Exam"),
sidebarPanel(actionButton("goButton", "Next"),p("Next Question")),
mainPanel(verbatimTextOutput("nText")))
server <- function(input, output,session) {
# Inititating reactive values, these will `reset` for each session
# These are just for counting purposes so we can step through the questions
values <- reactiveValues()
values$count <- 1
# Reactive expression will only be executed when the button is clicked
ntext <- eventReactive(input$goButton,{
# Check if the counter `values$count` are not equal to the length of your questions
# if not then increment quesions by 1 and return that question
# Note that initially the button hasn't been pressed yet so the `ntext()` will not be executed
if(values$count != length(questions)){
values$count <- values$count + 1
return(questions[values$count])
}
else{
# otherwise just return the last quesion
return(questions[length(questions)])
}
})
output$nText <- renderText({
# The `if` statement below is to test if the botton has been clicked or not for the first time,
# recall that the button works as a counter, everytime it is clicked it gets incremented by 1
# The initial value is set to 0 so we just going to return the first question if it hasnt been clicked
if(input$goButton == 0){
return(questions[1])
}
ntext()
})
}
shinyApp(ui = ui, server = server)
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()))})
I have been trying to create a Shiny UI that changes depending on the stage of data processing, but I can't figure out why my conditional panels don't pop up, and why even my text output for debugging doesn't show a value in the UI.
In this small example, I want to be able to show a panel after pressing a button, and then another one after pressing the second button. If the user presses the first button again, the second panel should disappear.
library(shiny)
ui <- fluidPage(
p("value of stage is:"),
textOutput("stage"),
actionButton("button1", "Show only the first panel"),
conditionalPanel("output.stage == 'first' || output.stage == 'second'",
p("First panel."),
actionButton("button2", "Also show the second panel")),
conditionalPanel("output.stage == 'second'",
p("Second panel."))
)
server <- function(input, output) {
stage <- reactive({"initial"})
stage <- eventReactive(input$button1, {"first"})
stage <- eventReactive(input$button2, {"second"})
output$stage <- renderText({stage()})
# make stage always available to UI
outputOptions(output, "stage", suspendWhenHidden = FALSE)
}
shinyApp(ui = ui, server = server)
I also tried using observeEvent() but that didn't help.
Edit: I am not directly using the input.button* values in my conditions because in my use case, the stage value also depends on other things happening on the server.
EDIT for better explanation :
You are defining stage too many times. The only one counting is the last one :
stage <- eventReactive(input$button2, {"second"})
At this point, stage is only that, so it never triggers.
Here is what you are searching for :
library(shiny)
ui <- fluidPage(
p("value of stage is:"),
textOutput("stage"),
actionButton("button1", "Show only the first panel"),
conditionalPanel("output.stage == 'first' || output.stage == 'second'",
p("First panel."),
actionButton("button2", "Also show the second panel")),
conditionalPanel("output.stage == 'second'",
p("Second panel.")),
textOutput("stage_dependant")
)
server <- function(input, output) {
button1_triggered <- reactiveVal(F)
button2_triggered <- reactiveVal(F)
observeEvent(input$button1,{
button1_triggered(!button1_triggered()) ## assigning a new value to button1_triggered : its contrary
})
observeEvent(input$button2,{
button2_triggered(!button2_triggered()) ## Invert the boolean
})
stage <- reactive({
if(!button1_triggered() & !button2_triggered()){
"intial"
} else if(button1_triggered() & !button2_triggered()){
"first"
} else if(!button1_triggered() & button2_triggered()){
"second anyways ?"
} else {
"second"
}
})
output$stage <- renderText({stage()})
# make stage always available to UI
outputOptions(output, "stage", suspendWhenHidden = FALSE)
stage_dependant <- reactive({
paste("This is a stage dependant reactive :",stage())
})
output$stage_dependant <- renderText(stage_dependant())
}
shinyApp(ui = ui, server = server)
You can search for more elegant ways to define stage but with this you should understand the principle.
Also note that the use of checkboxInput seems to be more appropriate for this functionnality.
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
I am constructing an animated graph project using R Studio's Shiny. Currently the "Go !" button initiates the animation. I would like to have the "Reset" button re-initialize the variables and re-run the animation, but since Shiny does not allow within-code changes to the input$button values, I am stuck on how to do this. The real project is similar in form to the sample blocks below, but much more involved. Animation is integral to the information being conveyed. When the project is completed, I intend to deploy it on the Shiny server, so I would like users to be able to re-run the animation with different selections without having to re-open the link.
# ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
headerPanel("Cost Explorer"),
sidebarPanel(
actionButton("goButton", "Go!"),
actionButton("reset", "Reset"),
sliderInput("myvar", label=h6("Variability of cost"),
min=0, max=50, value=10)
),
mainPanel(
plotOutput(outputId="tsplot")
)
))
# server.R
library(shiny)
shinyServer(function(input, output, session) {
# initialize reactive values
ts <- reactiveValues(cost=rep(NA,100), year=(2010:2109), counter=1)
output$tsplot <- renderPlot({
plot(ts$year, ts$cost, xlim=c(2010,2110), ylim=c(-200,200), xlab="Year",
ylab="Cost (US Dollars)", type="l", main="Forecasted Cost Time series")
})
observe({
isolate({
if (ts$counter==1){
ts$cost[ts$counter]=50 #initial cost
}
if (ts$counter > 1){
ts$cost[ts$counter]=ts$cost[ts$counter-1]+rnorm(1,0,input$myvar)
}
ts$counter=ts$counter+1
})
if (((isolate(ts$counter) < 100)) & (input$goButton > 0)){
invalidateLater(200, session)
}
if (input$reset > 0){
# How do I add reset functionality?
}
})
})
Based on your app it was quicker to add another observe and reset the counter to 1 using the global assignment operator <<-. Also I changed the plot so it is plots indexed variables. Have a look at similar problem people had, here. NB: In some of my apps I also have the pause button when a user presses the start button twice, you can achieve this by checking if the button index is divisible by two or not since every time the button is clicked it increments by one.
I was further looking into your app, make sure you are garbage collecting unreferenced observers, as you might run out of memory (look at the memory profile via Task manager). Look into this example here, alternately you can set-up a log-off functionality per session where the client will be logged off after n amount of minutes.
rm(list = ls())
library(shiny)
ui <- (fluidPage(
# Application title
headerPanel("Cost Explorer"),
sidebarPanel(
actionButton("goButton", "Go!"),
actionButton("reset", "Reset"),
sliderInput("myvar", label=h6("Variability of cost"),min=0, max=50, value=10)
),
mainPanel(plotOutput(outputId="tsplot"))
))
server <- (function(input, output, session) {
# initialize reactive values
ts <- reactiveValues(cost=rep(NA,100), year=(2010:2109), counter=1)
output$tsplot <- renderPlot({
plot(ts$year[1:ts$counter], ts$cost[1:ts$counter], xlim=c(2010,2110), ylim=c(-200,200), xlab="Year",
ylab="Cost (US Dollars)", type="l", main="Forecasted Cost Time series")
})
observe({
isolate({
if (ts$counter==1){
ts$cost[ts$counter]=50 #initial cost
}
if (ts$counter > 1){
ts$cost[ts$counter]=ts$cost[ts$counter-1]+rnorm(1,0,input$myvar)
}
ts$counter=ts$counter+1
})
if (((isolate(ts$counter) < 100)) & (input$goButton > 0)){
invalidateLater(200, session)
}
})
observe({
if (input$reset > 0){
ts$counter <<- 1
}
})
})
runApp(list(ui = ui, server = server))
I have a shinyTable in a shiny app. It is editable, but because of a submitButton elsewhere in the app the edits are not saved until the button is pressed. If more than one change is made and the button is pressed only the last change is saved.
My question is how can I get it to save all the changes that have been made ?
Perhaps there is a way that I can get at the contents of the whole table in the UI so I can workaround ?
Or would I be better off using shinysky or something else ?
Below is a reproducible example based on an example from the package. You'll see that if you make 2 changes to the upper table and then press the button only the 2nd change gets copied to the lower table.
library(shiny)
library(shinyTable)
server <- function(input, output, session) {
rv <- reactiveValues(cachedTbl = NULL)
output$tbl <- renderHtable({
if (is.null(input$tbl)){
#fill table with 0
tbl <- matrix(0, nrow=3, ncol=3)
rv$cachedTbl <<- tbl
print(tbl)
return(tbl)
} else{
rv$cachedTbl <<- input$tbl
print(input$tbl)
return(input$tbl)
}
})
output$tblNonEdit <- renderTable({
rv$cachedTbl
})
}
ui <- shinyUI(pageWithSidebar(
headerPanel("Simple Shiny Table!"),
sidebarPanel(
helpText(HTML("A simple editable matrix with an update button.
Shows that only most recent change is saved.
<p>Created using shinyTable."))
),
# Show the simple table
mainPanel(
#editable table
htable("tbl"),
#update button
submitButton("apply table edits"),
#to show saved edits
tableOutput("tblNonEdit")
)
))
shinyApp(ui = ui, server = server)
Thanks for your time.
Andy
Following advice from Joe Cheng at RStudio on a related question, it appears that submitButton is not advised and can cause pain.
Switching to actionButton and isolate was relatively straightforward in this simple example and in my application.
Solution below.
library(shiny)
library(shinyTable)
server <- function(input, output, session) {
rv <- reactiveValues(cachedTbl = NULL)
output$tbl <- renderHtable({
if (is.null(input$tbl)){
#fill table with 0
tbl <- matrix(0, nrow=3, ncol=3)
rv$cachedTbl <<- tbl
return(tbl)
} else{
rv$cachedTbl <<- input$tbl
return(input$tbl)
}
})
output$tblNonEdit <- renderTable({
#add dependence on button
input$actionButtonID
#isolate the cached table so it only responds when the button is pressed
isolate({
rv$cachedTbl
})
})
}
ui <- shinyUI(pageWithSidebar(
headerPanel("shinyTable with actionButton to apply changes"),
sidebarPanel(
helpText(HTML("A simple editable matrix with a functioning update button.
Using actionButton not submitButton.
Make changes to the upper table, press the button and they will appear in the lower.
<p>Created using shinyTable."))
),
# Show the simple table
mainPanel(
#editable table
htable("tbl"),
#update button
actionButton("actionButtonID","apply table edits"),
#to show saved edits
tableOutput("tblNonEdit")
)
))
shinyApp(ui = ui, server = server)