‘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
I started with my model data set:
Giving
Segmented regression would pick the last four and my eye-balling the last three.
For this fantastic data set I got
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
What’s happening with a true one-compartment model (t½ 24)?
I got
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)
If you want to have a look behind the scenes, try:
Anybody ready to run some sim’s?
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?

—
Dif-tor heh smusma 🖖🏼 Довге життя Україна!![[image]](https://static.bebac.at/pics/Blue_and_yellow_ribbon_UA.png)
Helmut Schütz
![[image]](https://static.bebac.at/img/CC by.png)
The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes
Dif-tor heh smusma 🖖🏼 Довге життя Україна!
![[image]](https://static.bebac.at/pics/Blue_and_yellow_ribbon_UA.png)
Helmut Schütz
![[image]](https://static.bebac.at/img/CC by.png)
The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes
Complete thread:
- ‘Automatic’ selection of time points for λzHelmut 2013-07-22 19:14
- New code Helmut 2013-07-23 02:06
- TTT flawed in case of a lagtime… Helmut 2013-07-23 19:59
- TTT flawed in case of a lagtime… martin 2013-07-23 20:22
- TTT flawed in case of a lagtime… ElMaestro 2013-07-23 22:35
- minimalistic R Helmut 2013-07-24 01:04
- Wow, very efficicient ElMaestro 2013-07-24 10:49
- R’s semantic riddles Helmut 2013-07-24 14:10
- Wow, very efficicient ElMaestro 2013-07-24 10:49
- minimalistic R Helmut 2013-07-24 01:04
- TTT flawed in case of a lagtime… Helmut 2013-07-23 19:59
- New code Helmut 2013-07-23 02:06