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
Related
I'm trying to get the textInput from the user and upon submitting it through an action button,I need to update the choices (Append the user input to already existing radio buttons) ,I tried couple of ways but no luck, Thanks in advance for your Help:)
library(shiny)
ui = navbarPage("Sample Trial",
tabPanel("Input Tab",
mainPanel(
textInput("textinp","Create New Label", placeholder = NULL),
actionButton("labbutton","Create")
)
),
tabPanel("Radio Button Panel",
radioButtons("labradio", label = "New Label",choices=values)
)
)
values <- c("Label1","label2","label3")
server = function(input, output) {
observeEvent(input$labbutton,{
req(input$textinp)
value01 <-input$textinp
updatedValues <- c(values, value01)
updateRadioButtons(session,inputId ="labradio",choices=updatedValues)
})
}#Server End
Currently the App will append user input at first time to the list of already present inputs but upon the second input from the user ,It rewrites the previous one.
Try this
library(shiny)
ui = navbarPage("Sample Trial",
tabPanel("Input Tab",
mainPanel(
textInput("textinp","Create New Label", placeholder = NULL),
actionButton("labbutton","Create")
)
),
tabPanel("Radio Button Panel",
radioButtons("labradio", label = "New Label",choices=values)
)
)
server = function(input, output,session) {
value <- c("Label1","label2","label3")
rv <- reactiveValues(values=value)
observeEvent(input$labbutton,{
req(input$textinp)
rv$values <- c(rv$values, input$textinp)
updateRadioButtons(session,inputId ="labradio",choices=rv$values)
})
}
shinyApp(ui, server)
How can we ensure the user sees the validation error message only once?
Even in Shiny validation page, they had displayed error message twice:
https://shiny.rstudio.com/articles/validation.html
Also, if I were using different language, the below link might have helped.
Knockout - validation showing same error message twice
Even though **Stackoverflow had similar question here but referring different issue **
Show validate error message only once
It meant something different.
I am referring to "Please select a data set" message displaying twice
library(shiny)
ui <- fluidPage(
titlePanel("Validation App"),
sidebarLayout(
sidebarPanel(
selectInput("data", label = "Data set",
choices = c("", "mtcars", "faithful", "iris"))
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("table"),
plotOutput("plot")
)
)
)
server <- function(input, output) {
data <- reactive({
validate(
need(input$data != "", "Please select a data set")
)
get(input$data, 'package:datasets')
})
output$plot <- renderPlot({
hist(data()[, 1], col = 'forestgreen', border = 'white')
})
output$table <- renderTable({
head(data())
})
}
shinyApp(ui,server)
If there is an error, ideally only 1 time, user should be notified if not it might be annoying.
Because you are storing the message "Please select a data set" in the reactive object data() and then calling that object to be displayed twice, once in output$plot and once in output$table.
One way to refactor the app and still have a similar experience is the use a place holder in the input widget and then req() to check if the input value is truthy. If a value is not truthy ("falsey"?) then evaluation is stopped and you won't raise errors from downstream outputs that use data().
library(shiny)
ui <- fluidPage(
titlePanel("Validation App"),
sidebarLayout(
sidebarPanel(
selectInput("data", label = "Data set",
choices = c("Please select a dataset" = "", "mtcars", "faithful", "iris"))
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("table"),
plotOutput("plot")
)
)
)
server <- function(input, output) {
data <- reactive({
req(input$data)
get(input$data, 'package:datasets')
})
output$plot <- renderPlot({
hist(data()[, 1], col = 'forestgreen', border = 'white')
})
output$table <- renderTable({
head(data())
})
}
shinyApp(ui,server)
Another option would be to relocate the validate() logic from the data() block to one of the outputs. That way the message will only be shown once, but you may have to implement another check on the data, which is why I prefer using req for things like this.
I am trying to write a script in shiny, which has two inputs and stores the inputs in two different variables and runs a code using these input variables.But i am getting an error which says :Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
The following is my ui code:
ui <- fluidPage(
titlePanel("Network Model"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "origin",
label = "Origin:",
choices = milk_runs$Origin),
selectInput(inputId = "destination",
label = "Destination:",
choices = milk_runs$Dest),
actionButton("go", "")
),
mainPanel(
tableOutput(
"view"))
)
)
server code :
server<- function(input, output){
origin <- input$origin
destination <- input$destination
observeEvent(input$go,source("nr9.R"))
output$summary <- renderPrint({
#dataset <- datasetInput()
summary(Tnetwork)
})
Can you please tell me how to get correct results.
I think (it would help if you provided a fully reproducible example) that the error is occurring because you are trying to run input$origin without reactive(). The input$origin will not invalidate and update based on user input unless put inside reactive. Based on the example you provided:
library(shiny)
ui <- fluidPage(
titlePanel("Network Model"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "origin", label = "Origin:", choices = c("A","B","C","D","E","F")),
selectInput(inputId = "destination", label = "Destination:", choices = c("A","B","C","D","E","F")),
actionButton("go", "GO")
),
mainPanel( tableOutput( "view"))
)
)
server<- function(input, output){
origin <- reactive(input$origin)
destination<-reactive(input$destination)
observeEvent(input$go,{
cat(origin(),'nextword',destination(),sep="-")
})
output$view <- renderTable({data.frame(origin=origin(),destination=destination())})
}
shinyApp(ui, server)
should print 'origin-nextword-destination' to the console when 'go' is activated, and the table should update. I changed a few bits in your example because it was not reproducible but hopefully it helps.
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.
In my R shiny application, I would like to have one button to submit one set of inputs (which affect one portion of the output) and another one to submit the remaining inputs (which affect a different portion of the output). The code in the widgets example of the Shiny tutorial uses a submitButton but it seems like all the inputs are delivered when that single button is pressed? Thanks in advance for your help.
Here is an example showing actionButtons controlling reactive components:
library(shiny)
runApp(list(
ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
tags$form(
numericInput('n', 'Number of obs', 100)
, br()
, actionButton("button1", "Action 1")
)
, tags$form(
textInput("text", "enter some text", value= "some text")
, br()
, actionButton("button2", "Action 2")
)
),
mainPanel(
plotOutput('plot')
, textOutput("stext")
)
)
),
server = function(input, output) {
output$plot <- renderPlot({
input$button1
hist(runif(isolate(input$n)))
})
output$stext <- renderText({
input$button2
isolate(input$text )
})
}
)
)