I want to create an expandable table that shows for certain columns their total sums by year, month, and week. What I mean is the initial table will appear in shiny dashboard showing only the columns sum totals for each year. When you click on the year the row would expand and show its corresponding months and the totals of those columns for each month. I would like to make the month rows further expand when clicked to show the sum totals for each column by week.
I have successfully created a table using the code that I found from this website.
Here is how my table looks like.
I would like to now create expandable rows for the months where it would show the total sums for all columns by weeks of those months. However, I don't know how to go about this since I believe Java code would have to be written and my background is only in R. I have researched online and checked out the website for the package DT in R but I can't find anything that could solve my problem.
Here is the reproducible code for my problem:
library(shiny)
library(DT)
library(jsonlite)
library(lubridate)
library(tidyverse)
# Creating the data
so_date<- seq(as.Date("2019-07-01"),as.Date("2021-08-22"), by = "day")
pivot_df<-cbind.data.frame(Date = so_date,
Year = year(so_date),
Month = months(so_date),
Week = lubridate::week(so_date),
TI = sample.int(1000, 784, replace = TRUE),
PAU = sample.int(1000, 784, replace = TRUE),
AU = sample.int(1000, 784, replace = TRUE),
PE = sample.int(1000, 784, replace = TRUE),
TPH = sample.int(1000, 784, replace = TRUE),
APD = sample.int(1000, 784, replace = TRUE),
PRC = sample.int(1000, 784, replace = TRUE),
URC = sample.int(1000, 784, replace = TRUE),
Pat_AU = sample.int(1000, 784, replace = TRUE))
server <- function(input, output) {
## Generate a data frame containing grouped data
## Subtable is included, formatted as JSO
# Splits the data frame by year
l.df<- split(pivot_df,pivot_df$Year)
# This aggregates the totals by month.
# Basically calculates the table in blue in the image which will be formated into JSON
# It then combines the sum totals for the year of each column and the subtable (monthly aggregated data) in a list.
l.cars <- lapply(l.df, function(x) {
subTable1<-x %>% group_by(Month) %>%
summarize(TI = sum(TI, na.rm = T),
AU = sum(AU, na.rm = T),
PAU = sum(PAU, na.rm = T),
PE = sum(PE , na.rm = T),
TPH = sum(TPH, na.rm = T),
APD = sum(APD , na.rm = T),
PRC = sum(PRC, na.rm = T),
URC = sum(URC, na.rm = T)
)
subTable1<-data.frame(subTable1)
return(list(TI = sum(x$TI, na.rm = T),
AU = sum(x$AU, na.rm = T),
PAU = sum(x$PAU, na.rm = T),
PE = sum(x$PE , na.rm = T),
TPH = sum(x$TPH, na.rm = T),
APD = sum(x$APD , na.rm = T),
PRC = sum(x$PRC, na.rm = T),
URC = sum(x$URC, na.rm = T),
subTable = toJSON(subTable1)))
}
)
# all elements in list become their own columns even the JSON
df<- data.frame(Year = names(l.cars), do.call('rbind', l.cars), stringsAsFactors = FALSE)
## shiny table output
## datatable with expand/collapse buttons
## on expanding, subtable is rendered from JSON to HTML
output$dt <- DT::renderDataTable({
df <- cbind(' ' = '⊕', df)
datatable(
df,
escape = -2,
options = list(
dom = 't',
columnDefs = list(
list(visible = FALSE, targets = c(0, 11)), # hides row names and Json
list(orderable = FALSE, className = 'details-control', targets = 1)
)
),
callback = JS("
var format = function(d) {
var table = document.createElement('table');
var tableBody = document.createElement('tbody');
var embeddedTableRows = d[11]; // JSON automatically converted to array
var subtable = [];
var arr = [];
$.each(embeddedTableRows, function (index, item) {
arr = [];
$.each(item, function(k, v) {
arr.push(v);
})
subtable.push(arr);
});
// Add table headers
headers = [];
$.each(embeddedTableRows[0], function(k, v) {
headers.push(k);
})
for(var i=0; i<headers.length; i++){
table.appendChild(document.createElement('th')).
appendChild(document.createTextNode(headers[i]));
}
// Add table body
for (var i = 0; i < subtable.length; i++) {
var row = document.createElement('tr');
for (var j = 0; j < subtable[i].length; j++) {
var cell = document.createElement('td');
cell.appendChild(document.createTextNode(subtable[i][j]));
cell.style.backgroundColor = 'lightblue';
row.appendChild(cell);
}
tableBody.appendChild(row);
}
table.appendChild(tableBody);
return(table);
};
// Event handler - expand inner table
table.on('click', 'td.details-control', function() {
var td = $(this), row = table.row(td.closest('tr'));
if (row.child.isShown()) {
row.child.hide();
td.html('⊕').css('color', 'green');
} else {
row.child(format(row.data())).show();
td.html('⊖').css('color', 'red');
}
});"
),
selection = 'none') %>%
formatStyle(1, color = 'green', fontWeight = 'bold', fontSize = '150%', cursor = 'pointer')
})
}
ui <- fluidPage(
br(),
h4('Example of embedding subtables in a datatable'),
br(),
DT::dataTableOutput('dt')
)
shinyApp(server = server, ui = ui)
