In metrumresearchgroup/pmplots: Plots for Pharmacometrics

Setup and packages

knitr::opts_chunk$set(
  comment='.', message=FALSE, warning=FALSE,
  fig.path="img/pmplots_complete--",
  eval = !params$form_only,
  fig.width=4, fig.height=4
)

library(pmplots)
library(dplyr)
library(purrr)

\newpage

Example data in the package

df <- pmplots_data_obs() %>% mutate(CWRES = CWRESI)

id <- pmplots_data_id()

dayx <- defx(breaks = seq(0,168,24))

.yname <- "MRG1557 (ng/mL)"

etas <- c("ETA1//ETA-CL", "ETA2//ETA-V2", "ETA3//ETA-KA")

covs <- c("WT//Weight (kg)", "ALB//Albumin (g/dL)", "SCR//Creatinine (mg/dL)")

Override the df and id objects in the above chunk

## Nothing here

\newpage

col//title specification

This is a way to specify the column name for source data along with the axis label

col_label("CL//Clearance (L)")

When only the column is given, then the column name will be used for the column title:

col_label("WT")

Generate using the yspec package

You can also pull col//title data from a yspec object. Load the yspec package and generate an example data specification object

library(yspec)
spec <- ys_help$spec()

Typically, you'll want to select a subset of columns and then call axis_col_labs()

spec %>% 
  ys_select(WT, AGE, BMI) %>% 
  axis_col_labs()

\newpage

Fill in CWRES if it doesn't exist

dat <- mutate(df, CWRES = NULL)

cwresi_time(df)

cwres_time(dat)

\newpage

Observed vs predicted

Observed versus population predicted (dv_pred)

dv_pred(df, yname = .yname)

\newpage

Observed versus population predicted - log/log

dv_pred(df, loglog=TRUE, yname = .yname)

\newpage

Observed versus individual predicted (dv_ipred)

dv_ipred(df, yname=.yname)

\newpage

Observed versus individual predicted - log/log

dv_ipred(df, loglog=TRUE, yname = .yname)

\newpage

Observed versus both PRED and IPRED

dv_preds(df) %>% pm_grid(ncol=2)

\newpage

Residual plots

Residuals versus time (res_time)

res_time(df)

\newpage

Residuals versus time after first dose (res_tafd)

res_tafd(df)

\newpage

Residuals versus time after dose (res_tad)

res_tad(df)

\newpage

Residuals versus population predicted (res_pred)

res_pred(df)

\newpage

RES versus continuous covariate (res_cont)

res_cont(df, x="WT//Weight (kg)")

This function is also vectorized in x.

c("WT", "CRCL", "AST") %>% map(.f = partial(res_cont,df)) %>% pm_grid()

\newpage

RES by categorical covariate (res_cat)

dplyr::count(df, STUDYc)
res_cat(df, x="STUDYc//Study type")

\newpage

Residual histogram (res_hist)

res_hist(df)

\newpage

Weighted residuals

Weighted residuals versus time (wres_time)

wres_time(df) 

\newpage

Weighted residuals versus time after first dose (wres_tafd)

wres_tafd(df)

\newpage

Weighted residuals versus time after dose (wres_tad)

wres_tad(df)

\newpage

Weighted esiduals versus population predicted (wres_pred)

wres_pred(df)

\newpage

WRES versus continuous covariate (wres_cont)

This function is also vectorized in x.

wres_cont(df, x="WT//Weight (kg)")

\newpage

WRES by categorical covariate (wres_cat)

wres_cat(df, x="STUDYc//Study type")

\newpage

Weighted residual histogram (wres_hist)

wres_hist(df)

\newpage

WRES QQ plot (wres_q)

wres_q(df)

\newpage

Conditional weighted residuals (CWRES)

CWRES versus time (cwres_time)

cwres_time(df)

\newpage

Conditional weighted residuals versus time after first dose (cwres_tafd)

cwres_tafd(df)

\newpage

CWRES versus time after dose (cwres_tad)

cwres_tad(df)

\newpage

CWRES versus continuous covariate (cwres_cont)

cwres_cont(df, x="WT//Weight (kg)")

Vectorized version

cwres_cont(df, covs) %>%  pm_grid(ncol=2)

\newpage

CWRES by categorical covariate (cwres_cat)

cwres_cat(df, x="STUDYc//Study type")

cwres_cat(df, x="STUDYc//Study type", shown=FALSE)

