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
)
