Helmut
★★★
avatar
Homepage
Vienna, Austria,
2013-07-22 21:14
(4297 d 05:49 ago)

Posting: # 11034
Views: 12,167
 

 ‘Automatic’ selection of time points for λz [🇷 for BE/BA]

Dear NCA-adepts!

Following these posts I decided to open a new thread in order to have more space.

I payed a closer look at package PK, function lee(). I think that we cannot use it directly, because the last two phases are fit simultaneously – which already might be interpreted as modeling by regulators.

I started with my model data set:
require(PK)
time <- c(0, 0.25, 0.5, 1, 1.5, 2, 2.5,
          3, 4, 6, 9, 12, 16, 24)
conc <- c(NA, 29.63, 46.07, 53.68, 52.75, 45.99, 40.24,
          34.87, 27.19, 17.59, 11.83, 7.39, 4.08, 2.75)
data0<- data.frame(time=time, conc=conc)
TTT  <- time[min(seq_along(data0$time)[data0$time >= data0$time[which.max(data0$conc)]*2])]
               # Ace’s one-liner (THX!)
               # http://forum.bebac.at/forum_entry.php?id=2548
data1<- subset(data0, data0$time >= TTT)
               # Post-absorption data only
ET   <- max(time) # t-last
meth <- c("ols", "lad", "hub", "npr")
               # Methods of lee()
ow   <- options("warn"); options(warn=-1)
BP   <- NULL; BPT <- NULL; lz <- NULL; t12 <- NULL
for(i in 1:4){ # Run all methods
  res <- lee(data1$conc, data1$time, method=meth[i])
  if(is.na(res$chgpt)) { # no distinct phases, fallback to TTT
    fit <- lm(log(data1$conc[data1$time >= TTT & data1$time <= ET])
              ~ data1$time[data1$time >= TTT & data1$time <= ET])
    BP <- c(BP, NA); BPT <- c(BPT, NA) # for completeness
    lz  <- c(lz, abs(as.numeric(fit$coeff[2])))
    t12 <- c(t12, log(2)/lz[i])
    cat(sprintf("%s%s%s %s %5.2f%s%5.2f %s%2i%s %s %6.5f %s %5.2f%s",
      "Lee meth. \u201c", meth[i], "\u201d one phase (TTT);",
      "interval:", TTT, "\u2013", ET,
      "(n=", length(time[time >= TTT]), ")",
      "\u03bbz:", lz[i], "(t\u00bd", t12[i], ")\n"))
  } else {
    BP  <- c(BP, as.numeric(res$chgpt))     # extract breakpoint
    BPT <- c(BPT, min(time[time >= BP[i]])) # time point which is at least BP
    fit <- lm(log(data1$conc[data1$time>=BPT[i] & data1$time <= ET])
              ~ data1$time[data1$time >= BPT[i] & data1$time <= ET])
    lz  <- c(lz, abs(as.numeric(fit$coeff[2])))
    t12 <- c(t12, log(2)/lz[i])
    cat(sprintf("%s%s%s %5.2f, %s %5.2f%s%5.2f %s%2i%s %s %6.5f %s %5.2f%s",
      "Lee meth. \u201c", meth[i], "\u201d BP:", BP[i],
      "prop. interval:", BPT[i], "\u2013", ET,
      "(n=", length(time[time >= BPT[i]]), ")",
      "\u03bbz:", lz[i], "(t\u00bd", t12[i], ")\n"))
  }
}
options(ow) # reset warnings


Giving
Lee meth. “ols” BP: 11.30, prop. interval: 12.00–24.00 (n= 3) λz: 0.07765 (t½  8.93)
Lee meth. “lad” BP:  8.42, prop. interval:  9.00–24.00 (n= 4) λz: 0.09496 (t½  7.30)
Lee meth. “hub” BP: 11.30, prop. interval: 12.00–24.00 (n= 3) λz: 0.07765 (t½  8.93)
Lee meth. “npr” BP:  7.26, prop. interval:  9.00–24.00 (n= 4) λz: 0.09496 (t½  7.30)

