TLG Catalog - Stable
  • Stable
    • Dev
  1. Graphs
  2. Other
  3. BWG01
  • Introduction

  • Tables
    • ADA
      • ADAT01
      • ADAT02
      • ADAT03
      • ADAT04A
      • ADAT04B
    • Adverse Events
      • AET01
      • AET01_AESI
      • AET02
      • AET02_SMQ
      • AET03
      • AET04
      • AET04_PI
      • AET05
      • AET05_ALL
      • AET06
      • AET06_SMQ
      • AET07
      • AET09
      • AET09_SMQ
      • AET10
    • Concomitant Medications
      • CMT01
      • CMT01A
      • CMT01B
      • CMT02_PT
    • Deaths
      • DTHT01
    • Demography
      • DMT01
    • Disclosures
      • DISCLOSUREST01
      • EUDRAT01
      • EUDRAT02
    • Disposition
      • DST01
      • PDT01
      • PDT02
    • ECG
      • EGT01
      • EGT02
      • EGT03
      • EGT04
      • EGT05_QTCAT
    • Efficacy
      • AOVT01
      • AOVT02
      • AOVT03
      • CFBT01
      • CMHT01
      • COXT01
      • COXT02
      • DORT01
      • LGRT02
      • MMRMT01
      • ONCT05
      • RATET01
      • RBMIT01
      • RSPT01
      • TTET01
    • Exposure
      • EXT01
    • Lab Results
      • LBT01
      • LBT02
      • LBT03
      • LBT04
      • LBT05
      • LBT06
      • LBT07
      • LBT08
      • LBT09
      • LBT10
      • LBT10_BL
      • LBT11
      • LBT11_BL
      • LBT12
      • LBT12_BL
      • LBT13
      • LBT14
      • LBT15
    • Medical History
      • MHT01
    • Pharmacokinetic
      • PKCT01
      • PKPT02
      • PKPT03
      • PKPT04
      • PKPT05
      • PKPT06
      • PKPT07
      • PKPT08
      • PKPT11
    • Risk Management Plan
      • RMPT01
      • RMPT03
      • RMPT04
      • RMPT05
      • RMPT06
    • Safety
      • ENTXX
    • Vital Signs
      • VST01
      • VST02
  • Listings
    • ADA
      • ADAL02
    • Adverse Events
      • AEL01
      • AEL01_NOLLT
      • AEL02
      • AEL02_ED
      • AEL03
      • AEL04
    • Concomitant Medications
      • CML01
      • CML02A_GL
      • CML02B_GL
    • Development Safety Update Report
      • DSUR4
    • Disposition
      • DSL01
      • DSL02
    • ECG
      • EGL01
    • Efficacy
      • ONCL01
    • Exposure
      • EXL01
    • Lab Results
      • LBL01
      • LBL01_RLS
      • LBL02A
      • LBL02A_RLS
      • LBL02B
    • Medical History
      • MHL01
    • Pharmacokinetic
      • ADAL01
      • PKCL01
      • PKCL02
      • PKPL01
      • PKPL02
      • PKPL04
    • Vital Signs
      • VSL01
  • Graphs
    • Efficacy
      • FSTG01
      • FSTG02
      • KMG01
      • MMRMG01
      • MMRMG02
    • Other
      • BRG01
      • BWG01
      • CIG01
      • IPPG01
      • LTG01
      • MNG01
    • Pharmacokinetic
      • PKCG01
      • PKCG02
      • PKCG03
      • PKPG01
      • PKPG02
      • PKPG03
      • PKPG04
      • PKPG06

  • Appendix
    • Reproducibility

  • Index

On this page

  • Output
  • teal App
  • Reproducibility
    • Timestamp
    • Session Info
    • .lock file
  • Edit this page
  • Report an issue
  1. Graphs
  2. Other
  3. BWG01

BWG01

Box Plot


Output

  • Standard Plot
  • Plot Changing
    Whiskers
  • Plot Adding
    Outliers
  • Plot Specifying Marker
    for Outliers and
    Adding Patient ID
  • Plot Specifying
    Marker for Mean
  • Plot by Treatment
    and Timepoint
  • Plot by Timepoint
    and Treatment
  • Plot with
    Table Section
  • Plot with Number of Patients
    only in Table Section
  • Data Setup
  • Preview
  • Try this using WebR
Code
bp_1 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(geom = "boxplot", fun.data = five_num, fill = fc, color = oc) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the minimum and maximum values.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_1, oc)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

  • Preview
  • Try this using WebR
Code
bp_3 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(
    geom = "boxplot", fun.data = five_num,
    fun.args = list(probs = c(0.05, 0.25, 0.5, 0.75, 0.95)), fill = fc, color = oc
  ) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the 5th and 95th percentile. Values outside the whiskers have not been plotted.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_3, oc)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

  • Preview
  • Try this using WebR
Code
bp_4 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(
    geom = "boxplot", fun.data = five_num,
    fun.args = list(probs = c(0.05, 0.25, 0.5, 0.75, 0.95)), fill = fc, color = oc
  ) +
  stat_summary(geom = "point", fun = get_outliers, shape = 1) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the 5th and 95th percentile.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_4, oc)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

  • Preview
  • Try this using WebR
