I am working on a prediction model using R Shiny.
I have as input some variables for the model, like sex, age, height....
I than have a action button saying "Generate Prediction".
When pressed, some text and figures appear based on the prediction made with the input variables.
I also included a "reset" action button.
I want when this button is pressed for all variables to go to original value (that already works) AND that the output generated after the "Generate Prediction" button disappears.
My problem is with the second part of this wish.
Is it possible and how can I remove the output after pressing "reset"?
Find my script below as an example (the real script is more complex).
I would like the part stating from "Results of prediction" to disappear when reset is pressed.
library(shiny)
# Define UI ----
ui <- fluidPage(
titlePanel(title=div( "COPD risk prediction tool")),
p("Chronic Obstructive Pulmonary Disease (COPD) is a lung problem that can affect people mainly as they get older. One of the main features of COPD is a change in the airways that alters how the air is held in the lungs and the ease with which breathing occurs (the airways become 'obstructed'). This may cause breathlessness, frequent coughing, production of sputum from your chest, and chest infections."),
selectInput("sex", label=h4("What is your gender?"),
choices=list("Female"=0, "Male"=1), selected=0),
selectInput("age", label=h4("What is your age?"),
choices=list("18"=18, "19"=19, "20"=20, "21"=21, "22"=22, "23"=23, "24"=24, "25"=25, "26"=26, "27"=27, "28"=28, "29"=29, "30"=30), selected=20),
bsTooltip("age",
"What is your current age in years?","right"),
selectInput("weight", label=h4("What is your weight?"),
choices=list("50"=50, "51"=51, "52"=52, "53"=53, "54"=54, "55"=55, "56"=56, "57"=57, "58"=58, "59"=59, "60"=60, "61"=61, "62"=62, "63"=63, "64"=64, "65"=65, "66"=66, "67"=67, "68"=68, "69"=69, "70"=70, "71"=71, "72"=72, "73"=73, "74"=74, "75"=75, "76"=76, "77"=77, "78"=78, "79"=79, "80"=80, "81"=81, "82"=82, "83"=83, "84"=84, "85"=85, "86"=86, "87"=87, "88"=88, "89"=89, "90"=90, "91"=91, "92"=92, "93"=93, "94"=94, "95"=95, "96"=96, "97"=97, "98"=98, "99"=99, "100"=100), selected=75),
bsTooltip("weight",
"What is your current weight in kg?", "right"),
selectInput("height", label=h4("What is your height?"),
choices=list("140"=140, "141"=141, "142"=142, "143"=143, "144"=144, "145"=145, "146"=146, "147"=147, "148"=148, "149"=149, "150"=150, "151"=151, "152"=152, "153"=153, "154"=154, "155"=155, "156"=156, "157"=157, "158"=158, "159"=159, "160"=160, "161"=161, "162"=162, "163"=163, "164"=164, "165"=165, "166"=166, "167"=167, "168"=168, "169"=169, "170"=170, "171"=171, "172"=172, "173"=173, "174"=174, "175"=175, "176"=176, "177"=177, "178"=178, "179"=179, "180"=180, "181"=181, "182"=182, "183"=183, "184"=184, "185"=185), selected=170),
bsTooltip("height",
"What is your current height in cm?", "right"),
br(),
h4("Medical Disclaimer", style = "color:blue"),
p(strong("This risk prediction tool is for general information and should not replace advice from your GP who knows your individual history.", style = "color:blue")),
p(strong("Although we have included major risk factors, COPD can affect anyone and if you have symptoms or concerns you should speak to your doctor.", style = "color:blue")),
p(strong("This risk score is derived from Caucasian populations and may not be as accurate for other ethnic groups.", style = "color:blue")),
actionButton("submit", label = "Generate Prediction"), actionButton("reset", label=("Reset")),
h2(textOutput('title')),
h4(textOutput('label1')),
h5(textOutput('label2')),
verbatimTextOutput("prediction")
)
# Define server logic ----
server <- function(input, output,session) {
submit <- FALSE
output$title <- eventReactive(input$submit, {
'Results of prediction'
})
output$label1 <- eventReactive(input$submit, {
'COPD risk prediction score'
})
output$label2 <- eventReactive(input$submit, {
'Your predicted risk (%) of developing COPD in your lifetime is:'
})
output$prediction <- eventReactive(input$submit, {
round((copdRisk(weight=input$weight, height=input$height, sex=input$sex)*100), 1)
})
output$label5 <- eventReactive(input$submit, {
'This means that for every 100 people sharing your characteristics '
})
output$label6 <- eventReactive(input$submit, {
'would develop COPD in their lifetime.'
})
observe({
input$reset
updateSelectInput(session, "age", selected=20)
updateSelectInput(session, "weight", selected=75)
updateSelectInput(session, "height", selected=170)
updateSelectInput(session, "sex", selected=0)
#updateActionButton(session, "submit", selected=FALSE)
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
In my answer below I will demonstrate how to achieve what you're asking for. In my answer I use the shinyjs package, both for resetting input values and for hiding/showing the results. I cannot run your code because there are extra packages and functions that you are using that I don't know about, and the code itself is not a minimal isolated example, so instead I'll write my own small app that does something similar and achieves what you want. Here is the code:
library(shiny)
ui <- fluidPage(
shinyjs::useShinyjs(),
numericInput("num", "Enter a number", 7),
actionButton("submit", "Square that number!"),
actionButton("reset", "Reset"),
shinyjs::hidden(
div(
id = "results",
h3("The square is"),
textOutput("square")
)
)
)
server <- function(input, output, session) {
output$square <- renderText({
input$submit
isolate(input$num * input$num)
})
observeEvent(input$reset, {
shinyjs::reset("num")
shinyjs::hide("results")
})
observeEvent(input$submit, {
shinyjs::show("results")
})
}
shinyApp(ui = ui, server = server)
To address your two questions specifically and how they are solved above:
To reset inputs to their original value, I use the shinyjs::reset() function. This is a much better approach than updating the inputs to a particular value, because the reset() function will guarantee to reset it to whatever value it was originally, whereas your approach means that if you change the initial value in the UI, you must remember to change it in the server as well.
To hide the results after pressing reset, I wrapped all the results UI inside a div(id = "results", ...). Then whenever the submit button is pressed, I use shinyjs to show it, and when reset is pressed I use shinyjs to hide it. I also wrapped the UI in a shinyjs::hidden(...) because you want the results to start off as not showing.
Both of the above require a call to shinyjs::useShinyjs() in the UI.
You should be able to build off this example and implement these techniques in your more complex app.
Also note that my sample app above does a few other things differently than yours. For example, you should not use output$X <- eventReactive(...). You should use the render functions (such as renderText()) when assigning into outputs.
For people who have the same problem, this might also be a solution: Restart Shiny Session. In this way all inputs and output are reset, but it takes more time.
Related
I added the button but the values will automatically change before I hit "Update Order", I don't know how to fix it. Should be like this:enter image description hereBelow is my code:
library(shiny)
ui <- fluidPage(
titlePanel("My Simple App"),
sidebarLayout(
sidebarPanel(
helpText("Controls for my app"),
selectInput("fruitchoice",
label = "Choose a fruit",
choices = list("Apples",
"Oranges",
"Mangos",
"Pomegranate"),
selected = "Percent White"),
sliderInput("amt",
label = "Order Amount:",
min=0, max = 100, value=20),
actionButton ("Update","Update Order")
),
mainPanel(
helpText("Fruit Chosen:"),
verbatimTextOutput("fruit"),
helpText("Order Amount"),
verbatimTextOutput("amt")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
SelectInput <- eventReactive (input$Update , {
runif(input$fruitchoice,amt)
})
output$fruit = renderText(input$fruitchoice)
output$amt = renderText(input$amt)
}
# Run the application
shinyApp(ui = ui, server = server)
I will show you, how to rewrite your code to get this update behavior, however I would like to also get you know that this part of code:
SelectInput <- eventReactive (input$Update , {
runif(input$fruitchoice,amt)
})
Is wrong for three reasons: (1) object amt do not exists, you probably want input$amt; (2) even if you change amt to input$amt code won't work and you will get error; (3) now you are not using SelectInput in any place in your application, so there is no reason for this part to exists, however as I don't know what is your aim and how will look the final app, I'm not saying this is generally wrong.
Ok, so now about this update button. We will focus on this code:
output$fruit = renderText(input$fruitchoice)
output$amt = renderText(input$amt)
Here you instruct program to (re)render text when input$fruitchoice or (in second line) when input$amt change, but you want to (re)render text only when user clicks the button, so you need two things - first, be sure that user clicked the button and do not (re)render text when one of input$ changes. This will work:
output$fruit = renderText({
req(input$Update)
isolate(input$fruitchoice)
})
output$amt = renderText({
req(input$Update)
isolate(input$amt)
})
If I understand Shiny correctly, isolate() makes sure that text is not (re)rendering when input$ changes (however it has internally the new values) and req() makes sure that the input$Update was clicked; and when is clicked again, Shiny recomputes [(re)renders] text. It recomputes, because we didn't use isolate() on input$Update I think.
There's a few things wrong in your code. I will give a bit of explanation for each one:
You are initializing with reactive inputs. By using renderText(input$...) you create a text output that updates automatically when your input updates. Automatically is the problem here, you don't want that. We are going to write an alternative method that stores the inputs in a separate variable that we only allow to be updated when the button is pressed. We initialize that variable like so:
rv <- reactiveValues(fruit = "Apples",
amt = 20)
EventReactive creates a reactive variable that can later be used in the code. Generally speaking what you want to use in these kind of scenarios is observeEvent. You can do so like this:
observeEvent (input$Update , {
rv$fruit <- input$fruitchoice
rv$amt <- input$amt
})
We now have a list of variables under the name "rv" and an observeEvent that updates this variable every time the button gets pressed. All that is left to do is create the renderText which you can do like so:
output$fruit <- renderText(rv$fruit)
output$amt <- renderText(rv$amt)
Description
I have a textAreaInput box that I want to start with a default value. The user can click 2 actionButtons (Submit & Random Comment). Submit updates the comment from the textAreaInput for further processing (plot, etc.) while Random Comment sends a new random value to textAreaInput (the user may type in the textAreaInput box as well). I almost have it but can't get the app to update textAreaInput's value until the Submit button is pressed.
Question
I want it to be updated when Random Comment is pressed but still allow the user to erase the text box and type their own text. How can I make the app do this?
MWE
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
output$randcomment <- renderUI({
commentUi()
})
comment_value <- reactiveValues(default = 0)
observeEvent(input$submit,{
comment_value$default <- input$randtext
})
renderText(input$randtext)
commentUi <- reactive({
if (comment_value$default == 0) {
com <- stri_rand_lipsum(1)
} else {
com <- stri_rand_lipsum(1)
}
textAreaInput("comment", label = h3("Enter Course Comment"),
value = com, height = '300px', width = '300px')
})
output$commenttext <- renderText({ input$comment })
}
)
I'd approach this a little bit differently. I would use reactiveValues to populate both of the fields, and then use two observeEvents to control the contents of the reactiveValues.
I don't think you need a reactive at all in this situation. reactive is good when you want immediate processing. If you want to maintain control over when the value is processed, use reactiveValues.
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
# Reactive lists -------------------------------------------------------
# setting the initial value of each to the same value.
initial_string <- stri_rand_lipsum(1)
comment_value <- reactiveValues(comment = initial_string,
submit = initial_string)
# Event observers ----------------------------------------------------
observeEvent(input$randtext,
{
comment_value$comment <- stri_rand_lipsum(1)
}
)
# This prevents the comment_value$submit from changing until the
# Submit button is clicked. It changes to the value of the input
# box, which is updated to a random value when the Random Comment
# button is clicked.
observeEvent(input$submit,
{
comment_value$submit <- input$comment
}
)
# Output Components -------------------------------------------------
# Generate the textAreaInput
output$randcomment <- renderUI({
textAreaInput("comment",
label = h3("Enter Course Comment"),
value = comment_value$comment,
height = '300px',
width = '300px')
})
# Generate the submitted text display
output$commenttext <-
renderText({
comment_value$submit
})
}
)
Some comments on your code
I struggled a little with determining what your code was doing. Part of the reason was that your server function was organized a bit chaotically. Your components are
output
reactive list
observer
output (but not assigned to a slot...superfluous)
reactive object
output
I'd recommend grouping your reactives together, your observers together, and your outputs together. If you have truly separate systems, you can break the systems into different sections of code, but have them follow a similar pattern (I would claim that these two boxes are part of the same system)
Your commentUi reactive has a strange if-else construction. It always sets com to a random string. What's more, the if-else construction isn't really necessary because no where in your code do you ever update comment_value$default--it is always 0. It looks like you may have been trying to base this off of an action button at some point, and then concluded (rightly) that that wasn't a great option.
Also, I would advise against building UI components in your reactive objects. You'll find your reactives are much more flexible and useful if they return values and then build any UI components within the render family of functions.
I am developing some shiny apps with various inputs. In general, I have a setup where I want the user to push a button to accept the input values, which will then create objects that need to be set up. The a simulation should run when the user presses the play button on a animated sliderInput object. The objects that have been created will be updated at each iteration.
One problem is that one of the objects is a reactiveValues list. I would like the whole set of objects to be recreated (erasing earlier values) whenever a user changes a setting and clicks "Accept" and runs them. Instead, the objects in the reactiveValues list are not being overwritten but are being augmented each time with the next settings. So each object slot actually holds several objects.
To see this, try setting the maximum iteration to a value, hit accept, then change the value and accept again, then click play. You will see it will print out different lengths of the reactiveValues object.
I tried a few things like rm() to try to delete the reactiveValues. Also I tried the solution here (shiny: How to update a reactiveValues object?) but it didn't work either.
library(shiny)
iter_test <- shinyApp(
ui=shinyUI(fluidPage(
titlePanel("title panel"),
sidebarLayout(position = "left",
sidebarPanel("Simulation parameters",
sliderInput("iter","Progress of simulation",value=1, min=1, max=30, round=TRUE, step=1,
animate=animationOptions(interval=1, loop=FALSE)),
actionButton('run',"Accept settings, press play above"),
sliderInput('max_iter','Maximum number of iterations',value=20, min=1, max=30, round=TRUE, step=1)
),
mainPanel( plotOutput("plots"))
)#end of layout
)
)#end of UI definition
,
server=shinyServer(function(input, output, session)
{
observeEvent( input$run, {
#only set up simulation objects if accept is clicked
updateSliderInput(session, "iter", label="Progress of simulation", value=1, min=1, max=input$max_iter, step=1)
#try(rm(params))
#set up objects needed for simulation
params <- reactiveValues(tmp=rep(1, input$max_iter))
#when the play button is pressed, the following loop should trigger.
observeEvent( input$iter, {
print(length(params$tmp))
})
})
}
)
)
I think this gets you what you want:
library(shiny)
iter_test <- shinyApp(
ui=shinyUI(fluidPage(
titlePanel("title panel"),
sidebarLayout(position = "left",
sidebarPanel("Simulation parameters",
sliderInput("iter","Progress of simulation",value=1, min=1, max=30, round=TRUE, step=1,
animate=animationOptions(interval=1, loop=FALSE)),
actionButton('run',"Accept settings, press play above"),
sliderInput('max_iter','Maximum number of iterations',value=20, min=1, max=30, round=TRUE, step=1)
),
mainPanel( plotOutput("plots"))
)#end of layout
)),#end of UI definition
server=shinyServer(function(input, output, session)
{
params <- reactiveValues(tmp=NULL)
observeEvent( input$run, {
req(input$run)
updateSliderInput(session, "iter", label="Progress of simulation", value=1, min=1, max=input$max_iter, step=1)
#try(rm(params))
#set up objects needed for simulation
params$tmp =rep(1, input$max_iter)
})
#when the play button is pressed, the following loop should trigger.
observeEvent( input$iter, {
req(input$iter)
print(length(params$tmp))
})
})
)
Yielding this:
In the above I set to 20, ran it, then set to 6, and ran it again. You can see it is no longer repeating the values, before it would have alternated 20 and 6.
The changes I made were:
initialized param$tmp outside the loop
removed the nesting of the observeEvent calls.
I kind of think you should be using an eventReactive here for the input$run case, but I am not really sure where you are going with this, so I let it be.
My shiny app has to perform some slightly slower server-side calculations so I want the user to be able to keep track of what is happening while they are waiting. Here is a minimal example of the structure of my app:
https://gist.github.com/0bb9efb98b0a5e431a8f
runGist("0bb9efb98b0a5e431a8f")
What I would like to happen is:
Click submit
The app moves to the 'Output' tab panel
It displays the messages and outputs in the order they are listed in observeEvent
What actually happens is:
Click submit
Everything is executed server side at once
The UI is updated at the end
Is it possible to get what I want here?
I could not come up with a solution using your approach. Shiny seems to wait until everything in server = function(input, output) is computed, and displays the results just afterwards, when all components for output$... are available. I don't know if there is a way around that.
There is however a solution implemented, which you could try: Progress indicators
Implementation using your code:
library(shiny)
shinyApp(
ui = navbarPage(title="test", id="mainNavbarPage",
tabPanel("Input", value="tabinput",
numericInput('n', 'Number of obs', 100),
actionButton(inputId="submit_button", label="Submit")
),
tabPanel("Output", value="taboutput",
plotOutput('plot')
)
),
server = function(input, output, session) {
observeEvent(input$submit_button, {
# Move to results page
updateNavbarPage(session, "mainNavbarPage", selected="taboutput")
withProgress(message = "Computing results", detail = "fetching data", value = 0, {
Sys.sleep(3)
incProgress(0.25, detail = "computing results")
# Perform lots of calculations that may take some time
Sys.sleep(4)
incProgress(0.25, detail = "part two")
Sys.sleep(2)
incProgress(0.25, detail = "generating plot")
Sys.sleep(2)
})
output$plot <- renderPlot({hist(runif(input$n)) })
})
})
while working on a Shiny application I stumbled upon the following problem which seems related to the order in which input are changed by the update***Input vs. the reactivity order.
I have been able to narrow down the code and steps to reproduce the problem to the following ones:
I have a numericInput which spans between 1 and 5, with 3 as default value, whose selected value is used to produce some output (for the sake of simplicity, here it's just a "Good" message if the value is 2, 3 or 4, and a "Bad" message if the value is either 1 or 5);
I want the user to be able to change the input value and either use its chosen value (by pressing a Submit button) or use the default value (by pressing a Reset button) in the rest of the application;
The check for the condition 1<value<5 has to be preferably inside an isolate block (because my actual complete code triggers various time-consuming operations based on the input)
The code snippets are the following
ui.R:
shinyUI(fluidPage(
titlePanel(
fluidRow(headerPanel(HTML("Test a possible bug"), windowTitle = "Test a possible bug")
)
),
mainPanel(
tabsetPanel(
tabPanel("Try this", br(),
numericInput(inputId="foo", label="Input me", value=3,min=1, max=5),
actionButton(inputId="reset", label="Use default"),
actionButton(inputId="submit", label="Use new value"),br(),br(),br(),
textOutput(outputId="bar")
)
)
)
))
server.R:
shinyServer(function(input, output, session) {
observeEvent(input$reset, {
updateNumericInput(session=session, inputId="foo", value=3)
})
checkInput <- reactive({
input$submit
input$reset
isolate({
input$foo > 1 && input$foo < 5
})
})
output$bar <- renderText({
if (checkInput())
"Good"
else
"Bad"
})
})
The problem I encountered is the following
If I choose 5, the app properly prints a "Bad" message
If I now press "Use default" the numericInput is properly update to the default 3, but the message remains "Bad" because the modification of the input is not acknowledged (yet) by shiny
If I now press a second time the "Use default" button, or if I press the "Use new value" button, the message is now correctly updated to "Good"
I would expect on the other hand that shiny acknowledges the updated input, since the input field has changed
Is this behaviour by design? Any suggestion to solve the problem?
I could work around the issue by requiring the user to separately reset the value to default and then to submit the new value, but it sounds a little bit unsatisfactory...
p.s. my actual code has a dozen of numericInput fields, thus the "Use default" button is really needed because manually restoring all values is not really a feasible option outside the simplified settings posted here ;-)
I believe this is how it is intended to work. If you check the documentation, of updateNumericInput or updateSelectInput, the updation is done after all the outputs are produced.
"The input updater functions send a message to the client, telling it
to change the settings of an input object. The messages are collected
and sent after all the observers (including outputs) have finished
running."
I would suggest that the functionality be set in such a way that the Message "good' or 'bad' be displayed only when 'Submit' is hit, AND that it is 'cleared' when "Reset' is hit. Hope this is useful
Please see an example
library(shiny)
ui<-(fluidPage(
titlePanel(
fluidRow(headerPanel(HTML("Test a possible bug"), windowTitle = "Test a possible bug")
)
),
mainPanel(
tabsetPanel(
tabPanel("Try this", br(),
numericInput(inputId="foo", label="Input me", value=3,min=1, max=5),
actionButton(inputId="reset", label="Use default"),
actionButton(inputId="submit", label="Use new value"),br(),br(),br(),
textOutput(outputId="bar")
)
)
)
))
server<-(function(input, output, session) {
rv <- reactiveValues()
observeEvent(input$reset, {
updateNumericInput(session=session, inputId="foo", value=3)
rv$Message = " "
})
observeEvent(input$submit,{
rv$checkInput<- input$foo > 1 && input$foo < 5
if (rv$checkInput)
rv$Message<- "Good"
else
rv$Message<- "Bad"
})
output$bar <- renderText({
rv$Message
})
})
shinyApp(ui,server)