Factor Search Clearing Button in DT: shinydashboard vs. shinymaterial - r

I have several applications that I am attempting to port from shinydashboard to shinymaterial, due to the nice aesthetics that my users seem to enjoy. I am facing an issue with searching/filtering factors in the shinymaterial dashboards where the "x" button that normally clears factor filtering is NOT present when using shinymaterial.
shinydashboard screenshot where the "filter clearing" button for the factor column is present:
shinydashboard screenshot
shinymaterial screenshot where there is no "filter clearing" button for the factor column:
shinymaterial screenshot
Here are my reproducible code examples:
shinydashboard
library(shiny)
library(tidyverse)
library(DT)
# Shiny Dashboard or Shiny Material
library(shinydashboard)
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(
title = "Some Title",
titleWidth = 250
),
shinydashboard::dashboardSidebar(),
shinydashboard::dashboardBody(
DT::dataTableOutput("exampleDT")
)
)
server <- function(input, output, session) {
# Use MPG Data and convert manufacturer to Factor
df <- mpg %>%
mutate(manufacturer = as.factor(manufacturer))
# Create Datatable
output$exampleDT <- DT::renderDataTable({
DT::datatable(df,
class = 'cell-border stripe',
rownames = FALSE,
escape = FALSE,
extensions = c("KeyTable"),
filter = list(position = "top"),
options = list(searching = TRUE,
searchHighlight = TRUE,
scrollX = TRUE,
pageLength = 5,
autoWidth = TRUE,
keys = TRUE,
columnDefs = list(list(className = "dt-center", targets = "_all"))
)
)
})
}
shinyApp(ui = ui, server = server)
shinymaterial
library(shiny)
library(tidyverse)
library(DT)
# Shiny Dashboard or Shiny Material
library(shinymaterial)
ui <- shinymaterial::material_page(
title = "Some Title",
primary_theme_color = "grey",
shinymaterial::material_tabs(
tabs = c("Tab 1" = "tab1")
),
shinymaterial::material_tab_content(
tab_id = "tab1",
shinymaterial::material_card(
title = "",
DT::dataTableOutput("exampleDT")
)
)
)
server <- function(input, output, session) {
# Use MPG Data and convert manufacturer to Factor
df <- mpg %>%
mutate(manufacturer = as.factor(manufacturer))
# Create Datatable
output$exampleDT <- DT::renderDataTable({
DT::datatable(df,
class = 'cell-border stripe',
rownames = FALSE,
escape = FALSE,
extensions = c("KeyTable"),
filter = list(position = "top"),
options = list(searching = TRUE,
searchHighlight = TRUE,
scrollX = TRUE,
pageLength = 5,
autoWidth = TRUE,
keys = TRUE,
columnDefs = list(list(className = "dt-center", targets = "_all"))
)
)
})
}
shinyApp(ui = ui, server = server)

