## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = FALSE)
requireNamespace("pmxTools")
library(PKNCA)
library(dplyr)
library(ggplot2)
library(tidyr)
library(purrr)
breaks_hours <- function(n=5, Q=c(1, 6, 4, 12, 2, 24, 168), ...) {
  n_default <- n
  Q_default <- Q
  function(x, n = n_default, Q=Q_default) {
    x <- x[is.finite(x)]
    if (length(x) == 0) {
      return(numeric())
    }
    rng <- range(x)
    labeling::extended(rng[1], rng[2], m=n, Q=Q, ...)
  }
}

scale_x_hours <- function(..., breaks=breaks_hours()) {
  ggplot2::scale_x_continuous(..., breaks=breaks)
}

## ----fig.width=6, fig.height=4------------------------------------------------
conc <-
  datasets::Theoph %>%
  filter(Subject %in% 1)
ggplot(conc, aes(x=Time, y=conc)) +
  geom_line() +
  scale_x_hours()

## -----------------------------------------------------------------------------
conc_data <-
  withr::with_seed(5, {
    data.frame(
      Subject=rep(1:2, each=6),
      Treatment=rep(c("A", "B", "A", "B"), each=3),
      Time=rep(c(0, 2, 8), 4),
      Conc=rep(c(0, 2, 0.5), 4)*exp(rnorm(n=12, sd=0.05))
    )
  })

## -----------------------------------------------------------------------------
pander::pander(conc_data %>% filter(Subject == 1))

## -----------------------------------------------------------------------------
pander::pander(conc_data %>% filter(Subject == 2))

## -----------------------------------------------------------------------------
dose_data <-
  data.frame(
    Subject=rep(1:2, each=2),
    Treatment=c("A", "B", "A", "B"),
    Time=0,
    Dose=10
  )

## -----------------------------------------------------------------------------
pander::pander(dose_data %>% filter(Subject == 1))

## -----------------------------------------------------------------------------
pander::pander(dose_data %>% filter(Subject == 2))

## ----echo=TRUE----------------------------------------------------------------
d_interval_1 <-
  data.frame(
    start=0, end=8,
    cmax=TRUE, tmax=TRUE, auclast=TRUE
  )

## -----------------------------------------------------------------------------
pander::pander(d_interval_1)

## ----echo=TRUE----------------------------------------------------------------
library(dplyr)
library(ggplot2)
library(tidyr)
library(purrr)
library(PKNCA)
# Concentration data setup
d_conc <-
  datasets::Theoph %>%
  filter(Subject %in% 1)
o_conc <- PKNCAconc(conc~Time, data=d_conc)
# Setup intervals for calculation
d_intervals <- data.frame(start=0, end=24, cmax=TRUE, tmax=TRUE,
                          auclast=TRUE, aucint.inf.obs=TRUE)
# Combine concentration and dose
o_data <- PKNCAdata(o_conc, intervals=d_intervals)
# Calculate the results (suppressMessages() hides a message that isn't needed now)
o_result <- suppressMessages(pk.nca(o_data))
# summary(o_result)

## ----echo=TRUE----------------------------------------------------------------
# Concentration data setup
d_conc <-
  datasets::Theoph %>%
  filter(Subject %in% 1)
o_conc <- PKNCAconc(conc~Time, data=d_conc)
# Dose data setup
d_dose <-
  datasets::Theoph %>%
  filter(Subject %in% 1) %>%
  filter(Time == 0)
o_dose <- PKNCAdose(Dose~Time, data=d_dose)
# Combine concentration and dose
o_data <- PKNCAdata(o_conc, o_dose)
# Calculate the results
o_result <- pk.nca(o_data)

## ----echo=TRUE----------------------------------------------------------------
# Load your dataset as a data.frame
d_conc <-
  datasets::Theoph %>%
  filter(Subject %in% 1)
# Take a look at the data
pander::pander(head(d_conc, 2))
# Define the PKNCAconc object indicating the concentration and time columns, the
# dataset, and any other options.
o_conc <- PKNCAconc(conc~Time, data=d_conc)

## ----echo=TRUE----------------------------------------------------------------
# Load your dataset as a data.frame
d_dose <-
  datasets::Theoph %>%
  filter(Subject %in% 1) %>%
  filter(Time == 0)
# Take a look at the data
pander::pander(d_dose)
# Define the PKNCAdose object indicating the dose amount and time columns, the
# dataset, and any other options.
o_dose <- PKNCAdose(Dose~Time, data=d_dose)