Code
adlb_o <- adlb %>%
  group_by(ARMCD) %>%
  mutate(OUTLIER = AVAL < quantile(AVAL, 0.01) | AVAL > quantile(AVAL, 0.99)) %>%
  filter(OUTLIER == TRUE) %>%
  select(ARMCD, AVAL, USUBJID)
# Next step may be study-specific: shorten USUBJID to make annotation labels
# next 2 lines of code split USUBJID by "-" and take the last syllable as ID
n_split <- max(vapply(strsplit(adlb_o$USUBJID, "-"), length, numeric(1)))
adlb_o$ID <- vapply(strsplit(adlb_o$USUBJID, "-"), `[[`, n_split, FUN.VALUE = "a")

bp_5 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(
    geom = "boxplot", fun.data = five_num,
    fun.args = list(probs = c(0.01, 0.25, 0.5, 0.75, 0.99)), fill = fc, color = oc
  ) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  geom_point(data = adlb_o, aes(x = ARMCD, y = AVAL), shape = 1) +
  geom_text(data = adlb_o, aes(x = ARMCD, y = AVAL, label = ID), size = 3, hjust = -0.2) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the largest and smallest observed value within 1.5*IQR.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_5, oc)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

  • Preview
  • Try this using WebR
Code
bp_6 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  geom_boxplot(fill = fc, color = oc) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 5) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the minimum and maximum values.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_6, oc)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

  • Preview
  • Try this using WebR
Code
adsl <- random.cdisc.data::cadsl
adlb <- random.cdisc.data::cadlb

adlb_v <- adlb %>%
  filter(PARAMCD == "ALT" & AVISIT %in% c("WEEK 1 DAY 8", "WEEK 2 DAY 15", "WEEK 3 DAY 22", "WEEK 4 DAY 29"))

bp_7 <- ggplot(adlb_v, aes(x = AVISIT, y = AVAL)) +
  stat_summary(
    geom = "boxplot",
    fun.data = five_num,
    position = position_dodge2(.5),
    aes(fill = ARMCD, color = ARMCD)
  ) +
  stat_summary(
    geom = "point",
    fun = mean,
    aes(group = ARMCD),
    size = 3,
    shape = 8,
    position = position_dodge2(1)
  ) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    caption = "The whiskers extend to the minimum and maximum values.",
    x = "Visit",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_7, oc, 2)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

  • Preview
  • Try this using WebR
Code
bp_8 <- ggplot(adlb_v, aes(x = ARMCD, y = AVAL)) +
  stat_summary(
    geom = "boxplot",
    fun.data = five_num,
    position = position_dodge2(width = .5),
    aes(fill = AVISIT, color = AVISIT)
  ) +
  stat_summary(
    geom = "point",
    fun = mean,
    aes(group = AVISIT),
    size = 3,
    shape = 8,
    position = position_dodge2(1)
  ) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    caption = "The whiskers extend to the minimum and maximum values.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_8, oc, 2)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

  • Preview
  • Try this using WebR
Code
# Make wide dataset with summary statistics
adlb_wide <- adlb %>%
  group_by(ARMCD) %>%
  summarise(
    n = n(),
    mean = round(mean(AVAL), 1),
    median = round(median(AVAL), 1),
    median_ci = paste(round(DescTools::MedianCI(AVAL)[1:2], 1), collapse = " - "),
    q1_q3 = paste(round(quantile(AVAL, c(0.25, 0.75)), 1), collapse = " - "),
    min_max = paste0(round(min(AVAL), 1), "-", max(round(AVAL, 2)))
  )

# Make long dataset
adlb_long <- tidyr::gather(adlb_wide, key = type, value = stat, n:min_max)
adlb_long <- adlb_long %>% mutate(
  type_lbl = case_when(
    type == "n" ~ "n",
    type == "mean" ~ "Mean",
    type == "median" ~ "Median",
    type == "median_ci" ~ "95% CI for Median",
    type == "q1_q3" ~ "25% and 75%-ile",
    type == "min_max" ~ "Min - Max"
  )
)
adlb_long$type_lbl <- factor(adlb_long$type_lbl,
  levels = c("Min - Max", "25% and 75%-ile", "95% CI for Median", "Median", "Mean", "n")
)

bp_9 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(geom = "boxplot", fun.data = five_num, fill = fc, color = oc) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

tbl_theme <- theme(
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  axis.ticks = element_blank(),
  axis.title = element_blank(),
  axis.text.y = element_text(face = "plain"),
  axis.text.x = element_blank()
)

tbl_1 <- ggplot(adlb_long, aes(x = ARMCD, y = type_lbl, label = stat), vjust = 10) +
  geom_text(size = 3) +
  scale_y_discrete(labels = levels(adlb_long$type_lbl)) +
  theme_bw() +
  tbl_theme +
  labs(caption = "The whiskers extend to the minimum and maximum values.") +
  theme_bp

plot <- cowplot::plot_grid(bp_annos(bp_9, oc), tbl_1,
  rel_heights = c(4, 2),
  ncol = 1, nrow = 2, align = "v"
)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

  • Preview
  • Try this using WebR
Code
tbl_2 <- adlb_long %>%
  filter(type == "n") %>%
  ggplot(aes(x = ARMCD, y = type_lbl, label = stat)) +
  geom_text(size = 3) +
  scale_y_discrete(labels = "n") +
  theme_bw() +
  tbl_theme +
  labs(caption = "The whiskers extend to the minimum and maximum values.") +
  theme_bp

