I am trying to build an interactive table in flexdashboard with Shiny. The following reprex displays the table in the Rstudio viewer but the CSV button does not work. When attempting to open in a local browser the table is not displayed.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(DT)
library(shiny)
df <- data_frame(
x = c("a", "b", "c", "c", "b", "c", "b", "a"),
y = c(1, 6, 7, 5, 9, 3, 8, 2),
z = c("one", "two", "three", "one", "two", "three", "one", "two")
)
```
Column {data-width=200 .sidebar}
-----------------------------------------------------------------------
```{r}
selectInput("x_input", label = "Select x Value",
choices = c("All", unique(as.character(df$x))), selected = "All")
roster_input <- reactive({
if (input$x_input=="All"){
df
}else{
df %>%
filter(x==input$x_input)}
})
```
Column {data-width=350}
-----------------------------------------------------------------------
### Chart B
```{r}
renderDataTable({
DT::datatable(
roster_input(),
rownames = FALSE,
filter = "top",
extensions = c('Buttons', 'Scroller'),
options = list(
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
deferRender = T,
scrollY = '400px',
scroller = TRUE))})
```
What am I missing to make this work in my local browser?
Related
In my toy example, I am trying to render Rmd file in the shiny app while passing a variable from Shiny to Rmd. Somehow, the Rmd file is not able to pick the input input$selectInput passed to Rmd file. Can someone show me how to pass a variable from Shiny to Rmd file and print it there?
My intent is to use Rmd file as a template which will be filled by variables from Shiny App at runtime. There may be better alternatives to this approach to render HTML templates in Shiny, do let me know if you know any better approches.
library(shiny)
library(shinydashboard)
library(knitr)
sidebar <- dashboardSidebar(
collapsed = FALSE,
sidebarMenu(
id = "menu_sidebar",
conditionalPanel(
condition = "input.main_tab == 'tab 1'",
selectizeInput(inputId = "selectInput", label = "Choose an option", choices = c("a", "b", "c"), selected = "a", multiple = FALSE),
radioButtons(inputId = "buttons", label = "Choose one:",
choices=c(
"A" = "a",
"B" = "b"))
)
)
)
body <- dashboardBody(
fluidRow(
tabsetPanel(
id = "main_tab",
selected = "tab 1",
tabPanel(title = "tab 1", "Tab content 1",
conditionalPanel("input.buttons == 'a'",
{
knit("text1.Rmd", envir = globalenv(), quiet = T)
withMathJax(includeMarkdown("text1.md"))
},
tags$style("html, body {overflow: visible !important;")),
conditionalPanel("input.buttons == 'b'", htmlOutput("plot_overview_handler"))
)
)
)
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
sidebar,
body
),
server = function(input, output) {
output$tabset1Selected <- output$tabset2Selected <- renderText({
input$main_tab
})
output$plot_overview_handler <- renderUI({
pars <- list(variable_1 = input$selectInput)
includeMarkdown(rmarkdown::render(input = "text2.Rmd",
output_format = "html_document",
params = pars,
run_pandoc = FALSE,
quiet = TRUE,
envir = new.env(parent = globalenv())))
})
}
)
Rmd File 1 - text1.Rmd
---
title: "tst2"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
#``` # Uncomment this to run code
## R Markdown
```{r cars}
print(input$selectInput)
#``` # Uncomment this to run code
Rmd File 2 - text2.Rmd
---
title: "tst2"
output: html_document
runtime: shiny
params:
variable_1: NA
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
#``` # Uncomment this to run code
## R Markdown
```{r cars}
print(params$variable_1)
#``` # Uncomment this to run code
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.
I am working with flexdashboard and I am trying to add sub tabset into tabset . Below you can see my code:
---
title: "Test APPLICATION"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(data.table)
library(tidyr)
library(dplyr)
library(tidyverse)
library(knitr)
library(DT)
library(rpivotTable)
library(biclust)
data(BicatYeast)
data=data.frame(data(BicatYeast))
```
# Intro
Testing application
Tabset 1
=======================================================================
Row {.tabset}
-----------------------------------------------------------------------
### Notes
### Sub tabset 1
```{r,eval=TRUE}
rpivotTable(
data,
aggregatorName = "Integer Sum",
vals="Total",
cols = "Test",
width="100%",
height="400px",
rendererName = "Table"
)
```
### Sub tabset 2
```{r,eval=TRUE}
rpivotTable(
data,
aggregatorName = "Integer Sum",
vals="Total",
cols = "Test",
width="100%",
height="400px",
rendererName = "Table"
)
```
Tabset 2
=======================================================================
Row {.tabset}
-----------------------------------------------------------------------
### Sub tabset 1
```{r,eval=TRUE}
datatable(data,
caption = "Test",
rownames = T,
filter = "top",
class = 'cell-border stripe',
extensions='Buttons',
options = list(
pageLength = 50,
dom = 'Blfrtip',
buttons=c('copy','csv','excel','pdf','print'),
lengthMenu = list(c(10,25,50,-1),c(10,25,50,"All"))
))
```
### Sub tabset 2
```{r,eval=TRUE}
datatable(data,
caption = "Test",
rownames = T,
filter = "top",
class = 'cell-border stripe',
extensions='Buttons',
options = list(
pageLength = 50,
dom = 'Blfrtip',
buttons=c('copy','csv','excel','pdf','print'),
lengthMenu = list(c(10,25,50,-1),c(10,25,50,"All"))
))
```
Now, I want to put additional tab sets under Sub tabset 1. Can anybody help me on how to solve this problem and add additional tab sets (two or three)?
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.
I'm trying to build a panel where when selecting a State in a drop-down list the value of a valueBox dynamically change according to the column value in the database, but in every attempt I get an error return. Below, the code used:
library(flexdashboard)
library(shiny)
UF = c('AC', 'AM', 'AP', 'BA', 'CE', 'ES', 'PB', 'PE')
Column = c(30, 200, 7, 12, 854, 2, 78, 965)
df <- data.frame(UF,Coluna)
Row {data-width=200 .sidebar}
--------------------------------------------------------------
{r}
selectInput(inputId = "states",
label="Select State:",
choices = unique(df$UF),
selected = "",
multiple=FALSE
)
Row
-----------------------------------------------------------------------
{r}
renderValueBox({
b <- df %>%
filter(UF %in% input$states) %>%
select(df$Column)
valueBox(value = b, icon = "fa-users")
})
It turns out you have a couple of mistakes here:
You have some misspelling of variable names.
You didn't load all the required libraries.
You had the wrong {dplyr} grammar for select.
After fixing everything, here is the working code:
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r}
library(flexdashboard)
library(shiny)
library(magrittr)
library(dplyr)
```
```{r}
UF = c('AC', 'AM', 'AP', 'BA', 'CE', 'ES', 'PB', 'PE')
Column = c(30, 200, 7, 12, 854, 2, 78, 965)
df <- data.frame(UF,Column)
```
Row {data-width=200 .sidebar}
--------------------------------------------------------------
```{r}
selectInput(inputId = "states",
label="Select State:",
choices = unique(df$UF),
selected = "",
multiple=FALSE
)
```
Row
-----------------------------------------------------------------------
```{r}
renderValueBox({
b <- df %>%
filter(UF %in% input$states) %>%
select(Column)
valueBox(value = b, icon = "fa-users")
})
```