That's because this "button" actually is a glyphicon icon. The glyphicon icons are included in bootstrap, which is automatically loaded when you use an ordinary Shiny page, but not when you use 'shinymaterial'. So you have to add a link to bootstrap-glyphicons.css:
ui <- shinymaterial::material_page(
tags$head(
tags$link(href = "https://netdna.bootstrapcdn.com/bootstrap/3.0.0/css/bootstrap-glyphicons.css", rel="stylesheet")
),
title = "Some Title",
......
This way requires to use the app online. But instead of including a link, you can download the css file and put it in the www subfolder of your app, and include it with tags$link(href = "bootstrap-glyphicons.css", rel = "stylesheet").

Related

How to download only the selected columns in a dataframe using Colvis from DT in Shiny?

I am using the button colvis from the DT package to select which columns I would like to show in the table. Here you have more info about the button colvis.
It works perfectly fine, it hides the columns that I don't want to select and the result is shown to the user.
However, it seems that this info is not updated when I download the file.
If I only select "Petal.Width" and "Species":
Then, I download the file... and I open it. I still have all the columns and not the selected ones.
I have been trying to find a solution, but I haven't found anything.
Does anyone know how to fix it?
Thanks in advance.
Here is my code:
library(shiny)
library(DT)
ui <- fluidPage(
dataTableOutput("table")
)
server <- function(input, output, session) {
output$table <- renderDataTable({
datatable(
iris,
filter = list(position = 'top', clear = FALSE),
selection = "none", #this is to avoid select rows if you click on the rows
rownames = FALSE,
extensions = 'Buttons',
options = list(
scrollX = TRUE,
dom = 'Blrtip',
buttons =
list(I('colvis'),'copy', 'print', list(
extend = 'collection',
buttons = list(
list(extend = 'csv', filename = paste0("iris"), title = NULL),
list(extend = 'excel', filename = paste0("iris"), title = NULL)),
text = 'Download'
)),
lengthMenu = list(c(10, 30, 50, -1),
c('10', '30', '50', 'All'))
),
class = "display"
)
})
}
shinyApp(ui, server)
library(DT)
datatable(
iris,
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
I("colvis"),
list(
extend = "collection",
text = "Download",
buttons = list(
list(
extend = "csv",
exportOptions = list(
columns = ":visible"
)
)
)
)
)
)
)
Thanks to Stéphane Laurent's answer, I managed to find an answer.
I had some problems to have both buttons (csv and excel) and how to organise the lists with the proposed solution, but I found the way to do it.
I will add the answer with the original code just in case someone has problems like me.
library(shiny)
library(DT)
ui <- fluidPage(
dataTableOutput("table")
)
server <- function(input, output, session) {
output$table <- renderDataTable({
datatable(
iris,
filter = list(position = 'top', clear = FALSE),
selection = "none", #this is to avoid select rows if you click on the rows
rownames = FALSE,
extensions = 'Buttons',
options = list(
scrollX = TRUE,
dom = 'Blrtip',
buttons =
list(I('colvis'),'copy', 'print', list(
extend = 'collection',
text = 'Download',
buttons = list(
list(
extend = "csv", filename = paste0("iris"), title=NULL,
exportOptions = list(
columns = ":visible")
),
list(
extend = "excel", filename = paste0("iris"), title=NULL,
exportOptions = list(
columns = ":visible")
)
)
)),
lengthMenu = list(c(10, 30, 50, -1),
c('10', '30', '50', 'All'))
),
class = "display"
)
})
}
shinyApp(ui, server)

RShiny: Reducing bootstrap table cell padding when using `bs_theme()`

# Header
## Load packages
library(shiny)
library(tidyverse)
library(DT)
library(bslib)
ui <- navbarPage("Test",
inverse = T,
collapsible = T,
theme = bs_theme(
version = 4,
bootswatch = "lux",
"font-size-base" = "1rem",
"table-cell-padding" = ".4rem"
),
tabPanel(
title = "Data Tables",
id = "data",
icon = icon("flask"),
fluidRow(
dataTableOutput("DT1")
)
)
)
server <- function(input, output, session) {
output$DT1 <- renderDataTable({
datatable(mtcars,
style = "bootstrap4",
options = list(info = F,
searching = T,
paging = T,
autoWidth = T,
scrollX = T),
filter = list(position = 'top', clear = FALSE),
class = 'cell-border stripe compact',
rownames = F)
})
}
##
shinyApp(ui, server)
I am trying to create a table using the bs_theme() function from the bslib package, specifically using the theme lux. The tables are very large and the cells have massive padding. Adding the "table-cell-padding" argument in bs_theme() doesn't change the cell sizes. How do I make the table compact and the cells tight around the numbers/column names?
Just add tags$style('#DT1 td {padding: 0}'), how simple is that.
# Header
## Load packages
library(shiny)
library(tidyverse)
library(DT)
library(bslib)
ui <- navbarPage("Test",
inverse = T,
collapsible = T,
theme = bs_theme(
version = 4,
bootswatch = "lux",
"font-size-base" = "1rem",
"table-cell-padding" = ".4rem"
),
tabPanel(
title = "Data Tables",
id = "data",
icon = icon("flask"),
fluidRow(
tags$style('#DT1 td {padding: 0}'),
# style = "width: 50%",
dataTableOutput("DT1")
)
)
)
server <- function(input, output, session) {
output$DT1 <- renderDataTable({
datatable(mtcars,
style = "bootstrap4",
options = list(info = F,
searching = T,
paging = T,
autoWidth = T,
scrollX = T),
filter = list(position = 'top', clear = FALSE),
class = 'cell-border stripe compact',
rownames = F)
})
}
##
shinyApp(ui, server)
Change the padding: 0 to any valid css unit you want, here I changed to 0, no padding. It will seem that it doesn't work on left and right, that's because you have autoWidth, it will always use the full width of the parent node. So, if you want the width to be smaller, uncomment the style line above, you should see is't only half of the screen.