plot <- cowplot::plot_grid(bp_annos(bp_9, oc), tbl_2,
  rel_heights = c(6, 1),
  ncol = 1, nrow = 2, align = "v"
)
plot

Experimental use!

WebR is a tool allowing you to run R code in the web browser. Modify the code below and click run to see the results. Alternatively, copy the code and click here to open WebR in a new tab.

Code
library(dplyr)
library(ggplot2)
library(nestcolor)

adlb <- random.cdisc.data::cadlb
adlb <- adlb %>% filter(PARAMCD == "ALT" & AVISIT == "WEEK 2 DAY 15")

# Definition of boxplot boundaries and whiskers
five_num <- function(x, probs = c(0, 0.25, 0.5, 0.75, 1)) {
  r <- quantile(x, probs)
  names(r) <- c("ymin", "lower", "middle", "upper", "ymax")
  r
}

# get outliers based on quantile
# for outliers based on IQR see coef in geom_boxplot
get_outliers <- function(x, probs = c(0.05, 0.95)) {
  r <- subset(x, x < quantile(x, probs[1]) | quantile(x, probs[2]) < x)
  if (!is.null(x)) {
    x_names <- subset(names(x), x < quantile(x, probs[1]) | quantile(x, probs[2]) < x)
    names(r) <- x_names
  }
  r
}

# create theme used for all plots
theme_bp <- theme(
  plot.title = element_text(hjust = 0),
  plot.subtitle = element_text(hjust = 0),
  plot.caption = element_text(hjust = 0),
  panel.background = element_rect(fill = "white", color = "grey50")
)

# assign fill color and outline color
fc <- "#eaeef5"
oc <- getOption("ggplot2.discrete.fill")[1]

# get plot metadata data to derive coordinates for adding annotations
bp_annos <- function(bp, color, annos = 1) {
  bp_mdat <- ggplot_build(bp)$data[[1]]
  if (annos == 1) {
    bp <- bp +
      geom_segment(data = bp_mdat, aes(
        x = xmin + (xmax - xmin) / 4, xend = xmax - (xmax - xmin) / 4,
        y = ymax, yend = ymax
      ), linewidth = .5, color = color) +
      geom_segment(data = bp_mdat, aes(
        x = xmin + (xmax - xmin) / 4, xend = xmax - (xmax - xmin) / 4,
        y = ymin, yend = ymin
      ), linewidth = .5, color = color)
  } else {
    bp <- bp +
      geom_segment(data = bp_mdat, aes(
        x = xmin + (xmax - xmin) / 4, xend = xmax - (xmax - xmin) / 4,
        y = ymax, yend = ymax
      ), linewidth = .5, color = color) +
      geom_segment(data = bp_mdat, aes(
        x = xmin + (xmax - xmin) / 4, xend = xmax - (xmax - xmin) / 4,
        y = ymin, yend = ymin
      ), linewidth = .5, color = color) +
      geom_segment(data = bp_mdat, aes(
        x = xmin, xend = xmax,
        y = middle, yend = middle
      ), colour = color, linewidth = .5)
  }
  return(bp)
}

teal App

  • Preview
  • Try this using shinylive
Code
library(teal.modules.general)

## Data reproducible code
data <- teal_data()
data <- within(data, {
  library(tern)

  ADSL <- random.cdisc.data::cadsl
  ADLB <- random.cdisc.data::cadlb

  # If PARAMCD and AVISIT are not factors, convert to factors
  # Also fill in missing values with "<Missing>"
  ADLB <- ADLB %>%
    df_explicit_na(
      omit_columns = setdiff(names(ADLB), c("PARAMCD", "AVISIT")),
      char_as_factor = TRUE
    )

  # If statment below fails, pre-process ADLB to be one record per
  # study, subject, param and visit eg. filter with ANLFL = 'Y'
  stopifnot(nrow(ADLB) == nrow(unique(ADLB[, c("STUDYID", "USUBJID", "PARAMCD", "AVISIT")])))
})
datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames
Warning: `datanames<-()` was deprecated in teal.data 0.7.0.
ℹ invalid to use `datanames()<-` or `names()<-` on an object of class
  `teal_data`. See ?names.teal_data
Code
join_keys(data) <- default_cdisc_join_keys[datanames]

## Reusable Configuration For Modules
ADSL <- data[["ADSL"]]
ADLB <- data[["ADLB"]]

