searchPanes extension in Rmarkdown - r

I am trying to get the searchPanes extension from DT to work in an rmarkdown file (https://rstudio.github.io/DT/extensions.html). I can get it to work with datatable but not with renderDataTable and reactive statement. Attached is a working example that one tab shows it working and the other tab showing the issue. Any advice/recommendation is appreciate.
My code:
---
title: "Filter_example"
output: flexdashboard::flex_dashboard
runtime: shiny
date: "`r Sys.Date()`"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = F)
library(DT)
library(tidyverse)
```
# Sidebar {.sidebar data-width="200"}
```{r sidebar, echo=FALSE}
selectizeInput('color', label ='color', choices = diamonds$color ,
multiple = TRUE,
options = list(maxItems = 5,
placeholder = 'Search Here...'))
```
# Diamonds Are Forever
```{r echo=FALSE}
diamonds %>%
datatable(
rownames = F,
extensions = c("SearchPanes", "Select", "Buttons"),
options = list(
language = list(searchPanes = list(collapse = "Filter Rows")),
scrollX= "30vw",
scrollY = "45vh",
dom = "Blfrtip",
buttons = list("searchPanes")
),
selection = 'none'
)
```
# Diamonds Are Forever renderDataTable
```{r echo=FALSE}
diamonds_dd <- reactive({
if (is.null(input$color)){
diamonds
}
else if(!is.null(input$color)) {
diamonds %>%
filter(color %in% input$color)
}
})
DT::renderDataTable(diamonds_dd(),extensions = c("SearchPanes", "Select", "Buttons"),
options = list(
scrollX= "30vw",
scrollY = "45vh",
dom = "Blfrtip",
buttons = list("searchPanes"),
columnDefs = list(
list(searchPanes = list(show = FALSE), targets = 3:5),
list(searchPanes = list(controls = FALSE), targets = 0:2),
list(className = "dt-center", targets = 0:5)
)
),
selection = 'none'
)
```

You need server = FALSE.
DT::renderDataTable(
diamonds_dd(), extensions = c("SearchPanes", "Select", "Buttons"),
options = list(
scrollX= "30vw",
scrollY = "45vh",
dom = "Blfrtip",
buttons = list("searchPanes"),
columnDefs = list(
list(searchPanes = list(show = FALSE), targets = 3:5),
list(searchPanes = list(controls = FALSE), targets = 0:2),
list(className = "dt-center", targets = 0:5)
)
),
selection = 'none',
server = FALSE
)
However, this is not recommended for a large dataset like diamonds. It sends all rows to users which is unnecessary and takes a long time.

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)

Rmarkdown Download data with download button for that row

Update
renderdatatable doesnt show actionbutton, renderDT shows but not able to just download the table although i can see the actionbutton being triggered with cat statement
I'm new to markdown trying to build a markdown application which needs to download data depending on the action/download button. In my example below, id like to have a downloadButton or downloadLink to download the row contents of the download button row, if i click on the first action button then id like to download mtcars 1st row values for mpg, cyl, disp to a csv or excel.
I have a fairly large subset in the actual application so i can filter accordingly.
The problem is i am not getting an action button but just raw html in my DT, not sure if i am missing small details.
---
title: "Download data with download button"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(DT)
library(downloadthis)
library(dplyr)
```
```{r, echo=FALSE}
shinyInput <- function(FUN, n, id, ...) {
vapply(seq_len(n), function(i){
as.character(FUN(paste0(id, i), ...))
}, character(1))
}
downloadButtonRmd <- function (outputId, label = "Download", class = NULL, ...) {
tags$a(id = outputId, class = paste("btn btn-default shiny-download-link",
class), href = "", target = "_blank", download = NA,
icon("download"), label, ...)
}
tab <- data.frame(head(mtcars[1:3]))
tab <- tab %>% mutate(
dl1 = shinyInput(actionButton, nrow(.), 'button_', label = "Download", onclick = 'Shiny.onInputChange(\"select_button\", this.id)' ),
dl2 = shinyInput(downloadButtonRmd, nrow(.), 'button_', label = "Download",onclick = 'Shiny.onInputChange(\"select_button1\", this.id)' ))
# renderDataTable({
# tab %>%
# datatable(extensions = 'Buttons',
# options = list(dom = 'Blfrtip',
# buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
# lengthMenu = list(c(10,25,50,-1),
# c(10,25,50,"All"))))
# })
renderDT({
datatable(tab,
options = list(pageLength = 25,
dom = "rt"),
rownames = FALSE,
escape = FALSE)})
observeEvent(input$select_button1, {
selectedRow <<- as.numeric(strsplit(input$select_button1, "_")[[1]][2])
cat(input$select_button1)
downloadHandler(filename = "Academic Report.csv",
content = function(file) {write.csv(tab[selectedRow,1:3], file, row.names = FALSE)},
contentType = "text/csv")
})
```
I've read through these links and many others but i'm unable to get what I intended
RShiny Download Button Within RMarkdown
R Shiny: Handle Action Buttons in Data Table
Thanks
Here is a way with the downloadthis package.
---
title: "DT download row"
author: "Stéphane Laurent"
date: "21/03/2022"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(DT)
library(downloadthis)
htmltools::tagList( # for the icons
rmarkdown::html_dependency_font_awesome()
)
```
```{r}
dat <- mtcars
dat[["Download"]] <- vapply(1L:nrow(mtcars), function(i){
as.character(
download_this(
.data = mtcars[i, ],
output_name = paste0("mtcars - row ", i),
output_extension = ".csv",
button_label = "Download",
button_type = "primary",
icon = "fa fa-save",
csv2 = FALSE,
self_contained = TRUE
)
)
}, character(1L))
```
```{r}
datatable(
dat,
escape = FALSE,
options = list(
columnDefs = list(
list(targets = ncol(dat), orderable = FALSE),
list(targets = "_all", className = "dt-center")
)
)
)
```
Of course that won't work if you edit the table.

Factor Search Clearing Button in DT: shinydashboard vs. shinymaterial

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").

Replace options in R Shiny datatable on the fly

I would like to change the language of a datatable on the fly
I have the following code
output$prr2 <- renderDataTable({
prr()}, options = list(
autoWidth = TRUE,
columnDefs = list(list(width = '50', targets = c(1, 2) ) ),
language = list(url = if(getLanguage()=='gr') '//cdn.datatables.net/plug-ins/1.10.11/i18n/Greek.json' else
'//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json' ))
getLanguage() returns the value of selected_language, prr() returns a data.frame.
I want to do something like this in order to change options of the table after selecting a different language in a dropdown selected_language
proxy = dataTableProxy('prr2')
observeEvent(input$selected_language,{ replace language option of datatable prr2})
Any idea about this?
I can't test since you don't provide a reproducible example. I would try
output$prr2 <- renderDataTable({
prr()
}, options = exprToFunction(list(
autoWidth = TRUE,
columnDefs = list(list(width = '50', targets = c(1, 2))),
language = list(
url = ifelse(getLanguage()=='gr',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/Greek.json',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json')
)
)))
EDIT
output$prr2 <- renderDataTable({
datatable(
prr(),
options = exprToFunction(list(
autoWidth = TRUE,
columnDefs = list(list(width = '50', targets = c(1, 2))),
language = list(
url = ifelse(getLanguage()=='gr',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/Greek.json',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json')
)
)
)
)
})
EDIT 2
Full app which works:
library(shiny)
library(DT)
ui <- fluidPage(
radioButtons("language", "Language", choices = c("gr", "en")),
DTOutput("prr2")
)
server <- function(input, output, session){
output$prr2 <- renderDT({
datatable(
iris,
options = exprToFunction(list(
autoWidth = TRUE,
columnDefs = list(list(width = '50', targets = c(1, 2))),
language = list(
url = ifelse(input$language=='gr',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/Greek.json',
'//cdn.datatables.net/plug-ins/1.10.11/i18n/English.json')
)
))
)
})
}
shinyApp(ui, server)

Display the number of rows of a datatable that are selected by tickboxes in a shiny app

I have a simple shiny app.
#ui.r
navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("tex2")
),
mainPanel(
DT::dataTableOutput("hot3")
)
)))
#server.r
library(shiny)
library(DT)
library(tidyverse)
server <- function(input, output,session) {
output$tex2<-renderUI({
numericInput("text2","Rows selected",
value = 1,
min=1
)
})
output$hot3 <-DT::renderDataTable(
iris%>% rowid_to_column("Row") %>% mutate(Row = ""),
rownames = FALSE,
extensions = "Select",
options = list(
columnDefs = list(list(className = "select-checkbox", targets = 0, orderable = FALSE)),
select = list(style = "os", selector = "td:first-child")),
selection=list(mode="single")
)
}
What I need to do is display the number of rows selected in the datatable in the numericInput() in the sidebarPanel. This number is already displayed under the table but I would like to have it in the numericInput() as well. If I want to select multiple items, I need to keep the command key pressed on my Mac. On a Windows machine it should be the control key I believe. Or use shift to select multiple adjacent items.
Here is a minimal example using an RMarkdown document with a shiny backend to show how to get the number of selected rows.
---
title: "Untitled"
output: html_document
runtime: shiny
---
```{r echo=FALSE}
library(DT)
library(tidyverse)
dataTableOutput("irisTable")
output$irisTable <- renderDataTable(
iris %>% rowid_to_column("Row") %>% mutate(Row = ""),
rownames = FALSE,
extensions = "Select",
options = list(
columnDefs = list(list(className = "select-checkbox", targets = 0, orderable = FALSE)),
select = list(style = "multi", selector = "td:first-child")
))
p("Selected rows are...")
renderText(input$irisTable_rows_selected)
```
Please note that in comparison to my answer to your previous post, I've changed the select.style behaviour to select = list(style = "multi", selector = "td:first-child"); this allows you to select multiple entries by single-clicking on rows (instead of having to hold the Command/Ctrl key).

Resources