Issues with controlling width of columns in a rendered datatable Shiny - r

To render a datatable in a shiny app I use the following code
ui <- fluidPage(
box(width = 10, # this is to control table width
DT::DTOutput(('table'))
)
)
server <- function(input, output) {
options(shiny.maxRequestSize=10000*1024^2)
output$table <- DT::renderDataTable(
datatable(
dataset ,
options = list(dom = 'fltipr',
pageLength = 1000,
#lengthMenu = list(c(250, 500), c('250', '500')),
searchHighlight = TRUE,
autoWidth = TRUE,
columnDefs = list(list(width = '300px', targets = c(7,10)), # this is to control width of two columns
list(visible = FALSE, targets = c(2,4,6, 8,11,13,15,16,17:23)))
), filter = 'top',
selection = 'none',
editable = 'cell')
)
}
With that that setup I am trying to control the width of two of the visible columns. When I run the app, it renders fine, just as I wanted it to be rendered.
But when I try to sort the rendered datatable by one of the columns, the controls for column width (and even the whole table width) stop working. The initially controlled column that contains long sections of text now becomes so wide it does not fit on the page, and I have to scroll sideways.
In essence I would like all table to fit on page, with width of two textual columns controlled strictly not matter how I sort the rendered datatable.
Sincerely,
Maria

Related

R shiny datatable scrollX impacts table width

please I have the following example to show a layout issue I'm facing with my R shiny app. Example should be entirely reproducible:
ui <- dashboardPage(
title = "Dashboard test", # this is the name of the tab in Chrome browserr
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
sidebarMenu(
menuItem('Retail', tabName = "retail", icon = icon("th"),
menuItem('Dashboard', tabName = 'retail_dashboard'))
)
),
dashboardBody(
tabItem(tabName = "retail_dashboard",
tabsetPanel(type = "tabs",
tabPanel("Dashboard",
h3("Test."),
fluidRow(column(3,
dataTableOutput("table_test1", width = '100%')),
column(3,
dataTableOutput("table_test2", width = '100%'))
)
)
)
)
)
)
server <- function(input, output, session) {
output$table_test1 <- renderDataTable({
df <- data.frame(BUCKET=c("1","2"), ITEM=c(48,53), VALUE = c(7.88, 5.12), stringsAsFactors = F)
datatable(df,
rownames= F,
#colnames = colnames_var,
filter = 'none',
extensions = 'Buttons',
caption = NULL,
options = list(scrollX = T
#, headerCallback = js_col_header # this is to show/hide column headers
, lengthChange = T
#, pagingType = "numbers" # this hides the Next and Previous buttons --> https://datatables.net/reference/option/pagingType
, paging = T # this completely hides the Next, Previous and Page number at the bottom of the table
, autoWidth = T
, pageLength = 5 # this determines how many rows we want to see per page
, dom = 'Blfrtip'
, buttons = NULL
, info = T # this will hide the "Showing 1 of 2..." at the bottom of the table --> https://stackoverflow.com/questions/51730816/remove-showing-1-to-n-of-n-entries-shiny-dt
, searching = T # this removes the search box -> https://stackoverflow.com/questions/35624413/remove-search-option-but-leave-search-columns-option
, ordering = F # https://stackoverflow.com/questions/54318475/hide-the-column-names-in-dtdatatable useful especially when we want to hide column names
))
})
output$table_test2 <- renderDataTable({
df <- data.frame(BUCKET=c("1","2"), ITEM=c(48,53), VALUE = c(7.88, 5.12), stringsAsFactors = F)
datatable(df,
rownames= F,
#colnames = colnames_var,
filter = 'none',
extensions = 'Buttons',
caption = NULL,
options = list(scrollX = F
#, headerCallback = js_col_header # this is to show/hide column headers
, lengthChange = T
#, pagingType = "numbers" # this hides the Next and Previous buttons --> https://datatables.net/reference/option/pagingType
, paging = T # this completely hides the Next, Previous and Page number at the bottom of the table
, autoWidth = T
, pageLength = 5 # this determines how many rows we want to see per page
, dom = 'Blfrtip'
, buttons = NULL
, info = T # this will hide the "Showing 1 of 2..." at the bottom of the table --> https://stackoverflow.com/questions/51730816/remove-showing-1-to-n-of-n-entries-shiny-dt
, searching = T # this removes the search box -> https://stackoverflow.com/questions/35624413/remove-search-option-but-leave-search-columns-option
, ordering = F # https://stackoverflow.com/questions/54318475/hide-the-column-names-in-dtdatatable useful especially when we want to hide column names
))
})
}
cat("\nLaunching 'shinyApp' ....")
shinyApp(ui, server)
Problem 1: if I open this app on a large screen, table_test2 is nicely taking all the expected real estate of the screen, ranging entirely within 3 columns.
However, table_test1 does not (see my screenshot).
Main difference is that table_test1 has scrollX =T vs table_test2 that has scrollX =F.
How can I keep scrollX = T and visualize table_test1 the same way I visualize table_test2 (meaning, with no empty side spaces)? (see red color in attached screenshot)
Problem 2:
How come the alignment of table_test1 is a bit messed up and column names are not aligned to table columns? (see blue color in attached screenshot)
Changing scrollX is not an option since some users have a smaller screen and with scrollX =F tables would not show up properly on some users' monitors.
Thanks
Take out the autoWidth option from datatable
datatable(
data = df,
rownames = FALSE,
filter = "none",
extensions = "Buttons",
caption = NULL,
options = list(
scrollX = TRUE,
lengthChange = TRUE,
paging = TRUE,
pageLength = 5,
dom = "Blfrtip",
buttons = NULL,
info = TRUE,
searching = TRUE,
ordering = FALSE
)
)

