Shiny Responds to Enter - r

I have a textInput widget, and now whenever I start typing in the widget, shinyApp tries to evaluate the unfinished content in the textInput widget and results in many errors. I'm aware that adding an action Button "Calculate" would easily solve the problem. However, my app does not have space left for one more button. So, I'd like to know if there's a way that the textInput widget would "listen" to a keyboard event, such as when the user hits "Enter?" Thanks in advance!

Very good question. Here is an example of the way I use; this app shows a ggplot and the user gives the title of the ggplot in a textbox - but the title changes reacts only when "Return" is pressed:
js <- '
$(document).on("keyup", function(e) {
if(e.keyCode == 13){
Shiny.onInputChange("keyPressed", Math.random());
}
});
'
shinyApp(
ui = bootstrapPage(
tags$script(js),
textInput("title", label = "Title"),
plotOutput("ggplot")
),
server = function(input, output, session){
Title <- reactiveVal()
observeEvent(input[["keyPressed"]], {
Title(input[["title"]])
})
output[["ggplot"]] <- renderPlot({
ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width)) +
geom_point() +
ggtitle(Title())
})
}
)
Explanations:
This Javascript code:
$(document).on("keyup", function(e) {
if(e.keyCode == 13){
Shiny.onInputChange("keyPressed", Math.random());
}
});
creates a new Shiny input, namely input$keyPressed which receives a random number when the "Return" key is pressed anywhere.
Then I define a reactive value which takes the value input$title given in the textbox by the user, only when input$keyPressed changes:
Title <- reactiveVal()
observeEvent(input[["keyPressed"]], {
Title(input[["title"]])
})
And finally I pass this reactive value to ggtitle:
output[["ggplot"]] <- renderPlot({
ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width)) +
geom_point() +
ggtitle(Title())
})

Here is an app that I built, and solves a similar problem.
The idea is to have listen to both the keypress and the button, and make sure they work together well. In your case, you should be able to make something even simpler because you don't need the button.
I hope you like it.
library(shiny)
# This is a demo app to test a key binding on an actionButton
# Uncommenting the info item (on both UI and server) will display internal stuff
runApp(
list(
#############################################
# UI
#############################################
ui = bootstrapPage(
textInput ("myinput", label = "Write something here"),
tags$script('
$(document).on("keydown", function (e) {
Shiny.onInputChange("lastkeypresscode", e.keyCode);
});
'),
actionButton("GO", "Lancer le matching !"),
# verbatimTextOutput("info"),
verbatimTextOutput("results")
),
#############################################
# SERVER
#############################################
server = function(input, output, session) {
# There are state variables for the input text and GO button
curr.val <- "" # Corresponds to the current displayed input$myinput
curr.go <- 0 # Corresponds to the last known GO value (integer)
lastEvent <- reactive({
# Is reactive to the following events
input$GO
input$lastkeypresscode
# Decide which action should be taken
if(input$GO > curr.go) {
# The user pushed the GO actionButton, so take action
action <- 1
curr.go <<- input$GO
} else if(input$lastkeypresscode == 13) {
# The user pressed the Enter key, so take action
action <- 1
} else {
# The user did anything else, so do nothing
action <- 0
}
return(action)
})
output$results = renderPrint({
if(lastEvent() == 1) {
curr.val <<- isolate(input$myinput)
}
curr.val
})
# output$info = renderText({
# paste(curr.val, curr.go, input$lastkeypresscode, sep = ", ")
# })
}
)
)

I created a simple app as an example, where the user can write the name of a city and after pressing ENTER it returns latitude and longitude:
library(shiny)
library(ggmap)
runApp(
list(
#############################################
# UI
#############################################
ui = fluidPage( title = "City Search" ,
position= "static-top",
tags$script(' $(document).on("keydown", function (e) {
Shiny.onInputChange("lastkeypresscode", e.keyCode);
});
'),
# Search panel:
textInput("search_city", "" , placeholder= "City"),
verbatimTextOutput("results")),
#############################################
# SERVER
#############################################
server = function(input, output, session) {
observe({
if(!is.null(input$lastkeypresscode)) {
if(input$lastkeypresscode == 13){
target_pos = geocode(input$search_city, messaging =FALSE)
LAT = target_pos$lat
LONG = target_pos$lon
if (is.null(input$search_city) || input$search_city == "")
return()
output$results = renderPrint({
sprintf("Longitude: %s ---- Latitude: %s", LONG, LAT)
})
}
}
})
}
)
)
Note that for catching the ENTER input the code is 13, i.e. input$lastkeypresscode == 13.

