reset animation in Shiny R Studio - r

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))

Related

R Shiny won't output a variable using textOutput

I'm trying to write a calculator using Shiny in R for a video game (you input the stats of you and your opponent, and it outputs your odds of winning a match). However, I can't get the Shiny app to output any of my variables. The app runs fine, but nothing outputs when the action button is selected.
Trying to find the issue, I simplified my code into a basic calculator that takes a numeric input, multiplies it by two, and outputs a result. As before, nothing is displayed when the action button is pushed. However, if you directly type a string into the renderText function, it works just fine.
I need to include an action button in my ultimate code because I don't want it to calculate the result until several numerical values have been typed in. Could the action button be causing an issue somewhere, or is it something else?
Below is the simplified code. If I can get this to run, I'm sure I could get my more complicated code to run. Thank you!
library(shiny)
library(shinythemes)
ui <- fluidPage(
titlePanel("Multiply by 2"),
fluidRow(
column(12, textOutput("test"),
numericInput(inputId = "start", "Start", value = 1),
actionButton("go", "Go!") )
)
)
server <- function(input, output) {
myval <- reactiveValues()
observeEvent(input$go, {
reactive ({
if (input$go == 0)
return()
isolate({
myval$calc <- paste("The result is", 2*input$start)
})
})
})
output$test <- renderText({
if (input$go == 0)
return()
isolate({
myval$calc
})
})
}
shinyApp(ui = ui, server = server)
It looks like there is some extra code in there we don't need, for example the isolate function. See the below minimal example:
input$go doesn't tell us what the button is doing. Try running print(input$go) and have a look at the output.
library(shiny)
ui <- fluidPage(
titlePanel("Multiply by 2"),
fluidRow(
column(12,
textOutput("test"),
numericInput(inputId = "start", "Start", value = 1),
actionButton("go", "Go!")
)
)
)
server <- function(input, output) {
myval <- reactiveValues()
#Observe button (will run when the button is clicked)
observeEvent(input$go, {
myval$calc <- paste("The result is", 2 * input$start)
})
#Text output (will run when myval$calc changes)
output$test <- renderText({
myval$calc
})
}
shinyApp(ui = ui, server = server)

R Shiny stop for user input and display all plots

I have a script which I want to add to my Shiny app, and the original script can be simplified to the following:
plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed")
a <- menu(c(1:5), title="what would you like to change the first point to?")
plot(c(1:3),c(a,4,6), main ="This is second plot I want displayed")
b <- menu(c(1:5), title="what would you like to change the second point to?")
plot(c(1:3),c(a,b,6), main ="This is second plot I want displayed")
The above script plots the first plot, then waits for user input before plotting second, and waits again for user input before plotting third.
However, when I try to convert it to shiny app as seen below, it never updates the first or the second plot, and the things I've tried to make it stop for user input where shown have not worked.
I have tried using req() but it seems to stop the script entirely so the last things are not run at all, and you have to start the entire script over.
So, how can i make it display all plots in sequence, and how can I make the script stop and wait for input before continuing?
if(interactive()){
ui <- fluidPage(
actionButton("button","Click me"),
selectInput("input", "Input", c(1:10)),
textOutput("text"),
plotOutput("plot")
)
server <- function(input, output) {
a<-1
observeEvent(input$button, {
output$plot <- renderPlot(plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed"))
output$text <- renderText("Please select a number to multiply the first point with")
#This is where I want the script to wait for user input
output$plot <- renderPlot(plot(c((1),(2),(3)),c((input$input),(a),(3)), main="This is plot the second plot"))
a<-a+1
#Here I want the script to wait for user input again
output$plot <- renderPlot(plot(c((1),(2),(3)),c((input$input),(a),(3)), main="This is plot the third plot"))
})
}
shinyApp(ui=ui, server=server)
}
The goal is that it updates the plots when they are rendered in the code, and that it waits for user input until script continues, instead of just keeping going.
Perhaps this is what you want.
req is used to only display when a variable is available. You need to create the second renderUI in the server since you cannot use req in the ui part.
if(interactive()){
ui <- fluidPage(
plotOutput("plot1"),
numericInput ("num1", "Please select a number to multiply the first point with", NA, 1, 10),
plotOutput("plot2"),
uiOutput("num2"),
plotOutput("plot3")
)
server <- function(input, output) {
output$plot1 <- renderPlot(plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed"))
output$plot2 <- renderPlot({
req(input$num1)
plot(c(1:3),c(2*(input$num1),4,(6)),
main="This is plot the second plot"
)
}
)
output$plot3 <- renderPlot({
req(input$num1, input$num2)
plot(c(1:3),c(2*(input$num1)+(input$num2),4,(6)),
main="This is plot the third plot"
)
}
)
output$num2 <- renderUI({
req(input$num1)
numericInput ("num2", "Please select a number to add to first point", NA, 1, 10)
})
}
shinyApp(ui=ui, server=server)
}
To be honest, I´m not 100% sure if I know what you expect, even after reading your text 5 times. I have a guess ;-).
Your pause function, which cause plots to render one step after another can be done with invalidateLater. This has to "live" inside a reactiveValue. I don´t know exactly who is the creator of this function, I saved it in my snippets (all glory to the unknown person).
To render a plot or run a script based on the input of a user, try to catch it by using an if statement.
Hope this helps :-).
library(shiny)
if(interactive()){
ui <- fluidPage(
selectInput("input", "Input", c(1:10)),
actionButton("apply", "Apply"),
textOutput("text"),
plotOutput("plot")
)
server <- function(input, output, session) {
rv <- reactiveValues(i = 0)
maxIter <- 10
observeEvent(input$apply, {
rv$i <- 0
observe({
isolate({
rv$i <- rv$i + 1
})
if (isolate(rv$i) < maxIter){
invalidateLater(2000, session)
}
})
})
output$plot <- renderPlot( {
if(rv$i > 0) {
if(input$input <= 4) {
plot(c((rv$i*1),(rv$i*2),(rv$i*3)),c((1),(2),(3)), main = sprintf("Input <= 4; Round %i", rv$i), type = "l")
} else {
plot(c((rv$i*1),(rv$i*5),(rv$i*4)),c((1),(2),(3)), main = sprintf("Input > 4; Round %i", rv$i), type = "l")
}
} else {
plot(c(1:3),c(2,4,6), main ="This is first plot")
}
})
}
shinyApp(ui=ui, server=server)
}