Segmented regression would pick the last four and my eye-balling the last three.

For this fantastic data set I got
Lee meth. “ols” BP: 11.71, prop. interval: 12.00–24.00 (n= 3) λz: 0.08660 (t½  8.00)
Lee meth. “lad” BP:  9.10, prop. interval: 10.00–24.00 (n= 4) λz: 0.10899 (t½  6.36)
Lee meth. “hub” BP: 11.71, prop. interval: 12.00–24.00 (n= 3) λz: 0.08660 (t½  8.00)
Lee meth. “npr” BP:  7.83, prop. interval:  8.00–24.00 (n= 5) λz: 0.12835 (t½  5.40)

Segmented regression and eye-balling the last three.

I rarely read TFM (last time when I beta-tested the package). So I calculated the intersection of the lines based on intercepts and slopes just to find out that there is this nice $chgpt already in the list…

What’s happening with a true one-compartment model (t½ 24)?
time <- c(0,0.25,0.5,1,2,3,4,5,7,9,11,15,19,25,33,42,55,72)
conc <- c(NA,28.95,53.06,76.26,91.02,92.12,90.49,84.41,78.29,
          73.56,70.20,61.69,55.04,52.04,40.05,26.32,20.13,14.78)


I got
Lee meth. “ols” BP: 10.67, prop. interval: 11.00–72.00 (n= 8) λz: 0.02668 (t½ 25.98)
Lee meth. “lad” BP: 17.98, prop. interval: 19.00–72.00 (n= 6) λz: 0.02657 (t½ 26.08)
Lee meth. “hub” one phase (TTT); interval:  7.00–72.00 (n=10) λz: 0.02680 (t½ 25.87)
Lee meth. “npr” BP: 10.63, prop. interval: 11.00–72.00 (n= 8) λz: 0.02668 (t½ 25.98)

Segmented regression tells me to get lost. By eye-balling I would have picked the last five – distracted be the random upshift at 24…

Interesting. With the exception of “hub” (Huber M regression) lee() “sees” two distinct phases, even if there is actually only one. TTT performs nicely with the lowest bias.

If you want to have a look behind the scenes, try:
res <- lee(data1$conc, data1$time, method="…")
plot(res, log="y", xlim=c(0, ET))
points(data0$time, data0$conc)


Anybody ready to run some sim’s? :-D

Dif-tor heh smusma 🖖🏼 Довге життя Україна! [image]
Helmut Schütz
[image]

The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes
Helmut
★★★
avatar
Homepage
Vienna, Austria,
2013-07-23 04:06
(4296 d 22:56 ago)

@ Helmut
Posting: # 11037
Views: 9,218
 

 New code

Dear all,

after some preliminary sim’s I think the most challenging part is not noise, but coping with lee’s greedy behavior – fitting two lines more often than necessary. If we feed lee’s greed we would loose many data points in monophasic profiles (compared to TTT and even more to R²adj). So the problem is: Dampen lee’s sensitivity but keep it high enough in order to pick true multiphasic profiles. New code (as a function for easier testing):

