'Reset inputs' button in shiny app - r

I would like to implement a 'Reset inputs' button in my shiny app.
Here is an example with just two inputs where I'm using the update functions to set the values back to the default values:
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("'Reset inputs' button example"),
sidebarPanel(
numericInput("mynumber", "Enter a number", 20),
textInput("mytext", "Enter a text", "test"),
tags$hr(),
actionButton("reset_input", "Reset inputs")
),
mainPanel(
h4("Summary"),
verbatimTextOutput("summary")
)
),
server = function(input, output, session) {
output$summary <- renderText({
return(paste(input$mytext, input$mynumber))
})
observe({
input$reset_input
updateNumericInput(session, "mynumber", value = 20)
updateTextInput(session, "mytext", value = "test")
})
}
))
What I would like to know is if there is also a function that sets back everything to default? That would be useful in case of multiple inputs.
Additionally, I'm not sure if my use of the observe function in order to detect when the action button was hit is the 'proper way' of handling the action buttons?

First of all, your use of the observer is correct, but there is another way that's slightly nicer. Instead of
observe({
input$reset_input
updateNumericInput(session, "mynumber", value = 20)
updateTextInput(session, "mytext", value = "test")
})
You can change it to
observeEvent(input$reset_input, {
updateNumericInput(session, "mynumber", value = 20)
updateTextInput(session, "mytext", value = "test")
})
Also note that you don't need to explicitly "return" from a renderText function, the last statement will automatically be used.
Regarding the main question: Matthew's solution is great, but there's also a way to achieve what you want without having to move all your UI into the server. I think it's better practice to keep your UI in the UI file just because separation of structure and logic is generally a good idea.
Full disclaimer: my solution involves using a package that I wrote. My package shinyjs has a reset function that allows you to reset an input or an HTML section back to its original value. Here is how to tweak your original code to your desired behaviour in a way that will scale to any number of inputs without having to add any code. All I had to do is add a call to useShinyjs() in the UI, add an "id" attribute to the form, and call reset(id) on the form.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("'Reset inputs' button example"),
sidebarPanel(
shinyjs::useShinyjs(),
id = "side-panel",
numericInput("mynumber", "Enter a number", 20),
textInput("mytext", "Enter a text", "test"),
tags$hr(),
actionButton("reset_input", "Reset inputs")
),
mainPanel(
h4("Summary"),
verbatimTextOutput("summary")
)
),
server = function(input, output, session) {
output$summary <- renderText({
return(paste(input$mytext, input$mynumber))
})
observeEvent(input$reset_input, {
shinyjs::reset("side-panel")
})
}
))

There isn't such a function in shiny, however, here's a way to accomplish this without having to essentially define your inputs twice. The trick is to use uiOutput and wrap the inputs you want to reset in a div whose id changes to something new each time the reset button is pressed.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("'Reset inputs' button example"),
sidebarPanel(
uiOutput('resetable_input'),
tags$hr(),
actionButton("reset_input", "Reset inputs")
),
mainPanel(
h4("Summary"),
verbatimTextOutput("summary")
)
),
server = function(input, output, session) {
output$summary <- renderText({
return(paste(input$mytext, input$mynumber))
})
output$resetable_input <- renderUI({
times <- input$reset_input
div(id=letters[(times %% length(letters)) + 1],
numericInput("mynumber", "Enter a number", 20),
textInput("mytext", "Enter a text", "test"))
})
}
))

