Simple Table Format

section <- c('Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Age Group', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Race', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Urbanicity', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category', 'Eligibility Category')
row <- c('0 - 1 years', '0 - 1 years', '0 - 1 years', '0 - 1 years', '0 - 1 years', '1 - 6 years', '1 - 6 years', '1 - 6 years', '1 - 6 years', '1 - 6 years', '6 - 12 years', '6 - 12 years', '6 - 12 years', '6 - 12 years', '6 - 12 years', '12 - 18 years', '12 - 18 years', '12 - 18 years', '12 - 18 years', '12 - 18 years', '18 - 40 years', '18 - 40 years', '18 - 40 years', '18 - 40 years', '18 - 40 years', '40 - 65 years', '40 - 65 years', '40 - 65 years', '40 - 65 years', '40 - 65 years', '65+ years', '65+ years', '65+ years', '65+ years', '65+ years', '(Missing)', '(Missing)', '(Missing)', '(Missing)', '(Missing)', 'Black', 'Black', 'Black', 'Black', 'Black', 'Other', 'Other', 'Other', 'Other', 'Other', 'White', 'White', 'White', 'White', 'White', 'Rural', 'Rural', 'Rural', 'Rural', 'Rural', 'Suburban', 'Suburban', 'Suburban', 'Suburban', 'Suburban', 'Urban', 'Urban', 'Urban', 'Urban', 'Urban', 'Other', 'Other', 'Other', 'Other', 'Other', 'Children', 'Children', 'Children', 'Children', 'Children', 'ABD', 'ABD', 'ABD', 'ABD', 'ABD', 'Families', 'Families', 'Families', 'Families', 'Families')
column <- c(2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018, 2014, 2015, 2016, 2017, 2018)
n <- c(114070, 127260, 113850, 111773, 108867, 300267, 339468, 316200, 306990, 296140, 332560, 362730, 346085, 339580, 328415, 266490, 279935, 252640, 238020, 216645, 232380, 317585, 322620, 331410, 328125, 186155, 237759, 239256, 230060, 227650, 107675, 138970, 129725, 114560, 103575, 3680, 5415, 4880, 4330, 4200, 581130, 694504, 670801, 659088, 635207, 215200, 242820, 230835, 224630, 214365, 739587, 860968, 813860, 784345, 755645, 740980, 863114, 826096, 801345, 773100, 367137, 426583, 404130, 392968, 377237, 431480, 514010, 490150, 478080, 459080, 116317, 120583, 109570, 102950, 95405, 794470, 835015, 761135, 733298, 699357, 370135, 461569, 453116, 424975, 405140, 258675, 386540, 396555, 411170, 409515)
percent <- c(0.074090817, 0.070554697, 0.066177394, 0.066834171, 0.067643749, 0.195029608, 0.188205734, 0.18379703, 0.183563313, 0.184004518, 0.216004578, 0.201102507, 0.201168233, 0.20305036, 0.204058364, 0.17309075, 0.155199819, 0.146851618, 0.142323007, 0.134610856, 0.150935602, 0.176073498, 0.187528773, 0.198165144, 0.203878175, 0.120911511, 0.131816864, 0.139071924, 0.13756336, 0.141448736, 0.069937133, 0.077046882, 0.075405028, 0.068500645, 0.064355602, 0.002390236, 0.003002151, 0.002836589, 0.002589104, 0.002609641, 0.377455919, 0.385042582, 0.389915344, 0.394098755, 0.394681428, 0.139776838, 0.134622752, 0.134177064, 0.134316515, 0.133194194, 0.480377008, 0.477332516, 0.473071003, 0.468995625, 0.469514737, 0.48128179, 0.478522288, 0.480183402, 0.4791607, 0.48036028, 0.238463052, 0.23650349, 0.23490795, 0.234973478, 0.234393572, 0.280255158, 0.284974223, 0.284908648, 0.285865822, 0.285246148, 0.07555029, 0.066852876, 0.063689566, 0.061558497, 0.05927923, 0.516024648, 0.462943815, 0.442423633, 0.438472297, 0.434540582, 0.240410315, 0.25590021, 0.263381958, 0.254111922, 0.251730906, 0.168014747, 0.214303099, 0.230504843, 0.245857284, 0.254449282)
data <- data.frame(section, row, column, n, percent)

cell_formats <- list(
  default = list(
    list(variable = 'n', format = 'number', label = 'Population'),
    list(variable = 'percent', format = 'percent_bar', label = 'Percent of Population')
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats
)

Advanced Table Format

section <- c(
  NA, NA, NA, NA, NA,
  NA, NA, NA, NA, NA,
  'Race', 'Race', 'Race', 'Race', 'Race',
  'Race', 'Race', 'Race', 'Race', 'Race',
  'Race', 'Race', 'Race', 'Race', 'Race'
)
row <- c(
  'Overall', 'Overall', 'Overall', 'Overall', 'Overall',
  'Age', 'Age', 'Age', 'Age', 'Age',
  'White', 'White', 'White', 'White', 'White',
  'Black', 'Black', 'Black', 'Black', 'Black',
  'Other', 'Other', 'Other', 'Other', 'Other'
)
column_group <- c(
  'Column Group 1', 'Column Group 1', 'Column Group 2', 'Column Group 2', 'Column Group 2',
  'Column Group 1', 'Column Group 1', 'Column Group 2', 'Column Group 2', 'Column Group 2',
  'Column Group 1', 'Column Group 1', 'Column Group 2', 'Column Group 2', 'Column Group 2',
  'Column Group 1', 'Column Group 1', 'Column Group 2', 'Column Group 2', 'Column Group 2',
  'Column Group 1', 'Column Group 1', 'Column Group 2', 'Column Group 2', 'Column Group 2'
)
column <- c(
  'Column 1a', 'Column 1b', 'Column 2a', 'Column 2b', 'Column 2c',
  'Column 1a', 'Column 1b', 'Column 2a', 'Column 2b', 'Column 2c',
  'Column 1a', 'Column 1b', 'Column 2a', 'Column 2b', 'Column 2c',
  'Column 1a', 'Column 1b', 'Column 2a', 'Column 2b', 'Column 2c',
  'Column 1a', 'Column 1b', 'Column 2a', 'Column 2b', 'Column 2c'
)
cell_format <- c(
  'a', 'a', 'a', 'a', 'a',
  'b', 'b', 'b', 'b', 'b',
  'c', 'c', 'c', 'c', 'c',
  'c', 'c', 'c', 'c', 'c',
  'd', 'd', 'd', 'd', 'd'
)
stat <- c(
  1539597, 1803707, 1720376, 1672393, 1609417,
  64, 55, 67, 59, 60,
  20, 21, 22, 23, 24,
  10, 11, 12, 13, 14,
  1, 2, 3, 4, 5
)
percent <- c(
  NA, NA, NA, NA, NA,
  NA, NA, NA, NA, NA,
  0.480377008, 0.477332516, 0.473071003, 0.468995625, 0.469514737,
  0.377455919, 0.385042582, 0.389915344, 0.394098755, 0.394681428,
  0.139776838, 0.134622752, 0.134177064, 0.134316515, 0.133194194
)
range <- c(
  NA, NA, NA, NA, NA,
  '(60-68)', '(50-60)', '(65-69)', '(58-60)', '(50-70)',
  NA, NA, NA, NA, NA,
  NA, NA, NA, NA, NA,
  NA, NA, NA, NA, NA
)
data <- data.frame(section, row, column_group, column, cell_format, stat, percent, range)

cell_formats <- list(
  a = list(
    list(variable = 'stat', format = 'number', align = 'center', label = 'Population')
  ),
  b = list(
    # classes are ways to add styling to a cell - currently just 'emphasis', but we can add more as more styling is needed
    list(variable = 'stat', format = 'number', classes = list('emphasis'), label = 'Median'),
    list(variable = 'range', format = 'none', label = 'Range')
  ),
  c = list(
    # Note the flex property allows you to tweak column width allocation to each cell
    # By default the cell width will be distributed equally
    list(variable = 'stat', format = 'number', flex = '40%', label = 'Population'),
    list(variable = 'percent', format = 'percent_bar', flex ='60%', label = 'Percent of Population')
  ),
  d = list(
    list(variable = 'stat', format = 'number', flex = '40%', align = 'right', label = 'Population'),
    list(variable = 'percent', format = 'number', type = 'percent_short', flex ='60%', parens = TRUE, align = 'left', label = 'Percent of Population')
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats,
  data_column_width = 144 # note: this width will fit 5 columns without arrows for paging
)

Text Value Table

section <- rep('Age Group', 7)
row <- c('0 - 1 years', '1 - 6 years', '6 - 12 years', '12 - 18 years', '18 - 40 years', '40 - 65 years', '65+ years')
column <- rep('Text Values', 7)
val <- c('1000 (500, 1500)', '50 (25, 75)', '5 (0, 10)', '10 (5, 15)', '500 (250, 750)', '7 (5, 9)', '6 (5, 9)')
cell_format <- rep('text', 7)

column2 <- rep('Number Values', 7)
val2 <- c(1000, 50, 5, 10, 500, 7, 6)
cell_format2 <- rep('number', 7)
data <- rbind(
  data.frame(section, row, column, val, val2 = rep(NA, 7), cell_format),
  data.frame(section, row, column = column2, val = rep(NA, 7), val2, cell_format = cell_format2)
)

cell_formats <- list(
  text = list(
    list(variable = 'val', format = 'text', align = 'center')
  ),
  number = list(
    list(variable = 'val2', format = 'number', align = 'center')
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats,
  no_sort_columns = list('Text Values')
)

No Section Table

row1 <- 'Cutaneous autoimmunity (alopecia areata, vitiligo, allergic urticaria (hives))'
row2 <- 'Venous thromboembolic disease'
row3 <- 'ASCVD'
row <- c(
  row1, row1, row1, row1, row1,
  row2, row2, row2, row2, row2,
  row3, row3, row3, row3, row3
)
column <- c(
  'Two Thousand and Fourteen', 'Two Thousand and Fifteen', 'Year Two Thousand and Sixteen', 'Two Thousand and Seventeen', 'Two Thousand and Eighteen',
  'Two Thousand and Fourteen', 'Two Thousand and Fifteen', 'Year Two Thousand and Sixteen', 'Two Thousand and Seventeen', 'Two Thousand and Eighteen',
  'Two Thousand and Fourteen', 'Two Thousand and Fifteen', 'Year Two Thousand and Sixteen', 'Two Thousand and Seventeen', 'Two Thousand and Eighteen'
)
n <- c(
  20, 21, 22, 23, 24,
  10, 11, 12, 13, 14,
  1, 2, 3, 4, 5
)
data <- data.frame(row, column, n)

cell_formats <- list(
  default = list(
    list(variable = 'n', format = 'number', align = 'center', label = 'Random Value')
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats,
  primary_label = 'Comorbidities'
)

Sparkline as secondary label

section_name <- 'Comorbidities'
section <- c(
  NA, NA, NA, NA, NA, NA,
  section_name, section_name, section_name, section_name, section_name, section_name,
  section_name, section_name, section_name, section_name, section_name, section_name,
  section_name, section_name, section_name, section_name, section_name, section_name
)

row1 <- 'Cutaneous autoimmunity (alopecia areata, vitiligo, allergic urticaria (hives))'
row2 <- 'Venous thromboembolic disease'
row3 <- 'ASCVD'
row <- c(
  'Overall', 'Overall', 'Overall', 'Overall', 'Overall', 'Overall',
  row1, row1, row1, row1, row1, row1,
  row2, row2, row2, row2, row2, row2,
  row3, row3, row3, row3, row3, row3
)
column <- c(
  2014, 2015, 2016, 2017, 2018, 2019,
  2014, 2015, 2016, 2017, 2018, 2019,
  2014, 2015, 2016, 2017, 2018, 2019,
  2014, 2015, 2016, 2017, 2018, 2019
)
cell_format <- c(
  'a', 'a', 'a', 'a', 'a', 'a',
  'b', 'b', 'b', 'b', 'b', 'b',
  'b', 'b', 'b', 'b', 'b', 'b',
  'b', 'b', 'b', 'b', 'b', 'b'
)
stat <- c(
  1539597, 1803707, 1720376, 1672393, 1609417, 1609417,
  20, 21, 22, 23, 24, 25,
  10, 11, 12, 13, 14, 15,
  1, 2, 3, 4, 5, 6
)
percent <- c(
  NA, NA, NA, NA, NA, NA,
  0.480377008, 0.477332516, 0.473071003, 0.468995625, 0.469514737, 0.469514737,
  0.377455919, 0.385042582, 0.389915344, 0.394098755, 0.394681428, 0.394681428,
  0, 0.134622752, 0.134177064, 0.134316515, 0.133194194, 0.133194194
)
data <- data.frame(section, row, column, cell_format, stat, percent)

cell_formats <- list(
  a = list(
    list(variable = 'stat', format = 'number', align = 'center', label = 'Random Value')
  ),
  b = list(
    list(variable = 'stat', format = 'number', flex = '40%', label = 'Random Value'),
    list(variable = 'percent', format = 'percent_bar', flex ='60%', label = 'Random Percent')
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats,
  sparkline_variable = 'percent',
  sparkline_format = 'percent',
  secondary_label = 'Trend in %'
)

Sparkline in Data Column

row1 <- 'Cutaneous autoimmunity (alopecia areata, vitiligo, allergic urticaria (hives))'
row2 <- 'Venous thromboembolic disease'
row3 <- 'ASCVD'
row <- c(row1, row2, row3)
column_name <- 'Trend in %'
column <- c(column_name, column_name, column_name)
cell_format <- c('a', 'a', 'a')
data <- data.frame(row, column, cell_format)
data$trend <- list(
  c(0.245, 0.297, 0.327, 0.284, 0.289, 0.302),
  c(0.082, 0.064, 0.072, 0.094, 0.126, 0.181),
  c(0.042, 0.018, -0.031, -0.056, -0.083, -0.107)
)

cell_formats <- list(
  a = list(
    list(variable = 'trend', format = 'sparkline', enableaxis = T)
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats,
  primary_label = 'Comorbidities',
  data_column_width = 100
)
row <- c('Cutaneous autoimmunity (alopecia areata, vitiligo, allergic urticaria (hives))')
column_name <- 'Risk Trend'
column <- c(column_name)
cell_format <- c('a')
data <- data.frame(row, column, cell_format)
data$trend <- list(
  c(0.245, 0.297, 0.327, 0.284, 0.289, 0.302, 0.082, 0.064, 0.072, 0.094, 0.126, 0.181, 0.042, 0.018, -0.031, -0.056, -0.083, -0.107)
)

cell_formats <- list(
  a = list(
    list(variable = 'trend', format = 'sparkline')
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats,
  primary_label = 'Comorbidities',
  data_column_width = 100,
  disable_sort = TRUE
)

Confidence Plot in Data Column

row <- c('COPD', 'Diabetes', 'ESRD')
column_name <- 'Relative Risk'
column <- c(column_name, column_name, column_name)
cell_format <- c('a', 'a', 'a')
data <- data.frame(row, column, cell_format)
data$risk <- list(
  c(1.15, 0.79, 1.52),
  c(1.13, 1, 1.26),
  c(1.28, 1.09, 1.47)
)

cell_formats <- list(
  a = list(
    list(variable = 'risk', format = 'confidence',  referenceline = 1)
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats,
  primary_label = 'Comorbidities',
  data_column_width = 200
)

Confidence Plot Edge Cases

# Using a data.table so I can mix string and numeric
# Passing Inf & NA as strings because that's how they are included in the datasets created using nswpr package
library(data.table)
data <- data.table(row = list(), lower = list(), value = list(), upper = list(), column = list(), cell_format = list())
data <- rbind(data, list("Touching Ref Line",          0,    1,   1.5, "Test", "default"))
data <- rbind(data, list("Not Touching Ref Line",    0.5,    1,   1.5, "Test", "default"))
data <- rbind(data, list("Lower Outside Min",       -2.5,    1,   1.5, "Test", "default"))
data <- rbind(data, list("Upper Outside Min",       -1.5,    1,   2.5, "Test", "default"))
data <- rbind(data, list("Both Outside",            -2.5,    1,   2.5, "Test", "default"))
data <- rbind(data, list("Lower Infinity",        "-Inf",    1,   1.5, "Test", "default"))
data <- rbind(data, list("Upper Infinity",          -1.5,    1, "Inf", "Test", "default"))
data <- rbind(data, list("Really Large CI/Value",  -1e20, 1e20,  1e20, "Test", "default"))
data <- rbind(data, list("Lower NA",                "NA",   -1,   1.5, "Test", "default"))
data <- rbind(data, list("Upper NA",                -1.5,    1,  "NA", "Test", "default"))
data <- rbind(data, list("Value NA",                -1.5, "NA",   1.5, "Test", "default"))
data <- rbind(data, list("Value Outside Min",         -3, -2.5,   1.5, "Test", "default"))
data <- rbind(data, list("Value Outside Max",       -1.5,  2.5,     3, "Test", "default"))
data <- rbind(data, list("Another Value NA",        -1.5, "NA",   1.5, "Test", "default"))
data <- rbind(data, list("CI Outside Min",            -5,   -4,    -3, "Test", "default"))
data <- rbind(data, list("CI Outside Max",             3,    4,     5, "Test", "default"))

head(data, 20)
##                       row  lower value upper column cell_format
##  1:     Touching Ref Line      0     1   1.5   Test     default
##  2: Not Touching Ref Line    0.5     1   1.5   Test     default
##  3:     Lower Outside Min   -2.5     1   1.5   Test     default
##  4:     Upper Outside Min   -1.5     1   2.5   Test     default
##  5:          Both Outside   -2.5     1   2.5   Test     default
##  6:        Lower Infinity   -Inf     1   1.5   Test     default
##  7:        Upper Infinity   -1.5     1   Inf   Test     default
##  8: Really Large CI/Value -1e+20 1e+20 1e+20   Test     default
##  9:              Lower NA     NA    -1   1.5   Test     default
## 10:              Upper NA   -1.5     1    NA   Test     default
## 11:              Value NA   -1.5    NA   1.5   Test     default
## 12:     Value Outside Min     -3  -2.5   1.5   Test     default
## 13:     Value Outside Max   -1.5   2.5     3   Test     default
## 14:      Another Value NA   -1.5    NA   1.5   Test     default
## 15:        CI Outside Min     -5    -4    -3   Test     default
## 16:        CI Outside Max      3     4     5   Test     default
cell_formats <- list(
  default = list(
    list(variable = list('value', 'lower', 'upper'), format = 'confidence', referenceline = 0, min = -2, max = 2, type = "number_short")
  )
)

nswidgets::create_collapsible_table(
  data = data,
  cell_formats = cell_formats,
  data_column_width = 200
)