Generating dynamic number of datatables without rerendering - r

I am wondering what the best practice is for handling a dynamic number of datatables. Here is a toy example:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
mainPanel(
sliderInput("number","Number of tables",1,10,1,1),
uiOutput("tables")
)))
server <- shinyServer(function(input, output, session) {
observe({
lapply(seq_len(input$number), function(i) {
output[[paste0("table",i)]] <- DT::renderDataTable(head(mtcars))
})
})
output$tables <- renderUI({
lapply(seq_len(input$number), function(i) {
DT::dataTableOutput(paste0("table",i))
})
})
})
# Run the application
shinyApp(ui = ui, server = server)
This approach is sort of a blunt tool, because you have to rerender all the datatables, whenever a single datatable is added or removed.
Is there a better approach to dynamically generating output that doesn't require creating all the output in a loop, and therefore recreating all the output each time there is a change?

I'm the author of insertUI and removeUI. It seems like you found a bug in insertUI when applied to interactive outputs. I filed an issue for this in the Shiny repo and will try to get to it soon. In the meantime, a workaround is to use where = "beforeBegin" instead of where = "beforeEnd" in the call to insertUI(). See my answer to the original issue filed in the DT repo for more details.

[Edit] Answer has been updated with the workaround from #Bárbara Borges (see her answer for details on why it works)
Here is an example, but note that it is working for normal tables (no refresh), but for datatables, there is no refresh when removing tables but always refreshing when adding tables. I think this is something caused by DT but haven't found the real cause yet. I am posting in the hope that someone can improve this.
library(shiny)
library(DT)
numUI <- 0
ui <- shinyUI(fluidPage(
mainPanel(
sliderInput("number","Number of tables",1,10,1,1),
tags$div(id="tables")
)))
server <- shinyServer(function(input, output, session) {
observe({
if (input$number > numUI) {
for (num in (numUI+1):input$number) {
insertUI("#tables", "beforeBegin", DT::dataTableOutput(paste0("table", num)))
output[[paste0("table",num)]] <- DT::renderDataTable(head(mtcars), server = FALSE)
}
}
if (input$number < numUI) {
for (num in (input$number+1):numUI) {
removeUI(paste0("#table", num))
}
}
numUI <<- input$number
})
})
# Run the application
shinyApp(ui = ui, server = server)

Related

Why R's error handling functions not working in shinyApp?

To reproduce :
library(shiny)
library(DT)
testdf<-c("car1",sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))
testdf<-rbind(testdf,c("car2",sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1)))
testdf<-data.frame(testdf)
shinyApp(
ui = fluidPage(
tabPanel("tab1",dataTableOutput("datatable")),
actionButton("CheckFile", "Refresh data")
),
server = function(input, output, session) {
X = testdf
output$datatable = renderDataTable(
{X},selection = list(mode = 'single',target = 'cell')
)
observeEvent(input$CheckFile, {
tryCatch(eval(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))))
#same with evaluate function
#evaluate(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1)))
removeModal()
showModal(modalDialog(
title="Refresh done",
footer=NULL,
easyClose=T
))
})
}
)
My app is rendering a table. I want to give the user the possibility to update this dataset with an actionButton(). It then calls an other R file that update this dataset with source(). However, this script may contain some errors and stops before the end. So I chose to handle errors with tryCatch() and eval(). The problem is that these two functions inside my shiny app avoid the update of the dataset.
I made this reproducible example to illustrate the problem.
When I'm only running this line the dataset is updated:
tryCatch(eval(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))))
But in the app, it is not the case.
Any idea?
Thanks in advance.

Shiny promises future is not working on eventReactive

I have an inputButton than when you click it, 2 querys to mysql database are done. One is a heavy one (more than 10 secs) and the other is light (less than 0.01sec to get data).
As I want to show the result of this querys on shiny app, I have intendeed to use Promises and Future packages for asyncronous loading.
In the example that I show you of my code, I have simulated the SQL querys with the function heavyFunction, which is intended to simulate the heavy query and the ligth one time loads.
The issue is that this code is not working for me, because the results of the light query are not shown till the heavy query is done.
Note: In the Rstudio console, this code works perfect...
library(future)
library(promises)
plan(multiprocess)
heavyFunction <- function(n){
Sys.sleep(n)
print(n)
}
ui <- fluidPage(
actionButton("go","Show the data"),
textOutput("result0sec"),
textOutput("result10sec")
)
server <- function(input,output,session){
data0 <- eventReactive(input$go,{
heavyFunction(0)
})
data10 <- eventReactive(input$go,{
heavyFunction(10)
})
output$result0sec <- renderText({
data <- data0()
future(data)%...>%print()
})
output$result10sec <- renderText({
data <- data10()
print(data)
})
}
shinyApp(ui,server)
What I'm doing wrong?
Welcome to SO!
This thread discusses the same issue.
Please also see the detailed answer from Joe Cheng on GitHub.
The main problem you are experiencing is reflected by his following statement:
The goal, at least for this release of Shiny, is not to allow this
kind of intra-session responsiveness, but rather, inter-session; i.e.,
running an async operation won't make its owning session more
responsive, but rather will allow other sessions to be more
responsive.
However, there are ways to work around this behaviour by running the future in a background R process with e.g. library(callr) or more convenient library(future.callr) and it's plan(callr).
Here is a working version of your code:
library(future)
library(promises)
library(future.callr)
plan(callr)
heavyFunction <- function(n) {
Sys.sleep(n)
print(n)
}
ui <- fluidPage(
br(),
actionButton("go", "Show the data"),
br(), br(),
textOutput("result0sec"),
textOutput("result10sec")
)
server <- function(input, output, session) {
futureData <- reactiveValues(data10 = NULL)
data0 <- eventReactive(input$go, {
heavyFunction(0)
})
observeEvent(input$go, {
myFuture <- future({
heavyFunction(5)
})
then(
myFuture,
onFulfilled = function(value) {
futureData$data10 <<- value
},
onRejected = NULL
)
return(NULL)
})
output$result0sec <- renderText({
data0()
})
output$result10sec <- renderText({
req(futureData$data10)
})
}
shinyApp(ui, server)
The most important point here is to realize, that you shouldn't return your future directly, otherwise it will block all other actions - the observer returns nothing, it only has the side-effect of triggering the callback-function.

