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)
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.
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.
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)) })
})
})
I have begun to create a web app using shiny where a user enters a search term and tweets containing that term are returned.
When I load this app the searchTwitter function begins automatically and on the main panel there is the error: Error: You must enter a query.
The search term is entered in the textInput box and there is a submitButton. You can enter a term and it works fine but I don't want the error to be the first thing the user sees.
ui.R:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Twitter Generator"),
sidebarPanel(
textInput("search", "Search Twitter For:", value = ""),
submitButton("Search")
),
mainPanel(
h3(textOutput("search")),
tableOutput("view"),
)
))
server.R:
library(shiny)
library(twitteR)
shinyServer(function(input, output) {
datasetInput <- reactive(function(){
rawTweets <- twListToDF(searchTwitter(paste(input$search)))
rawTweets$cleanText <- as.vector(sapply(rawTweets$text, CleanTweet))
rawTweets[, colnames(rawTweets) != "created"]
})
output$search <- reactiveText(function() {
input$search
})
output$view <- reactiveTable(function() {
head(datasetInput())
})
})
Thanks for your help
This is a logical request for and from your application design, and you should think through how to do it.
One easy way would be to add a tickbutton providing a true/false and to skip the actual twitter search if the value is FALSE. You may need to cache the previous value of rawTweets, or set it to NULL, or ...
mainPanel(
h3(textOutput("search")),
tableOutput("view")
)
try it without the second ","