## ----echo=TRUE----------------------------------------------------------------
# Combine the PKNCAconc and PKNCAdose objects.  You can add interval
# specifications and calculation options here.
o_data <- PKNCAdata(o_conc, o_dose)
# Calculate the results
o_result <- pk.nca(o_data)

## ----echo=TRUE----------------------------------------------------------------
# Look at summarized results
pander::pander(summary(o_result))

## ----echo=TRUE----------------------------------------------------------------
# Look at individual results
pander::pander(head(
  as.data.frame(o_result),
  n=3
))

## ----interval-vs-groups-setup, echo=FALSE-------------------------------------
last_dose_time <- 24
dose_interval <- 8
dose_times <- seq(0, last_dose_time-dose_interval, by=dose_interval)
d_conc_superposition <-
  superposition(
    o_conc,
    dose.times=dose_times,
    tau=last_dose_time,
    check.blq=FALSE,
    n.tau=1
  )

## ----fig.width=4, fig.height=4------------------------------------------------
d_intervals <-
  tibble(
    start=dose_times,
    end=dose_times + dose_interval
  ) %>%
  mutate(
    name=sprintf("Interval %g", row_number()),
    height=max(d_conc_superposition$conc)*1.03,
    width=dose_interval,
    x=(start+end)/2,
    y=height/2
  )
d_interval_arrows <-
  d_conc_superposition %>%
  filter(time != 0 & time %in% dose_times) %>%
  mutate(
    name1=sprintf("Interval %g", row_number()),
    name2=sprintf("Interval %g", row_number() + 1),
  )
ggplot(d_conc_superposition, aes(x=time, y=conc)) +
  geom_tile(
    data=d_intervals,
    aes(x=x, y=y, width=width, height=height, colour=name, fill=name),
    alpha=0.2,
    inherit.aes=FALSE,
    show.legend=FALSE
  ) +
  geom_segment(
    data=d_interval_arrows,
    aes(x=time - 0.8, xend=time - 0.1, y=conc-2.1, yend=conc - 0.1, colour=name2),
    arrow=arrow(length=unit(0.1, "inches")),
    inherit.aes=FALSE,
    show.legend=FALSE
  ) +
  geom_segment(
    data=d_interval_arrows,
    aes(x=time + 0.8, xend=time + 0.1, y=conc-2.1, yend=conc - 0.1, colour=name1),
    arrow=arrow(length=unit(0.1, "inches")),
    inherit.aes=FALSE,
    show.legend=FALSE
  ) +
  geom_line() +
  geom_point() +
  scale_x_hours() +
  labs(
    title=sprintf("Dosing Q%gH", dose_interval)
  )

## -----------------------------------------------------------------------------
PKNCA.options("single.dose.aucs") %>%
  select(c(all_of(c("start", "end")), where(~is.logical(.x) && any(.x)))) %>%
  pander::pander()

## ----echo=TRUE----------------------------------------------------------------
d_conc <-
  datasets::Theoph %>%
  mutate(
    Treatment=
      case_when(
        Dose <= median(Dose)~"Low dose",
        TRUE~"High dose"
      )
  )
# The study was single-dose
d_dose <-
  d_conc %>%
  select(Treatment, Subject, Dose) %>%
  unique() %>%
  mutate(dose_time=0)

## ----echo=TRUE----------------------------------------------------------------
o_conc <- PKNCAconc(conc~Time|Treatment+Subject, data=d_conc)
try({
  o_data <- PKNCAdata(o_conc)
  summary(pk.nca(o_data))
})

## ----echo=TRUE----------------------------------------------------------------
o_conc <- PKNCAconc(conc~Time|Treatment+Subject, data=d_conc)
d_intervals <- data.frame(start=0, end=Inf, cmax=TRUE, tmax=TRUE,
                          half.life=TRUE, aucinf.obs=TRUE)
o_data_manual_intervals <- PKNCAdata(o_conc, intervals=d_intervals)
summary(pk.nca(o_data_manual_intervals))

## ----echo=TRUE----------------------------------------------------------------
o_conc <- PKNCAconc(conc~Time|Treatment+Subject, data=d_conc)
o_dose <- PKNCAdose(Dose~dose_time|Treatment+Subject, data=d_dose)
o_data_auto_intervals <- PKNCAdata(o_conc, o_dose)
o_data_auto_intervals$intervals$aucint.inf.obs <- TRUE
summary(pk.nca(o_data_auto_intervals))

## ----auc-considerations-setup, warning=FALSE----------------------------------
d_conc <-
  datasets::Theoph %>%
  filter(Subject == 1)
