updateNumericInput not updating from reactiveValues - r

I think I have run into some strange scoping issue that I have fought with for a week now without understanding what is going on.
I have also been unable to really make a small example that have the same problem but I hope the symptoms ring some bells. The real code is also available but the app is pretty complex.
Let me explain the players in the code.
A number of inputs in a bsModal, mainly numericInput.
An observeEvent, lets call it "the reader", fires when a file is read that contains cached results. It updates a reactiveValues object that contains the equivalent of all the inputs in a special S4 object.
Then we have an observe, lets call it "the object creator" that takes all the inputs and updates the reactiveValues` object if any inputs are changed.
an observeEvent, lets call it "the input updater", that fires when the reactiveValues reactive is invalidated and should update all the inputs. This is done to allow other processes to change the inputs by changing the reactiveValues reactive (for example "the object creator"). The first functionality I need is simply that it updates the inputs when the cached results are read by the "the object creator".
So it should go:
"the reader" reads a file --> "the input updater" sees a new reactiveValues reactive and updates the inputs (--> the "the object creator" sees new inputs and re-writes the reactiveValues reactive but they should be what the "the reader" already set).
The issue I have is in the "the input updater". I cannot get it to update the input based on the reactiveValues.
The code looks like this:
observeEvent(settings$processing_local, {
cat("\n\n\n")
print("Modifying inputs")
print(paste0("before ppm input is: ", input$local_ppm))
set <- ppm(settings$processing_local) # THIS DOES NOT WORK
print(paste0("setting: ", set)) # SHOWS CORRECT VALUE
# set <- 1000 # THIS WORKS!
updateNumericInput(session,"local_ppm",value = set)
print(paste0("after ppm input is: ", input$local_ppm))
cat("\n\n\n")
}, priority = 2)
When set is based on the reactiveValues settings$processing_local then the update doesn't happen. The crazy thing is that the output of print does show the right value AND if I hardcode a value to set then it also works.
The full code for 1, 2, 3 and 4.
EDIT 1: Version of the relevant processes based on the example of #cuttlefish44
This is closer to my action app but unfortunately does not have the problem I am experiencing in the full app.
ui <- fluidPage(
numericInput("inNumber", "Input number", 0),
actionButton("but", "Update")
)
server <- function(input, output, session) {
settings <- reactiveValues(aaa = NULL)
# proxy for reading cached file
observeEvent(input$but, {
settings$aaa <- 30
})
observe({
settings$aaa <- input$inNumber
}, priority = 1)
observeEvent(settings$aaa, {
set <- settings$aaa
print(c(set, input$inNumber))
updateNumericInput(session, "inNumber", value = set)
print(c(set, input$inNumber))
}, priority = 2)
}
shinyApp(ui, server)
EDIT 2: In lieu of a working example of the issue I have dockerized my app so it should be possible to see the issue albeit annoying to do. Dockerized app here.
Can be build with docker build --tag mscurate . and run with docker run --publish 8000:3838 mscurate.
After starting the app the issue can be seen by:
click "Load"
Select the one available file
click "local settings"
Now the "ppm" value in the loaded data is 500. But the input was never updated and the reactive is then changed back to the default value of 100.
The logging shows the sequence of events when loading the file:
-------Loading started-------
before the reactive is:
settings not present
after the reactive is:
500
-------Loading finished-------
-------Modifying inputs-------
before ppm input is: 100
setting: 500
after ppm input is: 100 <---- #cuttlefish44's answer explains why this is not updated
--------------
-------updating reactive objects-------
before ppm input is: 100 <---- this should have been updated to 500!
before the reactive object is: 500
after ppm input is: 100
after the reactive object is: 100
--------------
-------Modifying inputs-------
before ppm input is: 100
setting: 100
after ppm input is: 100
--------------
-------updating reactive objects-------
before ppm input is: 100
before the reactive object is: 100
after ppm input is: 100
after the reactive object is: 100
--------------
-------updating reactive objects-------
before ppm input is: 100
before the reactive object is: 100
after ppm input is: 100
after the reactive object is: 100
--------------

I think the problem here is that the “object creator” has a reactive
dependency on the RVs, causing it to invalidate in the same cycle as the
“input updater” when the “reader” updates the RVs. Then the settings are overwritten by the old input values before the update from the "input updater" takes place in the next cycle.
My interpretation of a play-by-play walkthrough would look something like this:
Reader updates settings, invalidating object creator and input updater.
New evaluation cycle starts.
Input updater sends a message to update input from new settings, but the
values in the input object have not changed yet.
Object creator updates settings based on old input, invalidating settings
and consequently input updater and object creator itself.
Input updater sends another message to update input, this time based on the
old settings that object creator just set.
Object creator updates settings again, still based on old input. Invalidaiton
is not triggered because the value hasn't changed.
All outputs are ready, evaluation ends and session is at rest.
Update messages sent by input updater arrive; only the latter is noted, which
changes the input to the old value.
Object creator runs and sets settings to old value. Again, invalidation of
settings is not triggered because the value didn't change.
Evaluation ends again, this time with no pending input messages.
To fix this, remove the RV dependencies from the “object creator”, e.g. with
isolate(). I couldn’t get req() to work with isolate(),
but in this case you could just drop that altogether.
Here’s a minimal example with the problem. Removing the req() here fixes it:
library(shiny)
lgr <- list(debug = function(...) cat(sprintf(...), "\n"))
ui <- fluidPage(
sliderInput("file_number", "Number to \"read from file\"", 0, 10, 5),
actionButton("read", "Read"),
numericInput("number", "Input number to sync", 0)
)
server <- function(input, output, session) {
settings <- reactiveValues(number = NULL)
observeEvent(input$read, {
settings$number <- input$file_number
lgr$debug("Loaded settings from \"file\".")
}, label = "reader")
observe({
req(settings$number) # The dependency on settings
settings$number <- input$number
lgr$debug("Updated settings from input.")
}, priority = 1, label = "object-creator")
observeEvent(settings$number, {
updateNumericInput(session, "number", value = settings$number)
lgr$debug("Set input from settings: %d", settings$number)
}, priority = 2, label = "input-updater")
}
shinyApp(ui, server)
And the log produced after clicking “read”:
Loaded settings from "file".
Set input from settings: 5
Updated settings from input.
Set input from settings: 0
Updated settings from input.
Updated settings from input.
You can get a good look at the process with reactlog:
reactlog::reactlog_enable()
reactlogReset()
shinyApp(ui, server)
reactlogShow()

Your code works, but as far as I see input is static in the event.
See below simple example.
ui <- fluidPage(
sliderInput("controller", "Controller", 0, 20, 10),
numericInput("inNumber", "Input number", 0),
)
server <- function(input, output, session) {
settings <- reactiveValues(aaa = NULL)
observe({
settings$aaa <- input$controller + 3
}, priority = 1)
observeEvent(settings$aaa, {
set <- settings$aaa
print(c(input$controller, set, input$inNumber))
updateNumericInput(session, "inNumber", value = set)
print(c(input$controller, set, input$inNumber))
}, priority = 2)
}
shinyApp(ui, server)
I change controller 10 (default) to 12.
# this is console output
[1] 10 13 0
[1] 10 13 0
[1] 12 15 13
[1] 12 15 13
and the UI screen shot shows inNumber is updated to 15.
But console output shows input isn't updated immediately.
(maybe the updated value is in somewhere of session but I don't know where)

Related

R shiny - updateSelectizeInput does not update inputs when wrapped in observeEvent coupled with actionButton

Problem: an updateSelectizeInput call within observeEvent changes the value displayed in the browser but does not change the value I can access from code with input$
Background: In my Shiny app, I want to have an input with the following properties:
the user can type in and select from server-side list of options
a URL query string can also control it
blank means all options
an actionButton allows the user to delay expensive computation until all desired choices have been made
I currently have an observeEvent watching for the query string, and when it sees one, it calls updateSelectizeInput, but, after it does so, the input is unchanged.
Example:
library(shiny)
possibleLetters = LETTERS[1:10]
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId='letters',
label='Your letters:',
choices=NULL,
selected=NULL,
multiple=T,
width='100%'),
actionButton("recompute",
"Recompute now")
),
mainPanel(
h3("Letters: "),
textOutput('lettersDisplay'),
h3("Indices of letters: "),
textOutput('lettersIndicesDisplay')
)
)
)
server <- function(input, output, session) {
updateSelectizeInput(inputId='letters',
choices=c('',possibleLetters),
server=T)
userLetters = eventReactive(input$recompute, ignoreNULL=FALSE, {
if (length(input$letters) == 0) {
return (possibleLetters)
} else (
return (input$letters)
)
})
userLetterIndices = reactive({
return(match(userLetters(),LETTERS))
})
queryStringObserver = observeEvent(session$clientData$url_search, {
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query$letters)) {
cat(file=stderr(), paste0('observeEvent running - user specified param is: ',query$letters,'\n'))
updateSelectizeInput(session,
inputId="letters",
choices = possibleLetters,
selected = query$letters,
server=T)
cat(file=stderr(), paste0('observeEvent running - ran updateSelectizeInput, input$letters is now: ',input$letters,'\n'))
}
})
output$lettersDisplay = renderText({
return(paste(userLetters(),collapse=' '))
})
output$lettersIndicesDisplay = renderText({
return(paste(userLetterIndices(), collapse=' '))
})
}
shinyApp(ui = ui, server = server, options = list(port=1111))
Steps to reproduce problem: Run the app and then navigate to http://localhost:1111/?letters=A
You will find that "A" has indeed been filled into the selectize field in the browser window, however, the input value has not been updated. In your console you will see:
observeEvent running - user specified param is: A
observeEvent running - ran updateSelectizeInput, input$letters is now:
Thus, the query string has been correctly parsed, updateSelectizeInput has been called, and yet when input$letters is accessed afterwards, its value has not changed.
I suspect this relates to some fundamental shortcoming in my understanding of reactive graphs or something, but after poring over Mastering Shiny, I still can't figure out why this call does nothing.
The value of input$letters updates, it just hasn't by the time you try to print it. I'm not sure how or if Shiny batches messages, but your observeEvent eventually triggers a message to be sent to the client to update the input, which then has to inform the server is been updated. At a minimum, I assume it would finish executing the current observer code, but through some tinkering it appears Shiny may execute all necessary reactive code before sending messages to the client.
While the value of input$letters prints nothing with your given code, if I click recompute it does update the text as expected. Basically, here's more or less the conversation I believe that happens with your code as is:
Client: Yo, server. The user added a query parameter: letters=A.
Server: Hmmm, ok I will just run this observeEvent code. Oh, the developer wants to know the current value of `input$letters`. Client, can you help a server out with that input value.
Client: No problem, friend-o. The current selected value is NULL.
Server: Well, let me just cat this NULL to the stderr.
Server (~1 ms later): Yo, client. I finished running the observeEvent code and you should really update that selectize input. It would make everyone happy.
Client: Can do.
Client (~2 ms later): Whoa, the select input updated. I gots to tell server about this jawn. Hey server, input$letters just changed to `A`. Just FYI.
Server: Hmm, good to know. Nothing for me to do about that.
When the server prints inputletters, the value is still NULL because it hasn't told the client to update it yet. Actually, I'm not sure if the server polls the client for the value or if looks it up from it's own list of current values, but either way, it still hasn't been updated when it goes to cat the value.
Move your cat statement to a separate observe statement and the conversation above changes to
Client (~2 ms later): Whoa, the select input updated. I gots to tell server about this jawn. Hey server, input$letters just changed to `A`. Just FYI.
Server: WHAT?!!! OMG! I MUST TELL STDERR ABOUT THIS!!
This all a long way to say I don't think there is actually anything wrong with your code per se. Sorry, for all the personality changes with the server and the client, but hopefully this helps.
To achieve the desired behavior of the app immediately showing the results with the given query string (without waiting for user to press Recompute now), the following changes were necessary:
Delete the original observer, and instead only call updateSelectizeInput from inside the userLetters eventReactive
Only fill in values from the query string on startup (if(!input$recompute))
To keep the query string up to date with what the user then changes in the app, add a new observer update_qs
The code:
library(shiny)
possibleLetters = LETTERS[1:10]
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId='letters',
label='Your letters:',
choices=NULL,
selected=NULL,
multiple=T,
width='100%'),
actionButton("recompute",
"Recompute now")
),
mainPanel(
h3("Letters: "),
textOutput('lettersDisplay'),
h3("Indices of letters: "),
textOutput('lettersIndicesDisplay')
)
)
)
server <- function(input, output, session) {
userLetters = eventReactive(input$recompute, ignoreNULL=FALSE, {
query <- parseQueryString(session$clientData$url_search)
if (!input$recompute & !is.null(query$letters)) {
selectedLetters = strsplit(query$letters,';')[[1]]
} else if (is.null(input$letters)) {
selectedLetters = character(0)
} else (
selectedLetters = input$letters
)
updateSelectizeInput(session,
inputId="letters",
choices = c('',possibleLetters),
selected = selectedLetters,
server=T)
if (length(selectedLetters)==0) {
return (possibleLetters)
} else {
return (selectedLetters)
}
})
update_qs = observeEvent(input$recompute, {
if (!identical(userLetters(),possibleLetters)) {
new_qs = paste0('?letters=',paste0(userLetters(),collapse=';'))
} else {
new_qs = '?'
}
updateQueryString(new_qs, mode='push')
})
userLetterIndices = reactive({
return(match(userLetters(),LETTERS))
})
output$lettersDisplay = renderText({
return(paste(userLetters(),collapse=' '))
})
output$lettersIndicesDisplay = renderText({
return(paste(userLetterIndices(), collapse=' '))
})
}
# Run the application
shinyApp(ui = ui, server = server, options = list(port=1111))

Test whether any input in a set of numbered input objects in R Shiny is empty

Let's say I have created 10 selectInput dropdowns for a multi plot export and these selectInputs are called "xaxis_1", "xaxis_2", ..... , "xaxis_10"
for a single 1 I can write:
if(!is.null(input$xaxis_1)) { .... do stuff } to stop it running export when the user hasn't entered any name, and presses submit, to avoid crashes.
A bit more general you can check this:
if(!is.null(input[[paste('xaxis', i, sep = '_')]])) { ...}
how can you write it elegantly so that 1 line of code checks whether ANY of the 1:10 input[[...]] is empty, i.e. NULL?
The nr of inputs depends on how many plots the user wants to export per file, so all is build with lapply(1:input$nrofplots, function(i) { .... } renderUI structure, and my if statement needs to have the same flexibility of 1:n
In a situation like below in the image, pressing Initiate export should give a sweetalert (got that covered) saying there is at least 1 value missing
Here a snippet I used in the UI side to validate the user's inputs.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(), # Set up shinyjs
numericInput('axis1','Val 1',1),
numericInput('axis2','Val 2',1),
numericInput('axis3','Val 3',1),
actionButton('Go','Plot')
)
server <- function(input, output, session) {
#Try 1, space, AAA and check what shiny will return
observe(print(input$axis1))
observe({
All_Inputs <- vapply(paste0('axis',1:3),
function(x){isTruthy(input[[x]])},
logical(1))
All_InputsCP <- all(All_Inputs)
shinyjs::toggleState(id="Go", condition = All_InputsCP) #This is to make the button Go able or disable according to condition All_InputsCP #
})
}
shinyApp(ui, server)
I hope it helps.

Export all user inputs in a Shiny app to file and load them later

My Shiny app has several inputs which are used to define several parameters of a generated plot. It's very likely that the user will spend some minutes going through all possible options until he's satisfied with the output. Obviously the plot can be exported in different formats, but it's possible that the user will want to recreate the same plot with different data later, or maybe just change one small detail.
Because of this, I need to offer the user a way to export all his settings and keep that file for later use. I've developed an approach, but it isn't working well. I'm using reactiveValuesToList to get the names of all input elements and save as a simple text file with the format inputname=inputvalue. This is the downloadHandler on server.R:
output$bt_export <- downloadHandler(
filename = function() {
"export.txt"
},
content = function(file) {
inputsList <- names(reactiveValuesToList(input))
exportVars <- paste0(inputsList, "=", sapply(inputsList, function(inpt) input[[inpt]]))
write(exportVars, file)
})
This works fine, but loading isn't going very smoothly. Since I don't (and couldn't figure out how) save the input type, I have to update the values blindly. This is how I do it:
importFile <- reactive({
inFile <- input$fileImport
if (is.null(inFile))
return(NULL)
lines <- readLines(inFile$datapath)
out <- lapply(lines, function(l) unlist(strsplit(l, "=")))
return(out)
})
observe({
imp <- importFile()
for (inpt in imp) {
if (substr(inpt[2], 0, 1) == "#") {
shinyjs::updateColourInput(session, inputId = inpt[1], value = inpt[2])
} else {
try({
updateTextInput(session, inputId = inpt[1], value = inpt[2])
updateNumericInput(session, inputId = inpt[1], value = inpt[2])
updateSelectInput(session, inputId = inpt[1], selected = inpt[2])
})
}
}
})
Apart from the shinyjs::colorInput, which can be recognized by the # start, I have to use try() for the others. This works, partially, but some inputs are not being updated. Inspecting the exported file manually shows that inputs which weren't updated are there, so I suppose that updating 100+ inputs at once isn't a good idea. Also the try() part doesn't look good and is probably not a good idea.
The app is close to finished, but will probably be updated in the future, having some inputs added/changed. It's acceptable if this even make some "old" exported inputs invalid, since I'll try keep the backwards compatibility. But I'm looking for an approach that isn't just writing hundreds of lines to update the inputs one-by-one.
I've thought about using save.image() but simply using load() does not restore the app inputs. I also considered a way to somehow update all inputs at once, instead of one-by-one, but didn't come up with anything. Is there any better way to export all user inputs to a file and then load them all? It doesn't matter if it's a tweak to this one that works better or a completely different approach.
If you look at the code of the shiny input update functions, they end by session$sendInputMessage(inputId, message). message is a list of attributes that need to be changed in the input, for ex, for a checkbox input: message <- dropNulls(list(label = label, value = value))
Since most of the input have the value attribute, you can just use the session$sendInputMessage function directly on all of them without the try.
Here's an example, I created dummy_data to update all the inputs when you click on the button, the structure should be similar to what you export:
ui.R
library(shiny)
shinyUI(fluidPage(
textInput("control_label",
"This controls some of the labels:",
"LABEL TEXT"),
numericInput("inNumber", "Number input:",
min = 1, max = 20, value = 5, step = 0.5),
radioButtons("inRadio", "Radio buttons:",
c("label 1" = "option1",
"label 2" = "option2",
"label 3" = "option3")),
actionButton("update_data", "Update")
))
server.R
library(shiny)
dummy_data <- c("inRadio=option2","inNumber=10","control_label=Updated TEXT" )
shinyServer(function(input, output,session) {
observeEvent(input$update_data,{
out <- lapply(dummy_data, function(l) unlist(strsplit(l, "=")))
for (inpt in out) {
session$sendInputMessage(inpt[1], list(value=inpt[2]))
}
})
})
All the update functions also preformat the value before calling session$sendInputMessage. I haven't tried all possible inputs but at least for these 3 you can pass a string to the function to change the numericInput and it still works fine.
If this is an issue for some of your inputs, you might want to save reactiveValuesToList(input) using save, and when you want to update your inputs, use load and run the list in the for loop (you'll have to adapt it to a named list).
This is a bit old but I think is usefull to post a complete example, saving and loading user inputs.
library(shiny)
ui <- shinyUI(fluidPage(
textInput("control_label",
"This controls some of the labels:",
"LABEL TEXT"),
numericInput("inNumber", "Number input:",
min = 1, max = 20, value = 5, step = 0.5),
radioButtons("inRadio", "Radio buttons:",
c("label 1" = "option1",
"label 2" = "option2",
"label 3" = "option3")),
actionButton("load_inputs", "Load inputs"),
actionButton('save_inputs', 'Save inputs')
))
server <- shinyServer(function(input, output,session) {
observeEvent(input$load_inputs,{
if(!file.exists('inputs.RDS')) {return(NULL)}
savedInputs <- readRDS('inputs.RDS')
inputIDs <- names(savedInputs)
inputvalues <- unlist(savedInputs)
for (i in 1:length(savedInputs)) {
session$sendInputMessage(inputIDs[i], list(value=inputvalues[[i]]) )
}
})
observeEvent(input$save_inputs,{
saveRDS( reactiveValuesToList(input) , file = 'inputs.RDS')
})
})
Unless you're doing a lot of highly flexible type inputs (renderUI blocks which could be any sort of input) then you could create a list storing all current values, use dput to save them to a file with a corresponding dget to read it in.
In one app I have, I allow users to download a file storing all their uploaded data plus all their options.
output$saveData <- downloadHandler(
filename = function() {
paste0('Export_',Sys.Date(),'.sprout')
},
content = function(file) {
dataToExport = list()
#User specified options
dataToExport$sproutData$transformations=sproutData$transformations #user specified transformations
dataToExport$sproutData$processing=sproutData$processing #user specified text processing rules
dataToExport$sproutData$sc=sproutData$sc #user specified option to spell check
dataToExport$sproutData$scOptions=sproutData$scOptions #user specified spell check options (only used if spell check is turned on)
dataToExport$sproutData$scLength=sproutData$scLength #user specified min word lenght for spell check (only used if spell check is turned on)
dataToExport$sproutData$stopwords=sproutData$stopwords #user specified stopwords
dataToExport$sproutData$stopwordsLastChoice=sproutData$stopwordsLastChoice #last pre-built list selected
dput(dataToExport,file=file)
}
)
Here I make an empty list, then I stick in the values I use in my app. The reason for the dTE$sD$name structure is that I have a reactiveValues called sproutData which stores all user selected options and data. So, I preserve the structure in the output.
Then, I have a load data page which does the following:
output$loadStatusIndicator = renderUI({
worked = T
a = tryCatch(dget(input$loadSavedData$datapath),error=function(x){worked<<-F})
if(worked){
#User specified options
a$sproutData$transformations->sproutData$transformations #user specified transformations
a$sproutData$processing->sproutData$processing #user specified text processing rules
updateCheckboxGroupInput(session,"processingOptions",selected=sproutData$processing)
a$sproutData$sc->sproutData$sc #user specified option to spell check
updateCheckboxInput(session,"spellCheck",value = sproutData$sc)
a$sproutData$scOptions->sproutData$scOptions #user specified spell check options (only used if spell check is turned on)
updateCheckboxGroupInput(session,"spellCheckOptions",selected=sproutData$scOptions)
a$sproutData$scLength->sproutData$scLength #user specified min word lenght for spell check (only used if spell check is turned on)
updateNumericInput(session,"spellCheckMinLength",value=sproutData$scLength)
a$sproutData$stopwords->sproutData$stopwords #user specified stopwords
a$sproutData$stopwordsLastChoice->sproutData$stopwordsLastChoice
if(sproutData$stopwordsLastChoice[1] == ""){
updateSelectInput(session,"stopwordsChoice",selected="none")
} else if(all(sproutData$stopwordsLastChoice == stopwords('en'))){
updateSelectInput(session,"stopwordsChoice",selected="en")
} else if(all(sproutData$stopwordsLastChoice == stopwords('SMART'))){
updateSelectInput(session,"stopwordsChoice",selected="SMART")
}
HTML("<strong>Loaded data!</strong>")
} else if (!is.null(input$loadSavedData$datapath)) {
HTML(paste("<strong>Not a valid save file</strong>"))
}
})
The actual output is a table which details what it found and what it set. But, because I know all the inputs and they don't change, I can explicitly store them (default or changed value) and then explicitly update them when the save file is uploaded.

R shiny - possible issue with update***Input and reactivity

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)

Why doesn't my Shiny (R) actionButton respond after I use a different actionLink?

I'm writing a Shinyapp that enables users, among other things, to input new entries to a mongodb and delete specific rows from it.
I'm trying to add a functionality that would allow to undo the last delete by saving a temporary copy of the row. It seems to work fine, but after I use undo, for some reason the delete button doesn't work anymore, and I can't figure out why.
I thought maybe it has something to do with the fact that there's a few other places where I use observers for the two buttons, but I don't understand why that would cause any problem (and I need them for the app to function properly) - at any rate, they don't prevent me from deleting several rows one after the other so long as I don't use the undo function.
As you can see from the code below, I've put a bunch of print() functions throughout it to try and figure out where it's going. The weird thing - none of them show up! It's like the delete button simply doesn't activate the script once undo was used. Any ideas why?
UPDATE: Here's a short version of server.R and ui.R that reproduces the problem (without using mongodb):
server.R
tempEntry<-NULL
shinyServer(function(input, output, session) {
dat<-data.frame(nums=1:3,ltrs=c("a","b","c"))
## Action: Delete entry
output$delError<-renderText({
input$delButton
isolate({if (!is.na(input$delNum)) {
tempEntry<<-dat[input$delNum,]
output$undo<<-renderUI({
actionLink("undo","Undo last delete")
})
dat<<-dat[-input$delNum,]
print("deleted")
print(dat)
} else print("nope2")
})
})
## Action: Undo delete
output$undoError<-renderText({
input$undo
if (!is.null(input$undo)) {
if (input$undo>0) {
isolate({if (!is.null(tempEntry)) {
dat<<-rbind(dat,tempEntry)
tempEntry<<-NULL
output$delError<<-renderText({""})
print(dat)
} else print("nope3")
}) } else print("undo==0") } else print("undo null")
})
})
ui.R:
library(shiny)
shinyUI(navbarPage("example",
tabPanel("moo",
titlePanel(""),
fluidPage(numericInput("delNum","Row to delete",value=NULL),
actionButton("delButton","Delete row"),
uiOutput("undo"),
div(p(textOutput("delError")),style="color:red"),
div(p(textOutput("undoError")),style="color:blue")
))))
(This also gives an error "argument 1 (type 'list') cannot be handled by 'cat'" after deleting a row, I don't know why... But the problem doesn't seem to be related to that).
Thanks!
That happens because of the output$delError<<-renderText({""}) code that overwrites the original output$delError expression by the empty one, so no surprise output$delError does not trigger on input$delButton any more.
[UPDATE]
The OP's application uses actionButton and actionLink to delete and undelete records from a database, respectively. The 'delete' button is supposed to trigger the delError expression that deletes the record and shows the outcome of deletion (e.g. 'record deleted'). Similarly, the 'undelete' button triggers the undoError expression that puts the record back into the table and reports an outcome of undeletion (e.g. 'record undeleted'). The problem is that undoError has to get rid of the output produced by delError because outputs 'record deleted' and 'record undeleted' don't make much sense when they appear together, but the output 'record deleted' can be removed only by the delError expression.
It seems that this problem can be resolved by modifying delError to make it hide its output when the 'undelete' button (or link) is pressed. But in this case, delError would trigger on both 'delete' and 'undelete' buttons without being able to say which button caused the evaluation, so it would try to delete a record when the 'undelete' button is pressed!
The sample application below provides a way to address this problem by using a global variable that stores the status of the last operation. This status is generated by two high-priority observers (one for 'delete' and another for 'undelete'), which also take care of actual deleting/undeleting of the record. The observers don't produce output that directly goes to the web page, so there is no hassle with getting rid of the messages produced by the other observer. Instead, the status variable is shown by a simple reactive expression.
server.R
tempEntry<-NULL
dat<-data.frame(nums=1:3,ltrs=c("a","b","c"))
shinyServer(function(input, output, session) {
del.status <- NULL
##################
### Observers ####
##################
delete.row <- observe({
if (input$delButton ==0 ) return() # we don't want to delete anything at start
delNum <- isolate( input$delNum ) # this is the only thing that needs to be isolated
if (is.na(delNum)) {
print('nope2')
return()
}
tempEntry <<- dat[delNum,]
dat <<- dat[-delNum,]
output$undo <<- renderUI( actionLink("undo","Undo last delete") )
del.status <<- 'deleted'
},priority=100) # make sure that del.status will be updated *before* the evaluation of output$delError
undelete.row <- observe({
if (is.null(input$undo) || input$undo==0) return() # trigger on undowe don't want to undelete anything at the beginning of the script
dat <<- rbind(dat,tempEntry)
tempEntry <<- NULL
output$undo <<- renderUI("")
del.status <<- 'undeleted'
},priority=100)
##################
### Renderers ####
##################
output$delError <- renderText({
if (input$delButton == 0) return() # show nothing until first deletion
input$undo # trigger on undo
return(del.status)
})
output$show.table <- renderTable({
input$delButton; input$undo # trigger on delete/undelete buttons
return(dat)
})
})
ui.R
library(shiny)
shinyUI(
navbarPage(
"example"
, tabPanel("moo"
, titlePanel("")
, fluidPage(
numericInput("delNum","Row to delete",value=NULL)
, div(p(textOutput("delError")),style="color:red")
, actionButton("delButton","Delete row")
, uiOutput("undo")
, tableOutput('show.table')
)
)
)
)

Resources