Here is yet another option that works for either static or dynamic inputs, and doesn't involve re-rendering inputs entirely.
It uses:
reactiveValuesToList to get all initial input values, and (optionally) any dynamic input values that get initialized afterward.
session$sendInputMessage to update values for generic inputs. The updateXyzInput functions call this under the hood like session$sendInputMessage(inputId, list(value = x, ...).
Every Shiny input uses value for its input message, and almost all will update with their input value as-is. Only a two inputs I've found need special casing - checkboxGroupInput to not send NULL when nothing is checked, and dateRangeInput to convert its c(start, end) to a list(start = start, end = end).
It may not be a good idea to blindly reset ALL inputs (even tabs will be reset), but this can easily be adapted to reset a filtered set of inputs.
library(shiny)
ui <- pageWithSidebar(
headerPanel("'Reset inputs' button example"),
sidebarPanel(
numericInput("mynumber", "Enter a number", 20),
textInput("mytext", "Enter text", "test"),
textAreaInput("mytextarea", "Enter text", "test"),
passwordInput("mypassword", "Enter a password", "password"),
checkboxInput("mycheckbox", "Check"),
checkboxGroupInput("mycheckboxgroup", "Choose a number", choices = c(1, 2, 3)),
radioButtons("myradio", "Select a number", c(1, 2, 3)),
sliderInput("myslider", "Select a number", 1, 5, c(1,2)),
uiOutput("myselUI"),
uiOutput("mydateUI"),
tags$hr(),
actionButton("reset_input", "Reset inputs")
),
mainPanel(
h4("Summary"),
verbatimTextOutput("summary")
)
)
server <- function(input, output, session) {
initialInputs <- isolate(reactiveValuesToList(input))
observe({
# OPTIONAL - save initial values of dynamic inputs
inputValues <- reactiveValuesToList(input)
initialInputs <<- utils::modifyList(inputValues, initialInputs)
})
observeEvent(input$reset_input, {
for (id in names(initialInputs)) {
value <- initialInputs[[id]]
# For empty checkboxGroupInputs
if (is.null(value)) value <- ""
session$sendInputMessage(id, list(value = value))
}
})
output$myselUI <- renderUI({
selectInput("mysel", "Select a number", c(1, 2, 3))
})
output$mydateUI <- renderUI({
dateInput("mydate", "Enter a date")
})
output$summary <- renderText({
return(paste(input$mytext, input$mynumber))
})
}
shinyApp(ui, server)

You can also create a reset button by assigning NULL to your reactive values object.
See this RStudio Shiny article on Using Action Buttons: http://shiny.rstudio.com/articles/action-buttons.html. Specifically, read the sections titled Pattern 4 - Reset buttons and Pattern 5 - Reset on tab change. Examples (including code) are provided in the article.
The article provides solutions that don't require additional packages if that's a concern.

Related

I can't select specific parts from the choices of SelectizeInput in shiny

I have an app with one SelectizeInput which shows you a huge list of numbers.
I realised that I cannot remove a specific part of the choice that I have selected. Example:
Imagine that you have 5000, 5001, 5002, 5003... and you are in the choice 5003, but you want to select 5002 (so, you just have to remove the last number -3- and introduce the new one -2-). It will be the same if I want to delete a number from the middle.
At the moment, you have to delete the complete number, it doesn't allow you to remove parts of the number.
Here you have the code (note that you have to click on Submit before see the list)
library(shiny)
ui <- fluidPage(
titlePanel("Numbers"),
sidebarLayout(
sidebarPanel(
actionButton(inputId = "submit", label = "submit"),
hr(),
selectizeInput(inputId = "num_list", label = "Choose a number:", choices=character(0))
),
mainPanel(
)
)
)
server <- function(input, output, session) {
num <- reactive({
data = c(1:66000)
return(data)
})
# This function gives us the list of genes.
numbers_list <- reactive({
num()
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$submit,{
updateSelectizeInput(
session = session,
inputId = "num_list",
choices = numbers_list(), options=list(maxOptions = length(numbers_list())),
server = TRUE
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Does anyone know if this issue can be fixed?
Thanks very much in advance!

Make icon of airDatepickerInput clickable

I'm looking for a way to fire this line of code:
onevent('click', '???' ,{ print( 'hey1!!') })
or
onclick('DateRange' ,{ print( 'hey1!!') })
but ONLY when the user clicks on the calendar icon of an airDatepickerInput
but I don't know how to target the icon since it has no ID of its own.
Targeting 'DateRange' will not work as it will also trigger when clicking in the date range field, and that's unwanted.
The reason I want this is because I want the option to open a modal dialog that shows a plot with the date distribution of my data files the user is filtering for in my app.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res")
)
server <- function(input, output, session) {
output$res <- renderPrint(input$DateRange)
}
shinyApp(ui, server)
The author of the shinywidget package has updated the airDatepickerInput so that the button on the side can now be observed.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
airDatepickerInput(
inputId = "DateRange",
label = "Select multiple dates:",
placeholder = "You can pick 5 dates",
multiple = 5, clearButton = TRUE
),
verbatimTextOutput("res_date"),
verbatimTextOutput("res_button")
)
server <- function(input, output, session) {
output$res_date <- renderPrint(input$DateRange)
output$res_button <- renderPrint(input$DateRange_button)
observeEvent(input$DateRange_button, {
print(input$DateRange_button)
})
}
shinyApp(ui, server)

R Shiny reactive triggered by navigating to particular tabPanel in navbarPage

writing with a shiny question. I have a navbarPage, id = "navbar", and in the navbarMenu user can select one among several tabPanels. Each tabPanel is assigned a value (value = 1, value = 2, etc). So input$navbar is reactive value with the value of the selected tabPanel.
I have a reactive expression defined which reacts to the changing of the tabPanel (reacts based on input$navbar). What I actually want is for this to react to navigating to a particular tabPanel, but not navigating away from that tabPanel. So, when input$navbar changes from 1 to 2 I want a reaction, but when changing from 2 to 1 no reaction. How can I achieve this?
Here is relevant snippet of my code, I don't think I need a full reproducible example for this but let me know if I'm wrong.
#ui snippet
navbarPage(id = "navbar",
navbarMenu(title = "Title",
tabPanel(title = "tp1", value = 1),
tabPanel(title = "tp2", value = 2),
#more tabPanels and ui stuff...
#server snippet
rctvfx <- reactive({
#want this to react only when input$navbar changes from ==1 to ==2
input$navbar
isolate({
#do stuff
})
})
You can use an if statement. This makes sure the code only runs if the user navigated to the corresponding tab.
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
"----",
"Section header",
tabPanel("Table")
)
),
server = function(input, output){
observe({
if (req(input$navbar) == "Table")
message("Table has been selected")
if (req(input$navbar) == "Plot")
message("Plot has been selected")
})
}
)
I would recomment do use observe rather than reactive to make sure everything runs even if all observers for the reactive are idle.
Another example of the same answer as above
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
tabPanel("Table"),
mainPanel(dataTableOutput("d"))
)
),
server = function(input, output){
output$d = renderDataTable({
if ((input$navbar) == "Table") {
head(mtcars)
} else {
((input$navbar) == "Plot")
head(iris)
}
})
}
)