Hide a column in shiny datatable but keep it searchable

The DT package in Shiny produces a table with a searchbar that searches over every column in the table. I have a column of metadata which I do not want to display in the table, but I still want the rows to come up if I search with the search bar.
For example, the app below contains a column titled searchCol . This column is just letters. I want to hide this column in the actual table, and I want to be able to search for the letter b , using the DT search bar, and have the second row show up.
Is there a way to hide the column but have it still work with the search bar?
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput('tbl1'),
)
server <- function(input, output, session) {
output$tbl1 <- DT::renderDT(server = TRUE, {
datatable(
cbind(data.frame(replicate(3,sample(0:1,26,rep=TRUE))), data.frame(searchCol = letters)),
escape = FALSE,
rownames = FALSE,
filter = list(position = "top", clear = FALSE, plain = TRUE),
selection = "single",
options = list(
autoWidth = TRUE,
pageLength = 50,
lengthMenu = c(50, 100, 1000),
dom = 'Blfrtip',
buttons = c('copy', 'excel')
)
)
})
}
shinyApp(ui, server)
I've adapted the answer from here to the format you need to use in DT::datatable. You can use columnDefs to define the render options for the different columns, targets defines which column you mean. Please note that the JS library datatables starts counting columns at 0.
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput('tbl1'),
)
server <- function(input, output, session) {
output$tbl1 <- DT::renderDT(server = TRUE, {
datatable(
cbind(data.frame(replicate(3,sample(0:1,26,rep=TRUE))), data.frame(searchCol = letters)),
escape = FALSE,
rownames = FALSE,
filter = list(position = "top", clear = FALSE, plain = TRUE),
selection = "single",
options = list(
autoWidth = TRUE,
pageLength = 50,
lengthMenu = c(50, 100, 1000),
dom = 'Blfrtip',
buttons = c('copy', 'excel'),
columnDefs = list(
list(
targets = 3,
searchable = TRUE,
visible = FALSE
)
)
)
)
})
}
shinyApp(ui, server)

Button extension to download all data or only visible data

