I am creating an app with a form for users to fill in with details, and press a "Submit" button: after which a row gets added to a data frame summarising the entered data. Each entry has a unique identifier, eg. Name.
If a new submission is made, but references the same identifier, I want a pop-up box to warn the user that they are about to overwrite the original data.
Using information taken from this post, I have partially managed the aim. The code performs the update as expected (in running the example below, this is evidenced in the print() command), however the ui does not update as I'd expect.
Below I have included a minimal working example, where if one enters (for example) b into the "Row Name:" field, 10 into the "New Value:" field, and then click "Assign New Value", then the pop up box appears but the data table above does not change, moreover it appears to change shade. Then if you repeat with a second command, eg. b, 8, "Assign new Value", then the formatting goes back to normal, and both commits are seen to have taken affect.
I'd greatly appreciate if someone could explain why this is happening, and how to get the app to function as one would expect (eg. updating the table after first button click).
Moreover, if anybody has an idea of how I can extend this to accept/reject the update, that'd be great! By this I mean, having the option in the pop-up box to have "Are you sure you want to update row b?", and the options Yes/No.
Note whilst in the example below I have used the solution using shinyjs::alert (see comments in the above referenced post), I previously tried using the method outlined in the bulk of the post but had the same issue.
Thanks
library(shiny)
library(shinyjs)
library(DT)
ui <- fluidPage(
useShinyjs(),
dataTableOutput("DF_table"),
hr(),
fluidRow(
column(4,
textInput("rowName", "Row Name:", NULL) ),
column(4,
numericInput("newValue", "New Value:",NULL) ),
column(4,
actionButton("assignValue", label = h5("Assign New Value"), width = "100%" ) )
)
)
server <- function(input, output, session) {
rvs <- reactiveValues( DF = data.frame(name = c("a", "b", "c"), value = 1:3 ) )
observeEvent(input$assignValue,{
# Test if the supplied row name corresponds to a row of DF.
if(input$rowName %in% rvs$DF[,"name"] ){
# If it does, pop up box warns user that the supplied row is being over written.
shinyjs::alert(paste("Reassigning value of", input$rowName, sep=" ") )
# Over writes the value in the selected row, with the new value.
rvs$DF[match(input$rowName, rvs$DF[,"name"]), "value"] <- input$newValue
print(rvs$DF)
}
})
# Output data table.
output$DF_table <- renderDataTable(rvs$DF, rownames = FALSE)
}
runApp(list(ui = ui, server = server))
Related
Question
In R Shiny, when using
renderUI
uiOutput
to dynamically generate sets of controls, such as:
checkboxes
radiobuttons
text boxes
how can I harvest those values or populate input by causing events?
As-is, those generated controls appear to be "display only". Making a selection, marking a checkbox, or entering data only updates the display, but no Event is created and the values are not populated into the "input" variable ( ReactiveValues ); thus, nothing is received by the Shiny server process.
If these control inputs are in-fact isolated, it completely undermines the point of dynamically creating controls.
Obviously, I'm hoping that this issue has been addressed, but my searches haven't turned it up.
In my specific case, the UI allows the user to:
Select and upload a CSV file.
The logic identifies numerical, date, and grouping columns, and produces 3 sets of radiobutton control sets. The idea is that you pick which columns you are interested in.
Picking a grouping column SHOULD return that columnID back to the server, where it will display a discrete list of groups from which to select. This fails, as the selections do not generate an Event, and the input variable (provided to server.R) only contains the ReactiveValues from the static controls.
That said, the display of the controls looks fine.
Step#0 screenshot:
Step#1 screenshot:
On the server.R side, I'm using code as below to create the radioButtons.
output$radioChoices <- reactive({
...
inputGroup <- renderUI({
input_list <- tagList(
radioButtons(inputId = "choiceGrp", label = "Available Grouping Columns", choices = grpColumnNames, inline = TRUE, selected = selectedGrp),
radioButtons(inputId = "choiceNumb",label = "Available Numerical Columns",choices = numColumnNames, inline = TRUE, selected = selectedNum),
radioButtons(inputId = "choiceDate",label = "Available Date Columns", choices = dateColumnNames, inline = TRUE, selected = selectedDate),
hr()
)
do.call(tagList, input_list)
})
print(inputGroup)
output$radioChoices <- inputGroup
})
I have played around with a Submit button and ActionButtons to try and force an Event, but no dice. My skull-storming is now going to places like "do I need to somehow use Javascript here?"
Many thanks to all of you who are lending me your cycles on this matter.
I'm not sure I understand your problem. Here's a MWE that accesses the value of a widget created by uiOutput/renderUI. The values of widgets created by uiOutput/renderUIcan be accessed just like those of any other widget.
If this doesn't give you what you want, please provide more details.
library(shiny)
ui <-
fluidPage(
uiOutput("dataInput"),
textOutput("result")
)
server <- function(input, output, session) {
output$dataInput <- renderUI({
selectInput("beatles", "Who's your favourite Beatle?", choices=c("- Select one -"="", "John", "Paul", "George", "Ringo"))
})
output$result <- renderText({
req(input$beatles)
paste0("You chose ", input$beatles)
})
}
shinyApp(ui, server)
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.
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)
This is my first question on stackoverflow, and I've been using R for 3 months. I have a lot to learn! Any help is much appreciated. Thank you in advance for your time.
What I WANT to happen:
The user selects a category (Animals or Foods) from a drop-down box and clicks Next once. The appropriate ui component will render and display. Then the Next button should be disabled (grayed-out) whenever the right box of the Chooser Input component is empty. Only when the user has at least one selection in the right box, should Next button be enabled and the user may click it.
The PROBLEM: After the Chooser Input component is rendered, the right box is empty, but Next is NOT disabled. Here is the error:
Warning in run(timeoutMs) :
Unhandled error in observer: argument is of length zero
observeEvent(input$widget2)
Below are a demo ui.R and sever.R to recreate my problem. (However, I will be implementing the solution into a larger, more complex GUI.) The code uses shinyBS, so you will first need to install the package and load the library. The code also uses chooserInput, which requires two files: chooser.R and www/chooser-binding.js. See the following link for more information:
http://shiny.rstudio.com/gallery/custom-input-control.html
ui
### The following libraries need to be loaded BEFORE runApp()
### library(shiny)
### library(shinyBS)
source("chooser.R") # Used for Custom Input Control UI component (chooserInput)
# chooser.R is saved in the same location as the ui.R and server.R files
# chooserInput also requires chooser-binding JScript script file, which should be located within "www" folder
shinyUI(navbarPage("navbarPage Title",
tabPanel("tabPanel Title", titlePanel("titlePanel Title"),
fluidPage(
#### NEW ROW #####################################################################################################
fluidRow(wellPanel(
# Instructions for initial screen
conditionalPanel(condition = "input.ButtonNext == 0", tags$b("Step 1: Choose category and click 'Next'")),
# Instructions for 'Foods'
conditionalPanel(condition = "input.ButtonNext == 1 && input.widget1 == 'Foods'", tags$b("Step 2: Move Food(s) of interest to the right box and click 'Next'")),
# Instructions for 'Animals'
conditionalPanel(condition = "input.ButtonNext == 1 && input.widget1 == 'Animals'", tags$b("Step 2: Move Animals(s) of interest to the right box and click 'Next'"))
)),
#### NEW ROW #####################################################################################################
fluidRow(
# Drop down box for first selection
conditionalPanel(
condition = "input.ButtonNext == 0",
selectInput("widget1", label = "",
choices = c("Foods",
"Animals"))),
# This outputs the dynamic UI components based on first selection
uiOutput("ui1")
),
#### NEW ROW #####################################################################################################
fluidRow(tags$hr()), # Horizontal line separating input UI from "Next" button
#### NEW ROW #####################################################################################################
fluidRow(
column(1, offset=10,
# UI component for 'Next' button
conditionalPanel(condition = "input.ButtonNext < 2", bsButton("ButtonNext", "Next"))
),
column(1,
HTML("<a class='btn' href='/'>Restart</a>")
)
)
) # End of fluidPage
) # End of tabPanel
)) # End of navbarPage and ShinyUI
server
shinyServer(function(input, output, session) {
# Widget to display when number of clicks of "Next" button (ButtonNext) = 1
output$ui1 <- renderUI({
if(input$ButtonNext[1]==1) {
print("I am in renderUI") # Used to help debug
# Depending on the initial selection, generate a different UI component
switch(input$widget1,
"Foods" = chooserInput("widget2", "Available frobs", "Selected frobs", leftChoices=c("Apple", "Cheese", "Carrot"), rightChoices=c(), size = 5, multiple = TRUE),
"Animals" = chooserInput("widget2", "Available frobs", "Selected frobs", leftChoices=c("Lion", "Tiger", "Bear", "Wolverine"), rightChoices=c(), size = 5, multiple = TRUE)
)
}
}) # End of renderUI
# Disable "Next" button when right side of multi select input is empty
observeEvent(input$widget2, ({
widget2_right <- input$widget2[[2]]
print(widget2_right) # Used to help debug
if(widget2_right == character(0)) {
updateButton(session, "ButtonNext", disabled = TRUE)
} else {
updateButton(session, "ButtonNext", disabled = FALSE)
}
})) # End of observeEvent
}) # End of shinyServer
A similar question (link below) mentioned using Priorities and Resume/Suspend but no example was provided. If that is a valid solution to my problem, please provide some code.
R shiny Observe running Before loading of UI and this causes Null parameters
EXTRA NOTE: The code provided is a small demo recreated from a much larger GUI that I developed for the user to make a series of selections, clicking 'Next' between each selection. Depending on the selections they make each step, new choices are generated from a csv file. Therefore, the ui component that is rendered and displayed is dependent on how many times the user has clicked 'Next' and which selections they've previously made. In the end, the selections are used to sort a large data set so the user can plot only the data they are interested in. The dual conditions are why I used conditionalPanel and the VALUE of the actionButton to render and display the current ui component that the user needs. My code works (except for the problem above - HA!). However, I have read that it is poor coding practice to use the VALUE of an actionButton. If there are any suggestions for another method to handle the dual conditions, please let me know.
In server.R, I replaced
if(widget2_right == character(0))
with
if(length(widget2_right)==0)
and now the program works as I wanted it to.
When the right-box is empty, widget2_right = character(0). I learned that comparing vectors to character(0) results in logical(0), not TRUE or FALSE. However, length(character(0)) = 0. Therefore, if(length(widget2_right)==0) will be TRUE whenever no selections are in the right-box.