require(PK)
lambdaz <- function(time, conc, damp=NA, hl=NA, print=FALSE) {
  data0<- data.frame(time=time, conc=conc)
  TTT  <- time[min(seq_along(data0$time)[data0$time>=data0$time[which.max(data0$conc)]*2])]
                 # Ace’s ingenious one-liner (THX!)
                 # see http://forum.bebac.at/forum_entry.php?id=2548
  data1<- subset(data0, data0$time >= TTT)
                 # Post-absorption data only
  ET   <- max(time) # t-last
  meth <- c("ols", "lad", "hub", "npr")
                 # Methods of lee()
  ow   <- options("warn"); options(warn=-1)
  BP   <- NULL; BPT <- NULL; lz <- NULL; t12 <- NULL
  cat("\nFunction lee(), method:\n")
  for(j in 1:4) {# Run all methods
    res <- lee(data1$conc, data1$time, method=meth[j])
    t12.ratio <- res$parms[1, 2]/res$parms[1, 1]
    if(print) cat("Half live ratio (slow/fast):", round(t12.ratio, 2), "\n")
    ifelse(!is.na(damp) & t12.ratio < damp, esc <- "too close", esc <- "")
    if(is.na(res$chgpt) | esc == "too close") {
      # no distinct or too similar phases: fallback / force to TTT
      fit <- lm(log(data1$conc[data1$time >= TTT & data1$time <= ET])
                ~ data1$time[data1$time >= TTT & data1$time <= ET])
      BP <- c(BP, NA); BPT <- c(BPT, NA) # for completeness
      lz  <- c(lz, abs(as.numeric(fit$coeff[2])))
      t12 <- c(t12, log(2)/lz[j])
      if(is.na(res$chgpt)) {
        cat(sprintf("%s%s%s ", "\u201c", meth[j], "\u201d monophasic         (=> TTT):"))
      } else {
        cat(sprintf("%s%s%s ", "\u201c", meth[j], "\u201d two similar phases (=> TTT):"))
      }
      cat(sprintf("%5.2f%s%5.2f %s%2i%s %s %6.5f %s %5.2f",
        TTT, "\u2013", ET,
        "(n=", length(time[time >= TTT]), ")",
        "\u03bbz:", lz[j], "(t\u00bd", t12[j]))
    } else {
      BP  <- c(BP, as.numeric(res$chgpt))     # extract breakpoint
      BPT <- c(BPT, min(time[time >= BP[j]])) # time point which is at least BP
      fit <- lm(log(data1$conc[data1$time >= BPT[j] & data1$time <= ET])
                ~ data1$time[data1$time >= BPT[j] & data1$time <= ET])
      lz  <- c(lz, abs(as.numeric(fit$coeff[2])))
      t12 <- c(t12, log(2)/lz[j])
      cat(sprintf("%s%s%s %5.2f, %s %5.2f%s%5.2f %s%2i%s %s %6.5f %s %5.2f",
        "\u201c", meth[j], "\u201d breakpoint:", BP[j],
        "proposed:", BPT[j], "\u2013", ET,
        "(n=", length(time[time >= BPT[j]]), ")",
        "\u03bbz:", lz[j], "(t\u00bd", t12[j]))
    }
    if(is.na(hl)) {
      cat(sprintf("%s", ")\n"))
    } else {
      cat(sprintf(", %s %+4.2f%%%s", "RE", 100*(t12[j]-hl)/hl, ")\n"))
    }
  }
  options(ow) # reset warnings
}


Parameters:
  • damp defaults to NA. No dampening (also with damp=1) – allows lee() to fit two lines ad libitum. Higher values increase the threshold (i.e., ratios of half lives < damp will be forced to the simple TTT-method). Values between 1.5 and 2.5 are some reasonable starters.
  • hl defaults to NA. If you support a known half life (e.g., of simulated data), bias (as %RE) will be calculated.
  • print defaults to FALSE. Set to true to see half lives of the segments.
For the one-compartment data set of my last post I get with
lambdaz(time, conc, damp=1.5, hl=24, print=F)
Function lee(), method:
“ols” two similar phases (=> TTT):  7.00–72.00 (n=10) λz: 0.02680 (t½ 25.87, RE +7.78%)
“lad” two similar phases (=> TTT):  7.00–72.00 (n=10) λz: 0.02680 (t½ 25.87, RE +7.78%)
“hub” monophasic         (=> TTT):  7.00–72.00 (n=10) λz: 0.02680 (t½ 25.87, RE +7.78%)
“npr” two similar phases (=> TTT):  7.00–72.00 (n=10) λz: 0.02680 (t½ 25.87, RE +7.78%)

The ratios of half lives (with the exception of “hub”, which detected only one phase) are 1.17, 1.20, 1.22. We know from modeling that such small differences are simply impossible to detect with the full arsenal of PK software. In other words: lee’s ols/lad/npr-methods are crap. So a threshold of 1.5 was already very optimistic. Now for the good news: With the same threshold lee() would still detect two phases in the other two data sets.