o_conc <- PKNCAconc(conc~Time, data=d_conc)
d_interval_int <- data.frame(start=0, end=Inf, half.life=TRUE)
o_data_int <- PKNCAdata(o_conc, intervals=d_interval_int)
o_nca_int <- suppressMessages(pk.nca(o_data_int))
lambda_z_int <-
  o_nca_int %>%
  as.data.frame() %>%
  filter(PPTESTCD %in% "lambda.z") %>%
  "[["("PPORRES")

d_interval_inf <- data.frame(start=0, end=24, half.life=TRUE)
o_data_inf <- PKNCAdata(o_conc, intervals=d_interval_inf)
o_nca_inf <- suppressMessages(pk.nca(o_data_inf))
lambda_z_inf <-
  o_nca_inf %>%
  as.data.frame() %>%
  filter(PPTESTCD %in% "lambda.z") %>%
  "[["("PPORRES")

tlast <- 
  o_nca_inf %>%
  as.data.frame() %>%
  filter(PPTESTCD %in% "tlast") %>%
  "[["("PPORRES")

d_auc_calcs <-
  d_conc %>%
  bind_rows(
    tibble(Time=seq(12, 60))
  ) %>%
  mutate(
    conc_all_int=
      interp.extrap.conc(
        conc=conc[!is.na(conc)],
        time=Time[!is.na(conc)],
        time.out=Time,
        lambda.z=lambda_z_int
      ),
    conc_all_inf=
      interp.extrap.conc(
        conc=conc[!is.na(conc) & Time <= 24],
        time=Time[!is.na(conc) & Time <= 24],
        time.out=Time,
        lambda.z=lambda_z_inf
      ),
    conc_last=
      case_when(
        Time <= 24~conc,
        TRUE~NA_real_
      ),
    conc_int=
      case_when(
        Time <= 24 & Time >= tlast~conc_all_int,
        TRUE~NA_real_
      ),
    conc_inf=
      case_when(
        Time >= tlast~conc_all_inf,
        TRUE~NA_real_
      )
  ) %>%
  arrange(Time)
auc_figure_time_max <- 36
p_auc_calcs <-
  ggplot(d_auc_calcs, aes(x=Time, y=conc)) +
  # AUCinf (with a work-around for https://github.com/tidyverse/ggplot2/issues/4661)
  geom_area(
    data=d_auc_calcs %>% filter(Time <= auc_figure_time_max),
    aes(y=conc_inf, colour="AUCinf", fill="AUCinf"),
    alpha=0.2,
    na.rm=TRUE
  ) +
  geom_line(
    data=d_auc_calcs,
    aes(y=conc_inf, colour="AUCinf"),
    na.rm=TRUE
  ) +
  # AUCint
  geom_area(
    aes(y=conc_int, colour="AUCint", fill="AUCint"),
    alpha=0.2,
    na.rm=TRUE
  ) +
  # AUClast
  geom_area(
    aes(y=conc_last, colour="AUClast", fill="AUClast"),
    na.rm=TRUE
  ) +
  geom_point(show.legend=FALSE,
    na.rm=TRUE) +
  geom_line(show.legend=FALSE,
    na.rm=TRUE) +
  geom_vline(xintercept=24, linetype="63") +
  scale_x_continuous(breaks=seq(0, auc_figure_time_max, by=6)) +
  coord_cartesian(xlim=c(0, auc_figure_time_max)) +
  labs(
    colour="AUC type",
    fill="AUC type"
  )

## ----warning=FALSE, out.width="100%"------------------------------------------
p_auc_calcs

## ----warning=FALSE, out.width="100%"------------------------------------------
p_auc_calcs

## ----warning=FALSE, out.width="100%"------------------------------------------
p_auc_calcs

## ----eval=FALSE, echo=TRUE----------------------------------------------------
# library(PKNCA)
# 
# d_conc <- read.csv("c:/tmp/whale_conc.csv")
# d_dose <- read.csv("c:/tmp/whale_dose.csv")
# head(d_conc)
# head(d_dose)
# 
# o_conc <- PKNCAconc(concentration~time|Animal, data=d_conc)
# o_dose <- PKNCAdose(dose~time|Animal, data=d_dose)
# o_data <- PKNCAdata(o_conc, o_dose)
# o_data$intervals
# o_nca <- pk.nca(o_data)
# summary(o_nca)
# summary(o_nca, drop.group=c())
# as.data.frame(o_nca)

## ----exclude-example-1, echo=TRUE---------------------------------------------
d_before_exclude <-
 data.frame(
  time=0:4,
  conc=c(0, 2, 1, 0.5, 0.25),
  not_this=c(NA, "Not this", rep(NA, 3))
 )
