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

posted by martin  – Austria, 2008-10-11 17:30 (6043 d 12:09 ago) – Posting: # 2514
Views: 20,258

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
23,424 posts in 4,927 threads, 1,672 registered users;
29 visitors (0 registered, 29 guests [including 2 identified bots]).
Forum time: 05:39 CEST (Europe/Vienna)

The whole purpose of education is
to turn mirrors into windows.    Sydney J. Harris

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