Bioequivalence and Bioavailability Forum • modified code

modified code [🇷 for BE/BA]

posted by martin – Austria, 2008-10-16 14:29 (6445 d 14:13 ago) – Posting: # 2543
Views: 26,151

dear ace and yung-jin lee !

I suggest not to use the absolute value. please find below a new modification of the ace's code including some lines to prevent errors which I encountered in a simulation study (for strange PK profiles)

best regards


# function for selection of time points

tp <- function(dat){



   dat <- dat[order(dat$time),] # modification 



   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)) {

      check <- summary(lm(log(conc)~time,dat[i:nrow(dat),]))$adj.r.squared # modification

      if (!is.na(check) && (r.adj - check <(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]))) {

      check <- summary(lm(log(conc)~time,dat[i:nrow(dat),]))$adj.r.squared # modification

      if (!is.na(check) && (r.adj2 - check < (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)

   leedat <- dat[c((m+1):nrow(dat)),] 

   n_lee <- nrow(leedat)

   if(nrow(leedat) >= 5){

       l <- lee(conc=leedat$conc, time=leedat$time, method='ols', lt=FALSE, points=3)

       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(overview$AIC)] # modification



   #plot(l,log="y")

   print(overview)

   cat("n")

   return(c(TTT=n_TTT, last3=3, AIC=n_AIC, ARS=n_ARS,TTT_ARS=n_TTT_ARS,lee=n_lee))

}

Complete thread:

update: bear v1.1.4 for R (a free tool for ABE) yjlee168 2008-09-17 13:33 [🇷 for BE/BA]
- update: bear v1.1.4 for R (a free tool for ABE) Helmut 2008-09-17 16:59
  - update: bear v1.1.4 for R (a free tool for ABE) yjlee168 2008-09-17 21:03
- update: bear v1.1.4 for R (a free tool for ABE) martin 2008-09-19 13:13
  - update: bear v1.1.4 for R (a free tool for ABE) yjlee168 2008-09-22 18:19
  - update: bear v1.1.4 for R (a free tool for ABE) Helmut 2008-09-23 00:46
    - update: bear v1.1.4 for R (a free tool for ABE) martin 2008-09-27 09:37
      - Package lee for R Helmut 2008-09-27 14:05
  - update: bear v1.1.4 for R (a free tool for ABE) yjlee168 2008-09-23 10:07
    - update: bear v1.1.4 for R (a free tool for ABE) martin 2008-09-27 09:25
      - update: bear v1.1.4 for R (a free tool for ABE) yjlee168 2008-09-29 12:03
        
        update: bear v1.1.4 for R (a free tool for ABE) Helmut 2008-09-29 12:10
        
        update: bear v1.1.4 for R (a free tool for ABE) yjlee168 2008-09-29 13:07
        
        modified function for selection of time points martin 2008-10-11 15:30
        
        modified function for selection of time points yjlee168 2008-10-11 19:45
        
        last 3 time points martin 2008-10-12 00:04
        
        modified function for selection of time points yjlee168 2008-10-16 11:20
        
        modified function for selection of time points Aceto81 2008-10-16 12:09
        
        modified codemartin 2008-10-16 12:29
        
        modified code Aceto81 2008-10-16 14:11
        
        abs(AIC) martin 2008-10-16 15:03
        example martin 2008-10-16 20:02
        
        example Aceto81 2008-10-17 12:30