In your case, the problem is reactive programming and this is the reason that you need something to manage this situation. My recommendation is to use observer pattern or validate function.
Observer pattern: shiny implements the observer pattern which is
useful to act when an event happens in an object (it can be a click
in a button, new value in an input...).
Validate function: the functionality of this process is similar to an
if/else statement. Indeed, there is need what is the if to check the
parameter, if the values are wrong, there will be an error message.
To know how to use observe pattern and the validate function, click on the previous link (in the Shiny website is everything explained).

Related

Testing of shiny modules containing other modules

In a large Shiny App, I have a lot of modules within other modules. These nested modules also sometimes have input controls, e.g. textInput() or actionButton, which trigger certain events also in the parent module.
The following MWE shows the problem.
The module summaryServer prints a summary of a value, but waits for the reactive from rangeServer, which is triggered by a button. I want a Testing specific for summaryServer with testServer() function from Shiny, but how can I "click" the Button in the contained rangeServer module to continue? Is that something about the Mock Shiny Session?
### TESTING ###
x <- reactiveVal(1:10)
testServer(summaryServer, args = list(var = x), {
cat("var active?", d_act(),"\n")
# -----------------------------
# How to click "go" here?
# -----------------------------
cat("var active?", d_act(), "\n")
})
### The app ###
summaryUI <- function(id) {
tagList(
textOutput(NS(id, "min")),
textOutput(NS(id, "mean")),
textOutput(NS(id, "max")),
rangeUI(NS(id, "range"))
)
}
summaryServer <- function(id, var) {
stopifnot(is.reactive(var))
moduleServer(id, function(input, output, session) {
d_act = reactiveVal("Haha nope")
range_val = rangeServer("range", var = var)
# waits to range_val
observeEvent(range_val(),{
d_act("TRUE")
message(range_val())
output$min <- renderText(range_val()[[1]])
output$max <- renderText(range_val()[[2]])
output$mean <- renderText(mean(var()))
})
})
}
rangeUI = function(id) {
textInput(inputId = NS(id, "go"), label = "Go")
}
rangeServer = function(id, var){
moduleServer(id, function(input, output, session){
# when button gets clicked
eventReactive(input$go,{
range(var(), na.rm = TRUE)
}, ignoreInit = TRUE, ignoreNULL = TRUE)
})
}
library(shiny)
ui <- fluidPage(
summaryUI("sum")
)
server <- function(input, output, session) {
x = reactiveVal(1:10)
summaryServer("sum", x)
}
# shinyApp(ui, server)
That is a tricky one. It works if you set both ignoreInit and ignoreNULL to FALSE but just because then you are not initially dependent on a change of go anymore, which is undesirable.
I do not think it is possible to change go inside of rangeServer when running testServer with summaryServer. You can however use {shinytest} to achieve this. Note that here you invoke and test the entire app. Therefore, when using modules, you have to call elements by their complete id, including namespaces.
(I changed go to an actionButton, everything else stays the same)
rangeUI <- function(id) {
actionButton(inputId = NS(id, "go"),label = "Go")
}
test_that("output updates when reactive input changes", {
# invoke app
app <- shinytest::ShinyDriver$new("app.R")
# initially, the button has`nt been clicked and the outputs are empty
testthat::expect_equal(app$getValue("summary-range-go"), 0)
testthat::expect_equal(app$getValue("summary-min"), "")
# click the button
app$click("summary-range-go")
testthat::expect_equal(app$getValue("summary-range-go"), 1)
# testthat::expect_equal(app$getValue("summary-min"), "1")
# for some reason, the button value increased, hence is clicked,
# but the outputs have not been triggered yet.
# another click fixes that
app$click("summary-range-go")
testthat::expect_equal(app$getValue("summary-min"), "1")
})

Shiny click on button and show new plot

