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.
Related
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.
My Shiny app is getting a little long, as I'm plotting a variety of graphs in a number of panels. Accordingly, to help with some of the organization, I was wondering if it was possible to move the code for the graphs into a separate r-script, and call those graphs from the original r script.
Adding some further complication, the graphs that I'd like to display all require user input from the Shiny app.
Is it possible to use code from another script in R to plot graphs, and, if so, how? Additionally, as there will be multiple graphs, is it possible to specify which graph from the new r-script will go in the designated location, or will I need to create a separate r-script for each graph (which would defeat the purpose of increased organizational oversight)?
I've written some simplified, reproducible code (see below) that I hope will give you an idea of what I'm looking for. Essentially, I'd like any code that produces a graph within renderPlot() to come from a separate r-script.
Many thanks for any help!
library(shiny)
ui <- fluidPage(
mainPanel(
selectInput("input1","Select an option",choices = c("First","Second")),
plotOutput("plot1"),
plotOutput("plot2")
)
)
server <- function(input, output, session) {
output$plot1 = renderPlot({
if(input$input1=="First"){
##This is where I'd like to call the code for the graph from another sheet.
plot(1,main = input$input1)
}
if(input$input1=="Second"){
##Again, this is where I'd like to code for the graph from another sheet.
plot(2,main = input$input1)
}
})
output$plot2 = renderPlot({
if(input$input1=="First"){
##This is where I'd like to call the code for the graph from another sheet.
plot(1*rnorm(1,10,2),main = input$input1)
}
if(input$input1=="Second"){
##Again, this is where I'd like to code for the graph from another sheet.
plot(2*rnorm(1,50,2),main = input$input1)
}
})
}
shinyApp(ui, server)
You can make a function that takes arguments for the plot that you make like the data and plot title and then passes these arguments to your code that creates the plot. For example, say the only thing that changes is x and the plot title, you can define a function that takes those arguments and then uses them in the code to make the plot. Then you save this in a separate script and call the script using source() in your shiny app.
plots.R
plot_data <- function(x, y=NULL, plot.title){
if(is.null(y)) {
y <- seq(from = 1, by = 1, length.out = length(x))
}
plot(x, y, main = plot.title)
}
Load the function into your global environment using source('plots.R'), make sure plots.R is saved in the same location as your shiny app.
library(shiny)
source("plots.R")
ui <- fluidPage(
mainPanel(
selectInput("input1","Select an option",choices = c("First","Second")),
plotOutput("plot1"),
plotOutput("plot2")
)
)
server <- function(input, output, session) {
output$plot1 = renderPlot({
if(input$input1=="First"){
##This is where I'd like to call the code for the graph from another sheet.
plot_data(1, plot.title = input$input1)
}
if(input$input1=="Second"){
##Again, this is where I'd like to code for the graph from another sheet.
plot_data(2, plot.title = input$input1)
}
})
output$plot2 = renderPlot({
if(input$input1=="First"){
##This is where I'd like to call the code for the graph from another sheet.
plot_data(1*rnorm(1,10,2),plot.title = input$input1)
}
if(input$input1=="Second"){
##Again, this is where I'd like to code for the graph from another sheet.
plot_data(2*rnorm(1,50,2),plot.title = input$input1)
}
})
}
shinyApp(ui, server)
Of course this doesn't look like much of a difference, but with complex plots that span multiple lines, turning your plot code into a function will turn multiple lines into just one.
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 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)
})
I've been looking into ways to update a plot within an R Shiny application without having to re-render the whole plot. I'm working with temporal data which is animated via a Slider Input (animationOptions(playButton = TRUE)). The idea is to somehow highlight the part of the plot which is selected via the Slider Input. Re-rendering the whole plot at every animation step would make the whole application uselessly slow.
The most elegant solution with ggplot2 would have been, if shiny offered a way to add layers to the ggplot (e.g. + geom line()) and integrated this layer seamlessly into the plot without re-rendering it. Sadly, this does not seem to work. A bit of a hack could include creating a second ggplot-instance with exactly the same x/y-dimensions and overlapping the two plots.
EDIT:
I've just learnt that there are more javascript oriented plotting methods than ggplot2. For example, using dygraphs and adding a layer of dyShading, the selected area gets highlighted nicely. The basic question remains the same though, since changing the start- and end values of dyShading() seems to require re-rendering the whole plot.
library(shiny)
library(dygraphs)
library(xts)
data <- data.frame(
datetime = as.POSIXct("2016-06-20 17:00:00", tz = "UTC") + 1:100*60,
y = rnorm(100)
)
data_xts <- as.xts(data[,-1], data[,1])
minDatetime <- min(data$datetime)
maxDatetime <- max(data$datetime)
minY = min(data$y)
maxY = max(data$y)
plotlimits <- lims(x = c(minDatetime, maxDatetime), y = c(minY, maxY))
ui <- fluidPage(
sliderInput("timeslider", "Time Slider",
min = minDatetime,
max = maxDatetime,
value = c(minDatetime, minDatetime+10*60),
animate = animationOptions(interval=200)
),
dygraphOutput("dyplot")
)
server <- function(input, output) {
data_fil <- reactive({
data[data$datetime <= input$timeslider[2] & data$datetime >= input$timeslider[1],]
})
output$dyplot <- renderDygraph({
dygraph(data_xts) %>%
dyShading(
from = as.character(input$timeslider[1]),
to = as.character(input$timeslider[2]),
color = "tomato")
})
}
shinyApp(ui = ui, server = server)