Of course for a user this is not the way to go. In simulations we should try to find out a value which reliably distinguishes between mono- and multiphasic profiles. This could be the default in your future ‘semi-automatic’ method.

If you want to give it a try: Run lambdaz() and use the code from this post to simulate profiles. Change the relevant lines to:
n      <- 1       # no of sims
AErr   <- 0.15    # analytical error CV 15%, lognormal
curve(F.d*D/V.d*k01.d/(k01.d-k10.d)*(exp(-k10.d*(x-tlag.d))-exp(-k01.d*(x-tlag.d))),
      from=tlag.d, to=24, n=(24-tlag.d)*5+1, type="l", lwd=2, col="red", xlim=c(0,24),
      ylim=c(1,350), log="y", xlab="time", ylab="concentration", add=FALSE)
  for (j in 1:length(t)){
    if (j==1)
      AErr1 <- rtruncnorm(n=1, a=-3*abs(C[j]*AErr), b=+3*abs(C[j]*AErr),
                          mean=0, sd=abs(C[j]*AErr))

    else
      AErr1 <- c(AErr1, rtruncnorm(n=1, a=-3*abs(C[j]*AErr), b=+3*abs(C[j]*AErr),
                                   mean=0, sd=abs(C[j]*AErr)))

  }

Call lambdaz(t, C, damp=2, hl=log(2)/k10, print=FALSE)
Worked nicely with low bias until I increased the analytical error to 25%. Quite often I was kicked by:
Error in lee(data1$conc, data1$time, method = meth[j]) :
  not enough points for inital phase

Ah, the lag-time! Sometimes tmax is at 2.5 and TTT therefore at 5. Leaves only five data point for two phases (or just even four if the LLOQ hits). Since absorption starts at the lagtime, in such cases the subset should not start at 2×tmax, but rather at 2×tmax-tlag. Maybe tomorrow…

Dif-tor heh smusma 🖖🏼 Довге життя Україна! [image]
Helmut Schütz
[image]

The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes
Helmut
★★★
avatar
Homepage
Vienna, Austria,
2013-07-23 21:59
(4296 d 05:03 ago)

@ Helmut
Posting: # 11041
Views: 8,933
 

 TTT flawed in case of a lagtime…

Dear all,

TTT is the time of the inflection (tinpt) of the plasma profile (or the minimum of the first derivative = the root of the second derivative). If we have a lagtime, the inflection occurs not at 2×tmax but is shifted by tlag (if you don’t trust me, do some calculus yourself).*

Simple example (noise-free data, parameters of this post differing only in lagtimes – 0 and 2):
  t       C1      C2
  0       BQL     BQL
  0.25  29.917    BQL
  0.5   45.403    BQL
  1     54.577    BQL
  1.5   51.966    BQL
  2     46.228    BQL  ← tinpt1
  2.5   40.284  45.403
  3     35.007  54.577
  4     26.875  46.228 ← tinpt2
  6     17.454  26.875 ← picked by TTT-algo: not the inflection point!
  9     10.997  14.679
 12      7.716   9.702
 16      5.073   6.233
 24      2.268   2.771
 48      0.206   2.251
tlag     0       2     ← simple definition: time point before the first C ≥LLOQ
tmax     1       3
TTT      2       6
λz-range 2–48    6–48
λz       0.115   0.107 ← different estimates

tmax in green, tinpt in red.
Although true elimination is identical we get different estimates because in the second case tinpt is not at 6 but already at 4 (=2×tmax–tlag). Cinpt1=Cinpt2=46.228. Therefore, I suggest to introduce a »TTT’« which corrects for lagtimes and gives similar estimates:
TTT’     2       4
λz-range 2–48    4–48
λz       0.115   0.113 ← similar estimates


Theoretically AUC should be identical for both profiles (not affected by lagtimes), i.e., 75/0.5+25/0.1–100/2=350. Let’s compare estimated AUCs (by the lin-up/log-down trapezoidal rule):
based on TTT  AUC∞    367.19   371.15
              bias     +4.91%   +6.04%
              extrap    5.35%    6.98%
