modified code [🇷 for BE/BA]
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
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) martin 2008-09-27 09:37
- 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
- modified codemartin 2008-10-16 12:29
- modified function for selection of time points Aceto81 2008-10-16 12:09
- modified function for selection of time points yjlee168 2008-10-11 19:45
- modified function for selection of time points martin 2008-10-11 15:30
- update: bear v1.1.4 for R (a free tool for ABE) yjlee168 2008-09-29 13:07
- 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 12:03
- 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) Helmut 2008-09-17 16:59