Shiny - elements are not being rendered once function is complete - r

I am dynamically creating the elements to be inserted into a fluidRow, the problem that I am facing is that all elements are being rendered at once. So, instead of rendering each element when its renderUI function ends, they all keep waiting until the last renderUI finishes. Thus, having lots of elements in my_dataset makes the rendering really slow.
I expected that once the print(str_glue('End: {i}')) was shown, the element would be rendered. However, this was not the case, it kept waiting for all elements (including ones that were not visible on screen).
I tried using the outputOptions(..., suspendWhenHidden = TRUE) but it made no difference (as it was expected since this is the default).
MWE
library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
library(shinycssloaders)
qtd <- 500
my_dataset <- data.frame(
stringsAsFactors = F,
Name = rep('Sample', qtd),
Value = runif(qtd)
)
ui <- function() {
fluidPage(
fluidRow(
column(12, textInput(inputId = 'my_text_input', label = NULL, placeholder = 'Search', width = '100%')),
uiOutput('custom_ui')
)
)
}
server <- function(input, output, session) {
output[['custom_ui']] <- renderUI({
filtered_dataset <- my_dataset %>%
filter(grepl(input[['my_text_input']], Name, ignore.case = T)) %>%
arrange(Name)
map(1:nrow(filtered_dataset), function(i) {
item <- filtered_dataset[i,]
custom_id <- str_glue('custom_id_{i}')
output[[custom_id]] <- renderUI({
print(str_glue('Start: {i}'))
print(item)
result <- box(
width = 3,
title = item$Name,
item$Value
)
print(str_glue('End: {i}'))
result
})
column(width = 3, uiOutput(custom_id, style = 'height: 350px;') %>% withSpinner(type = 6))
})
})
}
runApp(shinyApp(ui = ui, server = server), launch.browser = T)

What you are describing is the expected behaviour. The server will not return anything to the UI before all calculations are finished.
I see you are relying a lot on renderUI. This tends to make the Shiny app slow. When the app starts, it must load, realize that it lacks a portion of the UI, ask the server to create the UI - then the server will create the HTML for all of your boxes and send them to the UI before anything is shown. You should try to keep as much as possible of the UI static.
Dependent on what you want to achieve there are probably a lot of different ways of doing it without renderUI.
Under is an example where the HTML for the boxes are created outside of renderUI. This will work, as long as you don't need input controls or outputs in the boxes - because then they need their own ID.
library(shiny)
library(shinydashboard)
library(dplyr)
library(purrr)
qtd <- 500
my_dataset <- data.frame(
stringsAsFactors = FALSE,
Name = rep('Sample', qtd),
Value = runif(qtd)
) %>%
mutate(
x = map2(
Name,
Value,
~column(
width = 3,
box(
width = 3,
title = .x,
.y
)
)
)
)
ui <- function() {
fluidPage(
fluidRow(
column(
12,
textInput(
inputId = 'my_text_input',
label = NULL,
placeholder = 'Search',
width = '100%'
)
),
uiOutput('custom_ui')
)
)
}
server <- function(input, output, session) {
# Only the filtering of the data is done inside `renderUI`
output[['custom_ui']] <- renderUI({
filtered_dataset <-
my_dataset %>%
filter(grepl(input[['my_text_input']], Name, ignore.case = TRUE)) %>%
arrange(Name) %>%
pull(x)
})
}
runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)
Last I just want to recommend this book by Hadley Wickham. I think reading this (or parts of this) book before working with Shiny will make everything easier for you.

My Shiny application elements are not being rendered once the function is complete. I have a laptop with 2 external monitors. I do Shiny development in the IDE on monitor #1. If I run the app on monitor #1, it takes about 20 seconds to complete rendering when the main calculations (function) have completed. If I run the app on the laptop or monitor #2, it takes about 3 seconds to complete rendering.
However, this is when the app is maximized to full screen. If the app is not maximized, it renders quickly no matter the display (about 3 seconds).
I can only interact with the application on a screen other than the one which displays the IDE, unless it is not maximized. I know this sounds odd but I have tested it many times and it is the only logical solution. Why this is the case I would be interested in finding out.
I have also tried with 'open in browser' enabled, it will render only after about 20 seconds.

Related

How to stop columns with datatables overlapping at certain awkward screen widths in an R Shiny app