based on TTT’ AUC∞    367.19   369.88
              bias     +4.91%   +5.37%
              extrap    5.35%    6.66%

With the second algo bias is smaller and similar for both profiles.

This is not (only) academic nitpicking, but of practical interest. In the recent MR draft EMA considered the possibility of waiving the multiple dose study if the residual area in single dose (truncated at τ) is <10% of AUC. For the lagtime-profile we would get 7.48% (TTT) and 7.14% (TTT’).

Does anybody have a clever idea how I can find the lagtime in R without a loop? Essentially I would search backwards from tmax until I find the first NA.


  • Before you go crazy in curve sketching: The equations can be solved only for a one-compartment model (w/wo lagtime) in closed form. In R optimize() and deriv() is the way to go. If you want to take a sledgehammer to crack a nut: Get package numDeriv.

Dif-tor heh smusma 🖖🏼 Довге життя Україна! [image]
Helmut Schütz
[image]

The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes
martin
★★  

Austria,
2013-07-23 22:22
(4296 d 04:40 ago)

@ Helmut
Posting: # 11042
Views: 8,773
 

 TTT flawed in case of a lagtime…

dear helmut !

Wow; thank you for sharing the code - I will think about some extensive sims when I am back from vacation.

best regards

martin
ElMaestro
★★★

Denmark,
2013-07-24 00:35
(4296 d 02:28 ago)

@ Helmut
Posting: # 11043
Views: 8,837
 

 TTT flawed in case of a lagtime…

Hi Helmut,

❝ Does anybody have a clever idea how I can find the lagtime in R without a loop? Essentially I would search backwards from tmax until I find the first NA.


Not thoroughly tested, but if I get your drift, then here's something to consider:
time=c(1,2,3,4,5,6,7,8,9,10)
conc=c(NA,NA,NA,5,19,56, 53,46,40, NA)
data=data.frame(time, conc)

d1=subset(data, !(is.na(conc))) ##d1 now holds everything not NA
Tmax=subset(d1,  conc==max(d1[,2]))[1,1] ##records Tmax
d4=subset(data, (is.na(conc)) &(time<Tmax) ) ##takes all NA's observed until Tmax
Tlag=(subset(data, (is.na(conc))&&(time<Tmax)))[nrow(d4),1] ##Time of last observed NA before Tmax


Not thoroughly tested though :PCchaos:

Pass or fail!
ElMaestro
Helmut
★★★
avatar
Homepage
Vienna, Austria,
2013-07-24 03:04
(4295 d 23:58 ago)

@ ElMaestro
Posting: # 11044
Views: 8,815
 

 minimalistic R

Hi ElMaestro!

THX for the code and testing my visual acuity for the second time. :cool: R is an outstanding beast I will never master. What ’bout:

time <- c( 0,  1, 1.5, 2,  4,  5,  6,  7,  8,  9)
conc <- c(NA, NA,  NA, 5, 19, 56, 53, 46, 40, NA)
data <- data.frame(time, conc)
cat("Tmax =", data$time[which(data$conc == max(data$conc[complete.cases(data)]))],
    "\nTlag =", data$time[which.max(complete.cases(data))-1], "\n")

Dif-tor heh smusma 🖖🏼 Довге життя Україна! [image]
Helmut Schütz
[image]

The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes
ElMaestro
★★★

Denmark,
2013-07-24 12:49
(4295 d 14:13 ago)

@ Helmut
Posting: # 11046
Views: 8,763
 

 Wow, very efficicient

Hi Hötzi,

age taking its toll on your eyes:-D? Go visit the veterinarian.

I really like this:

cat("Tmax =", data$time[which(data$conc == max(data$conc[complete.cases(data)]))], "\nTlag =", data$time[which.max(complete.cases(data))-1], "\n")


- I had to read the online documentation to understand what which.max actually does.

I wonder, how would Tmax be defined in cases of e.g.
time <- c( 0,  1,  1.5,  2,  4,  5,  6,  7,  8,  9)
conc <- c(NA, NA, 0.01, NA, 19, 56, 53, 46, 40, NA)


