I am developing a shiny application that needs to show a variable number of elements in the screen. Since, I have no previous idea of how many items there are, I chose to use the uiOutput and on my server.R I use the renderUI to build the dynamic UI. When I have only a few items, it works perfectly, but when there are a lot of items (which is my case) it takes way too long to load the page because it renders all of them at once.
Since only a few of the items are visible on screen at each time, I was thinking about doing some sort of pagination or lazy loading but I could not find how to implement this in shiny.
Here is a simplified version of my renderUI function:
output[['custom.ui']] <- renderUI({
lapply(1:nrow(items), function(i) {
# Some code
box(my_custom_ui())
})
})
I tried using the withSpinner with no success. It shows the spinners, but they all render at the same time.
output[['custom.ui']] <- renderUI({
lapply(1:nrow(items), function(i) {
ui.id <- str_glue('box_{i}')
output[[ui.id]] <- renderUI({
# Some code
box(my_custom_ui())
})
uiOutput(ui.id) %>% withSpinner()
})
})
Related
I'm attempting to design a Shiny App where the user changes several inputs, then presses a "Plot" button to generate new visualizations. Currently, I have the a data object being generated in an eventReactive tied to the "Plot" button, with that data then getting fed into the renderPlot functions.
The framework seems to work, except that the plots will change whenever the inputs are changed. This often leads to errors in the plots, as different inputs load in different data. Pressing the "Plot" button after changing the inputs will cause the correct plots to render, but I'm trying to find a way to ensure that the plots don't change ever until that button is hit.
I believe the solution is a use of the "isolation" function, and I've tried that just about everywhere. However, none of these attempts have been successful. Below is a (simplified) setup of my code.
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# several selectInput options
actionButton('plot', label = 'Plot')
)
mainPanel(
plotOutput('outputPlot', height = '3in'),
)
)
)
server <- function(input, output) {
plotData <- eventReactive(input$plot, {
# load various data and organize into a list
return(data.list)
})
outPutPlot <- renderPlot({
plot.data <- plotData()
# manipulate data based on the specific plot, then generate
return(plot)
)
}
You’re right that you’d need to isolate() all reactive dependencies other
than plotData(). Without having a complete runnable example, it’s not
possible to point out where this might have gone wrong. However, it may be
easier to wrap the renderPlot() call in bindEvent(), which will isolate
everything. You just pass the expressions you want to depend on in other
arguments.
So try something like this:
bindEvent(renderPlot({ ... }), plotData())
I am using shinycssloaders to show loading animation. There are multiple inputs on the page which are loaded from the server. These inputs are also dependent on each other.
In the below example I have used a reactive object to create such dependency. First the table is displayed and only when the calculation of table is completed (rv$a <- 1) plot can be completed.
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
withSpinner(tableOutput('data')),
withSpinner(plotOutput('plot'))
)
server <- function(input, output) {
rv <- reactiveValues(a = NULL)
output$data <- renderTable({
#Some long calculation here, using Sys.sleep for simplicity
Sys.sleep(2)
rv$a <- 1
head(mtcars)
})
output$plot <- renderPlot({
req(rv$a)
#Some long calculation here, using Sys.sleep for simplicity
Sys.sleep(2)
plot(rnorm(100), rnorm(100))
})
}
shinyApp(ui, server)
This works fine but it shows 2 loaders, one for table and other one for plot. I want to combine these 2 loaders and show only 1 loading animation which covers the entire page combining table and plot. Also loading should end only after all the calculation is done i.e after plot calculation.
I have tried putting table and plot in a div and use spinner on div but it did not work and gave a blank page.
ui <- fluidPage(
withSpinner(div(
tableOutput('data'),
plotOutput('plot')
))
)
Does anybody have a solution to this? Is this possible using some different package?
You can use the tagList() function, which creates a list of the tags allowing the shinycssloaders package to wrap all the inputs within it in one go.
So the ui will look like the following:
ui <- fluidPage(
withSpinner(tagList(tableOutput('data'),
plotOutput('plot')))
)
Just some extra information for the animation. You can all change the style of the animation such as the the type, color, size , etc by adding these as arguments to the withSpinner(). Check the withSpinner() RDocumentation.
I have a shiny app that I am building where the user selects a report from a radio button menu, and then the table displays on the page. I would like to add an option for the user to simultaneously view all reports. I have found something close to what I want from this thread https://gist.github.com/wch/5436415/ , but I can't quite seem to implement it properly. Basically, I think what I have to do is:
In the UI, make a call to uiOutput() to reactively update the User Interface. I will need multiple calls to htmlOutput() if the user selects the "all" button, but only one call to htmlOutput() if the use simply selects one report. For the record, I am creating my tables with the kable() function, which is why I call htmlOutput() instead of tableOutput().
In the server function, I need to make a call to renderUI() that provides the instructions on how many htmlOutput() calls there will be and which reports will be in each call.
Create a loop that then makes a call to renderText that then sends the html code for the htmlOutput function to interpret.
I can get most of the way there. I can get Shiny to have reactive tables, and output individual reports, but I am struggling to get the looping range to reactively update so that I see all three tables in my testing app. Here is what I have:
library(shiny)
library(shinydashboard)
library(knitr)
library(kableExtra)
data("cars")
data("iris")
data("airquality")
UI<-dashboardPage(
dashboardHeader(),
dashboardSidebar(sidebarMenu(
menuItem("Options", radioButtons(inputId = "Tables", label="test", choices= c("cars", "iris", "airquality", "all"))
) )),
dashboardBody(
uiOutput(outputId = "TABLE"),
textOutput("N")
)
)
server<-function(input, output){
TBL<-list("cars", "iris", "airquality")
T1<-knitr::kable(head(cars))
T2<-knitr::kable(head(iris))
T3<-knitr::kable(head(airquality))
tmp<-list(cars=T1, iris=T2, airquality=T3)
TABLES<-reactive({
ifelse(input$Tables=="all", tmp, tmp[input$Tables])
})
val<-reactive({
tmp<-TABLES()
length(tmp)})
n<-isolate(val())
output$TABLE<-renderUI({
req(input$Tables)
TAB<-TABLES()
TBL<-names(TAB)
tbls<-lapply(1:length(TBL), function(i){
tblnm<-paste("tbl", i, sep="_")
htmlOutput(tblnm)})
do.call(tagList, tbls)
})#Close Render UI
for(i in 1:n){
local({
j<-i
tblnm<-paste("tbl", j, sep="_")
output[[tblnm]]<-renderText(kables(TABLES()))
})
}
output$N<-renderText(n)
}#Close Server
shinyApp(ui = UI, server = server)
Here is where I think I am going wrong:
I included a textOutput() for the value of n, and despite having the reactive() call to get the length of TABLES, when I isolate() I still get the value of 1 even when I select the "all" report button, which should give me 3. Am I misinterpreting how isolate() works? Is there another way to get a value out of a reactive() function that can be used outside of a *Output() or reactive() function? Any guidance would be much appreciated. Thanks so much.
I think your server function is needlessly complex.
render functions are a reactive context themselves, so no need to define variables which only exist in those contexts as specifically reactive.
server<-function(input, output){
TBL<-list("cars", "iris", "airquality")
T1<-knitr::kable(head(cars))
T2<-knitr::kable(head(iris))
T3<-knitr::kable(head(airquality))
tmp<-list(cars=T1, iris=T2, airquality=T3)
output$TABLE<-renderUI({
if(input$Tables=="all"){ind <- names(tmp)}else{ind <- input$Tables}
lapply(tmp, HTML)[ind]
})
output$N <- renderText({
if(input$Tables=="all"){ind <- names(tmp)}else{ind <- input$Tables}
length(ind)
})
}
I am having an issue with the _row_last_clicked option provided for tables created in shiny interfaces with the rstudio DT library. I am trying to select a row in a datatable, make modifications to it and output it to the shiny ui.r. It works for the first-time selection, but when I again click on the same table row which I just selected previously, the _row_last_clicked seems to remain unresponsive (=NULL?). Here is a mininmal example (ui.r likely irrelevant) of what I am trying to achieve:
# server.r-side:
table_x<-# ... loads the dataframe
redo_cal<-reactiveValues()
redo_cal$a<-1
observe({
redo_cal$a
output$some_table <- DT::renderDataTable(
table_x,
server = TRUE, # same problem with FALSE
selection =c('single')
)
})
observeEvent(
input$some_table_row_last_clicked,{
s<-input$some_table_row_last_clicked
table_x[s,]<- # some reversible modifications based on the row selection ...
redo_cal$a<-(redo_cal$a+1) # trigger above renderDataTable
})
The issue persists for both the latest github version of DT as well as the release found on CRAN. I have read several related posts but couldn`t figure out a satisfying solution. Thank you very much for your help!
If i understand you right you need some_table_row_selected
and table_x(dd$d - in my example) be reactiveValues
See example where
# some reversible modifications based on the row selection == log of x
Every time you select row value of x in this row log-ed
library(shiny)
library(DT)
data=data.frame(x=1:10,y=2:11)
ui=shinyUI(
fluidPage(
DT::dataTableOutput("tt")
)
)
server=shinyServer(function(input, output) {
dd=reactiveValues(d=data)
output$tt=DT::renderDataTable(
datatable(
dd$d,selection =c('single')
)
)
observeEvent(input$tt_rows_selected,{
dd$d[input$tt_rows_selected,1]<-log(dd$d[input$tt_rows_selected,1])
})
})
shinyApp(ui,server)
In each session your data refreshed
PS
Best minimal example its something which anyone can copy\paste and test.
With shiny it is very easy to create n inputs by creating a list of UIs like so (I am using ... to save space):
output$test <- renderUI({
lapply(1:input$count, function(x) numericInput(paste0('numId',x),...))
})
Let's say I want to dynamically set each numericInput's minimum to be the value of the previous numericInput. This won't work:
output$test <- renderUI({
lapply(1:input$count, function(x)
if (x==1) numericInput(paste0('numId',x),...))
else numericInput(paste0('numId',x),min=eval(parse(text=paste0("input$numId",x-1))),...))
})
It seems that using eval/parse to use the previous input as a parameter fails.
My next idea was to try adding this to the original code:
observe({
if (input$count>1) {
for (i in 2:input$count) {
updateNumericInput(paste0("numId",i),min=eval(parse(text=paste0("input$numId",i-1))))
}}})
Problem here is that observe doesn't know to respond when the numId's are updated because none of the objects input$numIdx are actually in the observe statement, just strings that are turned into those objects when observe is run.
Any ideas on how to handle this? It would be very nice to be able to generate n inputs, and make them relate to each other dynamically.
Regards