shiny: Update input without reactives getting triggered?

Is there any possibility to update an input without reactives getting triggered?
Below I put a minimal example. The aim is to update the slider without the value in the main panel changing. When the slider is changed again, then it should be forwarded to dependent reactives again.
The question and the underlying use case is similiar to the following questions: R shiny - possible issue with update***Input and reactivity and Update SelectInput without trigger reactive?. Similiar to these questions, there is a reactive that depends on two Inputs in my use case. I want to update one of these input depending on the other, which results in the reactive getting calculated twice. However, both of these questions got around the problem by updating the input only selectively. This is not possible in my use case, since I want to have some information shown to the user by updating the input.
If there is no possibility to update an input without reactives getting triggered, I will ask a follow-up-question focusing on my use case.
Example
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText(input$bins)
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
isolate(
updateSliderInput(session,"bins",value=20 )
)
})
}
shinyApp(ui = ui, server = server)
Here's a stab, though it feels like there might be side-effects from using stale data. Using the following diff:
# Define server logic
server <- function(input, output, session) {
- output$sliderValue <- renderText(input$bins)
+ output$sliderValue <- renderText({ saved_bins(); })
+ update <- reactiveVal(TRUE)
+ saved_bins <- reactiveVal(30)
+
+ observeEvent(input$bins, {
+ if (update()) saved_bins(input$bins) else update(TRUE)
+ })
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
+ update(FALSE)
- isolate(
updateSliderInput(session,"bins",value=20 )
- )
})
}
The method: using two new reactive values, one to store the data that (saved_bins) is used in the rendering, and one (update) to store whether that data should be updated. Everything that depends on input$bins should instead depend on saved_bins(). By using an additional observeEvent, the reactivity will always cascade as originally desired except when you explicitly set a one-time "do not cascade" with the prepended update(FALSE).
Full code below:
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText({ saved_bins(); })
update <- reactiveVal(TRUE)
saved_bins <- reactiveVal(30)
observeEvent(input$bins, {
if (update()) saved_bins(input$bins) else update(TRUE)
})
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
update(FALSE)
updateSliderInput(session,"bins",value=20)
})
}
shinyApp(ui = ui, server = server)
Firstly credit to #r2evans's solution.
At the risk of a verbal thrashing from the many headteacheRs that prohibit it, to avoid double observer you can use global assignment. Sensible to use a less generic name than 'update' though.
library(shiny)
ui <- fluidPage(
titlePanel("Update Slider - Isolate reaction?"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("set1", "set slider 'bins'$value=20"),
actionButton("set2", "'ISOLATED' set slider 'bins'$value=20 ")
),
mainPanel(
textOutput("sliderValue")
)
)
)
# Define server logic
server <- function(input, output, session) {
output$sliderValue <- renderText({ saved_bins(); })
saved_bins <- reactiveVal(30)
observeEvent(input$bins, {
if (update) saved_bins(input$bins) else update <<- TRUE
})
observeEvent(input$set1,{
updateSliderInput(session,"bins",value=20)
})
observeEvent(input$set2,{
## Is there any possibility to update the slider without 'sliderValue' changing?
#isolate does not work
update <<- FALSE
updateSliderInput(session,"bins",value=20)
})
}
shinyApp(ui = ui, server = server)

"Next" button in a R Shiny app

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)

conditionalPanel in R/shiny

Quick question on conditionalPanel for shiny/R.
Using a slightly modified code example from RStudio, consider the following simple shiny app:
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "input.n > 20",
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
My objective is to hide the graph and move up the HTML text to avoid a gap. Now, you can see that if the entered value is below 20, the graph is hidden and the text "Bottom" is moved up accordingly. However, if the entered value is larger than 20, but smaller than 50, the chart function returns NULL, and while no chart is shown, the text "Bottom" is not moving up.
Question is: is there a way I can set a conditionalPanel such that it appears/is hidden based on whether or not a plot function returns NULL? The reason I'm asking is because the trigger a bit complex (among other things it depends on the selection of input files, and thus needs to change if a different file is loaded), and I'd like to avoid having to code it on the ui.R file.
Any suggestions welcome,
Philipp
Hi you can create a condition for conditionalPanel in the server like this :
n <- 200
library("shiny")
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
conditionalPanel(condition = "output.cond == true", # here use the condition defined in the server
plotOutput('plot') ),
HTML("Bottom")
)
# Define the server code
server <- function(input, output, session) {
output$plot <- renderPlot({
if (input$n > 50) hist(runif(input$n)) else return(NULL)
})
# create a condition you use in the ui
output$cond <- reactive({
input$n > 50
})
outputOptions(output, "cond", suspendWhenHidden = FALSE)
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)
Don't forget to add the session in your server function and the outputOptions call somewhere in that function.

Resources