Getting there: Exercises

Instructions:

Recommended: Complete these exercises in the dedicated R in Pharma RStudio Cloud work space, which comes with

  1. all packages pre-installed, and

  2. an Rmarkdown document to fill in.

It may still be helpful to peek here to verify that your tables match the desired output.

Click here to enter R in Pharma RStudio Cloud work space for our workshop

Otherwise: Follow along this document, work on your personal computer, and challenge yourself not to peek at the code solutions until you have completed the exercise.

Exercise 1

Create a demographic table by using only dplyr.

  • The data should have only age, gender, and treatment columns.
  • The table should include the mean and standard deviation of age, the count and percentage.
Show the code solution
# Load necessary libraries
library(dplyr)

Attaching package: 'dplyr'
The following objects are masked from 'package:stats':

    filter, lag
The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union
Show the code solution
# Sample data frame with demographic data
set.seed(123)
data <- data.frame(
  id = 1:100,
  age = sample(18:80, 100, replace = TRUE),
  gender = sample(c("Male", "Female"), 100, replace = TRUE),
  treatment = sample(c("Treatment A", "Treatment B"), 100, replace = TRUE)
)

# Count participants per treatment group to get labels with counts
treatment_counts <- data |> 
  count(treatment) |> 
  mutate(treatment_label = paste0(treatment, " (N=", n, ")"))

# Create the demographic summary table
demographic_table <- data |> 
  # Join with treatment counts to include the labeled treatment names
  left_join(treatment_counts, by = "treatment") |>
  # Summarize age, female, and male counts and percentages by the labeled treatment
  group_by(treatment_label) |> 
  summarise(
    `Mean Age (SD)` = paste0(round(mean(age), 1), " (", round(sd(age), 1), ")"),
    `N Female (%)` = paste0(sum(gender == "Female"), " (", round(sum(gender == "Female") / n() * 100, 1), "%)"),
    `N Male (%)` = paste0(sum(gender == "Male"), " (", round(sum(gender == "Male") / n() * 100, 1), "%)"),
    .groups = "drop"
  ) |>
  # Transpose for easy review if needed
  t() |>
  print()
                [,1]                 [,2]                
treatment_label "Treatment A (N=51)" "Treatment B (N=49)"
Mean Age (SD)   "50.3 (17.9)"        "45.7 (16.3)"       
N Female (%)    "27 (52.9%)"         "28 (57.1%)"        
N Male (%)      "24 (47.1%)"         "21 (42.9%)"        

Bonus solution with {rtables}:

Show the code solution
library(rtables)
Loading required package: formatters

Attaching package: 'formatters'
The following object is masked from 'package:base':

    %||%
Loading required package: magrittr

Attaching package: 'rtables'
The following object is masked from 'package:utils':

    str
Show the code solution
library(tern)
Registered S3 method overwritten by 'tern':
  method   from 
  tidy.glm broom
Show the code solution
lyt <- basic_table() |> 
  split_cols_by("treatment") |> 
  analyze_vars(c("gender", "age"))

build_table(lyt, data)
Warning in as_factor_keep_attributes(x, verbose = verbose): automatically
converting character variable x to factor, better manually convert to factor to
avoid failures
Warning in as_factor_keep_attributes(x, verbose = verbose): automatically
converting character variable x to factor, better manually convert to factor to
avoid failures
              Treatment B   Treatment A
———————————————————————————————————————
gender                                 
  n               49            51     
  Female      28 (57.1%)    27 (52.9%) 
  Male        21 (42.9%)    24 (47.1%) 
age                                    
  n               49            51     
  Mean (SD)   45.7 (16.3)   50.3 (17.9)
  Median         44.0          49.0    
  Min - Max   20.0 - 79.0   21.0 - 80.0

Exercise 2

Build a demographic table using {rtables} or {gtsummary}. Data is provided as follows:

Show the code solution
adsl <- random.cdisc.data::cadsl
advs <- random.cdisc.data::cadvs

# Pre-Processing - Add any variables needed in your table to df
adsl <- adsl |> 
  mutate(AGEGR1 = as.factor(case_when(
    AGE >= 17 & AGE < 65 ~ "≥17 to &lt;65",
    AGE >= 65 ~ "≥65",
    AGE >= 65 & AGE < 75 ~ "≥65 to &lt;75",
    AGE >= 75 ~ "≥75"
  )))

advs <- advs |> 
  filter(AVISIT == "BASELINE", VSTESTCD == "TEMP") |>
  select("USUBJID", "AVAL")

anl <- left_join(adsl, advs, by = "USUBJID")

df <- anl |>
  df_explicit_na()

vars <- c("SEX", "AGE", "AGEGR1", "RACE", "ETHNIC", "COUNTRY")
lbl_vars <- formatters::var_labels(df, fill = TRUE)[vars]

lyt <- basic_table(show_colcounts = TRUE) |>
  split_cols_by("ARM", split_fun = add_overall_level("Total Population", first = FALSE)) |>
  analyze_vars(
    vars = vars,
    var_labels = lbl_vars,
    show_labels = "visible",
    .stats = c("mean_sd", "median_range", "count_fraction"),
    .formats = NULL,
    na.rm = FALSE
  ) |>
  append_topleft("Characteristic")

tbl <- build_table(lyt, df = df) |> 
  prune_table()

tbl
                                                  A: Drug X            B: Placebo         C: Combination      Total Population 
Characteristic                                     (N=134)              (N=134)              (N=132)              (N=400)      
———————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————
Sex                                                                                                                            
  F                                                79 (59%)            82 (61.2%)            70 (53%)           231 (57.8%)    
  M                                                55 (41%)            52 (38.8%)            62 (47%)           169 (42.2%)    