## Setup App
app <- init(
  data = data,
  modules = modules(
    tm_g_bivariate(
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = names(ADSL),
          selected = "ARMCD",
          fixed = FALSE
        )
      ),
      y = data_extract_spec(
        dataname = "ADLB",
        filter = list(
          filter_spec(
            vars = c("PARAMCD"),
            choices = levels(ADLB$PARAMCD),
            selected = levels(ADLB$PARAMCD)[1],
            multiple = FALSE,
            label = "Choose lab parameter"
          ),
          filter_spec(
            vars = c("AVISIT"),
            choices = levels(ADLB$AVISIT),
            selected = levels(ADLB$AVISIT)[1],
            multiple = FALSE,
            label = "Choose visit"
          )
        ),
        select = select_spec(
          label = "Select variable:",
          choices = names(ADLB),
          selected = "AVAL",
          multiple = FALSE,
          fixed = TRUE
        )
      ),
      row_facet = data_extract_spec(
        dataname = "ADLB",
        select = select_spec(
          label = "Select variables:",
          choices = names(ADLB),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      col_facet = data_extract_spec(
        dataname = "ADLB",
        select = select_spec(
          label = "Select variables:",
          choices = names(ADLB),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      )
    )
  )
)

shinyApp(app$ui, app$server)
Warning: Removed 8000 rows containing non-finite outside the scale range
(`stat_boxplot()`).

Experimental use!

shinylive allow you to modify to run shiny application entirely in the web browser. Modify the code below and click re-run the app to see the results. The performance is slighly worse and some of the features (e.g. downloading) might not work at all.

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 800
#| editorHeight: 200
#| components: [viewer, editor]
#| layout: vertical

# -- WEBR HELPERS --
options(webr_pkg_repos = c("r-universe" = "https://insightsengineering.r-universe.dev", getOption("webr_pkg_repos")))

# -- APP CODE --
library(teal.modules.general)

## Data reproducible code
data <- teal_data()
data <- within(data, {
  library(tern)

  ADSL <- random.cdisc.data::cadsl
  ADLB <- random.cdisc.data::cadlb

  # If PARAMCD and AVISIT are not factors, convert to factors
  # Also fill in missing values with "<Missing>"
  ADLB <- ADLB %>%
    df_explicit_na(
      omit_columns = setdiff(names(ADLB), c("PARAMCD", "AVISIT")),
      char_as_factor = TRUE
    )

  # If statment below fails, pre-process ADLB to be one record per
  # study, subject, param and visit eg. filter with ANLFL = 'Y'
  stopifnot(nrow(ADLB) == nrow(unique(ADLB[, c("STUDYID", "USUBJID", "PARAMCD", "AVISIT")])))
})
datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

## Reusable Configuration For Modules
ADSL <- data[["ADSL"]]
ADLB <- data[["ADLB"]]

## Setup App
app <- init(
  data = data,
  modules = modules(
    tm_g_bivariate(
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = names(ADSL),
          selected = "ARMCD",
          fixed = FALSE
        )
      ),
      y = data_extract_spec(
        dataname = "ADLB",
        filter = list(
          filter_spec(
            vars = c("PARAMCD"),
            choices = levels(ADLB$PARAMCD),
            selected = levels(ADLB$PARAMCD)[1],
            multiple = FALSE,
            label = "Choose lab parameter"
          ),
          filter_spec(
            vars = c("AVISIT"),
            choices = levels(ADLB$AVISIT),
            selected = levels(ADLB$AVISIT)[1],
            multiple = FALSE,
            label = "Choose visit"
          )
        ),
        select = select_spec(
          label = "Select variable:",
          choices = names(ADLB),
          selected = "AVAL",
          multiple = FALSE,
          fixed = TRUE
        )
      ),
      row_facet = data_extract_spec(
        dataname = "ADLB",
        select = select_spec(
          label = "Select variables:",
          choices = names(ADLB),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      col_facet = data_extract_spec(
        dataname = "ADLB",
        select = select_spec(
          label = "Select variables:",
          choices = names(ADLB),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      )
    )
  )
)

shinyApp(app$ui, app$server)

Reproducibility

Timestamp

[1] "2025-06-11 18:05:00 UTC"

Session Info

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.5.0 (2025-04-11)
 os       Ubuntu 24.04.2 LTS
 system   x86_64, linux-gnu
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       Etc/UTC
 date     2025-06-11
 pandoc   3.6.4 @ /usr/bin/ (via rmarkdown)
 quarto   1.7.31 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package              * version   date (UTC) lib source
 backports              1.5.0     2024-05-23 [1] RSPM
 boot                   1.3-31    2024-08-28 [2] CRAN (R 4.5.0)
 brio                   1.1.5     2024-04-24 [1] RSPM
 broom                  1.0.8     2025-03-28 [1] RSPM
 bslib                  0.9.0     2025-01-30 [1] RSPM
 cachem                 1.1.0     2024-05-16 [1] RSPM
 callr                  3.7.6     2024-03-25 [1] RSPM
 cellranger             1.1.0     2016-07-27 [1] RSPM
 checkmate              2.3.2     2024-07-29 [1] RSPM
 chromote               0.5.1     2025-04-24 [1] RSPM
 class                  7.3-23    2025-01-01 [2] CRAN (R 4.5.0)
 cli                    3.6.5     2025-04-23 [1] RSPM
 codetools              0.2-20    2024-03-31 [2] CRAN (R 4.5.0)
 cowplot                1.1.3     2024-01-22 [1] RSPM
 curl                   6.3.0     2025-06-06 [1] RSPM
 data.table             1.17.4    2025-05-26 [1] RSPM
 DescTools              0.99.60   2025-03-28 [1] RSPM
 dichromat              2.0-0.1   2022-05-02 [1] CRAN (R 4.5.0)
 digest                 0.6.37    2024-08-19 [1] RSPM
 dplyr                * 1.1.4     2023-11-17 [1] RSPM
 e1071                  1.7-16    2024-09-16 [1] RSPM
 evaluate               1.0.3     2025-01-10 [1] RSPM
 Exact                  3.3       2024-07-21 [1] RSPM
 expm                   1.0-0     2024-08-19 [1] RSPM
 farver                 2.1.2     2024-05-13 [1] RSPM
 fastmap                1.2.0     2024-05-15 [1] RSPM
 fontawesome            0.5.3     2024-11-16 [1] RSPM
 forcats                1.0.0     2023-01-29 [1] RSPM
 formatR                1.14      2023-01-17 [1] CRAN (R 4.5.0)
 formatters           * 0.5.11    2025-04-09 [1] RSPM
 fs                     1.6.6     2025-04-12 [1] RSPM
 generics               0.1.4     2025-05-09 [1] RSPM
 ggmosaic             * 0.3.3     2021-02-23 [1] RSPM
 ggplot2              * 3.5.2     2025-04-09 [1] RSPM
 ggrepel                0.9.6     2024-09-07 [1] RSPM
 gld                    2.6.7     2025-01-17 [1] RSPM
 glue                   1.8.0     2024-09-30 [1] RSPM
 gtable                 0.3.6     2024-10-25 [1] RSPM
 haven                  2.5.5     2025-05-30 [1] RSPM
 hms                    1.1.3     2023-03-21 [1] RSPM
 htmltools              0.5.8.1   2024-04-04 [1] RSPM
 htmlwidgets            1.6.4     2023-12-06 [1] RSPM
 httpuv                 1.6.16    2025-04-16 [1] RSPM
 httr                   1.4.7     2023-08-15 [1] RSPM
 jquerylib              0.1.4     2021-04-26 [1] RSPM
 jsonlite               2.0.0     2025-03-27 [1] RSPM
 knitr                  1.50      2025-03-16 [1] RSPM
 labeling               0.4.3     2023-08-29 [1] RSPM
 later                  1.4.2     2025-04-08 [1] RSPM
 lattice                0.22-7    2025-04-02 [2] CRAN (R 4.5.0)
 lazyeval               0.2.2     2019-03-15 [1] RSPM
 lifecycle              1.0.4     2023-11-07 [1] RSPM
 lmom                   3.2       2024-09-30 [1] RSPM
 logger                 0.4.0     2024-10-22 [1] RSPM
 magrittr             * 2.0.3     2022-03-30 [1] RSPM
 MASS                   7.3-65    2025-02-28 [2] CRAN (R 4.5.0)
 Matrix                 1.7-3     2025-03-11 [1] CRAN (R 4.5.0)
 memoise                2.0.1     2021-11-26 [1] RSPM
 mime                   0.13      2025-03-17 [1] RSPM
 mvtnorm                1.3-3     2025-01-10 [1] RSPM
 nestcolor            * 0.1.3     2025-01-21 [1] RSPM
 pillar                 1.10.2    2025-04-05 [1] RSPM
 pkgcache               2.2.4     2025-05-26 [1] RSPM
 pkgconfig              2.0.3     2019-09-22 [1] RSPM
 plotly                 4.10.4    2024-01-13 [1] RSPM
 processx               3.8.6     2025-02-21 [1] RSPM
 promises               1.3.3     2025-05-29 [1] RSPM
 proxy                  0.4-27    2022-06-09 [1] RSPM
 ps                     1.9.1     2025-04-12 [1] RSPM
 purrr                  1.0.4     2025-02-05 [1] RSPM
 R6                     2.6.1     2025-02-15 [1] RSPM
 ragg                   1.4.0     2025-04-10 [1] RSPM
 random.cdisc.data      0.3.16    2024-10-10 [1] RSPM
 rbibutils              2.3       2024-10-04 [1] RSPM
 RColorBrewer           1.1-3     2022-04-03 [1] RSPM
 Rcpp                   1.0.14    2025-01-12 [1] RSPM
 Rdpack                 2.6.4     2025-04-09 [1] RSPM
 readr                  2.1.5     2024-01-10 [1] RSPM
 readxl                 1.4.5     2025-03-07 [1] RSPM
 rlang                  1.1.6     2025-04-11 [1] RSPM
 rmarkdown              2.29      2024-11-04 [1] RSPM
 rootSolve              1.8.2.4   2023-09-21 [1] RSPM
 rstudioapi             0.17.1    2024-10-22 [1] RSPM
 rtables              * 0.6.12    2025-04-11 [1] RSPM
 sass                   0.4.10    2025-04-11 [1] RSPM
 scales                 1.4.0     2025-04-24 [1] RSPM
 sessioninfo            1.2.3     2025-02-05 [1] any (@1.2.3)
 shiny                * 1.10.0    2024-12-14 [1] RSPM
 shinycssloaders        1.1.0     2024-07-30 [1] RSPM
 shinyjs                2.1.0     2021-12-23 [1] RSPM
 shinyvalidate          0.1.3     2023-10-04 [1] RSPM
 shinyWidgets           0.9.0     2025-02-21 [1] RSPM
 stringi                1.8.7     2025-03-27 [1] RSPM
 stringr                1.5.1     2023-11-14 [1] RSPM
 survival               3.8-3     2024-12-17 [2] CRAN (R 4.5.0)
 systemfonts            1.2.3     2025-04-30 [1] RSPM
 teal                 * 0.16.0    2025-02-23 [1] RSPM
 teal.code            * 0.6.1     2025-02-14 [1] RSPM
 teal.data            * 0.7.0     2025-01-28 [1] RSPM
 teal.logger            0.3.2     2025-02-14 [1] RSPM
 teal.modules.general * 0.4.1     2025-04-01 [1] RSPM
 teal.reporter          0.4.0     2025-01-24 [1] RSPM
 teal.slice           * 0.6.0     2025-02-03 [1] RSPM
 teal.transform       * 0.6.0     2025-02-12 [1] RSPM
 teal.widgets           0.4.3     2025-01-31 [1] RSPM
 tern                 * 0.9.8.433 2025-06-11 [1] https://i~
 testthat               3.2.3     2025-01-13 [1] RSPM
 textshaping            1.0.1     2025-05-01 [1] RSPM
 tibble                 3.3.0     2025-06-08 [1] RSPM
 tidyr                  1.3.1     2024-01-24 [1] RSPM
 tidyselect             1.2.1     2024-03-11 [1] RSPM
 tzdb                   0.5.0     2025-03-15 [1] RSPM
 vctrs                  0.6.5     2023-12-01 [1] RSPM
 viridisLite            0.4.2     2023-05-02 [1] RSPM
 webshot                0.5.5     2023-06-26 [1] CRAN (R 4.5.0)
 webshot2               0.1.2     2025-04-23 [1] RSPM
 websocket              1.4.4     2025-04-10 [1] RSPM
 withr                  3.0.2     2024-10-28 [1] RSPM
 xfun                   0.52      2025-04-02 [1] RSPM
 xtable                 1.8-4     2019-04-21 [1] RSPM
 yaml                   2.3.10    2024-07-26 [1] RSPM

 [1] /usr/local/lib/R/site-library
 [2] /usr/local/lib/R/library
 [3] /github/home/R/x86_64-pc-linux-gnu-library/4.5
 * ── Packages attached to the search path.

──────────────────────────────────────────────────────────────────────────────

.lock file

Download the .lock file and use renv::restore() on it to recreate environment used to generate this website.

Download

BRG01
CIG01
Source Code
---
title: BWG01
subtitle: Box Plot
---

------------------------------------------------------------------------

{{< include ../../_utils/envir_hook.qmd >}}

```{r setup, echo = FALSE, warning = FALSE, message = FALSE}
library(dplyr)
library(ggplot2)
library(nestcolor)

adlb <- random.cdisc.data::cadlb
adlb <- adlb %>% filter(PARAMCD == "ALT" & AVISIT == "WEEK 2 DAY 15")

# Definition of boxplot boundaries and whiskers
five_num <- function(x, probs = c(0, 0.25, 0.5, 0.75, 1)) {
  r <- quantile(x, probs)
  names(r) <- c("ymin", "lower", "middle", "upper", "ymax")
  r
}

# get outliers based on quantile
# for outliers based on IQR see coef in geom_boxplot
get_outliers <- function(x, probs = c(0.05, 0.95)) {
  r <- subset(x, x < quantile(x, probs[1]) | quantile(x, probs[2]) < x)
  if (!is.null(x)) {
    x_names <- subset(names(x), x < quantile(x, probs[1]) | quantile(x, probs[2]) < x)
    names(r) <- x_names
  }
  r
}

# create theme used for all plots
theme_bp <- theme(
  plot.title = element_text(hjust = 0),
  plot.subtitle = element_text(hjust = 0),
  plot.caption = element_text(hjust = 0),
  panel.background = element_rect(fill = "white", color = "grey50")
)

# assign fill color and outline color
fc <- "#eaeef5"
oc <- getOption("ggplot2.discrete.fill")[1]

# get plot metadata data to derive coordinates for adding annotations
bp_annos <- function(bp, color, annos = 1) {
  bp_mdat <- ggplot_build(bp)$data[[1]]
  if (annos == 1) {
    bp <- bp +
      geom_segment(data = bp_mdat, aes(
        x = xmin + (xmax - xmin) / 4, xend = xmax - (xmax - xmin) / 4,
        y = ymax, yend = ymax
      ), linewidth = .5, color = color) +
      geom_segment(data = bp_mdat, aes(
        x = xmin + (xmax - xmin) / 4, xend = xmax - (xmax - xmin) / 4,
        y = ymin, yend = ymin
      ), linewidth = .5, color = color)
  } else {
    bp <- bp +
      geom_segment(data = bp_mdat, aes(
        x = xmin + (xmax - xmin) / 4, xend = xmax - (xmax - xmin) / 4,
        y = ymax, yend = ymax
      ), linewidth = .5, color = color) +
      geom_segment(data = bp_mdat, aes(
        x = xmin + (xmax - xmin) / 4, xend = xmax - (xmax - xmin) / 4,
        y = ymin, yend = ymin
      ), linewidth = .5, color = color) +
      geom_segment(data = bp_mdat, aes(
        x = xmin, xend = xmax,
        y = middle, yend = middle
      ), colour = color, linewidth = .5)
  }
  return(bp)
}
```

```{r include = FALSE}
webr_code_labels <- c("setup")
```

{{< include ../../_utils/webr_no_include.qmd >}}

## Output

:::::::::::: panel-tabset
## Standard Plot

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot1, test = list(plot_v1 = "plot")}
bp_1 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(geom = "boxplot", fun.data = five_num, fill = fc, color = oc) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the minimum and maximum values.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_1, oc)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot1")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Plot Changing <br/> Whiskers

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot2, test = list(plot_v2 = "plot")}
bp_3 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(
    geom = "boxplot", fun.data = five_num,
    fun.args = list(probs = c(0.05, 0.25, 0.5, 0.75, 0.95)), fill = fc, color = oc
  ) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the 5th and 95th percentile. Values outside the whiskers have not been plotted.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_3, oc)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot2")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Plot Adding <br/> Outliers

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot3, test = list(plot_v3 = "plot")}
bp_4 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(
    geom = "boxplot", fun.data = five_num,
    fun.args = list(probs = c(0.05, 0.25, 0.5, 0.75, 0.95)), fill = fc, color = oc
  ) +
  stat_summary(geom = "point", fun = get_outliers, shape = 1) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the 5th and 95th percentile.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_4, oc)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot3")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Plot Specifying Marker <br/> for Outliers and <br/> Adding Patient ID

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot4, test = list(plot_v4 = "plot")}
adlb_o <- adlb %>%
  group_by(ARMCD) %>%
  mutate(OUTLIER = AVAL < quantile(AVAL, 0.01) | AVAL > quantile(AVAL, 0.99)) %>%
  filter(OUTLIER == TRUE) %>%
  select(ARMCD, AVAL, USUBJID)