- something like that is not entirely uncommon with OIPs, where the plasma levels are annoyingly low and some CROs are really spanking the 5500 (and manipulating the low QC integrations:angry:) in order to achieve the corresponding low LLOQs.

Pass or fail!
ElMaestro
Helmut
★★★
avatar
Homepage
Vienna, Austria,
2013-07-24 16:10
(4295 d 10:52 ago)

@ ElMaestro
Posting: # 11047
Views: 8,949
 

 R’s semantic riddles

Hi ElMaestro,

❝ age taking its toll on your eyes:-D? Go visit the veterinarian.


Sure. I’m a regular guest at my pet doctor. Where do you think I’m getting my pills from?

❝ -I had to read the online documentation to understand what which.max actually does.


Yeah, some of R’s functions are very efficient but difficult to comprehend. Martin once provided me with a framework full of lapply(), sweep(), aggregate(), simplify2array(), with(), etc. as a wrapper to functions used in sim’s. Speeded up the code at least 10fold. But: I read Cuneiform script more fluent than this gibberish.

In my code I use obscure one-liners only in sim’s where speed prevails over clarity.

❝ I wonder, how would Tmax be defined in cases of e.g.

time <- c( 0,  1,  1.5,  2,  4,  5,  6,  7,  8,  9)

conc <- c(NA, NA, 0.01, NA, 19, 56, 53, 46, 40, NA)


My code gives:
Tmax = 5
Tlag = 1
I’m happy with that. Or would you prefer to flag the 0.01 as crap and come up with a lagtime of 2? BTW, your code comes up with 1.5.

❝ - something like that is not entirely uncommon with OIPs, …


Not only with OIPs. We have discussed this issue occasionally (here and there).

❝ … some CROs are really spanking the 5500


Interesting hobby.

❝ … and manipulating the low QC integrations


They should not practice BDSM with their machines, but receive bastinado themselves. As a cap’tain you are familiar with the cat o’ nine tails. :pirate:


Edit: If time[1] is not given and no NAs occur before tmax, my code returns numeric(0), which cannot be used in further calculations.
  1. No lag-time, zero as NA:
    time <- c( 0, 1, 1.5, 2,  4,  5,  6,  7,  8,  9)
    conc <- c(NA, 1,   3, 5, 19, 56, 53, 46, 40, NA)
    data <- data.frame(time, conc)
    Tmax <- data$time[which(data$conc == max(data$conc[complete.cases(data)]))]
    Tlag <- data$time[which.max(complete.cases(data))-1] cat("Tmax =", Tmax, "\nTlag =", Tlag, "\n")
    Tmax = 5
    Tlag = 0

  2. No lag-time, zero time point not given:
    time <- c(1, 1.5, 2,  4,  5,  6,  7,  8,  9)
    conc <- c(1,   3, 5, 19, 56, 53, 46, 40, NA)
    data <- data.frame(time, conc)
    Tmax <- data$time[which(data$conc == max(data$conc[complete.cases(data)]))]
    Tlag <- data$time[which.max(complete.cases(data))-1] cat("Tmax =", Tmax, "\nTlag =", Tlag, "\n")
    Tmax = 5
    Tlag =

    Oops!
  3. As above + workaround:
    if(length(Tlag) == 0) Tlag <- 0
    cat("Tmax =", Tmax, "\nTlag =", Tlag, "\n")
    Tmax = 5
    Tlag = 0


Dif-tor heh smusma 🖖🏼 Довге життя Україна! [image]
Helmut Schütz
[image]

The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes
UA Flag
Activity
 Admin contact
23,424 posts in 4,927 threads, 1,669 registered users;
25 visitors (0 registered, 25 guests [including 2 identified bots]).
Forum time: 03:03 CEST (Europe/Vienna)

There are two possible outcomes: if the result confirms the
hypothesis, then you’ve made a measurement. If the result is
contrary to the hypothesis, then you’ve made a discovery.    Enrico Fermi

The Bioequivalence and Bioavailability Forum is hosted by
BEBAC Ing. Helmut Schütz
HTML5