diff --git a/.DS_Store b/.DS_Store
new file mode 100644
index 0000000..3a85252
Binary files /dev/null and b/.DS_Store differ
diff --git a/Doc_BioassayReport copy.Rmd b/Doc_BioassayReport copy.Rmd
new file mode 100644
index 0000000..769170f
--- /dev/null
+++ b/Doc_BioassayReport copy.Rmd
@@ -0,0 +1,433 @@
+---
+output:
+ pdf_document:
+ extra_dependencies: ["float"]
+ number_sections: true
+ toc: true
+ toc_depth: 3
+header_includes:
+ -\usepackage{fancyheadr}
+ -\setlength{\headheight}{22pt}%
+ -\usepackage{lastpage}
+ -\pagestyle{fancy}
+ -\usepackage{pdflscape}
+ -\usepackage{longtable}
+ -\rhead{\includegraphics[width=.15\textwidth]{`r getwd()`/logo.png}}
+params:
+ FileName: NA
+ newTitle: NA
+ author: NA
+ REP: NA
+ coeffs: NA
+author: "Author: `r params$author`"
+title: |
+ | {width=1in}
+ | 4PL bioassay evaluation
+subtitle: |
+ `r params$FileName`
+
+ Unique time: `r Sys.time()`
+date: "`r paste(params$Subway, params$Version)`"
+
+---
+
+\fancyfoot[C]{\thepage\ of \pageref{LastPage}}
+\newpage
+
+\newpage
+
+```{r setup, include=FALSE}
+
+knitr::opts_chunk$set(echo = TRUE)
+
+library(knitr)
+library(DT)
+
+REP <- params$REP
+author <- params$author
+coeffs <- params$coeffs
+
+all_l <- REP$all_l
+ANOVAXLS <- REP$ANOVAXLS
+DiagnTable <- REP$DiagnTable
+UnRPLAausw <- REP$UnRPLAausw
+UnRPLBend <- REP$UnRPLBend
+PLAausw <- REP$PLAausw
+PLBend <- REP$PLBend
+LogPLAausw <- REP$LogPLAausw
+LogUnrPLAausw <- REP$LogUnrPLAausw
+
+XLdat2 <- REP$XLdat2
+
+CIplot <- REP$CIplot
+testsTab <- REP$testsTab
+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]).
+
+# Results
+
+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)
+
+```
+
+The following 4 plots show all 4 models: restricted and unrestricted, and log transformed, respectively.
+
+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)])
+
+ 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)
+
+
+```
+
+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)
+
+
+```
+
+
+```{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")
+
+
+```
+
+
+*...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, 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
+
+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)
+
+
+```
+
+
+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'}
+
+print(relpotTestPlot)
+
+
+```
+
+
+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)
+
+
+```
+
+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
+
+$$
+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
+
+B: slope
+
+D: lower asymptote
+
+C ... EC50
+
+# Literature
+
+Finney, D.J.: (1978) Statistical Method in Biological Assay, London: Charles Griffin House, 3rd edition (pp. 80-82)
+
+Franz, V.H.: Ratios: A short guide to confidence limits and proper use. arXiv:0710.2024v1, 10 Oct 2007
+
+VerHoef, J.M.: Who invented the Delta Method? The American Statistician, 2012, 66:2, 124-127 DOI: 10.1080/00031305.2012.687494
+
+
+
+
diff --git a/Doc_BioassayReport.Rmd b/Doc_BioassayReport.Rmd
index 769170f..95bcdc7 100644
--- a/Doc_BioassayReport.Rmd
+++ b/Doc_BioassayReport.Rmd
@@ -31,10 +31,10 @@ date: "`r paste(params$Subway, params$Version)`"
---
-\fancyfoot[C]{\thepage\ of \pageref{LastPage}}
-\newpage
+
+
-\newpage
+
```{r setup, include=FALSE}
@@ -93,10 +93,10 @@ 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)
+ 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],
@@ -109,7 +109,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
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()
+ #browser()
tryCatch({
mr <- gsl_nls(fn = readout ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
data=all_l2,
@@ -125,12 +125,12 @@ plot_f <- function(dat, sigmoid,det_sig) {
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]))))
@@ -138,19 +138,19 @@ plot_f <- function(dat, sigmoid,det_sig) {
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)),
@@ -159,7 +159,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
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",
@@ -172,15 +172,15 @@ plot_f <- function(dat, sigmoid,det_sig) {
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,
@@ -191,17 +191,17 @@ plot_f <- function(dat, sigmoid,det_sig) {
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) +
@@ -236,7 +236,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
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()
+#browser()
pu <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
geom_point() +
labs(title="unrestricted 4_pl-Model", color="product") +
@@ -246,7 +246,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
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)
+ 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))) +
@@ -254,7 +254,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
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)
@@ -266,16 +266,16 @@ plot_f <- function(dat, sigmoid,det_sig) {
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)
+ show.legend = F)
pu3_t <- pu2_t
grid.arrange(p2,p_rt2,pu2_,pu3_t, nrow=2)
}
@@ -306,26 +306,26 @@ kable(testsTab[1:7,], row.names = F, format = "markdown", caption="SST results")
*...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:
-
+ 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, 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
diff --git a/logo.png b/logo.png
new file mode 100644
index 0000000..c6a6fc3
Binary files /dev/null and b/logo.png differ
diff --git a/server.R b/server.R
index 33920e8..bc90a60 100644
--- a/server.R
+++ b/server.R
@@ -1056,7 +1056,7 @@ function(input,output, session) {
colnames(pot_est) <- c("estimate","lowerCI","upperCI")
colnames(potU_est) <- c("estimate","lowerCI","upperCI")
} else {
- FitAnova <- anova(lm(readout ~ factor(log_dose)*isSample, circ_ABl))
+ FitAnova <- anova(lm(readout ~ factor(log_dose)*isSample, all_l))
meanPureErr <- FitAnova[4,3]
DFsPure <- FitAnova[4,1]
VCOV <- vcov(mr)
@@ -1239,7 +1239,7 @@ function(input,output, session) {
# "log relative potency", "log lower CI", "log upper CI", round(logpotest, 3), round(compParm(potu, "c", display = F), 3)
- outputcoeffs_unr <- renderTable({
+ output$coeffs_unr <- renderTable({
UnRPLAausw
})
@@ -1325,7 +1325,7 @@ function(input,output, session) {
REP$XLdat2 <- XLdat2
# --- Diagnose-Plots (Residualanalyse) ---
- output$diagplot <- renderPlot({
+ output$diagnplot <- renderPlot({
op <- par(mfrow = c(1, 2), mar = c(3.2, 3.2, 2, .5), mgp = c(2, .7, 0))
# 1. Residuals vs Fitted
@@ -1543,8 +1543,8 @@ function(input,output, session) {
})
#### Testergebnisse ----
- #observe({
- observeEvent(input$StartCalc,{
+ observe({
+ #observeEvent(input$StartCalc,{
PureErrFlag <- input$PureErr
warning_text3 <- reactive({
ifelse(PureErrFlag, 'Pure error selected','')
@@ -1577,7 +1577,7 @@ function(input,output, session) {
target='row',
backgroundColor = styleEqual(c(-1,0,1),
c("pink",'lightgreen','lightgrey')))
- browser()
+ #browser()
output$secondary <- DT::renderDataTable({ dat})
output$EQtests <- DT::renderDataTable( dat, options = list(lengthChange=FALSE) )
@@ -2249,7 +2249,7 @@ function(input,output, session) {
#### download XL report----
output$downloadXLReport <- downloadHandler(
- filename= paste0("Report_4PLEvaluation", input$iFile,".pdf"),
+ filename= paste0("Report_4PLEvaluation", Dat$FileName,".pdf"),
content = function(file) {
tpdr <- tempdir()
diff --git a/ui.R b/ui.R
index de2b31b..b6737bf 100644
--- a/ui.R
+++ b/ui.R
@@ -27,7 +27,7 @@ function(req) {
h5("\n\n\n Author: Franz Innerbichler, InnerAnalytics")),
div(id="parameter",
column(1,style = "background: lightgrey",
- actionButton("StartCalc", "Click, when calculations to be started"),
+ #actionButton("StartCalc", "Click, when calculations to be started"),
h4("curve settings"),
numericInput("lowAsymptREF", "lower asymptote REF",10,step=1,min=0),
numericInput("lowAsymptTEST", "lower asymptote TEST",10,step=1,min=0),
@@ -92,7 +92,7 @@ function(req) {
tableOutput("FileSAmpl"),
downloadButton("downloadXLReport", label="Download PDF report", class="butt"),
tags$style(type="text/css","#downloadXLReport {background-color: orange; color: black;font-family: COurier New}"),
- plotOutput("relPotTestPlot", width="300px", height="150px"),
+ plotOutput("relpotTestPlot", width="300px", height="150px"),
h4("Akaike Information Criterion"),
tableOutput("AIC"),
h5("First row: restricted model; 2nd row: unrestricted model"),
@@ -137,14 +137,15 @@ function(req) {
DT::dataTableOutput("pottab4pl"),
"Footnote: test performed on absolute CIs."),
column(6,
- DT::dataTableOutput("secondary"),
+ DT::dataTableOutput("secondary"), # SSTs
h5("*...The estimate for F-test on regression and on non-linearity is the p-value"),
h5("F-test on regression passes if F-value > F-crit and thus p < 0.05"),
h5("F-test on non-linearity passes if F-value < F-crit and thus p > 0.05"),
h5("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"),
- plotOutput("CIplot, height=50%"))
+ #plotOutput("CIplot, height=50%")
+ )
))
),
#### Linear PLA ----
diff --git a/www/.DS_Store b/www/.DS_Store
new file mode 100644
index 0000000..5008ddf
Binary files /dev/null and b/www/.DS_Store differ
diff --git a/www/logo.png b/www/logo.png
new file mode 100644
index 0000000..c6a6fc3
Binary files /dev/null and b/www/logo.png differ