Create stacked bar sparkline within renderDatatable in R shiny - shiny

Question

I'm trying to replicate this site_details table in R shiny , using stacked bar chart within a column in a table. Here is the code that I'm using currently:
cost_data<- data.frame(site = c('Site 1', 'Site 2','Site 3', 'Site 4'),
cost = c("6,3,6,7", "7,4,7,5","3,2,2,2","6,5,3,2"))
ui <- fluidPage(sparklineOutput("details.1"),
DT::dataTableOutput("cost_table"))
server <- function(input, output) {
output$cost_table <- DT::renderDataTable({
dt <- DT::datatable(as.data.frame(cost_data), rownames = FALSE,
options = list(columnDefs = list(list(targets = 1, render =
JS("function(data, type, full){ return '<span class=sparkSamples>' + data + '</span>' }"))),
fnDrawCallback = JS(paste0("function (oSettings, json) {\n
$('.sparkSamples:not(:has(canvas))').sparkline('html', { ", "type: 'bar',
fillColor: 'black'", " });\n}"), collapse = "")))
})
}
shinyApp(ui = ui, server = server)
The above code gives a simple bar chart. Can a horizontal stacked bar be added instead (as shown in image attached).
Thanks!!

Answer 1

Sparkline may not be able to do what you are looking for i.e., the stacked horizontal bar charts. But you can essentially render a custom JS code within the columnDefs of your renderDataTable.
Below is the sample code for the same-
# Prepare the Sample data
test_data <-
data.table(
Sites = c('Site1', 'Site2', 'Site3', 'Site4'),
A = c(6, 3, 6, 7),
B = c(7, 4, 7, 5),
C = c(3, 2, 2, 2),
D = c(6, 5, 3, 2)
)
test_data$chart <- NA
# Define the Shiny UI and Custom CSS Elements
ui <- fluidPage(tags$head(tags$style(
HTML(
"
.bar-chart-bar {
background-color: #e8e8e8;
display: block;
position:relative;
width: 100%;
height: 20px;
}
.bar {
float: left;
height: 100%;
}
.bar1 {
background-color: green;
}
.bar2 {
background-color: yellow;
}
.bar3 {
background-color: black;
}
.bar4 {
background-color: blue;
}
"
)
)), DT::dataTableOutput("test_table"))
# Rendering the DataTable in Shiny Server
server <- function(input, output) {
output$test_table <- DT::renderDataTable({
dt <- DT::datatable(
as.data.frame(test_data),
rownames = FALSE,
class = "compact display",
options = list(columnDefs = list(list(
targets = -1,
render =
JS(
"function(data, type, row, meta){
return $('<div></div>', {
'class': 'bar-chart-bar'
}).append(function(){
console.log(row)
console.log(row[1])
var bars = [];
for(var i = 1; i < row.length; i++){
bars.push($('<div></div>',{
'class': 'bar ' + 'bar' + i
}).css({
'width': row[i] + '%'
}))
}
return bars;
}).prop('outerHTML')
}"
)
)))
)
})
}
# Run the App
shinyApp(ui, server)
Check below image for the output of above code to show Bar Chart within RenderDataTable -
See Output Image