In bergsmat/yamlet: Versatile Curation of Table Metadata

knitr::opts_chunk$set(echo = FALSE)
knitr::opts_chunk$set(warning = FALSE)
knitr::opts_chunk$set(error = FALSE)
knitr::opts_chunk$set(message = FALSE)
knitr::opts_chunk$set(dev = c('png','pdf'))
knitr::opts_chunk$set(dpi = 600)
library(knitr)
library(magrittr)
library(dplyr)
library(tidyr)
library(wrangle)
library(ggplot2)
library(yamlet)
library(metaplot)
library(plotscale)

x <- io_csv('xanomeline-mod.csv', gz = TRUE)

x %<>% filter(cp > 1)
x %<>% ggready(parse = F)


x %<>% decorate('
#                   black      violet   blue       green
ACTARM: [color: ["#000000", "#AA00FF", "#144A90", "#4CB54F"]]
') 

x %<>% decorate('ACTARM: [shape: [0,4,1,3]]')

# x %>% decorations(ACTARM)

isoplot <- function(
    x, 
    endpoint, versus, 
    alpha = 0.5, 
    log = T, 
    trans = 'identity',
    ... 
  ){

  x %>%
    ggplot(aes(x = {{ versus }}, y = {{ endpoint }} )) +
    geom_abline(slope = 1, intercept = 0) +
    geom_point(alpha = alpha) + 
    theme_bw() +
    theme(aspect.ratio = 1) + 
    geom_smooth(method = 'lm', formula = 'y ~ x') +
    isometric()
}


isopair <- function(
    x, 
    endpoint1, 
    versus1, 
    endpoint2, 
    versus2, 
    alpha = 0.5, # can be length 2
    trans = 'identity',
    ...
  ){
  alpha = rep(alpha, 2)
  trans = rep(trans, 2)
  multiplot(
    isoplot(x, {{ endpoint1 }}, {{versus1}}, alpha = alpha[[1]], trans = trans[[1]], ...),
    isoplot(x, {{ endpoint2 }}, {{versus2}}, alpha = alpha[[2]], trans = trans[[2]], ...) 
  )
}


trendplot <- function(
    x, 
    endpoint, versus, 
    alpha = 0.5, 
    log = T, 
    trans = 'identity',
    ref = 0,
    aspect = 1,
    symmetric = FALSE,
    ... 
){
  trans <- rep(trans, 2)
  p <- x %>%
    ggplot(aes(x = {{ versus }}, y = {{ endpoint }} )) +
    geom_hline(yintercept = ref) +
    geom_point(alpha = alpha) + 
    theme_bw() +
    theme(aspect.ratio = aspect) + 
    geom_smooth(method = 'lm', formula = 'y ~ x') +
    scale_y_continuous(trans = trans[[1]]) +
    scale_x_continuous(trans = trans[[2]])
  if(symmetric) p <- p + symmetric()
  p
}

trendpair <- function(
    x, 
    endpoint1, 
    versus1, 
    endpoint2, 
    versus2, 
    alpha = 0.5, # can be length 2
    trans1 = 'identity',
    trans2 = 'identity',
    ref = 0,
    aspect = 1,
    ...
){
  alpha = rep(alpha, 2)
  trans1 = rep(trans1, 2)
  trans2 = rep(trans2, 2)
  ref = rep(ref, 2)
  aspect = rep(aspect, 2)
  multiplot(
    trendplot(x, {{ endpoint1 }}, {{versus1}}, alpha = alpha[[1]], trans = trans1, aspect = aspect[[1]], ref= ref[[1]], ...),
    trendplot(x, {{ endpoint2 }}, {{versus2}}, alpha = alpha[[2]], trans = trans2, aspect = aspect[[2]], ref= ref[[2]], ...) 
  )
}

Data Diagnostics

Observations vs Individual Predictions by Arm, per Visit

(

  x %>%
  modify(DV, title = sub('Plasma','Plasma\n',label)) %>%
  ggplot(
    aes(IPRED, DV, color = ACTARM, shape = ACTARM)
  ) + 
  geom_point(alpha = .5, size = 1.5) +
  facet_wrap(
    ~VISIT, 
    ncol = 3, 
    scales = 'free'
  ) +
  theme_bw() +
  theme(
    legend.position = 'top', 
    legend.title = element_blank()
  ) +
  geom_abline(aes(slope = 1, intercept = 0)) +
  isometric()

  ) # %>% devsize(1.5, 1.5,verbose = T)

Observations vs Individual Predictions by Arm and Visit, and for scales = 'free'

multiplot(
  x %>%
  ggplot(aes(IPRED, DV, color = ACTARM, shape = ACTARM)) + 
  geom_point(alpha = 0.3) +
  geom_abline(aes(slope = 1, intercept = 0)) +
  facet_grid(ACTARM ~ VISIT) +
  theme_bw() +
  theme(legend.position = 'none') +
  isometric(),
  x %>%
  ggplot(aes(IPRED, DV, color = ACTARM, shape = ACTARM)) + 
  geom_point(alpha = 0.3) +
  geom_abline(aes(slope = 1, intercept = 0)) +
  facet_grid(ACTARM ~ VISIT, scale = 'free') +
  theme_bw() +
  theme(legend.position = 'none') +
  isometric()

  ) # %>% devsize(1.5, 1.5,verbose = T)

Observations vs Individual Predictions

x %>% isoplot(DV, PRED)

Observations vs Individual Predictions, With/without Grids

multiplot(
x %>% isoplot(DV, PRED),
x %>% isoplot(DV, PRED) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
)

Observations vs Population Predictions, Log-log

x %>% isoplot(DV, PRED, trans = 'log10')

Observations vs Population and Individual Predictions

x %>% isopair(DV, PRED, DV, IPRED)

Observations vs Individual Predictions, Untransformed and Log-log

x %>% isopair(DV, IPRED, DV, IPRED, trans = c('identity','log10'))

Conditional Weighted Residuals vs Time

x %>% trendplot(CWRES, TIME) + symmetric() #%>% devsize(3,3,verbose = T)

Conditional Weighted Residuals vs Time, Untransformed and Log-log

x %>% trendpair(CWRES, TIME, CWRES, TIME, trans2 = c('identity', 'log10'), symmetric = TRUE)

Conditional Weighted Residuals vs Time, Full Grid vs Horizontal Grid

multiplot(
x %>% trendplot(CWRES, TIME)+ 
  scale_y_continuous(
    breaks = function(x)seq(
      from = round(x[[1]]), 
      to = round(x[[2]])
    )
  ) + 
  symmetric(),
x %>% trendplot(CWRES, TIME) + 
  theme(
    panel.grid.major.x = element_blank(), 
    panel.grid.minor.x = element_blank()
  )+ 
  scale_y_continuous(
    breaks = function(x)seq(
      from = round(x[[1]]), 
      to = round(x[[2]])
    )
  ) + symmetric()
)

Conditional Weighted Residuals vs Time, Various Horizontal Reference Lines

multiplot(
x %>% 
  trendplot(CWRES, TIME) + 
  geom_hline(yintercept = c(2,4,-2,-4), linetype = 'dashed') + 
  scale_y_continuous(
    breaks = function(x)seq(
      from = round(x[[1]]), 
      to = round(x[[2]])
    )
  ) + symmetric()
,
x %>% trendplot(CWRES, TIME) + 
  geom_hline(yintercept = c(2,5,-2,-5), linetype = 'dashed') + 
    scale_y_continuous(
    # breaks = function(x)seq(
    #   from = round(x[[1]]), 
    #   to = round(x[[2]])
    # )
  ) + symmetric()
)

Individual Plots

(
  x %>% 
  filter(desolve(ID) <= 1068) %>%
  mutate(Profile = as.factor(dosenum)) %>%
  ggplot(aes(x = TAD, group = dosenum)) +
  geom_point(
    aes(
      y = DV, 
      shape = Profile
    ),    
    alpha = 1, 
    color = "#144A90") + # blue
  geom_line(
    aes(y = PRED),  
    alpha = 1, 
    color = "#AA00FF" # violet
  ) + 
  geom_line(
    aes(y = IPRED), 
    alpha = 1, 
    color = "#4CB54F" # green
  ) + 
  theme_bw() +
  facet_wrap(~desolve(ID), ncol = 7) +
  theme(legend.position  = 'top')
)  #%>% devsize(1,1, verbose = T)

Individual Plots -- Detailed Panel Strip

(
  x %>% 
  filter(desolve(ID) <= 1029) %>%
  mutate(Profile = as.factor(dosenum)) %>%
  ggplot(aes(x = TAD, group = dosenum)) +
  geom_point(
    aes(
      y = DV, 
      shape = Profile
    ),    
    alpha = 1, 
    color = "#144A90") + # blue
  geom_line(
    aes(y = PRED),  
    alpha = 1, 
    color = "#AA00FF" # violet
  ) + 
  geom_line(
    aes(y = IPRED), 
    alpha = 1, 
    color = "#4CB54F" # green
  ) + 
  theme_bw() +
  facet_wrap(
    . ~'Study 01' + 
      ID + 
      gsub(
        'Xanomeline','',
        as.character(ACTARM)
      ) + 
      'Transdermal'
    , 
    labeller = label_value, 
    ncol = 7
  ) +
  theme(
    legend.position  = 'top'#, 
    #strip.background = element_rect(linetype = 'blank')
  )
) # %>% devsize(1,1, verbose = T)

Individual Plots -- Unscaled Panel Strip

p <- x %>% 
  filter(desolve(ID) <= 1029) %>%
  mutate(Profile = as.factor(dosenum)) %>%
  # mutate(STUDY = 'Study 01') %>%
  # mutate(ROUTE = 'Transdermal') %>%
  mutate(ACTARM = sub('Xanomeline','', ACTARM)) %>%
  ggplot(aes(x = TAD, group = dosenum)) +
  geom_point(aes(y = DV, shape = Profile),alpha = 1, color = "#144A90") +
  geom_line(aes(y = PRED), alpha = 1, color = "#AA00FF") + 
  geom_line(aes(y = IPRED), alpha = 1, color = "#4CB54F") + 
  theme_bw() + theme(legend.position  = 'top') +
  facet_wrap(
    . ~ paste('Study 01',ID,ACTARM,'Transdermal'),
    labeller = label_wrap_gen(10),
    ncol = 7
  )
p

Individual Plots -- Scaled Panel Strip

p + scale_striptext()

bergsmat/yamlet documentation built on Feb. 18, 2024, 5:50 a.m.