How to print error message near UI elements in R shiny?

An example code:
ui.R
library(shiny)
shinyUI(
fluidRow(column(2, actionButton("add", "ADD details")),
fluidRow(uiOutput("ui"))
)
)
server.R
shinyServer(function(input, output,session){
observeEvent(
input$add,
output$ui <- renderUI({
isolate({
fluidRow(column(4, textInput("birthweight", label = "birth weight:", value = '')),
column(3, numericInput("height",label = "Height:",value='')),
column(2, actionButton("addnew", "ADD details to database"))
)
})
})
)
})
When the user enters the input to birthweight an error message should be displayed near the textInput box if it contains character data, similarly for numericInput Height. This must be displayed as soon as the user enters the data or when the user clicks the add details to database action button, but should be displayed as an error message near the textbox not in a pop up window.
Can this be done in R shiny?
The validate function is one options. Another options is use an extra UI to show a error message only if the textInput has a no-numeric value. In this case you can add you own CCS to the error message. Here is an example based on your code.
library(shiny)
ui <-shinyUI(
fluidRow(
column(2,
actionButton("add", "ADD details")),
fluidRow( uiOutput("ui"))
)
)
server <- shinyServer(function(input, output,session){
observeEvent( input$add,
output$ui <- renderUI({
isolate({
fluidRow(
column(4,
textInput("birthweight", label = "birth weight:", value = ''),
uiOutput("checkBirthweight")),
column(3,
numericInput("height",label = "Height:",value='')),
column(2,
actionButton("addnew", "ADD details to database"))
)
})
})
)
output$checkBirthweight <- renderUI({
if (nchar(input$birthweight) > 0 && is.na(as.numeric(input$birthweight)))
p("Error: birth weight must be numeric")
})
})
shinyApp(ui, server)
By the way, it is good idea to put your code as code in your questions, it will helps to others to identify the problem. You can find extra help about that at https://stackoverflow.com/editing-help
Also, I know that everybody has its own code style and I respect that, but I found these guidelines for coding in R very useful https://google.github.io/styleguide/Rguide.xml

Shiny Application actionButton click on page load