o_conc <-
 PKNCAconc(
  data=d_before_exclude,
  conc~time,
  exclude="not_this"
 )

## ----exclude-example-2, echo=TRUE---------------------------------------------
pander::pander(
  d_before_exclude %>%
    filter(is.na(not_this))
)

## ----echo=TRUE, eval=FALSE----------------------------------------------------
# o_conc <- PKNCAconc(data=d_before_exclude, conc~time, exclude="not_this")

## ----echo=TRUE----------------------------------------------------------------
d_urine <-
  data.frame(
    conc=c(1, 2, 3),
    urine_volume=c(200, 100, 300),
    time=c(1, 2, 3)
  )
o_conc <- PKNCAconc(data=d_urine, conc~time, volume="urine_volume")
d_intervals <- data.frame(start=0, end=24, ae=TRUE)
o_data <- PKNCAdata(o_conc, intervals=d_intervals)
o_nca <- suppressMessages(pk.nca(o_data))
summary(o_nca)

## ----echo=TRUE----------------------------------------------------------------
o_conc <- PKNCAconc(data=data.frame(conc=2^-(1:4), time=0:3), conc~time)
o_data <- PKNCAdata(o_conc, intervals=data.frame(start=0, end=Inf, cmax=TRUE))
o_nca <- suppressMessages(pk.nca(o_data))
as.data.frame(o_nca)

## ----echo=TRUE----------------------------------------------------------------
o_data <-
  PKNCAdata(
    o_conc,
    intervals=
      data.frame(
        start=0, end=Inf,
        aucinf.obs=TRUE
      )
  )
o_nca <- suppressMessages(pk.nca(o_data))

## ----echo=TRUE----------------------------------------------------------------
as.data.frame(o_nca)

## ----fig.height=3-------------------------------------------------------------
d_prep <-
  datasets::Theoph %>%
  filter(Subject == 1) %>%
  mutate(
    conc=
      case_when(
        Time == 0~0,
        TRUE~conc
      )
  )
d_plot <-
  superposition(
    conc=d_prep$conc,
    time=d_prep$Time,
    tau=48,
    n.tau=1,
    dose.times=24*(0:1)
  ) %>%
  # Pretend that we missed the predose sample
  filter(
    !between(time, 23, 24.5)
  )
# Pretend that there was a dose at 24
ggplot(d_plot, aes(x=time, y=conc)) +
  geom_point() + geom_line() +
  geom_vline(xintercept=24) +
  scale_x_hours()

## ----exclude-setup------------------------------------------------------------
o_conc <- PKNCAconc(data=data.frame(conc=2^-(1:4), time=0:3), conc~time)
o_data <-
  PKNCAdata(
    o_conc,
    intervals=
      data.frame(
        start=0, end=Inf,
        aucinf.obs=TRUE
      )
  )
o_nca <- suppressMessages(pk.nca(o_data))

## ----exclude-not-best, echo=TRUE----------------------------------------------
as.data.frame(o_nca) %>%
  filter(PPTESTCD != "half.life")

## ----exclude-best, echo=TRUE--------------------------------------------------
o_nca_excluded <-
  o_nca %>%
  exclude(FUN=exclude_nca_span.ratio(3))
as.data.frame(o_nca_excluded)

## ----echo=TRUE----------------------------------------------------------------
summary(o_nca)
summary(o_nca_excluded)

## ----echo=TRUE----------------------------------------------------------------
# Subject 2 is selected for a BLQ time=0 concentration
d_prep <-
  datasets::Theoph %>%
  filter(Subject == 2)
# Superposition to steady-state is the default
d_ss <-
  superposition(
    conc=d_prep$conc,
    time=d_prep$Time,
    tau=24
  )
# Going to steady-state is also an option
# (n.tau=2 means the second dose)
d_second_dose <-
  superposition(
    conc=d_prep$conc,
    time=d_prep$Time,
    tau=24,
    n.tau=2
  )

## ----echo=TRUE----------------------------------------------------------------
# Want the profile for the first two doses
# together?
d_first_two <-
  superposition(
    conc=d_prep$conc,
    time=d_prep$Time,
    tau=48, # 48 hours
    n.tau=1, # One tau interval (0 to 48 hours)
    dose.times=c(0, 24)
  )

## ----fig.height=3, fig.width=3------------------------------------------------
ggplot(d_ss, aes(x=time, y=conc)) +
  geom_point() + geom_line() +
  scale_y_continuous(limits=c(0, NA))