Vectorized version

cwres_cat(df, x = c("STUDYc//Study", "RF//Renal Function"))

\newpage

Conditional weighted residual histogram (cwres_hist)

cwres_hist(df)

\newpage

CWRES versus population predicted (cwres_pred)

cwres_pred(df)

\newpage

CWRES QQ plot (cwres_q)

cwres_q(df)

\newpage

NPDE plots

NPDE versus TIME (npde_time)

npde_time(df)

\newpage

NPDE versus TAD (npde_tad)

npde_tad(df)

\newpage

NPDE versus TAFD (npde_tafd)

npde_tafd(df)

\newpage

NPDE versus PRED (npde_pred)

npde_pred(df)

\newpage

NPDE versus continuous variable (npde_cont)

npde_cont(df, "WT")

\newpage

NPDE versus categorical variable (npde_cat)

npde_cat(df, "STUDYc")

\newpage

QQ-plot with NPDE (npde_q)

npde_q(df)

\newpage

NPDE histogram (npde_hist)

npde_hist(df)

\newpage

ETA plots

etas <- c("ETA1//ETA-CL", "ETA2//ETA-V2", "ETA3//ETA-KA")
covs <- c("WT//Weight (kg)", "ALB//Albumin (g/dL)", "SCR//Creatinine (mg/dL)")

\newpage

ETA versus continuous covariates (eta_cont)

Grouped by eta

eta_cont(id, x=covs,y=etas[2]) %>% pm_grid()

Grouped by covariate

eta_cont(id, x=covs[1], y=etas) %>% pm_grid(ncol=2)

\newpage

ETA by categorical covariates (eta_cat)

p <- eta_cat(id, x="STUDYc//Study type", y=etas)

pm_grid(p)

\newpage

ETA histograms (eta_hist)

etas <- c("ETA1//ETA-CL", "ETA2//ETA-V2", "ETA3//ETA-KA")
p <- eta_hist(id,etas, bins=10)

pm_grid(p)

\newpage

ETA pairs plot (eta_pairs)

p <- eta_pairs(id, etas)

print(p)

\newpage

DV versus time (dv_time)

Basic plot

dv_time(df, yname = .yname)

\newpage

Faceted

dv_time(df, yname="MRG1557 (ng/mL)") + facet_wrap(~DOSE, scales="free_x")

NOTE this will not work as you expect; the labels are wrong.

cwres_cat(df, x = "STUDYc") + facet_wrap(~CPc)

The only way to get this right is

cwres_cat(df, x = "STUDYc", shown=FALSE) + facet_wrap(~CPc)

\newpage

log-Scale

dv_time(df, yname="MRG1557 (ng/mL)", log=TRUE) + facet_wrap(~STUDYc)

\newpage

DV-PRED-IPRED

• This returns a list of plots; we show only one here (the first 9 IDs) as an example

dd1 <- filter(df, ID <= 15)

dv_pred_ipred(dd1, nrow = 3, ncol = 3, ylab = "Concentration (ng/mL)", log_y=TRUE)

\newpage

Wrapped plots

Histogram

wrap_hist(df, x = c("WT", "ALB", "SCR"), scales = "free", bins=10, ncol=2)

\newpage

ETA versus continuous

wrap_eta_cont(df, y = "ETA1", x = c("WT", "ALB"), scales="free_x")

\newpage

Continuous on categorical

wrap_cont_cat(df, y = c("WT", "CRCL", "AAG"), x = "STUDYc", ncol = 2) 

Continuous on continuous

wrap_cont_cont(df, y = "CWRES" , x = c("WT", "CRCL", "AAG"), ncol = 2, scales="free_x") 

Residuals versus time

wrap_res_time(df, y = c("RES", "WRES", "CWRES"), ncol = 2, scales="free_y") 

\newpage

DV/PRED and DV/IPRED

wrap_dv_preds(df, ncol=1)

\newpage

Use labels in the strip

wrap_eta_cont(
  df, 
  y = "ETA1", 
  x = c("WT//Weight (kg)", "ALB//Albumin (g/dL)"),
  scales="free_x", 
  use_labels=TRUE
)

\newpage

Pairs plots

This is a simple wrapper around GGally::ggpairs with some customizations that have been developed internally at Metrum over the years.

pairs_plot(id, c("WT//Weight", "ALB//Albumin", "SCR//Serum creat"))

