modified function for selection of time points [🇷 for BE/BA]

posted by martin  – Austria, 2008-10-11 17:30 (5668 d 08:43 ago) – Posting: # 2514
Views: 18,497

dear yjlee168 !

please find enclosed the wonderful code from Aceto81 :ok: modified to use the lee method for extravascular administration. I added an option allowing to switch between fitting algorithms (lee.method; default='ols') and an option to choose including Cmax (default=FALSE) for selection of appropriate time points. you may find it useful.

best regards

martin

f <- function(dat, lee.method='ols', lee.cmax=FALSE){
   dat <- dat[order(dat$time),]    m <- which.max(dat$conc)
   f2 <-  function(m) return(cbind((nrow(dat)-m+1),abs(extractAIC(lm(log(conc)~time,dat[m:nrow(dat),])))[2],summary(lm(log(conc)~time,dat[m:nrow(dat),]))$adj.r.squared))
   overview <- as.data.frame(do.call(rbind,lapply((m+1):(nrow(dat)-2),f2)))
   names(overview) <- c("n","AIC","adjR2")
   n_ARS=0
   r.adj=0
   for (i in (nrow(dat)-2):(which.max(dat$conc)+1)) {
      if (r.adj - summary(lm(log(conc)~time,dat[i:nrow(dat),]))$adj.r.squared <(0.0001)) {
         n_ARS = nrow(dat)-i+1
         r.adj = summary(lm(log(conc)~time,dat[i:nrow(dat),]))$adj.r.squared
         }
   }   

   n_TTT_ARS=0
   r.adj2=0
   for (i in (nrow(dat)-2):(min(seq_along(dat$time)[dat$time>=dat$time[which.max(dat$conc)]*2]))) {
      if (r.adj2 - summary(lm(log(conc)~time,dat[i:nrow(dat),]))$adj.r.squared <(0.0001)) {
         n_TTT_ARS = nrow(dat)-i+1
         r.adj2 = summary(lm(log(conc)~time,dat[i:nrow(dat),]))$adj.r.squared
         }
   }   
   
   # start modification
   require(PK)
   start <- m+1 # default lee.cmax=FALSE: not including cmax for selection
   if(lee.cmax==TRUE){start <- m}  # inculding cmax for selection 
   leedat <- dat[c(start:nrow(dat)),] # select data
   l <- lee(conc=leedat$conc, time=leedat$time, method=lee.method, lt=FALSE)
   n_lee <- sum(dat$time> l$chgpt)
   if(is.na(n_lee)){n_lee <- nrow(leedat)}
   # end modification

   n_TTT <- sum(dat$time> (dat$time[which.max(dat$conc)]*2))
   n_AIC <- overview$n[which.min(abs(overview$AIC))]    plot(l,log="y")
   print(overview)
   cat("n")
   return(data.frame(TTT=n_TTT, AIC=n_AIC, ARS=n_ARS,TTT_ARS=n_TTT_ARS,lee=n_lee))
}
> b<-c(0,0.25,0.5,0.75,1,1.5,2,3,4,8,12,24)
> c<-c(0,36.1,125,567,963,1343,1739,1604,1460,797,383,72)
> dat <- data.frame(time=b,conc=c)

> f(dat, lee.cmax=FALSE)
  n      AIC     adjR2
1 5 25.53606 0.9972111
2 4 18.82088 0.9960696
3 3 12.91243 0.9929628
n  TTT AIC ARS TTT_ARS lee
1   3   3   5       4   5

> f(dat, lee.cmax=TRUE)
  n      AIC     adjR2
1 5 25.53606 0.9972111
2 4 18.82088 0.9960696
3 3 12.91243 0.9929628
n  TTT AIC ARS TTT_ARS lee
1   3   3   5       4   4


Complete thread:

UA Flag
Activity
 Admin contact
22,986 posts in 4,823 threads, 1,671 registered users;
75 visitors (0 registered, 75 guests [including 7 identified bots]).
Forum time: 02:13 CEST (Europe/Vienna)

The only way to comprehend what mathematicians mean by Infinity
is to contemplate the extent of human stupidity.    Voltaire

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