## ----echo=TRUE----------------------------------------------------------------
dose_times <- seq(0, 96-1, by=6)
d_multidose <-
  superposition(
    conc=d_prep$conc,
    time=d_prep$Time,
    tau=96, # 48 hours
    n.tau=1, # One tau interval (0 to 48 hours)
    dose.times=dose_times
  )
pk.tss.monoexponential(
  conc=d_multidose$conc, time=d_multidose$time, subject=rep(1, nrow(d_multidose)),
  time.dosing=dose_times, subject.dosing=rep(1, length(dose_times)),
  output="single"
)

## ----echo=TRUE----------------------------------------------------------------
o_conc <- PKNCAconc(conc~Time|Subject, data=datasets::Theoph)
d_plot <-
  grouped_df(data=datasets::Theoph, vars=names(getGroups(o_conc))) %>%
  nest() %>%
  mutate(
    figure=
      lapply(
        pmap(.l=list(data=data), .f=ggplot,aes(x=Time, y=conc)),
        FUN="+",
        geom_line()
      )
  )
# d_plot$figure

## ----echo=TRUE----------------------------------------------------------------
pander::pander(summary(o_nca))

## ----echo=TRUE, eval=FALSE----------------------------------------------------
# pander::pander(as.data.frame(o_nca))

## ----echo=TRUE----------------------------------------------------------------
d_conc <-
  datasets::Theoph %>%
  rename(time=Time) %>%
  mutate(
    Subject=as.character(Subject)
  )
d_multidose <-
  PKNCAconc(conc~time|Subject, data=d_conc) %>%
  superposition(tau=24, check.blq=FALSE)
d_singledose_single_analyte <-
  d_conc %>%
  mutate(
    Study_Part="Single"
  )
d_multidose_single_analyte <-
  d_conc %>%
  mutate(Day=1) %>%
  bind_rows(
    d_multidose %>% mutate(time=time + 120, Day=6)
  ) %>%
  mutate(
    Study_Part="Multiple"
  )

## ----echo=TRUE----------------------------------------------------------------
d_single_multi_conc <- bind_rows(d_singledose_single_analyte, d_multidose_single_analyte)
d_single_multi_dose <-
  d_single_multi_conc %>%
  filter(
    (Study_Part %in% "Single" & time == 0) |
      (Study_Part %in% "Multiple" & (time %% 24) == 0)
  )

## ----echo=TRUE----------------------------------------------------------------
o_conc <- PKNCAconc(data=d_single_multi_conc, conc~time|Study_Part+Subject)
o_dose <- PKNCAdose(data=d_single_multi_dose, Dose~time|Study_Part+Subject)
o_data <- PKNCAdata(o_conc, o_dose)
o_data$intervals %>% select(-Subject) %>% unique() %>% as.data.frame()
o_nca <- pk.nca(o_data)

## ----echo=TRUE----------------------------------------------------------------
d_intervals <-
  data.frame(
    start=0,
    end=24,
    Subject=c("1", "2"),
    Study_Part="Single",
    aucinf.obs=TRUE
  )
o_data <- PKNCAdata(o_conc, o_dose, intervals=d_intervals)
o_nca <- pk.nca(o_data)
summary(o_nca)

## ----echo=TRUE----------------------------------------------------------------
# Find the time closest to 12 hours
d_intervals_prep <-
  d_single_multi_conc %>%
  filter(Study_Part == "Single") %>%
  mutate(
    time_deviation=abs(time-12)
  ) %>%
  group_by(Subject, Study_Part) %>%
  filter(time %in% time[time_deviation == min(time_deviation)])
d_intervals <-
  d_intervals_prep %>%
  select(Study_Part, Subject, end=time) %>%
  mutate(
    start=0,
    aucinf.obs=TRUE
  )
o_data <- PKNCAdata(o_conc, o_dose, intervals=d_intervals)

o_nca <- pk.nca(o_data)
summary(o_nca, drop.group=c("Subject", "end"))

## ----echo=TRUE----------------------------------------------------------------
d_single_multi_conc_multi_analyte <-
  bind_rows(
    d_single_multi_conc %>% mutate(Analyte="Parent"),
    d_single_multi_conc %>%
      mutate(
        Analyte="Metabolite",
        conc=conc/2
      )
  )
o_conc <-
  PKNCAconc(
    data=d_single_multi_conc_multi_analyte,
    conc~time|Study_Part+Subject/Analyte
  )
o_dose <- PKNCAdose(data=d_single_multi_dose, Dose~time|Study_Part+Subject)
o_data <- PKNCAdata(o_conc, o_dose)
o_nca <- pk.nca(o_data)
summary(o_nca)