Reset and clear out Shiny text output using reset button

I am creating a calculator that takes multiple inputs and prints the calculation after clicking 'Calculate'. I also provide a reset button that successfully resets the input values back to their default.
The reset button should also clear the previously printed output (basically I want it to look exactly like it did when you first open the app).
Below is a simplified and still functioning example of the calculator.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id="form",
sidebarLayout(
sidebarPanel(
numericInput("x","X",0),
numericInput("y","Y",0)
),
mainPanel(
br(),
column(width=6,actionButton("calc", "Calculate")),
column(width=6,actionButton("reset", "Reset")),
br(),br(),br(),
textOutput("sum"))
)
))
# Define the server logic
server <- function(input, output) {
output$sum <- renderText({
req(input$calc)
isolate(paste("X + Y =", input$x + input$y))
})
observeEvent(input$reset, {
reset("form")
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have tried a few approaches offered on here for other, seemingly similar questions but I haven't managed to get them to work. I would offer some examples of what I've done but I've lost track of them at this point and I'm hoping there's just some obvious, simple answer that I've overlooked. I'm fairly new to Shiny, though, so details of why a possible answer works would also be appreciated!
Edited to based on comments.
I think the simplest observer would be:
# two observers
server <- function(input, output) {
observeEvent(input$calc, {
output$sum <- renderText({
req(input$calc)
isolate(paste("X + Y =", input$x + input$y))
})
})
observeEvent(input$reset, {
output$sum <- renderText({
})
})
}

Shiny UI Module Issue: server module not updating choices with reactive expression

I am having a lot of trouble getting a search filtering module working.
I am to run stats on a large database of cat owner information.
I want my search module to bring up a list of possible owners(that the user can select from) based on a selection from a list of cat breeds.
I thought wrapping the updateSelectInput with observe and using a reactive cat owner expression would facilitate this, in the module, but it is not working( and I can't guess why this is happening or how to debug this). It worked in these other posts([1]:R shiny passing reactive to selectInput choices , [2]:using values from a reactive input to directly input into a custom function)
Why won't my selectInput update with cat owners?
library(shiny)
df=data.frame(
cat=c("tabby","DSH","MSH","LSH","DSH","MSH","LSH","sphinx"),
owner=c("Foo","Bar","Bash","Foo","Foo","Foo","Bar","Bash"),stringsAsFactors = F)
refinedSearch<-function(input, output, session){
ownsCat<-reactive({df[df$cat%in%input$cat,"owner"]})
observe({updateSelectInput(session, "ownerSelected",
label ="Owned By",choices = ownsCat())})
return()
}
refinedSearchUI<-function(id){
ns <- NS(id)
fluidRow(
column(4,selectInput(ns("cat"),"Cat",selectize = T,
choices =c("tabby","DSH","MSH","LSH","sphinx") )),
column(4,selectInput(ns("ownerSelected"),"Owned By","",selectize = T))
)
}
ui <- fluidPage(
h1("Find cats owners"),
fluidRow(column(10,offset=1, refinedSearchUI("tmp"))),
fluidRow(column(10,offset=1, actionButton("addFilter","Add a Filter",
icon = icon("plus"))))
)
server <- function(input, output,session) {
refinedSearch(input,output,session)
observeEvent(input$add, {insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearch(input,output,session))})
}
shinyApp(ui = ui, server = server)
Thank y'all for you time.
There seems to be quite a bit of confusion on how to call modules. You need to use the callModule() function in the server. Also, when inserting UI (using the insertUI()function), you need to call the refinedSearchUI() function, not the refinedSearch() function (which, again, should always be called through callModule(), so it should never actually get called directly like that).
I'd recommend a re-reading of the modules article.
You also have a typo. The event in your observeEvent() function should be input$addFilter, not input$add (which doesn't exist, so that observer is never fired..)
If you change your server function to this, your app will work as expected:
server <- function(input, output,session) {
callModule(refinedSearch, "tmp")
observeEvent(input$addFilter, {
id <- paste0("filter_", input$add)
insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearchUI(id))
callModule(refinedSearch, id)
})
}

R Shiny modules with conditionalPanel and reactives

I am trying to modularize a complex Shiny app for which I have a conditionalPanel that should only appear given a certain input state.
Before I made everything modular, the input and conditionalPanel were both in ui.R, and I could reference the input using something like this:
conditionalPanel("input.select == 'Option one'", p('Option one is selected'))
Now that I have modularized things, accessing the input is more complicated. I thought the following was the way to do it, but it doesn't quite work. (Here I've combined things into a single standalone script):
library(shiny)
## Module code for 'selectorUI' and 'selector'
selectorUI <- function(id) {
ns <- NS(id)
selectizeInput(inputId = ns('select'),
label = 'Make a choice:',
choices = c('Option one', 'Option two'))
}
selector <- function(input, output, session) {
reactive(input$select)
}
## Main app
ui <- shinyUI(fluidPage(
selectorUI('id1'),
conditionalPanel(condition = "output.selected == 'Option one'", p('Option one is selected.'))
))
server <- shinyServer(function(input, output, session) {
output$selected <- callModule(selector, 'id1')
})
shinyApp(ui = ui, server = server)
I think this should work, but it doesn't - it only works if I make another reference to output$selected in the main ui section:
ui <- shinyUI(fluidPage(
selectorUI('id1'),
textOutput('selected'), ## Adding just this one line makes the next line work
conditionalPanel(condition = "output.selected == 'Option one'", p('Option one is selected.'))
))
Unfortunately of course this has the unwanted effect of rendering the result of textOutput('selected'). I can only guess that the reason this works is because it somehow triggers the reactive in a way that the JavaScript reference alone does not.
Any idea how I should be getting this conditionalPanel to work properly?
Thank you..
EDIT: Turns out not actually a bug: https://github.com/rstudio/shiny/issues/1318. See my own answer below.
But also note that I actually like the renderUI solution given in the accepted answer better than my original conditionalPanel approach.
After calling the module the ID of selectizeInput is id1-select. In javaScript there are two ways of accessing object properties:
objectName.property or objectName['property']
Since there is - in the ID we have to refer to it via string, so the second method is way to go.
The condition in conditionalPanel becomes:
input['id1-select'] == 'Option one'
Full example:
library(shiny)
## Module code for 'selectorUI' and 'selector'
selectorUI <- function(id) {
ns <- NS(id)
selectizeInput(inputId = ns('select'),
label = 'Make a choice:',
choices = c('Option one', 'Option two'))
}
## Main app
ui <- shinyUI(fluidPage(
selectorUI('id1'),
conditionalPanel(condition = "input['id1-select'] == 'Option one'",
p('Option one is selected.'))
))
server <- shinyServer(function(input, output, session) {
})
shinyApp(ui = ui, server = server)
EDIT:
This does work, but doesn't it violate the notion of modularity? You would have to know the code for the module internally calls that input 'select' in order to construct 'id1-select'.
Yes, you're right.
According to this article, the trick you used i.e. assigning a module call to the output$selected and then accessing its value on the client side via output.selected should work but it doesn't. I don't know why...it is maybe a bug. (I have the newest shiny version from github)
The only thing I can think of is to use renderUI instead of conditionalPanel as in the example below:
library(shiny)
## Module code for 'selectorUI' and 'selector'
selectorUI <- function(id) {
ns <- NS(id)
selectizeInput(inputId = ns('select'),
label = 'Make a choice:',
choices = c('Option one', 'Option two'))
}
selector <- function(input, output, session) {
reactive(input$select)
}
## Main app
ui <- shinyUI(fluidPage(
selectorUI('id1'),
uiOutput("dynamic1")
))
server <- shinyServer(function(input, output, session) {
output$dynamic1 <- renderUI({
condition1 <- callModule(selector, 'id1') # or just callModule(selector, 'id1')()
if (condition1() == 'Option one') return(p('Option one is selected.'))
})
})
shinyApp(ui = ui, server = server)
Turns out it actually isn't a bug, just a little tricky. According to Joe Cheng,
Right--we don't, by default, calculate/render output values if they aren't going to be visible. And if we don't calculate them, you can't use them in conditions.
You can change this behavior this by setting an output to calculate every time, you can use this in your server.R (replace outputId with the corresponding value):
outputOptions(output, "outputId", suspendWhenHidden = FALSE)
So to fix the problem with my original example, we only need to add that one line to the server function:
server <- shinyServer(function(input, output, session) {
output$selected <- callModule(selector, 'id1')
outputOptions(output, 'selected', suspendWhenHidden = FALSE) # Adding this line
})

Resources