# Next step may be study-specific: shorten USUBJID to make annotation labels
# next 2 lines of code split USUBJID by "-" and take the last syllable as ID
n_split <- max(vapply(strsplit(adlb_o$USUBJID, "-"), length, numeric(1)))
adlb_o$ID <- vapply(strsplit(adlb_o$USUBJID, "-"), `[[`, n_split, FUN.VALUE = "a")

bp_5 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(
    geom = "boxplot", fun.data = five_num,
    fun.args = list(probs = c(0.01, 0.25, 0.5, 0.75, 0.99)), fill = fc, color = oc
  ) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  geom_point(data = adlb_o, aes(x = ARMCD, y = AVAL), shape = 1) +
  geom_text(data = adlb_o, aes(x = ARMCD, y = AVAL, label = ID), size = 3, hjust = -0.2) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the largest and smallest observed value within 1.5*IQR.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_5, oc)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot4")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Plot Specifying <br/> Marker for Mean

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot5, test = list(plot_v5 = "plot")}
bp_6 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  geom_boxplot(fill = fc, color = oc) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 5) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    caption = "The whiskers extend to the minimum and maximum values.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_6, oc)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot5")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Plot by Treatment <br/> and Timepoint

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot6, test = list(plot_v6 = "plot")}
adsl <- random.cdisc.data::cadsl
adlb <- random.cdisc.data::cadlb