How to add a horizontal scrollbar to a fixedHeader in renderDataTable in R Shiny?

I am building a datatable in R Shiny to display data with many columns and rows. I had two problems at first:
When the user was scrolling down the table, the header of the table disappeared. This has been fixed thanks to this SO post.
When a user wishes to go left or right of the table, he has to scroll to the bottom of the page (or top depending on where you display the scrollbar). This is an inconvenience to repeat this task especially when displaying many rows. So, my aim is to add a horizontal scrollbar to the fixed header. Would this be possible?
I searched the internet and I found this post that may contain the answer but not sure how to implement it in my case.
The following reproducible code will spawn a table with 50 rows and 30 columns:
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(dplyr)
library(data.table)
library(tidyverse)
library(DT)
myFun <- function(n = 5000) {
a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
}
dt <- setDT(data.frame(replicate(30,sample(myFun(50),50,rep=TRUE))))
ui <- fluidPage(theme = "slate",
navbarPage(title = "Test",
header = tagList(
useShinydashboard(),
),
tabPanel(
"Table",
fluidRow(
box(dataTableOutput("mytable"),
width = 12,
collapsible = FALSE,
title = "",
solidHeader = T
)
)
)
)
)
# server
server <- function(input, output) {
output$mytable <-
renderDataTable(
dt,
filter = list(position = "top", clear = FALSE, plain = TRUE),
extensions = c("FixedHeader"),
options = list(
scrollX = T,
fixedHeader=T,
pageLength = 50,
autoWidth = F,
search = list(regex = TRUE),
# the following is used to cut the string if its too long
columnDefs = list(
list(
targets = "_all",
render = JS(
"function(data, type, row, meta) {",
"return type === 'display' && data != null && data.length > 5 ?",
"'<span title=\"' + data + '\">' + data.substr(0, 5) + '...</span>' : data;",
"}"
)
)
)
),
rownames = FALSE
)
}
# app
shinyApp(ui, server)
Will generate a Shiny app:
Any help is kindly appreciated. Thanks in advance.
The vertical scrollbar that appears is actually for the whole page, not the datatable. You need to restrict the height of your datatable, so it doesn't overflow the page, and add the vertical bar. You can do that by adding
scrollY = 300
to your table options, where "300" is the height of your datatable. Depending on your userbase, what devices they are using etc. you will need to adjust this number or find an appropriate way of setting it automatically.
The above would also fix the problem with disappearing header, since you are actually scrolling table body instead of the whole page.

R Shiny DT Row Select and Row Edit Collision

I have a Shiny app that I am working on and am using renderDataTable to display a data frame to the user. Right now, the user needs to click on a row of the table to pull up additional information about that row. At the same time, I have the data table set to be 'row' editable. This is really causing some problems. In order to initiate the edit mode for the row, one needs to double click on the row, but clicking multiple times toggles the selected state of the row.
Is there a way to initiate the row editing without having to double click or to disable the row selection status when a double click is present?
EDIT: Here is my invocation of the DT:
output$image_list = DT::renderDataTable({
if(!('data.frame' %in% class(values$images))) {
return(NULL)
}
datatable(values$images,
rowname=FALSE,
options=list(columnDefs = list(list(visible=FALSE, targets=c(0, 1, 3, 6)))),
colnames=c('ID', 'Full File Name', 'Filename', 'Directory', 'Range Scale', 'Heading', 'Status'),
selection = 'single',
editable = list(target='row', disable = list(columns=c(0, 1, 2, 3, 6)))
) %>%
formatStyle('Status', target='row', backgroundColor = styleEqual(c('Incomplete', 'Complete'), c('#FF9999', '#99FF99')))
})
Version Information
Tool | Version
-----|--------
R | 4.0
Shiny| 1.5.0
DT | 0.15
I'm not sure to understand but maybe this can help. With the app below, you can select a row only by clicking on a cell in a non-editable column. So, double-clicking an editable cell doesn't trigger the row selection. Not sure this helps... tell me what.
library(shiny)
library(DT)
dat <- iris[1:6,]
nonEditableColumns <- c(3, 4)
ui <- fluidPage(
br(),
DTOutput("dtable")
)
server <- function(input, output, session) {
output[["dtable"]] <- renderDT({
datatable(
dat,
extensions = "Select",
selection = "none",
editable = list(
target = "row",
disable = list(columns = nonEditableColumns)
),
options = list(
columnDefs = list(
list(className = "selectable", targets = nonEditableColumns),
list(className = "dt-center", targets = "_all")
),
select = list(style = "single",
selector = "td.selectable")
)
)
}, server = FALSE)
}
shinyApp(ui, server)

