I am building a UI containing DT tables and sliders (both as inputs), as well as plot outputs. The tables are used to make a selection out of several. The user can only select one cell to make a choice.
I want the user to be able to store the setting of tables and sliders because they are quite complex. The idea is that the user can then switch back and forth between two stored settings, for example, and see how the resulting plots change. When a user restores a setting, the tables and sliders get updated, which updates the plot(s).
The problem is that the plot is not updated once, but usually twice. It seems that there is a delay somewhere in the logic, causing Shiny to first react to the update of the sliders, then to the update of the tables, so that the plot is re-plotted in two steps. This is very annoying for two reasons: (1) it causes the calculation to re-run twice, making the app react twice as slow and (2) it's impossible to see the changes directly in the plot because the original plot is first replaced by an intermediate plot which has no meaning to the user.
To illustrate the problem, I created this minimum working example, where I reduced complexity to just one table and one slider. I added a 3 second Sys.sleep to simulate a long calculation because obviously one would not see the problem otherwise:
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button", "Preset"),
# No problem with selectInput:
# selectInput("select", "x", choices = names(iris)[1:4], selected = "Sepal.Length"),
DT::dataTableOutput("table"),
sliderInput("slider", "bins", min = 1, max = 50, value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
observeEvent(input$button, {
# updateSelectInput(session, "select", selected = "Petal.Width")
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
})
output$table <- DT::renderDataTable(
DT::datatable(
data.frame(x = names(iris)[1:4]),
rownames = FALSE,
selection = "single",
options = list(searching = FALSE, paging = FALSE, info = FALSE, ordering = FALSE)
)
)
output$distPlot <- renderPlot({
req(input$table_rows_selected)
# x <- iris[[input$select]]
x <- iris[[input$table_rows_selected]]
bins <- seq(min(x), max(x), length.out = input$slider + 1)
# Simulate long calculation:
Sys.sleep(3)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)
Clicking first on the cell "Sepal.Length" in the table, then on the button "Preset" will load the preset and demonstrate the problem.
It seems that this is a timing issue/race condition, because sometimes, it works OK and the plot is updated only once (only in the minimal example, not the actual app). Usually the first time after starting the app. But in that case, just click on "Sepal.Length" again and change the slider position, then click on the "Preset" button and usually the plot will update twice.
I noticed that the problem does not appear when I replace the table with a selectInput. But the tables have a certain meaning: they stand for morphological fields (see package morphr), so I'd rather stick with tables to have the right appearance.
I could obviuously also disable reactivity using isolate() as suggested here: R Shiny: how to prevent duplicate plot update with nested selectors? and then e.g. introduce a button "Update plot". But I would prefer to keep the app reactive to changes in the sliders and tables, because that's a very useful user experience and one reason for me to use Shiny instead of PHP/python/etc.
My first idea to solve the problem was to introduce a reactive value:
server <- function(input, output, session) {
updating <- reactiveVal(FALSE)
# ...
}
then change the value before and after the updates to the inputs:
observeEvent(input$button, {
updating(TRUE)
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
updating(FALSE)
})
and add an if statement in the renderPlot() code, e.g. with validate:
output$distPlot <- renderPlot({
validate(need(!updating(), ""))
# ...
})
But that has no effect, because the entire code in the observeEvent(input$button) runs first, setting updating to TRUE and immediately back to FALSE. But the code inside renderPlot() is executed later (after the invalidation has occurred) and updating is always FALSE when it runs.
So, at the moment I have few ideas how to solve this. It would be best if one could somehow disable reactivity for the plot, then update the inputs, enable reactivity again and trigger a plot update programmatically. But is this possible?
Any other ideas for a workaround?
I'm not sure to understand the issue. Does this solve the problem:
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
......
observeEvent(input$button, {
runjs("Shiny.setInputValue('slider', 15); Shiny.setInputValue('table_rows_selected', 4);")
selectRows(DT::dataTableProxy("table"), 4)
updateSliderInput(session, "slider", value = 15)
})
Related
I'm relatively new to R Shiny and reactive programming. From my understanding (and this tutorial), it seems like you are not supposed to tell Shiny "when" to do things (i.e. to enforce execution order) as it will figure that out itself. However, often I find myself wanting plots or other UI to render sequentially. Is there a good way to do this?
I've made up a minimal example below. I want to render header before plot, as plot requires a time-consuming computation.
library(shiny)
ui <- fluidPage(
tags$h1("My app"),
uiOutput("header"),
plotOutput("plot")
)
server <- function(input, output) {
output$header <- renderUI({
tagList(tags$h2("Section header"),
tags$p("Some information relevant to the plot below..."))
})
output$plot <- renderPlot({
# hypothetical expensive computation
Sys.sleep(2)
# hypothetical plot
hist(rnorm(20))
})
}
shinyApp(ui = ui, server = server)
Here I could obviously replace uiOutput("header") in ui with its definition in server and that solves the problem; however, in practice I want header to be dynamic. A hacky solution I found was to include a hidden input inside header and then use req() inside plot. This is kind of like adding an action button that automatically clicks upon load.
server <- function(input, output) {
output$header <- renderUI({
tagList(tags$h2("Section header"),
tags$p("Some information relevant to the plot below..."),
div(style = "display:none", textInput(inputId = "hidden", label = "", value = "x")))
})
output$plot <- renderPlot({
req(input$hidden)
...
})
}
However, if I want to repeat this in multiple situations or if I want to force a chain of more than two outputs to render sequentially, then this seems tedious. Can anyone suggest a more elegant solution?
As your example code includes a "time-consuming computation" I guess in the end you don't really want to control the render order, instead you want to avoid long running functions to block the execution of other parts of your code (XY problem).
By default, R is single threaded, therefore we'll need child processes to solve this issue.
In shiny you can use library(future) + library (promises) for this. However, using asynchronous processes to unblock the elements within a shiny session requires us to "hide" the promise - read more about it here.
Below please find an async version of your example:
library(shiny)
library(promises)
library(future)
plan(multisession)
ui <- fluidPage(
tags$h1("My app"),
uiOutput("header"),
plotOutput("plot")
)
server <- function(input, output) {
output$header <- renderUI({
tagList(tags$h2("Section header"),
tags$p("Some information relevant to the plot below..."))
})
data <- reactiveVal()
observe({
future_promise({
# hypothetical expensive computation
Sys.sleep(2)
# hypothetical plot data
rnorm(20)
}, seed=TRUE) %...>% data()
return(NULL) # "hide" the future_promise
})
output$plot <- renderPlot({
req(data(), cancelOutput = TRUE)
hist(data())
})
}
shinyApp(ui = ui, server = server)
In Shiny, for a given session, no outputs are sent back to the client, until all outputs are ready : the text render function isn't sent until the plot render function completes, see shiny flush cycle.
A workaround is to skip plot rendering using a reactiveVal so that the text gets displayed in a first flush cycle, and then to use invalidateLater() to launch a new flush cycle to run the longer plot rendering.
library(shiny)
ui <- fluidPage(
tags$h1("My app"),
uiOutput("header"),
plotOutput("plot")
)
server <- function(input, output,session) {
skipPlot <- reactiveVal(1)
output$header <- renderUI({
tagList(tags$h2("Section header"),
tags$p("Some information relevant to the plot below..."))
})
output$plot <- renderPlot({
if (isolate(skipPlot()==1)) {
# skip first reactive sequence
skipPlot(0)
# launch next reactive sequence
invalidateLater(1,session)
} else {
# hypothetical expensive computation
Sys.sleep(2)
# hypothetical plot
hist(rnorm(20))
}
})
}
shinyApp(ui = ui, server = server)
Depending on the choice in the drop-down list i want to implement a specific function.
selectInput("model","Choose Model",choices = c("d_SIR","d_SIRS","d_SEIR","s_SIR","s_SIRS","s_SEIR",'s_SIRadditive'))
For example, if the choice is d_SIR i want to implement the function for the d_SIR. Do i have to do it with if/else statements?
I can't speak to exactly the choices you describe, but I can answer the general question about using a selectInput for picking different functions to use with the app. This should be made clear through these examples using the familiar "Old Faithful" geyser data.
Using if/else conditionals
library(shiny)
# specify which functions users should be able to choose from
fun_choices <- c("barplot", "boxplot", "hist")
# specify the data that the app will be using, regardless of input
x <- faithful[, 2]
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
# get inputs here
selectInput("plot_fun",
"Choose plotting function",
choices = fun_choices),
# a conditional panel, only shown if user has selected 'hist'
# as the plotting function
conditionalPanel(
condition = "input.plot_fun === 'hist'",
sliderInput("bins",
"Number of bins",
min = 1,
max = 50,
value = 30)
)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
# we use conditionals to make sure that the "plot_fun" value
# is actually one of our suggested choices (so that the user can't
# trick the app into running any other functions than we want),
# and to use different sets of arguments depending
# on what function is chosen
if (input$plot_fun %in% c("barplot", "boxplot")) {
# here we deal with two functions that share the same set of arguments
# use `get` to fetch the actual function that the
# `plot_fun` string value corresponds to
plot_fun <- get(input$plot_fun)
plot_fun(x)
} else if (input$plot_fun=="hist") {
# here we deal with a function that has a unique set of arguments
plot_fun <- get(input$plot_fun)
bins <- seq(min(x), max(x), length.out = input$bins + 1)
plot_fun(x, breaks = bins, col = 'darkgray', border = 'white')
}
})
}
shinyApp(ui = ui, server = server)
A couple of things to note:
We're a bit clever and DRY with functions that use the same set of arguments. But when we need to pass different arguments to the different functions, here we use if/else conditionals.
It's important to compare the user-input values with your vector of "allowed" choices, to stop them from running malicious code. (a user might muck about with the HTML form input so that they can submit other input than your choices)
get() is key to making this work, as is remembering that functions are also objects, meaning you can refer to them with a variable, as in the example. Again, using get() like this is dangerous, which is why you really need to make sure that it's only used with inputs that you determine.
We embed the input that's only related to one function inside of a conditionalPanel, and make presentation of this panel dependent upon the user having selected the related function.
Using a list of lists and do.call
Instead of using if/else conditionals like we did above, we can specify a "list of lists", where each inner list holds the arguments of a function, and are linked to a "key" with the function's name.
library(shiny)
# specify which functions users should be able to choose from
fun_choices <- c("barplot", "boxplot", "hist")
# specify the data that the app will be using, regardless of input
x <- faithful[, 2]
# a list of lists which hold each function's set of arguments to be passed in
fun_args_list <- list(
barplot = list(
height = x
),
boxplot = list(
x = x,
main = 'Boxplot of waiting times'
),
hist = list(
x = x,
# inserting faux vector here, to be replaced with user input
# later in the server function
breaks = c(),
col = 'darkgray',
border = 'white',
main = 'Histogram of waiting times',
xlab = 'Waiting time'
)
)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
# get input here
selectInput("plot_fun",
"Choose plotting function",
choices = fun_choices),
# a conditional panel, only shown if user has selected 'hist'
# as the plotting function
conditionalPanel(
condition = "input.plot_fun === 'hist'",
sliderInput("bins",
"Number of bins",
min = 1,
max = 50,
value = 30)
)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
# now that the user input variable is available to us, we replace the
# faux "bin" argument data with values based on user input
bins <- seq(min(x), max(x), length.out = input$bins + 1)
fun_args_list$hist[['breaks']] = bins
# we use a conditional to make sure that the "plot_fun" value
# is actually one of our suggested choices (so that the user can't
# trick the app into running any other functions than we want),
if (input$plot_fun %in% fun_choices) {
# use `get` to fetch the actual function that the
# `plot_fun` string value corresponds to
plot_fun <- get(input$plot_fun)
# fetch the list of arguments (from our list of lists,
# which we defined at the top), using the name of
# the function as a "key"
fun_args <- fun_args_list[[input$plot_fun]]
}
# call the function "indirectly", by using `do.call` so that we can
# pass a list of arguments to the function
do.call(plot_fun, fun_args)
})
}
shinyApp(ui = ui, server = server)
Note:
do.call is what makes it possible for us to call the function without specifying the arguments in a function call one by one, instead passing a list which holds the necessary information. You can read more about do.call here.
Because of the way base R works, each time you want to "reference" the data in the "list of lists of arguments", the data are actually copied. So in our example, the "waiting time" data are actually copied three times. This isn't a problem with a small data set like in the example, but if you are dealing with larger data sets then I'd say it's better to bite the bullet and insert a bunch of if/else conditionals, rather than using this "list of lists" approach. Or you can try implementing "assignment by reference", which would avoid making copies, using e. g. the data.table package if you want - this SO thread seems like a good place to start.
I'm trying to create a Shiny app that lets users
create a dataset by entering frequency counts for different values
plot a histogram of that dataset
A paired back example of the code is as follows:
library(shiny)
library(ggplot2)
# Define UI for application
ui <- fluidPage(
# Sidebar with inputs
sidebarLayout(
sidebarPanel(
numericInput("data1s",
"How many have a score of 1?",
value = 0,
min = 0
),
numericInput("data2s",
"How many have a score of 2?",
value = 0,
min = 0
),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 3,
value = 1)
),
# Show a plot of the data
mainPanel(
htmlOutput("mydatatable"),
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#show the data
output$mydatatable <- renderTable({
#create the dataframe from the frequncies
mydata <- data.frame(our_data=c(rep(1,input$data1s),rep(2,input$data2s))
)
}
)
#show the histogram
output$distPlot <- renderPlot({
ggplot(mydata, aes(x=our_data)) +
geom_histogram(bins = input$bins)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have achieved the creation of the dataset, but the code for displaying a histogram of the data returns an error: "object 'mydata' not found" instead of showing the histogram. The histogram should update whenever any of the inputs are changed.
Any help to resolve would be much appreciated.
The mydata that you define in the mydatatable reactive is not visible anywhere else. To understand why, I suggest you read about R's namespaces and environments; one good tutorial on it is Hadley's Advanced R -- Environments.
To fix it, I suggest you make the data itself a reactive block, and depend on it in your two other blocks (table and plot):
server <- function(input, output) {
mydata <- reactive({
req(input$data1s, input$data2s)
data.frame(our_data=c(rep(1,input$data1s),rep(2,input$data2s)))
})
#show the data
output$mydatatable <- renderTable({ req(mydata()); })
#show the histogram
output$distPlot <- renderPlot({
req(mydata())
ggplot(mydata(), aes(x=our_data)) +
geom_histogram(bins = input$bins)
})
}
(Untested.)
I added the use of req solely to prevent start-up jittering and warnings/errors in the app. When the shiny app is warming up, it's common to have input variables empty (NULL), and things that depend on it will temporarily produce errors until the inputs stabilize. (For an example of why things will stumble, input$data1s may initially show a NULL value, and try to see if data.frame(our_data=rep(1,NULL)) will work.)
req just looks for something that is "truthy", meaning: not NULL, not NA, not FALSE, length greater than 0, etc. See ?shiny::req for more details.
While req is not strictly required, it has its advantages. As you may infer from the table code, req(x) will return the "first value that was passed in" (from ?req), so it can be used in this shortcut mode for brevity.
And one last soap-box: in my limited experience with shiny reactivity, there are few times that I've generated data within a reactive block and used it solely within that reactive block. Given that, whenever you make a data.frame (or list or ... some important structure that is dependent on user input), it is often beneficial to make it its own reactive component (specifically, not an output component), and then depend on it as many times as necessary.
I'm writing an R shiny app which should allow the user to create customisable plots of some data. The idea is that my app offers a "create new plot" button, which renders the plot and stores it in a reactive. A renderUI function "watches" this list and renders all plots in that reactive.
I found a couple of related questions r-markdown-shiny-renderplot-list-of-plots-from-lapply or shiny-r-renderplots-on-the-fly which however did not really help in my case. I hope I didn't miss a good answer somewhere (which I would assume there is because I think this is not a rare use case).
When implementing, I noticed a strange behaviour: When there is only one plot to be shown, everything works well. However, when I have n (n>1) plots, instead of rendering plot 1, plot 2, ..., plot n, the app only showed n times the plot n.
See my example app below. I simplified the problem by just letting the user choose the number of plots to be displayed. The renderUI function then has a loop creating thees plots in a variable p and then calls renderPlot(p). I assume shiny does some caching and for some reason fails to recognise that p changes in the loop?!
I found a workaround by replacing the renderPlot(p) by do.call("renderPlot", list(expr = p). This does the job but I'm still curious to learn why the direct renderPlot does not work.
Here is my example app:
library(shiny)
library(ggplot2)
# Define UI
ui <- shinyUI(fluidPage(
titlePanel("renderPlot Test"),
sidebarLayout(
sidebarPanel(
numericInput(inputId = "n", label = "Number of Plots", value = 1L, min = 1L, max = 5L, step = 1L),
checkboxInput(inputId = "use_do.call", label = "use 'do.call'", value = FALSE)
),
mainPanel(
uiOutput("show_plots")
)
)
))
# Define server logic
server <- shinyServer(function(input, output) {
output$show_plots <- renderUI({
ui <- tags$div(tags$h4("Plots"))
for( i in 1:input$n ) {
p <- ggplot() + ggtitle(paste("plot", i))
if( input$use_do.call ) { # this works
ui <- tagAppendChild(ui, do.call("renderPlot", args=list(expr=p, width = 200, height = 200)))
} else { # this doesn't ...
ui <- tagAppendChild(ui, renderPlot(p, width = 200, height = 200))
}
}
return(ui)
})
})
# Run the application
shinyApp(ui = ui, server = server)
I agree with #JonMinton, and I've had the same problem. I've found that when I reuse the same variable to save the plots and render them (such as what you do with p), the plots get overwritten by the next plot and only the final plot is copied n times like you said.
To get around this, I define a new variable for each plot, which may not be sustainable for your project, but it is a workaround.
Reactive expressions in Shiny propagate changes where they need to go. We can suppress some of this behaviour with isolate, but can we suppress changes being propagated based on our own logical expression?
The example I give is a simple scatterplot, and we draw a crosshair with abline where the user clicks. Unfortunately, Shiny considers the result to be a new plot, and our click value is reset to NULL... which in turn is treated as an update to the value to be propagated as usual. The plot is redrawn, and NULL is passed to both arguments of abline.
My hack (commented out below) is to place a condition in the renderPlot call which updates some non-reactive variables for the plotting coordinates, only when the click values are non-NULL. This works fine for trivial plots, but it actually results in the plot being drawn twice.
What's a better way to do this? Is there a correct way?
Server file:
library(shiny)
shinyServer(function (input, output)
{
xclick <- yclick <- NULL
output$plot <- renderPlot({
#if (!is.null(input$click$x)){
xclick <<- input$click$x
yclick <<- input$click$y
#}
plot(1, 1)
abline(v = xclick, h = yclick)
})
})
UI file:
library(shiny)
shinyUI(
basicPage(
plotOutput("plot", click = "click", height = "400px", width = "400px")
)
)
Winston calls this problem "state" accumulation - you want to display not only the current data, but something generated by the previous plot (the best place to learn about this is at https://www.rstudio.com/resources/videos/coordinated-multiple-views-linked-brushing/)
The basic idea is to create your own set of reactive values, and update them when the user clicks on the plot. They won't be invalidated until the next click, so you don't get circular behaviour.
library(shiny)
shinyApp(
shinyUI(basicPage(plotOutput("plot", click = "click"))),
function(input, output) {
click <- reactiveValues(x = NULL, y = NULL)
observeEvent(input$click, {
click$x <- input$click$x
click$y <- input$click$y
})
output$plot <- renderPlot({
plot(1, 1)
abline(v = click$x, h = click$y)
})
}
)