How do I control the point at which responsive columns in a Shiny page (using bootstrap) give up on trying to put all 12 columns on one page and go into mobile phone mode?
I can reproduce my problem (but nowhere near as bad as my actual application) with this simple app. See how the right of the first two tables below has been obscured by the other tables. Basically, the desired behaviour is to put the three tables vertically in a single column at this screen width, but bootstrap will not do this until the screen width goes down another 100 pixels or so.
library(shiny)
library(DT)
ui <- fluidPage(
fluidRow(
column(4, DTOutput("t1")),
column(4, DTOutput("t2")),
column(4, DTOutput("t3"))
)
)
my_cars <- mtcars[, 1:3]
names(my_cars) <- c("A longish name", "Another longish name", "A particularly long and annoying name I can't change")
server <- function(input, output) {
output$t1 <- DT::renderDataTable(my_cars, rownames = FALSE)
output$t2 <- DT::renderDataTable(my_cars, rownames = FALSE)
output$t3 <- DT::renderDataTable(my_cars, rownames = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
Played around with it a little but. First tried implementing a solution found here,
Change bootstrap navbar collapse breakpoint without using LESS
Had little luck.
Then I tried the following and it seemed to work better. By default column() uses col-sm-x as the bootstrap class, switching this to col-md-x seemed to help.
library(shiny)
library(DT)
custom_column = function(...){
tags$div(
class = "col-md-4",
...
)
}
ui <- fluidPage(
fluidRow(
custom_column(DTOutput("t1")),
custom_column(DTOutput("t2")),
custom_column(DTOutput("t3"))
)
)
my_cars <- mtcars[, 1:3]
names(my_cars) <- c("A longish name", "Another longish name", "A particularly long and annoying name I can't change")
server <- function(input, output) {
output$t1 <- DT::renderDataTable(my_cars, rownames = FALSE)
output$t2 <- DT::renderDataTable(my_cars, rownames = FALSE)
output$t3 <- DT::renderDataTable(my_cars, rownames = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)

R shiny-app DT: apply filters using greater than

I'm building a shiny-app using R and, within the app, I need to display a table that has the possibility to apply filters to numeric, character and factor columns.
I'm using the DT package and this is an example of the code:
# packages
library(shiny)
library(DT)
# ui
ui <- fluidPage(
br(),
DT::dataTableOutput("my_iris")
)
# server
server <- function(input, output) {
output$my_iris <- DT::renderDataTable({
datatable(
data = iris,
filter = list(
position = "top",
clear = FALSE,
plain = TRUE
)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The problem is that I need to apply filters to numeric columns like "Sepal.Length > 5" and I can't accomplish that using simply the scrollbar implemented in DT since, if I move the scrollbar, then the filters applied is like [5,b] while I simply want a filter like (5,b).
Is there an easy way to accomplish that using R and DT?
EDIT: I think that maybe my problem could be solved using the options of noUiSlider, i.e. the Javascript library used to implement the filters, but I don't know which options to modify and how to implement the changes in DT.
I know that it is and old post, but just in case it helps to someone, I found a way to do it. It may not be the best solution or the solution that the #agila was trying to find.. but here it is.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
DTOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderDT(iris,
filter = "top",
options = list(
pageLength = 5
)
)
}
)
Here you have like a range to select your data depending on the filters that you want to put.
The original source is from here

R Shiny Leaflet Map won't redraw after the first movement

I have been working on my first little project in R and have run into an issue with a Leaflet map. It will render properly with the data and design I have specified thus far, but once I move the map in browser or the R viewer in RStudio it will no longer react to clicks/drags/etc. and will not react even if it is left alone for several minutes.
I have also had an issue with the zoom functionality, I am not sure if this is due to something that I missed or something to do with the above issue.
Example of the data:
Data_example
# Libraries ---------------------------------------------------------------
library("shiny")
library("tidyverse")
library("leaflet")
library("leaflet.minicharts")
# UI ----------------------------------------------------------------------
ui <- fluidPage(
titlePanel("Wiersma Sale Iceland Trip"),
mainPanel(
leafletOutput(outputId = "Map_1", height = 1080, width = 1920)
)
)
# Server ------------------------------------------------------------------
server <- function(input, output) {
sheets_data <- read.csv("Iceland_Mark2 - Data.csv")
output$Map_1 <- renderLeaflet({
m <- leaflet(data = sheets_data) %>%
addTiles() %>%
addMinicharts(
sheets_data$Long,
sheets_data$Lat,
type = "pie",
popup = popupArgs(
labels = c("A", "B", "C"),
html = paste0(
"<div>",
"<h3>",
sheets_data$Name,
"</h3>",
"Description: ",
sheets_data$Description,
"<br>",
"Media_1: ",
sheets_data$Media_1,
"</div>"
)
)
)
})
}
# Run_App -----------------------------------------------------------------
shinyApp(ui = ui, server = server)
The output:
Output_of_app
It needn't be pretty, nor unique, but it does need to react to zooming and movement and I can't for the life of me figure out why it behaves this way.
I had the same problem suddenly come up after having already produced a number of maps with no issues. So I figured it most likely was to do with the data I was feeding it.
I had one row in my chartdata that had NAs. Deleting this row and remapping fixed the problem.

Shiny DT: selectColumns not working?

I have the following example app (code below). The idea is that if a user selects the second column (index of 1), the selection goes to the third column (index of 2), as I don't want the user to be able to select the second column at all (as far as I know there is no built-in way to stop the user selecting a particular column in DT).
The issue is that while selectRows(tableProxy, c(2) works (a trivial example of a row selection), selectColumns(tableProxy, c(2)) only deselects the currently selected column and does not select the third column.
Is there an issue with my syntax, or is this a bug? If it is a bug, is there a workaround?
Reproducable example:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
fluidRow(
tags$div(title = "Iris table",
DT::dataTableOutput("irisTable"))
)
)
# Define server logic required to draw a table
server <- function(input, output) {
output$irisTable <- DT::renderDT(datatable(head(iris, 20), options = list(paging = FALSE, searching = FALSE),
rownames = FALSE,
selection = list(target = 'row+column', mode='single', selected = list(rows = c(NULL), cols = c(2)))
) %>%
formatStyle(0, target= 'row',color = 'black',
lineHeight='70%', padding = '3px 3px', fontSize = '80%')
)
tableProxy <- dataTableProxy("irisTable")
observeEvent(input$irisTable_columns_selected, {
if (input$irisTable_columns_selected == 1) {
#tableProxy %>% selectColumns(2)
selectRows(tableProxy, c(2))
selectColumns(tableProxy, c(2))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Update: I have tried the above with the example code published here (converted to work with a single file Shiny app), and I have the same issue. I've reinstalled the DT package and it doesn't resolve the issue.
It's a bug of DT that should have been fixed via the PR rstudio/DT#528. You can install the dev version to test it by calling devtools::install_github("rstudio/DT").

Shiny: display notification until browser is no longer busy

I have a Shiny application that plots large treemaps. I create the treemap objects ahead of time and serialize them:
library(readr)
library(magrittr)
library(highcharter)
library(treemap)
tm_file_name <- function(num_leaves) {
paste0(as.character(num_leaves), "_leaves.rds")
}
create_rand_treemap <- function(num_leaves) {
random.hierarchical.data(n = num_leaves) %>%
treemap(index = c("index1", "index2", "index3"),
vSize = "x",
draw = FALSE) %>%
hctreemap(allowDrillDown = TRUE) %>%
write_rds(tm_file_name(num_leaves))
}
for (leaves in c(50, 500, 5000)) {
create_rand_treemap(leaves)
}
Then I load them like this:
library(shiny)
library(shinydashboard)
library(shinycssloaders)
library(readr)
library(highcharter)
tm_file_name <- function(num_leaves) paste0(as.character(num_leaves), "_leaves.rds")
load_treemap <- function(num_leaves) tm_file_name(num_leaves) %>% read_rds()
ui <- dashboardPage(
dashboardHeader(
title = "Reproducible Shiny Example",
titleWidth = "100%"
),
dashboardSidebar(
radioButtons(
"num_leaves", "Number of Leaves in Treemap:",
c("50" = 50, "500" = 500, "5000" = 5000)
),
actionButton("createTreemap", "Create Treemap")
),
dashboardBody(
# CSS spinner
withSpinner(highchartOutput("treemap", width = "100%", height = "500px"),
type = 7))
)
server <- function(input, output) {
output$treemap <- renderHighchart({
# load and render only on button press
if (length(input$createTreemap) != 0) {
if (input$createTreemap > 0) {
# notification attempt
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(message = 'Generating treemap...')
isolate({load_treemap(input$num_leaves)})
}
}
})
}
shinyApp(ui = ui, server = server)
I would like to display a loading notification or spinner until the treemap has fully rendered.
The above example, live here, contains two attempts at this.
The first attempt uses Shiny progress objects to create a notification. However, the notification only displays for a very short time before disappearing. I believe this is because Shiny only has to read a serialized file and then it thinks the task is complete, but it takes the browser a long time to render the plot.
I've also tried a shinycssloaders approach, but
The CSS spinner displays briefly when the application first loads, which I don't want.
The spinner freezes after several seconds when rendering large treemaps (i.e 5000 leaves).
Lastly, I tried some blind copy-pasting from this SO question, but either couldn't get the solutions there to work with shinydashboard or to persist until the rendering was complete.
How can I display Shiny notifications until both Shiny and the browser are no longer busy?

Resources