I have the following app:
If you click next, you will see a plot - at the moment with trivial information - and have to choose two radiobutton options: yes or no. Then you can click on the next button and evaluate the next plot. The problem is, that you have to first click on the button to show the first plot. Also you see in the print statement a missmatch. The first radio button choice is printed in the second line instad of the first print statement.
Can you help me to show an initial plot?
ui <- fluidPage(
actionButton("buttonNext", "Next"),
radioButtons("radio", "Your Decision:",
choices = c("No Decision" = 'NoDec', "Yes" = 'yes', "No" = 'no'),
selected = 'NoDec'),
plotOutput("TimeSeriesPlot")
)
server <- function(input,output,session) {
observeEvent(input$buttonNext, {
})
clickNext <- eventReactive(input$buttonNext, {
updateRadioButtons(session,'radio',selected = -1)
randomNumber <- input$buttonNext
print(c(input$buttonNext,randomNumber,input$radio))
return(randomNumber)
})
output$TimeSeriesPlot <- renderPlot({
i <- clickNext()
plot(i)
})
}
shinyApp(server = server, ui = ui)
You could use a simple reactive, and isolate the statement where you call the radio button's value. This way, the reactive won't take a dependency on the radiobuttons. Also, it is considered bad practice to use a reactive for it's side-effects, better to update the radio buttons from a separate observer:
ui <- fluidPage(
actionButton("buttonNext", "Next"),
radioButtons("radio", "Your Decision:",
choices = c("No Decision" = 'NoDec', "Yes" = 'yes', "No" = 'no'),
selected = 'NoDec'),
plotOutput("TimeSeriesPlot")
)
server <- function(input,output,session) {
clickNext <- reactive({
isolate(input_radio <- input$radio)
randomNumber <- input$buttonNext
print(c(input$buttonNext,randomNumber,input_radio))
return(randomNumber)
})
observeEvent(input$buttonNext,
{
updateRadioButtons(session,'radio',selected = -1)
})
output$TimeSeriesPlot <- renderPlot({
i <- clickNext()
plot(i)
})
}
shinyApp(server = server, ui = ui)
Hope this helps.
Thank you a lot!
How is it possible to save the data the user is inserting:
print(c(input$buttonNext,randomNumber,input_radio))
This should not be just printed, but it should be available to me later.
My plan is, that people evaluate my plots and then I see for each user the buttons he clicked for each plot.

clicking same plotly marker twice does not trigger events twice

I am using Plotly's event_data("plotly_click") to do stuff (opening a modal) after the user clicked on a marker in a scatter plot. Afterwards (e.g. closing the modal), event_data("plotly_click") does of course not change and clicking on the same marker therefore does not trigger the same action again.
Minimal example:
library(plotly)
ui <- fluidPage(
plotlyOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
mtcars %>% plot_ly(x=~disp, y=~cyl)
})
# Do stuff after clicking on a marker in the plot
observeEvent(event_data("plotly_click"), {
print("do some stuff now") # this is not executed after second click on same marker
})
}
shinyApp(ui, server)
I have tried workarounds with shinyjs's onclick, to no avail (it works well in empty areas of the plot but not when clicking on markers):
shinyjs::onclick(id="plot", print("clicked"))
I have also tried using a reactive Value that stores the last click and is reset immediately afterwards (e.g. by event_data("plotly_hover")), but all tries fail because event_data("plotly_click") remains in its old value.
Can anyone help?
[Edit: The issue has been fixed in Plotly 4.9.0. See answer below. This answer works up to Plotly 4.8.0. From plotly 4.9.0., delete the string .clientValue- from the source code or use below answer.]
I finally solved this issue. I know this is bothering some people, so I'll post my solution here:
Basically I use shinyjs package to reset the data about the last click (the source where event_data("plotly_click") gets its information from) on a certain event (a button in my case).
The definition of the function is (note that "A" needs to be replaced with plotly-source string if used):
extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-A', 'null'); }")
Then this is called upon button click by js$resetClick().
Minimal example:
library(shiny)
library(plotly)
library(shinyjs)
ui <- shinyUI(
fluidPage(
useShinyjs(),
# code to reset plotlys event_data("plotly_click", source="A") to NULL -> executed upon action button click
# note that "A" needs to be replaced with plotly source string if used
extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-A', 'null'); }"),
actionButton("reset", "Reset plotly click value"),
plotlyOutput("plot"),
verbatimTextOutput("clickevent")
)
)
server <- shinyServer(function(input, output) {
output$plot <- renderPlotly({
plot_ly(mtcars, x=~cyl, y=~mpg)
})
output$clickevent <- renderPrint({
event_data("plotly_click")
})
observeEvent(input$reset, {
js$resetClick()
})
})
shinyApp(ui, server)
The issue has finally been fixed on Plotly side: https://github.com/ropensci/plotly/issues/1043
event_data("plotly_click", priority = "event") updates on every click, not only on shiny input change (as before). Working from Plotly 4.9.0 on.
Minimal example using Plotly 4.9.0:
library(shiny)
library(plotly)
ui <- shinyUI(
fluidPage(
plotlyOutput("plot", height = 200),
verbatimTextOutput("time_last_click")
)
)
server <- shinyServer(function(input, output) {
output$plot <- renderPlotly({
plot_ly(mtcars[1,], x=~cyl, y=~mpg, size = 1)
})
output$time_last_click <- renderPrint({
tmp <- event_data("plotly_click", priority = "event")
Sys.time()
})
})
shinyApp(ui, server)
I had the same problem, and came up with a solution where I specified the source argument of the plotly object to be a reactive value as follows:
In plot_ly(data,x,y,...,source = x) and event_data(...,source = x) let x be an element of a reactiveValues object. When your event triggers, change the value of x (increment or hash), which instantiates a new event_data() object.
Worked like a charm.

