cleanup and bugfix; linearity report made work

This commit is contained in:
2026-05-15 22:11:20 +02:00
parent 9422490f25
commit ec13d95387
4 changed files with 249 additions and 379 deletions
+82 -299
View File
@@ -17,17 +17,18 @@ params:
FileName: NA
newTitle: NA
author: NA
REPLin: NA
REP: NA
REPlin: NA
coeffsLin: NA
author: "Author: `r params$author`"
title: |
| ![](logo.png){width=1in}
| 4PL bioassay evaluation
| Linear bioassay evaluation
subtitle: |
`r params$FileName`
<left> Unique time: </left> <right> `r Sys.time()`</right>
date: "`r paste(params$Subway, params$Version)`"
date: "`r paste(params$NoP, params$Assay)`"
---
@@ -44,25 +45,21 @@ library(knitr)
library(DT)
REP <- params$REP
REPLin <- params$REPLin
REPlin <- params$REPlin
author <- params$author
coeffsLin <- params$coeffsLin
all_l <- REP$all_l
circles <- REPlin$circles
ANOVAXLS <- REP$ANOVAXLS
DiagnTable <- REP$DiagnTable
UnRPLAausw <- REP$UnRPLAausw
UnRPLBend <- REP$UnRPLBend
PLAausw <- REP$PLAausw
PLBend <- REP$PLBend
LogPLAausw <- REP$LogPLAausw
LogUnrPLAausw <- REP$LogUnrPLAausw
SuModAB <- REPlin$SuModAB
SuModABu <- REPlin$SuModABu
LinTests <- REPlin$LinTests
XLplotLin <- REPlin$pLin
LinPotTab <- REPlin$LinPotTab
XLdat2 <- REP$XLdat2
CIplot <- REP$CIplot
testsTab <- REP$testsTab
relpotTestPlot <- REP$relpotTestPlot
@@ -74,220 +71,71 @@ relpotTestPlot <- REP$relpotTestPlot
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]).
# Raw data
All data used for evaluation is shown in table 1.
```{r Alll, echo=FALSE, warning=FALSE, results='asis'}
kable(XLdat2, format = "markdown", caption= "Uploaded data (test and reference) ", digits=3)
```
All data used linerar regression is shown in table 2.
```{r Circles, echo=FALSE, warning=FALSE, results='asis'}
kable(circles, format = "markdown", caption= "Concentrations and readout used for linear regression", digits=3, row.names = F)
```
# Results
All data used for the 4PL evaluation is shown in table 1:
## Overall result
```{r alll, echo=FALSE, warning=FALSE, results='asis'}
```{r Over_all, echo=FALSE, comment=NA, warning=NA, message=NA}
#browser()
potFlag <- 0
if (LinPotTab[1,"test_result"]==1) potFlag <- 1
AnalysisFlag <- FALSE
if (potFlag==1 | sum(LinTests$test_results)>0) AnalysisFlag <- TRUE
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="")
}
return(text)
}
kable(all_l, format = "markdown", caption= "Uploaded data (test and reference) in long format", digits=3)
```
The following 4 plots show all 4 models: restricted and unrestricted, and log transformed, respectively.
`r colFmt()`
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'}
## Plots and ANOVA
# 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)
Plots in Figure 1 show the restricted and unrestricted model, respectively.
```{r LinPlot, echo=FALSE, warning=FALSE, fig.height=4, fig.width=6, fig.cap="Plot of models", fig.align='left'}
library(cowplot)
plot_grid(XLplotLin)
```
The ANOVA of the unconstrained model is listed in table 2:
The ANOVA of the unconstrained model is listed in table 3.
```{r anovaxls, echo=FALSE, warning=FALSE, results='asis'}
@@ -296,130 +144,65 @@ kable(ANOVAXLS, format = "markdown", caption= "ANOVA table unrestricted", digits
```
The assay suitability tests are shown in table 4.
```{r SST_ergebn, fig.align='center', fig.pos='htb!', echo=FALSE, cache=FALSE, warning=FALSE, message=FALSE, tidy=TRUE}
kable(testsTab[1:7,], row.names = F, format = "markdown", caption="SST results")
```{r SST_ergebn, echo=FALSE, cache=FALSE, warning=FALSE, message=FALSE, tidy=TRUE}
kable(LinTests, row.names = F, format = "markdown", caption="Assay suitability test results", digits=3)
```
*...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:
The estimate is the p-value of the test.
F-tests on regression, significance of slopes, and preparation need to have a p-value <0.05 to pass.
All other tests pass if p-value > 0.05.
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, label= 'CIplot', echo=FALSE, warning=FALSE, fig.width=100, fig.cap='Selected SSt confidence intervals with entered limits', fig.align='center'} -->
## Fitting results
<!-- png("CIplot.png") -->
<!-- print(CIplot) -->
<!-- dev.off() -->
The results of the linear fitting procedure for the restricted model is listed in table 5:
```{r SumCSSI, echo=FALSE, warning=FALSE, results='asis'}
<!-- ``` -->
<!-- ![](CIplot.png){width=60%} -->
## Fitting results of the 4 models with bend points
The results of the non-linear fitting procedure for the restricted model (5 parameters) is listed in table 4:
```{r PLAausw, echo=FALSE, warning=FALSE, results='asis'}
kable(PLAausw, format = "markdown", caption= "Restricted 4PL evaluation", digits=3, row.names = F)
kable(SuModAB, format = "markdown", caption= "Restricted linear regression (CSSI)", digits=3, row.names = F)
```
CSSI: common slope, separate intercept
A depiction of the CI and corresponding limits of relative potency is shown here:
The results of the linear fitting procedure for the unrestricted model is listed in table 6.
```{r, label='relpotPlot', echo=FALSE, warning=FALSE, fig.height=2, fig.width=3.5, fig.cap="Rel potency with CIs and limits", fig.align='left', results='asis'}
```{r SuSSSI, echo=FALSE, warning=FALSE, results='asis'}
print(relpotTestPlot)
kable(SuModABu, format = "markdown", caption= "Restricted linear regression (SSSI)", digits=3, row.names = F)
```
The bend points for test and reference sample are in table 5:
```{r PLBend, echo=FALSE, warning=FALSE, results='asis'}
kable(PLBend, format = "markdown", caption= "Bendpoints (Sebaugh) of restricted 4PL", digits=3)
SSSI: separate slope, separate intercept
```
The results of the non-linear fitting procedure for the unrestricted model (8 parameters) is listed in table 6:
```{r UnRPLAausw, echo=FALSE, warning=FALSE, results='asis'}
kable(UnRPLAausw, format = "markdown", caption= "UNrestricted 4PL evaluation", digits=3, row.names = F)
```
```{r UnRPLBend, echo=FALSE, warning=FALSE, results='asis'}
kable(UnRPLBend, format = "markdown", caption= "Bend points of 4PL unrestricted", digits=3, row.names = F)
```
```{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
## Potency of linear PLA
$$
Y = D + \frac{A-D} {1+(\frac{C} {x})^B } + \epsilon
rel Potency = \frac{I_{ref} - I_{test}{k}
$$
where: I... intercept of reference or test
k ... common slope
## log-logistic 4P regression
$$
Y = D + \frac{A-D} {1+e^{(B*(C - log(x))) }} + \epsilon
$$
where: x ... concentration of the analyte
A: upper asymptote
B: slope
D: lower asymptote
C ... EC50
# Literature