4PL report update
This commit is contained in:
Guxa committed
1 parent
9861af5fba
commit
9422490f25
4 files changed
+337
-454
No files matched your search
+192
-191
@@ -90,198 +90,199 @@ You can also embed plots, for example:
|
||||
|
||||
```{r XLplot, echo=FALSE, warning=FALSE, fig.height=4, fig.width=6, fig.cap="Plot of models", fig.align='left'}
|
||||
|
||||
plot_f <- function(dat, sigmoid,det_sig) {
|
||||
CORdat <- cor(dat[,1],dat[,ncol(dat)])
|
||||
# plot_f <- function(dat, sigmoid,det_sig) {
|
||||
# CORdat <- cor(dat[,1],dat[,ncol(dat)])
|
||||
#
|
||||
# all_l <- melt(data.frame(dat), id.vars="log_dose", variable.name="replname", value.name = "readout")
|
||||
# isRef <- rep(c(1,0),1,each=nrow(all_l)/2)
|
||||
# isSample <- rep(c(0,1),1,each=nrow(all_l)/2)
|
||||
# all_l2 <- cbind(all_l, isRef, isSample)
|
||||
#
|
||||
# if(is.null(det_sig)) {
|
||||
# if (CORdat<0) {
|
||||
# startlist <- list(a=sigmoid[3], b=-sigmoid[5],cs=sigmoid[7],
|
||||
# d=sigmoid[1],r=sigmoid[8])
|
||||
# } else {
|
||||
# startlist <- list(a=sigmoid[3],b=sigmoid[5],cs=sigmoid[7],
|
||||
# d=sigmoid[1],r=sigmoid[8])
|
||||
# }
|
||||
# } else {
|
||||
# startlist <- list(a=det_sig[5], b=det_sig[1],cs=det_sig[7],
|
||||
# d=det_sig[3],r=det_sig[7] - det_sig[8])
|
||||
# }
|
||||
# #browser()
|
||||
# tryCatch({
|
||||
# mr <- gsl_nls(fn = readout ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
|
||||
# data=all_l2,
|
||||
# start=startlist,
|
||||
# control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6))
|
||||
# },
|
||||
# error = function(err) {
|
||||
# err$message
|
||||
# })
|
||||
# s_mr <- summary(mr)
|
||||
# a <- s_mr$coefficients[1,1]
|
||||
# b <- s_mr$coefficients[2,1]
|
||||
# cs <- s_mr$coefficients[3,1]
|
||||
# d <- s_mr$coefficients[4,1]
|
||||
# r <- s_mr$coefficients[5,1]
|
||||
#
|
||||
# log_dose <- unique(all_l$log_dose)
|
||||
# seq_x <- seq(min(log_dose),max(log_dose),0.1)
|
||||
# SAMPLE <- a+(d-a)/(1+exp(b*(seq_x-(cs-r))))
|
||||
# REF <- a+(d-a)/(1+exp(b*(seq_x-(cs))))
|
||||
#
|
||||
# if (is.null(det_sig)) {
|
||||
# SAMPLEtrue <- sigmoid[4] + (sigmoid[2] -sigmoid[4])/(1+exp(sigmoid[6]*(seq_x-(sigmoid[7]-sigmoid[8]))))
|
||||
# REFtrue <- sigmoid[3] + (sigmoid[1] -sigmoid[3])/(1+exp(sigmoid[5]*(seq_x-(sigmoid[7]))))
|
||||
# } else {
|
||||
# SAMPLEtrue <- det_sig[4] + (det_sig[6] -det_sig[4])/(1+exp(-det_sig[2]*(seq_x-(det_sig[8]))))
|
||||
# REFtrue <- det_sig[3] + (det_sig[5] -det_sig[3])/(1+exp(-det_sig[1]*(seq_x-(det_sig[7]))))
|
||||
# }
|
||||
#
|
||||
# pl_df <- cbind(seq_x, SAMPLE, REF, SAMPLEtrue, REFtrue)
|
||||
# all_l2$readout[all_l2$readout < 0] <- 0.01
|
||||
# all_l2$readouttrans <- log(all_l2$readout)
|
||||
# slopeEC50 <- b*(a-d)/4
|
||||
#
|
||||
# Xbendl3 <- cs-(1.31696/b)
|
||||
# Xbendu3 <- cs+(1.31696/b)
|
||||
# XbendlT <- cs-r-(1.31696/b)
|
||||
# XbenduT <- cs-r+(1.31696/b)
|
||||
# bendpoints <- c(bendREF_lower = round(Xbendl3,3), bendREF_upper=round(Xbendu3,3),
|
||||
# bendSAMPLE_lower = round(XbendlT,3), bendSAMPLE_upper=round(XbenduT,3))
|
||||
#
|
||||
# p <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
|
||||
# geom_point(shape=factor(isRef), alpha=0.8) +
|
||||
# labs(title = paste("restricted 4pl; bendp:", round(Xbendl3,3),round(Xbendu3,3),round(XbendlT,3),round(XbenduT,3)),
|
||||
# color="product") +
|
||||
# scale_color_manual(labels=c("test","reference"), values=c("red","blue")) +
|
||||
# scale_shape_manual(labels=c("test","reference")) +
|
||||
# theme_bw() +
|
||||
# theme(axis.text = element_text(size=14))
|
||||
#
|
||||
# p2 <- p + geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=SAMPLE), color="red",
|
||||
# inherit.aes = F) +
|
||||
# geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REF), color="blue",
|
||||
# inherit.aes = F) +
|
||||
# geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=SAMPLEtrue), color="red", linetype=2, alpha=0.4,
|
||||
# inherit.aes = F) +
|
||||
# geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REFtrue), color="blue", linetype=2, alpha=0.4,
|
||||
# inherit.aes = F) +
|
||||
# geom_vline(xintercept=c(Xbendl3, Xbendu3), col="blue",linetype=2) +
|
||||
# geom_vline(xintercept=c(XbendlT, XbenduT), col="red",linetype=2) +
|
||||
# annotate("text", x=cs, y=a+(d-a)/2, label="0", size=5) +
|
||||
# theme(legend.position="none")
|
||||
#
|
||||
#
|
||||
# # transformed plots
|
||||
# p_rt <- ggplot(all_l2, aes(x=log_dose, y=readouttrans, color=factor(isRef))) +
|
||||
# geom_point(shape=factor(isRef), alpha=0.8) +
|
||||
# labs(title = paste("restricted transformed 4pl"), color="product") +
|
||||
# scale_color_manual(labels=c("test","reference"), values=c("red","blue")) +
|
||||
# theme_bw()
|
||||
#
|
||||
# mrt <- gsl_nls(fn = readouttrans ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
|
||||
# data=all_l2,
|
||||
# start=startlist,
|
||||
# control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6))
|
||||
# s_mrt <- summary(mrt)
|
||||
# a_trans <- s_mrt$coefficients[1,1]
|
||||
# b_trans <- s_mrt$coefficients[2,1]
|
||||
# cs_trans <- s_mrt$coefficients[3,1]
|
||||
# d_trans <- s_mrt$coefficients[4,1]
|
||||
# r_trans <- s_mrt$coefficients[5,1]
|
||||
#
|
||||
# XbendlTrans <- cs_trans-(1.31696/b_trans)
|
||||
# XbenduTrans <- cs_trans+(1.31696/b_trans)
|
||||
# XbendlTransT <- cs_trans-r_trans-(1.31696/b_trans)
|
||||
# XbenduTransT <- cs_trans-r_trans+(1.31696/b_trans)
|
||||
# bendpointsTRANS <- c(bendREF_lower = round(XbendlTrans,3), bendREF_upper=round(XbenduTrans,3),
|
||||
# bendSAMPLE_lower = round(XbendlTransT,3), bendSAMPLE_upper=round(XbenduTransT,3))
|
||||
#
|
||||
# SAMPLEtrans <- a_trans+(d_trans-a_trans)/(1+exp(b_trans*(seq_x-(cs_trans-r_trans))))
|
||||
# REFtrans <- a_trans+(d_trans-a_trans)/(1+exp(b_trans*(seq_x-(cs_trans))))
|
||||
#
|
||||
# pl_df_trans <- cbind(seq_x, SAMPLEtrans, REFtrans)
|
||||
# p_rt2 <- p_rt + geom_line(data=as.data.frame(pl_df_trans), aes(x=seq_x, y=SAMPLEtrans), color="red",
|
||||
# inherit.aes = F) +
|
||||
# geom_line(data=as.data.frame(pl_df_trans), aes(x=seq_x, y=REFtrans), color="blue",
|
||||
# inherit.aes = F) +
|
||||
# geom_vline(xintercept=c(XbendlTrans, XbenduTrans), col="blue",linetype=2) +
|
||||
# geom_vline(xintercept=c(XbendlTransT, XbenduTransT), col="red",linetype=2) +
|
||||
# theme(legend.position = "none", axis.text=element_text(size=14))
|
||||
#
|
||||
# if (is.null(det_sig)) {
|
||||
# unrestr <- drm(readout ~ exp(log_dose), isSample, data=all_l2, fct=LL.4(),
|
||||
# pmodels=data.frame(isSample, isSample,isSample,isSample))
|
||||
# Sum_u <- summary(unrestr)
|
||||
# ast <- Sum_u$coefficients[3,1]
|
||||
# ate <- Sum_u$coefficients[4,1]
|
||||
# bst <- Sum_u$coefficients[1,1]
|
||||
# bte <- Sum_u$coefficients[2,1]
|
||||
# cst <- log(Sum_u$coefficients[7,1])
|
||||
# cte <- log(Sum_u$coefficients[8,1])
|
||||
# dst <- Sum_u$coefficients[5,1]
|
||||
# dte <- Sum_u$coefficients[6,1]
|
||||
# } else {
|
||||
# ast <- det_sig[5]
|
||||
# ate <- det_sig[6]
|
||||
# bst <- det_sig[1]
|
||||
# bte <- det_sig[2]
|
||||
# cst <- det_sig[7]
|
||||
# cte <- det_sig[8]
|
||||
# dst <- det_sig[3]
|
||||
# dte <- det_sig[4]
|
||||
# }
|
||||
# REFu <- ast + (dst-ast)/(1+exp(bst*(seq_x-cst)))
|
||||
# SAMPLEu <- ate + (dte-ate)/(1+exp(bte*(seq_x-cte)))
|
||||
# pl_df2 <- cbind(seq_x, SAMPLEu, REFu)
|
||||
# #browser()
|
||||
# pu <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
|
||||
# geom_point() +
|
||||
# labs(title="unrestricted 4_pl-Model", color="product") +
|
||||
# scale_color_manual(labels = c("test","reference"), values=c("red","blue")) +
|
||||
# theme_bw()
|
||||
# pu2 <- pu + geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=SAMPLEu),
|
||||
# color="red", inherit.aes = F) +
|
||||
# geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=REFu),
|
||||
# color="blue", inherit.aes = F,
|
||||
# show.legend = F)
|
||||
# pu2_ <- pu2 +
|
||||
# theme(legend.position = "none", axis.text = element_text(size=14))
|
||||
# putrans <- ggplot(all_l2, aes(x=log_dose, y=readouttrans, color=factor(isRef))) +
|
||||
# geom_point() +
|
||||
# labs(title="unrestricted transformed 4_pl-Model", color="product") +
|
||||
# scale_color_manual(labels = c("test","reference"), values=c("red","blue")) +
|
||||
# theme_bw()
|
||||
#
|
||||
# unrestr_trans <- drm(readouttrans ~ exp(log_dose), isSample, data=all_l2, fct=LL.4(),
|
||||
# pmodels=data.frame(isSample, isSample,isSample,isSample))
|
||||
# Sum_ut <- summary(unrestr_trans)
|
||||
# ast_t <- Sum_ut$coefficients[3,1]
|
||||
# ate_t <- Sum_ut$coefficients[4,1]
|
||||
# bst_t <- Sum_ut$coefficients[1,1]
|
||||
# bte_t <- Sum_ut$coefficients[2,1]
|
||||
# cst_t <- log(Sum_ut$coefficients[7,1])
|
||||
# cte_t <- log(Sum_ut$coefficients[8,1])
|
||||
# dst_t <- Sum_ut$coefficients[5,1]
|
||||
# dte_t <- Sum_ut$coefficients[6,1]
|
||||
#
|
||||
# REFu_trans <- ast_t + (dst_t-ast_t)/(1+exp(bst_t*(seq_x-cst_t)))
|
||||
# SAMPLEu_trans <- ate_t + (dte_t-ate_t)/(1+exp(bte_t*(seq_x-cte_t)))
|
||||
# pl_df2u_t <- cbind(seq_x, SAMPLEu_trans, REFu_trans)
|
||||
#
|
||||
# pu2_t <- putrans + geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=SAMPLEu_trans),
|
||||
# color="red", inherit.aes = F) +
|
||||
# geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=REFu_trans),
|
||||
# color="blue", inherit.aes = F,
|
||||
# show.legend = F)
|
||||
# pu3_t <- pu2_t
|
||||
# grid.arrange(p2,p_rt2,pu2_,pu3_t, nrow=2)
|
||||
# }
|
||||
#
|
||||
# plot_f(XLdat2, sigmoid=NULL, det_sig=coeffs)
|
||||
|
||||
all_l <- melt(data.frame(dat), id.vars="log_dose", variable.name="replname", value.name = "readout")
|
||||
isRef <- rep(c(1,0),1,each=nrow(all_l)/2)
|
||||
isSample <- rep(c(0,1),1,each=nrow(all_l)/2)
|
||||
all_l2 <- cbind(all_l, isRef, isSample)
|
||||
|
||||
if(is.null(det_sig)) {
|
||||
if (CORdat<0) {
|
||||
startlist <- list(a=sigmoid[3], b=-sigmoid[5],cs=sigmoid[7],
|
||||
d=sigmoid[1],r=sigmoid[8])
|
||||
} else {
|
||||
startlist <- list(a=sigmoid[3],b=sigmoid[5],cs=sigmoid[7],
|
||||
d=sigmoid[1],r=sigmoid[8])
|
||||
}
|
||||
} else {
|
||||
startlist <- list(a=det_sig[5], b=det_sig[1],cs=det_sig[7],
|
||||
d=det_sig[3],r=det_sig[7] - det_sig[8])
|
||||
}
|
||||
#browser()
|
||||
tryCatch({
|
||||
mr <- gsl_nls(fn = readout ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
|
||||
data=all_l2,
|
||||
start=startlist,
|
||||
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6))
|
||||
},
|
||||
error = function(err) {
|
||||
err$message
|
||||
})
|
||||
s_mr <- summary(mr)
|
||||
a <- s_mr$coefficients[1,1]
|
||||
b <- s_mr$coefficients[2,1]
|
||||
cs <- s_mr$coefficients[3,1]
|
||||
d <- s_mr$coefficients[4,1]
|
||||
r <- s_mr$coefficients[5,1]
|
||||
|
||||
log_dose <- unique(all_l$log_dose)
|
||||
seq_x <- seq(min(log_dose),max(log_dose),0.1)
|
||||
SAMPLE <- a+(d-a)/(1+exp(b*(seq_x-(cs-r))))
|
||||
REF <- a+(d-a)/(1+exp(b*(seq_x-(cs))))
|
||||
|
||||
if (is.null(det_sig)) {
|
||||
SAMPLEtrue <- sigmoid[4] + (sigmoid[2] -sigmoid[4])/(1+exp(sigmoid[6]*(seq_x-(sigmoid[7]-sigmoid[8]))))
|
||||
REFtrue <- sigmoid[3] + (sigmoid[1] -sigmoid[3])/(1+exp(sigmoid[5]*(seq_x-(sigmoid[7]))))
|
||||
} else {
|
||||
SAMPLEtrue <- det_sig[4] + (det_sig[6] -det_sig[4])/(1+exp(-det_sig[2]*(seq_x-(det_sig[8]))))
|
||||
REFtrue <- det_sig[3] + (det_sig[5] -det_sig[3])/(1+exp(-det_sig[1]*(seq_x-(det_sig[7]))))
|
||||
}
|
||||
|
||||
pl_df <- cbind(seq_x, SAMPLE, REF, SAMPLEtrue, REFtrue)
|
||||
all_l2$readout[all_l2$readout < 0] <- 0.01
|
||||
all_l2$readouttrans <- log(all_l2$readout)
|
||||
slopeEC50 <- b*(a-d)/4
|
||||
|
||||
Xbendl3 <- cs-(1.31696/b)
|
||||
Xbendu3 <- cs+(1.31696/b)
|
||||
XbendlT <- cs-r-(1.31696/b)
|
||||
XbenduT <- cs-r+(1.31696/b)
|
||||
bendpoints <- c(bendREF_lower = round(Xbendl3,3), bendREF_upper=round(Xbendu3,3),
|
||||
bendSAMPLE_lower = round(XbendlT,3), bendSAMPLE_upper=round(XbenduT,3))
|
||||
|
||||
p <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
|
||||
geom_point(shape=factor(isRef), alpha=0.8) +
|
||||
labs(title = paste("restricted 4pl; bendp:", round(Xbendl3,3),round(Xbendu3,3),round(XbendlT,3),round(XbenduT,3)),
|
||||
color="product") +
|
||||
scale_color_manual(labels=c("test","reference"), values=c("red","blue")) +
|
||||
scale_shape_manual(labels=c("test","reference")) +
|
||||
theme_bw() +
|
||||
theme(axis.text = element_text(size=14))
|
||||
|
||||
p2 <- p + geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=SAMPLE), color="red",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REF), color="blue",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=SAMPLEtrue), color="red", linetype=2, alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REFtrue), color="blue", linetype=2, alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_vline(xintercept=c(Xbendl3, Xbendu3), col="blue",linetype=2) +
|
||||
geom_vline(xintercept=c(XbendlT, XbenduT), col="red",linetype=2) +
|
||||
annotate("text", x=cs, y=a+(d-a)/2, label="0", size=5) +
|
||||
theme(legend.position="none")
|
||||
|
||||
|
||||
# transformed plots
|
||||
p_rt <- ggplot(all_l2, aes(x=log_dose, y=readouttrans, color=factor(isRef))) +
|
||||
geom_point(shape=factor(isRef), alpha=0.8) +
|
||||
labs(title = paste("restricted transformed 4pl"), color="product") +
|
||||
scale_color_manual(labels=c("test","reference"), values=c("red","blue")) +
|
||||
theme_bw()
|
||||
|
||||
mrt <- gsl_nls(fn = readouttrans ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
|
||||
data=all_l2,
|
||||
start=startlist,
|
||||
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6))
|
||||
s_mrt <- summary(mrt)
|
||||
a_trans <- s_mrt$coefficients[1,1]
|
||||
b_trans <- s_mrt$coefficients[2,1]
|
||||
cs_trans <- s_mrt$coefficients[3,1]
|
||||
d_trans <- s_mrt$coefficients[4,1]
|
||||
r_trans <- s_mrt$coefficients[5,1]
|
||||
|
||||
XbendlTrans <- cs_trans-(1.31696/b_trans)
|
||||
XbenduTrans <- cs_trans+(1.31696/b_trans)
|
||||
XbendlTransT <- cs_trans-r_trans-(1.31696/b_trans)
|
||||
XbenduTransT <- cs_trans-r_trans+(1.31696/b_trans)
|
||||
bendpointsTRANS <- c(bendREF_lower = round(XbendlTrans,3), bendREF_upper=round(XbenduTrans,3),
|
||||
bendSAMPLE_lower = round(XbendlTransT,3), bendSAMPLE_upper=round(XbenduTransT,3))
|
||||
|
||||
SAMPLEtrans <- a_trans+(d_trans-a_trans)/(1+exp(b_trans*(seq_x-(cs_trans-r_trans))))
|
||||
REFtrans <- a_trans+(d_trans-a_trans)/(1+exp(b_trans*(seq_x-(cs_trans))))
|
||||
|
||||
pl_df_trans <- cbind(seq_x, SAMPLEtrans, REFtrans)
|
||||
p_rt2 <- p_rt + geom_line(data=as.data.frame(pl_df_trans), aes(x=seq_x, y=SAMPLEtrans), color="red",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df_trans), aes(x=seq_x, y=REFtrans), color="blue",
|
||||
inherit.aes = F) +
|
||||
geom_vline(xintercept=c(XbendlTrans, XbenduTrans), col="blue",linetype=2) +
|
||||
geom_vline(xintercept=c(XbendlTransT, XbenduTransT), col="red",linetype=2) +
|
||||
theme(legend.position = "none", axis.text=element_text(size=14))
|
||||
|
||||
if (is.null(det_sig)) {
|
||||
unrestr <- drm(readout ~ exp(log_dose), isSample, data=all_l2, fct=LL.4(),
|
||||
pmodels=data.frame(isSample, isSample,isSample,isSample))
|
||||
Sum_u <- summary(unrestr)
|
||||
ast <- Sum_u$coefficients[3,1]
|
||||
ate <- Sum_u$coefficients[4,1]
|
||||
bst <- Sum_u$coefficients[1,1]
|
||||
bte <- Sum_u$coefficients[2,1]
|
||||
cst <- log(Sum_u$coefficients[7,1])
|
||||
cte <- log(Sum_u$coefficients[8,1])
|
||||
dst <- Sum_u$coefficients[5,1]
|
||||
dte <- Sum_u$coefficients[6,1]
|
||||
} else {
|
||||
ast <- det_sig[5]
|
||||
ate <- det_sig[6]
|
||||
bst <- det_sig[1]
|
||||
bte <- det_sig[2]
|
||||
cst <- det_sig[7]
|
||||
cte <- det_sig[8]
|
||||
dst <- det_sig[3]
|
||||
dte <- det_sig[4]
|
||||
}
|
||||
REFu <- ast + (dst-ast)/(1+exp(bst*(seq_x-cst)))
|
||||
SAMPLEu <- ate + (dte-ate)/(1+exp(bte*(seq_x-cte)))
|
||||
pl_df2 <- cbind(seq_x, SAMPLEu, REFu)
|
||||
#browser()
|
||||
pu <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
|
||||
geom_point() +
|
||||
labs(title="unrestricted 4_pl-Model", color="product") +
|
||||
scale_color_manual(labels = c("test","reference"), values=c("red","blue")) +
|
||||
theme_bw()
|
||||
pu2 <- pu + geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=SAMPLEu),
|
||||
color="red", inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=REFu),
|
||||
color="blue", inherit.aes = F,
|
||||
show.legend = F)
|
||||
pu2_ <- pu2 +
|
||||
theme(legend.position = "none", axis.text = element_text(size=14))
|
||||
putrans <- ggplot(all_l2, aes(x=log_dose, y=readouttrans, color=factor(isRef))) +
|
||||
geom_point() +
|
||||
labs(title="unrestricted transformed 4_pl-Model", color="product") +
|
||||
scale_color_manual(labels = c("test","reference"), values=c("red","blue")) +
|
||||
theme_bw()
|
||||
|
||||
unrestr_trans <- drm(readouttrans ~ exp(log_dose), isSample, data=all_l2, fct=LL.4(),
|
||||
pmodels=data.frame(isSample, isSample,isSample,isSample))
|
||||
Sum_ut <- summary(unrestr_trans)
|
||||
ast_t <- Sum_ut$coefficients[3,1]
|
||||
ate_t <- Sum_ut$coefficients[4,1]
|
||||
bst_t <- Sum_ut$coefficients[1,1]
|
||||
bte_t <- Sum_ut$coefficients[2,1]
|
||||
cst_t <- log(Sum_ut$coefficients[7,1])
|
||||
cte_t <- log(Sum_ut$coefficients[8,1])
|
||||
dst_t <- Sum_ut$coefficients[5,1]
|
||||
dte_t <- Sum_ut$coefficients[6,1]
|
||||
|
||||
REFu_trans <- ast_t + (dst_t-ast_t)/(1+exp(bst_t*(seq_x-cst_t)))
|
||||
SAMPLEu_trans <- ate_t + (dte_t-ate_t)/(1+exp(bte_t*(seq_x-cte_t)))
|
||||
pl_df2u_t <- cbind(seq_x, SAMPLEu_trans, REFu_trans)
|
||||
|
||||
pu2_t <- putrans + geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=SAMPLEu_trans),
|
||||
color="red", inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=REFu_trans),
|
||||
color="blue", inherit.aes = F,
|
||||
show.legend = F)
|
||||
pu3_t <- pu2_t
|
||||
grid.arrange(p2,p_rt2,pu2_,pu3_t, nrow=2)
|
||||
}
|
||||
|
||||
plot_f(XLdat2, sigmoid=NULL, det_sig=coeffs)
|
||||
|
||||
|
||||
```
|
||||
|
||||
+104
-237
@@ -42,6 +42,7 @@ knitr::opts_chunk$set(echo = TRUE)
|
||||
|
||||
library(knitr)
|
||||
library(DT)
|
||||
library(kableExtra)
|
||||
|
||||
REP <- params$REP
|
||||
author <- params$author
|
||||
@@ -49,13 +50,14 @@ coeffs <- params$coeffs
|
||||
|
||||
all_l <- REP$all_l
|
||||
ANOVAXLS <- REP$ANOVAXLS
|
||||
XLplot4pl <- REP$XLplot4pl
|
||||
DiagnTable <- REP$DiagnTable
|
||||
UnRPLAausw <- REP$UnRPLAausw
|
||||
UnRPLBend <- REP$UnRPLBend
|
||||
PLAausw <- REP$PLAausw
|
||||
PLBend <- REP$PLBend
|
||||
LogPLAausw <- REP$LogPLAausw
|
||||
LogUnrPLAausw <- REP$LogUnrPLAausw
|
||||
pottab4plXL <- REP$pottab4plXL
|
||||
Lim <- REP$Lim
|
||||
|
||||
XLdat2 <- REP$XLdat2
|
||||
|
||||
@@ -70,262 +72,144 @@ relpotTestPlot <- REP$relpotTestPlot
|
||||
|
||||
# Introduction
|
||||
|
||||
Bioassay potency estimation uses statistical methods to quantify the strength of a biological product or drug by comparing its response to that of a reference standard. Because biological responses are inherently variable, affected by assay conditions, cell systems or organisms, and measurement noise, the 4-parametric logistic regression is used to obtain reliable potency values. The variance for confidence interval calculation is coming from the regression procedure itself and is an excellent predictor for the variability of any future potency determinations.
|
||||
USP<1034> recommends calculation of standard errors of ratios of the parameters using Fieller's theorem [Finney D.J. 1978] or using the "delta" method (for a discussion about the "delta" method see [Ver Hoef 2012]). However, the presented gradient approach using the differences on the log-scale is methematically more stable und thus preferable compared to any ratio approach ([Franz, V.H. 2007]).
|
||||
Bioassay potency estimation uses statistical methods to quantify the strength of a biological product or drug by comparing its response to that of a reference standard. Because biological responses are inherently variable, affected by assay conditions, cell systems or organisms, and measurement noise, the 4-parametric logistic regression is used to obtain reliable potency values.
|
||||
USP<1034> recommends calculation of standard errors of ratios of the parameters using Fieller's theorem [Finney DJ 1978] or using the "delta" method (for a discussion about the "delta" method see [Ver Hoef 2012]). However, the presented gradient approach using the differences on the log-scale is mathematically more stable und thus preferable compared to a ratio approach ([Franz VH 2007]).
|
||||
|
||||
# Results
|
||||
# Raw data
|
||||
|
||||
All data used for the 4PL evaluation is shown in table 1:
|
||||
|
||||
```{r alll, echo=FALSE, warning=FALSE, results='asis'}
|
||||
|
||||
kable(all_l, format = "markdown", caption= "Uploaded data (test and reference) in long format", digits=3)
|
||||
kable(XLdat2, format = "markdown", caption= "Uploaded data (test and reference) ", digits=3)
|
||||
|
||||
```
|
||||
|
||||
The following 4 plots show all 4 models: restricted and unrestricted, and log transformed, respectively.
|
||||
|
||||
You can also embed plots, for example:
|
||||
# Results
|
||||
|
||||
```{r XLplot, echo=FALSE, warning=FALSE, fig.height=4, fig.width=6, fig.cap="Plot of models", fig.align='left'}
|
||||
## Overall result
|
||||
|
||||
plot_f <- function(dat, sigmoid,det_sig) {
|
||||
CORdat <- cor(dat[,1],dat[,ncol(dat)])
|
||||
```{r Over_all, echo=FALSE, comment=NA, warning=NA, message=NA}
|
||||
|
||||
all_l <- melt(data.frame(dat), id.vars="log_dose", variable.name="replname", value.name = "readout")
|
||||
isRef <- rep(c(1,0),1,each=nrow(all_l)/2)
|
||||
isSample <- rep(c(0,1),1,each=nrow(all_l)/2)
|
||||
all_l2 <- cbind(all_l, isRef, isSample)
|
||||
potFlag <- 0
|
||||
if (pottab4plXL["test_result"][[1]][1]==1) potFlag <- 1
|
||||
AnalysisFlag <- FALSE
|
||||
if (potFlag==1 | sum(testsTab$test_results)>0) AnalysisFlag <- TRUE
|
||||
|
||||
if(is.null(det_sig)) {
|
||||
if (CORdat<0) {
|
||||
startlist <- list(a=sigmoid[3], b=-sigmoid[5],cs=sigmoid[7],
|
||||
d=sigmoid[1],r=sigmoid[8])
|
||||
} else {
|
||||
startlist <- list(a=sigmoid[3],b=sigmoid[5],cs=sigmoid[7],
|
||||
d=sigmoid[1],r=sigmoid[8])
|
||||
}
|
||||
} else {
|
||||
startlist <- list(a=det_sig[5], b=det_sig[1],cs=det_sig[7],
|
||||
d=det_sig[3],r=det_sig[7] - det_sig[8])
|
||||
colFmt <- function() {
|
||||
|
||||
outputFormat <- knitr::opts_knit$get("rmarkdown.pandoc.to")
|
||||
if(AnalysisFlag) {
|
||||
text <- paste("\\textcolor{red}{Analysis failed}",sep="")
|
||||
} else {
|
||||
text <- paste("\\textcolor{black}{Analysis succeeded}>",sep="")
|
||||
}
|
||||
#browser()
|
||||
tryCatch({
|
||||
mr <- gsl_nls(fn = readout ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
|
||||
data=all_l2,
|
||||
start=startlist,
|
||||
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6))
|
||||
},
|
||||
error = function(err) {
|
||||
err$message
|
||||
})
|
||||
s_mr <- summary(mr)
|
||||
a <- s_mr$coefficients[1,1]
|
||||
b <- s_mr$coefficients[2,1]
|
||||
cs <- s_mr$coefficients[3,1]
|
||||
d <- s_mr$coefficients[4,1]
|
||||
r <- s_mr$coefficients[5,1]
|
||||
|
||||
log_dose <- unique(all_l$log_dose)
|
||||
seq_x <- seq(min(log_dose),max(log_dose),0.1)
|
||||
SAMPLE <- a+(d-a)/(1+exp(b*(seq_x-(cs-r))))
|
||||
REF <- a+(d-a)/(1+exp(b*(seq_x-(cs))))
|
||||
|
||||
if (is.null(det_sig)) {
|
||||
SAMPLEtrue <- sigmoid[4] + (sigmoid[2] -sigmoid[4])/(1+exp(sigmoid[6]*(seq_x-(sigmoid[7]-sigmoid[8]))))
|
||||
REFtrue <- sigmoid[3] + (sigmoid[1] -sigmoid[3])/(1+exp(sigmoid[5]*(seq_x-(sigmoid[7]))))
|
||||
} else {
|
||||
SAMPLEtrue <- det_sig[4] + (det_sig[6] -det_sig[4])/(1+exp(-det_sig[2]*(seq_x-(det_sig[8]))))
|
||||
REFtrue <- det_sig[3] + (det_sig[5] -det_sig[3])/(1+exp(-det_sig[1]*(seq_x-(det_sig[7]))))
|
||||
}
|
||||
|
||||
pl_df <- cbind(seq_x, SAMPLE, REF, SAMPLEtrue, REFtrue)
|
||||
all_l2$readout[all_l2$readout < 0] <- 0.01
|
||||
all_l2$readouttrans <- log(all_l2$readout)
|
||||
slopeEC50 <- b*(a-d)/4
|
||||
|
||||
Xbendl3 <- cs-(1.31696/b)
|
||||
Xbendu3 <- cs+(1.31696/b)
|
||||
XbendlT <- cs-r-(1.31696/b)
|
||||
XbenduT <- cs-r+(1.31696/b)
|
||||
bendpoints <- c(bendREF_lower = round(Xbendl3,3), bendREF_upper=round(Xbendu3,3),
|
||||
bendSAMPLE_lower = round(XbendlT,3), bendSAMPLE_upper=round(XbenduT,3))
|
||||
|
||||
p <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
|
||||
geom_point(shape=factor(isRef), alpha=0.8) +
|
||||
labs(title = paste("restricted 4pl; bendp:", round(Xbendl3,3),round(Xbendu3,3),round(XbendlT,3),round(XbenduT,3)),
|
||||
color="product") +
|
||||
scale_color_manual(labels=c("test","reference"), values=c("red","blue")) +
|
||||
scale_shape_manual(labels=c("test","reference")) +
|
||||
theme_bw() +
|
||||
theme(axis.text = element_text(size=14))
|
||||
|
||||
p2 <- p + geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=SAMPLE), color="red",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REF), color="blue",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=SAMPLEtrue), color="red", linetype=2, alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REFtrue), color="blue", linetype=2, alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_vline(xintercept=c(Xbendl3, Xbendu3), col="blue",linetype=2) +
|
||||
geom_vline(xintercept=c(XbendlT, XbenduT), col="red",linetype=2) +
|
||||
annotate("text", x=cs, y=a+(d-a)/2, label="0", size=5) +
|
||||
theme(legend.position="none")
|
||||
|
||||
|
||||
# transformed plots
|
||||
p_rt <- ggplot(all_l2, aes(x=log_dose, y=readouttrans, color=factor(isRef))) +
|
||||
geom_point(shape=factor(isRef), alpha=0.8) +
|
||||
labs(title = paste("restricted transformed 4pl"), color="product") +
|
||||
scale_color_manual(labels=c("test","reference"), values=c("red","blue")) +
|
||||
theme_bw()
|
||||
|
||||
mrt <- gsl_nls(fn = readouttrans ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
|
||||
data=all_l2,
|
||||
start=startlist,
|
||||
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6))
|
||||
s_mrt <- summary(mrt)
|
||||
a_trans <- s_mrt$coefficients[1,1]
|
||||
b_trans <- s_mrt$coefficients[2,1]
|
||||
cs_trans <- s_mrt$coefficients[3,1]
|
||||
d_trans <- s_mrt$coefficients[4,1]
|
||||
r_trans <- s_mrt$coefficients[5,1]
|
||||
|
||||
XbendlTrans <- cs_trans-(1.31696/b_trans)
|
||||
XbenduTrans <- cs_trans+(1.31696/b_trans)
|
||||
XbendlTransT <- cs_trans-r_trans-(1.31696/b_trans)
|
||||
XbenduTransT <- cs_trans-r_trans+(1.31696/b_trans)
|
||||
bendpointsTRANS <- c(bendREF_lower = round(XbendlTrans,3), bendREF_upper=round(XbenduTrans,3),
|
||||
bendSAMPLE_lower = round(XbendlTransT,3), bendSAMPLE_upper=round(XbenduTransT,3))
|
||||
|
||||
SAMPLEtrans <- a_trans+(d_trans-a_trans)/(1+exp(b_trans*(seq_x-(cs_trans-r_trans))))
|
||||
REFtrans <- a_trans+(d_trans-a_trans)/(1+exp(b_trans*(seq_x-(cs_trans))))
|
||||
|
||||
pl_df_trans <- cbind(seq_x, SAMPLEtrans, REFtrans)
|
||||
p_rt2 <- p_rt + geom_line(data=as.data.frame(pl_df_trans), aes(x=seq_x, y=SAMPLEtrans), color="red",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df_trans), aes(x=seq_x, y=REFtrans), color="blue",
|
||||
inherit.aes = F) +
|
||||
geom_vline(xintercept=c(XbendlTrans, XbenduTrans), col="blue",linetype=2) +
|
||||
geom_vline(xintercept=c(XbendlTransT, XbenduTransT), col="red",linetype=2) +
|
||||
theme(legend.position = "none", axis.text=element_text(size=14))
|
||||
|
||||
if (is.null(det_sig)) {
|
||||
unrestr <- drm(readout ~ exp(log_dose), isSample, data=all_l2, fct=LL.4(),
|
||||
pmodels=data.frame(isSample, isSample,isSample,isSample))
|
||||
Sum_u <- summary(unrestr)
|
||||
ast <- Sum_u$coefficients[3,1]
|
||||
ate <- Sum_u$coefficients[4,1]
|
||||
bst <- Sum_u$coefficients[1,1]
|
||||
bte <- Sum_u$coefficients[2,1]
|
||||
cst <- log(Sum_u$coefficients[7,1])
|
||||
cte <- log(Sum_u$coefficients[8,1])
|
||||
dst <- Sum_u$coefficients[5,1]
|
||||
dte <- Sum_u$coefficients[6,1]
|
||||
} else {
|
||||
ast <- det_sig[5]
|
||||
ate <- det_sig[6]
|
||||
bst <- det_sig[1]
|
||||
bte <- det_sig[2]
|
||||
cst <- det_sig[7]
|
||||
cte <- det_sig[8]
|
||||
dst <- det_sig[3]
|
||||
dte <- det_sig[4]
|
||||
}
|
||||
REFu <- ast + (dst-ast)/(1+exp(bst*(seq_x-cst)))
|
||||
SAMPLEu <- ate + (dte-ate)/(1+exp(bte*(seq_x-cte)))
|
||||
pl_df2 <- cbind(seq_x, SAMPLEu, REFu)
|
||||
#browser()
|
||||
pu <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
|
||||
geom_point() +
|
||||
labs(title="unrestricted 4_pl-Model", color="product") +
|
||||
scale_color_manual(labels = c("test","reference"), values=c("red","blue")) +
|
||||
theme_bw()
|
||||
pu2 <- pu + geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=SAMPLEu),
|
||||
color="red", inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=REFu),
|
||||
color="blue", inherit.aes = F,
|
||||
show.legend = F)
|
||||
pu2_ <- pu2 +
|
||||
theme(legend.position = "none", axis.text = element_text(size=14))
|
||||
putrans <- ggplot(all_l2, aes(x=log_dose, y=readouttrans, color=factor(isRef))) +
|
||||
geom_point() +
|
||||
labs(title="unrestricted transformed 4_pl-Model", color="product") +
|
||||
scale_color_manual(labels = c("test","reference"), values=c("red","blue")) +
|
||||
theme_bw()
|
||||
|
||||
unrestr_trans <- drm(readouttrans ~ exp(log_dose), isSample, data=all_l2, fct=LL.4(),
|
||||
pmodels=data.frame(isSample, isSample,isSample,isSample))
|
||||
Sum_ut <- summary(unrestr_trans)
|
||||
ast_t <- Sum_ut$coefficients[3,1]
|
||||
ate_t <- Sum_ut$coefficients[4,1]
|
||||
bst_t <- Sum_ut$coefficients[1,1]
|
||||
bte_t <- Sum_ut$coefficients[2,1]
|
||||
cst_t <- log(Sum_ut$coefficients[7,1])
|
||||
cte_t <- log(Sum_ut$coefficients[8,1])
|
||||
dst_t <- Sum_ut$coefficients[5,1]
|
||||
dte_t <- Sum_ut$coefficients[6,1]
|
||||
|
||||
REFu_trans <- ast_t + (dst_t-ast_t)/(1+exp(bst_t*(seq_x-cst_t)))
|
||||
SAMPLEu_trans <- ate_t + (dte_t-ate_t)/(1+exp(bte_t*(seq_x-cte_t)))
|
||||
pl_df2u_t <- cbind(seq_x, SAMPLEu_trans, REFu_trans)
|
||||
|
||||
pu2_t <- putrans + geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=SAMPLEu_trans),
|
||||
color="red", inherit.aes = F) +
|
||||
geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=REFu_trans),
|
||||
color="blue", inherit.aes = F,
|
||||
show.legend = F)
|
||||
pu3_t <- pu2_t
|
||||
grid.arrange(p2,p_rt2,pu2_,pu3_t, nrow=2)
|
||||
return(text)
|
||||
}
|
||||
|
||||
plot_f(XLdat2, sigmoid=NULL, det_sig=coeffs)
|
||||
|
||||
```
|
||||
|
||||
`r colFmt()`
|
||||
|
||||
|
||||
## 4pl-regression
|
||||
|
||||
Relative potency (absolute and relative confidence limits) are shown in Table 2:
|
||||
|
||||
```{r Pot_tab4pl, echo=FALSE, comment=NA, warning=NA, message=NA}
|
||||
|
||||
#browser()
|
||||
if (pottab4plXL["test_result"][[1]][1]==1) { cat(paste("FAILED: relative potency CL result of restricted model outside limits: ", Lim[[9]], "and" ,Lim[[10]] ))}
|
||||
kable(pottab4plXL, format = "markdown", caption= "Relative potency with absolute and relative CLs ", digits=3, row.names = F) %>%
|
||||
kable_styling(latex_options = "hold_position")
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
## Plot of the data and models
|
||||
|
||||
The following plots show the restricted and unrestricted model, respectively.
|
||||
|
||||
|
||||
```{r XLplot, echo=FALSE, warning=FALSE, fig.height=4, fig.width=6, fig.cap="Plot of models", fig.align='left', comment=F, message=F, results='asis', fig.pos='H'}
|
||||
|
||||
library(cowplot)
|
||||
|
||||
|
||||
plot_grid(XLplot4pl)
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
## ANOVA table
|
||||
|
||||
The ANOVA of the unconstrained model is listed in table 2:
|
||||
|
||||
```{r anovaxls, echo=FALSE, warning=FALSE, results='asis'}
|
||||
|
||||
kable(ANOVAXLS, format = "markdown", caption= "ANOVA table unrestricted", digits=3)
|
||||
kable(ANOVAXLS, format = "markdown", caption= "ANOVA table unrestricted", digits=3) %>%
|
||||
kable_styling(latex_options = "hold_position")
|
||||
|
||||
|
||||
```
|
||||
|
||||
## Analysis suitability tests
|
||||
|
||||
The following table lists the chosen suitabilit test results with confidence limits, where applicable:
|
||||
|
||||
|
||||
```{r SST_ergebn, echo=FALSE, cache=FALSE, warning=FALSE, message=FALSE, tidy=TRUE}
|
||||
|
||||
kable(testsTab, row.names = F, format = "markdown", caption="SST results")
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
```{r SST_ergebn, fig.align='center', fig.pos='htb!', echo=FALSE, cache=FALSE, warning=FALSE, message=FALSE, tidy=TRUE}
|
||||
\footnotesize
|
||||
|
||||
kable(testsTab[1:7,], row.names = F, format = "markdown", caption="SST results")
|
||||
```{r Fussnote, echo=F, comment=NA}
|
||||
|
||||
cat("*...The estimate for F-test on regression and on non-linearity is the p-value")
|
||||
cat( "F-test on regression passes if F-value > F-crit and thus p < 0.05")
|
||||
cat( "F-test on non-linearity passes if F-value < F-crit and thus p > 0.05")
|
||||
cat( "Test results outcome:")
|
||||
cat(" 0 ... test passed (for EQ tests: CL within limits);")
|
||||
cat(" 1 ... test failed (for EQ tests: CL not within limits);")
|
||||
|
||||
|
||||
|
||||
```
|
||||
|
||||
\normalsize
|
||||
|
||||
|
||||
```{r AST_Ergebn, echo=FALSE, cache=FALSE, warning=FALSE, message=FALSE, tidy=TRUE}
|
||||
|
||||
TestsTabFlag <- FALSE
|
||||
if (sum(testsTab$test_results)>0) TestsTabFlag <- TRUE
|
||||
colFmt2 <- function() {
|
||||
|
||||
outputFormat <- knitr::opts_knit$get("rmarkdown.pandoc.to")
|
||||
if(TestsTabFlag) {
|
||||
text <- paste("\\textcolor{red}{Analysis suitability tests failed}",sep="")
|
||||
} else {
|
||||
text <- paste("\\textcolor{black}{Analysis suitability tests succeeded}",sep="")
|
||||
}
|
||||
return(text)
|
||||
}
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
*...The estimate for F-test on regression and on non-linearity is the p-value
|
||||
F-test on regression passes if F-value > F-crit and thus p < 0.05
|
||||
F-test on non-linearity passes if F-value < F-crit and thus p > 0.05
|
||||
Test results outcome:
|
||||
|
||||
0 ... test passed (for EQ tests: CI within limits);
|
||||
|
||||
1 ... test failed (for EQ tests CI not within limits);
|
||||
|
||||
-1 ... calculations unbound/denominator too close to 0
|
||||
`r colFmt2()`
|
||||
|
||||
|
||||
<!-- ```{r, label= 'CIplot', echo=FALSE, warning=FALSE, fig.width=100, fig.cap='Selected SSt confidence intervals with entered limits', fig.align='center'} -->
|
||||
|
||||
<!-- png("CIplot.png") -->
|
||||
<!-- print(CIplot) -->
|
||||
<!-- dev.off() -->
|
||||
|
||||
|
||||
<!-- ``` -->
|
||||
|
||||
|
||||
<!-- {width=60%} -->
|
||||
|
||||
|
||||
## Fitting results of the 4 models with bend points
|
||||
@@ -377,23 +261,6 @@ kable(UnRPLBend, format = "markdown", caption= "Bend points of 4PL unrestricted"
|
||||
|
||||
|
||||
|
||||
```{r LogPLAausw, echo=FALSE, warning=FALSE, results='asis'}
|
||||
|
||||
kable(LogPLAausw, format = "markdown", caption= "Restricted 4PL evaluation with log-transformed response", digits=3)
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
|
||||
```{r LogUnRPLAausw, echo=FALSE, warning=FALSE, results='asis'}
|
||||
|
||||
kable(LogUnrPLAausw, format = "markdown", caption= "Unrestricted 4PL evaluation with log-transformed response", digits=3)
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
# Appendix: Formulas
|
||||
|
||||
## 4PL regression
|
||||
|
||||
@@ -49,3 +49,11 @@ expect_equal(TestTab, SolTab, check.attributes = FALSE)
|
||||
```
|
||||
|
||||
Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot.
|
||||
|
||||
|
||||
|
||||
``` {r}
|
||||
y<-1:4;mean(y)
|
||||
#> [1] 2.5
|
||||
```
|
||||
|
||||
@@ -776,7 +776,7 @@ server <- function(input, output, session) {
|
||||
REP$PLAausw <- PLAAusw
|
||||
REP$PLBend <- PLAAusw2
|
||||
|
||||
#### Koeffizienten-Extraktion ----
|
||||
#### Parameter extraktion ----
|
||||
logcoeffs_R <- SRlog$coefficients[, 1] # logpot$coefficients
|
||||
names(logcoeffs_R) <- c("lower A", "Hill's slope", "upper A", "EC50 REF","EC50 DIFF")
|
||||
|
||||
@@ -818,9 +818,13 @@ server <- function(input, output, session) {
|
||||
if (exists("Ind")) {
|
||||
Dat$dilution <- XLdat[,Ind]
|
||||
} else Dat$dilution <- exp(XLdat[,logI])
|
||||
# --- Plot-Ausgabe ---
|
||||
|
||||
##### Plot XL 4PL ----
|
||||
output$XLplot <- renderPlot({
|
||||
plot_f(XLdat2, TransFlag=F)
|
||||
XLplot4pl <- plot_f(XLdat2, TransFlag=F)
|
||||
REP$XLplot4pl <- XLplot4pl
|
||||
|
||||
XLplot4pl
|
||||
})
|
||||
|
||||
REP$XLdat2 <- XLdat2
|
||||
@@ -1140,9 +1144,10 @@ server <- function(input, output, session) {
|
||||
tab <- tests_FUNC(Dat$EXCEL, Limite, PureErrFlag = PureErrFlag)
|
||||
|
||||
tab[1,6:7] <- c("-","-")
|
||||
Dat$tests_FUNC <- tab
|
||||
REP$testsTab <- tab
|
||||
|
||||
tab2 <- tab[SelTests,]
|
||||
Dat$tests_FUNC <- tab2
|
||||
REP$testsTab <- tab2
|
||||
|
||||
dat <- datatable(tab2,options = list(
|
||||
paging=TRUE,
|
||||
@@ -1158,26 +1163,26 @@ server <- function(input, output, session) {
|
||||
}) # observe
|
||||
|
||||
#### plot CIs XL----
|
||||
observe({
|
||||
tab <- Dat$tests_FUNC
|
||||
if (is.null(tab)) return(NULL)
|
||||
|
||||
tab2 <- tab[-c(1,2,3,6),]
|
||||
tab2[,3:7] <- apply(tab2[,3:7],2,as.numeric)
|
||||
tab2[4:5,3:7] <- tab2[4:5,3:7]/100
|
||||
|
||||
p_CIs <- ggplot(tab2,aes(x=test,y=estimate, color=test,group=test)) +
|
||||
geom_point() +
|
||||
geom_errorbar(aes(ymin=lower_CI, ymax=upper_CI), width=0.4) +
|
||||
geom_crossbar(aes(ymin=lower_limit, ymax=upper_limit), size=0.8) +
|
||||
coord_flip() +
|
||||
theme_bw() +
|
||||
theme(legend.position = "none",text = element_text(size=20))
|
||||
|
||||
output$CIplot <- renderPlot({ p_CIs}, height=200)
|
||||
|
||||
REP$CIplot <- p_CIs
|
||||
})
|
||||
# observe({
|
||||
# tab <- Dat$tests_FUNC
|
||||
# if (is.null(tab)) return(NULL)
|
||||
#
|
||||
# tab2 <- tab[-c(1,2,3,6),]
|
||||
# tab2[,3:ncol(tab2)] <- apply(tab2[,3:ncol(tab2)],2,as.numeric)
|
||||
# tab2[4:5,3:7] <- tab2[4:5,3:7]/100
|
||||
#
|
||||
# p_CIs <- ggplot(tab2,aes(x=test,y=estimate, color=test,group=test)) +
|
||||
# geom_point() +
|
||||
# geom_errorbar(aes(ymin=lower_CI, ymax=upper_CI), width=0.4) +
|
||||
# geom_crossbar(aes(ymin=lower_limit, ymax=upper_limit), size=0.8) +
|
||||
# coord_flip() +
|
||||
# theme_bw() +
|
||||
# theme(legend.position = "none",text = element_text(size=20))
|
||||
#
|
||||
# output$CIplot <- renderPlot({ p_CIs}, height=200)
|
||||
#
|
||||
# REP$CIplot <- p_CIs
|
||||
# })
|
||||
|
||||
#### simulated data tab Meta ----
|
||||
output$simdat <- DT::renderDataTable({
|
||||
@@ -1643,7 +1648,7 @@ server <- function(input, output, session) {
|
||||
as.numeric(input$lEACratioSlope), as.numeric(input$uEACratioSlope),
|
||||
as.numeric(input$lEACratioua), as.numeric(input$uEACratioua),
|
||||
as.numeric(input$lowerPot), as.numeric(input$upperPot))
|
||||
|
||||
REP$Lim <- Lim
|
||||
|
||||
pottab4_ <- data.frame(pottab4)
|
||||
pottab4_$potency <- round(as.numeric(pottab4[,2])*100,1)
|
||||
@@ -1667,6 +1672,8 @@ server <- function(input, output, session) {
|
||||
pottab4_ <- cbind(pottab4_[,-(2:4)], data.frame(tests=c(test_potCI, test_potUCI,test_potCI_t,test_potUCI_t)))
|
||||
colnames(pottab4_) <- c("model","potency","lower95%CI","upper95%CI","relative_lower95%CI","relative_upper95%CI","test_result")
|
||||
|
||||
REP$pottab4plXL <- pottab4_[1:2,]
|
||||
|
||||
output$pottab4plXL <- DT::renderDataTable({
|
||||
dat <- datatable(pottab4_[1:2,],
|
||||
options=list(digits=3,
|
||||
|
||||
Reference in new issue
Block a user