Age                                                                                                                            
  Mean (SD)                                       33.8 (6.6)           35.4 (7.9)           35.4 (7.7)           34.9 (7.4)    
  Median (Min - Max)                          33.0 (21.0 - 50.0)   35.0 (21.0 - 62.0)   35.0 (20.0 - 69.0)   34.0 (20.0 - 69.0)
AGEGR1                                                                                                                         
  ≥17 to &lt;65                                   134 (100%)           134 (100%)          131 (99.2%)          399 (99.8%)    
  ≥65                                                 0                    0                 1 (0.8%)             1 (0.2%)     
Race                                                                                                                           
  ASIAN                                           68 (50.7%)            67 (50%)            73 (55.3%)           208 (52%)     
  BLACK OR AFRICAN AMERICAN                       31 (23.1%)           28 (20.9%)           32 (24.2%)           91 (22.8%)    
  WHITE                                           27 (20.1%)           26 (19.4%)           21 (15.9%)           74 (18.5%)    
  AMERICAN INDIAN OR ALASKA NATIVE                  8 (6%)             11 (8.2%)             6 (4.5%)            25 (6.2%)     
  MULTIPLE                                            0                 1 (0.7%)                0                 1 (0.2%)     
  NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER           0                 1 (0.7%)                0                 1 (0.2%)     
Ethnicity                                                                                                                      
  HISPANIC OR LATINO                              15 (11.2%)           18 (13.4%)           15 (11.4%)            48 (12%)     
  NOT HISPANIC OR LATINO                         104 (77.6%)          103 (76.9%)          101 (76.5%)           308 (77%)     
  NOT REPORTED                                     6 (4.5%)            10 (7.5%)            11 (8.3%)            27 (6.8%)     
  UNKNOWN                                          9 (6.7%)             3 (2.2%)             5 (3.8%)            17 (4.2%)     
Country                                                                                                                        
  CHN                                             74 (55.2%)           81 (60.4%)           64 (48.5%)          219 (54.8%)    
  USA                                             10 (7.5%)            13 (9.7%)            17 (12.9%)            40 (10%)     
  BRA                                             13 (9.7%)             7 (5.2%)            10 (7.6%)            30 (7.5%)     
  PAK                                              12 (9%)              9 (6.7%)            10 (7.6%)            31 (7.8%)     
  NGA                                               8 (6%)              7 (5.2%)            11 (8.3%)            26 (6.5%)     
  RUS                                              5 (3.7%)              8 (6%)              6 (4.5%)            19 (4.8%)     
  JPN                                              5 (3.7%)              4 (3%)              9 (6.8%)            18 (4.5%)     
  GBR                                               4 (3%)              3 (2.2%)             2 (1.5%)             9 (2.2%)     
  CAN                                              3 (2.2%)             2 (1.5%)             3 (2.3%)              8 (2%)      
Show the code solution
library(gtsummary)

df <- df |> df_explicit_na()
vars <- c("SEX", "AGE", "AGEGR1", "RACE", "ETHNIC", "COUNTRY")
lbl_vars <- formatters::var_labels(df, fill = TRUE)[vars]

tbl <- df  |> 
  select(c(vars, "ARM")) |> 
  tbl_summary(
    by = "ARM",
    type = all_continuous() ~ "continuous2",
    statistic = list(
      all_continuous() ~ c(
        "{mean} ({sd})",
        "{median} ({min} - {max})"
      ),
      all_categorical() ~ "{n} ({p}%)"
    ),
    digits = all_continuous() ~ 1,
    missing = "ifany",
    label = as.list(lbl_vars) |> setNames(vars)
  ) |>
  gtsummary::bold_labels() |>
  modify_header(all_stat_cols() ~ "**{level}**  \nN = {n}") |>
  add_overall(last = TRUE, col_label = paste0("**", "Total Population", "**  \nN = {n}")) |>
  gtsummary::add_stat_label(label = all_continuous2() ~ c("Mean (SD)", "Median (min - max)")) |>
  modify_footnote(update = everything() ~ NA) |>
  gtsummary::modify_column_alignment(columns = all_stat_cols(), align = "right")

tbl

Exercise 3

Lets try now to build an ANCOVA efficacy table with a single visit and single endpoint.

AOVT02 on the TLG-catalog

Exercise 3 bonus

Use {teal} part: AOVT02 on the TLG-catalog

Exercise 3 wild bonus

Try to use the data from before (Exercise 1) to make your own teal app (tip: use tm_t_summary)

Show the code solution
library(teal.modules.clinical)
## Data reproducible code
data <- teal_data()
data <- within(data, {
  ADSL <- data.frame(
    STUDYID = 1:100,
    USUBJID = paste0("01-123-", 1:100),
    age = formatters::with_label(sample(18:80, 100, replace = TRUE), "Age"),
    gender = formatters::with_label(sample(c("Male", "Female"), 100, replace = TRUE), "Gender"),
    treatment = factor(sample(c("Treatment A", "Treatment B"), 100, replace = TRUE))
  )
})
datanames <- "ADSL"
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

## Setup App
app <- init(
  data = data,
  modules = modules(
    tm_t_summary(
      label = "Demographic Table",
      dataname = "ADSL",
      arm_var = choices_selected(c("treatment"), "treatment"),
      summarize_vars = choices_selected(
        c("age", "gender"),
        c("age", "gender")
      ),
      useNA = "ifany"
    )
  )
)

shinyApp(app$ui, app$server)

Exercise 4 - Kaplan-Meier plot

Lets try now to create an efficacy Kaplan-Meier plot.

KMG01

Exercise 5 - Try {teal.gallery}

teal.gallery