With the button extension to DT package, is there a way to specify that the buttons download either (1) all the data feeding the datatable, or (2) only the data on the visible page.
Below is the example from the documentation.
datatable(
iris, extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print')
)
)
As #divibisan said, one option is to use the server argument of renderDT() to control whether the download button will download only the current or all rows.
That would work well if you want to have one download button. However if you want to have two buttons always appear, where one download the current page and one downloads the full dataset, you can use the following code:
library(shiny)
ui <- fluidPage(
DT::DTOutput("table")
)
server <- function(input, output, session) {
output$table <- DT::renderDT(server = FALSE, {
DT::datatable(
mtcars,
extensions = c("Buttons"),
options = list(
dom = 'Bfrtip',
buttons = list(
list(extend = "csv", text = "Download Current Page", filename = "page",
exportOptions = list(
modifier = list(page = "current")
)
),
list(extend = "csv", text = "Download Full Results", filename = "data",
exportOptions = list(
modifier = list(page = "all")
)
)
)
)
)
})
}
shinyApp(ui, server)
See this answer: Buttons: download button with scroller downloads only few rows
Whether the buttons export all data or only visible data is determined by the server argument in the DT::renderDT function call. If server=FALSE then the buttons will export all data in the table, while if server=TRUE they will only export visible data.
You could set the server argument with a variable to make this a selectable option.
output$table <- DT::renderDT(server = input$download_all, {
DT::datatable( ... )
}
The other option you might want to look at is the exportOptions: modifier: selected option that determines whether to download only selected rows (the default) or all rows. You can read about that option here: https://datatables.net/extensions/buttons/examples/print/select.html
Note that your users might run into performance and memory issues using server=FALSE if your data table is very large.
you are looking for the modifiers: page: selected. here is a working example
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("diamonds", DT::dataTableOutput("mytable1"))
)
)
)
)
server <- function(input, output) {
# choose columns to display
diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
output$mytable1 <- DT::renderDataTable({
DT::datatable(diamonds2,
extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons =
list(
list(
extend = 'csv',
buttons = c('csv'),
exportOptions = list(
modifiers = list(page = "current")
)
))
)
)
})
}
shinyApp(ui, server)
hope this helps!
If you want to include the options to download the current page and the entire dataset as both a csv or an excel file, I've managed to implement this as two separate dropdown buttons with those options, together with the copy and print buttons:
Here is the modified working code:
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table")
)
server <- function(input, output, session) {
output$table <- DT::renderDataTable(server = FALSE, {
DT::datatable(
mtcars,
extensions = "Buttons",
filter = "top",
selection = "none", #this is to avoid select rows if you click on the rows
rownames = FALSE,
options = list(
scrollX = TRUE,
autoWidth = FALSE,
dom = 'Blrtip', # the important thing is that there is the l to allow for the lengthMenu
# https://stackoverflow.com/questions/52645959/r-datatables-do-not-display-buttons-and-length-menu-simultaneously
buttons = list(
# insert buttons with copy and print
# colvis includes the button to select and view only certain columns in the output table
# from https://rstudio.github.io/DT/extensions.html
I('colvis'), 'copy', 'print',
# code for the first dropdown download button
# this will download only the current page only (depends on the number of rows selected in the lengthMenu)
# using modifier = list(page = "current")
# only the columns visible will be downloaded using the columns:":visible" option from:
# https://stackoverflow.com/questions/72317260/how-to-download-only-the-selected-columns-in-a-dataframe-using-colvis-from-dt-in/72317607#72317607
list(
extend = 'collection',
buttons = list(
list(extend = "csv", filename = "page",exportOptions = list(
columns = ":visible",modifier = list(page = "current"))
),
list(extend = 'excel', filename = "page", title = NULL,
exportOptions = list(columns = ":visible",modifier = list(page = "current")))),
text = 'Download current page'),
# code for the second dropdown download button
# this will download the entire dataset using modifier = list(page = "all")
list(
extend = 'collection',
buttons = list(
list(extend = "csv", filename = "data",exportOptions = list(
columns = ":visible",modifier = list(page = "all"))
),
list(extend = 'excel', filename = "data", title = NULL,
exportOptions = list(columns = ":visible",modifier = list(page = "all")))),
text = 'Download all data')
),
# add the option to display more rows as a length menu
lengthMenu = list(c(10, 30, 50, -1),
c('10', '30', '50', 'All'))
),
class = "display"
)
})
}
shinyApp(ui, server)

filter = 'top' does not execute in Shiny app

I just created the following Shiny app using DT. My problem is that filter='top' does not actually seem to execute. Is there a problem combining checkboxGroupInput and filter from DT? I was hoping to be able to add as many filtering options as possible.
ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel('Database'),
sidebarPanel(
p('Welcome to the Database.'),
p('(1) Use the dropdown menus to select a category, type, or manufacturer.'),
p('(2) Use the checkboxes below to add or remove information from the table.'),
checkboxGroupInput('show_vars', 'Information:', names(Foods),
selected = names(Foods)),
),
mainPanel(
fluidRow(h1('A Server-side Table')),
fluidRow(
column(9, DT::dataTableOutput('x3')),
column(3, verbatimTextOutput('x4'))
)
)
)
)
server.R
library(shiny)
library(DT)
shinyServer(function(input, output, session) {
# server-side processing
output$x3 = DT::renderDataTable(Foods[, input$show_vars, drop = TRUE], server = TRUE,
options = list(pageLength = 5, autoWidth = TRUE,
columnDefs = list(list(width = '200px', targets = "_all"))
, filter = 'top'))
# print the selected indices
output$x4 = renderPrint({
s = input$x3_rows_selected
if (length(s)) {
cat('These rows were selected:\n\n')
cat(s, sep = ', ')
}
})
}
)
Move the filter='top' out to renderDataTable like this:
output$x3 = DT::renderDataTable(iris[, input$show_vars, drop = TRUE], server = TRUE,
options = list(pageLength = 5, autoWidth = TRUE,
columnDefs = list(list(width = '200px', targets = "_all"))
),filter='top')

Resources