In my R shiny app, I have many tabPanels in my tabsetPanel.
The charts of a specific tab won't begin to load until I click that tab.
So it takes a long time to just go through the contents of all tabs.
Is there any way to let all tabs process first when the app is launched so all the charts are already there when I go to different tabs?
I created a simple example with two histograms:
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(100000000), col = 'darkgray', border = 'white')
})
output$distPlot2 <- renderPlot({
hist(rnorm(100000000), col = 'red', border = 'white')
})
outputOptions(output,"distPlot2",suspendWhenHidden = FALSE)
}
ui <- fluidPage(
tabsetPanel(
tabPanel("1",plotOutput("distPlot")
),
tabPanel("2",plotOutput("distPlot2")
)
)
)
shinyApp(ui = ui, server = server)
I timed the loading of these two histgrams and found that the option suspendWhenHidden = FALSE is not working here. How to fix it?
You can use suspendWhenHidden parameter for shiny::outputOptions to control rendering behavior:
suspendWhenHidden. When ‘TRUE’ (the default), the output
object will be suspended (not execute) when it is hidden on
the web page. When ‘FALSE’, the output object will not
suspend when hidden, and if it was already hidden and
suspended, then it will resume immediately.
If that's not enough you can execute expensive part of you code either when application starts (outside server function), or per user (in server outside render blocks).
Related
I am displaying widgets within a DT datatables in an R Shiny app.
Following a similar approach to here, widgets are inserted as text into the data table. Then using the option escape = FALSE, the text of the widgets is interpretated as HTML and the widget is displayed.
This approach has worked very well, until I came to redraw the datatable. On redraw the widgets within the table no longer appear. You can test with the following example. When "Redraw" is clicked, the UI output showing the text "here" disappears.
# UI
ui = fluidPage(
actionButton("draw", "Redraw"),
# uiOutput("ui"),
DT::dataTableOutput("classify_table")
)
# server
server = function(input, output, session) {
output$ui = renderUI({ p("here") })
output$classify_table <- DT::renderDataTable({
df = data.frame(
rows = input$draw,
UI = as.character(uiOutput("ui")),
stringsAsFactors = FALSE
)
DT::datatable(
df,
escape = FALSE,
options = list(
dom = "t",
preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
})
}
# run
shinyApp(ui, server)
My best hypothesis is that Shiny ends up with two uiOutput("ui") bound. This would mean it does not display at the uiOutput("ui") in the redrawn table.
Supporting this hypothesis: if we uncomment uiOutput("ui") from line four, then the text "here" never appears in the data table, just like after redrawing.
Contrary evidence: the whole point of the callbacks is to unregister the previous uiOutput("ui") and to reregister the new uiOutput("ui") which should prevent this cause.
Any idea what is causing this behavior and how to fix it? Even suggestions for how to better debug this behavior would be helpful.
Another possible solution is to bind the UI component to shiny directly, instead of in the callback. But I don't know how to determine the JavaScript for this.
Based on the comment from #Stéphane Laurent, I found this answer by them (search term user:1100107 [dt] unbind).
I inserted this code into the UI
tags$script(HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})"
))
and this code at the start of the DT::renderDataTable({:
session$sendCustomMessage("unbindDT", "classify_table")
Note that if working in a module, we need to wrap with ns as so:
session$sendCustomMessage("unbindDT", ns("classify_table"))
I am building an shiny app, where users upload a bunch of data and than choose which should be computed. The computation itself is rather timeconsuming and should be stored in a list. To keep shiny responsive during the calculation (for the user and other users) I tried to utilize promises and future. The problem is that I am not able to get an input into future function. I always get Warning: Error in $: Can't access reactive value 'mem_pos' outside of reactive consumer. i Do you need to wrap inside reactive() or observe()? [No stack trace available]. I tried to read about reactive but I am simply stuck.
Here is a minimal example of the problem (to display it, the list has only one value each):
library(shiny)
library(promises)
library(future)
plan(multisession)
# example function
subfct = function(n) {
Sys.sleep(3)
return(n*2)
}
# shiny page
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
actionButton("mem_button", label="set mem value")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
superval = reactiveValues(mem = rep(list(0), 10))
# set the future calculations
observeEvent(input$mem_button, {future({return(subfct( input$mem_pos ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lies the problem
# show result table
observe( {output$result = renderTable({unlist(superval$mem)})})
}
# Run the application
shinyApp(ui = ui, server = server)
If the problematic line is exchanged by observeEvent(input$mem_button, {future({return(subfct( 5 ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) it basically works. But I am not able to get the user input into the function. I am grateful for a direct help or an explanation of reactive for my specific problem.
I solved it. Not enterily sure why, but isolate does the trick.
This code works for me:
library(shiny)
library(promises)
library(future)
plan(multisession)
# example function
subfct = function(n) {
Sys.sleep(3)
return(n*2)
}
# shiny page
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("mem_pos", min = 1, max = 30, value = 1, label="mem pos"),
actionButton("mem_button", label="set mem value")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
superval = reactiveValues(mem = rep(list(0), 10))
# set the future calculations
observeEvent(input$mem_button, {future({return(subfct( isolate(input$mem_pos) ))}) %...>% {superval$mem[[input$mem_pos]] = .}}) # here lied the problem
# show result table
observe( {output$result = renderTable({unlist(superval$mem)})})
}
# Run the application
shinyApp(ui = ui, server = server)
You may try to use delay() function from shinyjs package. This enables the code to run only after the times set lapses. e.g.
library(shinyjs)
ui<-fluidPage(useShinyjs(),
...)
server<-function(input,output, session){
delay (ms=,
...)
}
shinyApp(ui,server)
I developed a dashboard to monitor covid-19 cases in Brazil using shiny and flexdashboard. It's working fine, but not on mobile devices (at least in some of them). At the sidebar there is a selectinput() with multiple=TRUE, and the problem is that every time the mobile user tries to select a value to update the plots, the screen keyboard is shown and the whole app is realoaded before the selection (for the correct usage the user needs to select the states and click on "Atualizar" button to update).
I tried to solve it by duplicating the siderbar section, and use {.no-mobile} for the first one, and {.mobile) for the second, and using multiple=FALSE in this second selectinput(). Unfortunately it won't work, and both sections were shown overlapping.
I thought about another way (and i don't know how to do it), using something like multiple=ifelse("is mobile test",FALSE,TRUE).
My questions are: Is there a way to test if the browser is mobile? Is there another approach do solve this problem?
Any help will be highly appreciated.
App link (code embed): https://costafilho.shinyapps.io/monitor_covid19/
Github project: https://github.com/sergiocostafh/monitor_covid19
Problematic line:
selectInput("estado",h3("Estados"),choices = est_nome, selected = "Sao Paulo", multiple = TRUE)
Could you try this app on your mobile:
library(shiny)
js <- '
function(){
$(".selectize-input input").attr("readonly", "readonly");
}
'
shinyApp(
ui = fluidPage(
selectizeInput("variable", "Variable:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear"),
multiple = TRUE,
options = list(onInitialize = I(js))
),
tableOutput("data")
),
server = function(input, output) {
output$data <- renderTable({
mtcars[, c("mpg", input$variable), drop = FALSE]
}, rownames = TRUE)
}
)
The keyboard should not appear.
I am very new to programming in R/Shiny: I'll try my best to state my question precisely.
The app below is a simple app of choice between two alternatives. In the app, option A updates every time that one clicks on one of the action buttons, while option B stays fixed.
What I am trying to do is to disable both action buttons after each time that the plot is updated, to "force" the user to stare at the two updated alternatives for at least a minimum number of seconds (in the code below, 3).
Since the plot updates every time one clicks on an action button, I have tried using Sys.sleep(3) between the disable and enable functions (in the shinyjs package) inside observeEvent(input$action2_pe,...) and observeEvent(input$action1_pe,...) but this only invalidates both buttons while the plot is still updating, so that as a result the buttons get disabled and then enabled again only before the plot gets updated.
Another equivalent attempt (code below) has been using Sys.sleep(3) between the disable and enable functions inside observe({output$plotA=renderPlot({...}) and observe({output$plotB=renderPlot({...}) but the same result as above obtains (i.e. it disables and enables the button before showing the updated plot).
Any idea/suggestion on how to get to disable and then enable again the buttons only after the plot gets updated each time?
Thank you in advance for your help!
library(shinyjs)
library(shiny)
ui <- fluidPage(id="main",title="Example disable-enable actionbutton after plotoutput update",
shinyjs::useShinyjs(),
fluidRow(wellPanel(
splitLayout(cellWidths = c("50%", "50%"),
column(12,align="center",
plotOutput("plotA",width="100%"),
actionButton("buttonA", label = "Choice A")),
column(12,align="center",
plotOutput("plotB",width="100%"),
actionButton("buttonB", label = "Choice B")
)))))
server <- function(input, output, session) {
rv=reactiveValues()
range=10
######
s_data=data.frame(X2=c(500,400,300,200,100), Y2=c(0,0,0,0,0))
q=1
m=dim(s_data)[1]
s_data=s_data[sample(1:m,m),]
rv$X2=s_data[q,"X2"];
rv$Y2=s_data[q,"Y2"];
observe({rv$pres=0.5*(rv$X2 + rv$Y2)})
observe({rv$dmin=rv$Y2 ; rv$dmax=rv$X2})
rv$q=1
####
fun=function(a1,b1,c1){
totlength=100
plot(NA,xlim=c(-10,totlength),ylim=c(0,10),
axes=F,xlab="",ylab="")
if (b1>a1){
text(45,0,paste("Adopt", round(c1,digits=0), "cats" ,"in", 2 , "days"))
}
if (a1>b1){
text(45,0,paste("Adopt", rv$X2, "cats" ,"in", 10 , "years"))
}
}
####
step_pe=reactive((rv$dmax-rv$dmin)<=range)
observe({output$plotA=renderPlot({
par(fig = c(0,1,0,1))
fun(1,2,rv$pres)
shinyjs::disable("buttonA")
shinyjs::disable("buttonB")
Sys.sleep(3)
shinyjs::enable("buttonA")
shinyjs::enable("buttonB")
})})
observe({output$plotB=renderPlot({
par(fig = c(0,1,0,1))
fun(2,1,rv$pres)
shinyjs::disable("buttonA")
shinyjs::disable("buttonB")
Sys.sleep(3)
shinyjs::enable("buttonA")
shinyjs::enable("buttonB")
})})
observeEvent(input$buttonA,{
if(!step_pe()){
rv$dmax=rv$pres
temp1=round(0.5*(rv$dmin+rv$pres)/range)
rv$pres=range*temp1
}
})
observeEvent(input$buttonB,{
if (!step_pe()){
rv$dmin=rv$pres
temp1=round(0.5*(rv$dmax+rv$pres)/range)
rv$pres=range*temp1
}
})
}
shinyApp(ui = ui, server = server)
I am trying to make an app that allow user to input data and then let shiny server to calculate some results, for example, I could make shiny generate a plot or a data table.
However, due to the space of the UI, I kind of "run out of" space. The input box, and documentation of the app take a whole screen. And when the shiny generate the results it will show at the very bottom of the screen.
Is there a way that I can make shiny pop-up a message box to show the result?
My sudo-code would be:
ui <- fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
actionButton("demo", "Fill in fields with demo"))
server <- function(input, output, session) {
observeEvent(input$demo, {
****************************
OpenNewPage/MoveScreenDown()
****************************
updateTextInput(session, "text", value = H)
updateNumericInput(session, "age", value = "30")
})}
When clicking the "demo", a message box popup or I can make the screen move to the result part and allow the text to be at the top of the screen.
There are options to show your results in a separated window. But maybe will be easier to have everything on the same window.
You can use the shinyBS library to create a modal window to show the plot. Another option is to use JavaScript to move the scroll to the bottom of the page. I put the two options in the following example, so you can see which one is better for you.
library(shiny)
library(shinyBS)
runApp(list(
ui = shinyUI(fluidPage(
textInput("text", "Name"),
numericInput("age", "Age", 20),
# option 1, using ShinyBS with a modal window
actionButton("demo", "Using a modal"),
# modal window to show the plot
bsModal("largeModalID","Results", "demo", size = "large", plotOutput('plot')),
# Option 2, action button with a JavaScript function to move the scroll to the bottom
# after drawing the plot.
actionButton("demoJS", "Using JS",
# there is a delay to allow the renderPlot to draw the plot and you should
# change it according to the processes performed
onclick = "setTimeout( function() {
$('html, body').scrollTop( $(document).height() );},
300)"),
# to plot the results after click on "Using JS"
uiOutput("plotUI")
)
),
server = shinyServer(function(input, output, session) {
output$plot <- renderPlot({
# simple plot to show
plot(sin, -pi, 2*pi)
})
output$plotUI <- renderUI({
# this UI will show a plot only if "Using JS" is clicked
if (input$demoJS > 0)
# the margin-top attribute is just to put the plot lower in the page
div(style = "margin-top:800px", plotOutput('plot2'))
})
output$plot2 <- renderPlot({
# another simple plot,
plot(sin, -pi, 2*pi)
})
})
))
If you think that the JavaScript option works better for you, you could consider start using the shinyjs library, it includes very useful functions and you can easily add your own JavaScript code to your Shiny Apps.