cleanup and bugfix; linearity report made work
This commit is contained in:
+82
-299
@@ -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: |
|
||||
| {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'}
|
||||
|
||||
<!-- ``` -->
|
||||
|
||||
|
||||
<!-- {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
|
||||
|
||||
|
||||
+59
-37
@@ -15,19 +15,20 @@ header_includes:
|
||||
-\rhead{\includegraphics[width=.15\textwidth]{`r getwd()`/logo.png}}
|
||||
params:
|
||||
FileName: NA
|
||||
newTitle: NA
|
||||
author: NA
|
||||
NoP: NA
|
||||
Assay: NA
|
||||
REP: NA
|
||||
coeffs: NA
|
||||
author: "Author: `r params$author`"
|
||||
title: |
|
||||
| {width=1in}
|
||||
| {width=2in}
|
||||
| 4PL 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)`"
|
||||
|
||||
---
|
||||
|
||||
@@ -55,17 +56,17 @@ DiagnTable <- REP$DiagnTable
|
||||
UnRPLAausw <- REP$UnRPLAausw
|
||||
UnRPLBend <- REP$UnRPLBend
|
||||
PLAausw <- REP$PLAausw
|
||||
PLBend <- REP$PLBend
|
||||
PLbend <- REP$PLBend
|
||||
pottab4plXL <- REP$pottab4plXL
|
||||
Lim <- REP$Lim
|
||||
|
||||
XLdat2 <- REP$XLdat2
|
||||
PureErr <- REP$PureErr
|
||||
|
||||
CIplot <- REP$CIplot
|
||||
testsTab <- REP$testsTab
|
||||
relpotTestPlot <- REP$relpotTestPlot
|
||||
|
||||
|
||||
#browser()
|
||||
|
||||
```
|
||||
|
||||
@@ -103,7 +104,7 @@ colFmt <- function() {
|
||||
if(AnalysisFlag) {
|
||||
text <- paste("\\textcolor{red}{Analysis failed}",sep="")
|
||||
} else {
|
||||
text <- paste("\\textcolor{black}{Analysis succeeded}>",sep="")
|
||||
text <- paste("\\textcolor{black}{Analysis succeeded}",sep="")
|
||||
}
|
||||
return(text)
|
||||
}
|
||||
@@ -116,12 +117,14 @@ colFmt <- function() {
|
||||
|
||||
## 4pl-regression
|
||||
|
||||
Relative potency (absolute and relative confidence limits) are shown in Table 2:
|
||||
Relative potency (absolute and relative confidence limits) are shown in Table 2. `r if(PureErr) {"Pure Error is used for calculations."}`
|
||||
`r if (!PureErr) {"RMSE of restricted model is used for confidence limit calculation."}`
|
||||
|
||||
```{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]] ))}
|
||||
if (pottab4plXL["test_result"][[1]][1]==1) { cat(paste("FAILED: relative potency CL result of restricted model outside limits: ", Lim[[9]], "to" ,Lim[[10]] ))}
|
||||
if (pottab4plXL["test_result"][[1]][1]==0) { cat(paste("PASSED: relative potency CL result of restricted model within limits: ", Lim[[9]], "to" ,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")
|
||||
|
||||
@@ -129,9 +132,10 @@ kable(pottab4plXL, format = "markdown", caption= "Relative potency with absolute
|
||||
```
|
||||
|
||||
|
||||
|
||||
## Plot of the data and models
|
||||
|
||||
The following plots show the restricted and unrestricted model, respectively.
|
||||
Plots in Figure 1 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'}
|
||||
@@ -147,24 +151,24 @@ plot_grid(XLplot4pl)
|
||||
|
||||
## ANOVA table
|
||||
|
||||
The ANOVA of the unconstrained model is listed in table 2:
|
||||
The ANOVA of the unconstrained model is listed in table 3. Bates and Watts proposed a test on parallelism which compares the residual sum of squares of the restricted model (ResRSSE) with the residual sum of squares of the unrestricted model (UnresRSSE). If the UnresRSSE is significantly smaller than the ResRSSE, the p-value of "Non-parallelism" is smaller than 0.05 (line 4 in table 3). This test is for information only as it may be overly sensitive in case of small overall variability of the data.
|
||||
|
||||
```{r anovaxls, echo=FALSE, warning=FALSE, results='asis'}
|
||||
|
||||
kable(ANOVAXLS, format = "markdown", caption= "ANOVA table unrestricted", digits=3) %>%
|
||||
kable(ANOVAXLS, format = "markdown", caption= "Analysis of variance", digits=3) %>%
|
||||
kable_styling(latex_options = "hold_position")
|
||||
|
||||
|
||||
```
|
||||
|
||||
## Analysis suitability tests
|
||||
## Assay suitability tests
|
||||
|
||||
The following table lists the chosen suitabilit test results with confidence limits, where applicable:
|
||||
Table 4 lists the chosen suitability test results with confidence limits, where applicable. F-tests should be read with caution, if the overall variability is small, as the test gets overly sensitive.
|
||||
|
||||
|
||||
```{r SST_ergebn, echo=FALSE, cache=FALSE, warning=FALSE, message=FALSE, tidy=TRUE}
|
||||
|
||||
kable(testsTab, row.names = F, format = "markdown", caption="SST results")
|
||||
kable(testsTab, row.names = F, format = "markdown", caption="Assay suitability results", digits=4)
|
||||
|
||||
|
||||
```
|
||||
@@ -196,9 +200,9 @@ colFmt2 <- function() {
|
||||
|
||||
outputFormat <- knitr::opts_knit$get("rmarkdown.pandoc.to")
|
||||
if(TestsTabFlag) {
|
||||
text <- paste("\\textcolor{red}{Analysis suitability tests failed}",sep="")
|
||||
text <- paste("\\textcolor{red}{Assay suitability tests failed}",sep="")
|
||||
} else {
|
||||
text <- paste("\\textcolor{black}{Analysis suitability tests succeeded}",sep="")
|
||||
text <- paste("\\textcolor{black}{Assay suitability tests succeeded}",sep="")
|
||||
}
|
||||
return(text)
|
||||
}
|
||||
@@ -212,33 +216,33 @@ colFmt2 <- function() {
|
||||
|
||||
|
||||
|
||||
## Fitting results of the 4 models with bend points
|
||||
## Fitting results with curve points
|
||||
|
||||
The results of the non-linear fitting procedure for the restricted model (5 parameters) is listed in table 4:
|
||||
The results of the non-linear fitting procedure for the restricted model (5 parameters) is listed in table 5:
|
||||
|
||||
```{r PLAausw, echo=FALSE, warning=FALSE, results='asis'}
|
||||
|
||||
kable(PLAausw, format = "markdown", caption= "Restricted 4PL evaluation", digits=3, row.names = F)
|
||||
kable(PLAausw, format = "markdown", caption= "Restricted 4PL model", digits=3, row.names = F)
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
A depiction of the CI and corresponding limits of relative potency is shown here:
|
||||
<!-- A depiction of the CI and corresponding limits of relative potency is shown here: -->
|
||||
|
||||
```{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, 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'} -->
|
||||
|
||||
print(relpotTestPlot)
|
||||
<!-- print(relpotTestPlot) -->
|
||||
|
||||
|
||||
```
|
||||
<!-- ``` -->
|
||||
|
||||
|
||||
The bend points for test and reference sample are in table 5:
|
||||
Sebaugh et al proposed bend points for test and reference samples, that define the points with highest turning behavior. Table 6 lists these bendpoints as well as asymptote points ~ twice as far from the center as the bendpoints.
|
||||
|
||||
```{r PLBend, echo=FALSE, warning=FALSE, results='asis'}
|
||||
|
||||
kable(PLBend, format = "markdown", caption= "Bendpoints (Sebaugh) of restricted 4PL", digits=3)
|
||||
kable(PLbend, format = "markdown", caption= "Bendpoints and asymptote points of restricted 4PL model", digits=3)
|
||||
|
||||
|
||||
```
|
||||
@@ -247,17 +251,17 @@ The results of the non-linear fitting procedure for the unrestricted model (8 pa
|
||||
|
||||
```{r UnRPLAausw, echo=FALSE, warning=FALSE, results='asis'}
|
||||
|
||||
kable(UnRPLAausw, format = "markdown", caption= "UNrestricted 4PL evaluation", digits=3, row.names = F)
|
||||
kable(UnRPLAausw, format = "markdown", caption= "Unrestricted 4PL model", digits=3, row.names = F)
|
||||
|
||||
```
|
||||
|
||||
|
||||
```{r UnRPLBend, echo=FALSE, warning=FALSE, results='asis'}
|
||||
<!-- ```{r UnRPLBend, echo=FALSE, warning=FALSE, results='asis'} -->
|
||||
|
||||
kable(UnRPLBend, format = "markdown", caption= "Bend points of 4PL unrestricted", digits=3, row.names = F)
|
||||
<!-- kable(UnRPLBend, format = "markdown", caption= "Bend points of 4PL unrestricted", digits=3, row.names = F) -->
|
||||
|
||||
|
||||
```
|
||||
<!-- ``` -->
|
||||
|
||||
|
||||
|
||||
@@ -269,13 +273,6 @@ $$
|
||||
Y = D + \frac{A-D} {1+(\frac{C} {x})^B } + \epsilon
|
||||
$$
|
||||
|
||||
|
||||
## 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
|
||||
@@ -286,6 +283,29 @@ D: lower asymptote
|
||||
|
||||
C ... EC50
|
||||
|
||||
|
||||
## log-logistic 4P regression
|
||||
|
||||
$$
|
||||
Y = D + \frac{A-D} {1+e^{(B*(C - log(x))) }} + \epsilon
|
||||
$$
|
||||
|
||||
|
||||
|
||||
## Intercept for slope at EC50
|
||||
|
||||
$$
|
||||
I = A+\frac{D-A}{2}-B_{true}*EC50
|
||||
$$
|
||||
|
||||
## Slope at EC50
|
||||
|
||||
$$
|
||||
B_{true}=B*\frac{D-A}{4}
|
||||
$$
|
||||
|
||||
|
||||
|
||||
# Literature
|
||||
|
||||
Finney, D.J.: (1978) Statistical Method in Biological Assay, London: Charles Griffin House, 3rd edition (pp. 80-82)
|
||||
@@ -294,6 +314,8 @@ Franz, V.H.: Ratios: A short guide to confidence limits and proper use. arXiv:07
|
||||
|
||||
VerHoef, J.M.: Who invented the Delta Method? The American Statistician, 2012, 66:2, 124-127 DOI: 10.1080/00031305.2012.687494
|
||||
|
||||
Bates, D.M., Watts, D.G. (1988). Comparing models. In: Nonlinear Regression Analysis and Its Applications. New York: Wiley, pp 103-108
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -2,6 +2,7 @@
|
||||
|
||||
Dat <- reactiveValues()
|
||||
REP <- reactiveValues()
|
||||
REPlin <- reactiveValues()
|
||||
|
||||
#' Levenberg Marquard fit of 4 pl
|
||||
#'
|
||||
@@ -188,11 +189,13 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
|
||||
#browser()
|
||||
p <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
|
||||
geom_point(shape=factor(isRef), size=3,alpha=0.8) +
|
||||
labs(title = paste("restricted 4pl"),
|
||||
labs(title = paste("restricted 4pl model"),
|
||||
color="product") +
|
||||
scale_color_manual(labels=c("test","reference"), values=c("#C2173F","#4545BA")) +
|
||||
scale_shape_manual(labels=c("test","reference")) +
|
||||
theme_bw() +
|
||||
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
|
||||
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
|
||||
#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="#C2173F",
|
||||
@@ -205,8 +208,8 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
|
||||
inherit.aes = F) +
|
||||
geom_vline(xintercept=c(Xbendl3, Xbendu3), col="#4545BA",linetype=2) +
|
||||
geom_vline(xintercept=c(XbendlT, XbenduT), col="#C2173F",linetype=2) +
|
||||
geom_vline(xintercept=c( XasymplS, XasympuS), col="#4545BA55",linetype=2) +
|
||||
geom_vline(xintercept=c(XasymplT, XasympuT), col="#C2173F55",linetype=2) +
|
||||
geom_vline(xintercept=c( XasymplS, XasympuS), col="#4545BABB",linetype=3) +
|
||||
geom_vline(xintercept=c(XasymplT, XasympuT), col="#C2173FBB",linetype=3) +
|
||||
annotate("text", x=cs, y=a+(d-a)/2, label="0", size=5) +
|
||||
geom_abline(slope = slopeEC50, intercept = Intercept) +
|
||||
theme(legend.position="none")
|
||||
@@ -274,7 +277,7 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
|
||||
#browser()
|
||||
pu <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
|
||||
geom_point(size=3) +
|
||||
labs(title="unrestricted 4_pl-Model", color="product") +
|
||||
labs(title="unrestricted 4pl model", color="product") +
|
||||
scale_color_manual(labels = c("test","reference"), values=c("#C2173F88","#4545BA88")) +
|
||||
theme_bw()
|
||||
pu2 <- pu + geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=SAMPLEu),
|
||||
@@ -687,6 +690,8 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
#labs(title=paste("linear regression model", indS,indT), color="product") +
|
||||
scale_colour_manual(labels = c("test","reference"), values=c("#C2173F","#4545BA")) +
|
||||
ylim(min(all_l2$readout),max(all_l2$readout)) +
|
||||
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
|
||||
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
|
||||
theme_bw()
|
||||
p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="#4545BA",
|
||||
inherit.aes = F) +
|
||||
@@ -699,7 +704,7 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
labs(title = paste("unrestricted PLA model"), subtitle = paste("Regression starts for reference sample:",indS, "for test sample:",indT)) +
|
||||
theme(legend.position="none", axis.text = element_text(size=14))
|
||||
p3 <- p2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
|
||||
size=5,alpha=0.2), inherit.aes = FALSE) +
|
||||
size=5,alpha=0.2), col=c("black"), inherit.aes = FALSE) +
|
||||
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
|
||||
# fit intercept for test and ref and common slope
|
||||
|
||||
@@ -720,7 +725,7 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
subtitle = paste("Regression on highlighted points")) +
|
||||
theme(legend.position="none", axis.text = element_text(size=14))
|
||||
pr3 <- pr2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
|
||||
size=5, alpha=0.2), col=c("#1FE8B2"), stroke=2, inherit.aes = FALSE) +
|
||||
size=5, alpha=0.2), col=c("black"), inherit.aes = FALSE) +
|
||||
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
|
||||
return(grid.arrange(p3,pr3,nrow=1))
|
||||
}
|
||||
|
||||
@@ -18,11 +18,13 @@ library(drc)
|
||||
library(twopartm)
|
||||
library(car)
|
||||
library(dplyr)
|
||||
library(scales)
|
||||
|
||||
|
||||
#### reactive values ----
|
||||
Dat <- reactiveValues()
|
||||
REP <- reactiveValues()
|
||||
REPlin <- reactiveValues()
|
||||
|
||||
source("Global.R")
|
||||
|
||||
@@ -142,7 +144,7 @@ server <- function(input, output, session) {
|
||||
"EQ-test on ratio of lower asymptote"= "3","EQ-test on ratio of Hill slopes"= "4",
|
||||
"EQ-test on ratio of upper asymptote"= "5", "F-test on non-linearity"="6",
|
||||
"EQ-test on ratio of asymptote differences"= "7"),
|
||||
selected= c("1","2","3","4","5","6","7")),
|
||||
selected= c("1","4","5","6","7")),
|
||||
h4("Suitability tests for Parallel Line Assay"),
|
||||
checkboxGroupInput("selectedSSTsLinear", "Which suitability tests to be used?",
|
||||
choices= c("F-test on Regr."="1",
|
||||
@@ -177,6 +179,8 @@ server <- function(input, output, session) {
|
||||
),
|
||||
column(8,
|
||||
plotOutput("XLplot"),
|
||||
"Footnote: bendpoints (linear part) and asymptote points (point where asymptote is reached) are plotted in dashed and dotted lines. They indicate whether the linear part and asymptotes are catched with the current dilutions.",
|
||||
"Black line is the true slope at EC50 of REF.",
|
||||
DTOutput("pottab4plXL"),
|
||||
plotOutput("diagnplot"),
|
||||
DTOutput("EQtests"),
|
||||
@@ -192,14 +196,14 @@ server <- function(input, output, session) {
|
||||
width=2,
|
||||
fluidRow(
|
||||
column(12,
|
||||
numericInput("Limits",p("limit to be >", bsButton("q4",label="", icon=icon("info"), style="primary", size="extra-small")),
|
||||
bsPopover(id="q4", title="", content="The calculated limits ...")),
|
||||
numericInput("EACLinlow","Potency CL to be > than",value=80),
|
||||
numericInput("EACLinupp","Potency CL to be < than", value=125)
|
||||
|
||||
)
|
||||
)),
|
||||
mainPanel(
|
||||
tabsetPanel(id="tabs",
|
||||
tabPanel("linear PLA",
|
||||
tabPanel("Plot and models",
|
||||
column(12,
|
||||
htmlOutput("PureErrWLinXL"),
|
||||
tags$head(tags$style("#PureErrWLinXL{color: red;
|
||||
@@ -212,8 +216,11 @@ server <- function(input, output, session) {
|
||||
tableOutput("SummaryModABu"),
|
||||
h4("Restricted linear model (CSSI):"),
|
||||
tableOutput("SummaryModAB"),
|
||||
|
||||
h3("Tests for linear PLA):"),
|
||||
)),
|
||||
tabPanel("Tests and ANOVAA",
|
||||
column(12,
|
||||
|
||||
h3("Tests for linear PLA:"),
|
||||
box(title="Suitability tests", status="primary",solidHeader = T, width=12,
|
||||
DTOutput("TESTSlin")),
|
||||
h5("The estimate is the p-value of the test"),
|
||||
@@ -224,11 +231,12 @@ server <- function(input, output, session) {
|
||||
|
||||
h3("ANOVA for parallel line assay"),
|
||||
DTOutput("ANOVAlin"))
|
||||
),
|
||||
tabPanel("Report",
|
||||
h4("Settings for report"),
|
||||
|
||||
))
|
||||
),
|
||||
# tabPanel("Report",
|
||||
# h4("Settings for report"),
|
||||
#
|
||||
# )
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
@@ -260,6 +268,10 @@ server <- function(input, output, session) {
|
||||
tags$style(type="text/css","#downloadXLReport {background-color: orange; color: black;font-family: Courier New}"),
|
||||
downloadButton("downloadXLReportLin", label="Download linear PLA PDF report", class="butt"),
|
||||
tags$style(type="text/css","#downloadXLReportLin {background-color: #4FCBD9; color: black;font-family: Courier New}"),
|
||||
textInput("Author", "Author", value=""),
|
||||
textInput("RepIdentifier", "Report name", value=""),
|
||||
textInput("NoP","Product name", value=""),
|
||||
textInput("Assay", "Assay name",value="")
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -476,7 +488,7 @@ server <- function(input, output, session) {
|
||||
column(4,
|
||||
h3("Confidence intervals"),
|
||||
tableOutput("CIs"),
|
||||
"The confidence intrval table is interaactive for changes in: variability slider (%SD), potency of test-slider,
|
||||
"The confidence interval table is interaactive for changes in: variability slider (%SD), potency of test-slider,
|
||||
and 'Adjust the dilutions'-slider",
|
||||
tableOutput("optimalDils"),
|
||||
selectInput(inputId="scenario", label= "Select an 'optimal' scenario:", choices = c("scenario 2","scenario 3","scenario 6","steep slope"))),
|
||||
@@ -563,6 +575,12 @@ server <- function(input, output, session) {
|
||||
if (input$sheet != "please choose") {
|
||||
#browser()
|
||||
|
||||
Dat$RepIdentifier <- input$RepIdentifier
|
||||
Dat$Author <- input$Author
|
||||
Dat$NoP <- input$NoP
|
||||
Dat$Assay <- input$Assay
|
||||
|
||||
|
||||
XLdat <- Dat$wb[input$sheet][[1]]
|
||||
if (is.null(XLdat)) XLdat <- Dat$wb[Dat$sheets[1]][[1]]
|
||||
cn <- colnames(XLdat)
|
||||
@@ -593,6 +611,8 @@ server <- function(input, output, session) {
|
||||
})
|
||||
output$PureErrWParEst <- renderText(warning_textParEst())
|
||||
|
||||
REP$PureErr <- PureErrFlag
|
||||
|
||||
noDilSeries <-(ncol(XLdat2)-1)/2
|
||||
noDils <- nrow(XLdat2)
|
||||
Dat$noDilSeriesXL <- noDilSeries
|
||||
@@ -619,6 +639,28 @@ server <- function(input, output, session) {
|
||||
Dat$coeffsMUnr <- coeffsMU
|
||||
Dat$coeffs_UN <- coeffsMU
|
||||
names(coeffsMU) <- c("lowAsym REF", "slope REF","upperAsym REF","EC50 REF","lowAsym TEST","slope TEST","upperAsym TEST","r")
|
||||
# browser()
|
||||
XbendMUlREF <- coeffsMU[4] - 1.5434/abs(coeffsMU[2])
|
||||
XbendMUuREF <- coeffsMU[4] + 1.5434/abs(coeffsMU[2])
|
||||
XbendMUlTEST <- coeffsMU[4]-coeffsMU[8] - 1.5434/abs(coeffsMU[6])
|
||||
XbendMUuTEST <- coeffsMU[4]+coeffsMU[8] + 1.5434/abs(coeffsMU[6])
|
||||
XbendMRlREF <- coeffsMR[4] - 1.5434/abs(coeffsMR[2])
|
||||
XbendMRuREF <- coeffsMR[4] + 1.5434/abs(coeffsMR[2])
|
||||
XbendMRlTEST <- coeffsMR[4]-coeffsMR[5] - 1.5434/abs(coeffsMR[2])
|
||||
XbendMRuTEST <- coeffsMR[4]-coeffsMR[5] + 1.5434/abs(coeffsMR[2])
|
||||
XasymlREF <- coeffsMR[4] - 3/abs(coeffsMR[2])
|
||||
XasymuREF <- coeffsMR[4] + 3/abs(coeffsMR[2])
|
||||
XasymlTEST <- coeffsMR[4]-coeffsMR[5] - 3/abs(coeffsMR[2])
|
||||
XasymuTEST <- coeffsMR[4]-coeffsMR[5] + 3/abs(coeffsMR[2])
|
||||
#browser()
|
||||
BPsMR_MU <- data.frame(points = c("lower bendpoint REF", "upper bendpoint REF","lower bendpoint TEST" ,"upper bendpoint TEST",
|
||||
"lower asymp. point REF", "upper asymp. point REFr", "lower asymp. point TEST", "upper asymp. point TEST",
|
||||
"bendREF_lower_unrestr", "bendREF_upper_unrestr", "bendTESTE_lower_unrestr", "bendTEST_upper_unrestr"),
|
||||
estimates = c(round(XbendMRlREF,3), round(XbendMRuREF,3),round(XbendMRlTEST,3),round(XbendMRuTEST,3),
|
||||
round(XasymlREF,3),round(XasymuREF,3),round(XasymlTEST,3),round(XasymuTEST,3),
|
||||
round(XbendMRlREF,3),round(XbendMRuREF,3),round(XbendMRlTEST,3),round(XbendMRuTEST,3)))
|
||||
Dat$bendsAll <- BPsMR_MU
|
||||
REP$bendsAll <- BPsMR_MU
|
||||
|
||||
if (!PureErrFlag) {
|
||||
pot_est <- FITs[[3]]
|
||||
@@ -725,7 +767,7 @@ server <- function(input, output, session) {
|
||||
colnames(logpotUest) <- c("estimate", "lowerCI", "upperCI")
|
||||
#browser()
|
||||
cnXL <- colnames(XLdat2)
|
||||
Filesample <- data.frame(Test = c("File name", "samples"), Test2=c(Dat$FileName, paste(cnXL[1], " vs ", cnXL[4])))
|
||||
Filesample <- data.frame(Test = c("FFILE NAME:", "SAMPLES"), Test2=c(Dat$FileName, paste(cnXL[1], " vs ", cnXL[4])))
|
||||
colnames(Filesample) <- c("", "")
|
||||
output$Filesampl <- renderTable({ Filesample }, rownames = F)
|
||||
|
||||
@@ -770,11 +812,11 @@ server <- function(input, output, session) {
|
||||
round(pot_est[1, ] * 100, 3)))) # von gs1_nls
|
||||
output$coeffs_r <- renderTable({ PLAAusw })
|
||||
|
||||
PLAAusw2 <- data.frame(Dat$bendpoints)
|
||||
output$bends_r2 <- renderTable({ PLAAusw2 }, digits = 3, rownames = T)
|
||||
bendsAll <- data.frame(Dat$bendsAll[1:8,])
|
||||
output$bends_r2 <- renderTable({ bendsAll }, digits = 3, rownames = T)
|
||||
|
||||
REP$PLAausw <- PLAAusw
|
||||
REP$PLBend <- PLAAusw2
|
||||
REP$PLBend <- bendsAll
|
||||
|
||||
#### Parameter extraktion ----
|
||||
logcoeffs_R <- SRlog$coefficients[, 1] # logpot$coefficients
|
||||
@@ -1105,7 +1147,7 @@ server <- function(input, output, session) {
|
||||
REP$testsTab <- tab
|
||||
tab2 <- tab[1:7,]
|
||||
|
||||
dat <- datatable(tab2,options = list(
|
||||
dat <- datatable(tab2, rownames=F, options = list(
|
||||
paging=TRUE,
|
||||
dom="t",
|
||||
rownames=FALSE
|
||||
@@ -1149,10 +1191,10 @@ server <- function(input, output, session) {
|
||||
Dat$tests_FUNC <- tab2
|
||||
REP$testsTab <- tab2
|
||||
|
||||
dat <- datatable(tab2,options = list(
|
||||
dat <- datatable(tab2,
|
||||
rownames=FALSE, options = list(
|
||||
paging=TRUE,
|
||||
dom="t",
|
||||
rownames=FALSE
|
||||
dom="t"
|
||||
)) %>% formatStyle("test_results",
|
||||
target='row',
|
||||
backgroundColor = styleEqual(c(-1,0,1),
|
||||
@@ -1297,11 +1339,12 @@ server <- function(input, output, session) {
|
||||
circle <- rbind(circleS,circleT)
|
||||
|
||||
Dat$circles <- circle
|
||||
REPlin$circles <- circle
|
||||
#browser()
|
||||
sigmoid <- Dat$coeffsMUnr
|
||||
|
||||
pLin <- PlotLinPLA_FUNC(circle, sigmoid = sigmoid, all_l2, pl_df, indS, indT)
|
||||
|
||||
REPlin$pLin <- pLin
|
||||
|
||||
pLin
|
||||
})
|
||||
@@ -1397,7 +1440,10 @@ server <- function(input, output, session) {
|
||||
})
|
||||
|
||||
#### linear PLA tests XLinput ----
|
||||
output$TESTSlin <- DT::renderDataTable({
|
||||
#output$TESTSlin <- DT::renderDataTable({
|
||||
observe({
|
||||
if (is.null(Dat$EXCEL)) return(NULL)
|
||||
|
||||
tab <- Dat$EXCEL
|
||||
if (is.character(tab)) stop(tab)
|
||||
Conc <- exp(tab$log_dose)
|
||||
@@ -1405,7 +1451,7 @@ server <- function(input, output, session) {
|
||||
as.numeric(input$lEACratiola), as.numeric(input$uEACratiola),
|
||||
as.numeric(input$lEACratioSlope), as.numeric(input$uEACratioSlope),
|
||||
as.numeric(input$lEACratioua), as.numeric(input$uEACratioua),
|
||||
as.numeric(input$lowerPot), as.numeric(input$upperPot),
|
||||
as.numeric(input$EACLinlow), as.numeric(input$EACLinupp),
|
||||
as.numeric(input$lEACratioAdiff), as.numeric(input$uEACratioAdiff))
|
||||
|
||||
noDil <- nrow(tab)
|
||||
@@ -1458,6 +1504,9 @@ server <- function(input, output, session) {
|
||||
output$SummaryModABu <- renderTable({ su_modU }, digits=5)
|
||||
output$SummaryModAB <- renderTable({ su_mod2 }, digits=5)
|
||||
|
||||
REPlin$SuModABu <- su_modU
|
||||
REPlin$SuModAB <- su_mod2
|
||||
|
||||
slopeDiffCI <- t(data.frame(LIN[[3]]))
|
||||
colnames(slopeDiffCI) <- c("slope difference","lower CI","upper CI")
|
||||
output$SlopeDiffCI <- renderTable({ slopeDiffCI },digits=5)
|
||||
@@ -1465,13 +1514,17 @@ server <- function(input, output, session) {
|
||||
SelTestsL <- as.numeric(input$selectedSSTsLinear)
|
||||
df2 <- df[SelTestsL,]
|
||||
|
||||
REPlin$LinTests <- df2
|
||||
|
||||
Dat$ANOVA <- df[,4:length(df)]
|
||||
dat <- datatable(df2[,1:3],
|
||||
options=list(
|
||||
paging=T, dom="t",rownames=F
|
||||
)) %>% formatStyle("test_results", target="row",backgroundColor = styleEqual(c(-1,0,1),
|
||||
c("pink","lightgreen","lightgrey")))
|
||||
|
||||
output$TESTSlin <- DT::renderDataTable({
|
||||
dat
|
||||
})
|
||||
})
|
||||
|
||||
#### output 4PL ANOVA tests Meta ----
|
||||
@@ -1548,9 +1601,10 @@ server <- function(input, output, session) {
|
||||
})
|
||||
output$PureErrWLinXL <- renderText(warning_text2())
|
||||
|
||||
pottab <- LinPotTab(circles,Lim,PureErrFlag = PureErrFlag)
|
||||
#browser()
|
||||
dat <- datatable(pottab,
|
||||
LinPotTab <- LinPotTab(circles,Lim,PureErrFlag = PureErrFlag)
|
||||
REPlin$LinPotTab <- LinPotTab
|
||||
|
||||
dat <- datatable(LinPotTab,
|
||||
options=list(
|
||||
dom="t",rownames=F
|
||||
)) %>% formatStyle("test_result", target='row',
|
||||
@@ -1671,20 +1725,20 @@ server <- function(input, output, session) {
|
||||
} else {test_potUCI_t <- 1 }
|
||||
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")
|
||||
|
||||
row.names(pottab4_) <- NULL
|
||||
REP$pottab4plXL <- pottab4_[1:2,]
|
||||
|
||||
output$pottab4plXL <- DT::renderDataTable({
|
||||
dat <- datatable(pottab4_[1:2,],
|
||||
dat <- datatable(pottab4_[1:2,],rownames=F,
|
||||
options=list(digits=3,
|
||||
paging=T, dom="t",rownames=F
|
||||
paging=T, dom="t"
|
||||
)) %>% formatStyle("test_result", target="row",backgroundColor = styleEqual(c(0,1),
|
||||
c("#B5C74055","#F9545455")))
|
||||
})
|
||||
output$pottab4plTransXL <- DT::renderDataTable({
|
||||
dat <- datatable(pottab4_[3:4,],
|
||||
dat <- datatable(pottab4_[3:4,],rownames=F,
|
||||
options=list(digits=3,
|
||||
paging=T, dom="t",rownames=F
|
||||
paging=T, dom="t"
|
||||
)) %>% formatStyle("test_result", target="row",backgroundColor = styleEqual(c(0,1),
|
||||
c("#B5C74055","#F9545455")))
|
||||
})
|
||||
@@ -2064,7 +2118,10 @@ server <- function(input, output, session) {
|
||||
#### download XL 4PL report----
|
||||
|
||||
output$downloadXLReport <- downloadHandler(
|
||||
filename= paste0("Report_4PLEvaluation", Dat$FileName,".pdf"),
|
||||
|
||||
|
||||
|
||||
filename= paste0("Report_4PLEvaluation", Dat$RepIdentifier,".pdf"),
|
||||
|
||||
content = function(file) {
|
||||
tpdr <- tempdir()
|
||||
@@ -2076,7 +2133,9 @@ server <- function(input, output, session) {
|
||||
|
||||
rmarkdown::render(tempReport, output_file = file,
|
||||
params = list(FileName = Dat$FileName,
|
||||
author = Dat$author,
|
||||
author = Dat$Author,
|
||||
NoP = Dat$NoP,
|
||||
Assay = Dat$Assay,
|
||||
REP = REP,
|
||||
coeffs = Dat$coeffs_UN),
|
||||
envir = new.env(parent = globalenv()))
|
||||
@@ -2099,9 +2158,10 @@ server <- function(input, output, session) {
|
||||
|
||||
rmarkdown::render(tempReport, output_file = file,
|
||||
params = list(FileName = Dat$FileName,
|
||||
author = Dat$author,
|
||||
author = Dat$Author,
|
||||
REP = REP,
|
||||
coeffs = Dat$coeffs_UN),
|
||||
REPlin = REPlin,
|
||||
coeffsLin = Dat$coeffs_UN),
|
||||
envir = new.env(parent = globalenv()))
|
||||
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user