Clear plotly click event

I'm trying to use plotly click events in the context of a shiny app. Following the official demo I'm using this bit of code to update a date picker and jump to another tab in my app on click:
observe({
d <- event_data("plotly_click", source = 'plot')
if(!is.null(d) & (input$navPanel == 'overview')) {
d %>% filter(curveNumber == 0) %>% select(x) -> selected_date
updateDateInput(session, "date", value = lubridate::ymd(selected_date$x))
updateTabsetPanel(session, "navPanel", selected = "details")
}
However, when I then try to switch back from the details to the overview tab, I get immediately thrown back to the details tab. I'm assuming that this happens because the event is never cleared, i.e. d is not null when the tab gets changed and so the condition in the if-clause evaluates to TRUE.
So, how do I clear the click event programmatically? Adding d <- NULL to the end of the conditional doesn't seem to do it.
I have same problem, and the workaround I've found is to store the old state in a global variable, and do the updates only when that variable changes and not on the !is.null()
selected_date <- 0 # declare outside the server function
server <- function(input, output, session) {
observe({
d <- event_data("plotly_click")
new_value <- ifelse(is.null(d),"0",d$x) # 0 if no selection
if(selected_date!=new_value) {
selected_date <<- new_value
if(selected_date !=0 && input$navPanel == 'overview')
updateDateInput(session, "date", value = lubridate::ymd(selected_date))
}
})
...
}
This also allows you to add a behaviour whenever the element is unselected
I solved this by using shinyjs and manually resetting the event_data("plotly_click") with the help of the Shiny.onInputChange function, which sets values in the input vector manually:
library(shiny)
library(plotly)
library(shinyjs)
ui <- shinyUI(
fluidPage(
useShinyjs(),
# code to reset plotlys event_data("plotly_click", source="A") to NULL -> executed upon action button click
# note that "A" needs to be replaced with plotly source string if used
extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-A', 'null'); }"),
actionButton("reset", "Reset plotly click value"),
plotlyOutput("plot"),
verbatimTextOutput("clickevent")
)
)
server <- shinyServer(function(input, output) {
output$plot <- renderPlotly({
plot_ly(mtcars, x=~cyl, y=~mpg)
})
output$clickevent <- renderPrint({
event_data("plotly_click")
})
observeEvent(input$reset, {
js$resetClick()
})
})
shinyApp(ui, server)

Add a panel in shiny that disappears on time

I need to place a text panel in my shiny app that disappears 10 seconds after it starts (like an advice), anyone know if it is posible? I've tryed to use the command "invalidLater", but it always appear again.
Thanks
Louro, J.
As #bunk is showing a good way is to use invalidateLater, here's some examples:
library(shinyjs)
ui <- shinyUI(
fluidPage(
tags$head(
tags$script(
HTML(
'
Shiny.addCustomMessageHandler("registerTimer", function(message){
console.log("Timer registered for $("+message.selector+")with delay "+message.delay);
setTimeout(removeElementFromDOM, message.delay, message.selector);
});
function removeElementFromDOM(selector){
$("#"+selector).remove();
}
'
)
)
),
uiOutput("ui1"),
textOutput("ui2"),
plotOutput("plt1"),
div(id="txtDiv","Some text here")
)
)
rm(active)
server <- shinyServer(function(input,output, session){
data <- data.frame("x"=runif(10),"y"=runif(10))
txt1 <- "Some text"
makeReactiveBinding('txt1')
makeReactiveBinding('data')
# Remove with javascript
session$sendCustomMessage('registerTimer',
message=list(selector='txtDiv',delay=4000))
# Hide with shinyjs
output$plt1 <- renderPlot({
if (is.null(data)){
hide("plt1")
} else{
plot(x~y,data)
}
})
output$ui2 <- renderText({
txt1
})
# Continously update, output nothing after time
output$ui1 <- renderUI({
invalidateLater(1000, session);
if ((active <<- exists('active'))) return()
div("Text here")
})
# Triggers change
reactiveTimer(2000,{
txt1 <- NULL
})
reactiveTimer(3000,{
data <- NULL
})
})
shinyApp(ui=ui,server=server)
ui1 uses the invalidateLater method, ui2 uses a reactive value that is set to NULL and plt1 is a variation of ui2 where shinyjs is used to hide the plotOutput.
Edited
I've added a Javascript solution to this you can use it on any element of the DOM.

Resources