adlb_v <- adlb %>%
  filter(PARAMCD == "ALT" & AVISIT %in% c("WEEK 1 DAY 8", "WEEK 2 DAY 15", "WEEK 3 DAY 22", "WEEK 4 DAY 29"))

bp_7 <- ggplot(adlb_v, aes(x = AVISIT, y = AVAL)) +
  stat_summary(
    geom = "boxplot",
    fun.data = five_num,
    position = position_dodge2(.5),
    aes(fill = ARMCD, color = ARMCD)
  ) +
  stat_summary(
    geom = "point",
    fun = mean,
    aes(group = ARMCD),
    size = 3,
    shape = 8,
    position = position_dodge2(1)
  ) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    caption = "The whiskers extend to the minimum and maximum values.",
    x = "Visit",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_7, oc, 2)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot6")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Plot by Timepoint <br/> and Treatment

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot7, test = list(plot_v7 = "plot")}
bp_8 <- ggplot(adlb_v, aes(x = ARMCD, y = AVAL)) +
  stat_summary(
    geom = "boxplot",
    fun.data = five_num,
    position = position_dodge2(width = .5),
    aes(fill = AVISIT, color = AVISIT)
  ) +
  stat_summary(
    geom = "point",
    fun = mean,
    aes(group = AVISIT),
    size = 3,
    shape = 8,
    position = position_dodge2(1)
  ) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    caption = "The whiskers extend to the minimum and maximum values.",
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

