R/bp_visuals_tables.R
In johnschwenck/bp: Blood Pressure Analysis in R
Defines functions
dow_tod_plots_old
dow_tod_plots
Documented in
dow_tod_plots
#' Blood Pressure Tables in Graphical Format
#'
#' @param data A processed dataframe resulting from the \code{process_data} function that
#' contains the \code{SBP}, \code{DBP}, \code{DAY_OF_WEEK}, \code{Time_of_Day}, \code{SBP_Category},
#' and \code{DBP_Category} columns.
#'
#' @param subj Optional argument. Allows the user to specify and subset specific subjects
#' from the \code{ID} column of the supplied data set. The \code{subj} argument can be a single
#' value or a vector of elements. The input type should be character, but the function will
#' comply with integers so long as they are all present in the \code{ID} column of the data.
#'
#' @return A list of four `gtables` that correspond to the tables for Day of Week and
#' Time of Day broken down by both \code{SBP} and \code{DBP}.
#'
#' @export
#'
#' @examples
#'
#' data("bp_hypnos")
#' hyp_proc <- process_data(bp_hypnos,
#' bp_type = 'ABPM',
#' sbp = "syst",
#' dbp = "DIAST",
#' date_time = "date.time",
#' id = "id",
#' wake = "wake",
#' visit = "visit",
#' hr = "hr",
#' map = "map",
#' rpp = "rpp",
#' pp = "pp",
#' ToD_int = c(5, 13, 18, 23))
#'
#' rm(bp_hypnos)
#'
#' dow_tod_plots_out <- dow_tod_plots(hyp_proc)
#' grid::grid.draw(
#' gridExtra::grid.arrange(dow_tod_plots_out[[1]], dow_tod_plots_out[[2]], ncol = 2)
#' )
#'
dow_tod_plots <- function(data, subj = NULL){
# Primary variables needed: SBP, DBP, DAY_OF_WEEK, Time_of_Day
# Secondary variables needed: SBP_Category (bp_tables), DBP_Category (bp_tables)
SBP = DBP = DAY_OF_WEEK = ID = Time_of_Day = Sun = Mon = Tue = Wed = Thu = Fri = Sat = Total = Morning = Afternoon = Evening = Night = . = NULL
rm(list = c("SBP", "DBP", "DAY_OF_WEEK", "ID", "Time_of_Day",
"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Total",
"Morning", "Afternoon", "Evening", "Night", "."))
# If user supplies a vector corresponding to a subset of multiple subjects (multi-subject only)
if(!is.null(subj)){
# check to ensure that supplied subject vector is compatible
subject_subset_check(data, subj)
if(length(unique(data$ID)) > 1){
# Filter data based on subset of subjects
data <- data %>%
dplyr::filter(ID %in% subj)
}
}
# This part is inefficient as don't need all tables and may not need to call at all if date is missing, but it works. Possibly come to this later
table_data <- bp_tables(data)
ft_size = 6
## Day of Week ##
if( ("DAY_OF_WEEK" %in% names(data)) == TRUE ){
tables_dow <- table_data$CLASS_Day_of_Week
tables_dow <- tibble::rownames_to_column(table_data$CLASS_Day_of_Week, var = "BP Stage")
tables_dow <- tables_dow %>%
dplyr::bind_rows(dplyr::summarise(.,
dplyr::across(tidyselect::vars_select_helpers$where(is.numeric), sum),
dplyr::across(tidyselect::vars_select_helpers$where(is.character), ~"Total")))
dow <- gridExtra::tableGrob(tables_dow, rows = NULL, theme = gridExtra::ttheme_default(base_size = ft_size))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(dow)-1, l = 1, r = ncol(dow))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 1, l = 1, r = ncol(dow))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = nrow(dow), b = nrow(dow), l = 1, r = ncol(dow))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(dow), l = ncol(dow), r = ncol(dow))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(dow), l = 2, r = ncol(dow)-1)
# Add title for plot
title_dow <- grid::textGrob("BP by Day of Week", gp = grid::gpar(fontsize = 15))
padding <- grid::unit(7, "mm")
table_dow <- gtable::gtable_add_rows(
dow,
heights = grid::grobHeight(title_dow) + padding,
pos = 0)
dow <- gtable::gtable_add_grob(
table_dow,
title_dow,
1, 1, 1, ncol(table_dow))
# display plot
dow_out <- gridExtra::arrangeGrob(dow)
}else{
# Empty grob
dow_out <- grid::grid.rect(gp = grid::gpar(col = NA))
}
## Time of Day ##
if( ("TIME_OF_DAY" %in% names(data)) == TRUE ){
tables_tod <- table_data$CLASS_Time_of_Day
tables_tod <- tibble::rownames_to_column(tables_tod, var = "BP Stage")
tables_tod <- tables_tod %>%
dplyr::bind_rows(dplyr::summarise(.,
dplyr::across(tidyselect::vars_select_helpers$where(is.numeric), sum),
dplyr::across(tidyselect::vars_select_helpers$where(is.character), ~"Total")))
tod <- gridExtra::tableGrob(tables_tod, rows = NULL, theme = gridExtra::ttheme_default(base_size = ft_size))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(tod)-1, l = 1, r = ncol(tod))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 1, l = 1, r = ncol(tod))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = nrow(tod), b = nrow(tod), l = 1, r = ncol(tod))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(tod), l = ncol(tod), r = ncol(tod))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(tod), l = 2, r = ncol(tod)-1)
# Add title for plot
title_tod <- grid::textGrob("BP by Time of Day", gp = grid::gpar(fontsize = 15))
padding <- grid::unit(7, "mm")
table_tod <- gtable::gtable_add_rows(
tod,
heights = grid::grobHeight(title_tod) + padding,
pos = 0)
tod <- gtable::gtable_add_grob(
table_tod,
title_tod,
1, 1, 1, ncol(table_tod))
# display plot
tod_out <- gridExtra::arrangeGrob(tod)
}else{
# Empty grob
tod_out <- grid::grid.rect(gp = grid::gpar(col = NA))
}
return(list(dow = dow_out, tod = tod_out))
}
dow_tod_plots_old <- function(data, subj = NULL){
# Primary variables needed: SBP, DBP, DAY_OF_WEEK, Time_of_Day
# Secondary variables needed: SBP_Category (bp_tables), DBP_Category (bp_tables)
SBP = DBP = DAY_OF_WEEK = ID = Time_of_Day = Sun = Mon = Tue = Wed = Thu = Fri = Sat = Total = Morning = Afternoon = Evening = Night = . = NULL
rm(list = c("SBP", "DBP", "DAY_OF_WEEK", "ID", "Time_of_Day",
"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Total",
"Morning", "Afternoon", "Evening", "Night", "."))
# If user supplies a vector corresponding to a subset of multiple subjects (multi-subject only)
if(!is.null(subj)){
# check to ensure that supplied subject vector is compatible
subject_subset_check(data, subj)
if(length(unique(data$ID)) > 1){
# Filter data based on subset of subjects
data <- data %>%
dplyr::filter(ID == subj)
}
}
table_build <- function(data){
# Load all tables one time into sbp_dow_data object
sbp_dow_data <- bp_tables(data)
table_id <- c('SBP_by_Day_of_Week', 'DBP_by_Day_of_Week', 'SBP_by_Time_of_Day', 'DBP_by_Time_of_Day')
title_names <- c("SBP by Day of the Week", "DBP by Day of the Week", "SBP by Time of the Day", "DBP by Time of the Day")
out_tables <- list()
for(i in table_id){
# Clear plot area for initial / next iteration
grid::grid.newpage()
# Convert row names of table to column --> tibble package
loop_data <- tibble::rownames_to_column(sbp_dow_data[i][[1]], var = "BP Stage")
# Add column totals --> dplyr for bind_rows
# See https://github.com/r-lib/tidyselect/issues/201 for issue with "where" in dplyr's across function
# https://dplyr.tidyverse.org/reference/across.html - dplyr documentation of how where is used within across
# https://stackoverflow.com/questions/40251801/how-to-use-utilsglobalvariables - alternative temporary fix using
# global variables
loop_data <- loop_data %>%
dplyr::bind_rows(dplyr::summarise(.,
dplyr::across(tidyselect::vars_select_helpers$where(is.numeric), sum),
dplyr::across(tidyselect::vars_select_helpers$where(is.character), ~"Total")))
# Format BP Stage column
stage_col <- gridExtra::tableGrob(loop_data["BP Stage"],
theme = gridExtra::ttheme_default(
colhead = list(bg_params=list(fill="white", col="grey90")),
base_size = 7, padding = grid::unit(c(4,3),"mm")),
rows = NULL)
loop_table <- gridExtra::gtable_cbind(stage_col)
# Loop over each of the columns other than total and row name to format properly
for(dfcol in names(loop_data)[2: (length(names(loop_data)) - 1) ]){
# Color palette for either day of the week or time of day
color_pal = ifelse( table_id %in% c('SBP_by_Day_of_Week' , 'SBP_by_Day_of_Week') ,
grDevices::colorRampPalette(c("#FFE0B2", "#FFA000", "#E65100"))(nrow(loop_data))[rank(loop_data[[dfcol]][1:6])],
grDevices::colorRampPalette(c("#DDDDFF", "#AABBFF", "#3366EE"))(nrow(loop_data))[rank(loop_data[[dfcol]][1:6])])
# Isolate the column data for each of the dfcol days / times of day
col_data <- as.data.frame(loop_data[dfcol][1:6,])
# Change colname to dfcol name (i.e. Sun, Mon, etc)
colnames(col_data) <- dfcol
col_grob <- gridExtra::tableGrob(col_data,
theme = gridExtra::ttheme_default(
core=list(bg_params = list(fill = color_pal )),
colhead = list(bg_params=list(fill="white", col="grey90")),
base_size = 7, padding = grid::unit(c(4,3),"mm")),
rows = NULL)
col_total <- as.data.frame(loop_data[dfcol][7,])
colnames(col_total) <- dfcol
col_total_grob <- gridExtra::tableGrob(col_total, rows = NULL, cols = NULL,
theme = gridExtra::ttheme_default(base_size = 7, padding = grid::unit(c(4,3),"mm")))
col_grob <- gridExtra::gtable_rbind(col_grob, col_total_grob)
loop_table <- gridExtra::gtable_cbind(loop_table, col_grob)
}
# Total column formatting
grobtotals <- gridExtra::tableGrob(loop_data["Total"],
theme = gridExtra::ttheme_default(
colhead = list(bg_params=list(fill="white", col="grey90")),
base_size = 7, padding = grid::unit(c(4,3),"mm")),
rows = NULL)
# Attach Totals column to rest of table
loop_table <- gridExtra::gtable_cbind(loop_table, grobtotals)
# Draw border around main part of table
loop_table <- gtable::gtable_add_grob(loop_table,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2,
b = nrow(loop_table)-1,
l = 2,
r = ncol(loop_table)-1
)
# Draw grid around the whole table
loop_table <- gtable::gtable_add_grob(loop_table,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 1)),
t = 1,
b = nrow(loop_table),
l = 1,
r = ncol(loop_table)
)
# Add title and padding
grobtitle <- grid::textGrob(title_names[match(i, table_id)], gp = grid::gpar(fontsize = 15))
padding <- ggplot2::unit(7, "mm")
loop_table <- gtable::gtable_add_rows(
loop_table,
heights = grid::grobHeight(grobtitle) + padding,
pos = 0)
loop_table <- gtable::gtable_add_grob(
loop_table,
grobtitle,
1, 1, 1, ncol(loop_table))
# Add current iteration of table to list
out_tables[[i]] <- loop_table
}
return(out_tables)
}
## Return all table visuals in a list
out <- table_build(data)
return(out)
}
johnschwenck/bp documentation built on Aug. 18, 2022, 11:30 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions dow_tod_plots_old dow_tod_plots
Documented in dow_tod_plots
#' Blood Pressure Tables in Graphical Format
#'
#' @param data A processed dataframe resulting from the \code{process_data} function that
#' contains the \code{SBP}, \code{DBP}, \code{DAY_OF_WEEK}, \code{Time_of_Day}, \code{SBP_Category},
#' and \code{DBP_Category} columns.
#'
#' @param subj Optional argument. Allows the user to specify and subset specific subjects
#' from the \code{ID} column of the supplied data set. The \code{subj} argument can be a single
#' value or a vector of elements. The input type should be character, but the function will
#' comply with integers so long as they are all present in the \code{ID} column of the data.
#'
#' @return A list of four `gtables` that correspond to the tables for Day of Week and
#' Time of Day broken down by both \code{SBP} and \code{DBP}.
#'
#' @export
#'
#' @examples
#'
#' data("bp_hypnos")
#' hyp_proc <- process_data(bp_hypnos,
#' bp_type = 'ABPM',
#' sbp = "syst",
#' dbp = "DIAST",
#' date_time = "date.time",
#' id = "id",
#' wake = "wake",
#' visit = "visit",
#' hr = "hr",
#' map = "map",
#' rpp = "rpp",
#' pp = "pp",
#' ToD_int = c(5, 13, 18, 23))
#'
#' rm(bp_hypnos)
#'
#' dow_tod_plots_out <- dow_tod_plots(hyp_proc)
#' grid::grid.draw(
#' gridExtra::grid.arrange(dow_tod_plots_out[[1]], dow_tod_plots_out[[2]], ncol = 2)
#' )
#'
dow_tod_plots <- function(data, subj = NULL){
# Primary variables needed: SBP, DBP, DAY_OF_WEEK, Time_of_Day
# Secondary variables needed: SBP_Category (bp_tables), DBP_Category (bp_tables)
SBP = DBP = DAY_OF_WEEK = ID = Time_of_Day = Sun = Mon = Tue = Wed = Thu = Fri = Sat = Total = Morning = Afternoon = Evening = Night = . = NULL
rm(list = c("SBP", "DBP", "DAY_OF_WEEK", "ID", "Time_of_Day",
"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Total",
"Morning", "Afternoon", "Evening", "Night", "."))
# If user supplies a vector corresponding to a subset of multiple subjects (multi-subject only)
if(!is.null(subj)){
# check to ensure that supplied subject vector is compatible
subject_subset_check(data, subj)
if(length(unique(data$ID)) > 1){
# Filter data based on subset of subjects
data <- data %>%
dplyr::filter(ID %in% subj)
}
}
# This part is inefficient as don't need all tables and may not need to call at all if date is missing, but it works. Possibly come to this later
table_data <- bp_tables(data)
ft_size = 6
## Day of Week ##
if( ("DAY_OF_WEEK" %in% names(data)) == TRUE ){
tables_dow <- table_data$CLASS_Day_of_Week
tables_dow <- tibble::rownames_to_column(table_data$CLASS_Day_of_Week, var = "BP Stage")
tables_dow <- tables_dow %>%
dplyr::bind_rows(dplyr::summarise(.,
dplyr::across(tidyselect::vars_select_helpers$where(is.numeric), sum),
dplyr::across(tidyselect::vars_select_helpers$where(is.character), ~"Total")))
dow <- gridExtra::tableGrob(tables_dow, rows = NULL, theme = gridExtra::ttheme_default(base_size = ft_size))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(dow)-1, l = 1, r = ncol(dow))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 1, l = 1, r = ncol(dow))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = nrow(dow), b = nrow(dow), l = 1, r = ncol(dow))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(dow), l = ncol(dow), r = ncol(dow))
dow <- gtable::gtable_add_grob(dow,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(dow), l = 2, r = ncol(dow)-1)
# Add title for plot
title_dow <- grid::textGrob("BP by Day of Week", gp = grid::gpar(fontsize = 15))
padding <- grid::unit(7, "mm")
table_dow <- gtable::gtable_add_rows(
dow,
heights = grid::grobHeight(title_dow) + padding,
pos = 0)
dow <- gtable::gtable_add_grob(
table_dow,
title_dow,
1, 1, 1, ncol(table_dow))
# display plot
dow_out <- gridExtra::arrangeGrob(dow)
}else{
# Empty grob
dow_out <- grid::grid.rect(gp = grid::gpar(col = NA))
}
## Time of Day ##
if( ("TIME_OF_DAY" %in% names(data)) == TRUE ){
tables_tod <- table_data$CLASS_Time_of_Day
tables_tod <- tibble::rownames_to_column(tables_tod, var = "BP Stage")
tables_tod <- tables_tod %>%
dplyr::bind_rows(dplyr::summarise(.,
dplyr::across(tidyselect::vars_select_helpers$where(is.numeric), sum),
dplyr::across(tidyselect::vars_select_helpers$where(is.character), ~"Total")))
tod <- gridExtra::tableGrob(tables_tod, rows = NULL, theme = gridExtra::ttheme_default(base_size = ft_size))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(tod)-1, l = 1, r = ncol(tod))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 1, l = 1, r = ncol(tod))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = nrow(tod), b = nrow(tod), l = 1, r = ncol(tod))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(tod), l = ncol(tod), r = ncol(tod))
tod <- gtable::gtable_add_grob(tod,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(tod), l = 2, r = ncol(tod)-1)
# Add title for plot
title_tod <- grid::textGrob("BP by Time of Day", gp = grid::gpar(fontsize = 15))
padding <- grid::unit(7, "mm")
table_tod <- gtable::gtable_add_rows(
tod,
heights = grid::grobHeight(title_tod) + padding,
pos = 0)
tod <- gtable::gtable_add_grob(
table_tod,
title_tod,
1, 1, 1, ncol(table_tod))
# display plot
tod_out <- gridExtra::arrangeGrob(tod)
}else{
# Empty grob
tod_out <- grid::grid.rect(gp = grid::gpar(col = NA))
}
return(list(dow = dow_out, tod = tod_out))
}
dow_tod_plots_old <- function(data, subj = NULL){
# Primary variables needed: SBP, DBP, DAY_OF_WEEK, Time_of_Day
# Secondary variables needed: SBP_Category (bp_tables), DBP_Category (bp_tables)
SBP = DBP = DAY_OF_WEEK = ID = Time_of_Day = Sun = Mon = Tue = Wed = Thu = Fri = Sat = Total = Morning = Afternoon = Evening = Night = . = NULL
rm(list = c("SBP", "DBP", "DAY_OF_WEEK", "ID", "Time_of_Day",
"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Total",
"Morning", "Afternoon", "Evening", "Night", "."))
# If user supplies a vector corresponding to a subset of multiple subjects (multi-subject only)
if(!is.null(subj)){
# check to ensure that supplied subject vector is compatible
subject_subset_check(data, subj)
if(length(unique(data$ID)) > 1){
# Filter data based on subset of subjects
data <- data %>%
dplyr::filter(ID == subj)
}
}
table_build <- function(data){
# Load all tables one time into sbp_dow_data object
sbp_dow_data <- bp_tables(data)
table_id <- c('SBP_by_Day_of_Week', 'DBP_by_Day_of_Week', 'SBP_by_Time_of_Day', 'DBP_by_Time_of_Day')
title_names <- c("SBP by Day of the Week", "DBP by Day of the Week", "SBP by Time of the Day", "DBP by Time of the Day")
out_tables <- list()
for(i in table_id){
# Clear plot area for initial / next iteration
grid::grid.newpage()
# Convert row names of table to column --> tibble package
loop_data <- tibble::rownames_to_column(sbp_dow_data[i][[1]], var = "BP Stage")
# Add column totals --> dplyr for bind_rows
# See https://github.com/r-lib/tidyselect/issues/201 for issue with "where" in dplyr's across function
# https://dplyr.tidyverse.org/reference/across.html - dplyr documentation of how where is used within across
# https://stackoverflow.com/questions/40251801/how-to-use-utilsglobalvariables - alternative temporary fix using
# global variables
loop_data <- loop_data %>%
dplyr::bind_rows(dplyr::summarise(.,
dplyr::across(tidyselect::vars_select_helpers$where(is.numeric), sum),
dplyr::across(tidyselect::vars_select_helpers$where(is.character), ~"Total")))
# Format BP Stage column
stage_col <- gridExtra::tableGrob(loop_data["BP Stage"],
theme = gridExtra::ttheme_default(
colhead = list(bg_params=list(fill="white", col="grey90")),
base_size = 7, padding = grid::unit(c(4,3),"mm")),
rows = NULL)
loop_table <- gridExtra::gtable_cbind(stage_col)
# Loop over each of the columns other than total and row name to format properly
for(dfcol in names(loop_data)[2: (length(names(loop_data)) - 1) ]){
# Color palette for either day of the week or time of day
color_pal = ifelse( table_id %in% c('SBP_by_Day_of_Week' , 'SBP_by_Day_of_Week') ,
grDevices::colorRampPalette(c("#FFE0B2", "#FFA000", "#E65100"))(nrow(loop_data))[rank(loop_data[[dfcol]][1:6])],
grDevices::colorRampPalette(c("#DDDDFF", "#AABBFF", "#3366EE"))(nrow(loop_data))[rank(loop_data[[dfcol]][1:6])])
# Isolate the column data for each of the dfcol days / times of day
col_data <- as.data.frame(loop_data[dfcol][1:6,])
# Change colname to dfcol name (i.e. Sun, Mon, etc)
colnames(col_data) <- dfcol
col_grob <- gridExtra::tableGrob(col_data,
theme = gridExtra::ttheme_default(
core=list(bg_params = list(fill = color_pal )),
colhead = list(bg_params=list(fill="white", col="grey90")),
base_size = 7, padding = grid::unit(c(4,3),"mm")),
rows = NULL)
col_total <- as.data.frame(loop_data[dfcol][7,])
colnames(col_total) <- dfcol
col_total_grob <- gridExtra::tableGrob(col_total, rows = NULL, cols = NULL,
theme = gridExtra::ttheme_default(base_size = 7, padding = grid::unit(c(4,3),"mm")))
col_grob <- gridExtra::gtable_rbind(col_grob, col_total_grob)
loop_table <- gridExtra::gtable_cbind(loop_table, col_grob)
}
# Total column formatting
grobtotals <- gridExtra::tableGrob(loop_data["Total"],
theme = gridExtra::ttheme_default(
colhead = list(bg_params=list(fill="white", col="grey90")),
base_size = 7, padding = grid::unit(c(4,3),"mm")),
rows = NULL)
# Attach Totals column to rest of table
loop_table <- gridExtra::gtable_cbind(loop_table, grobtotals)
# Draw border around main part of table
loop_table <- gtable::gtable_add_grob(loop_table,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 2)),
t = 2,
b = nrow(loop_table)-1,
l = 2,
r = ncol(loop_table)-1
)
# Draw grid around the whole table
loop_table <- gtable::gtable_add_grob(loop_table,
grobs = grid::rectGrob(gp = grid::gpar(fill = NA, lwd = 1)),
t = 1,
b = nrow(loop_table),
l = 1,
r = ncol(loop_table)
)
# Add title and padding
grobtitle <- grid::textGrob(title_names[match(i, table_id)], gp = grid::gpar(fontsize = 15))
padding <- ggplot2::unit(7, "mm")
loop_table <- gtable::gtable_add_rows(
loop_table,
heights = grid::grobHeight(grobtitle) + padding,
pos = 0)
loop_table <- gtable::gtable_add_grob(
loop_table,
grobtitle,
1, 1, 1, ncol(loop_table))
# Add current iteration of table to list
out_tables[[i]] <- loop_table
}
return(out_tables)
}
## Return all table visuals in a list
out <- table_build(data)
return(out)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.