The toy shiny app in the code below renders a table from the R excelR package. The table data has been manufactured from 2 calls to the mtcars data to force it to have many columns so that it extends beyond the modal that presents it, and is wrapped in a div with an x-scrolbar so that all the columns can be viewed with horizontal scrolling (commented out as doesn’t achieve the goal).
Scrolling the columns this way though also moves the pagination buttons.
I am looking to find out 2 things please
how to horizontal scroll the table only.
and how to freeze the first 3 columns so that they are fixed in place and not part of the scroll.
Anyone know how to achieve this please? I cannot see any functionality at the package documentation.
I have also tried various combinations of autoFill and autoWidth opined at https://github.com/Swechhya/excelR/issues/57
library(shiny)
library(excelR)
library(dplyr)
library(tibble)
ui <- fluidPage(
column(12, actionButton('btn_modal', 'modal up')))
server <- function(input, output) {
observeEvent(input$btn_modal,{
showModal(modalDialog(
# tags$div(style = 'overflow-x: scroll;',
excelOutput('duplicator_table', width = '100%', height = '500px')
# )
))
})
output$duplicator_table <- renderExcel({
data_2 <- data_1 <- mtcars
data_1 <- forecast_data_1 %>% rownames_to_column('car_models')
colnames(forecast_data_2) <- paste0(colnames(forecast_data_2), '_2')
rownames(forecast_data_2) <- NULL
data_3 <- data_1 %>% bind_cols(data_2)
excelTable(
data = data_3,
pagination = 15
)
})
}
shinyApp(ui = ui, server = server)
Related
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.
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)
When a DT datatable initilaly renders in a shiny app it appears to grow from the top and push all other elements down the page. Is there a way to render the datatable more smoothly so that other elements are not pushed out of the way like this?
You can see in the example code the h1 renders first at the top of the screen and is then pushed down when the datatable renders. I have tried creating a div with minimum height for the table but it didn't work.
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput('table'),
h1('placeholder text'))
server <- function(input, output, session) {
my_data <-
data.frame(
a = rnorm(5000),
b = rnorm(5000),
c = rnorm(5000),
d = rnorm(5000)
)
output$table <- DT::renderDataTable({
datatable(my_data, options = list(pageLength = 25))
})
}
shinyApp(ui, server)
There is some nice functionality in the DT package to reload data smoothly when the data changes after the initial render (using replaceData()). However, I cannot seem to render the data smoothly initially.
So, you can define a height in pixels, but that may not match the pageLength argument you made on the server. I think if you want to control the height in the rendering of the page, the best way to do that is to define height in pixels, not page length. This way the height gets enforced when the page is being loaded AND when the table gets rendered:
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput('table', height = "500px"),
h1('placeholder text'))
server <- function(input, output, session) {
my_data <-
data.frame(
a = rnorm(5000),
b = rnorm(5000),
c = rnorm(5000),
d = rnorm(5000)
)
output$table <- DT::renderDataTable({
datatable(my_data)
})
}
shinyApp(ui, server)
I use
output$hot <- renderRHandsontable(rhandsontable(DF))
to get a table.
All works fine but I would like to allow the user to select certain columns only (implemented with shiny::updateSelectizeInput()). the data should then be updated in the full data table and not only in the columns selected. I googled but could only find a very bad description in java. Can someone help me out with this?
as requested an example:
DF = data.frame(matrix(rnorm(20), nrow=10))
rhandsontable(DF)
This is a few years late, and I will note that I don't think this will completely solve the issue as it doesn't use "updateSelectizeinput()" as requested by the OP, plus I must not be handling the select input correctly as one column always shows, but for anyone looking for a start, here is an example:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
selectInput("Select", "Select", names(mtcars), multiple = T, selected = names(mtcars)),
rHandsontableOutput("cars")
)
server <- function(input, output, session) {
DF<-reactiveValues(DF = mtcars, Select = NULL)
observeEvent(input$Select,{
DF$Select <- input$Select
})
output$cars<-renderRHandsontable({
rhandsontable(DF$DF, rowHeaders = NULL)%>%
hot_cols(colWidths = ifelse(names(DF$DF) %in% DF$Select == T, 150, 0.1))
})
}
shinyApp(ui, server)
It uses 0.1 as a column width to effectively hide the column, leaving the original data frame in tact.
I have a bunch of points on a map with some associated data.
First, I want to filter those points by their attributes. That works fine, but recently when I run the app and fiddle with the filters, eventually it stops removing the previously filtered points and just loads the newly filtered points on top. This has been happening after about 10 adjustments to the filter. It is as if the clearMarkers() function stops working. The filtered data will also show up in a reactive data.table (that part works fine, didn't include it in the example).
Second, I want to click on points to select them. Data from the selected points will go in to some graphs later. I can definitely select one point, but I am having trouble keeping a reactive variable of all clicked points. Also, a selected point should become unselected if clicked again. The selected points will be highlighted on the map (by adding bigger brighter markers on them), and in the reactive data.table, and the selection should update following clicks in the map and clicks in the table. But that is a few steps down the line.
Here is some sample code, which does not work.
library(sp)
library(leaflet)
library(shiny)
data <- data.frame(x = c(10,20,30,10,40), y = c(20,20,10,30,30), z = c(1,2,3,4,5))
points <- SpatialPointsDataFrame(data[,1:2],data[3])
server <- function(input, output, session) {
filtered <- reactive({
z.in <- input$z
points[points#data$z > z.in,]
})
selected <- reactiveValues()
output$map <- renderLeaflet({leaflet()})
observe({ # This observer works, but it seems to stop working about about 10 tries
leafletProxy("map") %>%
clearMarkers() %>%
addCircleMarkers(data = filtered())
})
observe({ # This observer does not work, and the app won't run unless you comment it out
clicked <- unlist(input$map_marker_click[3:4])
if (is.na(clicked)) {selected <- clicked}
else if (clicked %in% selected) {selected <- selected[-clicked]}
else {selected <- append(selected, clicked)}
})
}
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10,left = 10,
sliderInput("z", "z",0,6,0)
))
shinyApp(ui = ui, server = server)
The crosstalk package addresses this.
https://rstudio.github.io/crosstalk/