plot <- bp_annos(bp_8, oc, 2)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot7")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Plot with <br/> Table Section

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot8, test = list(plot_v8 = "plot")}
# Make wide dataset with summary statistics
adlb_wide <- adlb %>%
  group_by(ARMCD) %>%
  summarise(
    n = n(),
    mean = round(mean(AVAL), 1),
    median = round(median(AVAL), 1),
    median_ci = paste(round(DescTools::MedianCI(AVAL)[1:2], 1), collapse = " - "),
    q1_q3 = paste(round(quantile(AVAL, c(0.25, 0.75)), 1), collapse = " - "),
    min_max = paste0(round(min(AVAL), 1), "-", max(round(AVAL, 2)))
  )

# Make long dataset
adlb_long <- tidyr::gather(adlb_wide, key = type, value = stat, n:min_max)
adlb_long <- adlb_long %>% mutate(
  type_lbl = case_when(
    type == "n" ~ "n",
    type == "mean" ~ "Mean",
    type == "median" ~ "Median",
    type == "median_ci" ~ "95% CI for Median",
    type == "q1_q3" ~ "25% and 75%-ile",
    type == "min_max" ~ "Min - Max"
  )
)
adlb_long$type_lbl <- factor(adlb_long$type_lbl,
  levels = c("Min - Max", "25% and 75%-ile", "95% CI for Median", "Median", "Mean", "n")
)