R large datatable display in Shiny

I am trying to display a relatively large DataTable in a shiny app. The table's dimensions are 7000x30. The performance in Chrome was very very sluggish so I added the 'Scroller' extension to limit the rendering but that did not help. It seems that it is the large number of columns that is causing the issue, not the large number of rows. I also tried to used the colvis extension but the button gives a non scrollable list and with 30 columns, that wouldn't work. Also I tried to have some columns hidden using the visible option, but that didn't work.
Here is the example:
data = as_tibble(matrix(runif(200000), ncol=30))
data %>%
DT::datatable(filter = 'top', extensions = c('Buttons', 'Scroller'),
options = list(scrollY = 650,
scrollX = 500,
deferRender = TRUE,
scroller = TRUE,
# paging = TRUE,
# pageLength = 25,
buttons = list('excel',
list(extend = 'colvis', targets = 0, visible = FALSE)),
dom = 'lBfrtip',
fixedColumns = TRUE),
rownames = FALSE)
Weirdly, the Rstudio viewer shows the datatable and is fine. It's only when I Run the document as a shiny document and open it in Chrome that it becomes very sluggish. My questions are:
Why is this happening
How do I only show a limited number of columns by default and have the option to show the others
is there a better button for colvis? if the list of columns exceeds the page length, I can't access those hidden columns to toggle them on or off.
What do you mean by sluggish?
I ran it and everything looks okay to me in terms of speed.
library(shiny)
library(shinydashboard)
library(DT)
####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
DT::dataTableOutput("test")
)
ui <- dashboardPage(header, sidebar, body)
####/SERVER/####
server <- function(input, output, session) {
data <- as_tibble(matrix(runif(200000), ncol=30))
output$test <- DT::renderDataTable({
DT::datatable(
data,
filter = 'top', extensions = c('Buttons', 'Scroller'),
options = list(scrollY = 650,
scrollX = 500,
deferRender = TRUE,
scroller = TRUE,
# paging = TRUE,
# pageLength = 25,
buttons = list('excel',
list(extend = 'colvis', targets = 0, visible = FALSE)),
dom = 'lBfrtip',
fixedColumns = TRUE),
rownames = FALSE)
})
}
shinyApp(ui, server)
You may want to remove 'scroller' from Options = () as with that many rows, you may want to break it up into pages. Also, you can try to make the table server processing by putting Server = TRUE in there, that will make it process every page versus the whole dataset at once.

How to make the horizontal scrollbar visible in DT::datatable

Using R shiny & DT package, I am creating certain tables. The number of columns vary as per user input & is not fixed. I have included the following code snippet to include a horizontal scrollbar so that when the number of columns is large, the user can scroll through the columns that are not directly visible.
server.R:
output$results <- DT::renderDataTable({
DT::datatable(data = datasetInput(),
options = list(scrollX = TRUE,...)
)
})
<code reduced for brevity>
Using the above code, the Horizontal scrollbar is not visible at first but appears when I click on a row and hit right arrow on my keyboard. Is there any way the scroll bar becomes visible as soon as the table is fired up, no matter how many columns I have, and I can drag the scrollbar using the mouse pointer?
Update:
I tried the code in the answer below and this is what I see - no horizontal scrollbar.
I don't think you can (or should) force a scrollbar easily if you don't need one, but the above code works fine for me, it shows a scrollbar when the page initializes. Maybe the problem is with the data or something else.
Here's a minimal example that has a horizontal scrollbar on page load
runApp(shinyApp(
ui = fluidPage(
DT::dataTableOutput("results", width = 300)
),
server = function(input, output, session) {
output$results <- DT::renderDataTable(
mtcars,
options = list(scrollX = TRUE)
)
}
))
Try this:
DT::datatable(sta, options = list(
pageLength=50, scrollX='400px'), filter = 'top')
I would have done this way also:
datasetInput1 <- reactive({
infile <- input$file1
if(is.null(infile))
return(NULL)
else
m <- read.csv(infile$datapath, header = input$header)
return ( DT::datatable(m, extensions = 'Scroller', options = list(deferRender = F, dom = 't',
columnDefs = list(list(className = 'dt-center',
targets = 5)),
scrollY = 300, scroller = TRUE, scrollX = T,
pageLength = 5))
)
})

Resources