Customized lower triangle

Pass a function that customizes the scatter plots on the lower triangle. This function should accept a gg object and add a geom to it

my_lower <- function(p) {
  p + geom_point(aes(color = STUDYc)) + 
    geom_smooth(se = FALSE, color = "black")
}

pairs_plot(id, c("WT", "ALB"), lower_plot = my_lower)

\newpage

Vectorized plots

pm_scatter(df, x = "TIME", y = c("RES", "WRES", "CWRES"))

\newpage

Data summary

Continuous variable by categorical variable (cont_cat)

cont_cat(id, x="STUDYc", y="WT")

\newpage

General histogram (cont_hist)

cont_hist(id, x = "WT", bins = 20)

\newpage

Split and plot (split_plot)

p <- split_plot(df, sp="STUDYc", fun=dv_ipred)

pm_grid(p)

\newpage

Some customization

Latex (including Greek letters) in axis title

dv_pred(df, x = "PRED//Concentration ($\\mu$g)")

\newpage

Latex in pairs plot

data <- dplyr::tibble(m = rnorm(100), s = rnorm(100), n = rnorm(100))

x <- c("m//$\\mu$", "s//$\\sigma$", "n//$\\nu$")

pairs_plot(data,x)

Latex in wrapped plots

y <- c("WT//Weight (kg)", "BMI//BMI (kg/m$^2$)", "SCR//SCR (g/dL)")

wrap_cont_time(df, y = y, use_labels=TRUE)

Modify x-axis

a <- list(transform="log", breaks = logbr3())

dv_time(df, xs=a)

\newpage

Modify y-axis

dv_time(df, ys=a, yname="Y-axis name")

Flip coordinates when labels get cramped

If this is too cramped

cont_cat(
  id, 
  y = c("WT", "BMI", "ALB", "CRCL"), 
  x = "STUDYc"
) %>% pm_grid()

Try this

cont_cat(
  id, 
  y = c("WT", "BMI", "ALB", "CRCL"), 
  x = "STUDYc"
) %>% map(~.x+coord_flip()) %>% pm_grid()

Add layers

p <- ggplot(df, aes(PRED,DV))  + geom_point() + pm_theme()

\newpage

smooth

layer_s(p)

\newpage

abline

layer_a(p)

layer_h(cwres_time(df,add_layers=FALSE))

\newpage

Drop extra layers

dv_pred(df, smooth=NULL)

dv_pred(df, abline=NULL)

cwres_time(df, hline = NULL)

dv_pred(df, abline=NULL, smooth = NULL)

\newpage

Modify layer specs

For example, change the values of argument for geom_smooth

cwres_time(df, smooth = list(method = "loess", span = 0.1, se=TRUE))

Drop all extra layers

dv_pred(df, add_layers=FALSE)

\newpage

Custom breaks

Default breaks:

dv_time(df)

\newpage

Break every 3 days

dv_time(df, xby=72)

\newpage

Custom breaks and limits

a <- list(breaks = seq(0,240,48), limits=c(0,240))
dv_time(df, xs=a)

\newpage

Extra reference lines to [C]WRES plots

wres_time(df) + geom_3s()

\newpage

Replicate look and feel

p <- ggplot(df, aes(IPRED,DV)) + geom_point()

p

\newpage

Theme

p + pm_theme()

\newpage

Plain

p + theme_plain()

\newpage

Smooth

p + pm_smooth()

\newpage

Abline

p + pm_abline()

\newpage

Horizontal reference line

ggplot(df, aes(TIME,CWRES)) + geom_point() + pm_hline()

\newpage

Rotate x and y axis labels

Specify the angle

dv_pred(df) + rot_x(angle = 90) + rot_y()

\newpage

Rotate to vertical

We are typically rotating the tick labels on the x-axis and frequently it is convenient to ask for a totally vertical rendering

cwres_cat(df, x = "STUDYc") + 
  facet_wrap(~CPc) + rot_x(vertical = TRUE)

Standard axis titles

pm_axis_time()
pm_axis_tad()
pm_axis_tafd()
pm_axis_res()
pm_axis_wres()
pm_axis_cwres()
pm_axis_cwresi()
pm_axis_npde()
pm_axis_dv()
pm_axis_pred()
pm_axis_ipred()

\newpage

Log breaks

logbr3()

logbr()

metrumresearchgroup/pmplots documentation built on Oct. 15, 2024, noon