bp_9 <- ggplot(adlb, aes(x = ARMCD, y = AVAL)) +
  stat_summary(geom = "boxplot", fun.data = five_num, fill = fc, color = oc) +
  stat_summary(geom = "point", fun = mean, size = 3, shape = 8) +
  labs(
    title = "Box Plot of Laboratory Test Results",
    subtitle = paste("Visit:", adlb$AVISIT[1]),
    x = "Treatment Group",
    y = paste0(adlb$PARAMCD[1], " (", adlb$AVALU[1], ")")
  ) +
  theme_bp

tbl_theme <- theme(
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  axis.ticks = element_blank(),
  axis.title = element_blank(),
  axis.text.y = element_text(face = "plain"),
  axis.text.x = element_blank()
)

tbl_1 <- ggplot(adlb_long, aes(x = ARMCD, y = type_lbl, label = stat), vjust = 10) +
  geom_text(size = 3) +
  scale_y_discrete(labels = levels(adlb_long$type_lbl)) +
  theme_bw() +
  tbl_theme +
  labs(caption = "The whiskers extend to the minimum and maximum values.") +
  theme_bp

plot <- cowplot::plot_grid(bp_annos(bp_9, oc), tbl_1,
  rel_heights = c(4, 2),
  ncol = 1, nrow = 2, align = "v"
)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot8")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Plot with Number of Patients <br/> only in Table Section

::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview

```{r plot9, test = list(plot_v9 = "plot")}
tbl_2 <- adlb_long %>%
  filter(type == "n") %>%
  ggplot(aes(x = ARMCD, y = type_lbl, label = stat)) +
  geom_text(size = 3) +
  scale_y_discrete(labels = "n") +
  theme_bw() +
  tbl_theme +
  labs(caption = "The whiskers extend to the minimum and maximum values.") +
  theme_bp

plot <- cowplot::plot_grid(bp_annos(bp_9, oc), tbl_2,
  rel_heights = c(6, 1),
  ncol = 1, nrow = 2, align = "v"
)
plot
```

```{r include = FALSE}
webr_code_labels <- c("plot9")
```

{{< include ../../_utils/webr.qmd >}}
:::

## Data Setup

```{r setup}
#| code-fold: show
```
::::::::::::

{{< include ../../_utils/save_results.qmd >}}

## `teal` App

::: {.panel-tabset .nav-justified}
## {{< fa regular file-lines fa-sm fa-fw >}} Preview

```{r teal, opts.label = c("skip_if_testing", "app"), eval = packageVersion("teal.modules.general") >= "0.3.0"}
library(teal.modules.general)

## Data reproducible code
data <- teal_data()
data <- within(data, {
  library(tern)

  ADSL <- random.cdisc.data::cadsl
  ADLB <- random.cdisc.data::cadlb

  # If PARAMCD and AVISIT are not factors, convert to factors
  # Also fill in missing values with "<Missing>"
  ADLB <- ADLB %>%
    df_explicit_na(
      omit_columns = setdiff(names(ADLB), c("PARAMCD", "AVISIT")),
      char_as_factor = TRUE
    )

  # If statment below fails, pre-process ADLB to be one record per
  # study, subject, param and visit eg. filter with ANLFL = 'Y'
  stopifnot(nrow(ADLB) == nrow(unique(ADLB[, c("STUDYID", "USUBJID", "PARAMCD", "AVISIT")])))
})
datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

## Reusable Configuration For Modules
ADSL <- data[["ADSL"]]
ADLB <- data[["ADLB"]]

## Setup App
app <- init(
  data = data,
  modules = modules(
    tm_g_bivariate(
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = names(ADSL),
          selected = "ARMCD",
          fixed = FALSE
        )
      ),
      y = data_extract_spec(
        dataname = "ADLB",
        filter = list(
          filter_spec(
            vars = c("PARAMCD"),
            choices = levels(ADLB$PARAMCD),
            selected = levels(ADLB$PARAMCD)[1],
            multiple = FALSE,
            label = "Choose lab parameter"
          ),
          filter_spec(
            vars = c("AVISIT"),
            choices = levels(ADLB$AVISIT),
            selected = levels(ADLB$AVISIT)[1],
            multiple = FALSE,
            label = "Choose visit"
          )
        ),
        select = select_spec(
          label = "Select variable:",
          choices = names(ADLB),
          selected = "AVAL",
          multiple = FALSE,
          fixed = TRUE
        )
      ),
      row_facet = data_extract_spec(
        dataname = "ADLB",
        select = select_spec(
          label = "Select variables:",
          choices = names(ADLB),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      col_facet = data_extract_spec(
        dataname = "ADLB",
        select = select_spec(
          label = "Select variables:",
          choices = names(ADLB),
          selected = NULL,
          multiple = FALSE,
          fixed = FALSE
        )
      )
    )
  )
)

shinyApp(app$ui, app$server)
```

{{< include ../../_utils/shinylive.qmd >}}
:::

{{< include ../../repro.qmd >}}

Made with ❤️ by the NEST Team

  • Edit this page
  • Report an issue
Cookie Preferences