I am building a Shiny application using the navbarPage() type. I have three tabs - the initial tab has a textInput() box that has default text defined. The mainPanel() of that page has a histogram and a table. On page load those update and reflect the proper information when the application is launched based on that default text.
The second tab is supposed to present a wordcloud based on that default text. When I switch over to that tab there is an error - if I go back to the first tab and enter new text and hit the actionButton - the wordcloud will update, but it won't do so until I perform that action.
Is there a way to have the actionButton() or some sort of submit happen when the page loads so the tab with the wordcloud can update? Or maybe I just need to make a variable global or something. I'm not sure. I've spent quite a bit of time on this and have hit a wall. Any help would be greatly appreciated.
Code for the UI:
tabPanel("Word Cloud Diagram",
fluidRow(
sidebarPanel(
width = 3,
h5("The sentence input:"),
wellPanel(span(h5(textOutput(
'sent'
)), style = "color:red")),
sliderInput(
"maxWC",
h5("Maximum Number of Words:"),
min = 10,
max = 100,
value = 50
),
br(),
#actionButton("update", "Update Word Cloud"),
hr(),
helpText(h5("Help Instruction:")),
helpText(
"Please have a try to make the prediction by using
the dashboard on right side. Specifically, you can:"
),
helpText("1. Type your sentence in the text field", style =
"color:#428ee8"),
helpText(
"2. The value will be passed to the model while you are typing.",
style = "color:#428ee8"
),
helpText("3. Obtain the instant predictions below.", style =
"color:#428ee8"),
hr(),
helpText(h5("Note:")),
helpText(
"The App will be initialized at the first load.
After",
code("100% loading"),
", you will see the prediction
for the default sentence example \"Nice to meet you\"
on the right side."
)
),
mainPanel(
h3("Word Cloud Diagram"),
hr(),
h5(
"A",
code("word cloud"),
"or data cloud is a data display which uses font size and/
or color to indicate numerical values like frequency of words. Please click",
code("Update Word Cloud"),
"button and",
code("Slide Input"),
"in the side bar to update the plot for relevant prediction."
),
plotOutput("wordCloud"),
# wordcloud
br()
)
)),
Code for the server:
wordcloud_rep <- repeatable(wordcloud)
output$wordCloud <- renderPlot({
v <- terms()
wordcloud_rep(
v[, 2],
v[, 1],
max.words = input$maxWC,
scale = c(5, 1.5),
colors = brewer.pal(4, "Dark2")
)
})
Also, I am using a single file application "app.R" - not sure if this is useful information or not. Again, on the first tab, default text is presented on the first page load, I just want this to extend to the wordcloud on page load so the plot is shown immediately without having to enter and submit new text. Thanks!
Here is an example that should be close to what you want. The trick is to use a submitButton. The wordcloud will have a default plot based on initial input, but will change when you change the text and press the submit button.
library(shiny)
library(wordcloud)
ui <- shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
textInput("text", "Input Text", "Random text random text random is no yes"),
submitButton("Submit")
),
mainPanel(
tabsetPanel(
tabPanel("Tab1",
plotOutput("hist"),
tableOutput("hist_table")),
tabPanel("Tab2",
plotOutput("wordcloud"))
)
)
)
))
server <- shinyServer(function(input, output) {
observe({
word_list = strsplit(input$text, " ")
word_table = as.data.frame(table(word_list))
output$hist = renderPlot({
barplot(table(word_list))
})
output$hist_table = renderTable({
word_table
})
output$wordcloud = renderPlot({
wordcloud(word_table[,1], word_table[,2])
})
})
})
shinyApp(ui = ui, server = server)
Since the use of submitButton() is generally discouraged in favour of the more versatile actionButton() (see here for function documentation), here is a version of the answer above that uses a combination of actionButton() and eventReactive() with ignoreNULL = FALSE so that the plots show up upon launching the app.
library(shiny)
library(wordcloud)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("text", "Input Text", "Random text random text random is no yes"),
actionButton("submit", "Submit")
),
mainPanel(
tabsetPanel(
tabPanel(
"Tab1",
plotOutput("hist"),
tableOutput("hist_table")
),
tabPanel(
"Tab2",
plotOutput("wordcloud")
)
)
)
)
)
server <- shinyServer(function(input, output) {
word_list <- eventReactive(input$submit,{
strsplit(input$text, " ")
},
ignoreNULL = FALSE
)
word_table <- reactive(
as.data.frame(table(word_list()))
)
output$hist <- renderPlot({
barplot(table(word_list()))
})
output$hist_table <- renderTable({
word_table()
})
output$wordcloud <- renderPlot({
wordcloud(word_table()[, 1], word_table()[, 2])
})
})
shinyApp(ui = ui, server = server)
The solution to making the action button run on the first load is a simple one. Just add an ifelse statement.
Original:
eventReactive(input$submit, ...
New:
eventReactive(ifelse(input$submit == 0, 1, input$submit), ...
Yes, it's just that easy!

Resources