I have a shiny app where I use the package DT to create interactive tables. For some of the tables, the first column is text where I need custom sorting. Defining the text column as a factor works great to achieve custom sorting within the app. But if I hand over the same data frame to a rmarkdown file, custom sorting does not work anymore (inside the rmarkdown file, the DT table is recreated and the file is finally exported as .html using a download button).
Does anyone know a way to again compel custom sorting based on the factor in rmarkdown / the exported html file?
I have created an example app below to illustrate the problem.
app.R
library(shiny)
library(dplyr)
library(DT)
# Define UI
ui <- shinyUI(fluidPage(
titlePanel("Example App"),
# Define sidebarLayout
sidebarLayout(
sidebarPanel(
# Create download button
downloadButton(
outputId = 'download_report',
label = ' download report',
icon = icon('download'),
class = 'form-group shiny-input-container')
),
# Show table
mainPanel(
DTOutput("table")
)
)
))
# Define server logic
server <- shinyServer(function(input, output, session) {
# set seed
set.seed(123)
# Define order of categories
order_cat <- c("Out", "12WO", "ARC")
# Create container
rv_container <- reactiveValues()
# Create data
rv_container$df <- tibble(category = c("Out", "ARC", "12WO"),
value_1 = sample(1:100, 3),
value_2 = sample(1:100, 3),
value_3 = sample(1:100, 3),
value_4 = sample(1:100, 3)) %>%
mutate(select(., starts_with("value")) %>% rowSums(),
# Switch type of category column to factor
category = factor(category,
levels = order_cat,
labels = order_cat))
# Create output
output$table <- renderDT({
# Create header of table
headers <- withTags(
table(class = "display",
thead(tr(th(colspan = 1,"", style = "border-bottom : none;"),
th(colspan = 2, "Header 1", style = "text-align: center;"),
th(colspan = 2, "Header 2", style = "text-align: center;"),
th(colspan = 1, "", style = "border-bottom : none;")),
tr(th(colspan = 1, "", style = "text-align: center;"),
th(colspan = 1, "Value 1", style = "text-align: center;"),
th(colspan = 1, "Value 2", style = "text-align: center;"),
th(colspan = 1, "Value 3", style = "text-align: center;"),
th(colspan = 1, "Value 4", style = "text-align: center;"),
th(colspan = 1, "Total", style = "text-align: center;")))))
# Create table
datatable(rv_container$df,
container = headers,
rownames = FALSE,
escape = FALSE,
options = list(searching = FALSE,
paging = FALSE, info = FALSE, autoWidth = FALSE,
columnDefs = list(list(className = "dt-right",
targets = 1:5)))) %>%
formatStyle(c(2, 4, 6), `border-left` = "1px solid #ddd") %>%
formatStyle(6, backgroundColor = "lightgrey")
})
# Create html report
output$download_report <- downloadHandler(
# Define name
filename = function(){
"report.html"
},
# Define content
content = function(file) {
progress_down <- Progress$new(session, min = 1, max = 50)
on.exit(progress_down$close())
progress_down$set(message = "Download in progress", value = 5)
params_markdown <- reactiveValuesToList(rv_container)
progress_down$set(value = 50)
# Create html report
rmarkdown::render("html_markdown.Rmd",
output_file = file,
params = params_markdown,
envir = new.env(parent = globalenv())
)
}
)
})
shinyApp(ui = ui, server = server)
html_markdown.Rmd
---
title: "html report created from app"
output: html_document
params:
df: NA
---
```{r setup, include=FALSE}
library(shiny)
library(dplyr)```
```{r cars, echo = FALSE}
# Create header
headers <- withTags(
table(class = "display",
thead(tr(th(colspan = 1,"", style = "border-bottom : none;"),
th(colspan = 2, "Header 1", style = "text-align: center;"),
th(colspan = 2, "Header 2", style = "text-align: center;"),
th(colspan = 1, "", style = "border-bottom : none;")),
tr(th(colspan = 1, "", style = "text-align: center;"),
th(colspan = 1, "Value 1", style = "text-align: center;"),
th(colspan = 1, "Value 2", style = "text-align: center;"),
th(colspan = 1, "Value 3", style = "text-align: center;"),
th(colspan = 1, "Value 4", style = "text-align: center;"),
th(colspan = 1, "Total", style = "text-align: center;")))))
dt <- datatable(df, container = headers,
rownames = FALSE, escape = FALSE,
options = list(searching = FALSE,
paging = FALSE, info = FALSE, autoWidth = FALSE,
columnDefs = list(list(className = "dt-right",
targets = 1:5)))) %>%
formatStyle(c(2, 4, 6), `border-left` = "1px solid #ddd") %>%
formatStyle(6, backgroundColor = "lightgrey")
dt```
Supplement: I'm using the newest version of R, DT, shiny and rmarkdown. I also know that there are some workarounds to bypass the problem like creating another numerical column that is used for sorting but invisible. I'd like to avoid these workarounds and find a solution based on the factors instead because otherwise I'd need to manually adapt many different tables.