Here is a workflow to create a Shift Table in R, using the {tidyverse}
suite for data processing, and {gt}
to build the desired table layout.
Required Packages
Code
suppressPackageStartupMessages (library (dplyr))
suppressPackageStartupMessages (library (tidyr))
suppressPackageStartupMessages (library (rlang))
suppressPackageStartupMessages (library (purrr))
suppressPackageStartupMessages (library (stringr))
suppressPackageStartupMessages (library (gt))
suppressPackageStartupMessages (library (here))
# list all files
files <- list.files (here ("R" ), pattern = ".R" , full.names = TRUE )
# Read all files
walk (files, source)
Data used for Analysis
We will make use of the adsl
and adlb
test ADaM datasets from the {pharmaverseadam} R package for analysis.
ADSL is the subject level analysis dataset
Code
adsl <- pharmaverseadam:: adsl
ADLB is the analysis dataset for Laboratory Records
Code
adlb <- pharmaverseadam:: adlb
Variables used for Analysis
USUBJID - Unique Subject Identifier
SAFFL - Safety Population Flag
TRT01A - Actual Treatment Arm for Period 01
PARAM - Parameter
PARAMCD - Parameter Code
AVISIT - Analysis Visit
AVISITN - Analysis Visit (Numeric)
AVAL - Analysis Value
ANL01FL - Analysis Flag 01
BNRIND - Baseline Reference Range Indicator
ANRIND - Analysis Reference Range Indicator
Programming Flow
1. Calculating BIG N
Keep only safety subjects (SAFFL
== 'Y'
) in adsl
Count number of subjects in the full safety analysis set within each treatment arm (TRT01A
)
Code
adsl_bign <- adsl |>
na_to_missing () |>
filter (.data$ SAFFL == "Y" ) |>
select (all_of (c ("USUBJID" , "TRT01A" ))) |>
add_count (.data$ TRT01A, name = "TRT_N" )
2. Preprocessing Lab Records
Merge adsl_bign
to adlb
to add TRT_N
Filter out missing values in Baseline Reference Range Indicator (BNRIND
), Analysis Reference Range Indicator (ANRIND
) and Analysis Value (AVAL
)
Subset the resulting data for subjects with post-does records where analysis flag (ANL01FL
) is equal to 'Y'
Subset data to keep records within the time period (eg. Week 2, Week 4, Week 6
) we want to see the shifts in Laboratory Tests
Add BIG N
to treatment labels by concatenating TRT_N
with TRT01A
Code
adlb_prep <- adlb |>
na_to_missing () |>
mutate (across (all_of (c ("BNRIND" , "ANRIND" )), str_to_title)) |>
left_join (adsl_bign, by = c ("USUBJID" , "TRT01A" )) |>
filter (
.data$ BNRIND != "<Missing>" ,
.data$ ANRIND != "<Missing>" ,
! is.na (.data$ AVAL),
.data$ ANL01FL == "Y" ,
.data$ AVISIT %in% c ("Week 2" , "Week 4" , "Week 6" )
) |>
mutate (TRT_VAR = paste0 (.data$ TRT01A, "<br>(N=" , .data$ TRT_N, ")" )) |>
select (- TRT_N)
Subset adlb_prep
to keep only Hemoglobin records
Code
adlb_hgb <- adlb_prep |>
filter (.data$ PARAMCD == "HGB" )
3. Get all combinations of Range Indicator values
Create a dummy dataset that contains all possible combination of BNRIND
and ANRIND
values by Treatment and Visit.
Code
comb_base_pbase <- expand_grid (
TRT_VAR = unique (adlb_hgb[["TRT_VAR" ]]),
AVISIT = unique (adlb_hgb[["AVISIT" ]]),
BNRIND = c ("Low" , "Normal" , "High" , "Total" )
) |>
cross_join (tibble (ANRIND = c ("Low" , "Normal" , "High" )))
5. Reshaping Data
Reshaping data to wide format to get the final Shift Table layout
Adding Post-Baseline Grade Totals
Code
shift_wide <- shift_counts |>
pivot_wider (
id_cols = all_of (c ("AVISIT" , "ANRIND" )),
names_from = all_of (c ("TRT_VAR" , "BNRIND" )),
values_from = "CNT" ,
names_sep = "^"
)
post_base_grade_totals <- shift_wide |>
summarize (across (where (is.numeric), sum), .by = all_of ("AVISIT" )) |>
mutate (ANRIND = "Total" )
visit_levels <-
arrange (filter (shift_counts, ! is.na (.data$ AVISITN)), by = .data$ AVISITN) |>
pull (.data$ AVISIT) |>
unique ()
shift_final <- shift_wide |>
bind_rows (post_base_grade_totals) |>
arrange (
factor (.data$ AVISIT, levels = visit_levels),
factor (.data$ ANRIND, levels = c ("Low" , "Normal" , "High" , "Total" ))
)
An alternate and tidier approach would be to create a function say count_shifts_by_visit()
to cover Steps 3-5
Code
shift_final <-
count_shifts_by_visit (
bds_dataset = adlb_hgb,
trt_var = exprs (TRT_VAR),
analysis_grade_var = exprs (ANRIND),
base_grade_var = exprs (BNRIND),
grade_var_order = exprs (Low, Normal, High),
visit_var = exprs (AVISIT, AVISITN)
)
6. Adding Percentages
Code
trt_bign <-
map (
set_names (unique (adsl_bign[["TRT01A" ]])),
\(trt_val) get_trt_total (adsl_bign, exprs (TRT01A, TRT_N), trt_val)
)
shift_final <- shift_final |>
add_pct2cols (
exclude_cols = exprs (AVISIT, ANRIND),
trt_bign = trt_bign
)
7. Displaying the Final Table with {gt}
Code
out <-
shift_final |>
gt (groupname_col = "AVISIT" , row_group_as_column = TRUE ) |>
cols_label_with (
columns = contains ("ANRIND" ), \(x) md ("Reference<br>Range" )
) |>
tab_spanner_delim (delim = "^" ) |>
text_transform (
fn = \(x) map (x, \(y) md (paste0 (y, "<br>Baseline<br>n (%)" ))),
locations = cells_column_spanners ()
) |>
# headers and footers
tab_stubhead (md ("Analysis Visit" )) |>
tab_footnote (footnote = md ("N: Number of subjects in the full safety analysis set, within each treatment group<br>n: Subjects with at least one baseline and post-baseline records" )) |>
tab_header (
preheader = c ("Protocol: CDISCPILOT01" , "Cutoff date: DDMMYYYY" ), # for rtf
title = md (
"Table x.x<br>Shift Table of Lab Hematology<br>(Full Safety Analysis Set)"
),
subtitle = paste0 ("Parameter = " , unique (pull (adlb_hgb, "PARAM" )))
) |>
tab_source_note (
"Source: ADLB DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY"
) |>
# cell styling
tab_style (
style = cell_text (weight = "bold" ),
locations = cells_body (columns = 2 )
) |>
tab_style (
style = cell_text (align = "center" ),
locations = cells_body (columns = - c (1 , 2 ))
) |>
tab_style (
style = cell_text (align = "center" ),
locations = cells_column_labels (columns = - c (1 , 2 ))
) |>
# other options
tab_options (
# rtf options
page.orientation = "landscape" ,
page.numbering = TRUE ,
page.header.use_tbl_headings = TRUE ,
page.footer.use_tbl_notes = TRUE ,
# page.height = "18in", uncomment to modify page dimensions while saving as rtf
# other styling
table.background.color = "white" ,
table.font.names = "monospace-slab-serif" ,
row_group.font.weight = "bold" ,
column_labels.font.weight = "bold" ,
heading.title.font.weight = "bold" ,
heading.title.font.size = "20px" ,
heading.padding = "10px" ,
heading.subtitle.font.size = "14px"
) |>
opt_css (
css = "
.gt_heading {
border-top-style: hidden !important;
}
.gt_sourcenote {
border-bottom-style: hidden !important;
}
.gt_table {
width: max-content !important;
}
.gt_subtitle, .gt_footnotes, .gt_sourcenote {
text-align: left !important;
font-weight: bold !important;
color: gray !important;
}
"
)
Table x.x Shift Table of Lab Hematology (Full Safety Analysis Set)
Parameter = Hemoglobin (mmol/L)
Analysis Visit
Reference Range
Placebo (N=86) Baseline n (%)
Xanomeline High Dose (N=72) Baseline n (%)
Xanomeline Low Dose (N=96) Baseline n (%)
Low
Normal
High
Total
Low
Normal
High
Total
Low
Normal
High
Total
Week 2
Low
4 (4.7%)
2 (2.3%)
0
6 (7%)
1 (1.4%)
3 (4.2%)
0
4 (5.6%)
4 (4.2%)
0
0
4 (4.2%)
Normal
3 (3.5%)
73 (84.9%)
0
76 (88.4%)
0
65 (90.3%)
2 (2.8%)
67 (93.1%)
1 (1%)
67 (69.8%)
1 (1%)
69 (71.9%)
High
0
0
0
0
0
0
0
0
0
0
0
0
Total
7 (8.1%)
75 (87.2%)
0
82 (95.3%)
1 (1.4%)
68 (94.4%)
2 (2.8%)
71 (98.6%)
5 (5.2%)
67 (69.8%)
1 (1%)
73 (76%)
Week 4
Low
4 (4.7%)
2 (2.3%)
0
6 (7%)
1 (1.4%)
0
0
1 (1.4%)
4 (4.2%)
2 (2.1%)
0
6 (6.2%)
Normal
1 (1.2%)
68 (79.1%)
0
69 (80.2%)
0
63 (87.5%)
1 (1.4%)
64 (88.9%)
1 (1%)
57 (59.4%)
0
58 (60.4%)
High
0
0
0
0
0
1 (1.4%)
0
1 (1.4%)
0
0
0
0
Total
5 (5.8%)
70 (81.4%)
0
75 (87.2%)
1 (1.4%)
64 (88.9%)
1 (1.4%)
66 (91.7%)
5 (5.2%)
59 (61.5%)
0
64 (66.7%)
Week 6
Low
3 (3.5%)
1 (1.2%)
0
4 (4.7%)
0
1 (1.4%)
0
1 (1.4%)
4 (4.2%)
3 (3.1%)
0
7 (7.3%)
Normal
2 (2.3%)
64 (74.4%)
0
66 (76.7%)
0
51 (70.8%)
1 (1.4%)
52 (72.2%)
1 (1%)
50 (52.1%)
0
51 (53.1%)
High
0
1 (1.2%)
0
1 (1.2%)
0
1 (1.4%)
0
1 (1.4%)
0
0
0
0
Total
5 (5.8%)
66 (76.7%)
0
71 (82.6%)
0
53 (73.6%)
1 (1.4%)
54 (75%)
5 (5.2%)
53 (55.2%)
0
58 (60.4%)
Source: ADLB DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
Split adlb_prep
by multiple parameters.
Map over count_shifts_by_visit()
on the data split by parameters
Add percentages to numeric columns within each resulting data.frame
from count_shifts_by_visit()
Create a function std_shift_display()
to combine the {gt}
table display steps and map it over on the list
output retrieved from the previous step
Code
adlb_multi <- adlb_prep |>
filter (toupper (.data$ PARAMCD) %in% c ("PLAT" , "HCT" , "MCH" )) |>
group_nest (.data$ PARAM)
shift_out <- map (adlb_multi$ data, \(x) {
count_shifts_by_visit (
bds_dataset = x,
trt_var = exprs (TRT_VAR),
analysis_grade_var = exprs (ANRIND),
base_grade_var = exprs (BNRIND),
grade_var_order = exprs (Low, Normal, High),
visit_var = exprs (AVISIT, AVISITN)
)
}) |>
set_names (adlb_multi$ PARAM)
# add percentages
shift_out <- map (shift_out, \(df) {
df |>
add_pct2cols (
exclude_cols = exprs (AVISIT, ANRIND),
trt_bign = trt_bign
)
})
list_out <-
map (names (shift_out), \(x) {
shift_out[[x]] |>
std_shift_display (
param = x,
group_col = "AVISIT" ,
stub_header = "Analysis Visit" ,
rtf_preheader = "Protocol: CDISCPILOT01" ,
title = "Table x.x<br>Shift Table of Lab
Hematology<br>(Full Safety Analysis Set)" ,
footnote = "N: Number of subjects in the full safety analysis set, within each treatment group<br>n: Subjects with at least one baseline and post-baseline records" ,
sourcenote =
"Source: ADLB DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY"
)
})
gt_group (.list = list_out)
Table x.x Shift Table of Lab
Hematology (Full Safety Analysis Set)
Parameter = Ery. Mean Corpuscular Hemoglobin (fmol(Fe))
Analysis Visit
Reference Range
Placebo (N=86) Baseline n (%)
Xanomeline High Dose (N=72) Baseline n (%)
Xanomeline Low Dose (N=96) Baseline n (%)
Low
Normal
High
Total
Low
Normal
High
Total
Low
Normal
High
Total
Week 2
Low
0
0
0
0
1 (1.4%)
0
0
1 (1.4%)
0
0
0
0
Normal
0
78 (90.7%)
2 (2.3%)
80 (93%)
0
63 (87.5%)
2 (2.8%)
65 (90.3%)
0
68 (70.8%)
2 (2.1%)
70 (72.9%)
High
0
0
2 (2.3%)
2 (2.3%)
0
0
5 (6.9%)
5 (6.9%)
0
2 (2.1%)
1 (1%)
3 (3.1%)
Total
0
78 (90.7%)
4 (4.7%)
82 (95.3%)
1 (1.4%)
63 (87.5%)
7 (9.7%)
71 (98.6%)
0
70 (72.9%)
3 (3.1%)
73 (76%)
Week 4
Low
0
0
0
0
1 (1.4%)
0
0
1 (1.4%)
0
0
0
0
Normal
0
70 (81.4%)
1 (1.2%)
71 (82.6%)
0
58 (80.6%)
1 (1.4%)
59 (81.9%)
0
60 (62.5%)
2 (2.1%)
62 (64.6%)
High
0
2 (2.3%)
2 (2.3%)
4 (4.7%)
0
0
6 (8.3%)
6 (8.3%)
0
1 (1%)
1 (1%)
2 (2.1%)
Total
0
72 (83.7%)
3 (3.5%)
75 (87.2%)
1 (1.4%)
58 (80.6%)
7 (9.7%)
66 (91.7%)
0
61 (63.5%)
3 (3.1%)
64 (66.7%)
Week 6
Low
0
0
0
0
0
0
0
0
0
0
0
0
Normal
0
65 (75.6%)
2 (2.3%)
67 (77.9%)
0
47 (65.3%)
1 (1.4%)
48 (66.7%)
0
55 (57.3%)
2 (2.1%)
57 (59.4%)
High
0
2 (2.3%)
2 (2.3%)
4 (4.7%)
0
0
6 (8.3%)
6 (8.3%)
0
0
1 (1%)
1 (1%)
Total
0
67 (77.9%)
4 (4.7%)
71 (82.6%)
0
47 (65.3%)
7 (9.7%)
54 (75%)
0
55 (57.3%)
3 (3.1%)
58 (60.4%)
Source: ADLB DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
Table x.x Shift Table of Lab
Hematology (Full Safety Analysis Set)
Parameter = Hematocrit (1)
Analysis Visit
Reference Range
Placebo (N=86) Baseline n (%)
Xanomeline High Dose (N=72) Baseline n (%)
Xanomeline Low Dose (N=96) Baseline n (%)
Low
Normal
High
Total
Low
Normal
High
Total
Low
Normal
High
Total
Week 2
Low
0
0
0
0
1 (1.4%)
0
0
1 (1.4%)
1 (1%)
2 (2.1%)
0
3 (3.1%)
Normal
3 (3.5%)
79 (91.9%)
0
82 (95.3%)
0
66 (91.7%)
2 (2.8%)
68 (94.4%)
0
67 (69.8%)
1 (1%)
68 (70.8%)
High
0
0
0
0
0
1 (1.4%)
0
1 (1.4%)
0
0
1 (1%)
1 (1%)
Total
3 (3.5%)
79 (91.9%)
0
82 (95.3%)
1 (1.4%)
67 (93.1%)
2 (2.8%)
70 (97.2%)
1 (1%)
69 (71.9%)
2 (2.1%)
72 (75%)
Week 4
Low
3 (3.5%)
0
0
3 (3.5%)
0
0
0
0
1 (1%)
2 (2.1%)
0
3 (3.1%)
Normal
0
71 (82.6%)
0
71 (82.6%)
1 (1.4%)
61 (84.7%)
2 (2.8%)
64 (88.9%)
1 (1%)
58 (60.4%)
1 (1%)
60 (62.5%)
High
0
0
0
0
0
1 (1.4%)
0
1 (1.4%)
0
0
0
0
Total
3 (3.5%)
71 (82.6%)
0
74 (86%)
1 (1.4%)
62 (86.1%)
2 (2.8%)
65 (90.3%)
2 (2.1%)
60 (62.5%)
1 (1%)
63 (65.6%)
Week 6
Low
2 (2.3%)
1 (1.2%)
0
3 (3.5%)
1 (1.4%)
0
0
1 (1.4%)
1 (1%)
1 (1%)
0
2 (2.1%)
Normal
0
66 (76.7%)
0
66 (76.7%)
0
50 (69.4%)
2 (2.8%)
52 (72.2%)
1 (1%)
52 (54.2%)
1 (1%)
54 (56.2%)
High
0
1 (1.2%)
0
1 (1.2%)
0
1 (1.4%)
0
1 (1.4%)
0
0
0
0
Total
2 (2.3%)
68 (79.1%)
0
70 (81.4%)
1 (1.4%)
51 (70.8%)
2 (2.8%)
54 (75%)
2 (2.1%)
53 (55.2%)
1 (1%)
56 (58.3%)
Source: ADLB DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
Table x.x Shift Table of Lab
Hematology (Full Safety Analysis Set)
Parameter = Platelet (10^9/L)
Analysis Visit
Reference Range
Placebo (N=86) Baseline n (%)
Xanomeline High Dose (N=72) Baseline n (%)
Xanomeline Low Dose (N=96) Baseline n (%)
Low
Normal
High
Total
Low
Normal
High
Total
Low
Normal
High
Total
Week 2
Low
0
0
0
0
1 (1.4%)
0
0
1 (1.4%)
0
0
0
0
Normal
0
80 (93%)
1 (1.2%)
81 (94.2%)
0
70 (97.2%)
0
70 (97.2%)
1 (1%)
66 (68.8%)
1 (1%)
68 (70.8%)
High
0
0
1 (1.2%)
1 (1.2%)
0
0
0
0
0
2 (2.1%)
0
2 (2.1%)
Total
0
80 (93%)
2 (2.3%)
82 (95.3%)
1 (1.4%)
70 (97.2%)
0
71 (98.6%)
1 (1%)
68 (70.8%)
1 (1%)
70 (72.9%)
Week 4
Low
0
0
0
0
0
0
0
0
1 (1%)
0
0
1 (1%)
Normal
0
72 (83.7%)
0
72 (83.7%)
0
65 (90.3%)
0
65 (90.3%)
0
61 (63.5%)
1 (1%)
62 (64.6%)
High
0
0
2 (2.3%)
2 (2.3%)
0
0
0
0
0
0
0
0
Total
0
72 (83.7%)
2 (2.3%)
74 (86%)
0
65 (90.3%)
0
65 (90.3%)
1 (1%)
61 (63.5%)
1 (1%)
63 (65.6%)
Week 6
Low
0
0
0
0
0
0
0
0
1 (1%)
0
0
1 (1%)
Normal
0
69 (80.2%)
1 (1.2%)
70 (81.4%)
0
53 (73.6%)
0
53 (73.6%)
0
56 (58.3%)
1 (1%)
57 (59.4%)
High
0
0
1 (1.2%)
1 (1.2%)
0
0
0
0
0
0
0
0
Total
0
69 (80.2%)
2 (2.3%)
71 (82.6%)
0
53 (73.6%)
0
53 (73.6%)
1 (1%)
56 (58.3%)
1 (1%)
58 (60.4%)
Source: ADLB DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
Colorize cells (Optional)
Suppose we want to highlight values which are Normal
in Baseline but Low
or High
in post-baseline
Code
out |>
data_color (
columns = contains ("Normal" ),
rows = ANRIND %in% c ("High" , "Low" ),
palette = c ("white" , "lightpink" )
)
Table x.x Shift Table of Lab Hematology (Full Safety Analysis Set)
Parameter = Hemoglobin (mmol/L)
Analysis Visit
Reference Range
Placebo (N=86) Baseline n (%)
Xanomeline High Dose (N=72) Baseline n (%)
Xanomeline Low Dose (N=96) Baseline n (%)
Low
Normal
High
Total
Low
Normal
High
Total
Low
Normal
High
Total
Week 2
Low
4 (4.7%)
2 (2.3%)
0
6 (7%)
1 (1.4%)
3 (4.2%)
0
4 (5.6%)
4 (4.2%)
0
0
4 (4.2%)
Normal
3 (3.5%)
73 (84.9%)
0
76 (88.4%)
0
65 (90.3%)
2 (2.8%)
67 (93.1%)
1 (1%)
67 (69.8%)
1 (1%)
69 (71.9%)
High
0
0
0
0
0
0
0
0
0
0
0
0
Total
7 (8.1%)
75 (87.2%)
0
82 (95.3%)
1 (1.4%)
68 (94.4%)
2 (2.8%)
71 (98.6%)
5 (5.2%)
67 (69.8%)
1 (1%)
73 (76%)
Week 4
Low
4 (4.7%)
2 (2.3%)
0
6 (7%)
1 (1.4%)
0
0
1 (1.4%)
4 (4.2%)
2 (2.1%)
0
6 (6.2%)
Normal
1 (1.2%)
68 (79.1%)
0
69 (80.2%)
0
63 (87.5%)
1 (1.4%)
64 (88.9%)
1 (1%)
57 (59.4%)
0
58 (60.4%)
High
0
0
0
0
0
1 (1.4%)
0
1 (1.4%)
0
0
0
0
Total
5 (5.8%)
70 (81.4%)
0
75 (87.2%)
1 (1.4%)
64 (88.9%)
1 (1.4%)
66 (91.7%)
5 (5.2%)
59 (61.5%)
0
64 (66.7%)
Week 6
Low
3 (3.5%)
1 (1.2%)
0
4 (4.7%)
0
1 (1.4%)
0
1 (1.4%)
4 (4.2%)
3 (3.1%)
0
7 (7.3%)
Normal
2 (2.3%)
64 (74.4%)
0
66 (76.7%)
0
51 (70.8%)
1 (1.4%)
52 (72.2%)
1 (1%)
50 (52.1%)
0
51 (53.1%)
High
0
1 (1.2%)
0
1 (1.2%)
0
1 (1.4%)
0
1 (1.4%)
0
0
0
0
Total
5 (5.8%)
66 (76.7%)
0
71 (82.6%)
0
53 (73.6%)
1 (1.4%)
54 (75%)
5 (5.2%)
53 (55.2%)
0
58 (60.4%)
Source: ADLB DDMMYYYY hh:mm; Listing x.xx; SDTM package: DDMMYYYY
Saving the Table
Code
# as rtf
gtsave (out, "adlb_rxxxx_20240428.rtf" , "path to the output directory" )
# as pdf
gtsave (out, "adlb_rxxxx_20240428.pdf" , "path to the output directory" )
# as word
gtsave (out, "adlb_rxxxx_20240428.docx" , "path to the output directory" )
# as html
gtsave (out, "adlb_rxxxx_20240428.html" , "path to the output directory" )
Back to top