initial commit

This commit is contained in:
2026-04-14 21:46:10 +02:00
commit d02cea0698
5 changed files with 3015 additions and 0 deletions

433
Doc_BioassayReport.Rmd Normal file
View File

@@ -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: |
| ![](logo.png){width=1in}
| 4PL bioassay evaluation
subtitle: |
`r params$FileName`
<left> Unique time: </left> <right> `r Sys.time()`</right>
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()
```
![](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)
```
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

BIN
TestF4PL.xlsx Normal file

Binary file not shown.

BIN
TestFnegSl.xlsx Normal file

Binary file not shown.

2306
server.R Normal file

File diff suppressed because it is too large Load Diff

276
ui.R Normal file
View File

@@ -0,0 +1,276 @@
library(shiny)
library(shinyjs)
library(shinyAce)
library(bslib)
version <- "1.0.0"
function(req) {
fluidPage(
useShinyjs(),
titlePanel("Dilution Wizard"),
tags$head(tags$style((".shiny-notification {position: fixed; top: 20%;left: 50%; margin-top: -100px;
margin-left: -250px; color: blue;font-size: 20px; font-style: italic;}")),
tabsetPanel(id="toptab",
tabPanel("Data entry",
wellPanel(
fluidRow(
tags$head(tags$style(HTML("label {font-size:80%;margin-bottom: 3px;margin-top: 3px;}"))),
column(2,
tags$image(src="logo.png", class="adv_logo"),
h4("upload EXCEL"),
fileInput(inputId = "iFile", label = "", accept="ms-excel"),
uiOutput(outputId = "sheetName"),
div(checkboxInput("PureErr", "Should pure error be used for calculation of CIs?", FALSE),
style = "font-size: 24px !important;color: red"),
verbatimTextOutput("stats"),
h5("\n\n\n Author: Franz Innerbichler, InnerAnalytics")),
div(id="parameter",
column(1,style = "background: lightgrey",
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),
numericInput("uppAsymptREF", "upper asymptote REF",110,step=1,min=0),
numericInput("uppAsymptTEST", "upper asymptote TEST",110,step=1,min=0)
),
column(1,style = "background: lightgrey",
numericInput("slopeREF", "slope REF",1,step=0.1,min=-10),
numericInput("slopeTEST", "slope TEST",1,step=0.1,min=-10),
numericInput("EC50", "EC50 REF",-3.5),
numericInput("potDiff", "potency difference",0)
),
column(1,style = "background: lightgreen",
h4("dilutions"),
numericInput("CONC1", "highest concentration",0.3, min=-3.5),
numericInput("CONC2", "2nd concentration",0.15),
numericInput("CONC3", "3rd concentration",0.075),
numericInput("CONC4", "4th concentration",0.0375),
numericInput("CONC5", "5th concentration",0.01875),
numericInput("CONC6", "6th concentration",0.00938)
),
column(1,style = "background: lightgreen",
numericInput("CONC7", "7th concentration",0.00469),
numericInput("CONC8", "8thd concentration",0.00235),
numericInput("CONC9", "9thd concentration",NA),
numericInput("CONC10", "10th concentration",NA),
numericInput("CONC11", "11th concentration",NA),
numericInput("CONC12", "lowest concentration",NA)
),
column(1,style = "background: lightblue",
h4("geometric dilution scheme"),
numericInput("ConcStart", "starting concentration",NA),
numericInput("dilutionFac", "dilution factor",NA),
numericInput("NoDil", "no. of dilutions",NA),
numericInput("NoDilSer", "no. of dil. series",NA),
verbatimTextOutput("dilutions")
),
column(4,
h4("log-dilution scheme"),
verbatimTextOutput("logdil"),
h4("User help"),
h5("If new dilutions are entered, please adjust EC50 to avoid calculation errors"))
)
)
)),
#### XLSX diagnostics ----
tabPanel ("XLSX diagnostics",
tags$style(HTML("pre { color: black; background-color: #FFE1FF;
font-family: 'Helvetica Neue', Helvetica, Arial, sans-serif;font-size: 12px;} ")),
wellPanel(
fluidRow(
column(2,
h5("Diagnostics only shown if EXCEL is uploaded"),
htmlOutput("PureErrW2"),
tags$head(tags$style("#PureErrW2{color: red;
font-size: 16px;
font_style: italic;}")),
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"),
h4("Akaike Information Criterion"),
tableOutput("AIC"),
h5("First row: restricted model; 2nd row: unrestricted model"),
h5("Smaller values of AIC indicate better fit to the data"),
tableOutput("VarDiagn")
),
column(4,
plotOutput("XLplot"),
column(6,
br(),
"Regression results restricted",
tableOutput("coeffs_r"),
"Bend points restricted",
tableOutput("coeffs_r2")),
column(6,
br(),
"Regression results unrestricted",
tableOutput("coeffs_unr"))),
column(4,
plotOutput("diagnplot"),
column(6,
tableOutput("logcoeffs_r"),
tableOutput("coeffs_unr2")),
column(6,
tableOutput("logcoeffs_unr"))),
column(2,
tableOutput("ANOVAXLS"),
DT::renderDataTable("EQtests"))
)
)),
#### 4pl fits ----
tabPanel("4pl-fit",
wellPanel(
fluidRow(
column(6,
tags$style(span(htmlOutput("PureErrW3"), style="color: red")),
htmlOutput("PureErrW3"),
tags$head(tags$style("#PureErrW2{color: red;
font-size: 16px;
font_style: italic;}")),
plotOutput("plot"),
DT::dataTableOutput("pottab4pl"),
"Footnote: test performed on absolute CIs."),
column(6,
DT::dataTableOutput("secondary"),
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%"))
))
),
#### Linear PLA ----
tabPanel("Linear PLA",
wellPanel(
fluidRow(
column(6,
htmlOutput("PureErrW3"),
tags$head(tags$style("#PureErrW2{color: red;
font-size: 16px;
font_style: italic;}")),
plotOutput("plotLin"),
"Delta method is used for potency CIs",
DT::dataTableOutput("pottab"),
h4("Unrestricted linear model (SSSI):"),
tableOutput("SummaryModABu"),
h4("Restricted linear model (CSSI):"),
tableOutput("SummaryModAB")),
column(3,
h3("Tests for linear PLA):"),
DT::dataTableOutput("TESTSlin"),
h5("The estimate is the p-value of the test"),
h5("F-tests on regression, significance of slopes, and preparation need to have a p-value <0.05 to pass"),
h5("All other tests pass if p-value > 0.05"),
"SST CI for difference of slopes:",
tableOutput("SlopeDiffCI")),
column(3,
h3("ANOVA for parallel line assay"),
DT::dataTableOutput("ANOVAlin"))
)
)),
#### Dilution simulator ----
tabPanel("Dilution simulator",
wellPanel(
fluidRow(
column(4,
h3("Confidence intervals"),
tableOutput("CIs"),
"The confidence intrval 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"))),
column(5,
plotOutput("plotfordilutions"),
h4("in grey: most extreme bend point lines of theoretical samples with 50% and 200% potency"),
sliderInput("dilslider", "Adjust the dilutions(+-change in %)", min = -100,max=100, value=0, step=1, round=0),
checkboxInput("fixupper","Fix highest concentration (if unticked, the center is fixed)",FALSE),
h5("Dilution factors"),
tableOutput("adjlogdil"),
"Short guidance: wider dilution ranges increase the CIs of rel. potency, and decrease the CIs of upper and lower asymptote ratios, as well as Hill's slope ratios", br(),
"Narrower dilution ranges decrease the CIs of rel. potency, and increase the CIs of upper and lower asymptote ratios, ands Hill's slope ratios",),
column(3,
h3("Bend points"),
tableOutput("bps"),
tableOutput("extremebps"),
h4("Explanation of the plots")
)
)
)),
#### EQ limits simulation ----
tabPanel("EQ-limit simulatioin",
wellPanel(
fluidRow(
column(1, style="background: lightblue",
numericInput("simN","number of datasets to simulate", 100, step=10, min=10, max=1000),
numericInput("lowQuant", "lower quantile", 1, min = 0.01,max=20),
numericInput("uppQuant", "upper quantile", 99, min = 801,max=99.99),
actionButton('goSim', "Start simulation",class="btn-success")
),
column(4,
h4("estimation of EACs for slope ratio, dynamic range-ratio, upper asymptote ratio, and potency"),
plotOutput("plotHistuAs", width = "1400px", height = "400px"))
)
)),
#### Documentation ----
tabPanel("Documentation",
h4("Information on dilution setting"),
"(for details see:", a(href="ADONIS.pdf","Whitepaper", download=NA, target="_blank"),")",tags$br(),
"Bend points are calculated according to following formula:",
withMathJax(" $$bp_{1/2} = \\pm\\frac{1.31696}{Hill's slope}$$"))),
#### setting lower panel ----
wellPanel(
fluidRow(
column(2,
h3("Settings"),
helpText("Vary the slider to see the effect of special cause"),
sliderInput("sdfac","Variability as % of lower to upper asymptote", max=10, value=3, min=0.1, step=0.1),
checkboxInput("heterosked","heteroskedastic noise", FALSE),
sliderInput("potencydiff","potency of test (%)", max=200, min=50, value=100, step=1),
sliderInput("outlL","outlier in lower asymptote", min=0, max=1.5, value=0, step=1),
sliderInput("outlM","outlier in mid part", min=0, max=1.5,value=0, step=1),
sliderInput("outlU","outlier in upper asymptote", min=0, max=1.5,value=0, step=1)
),
column(1,
tags$table(id="dose-table",
numericInput("lEACdiffla","lower EAC for diff. of LA", -0.175, step=0.001),
numericInput("uEACdiffla","upper EAC for diff. of LA", 0.189, step=0.001),
numericInput("lEACratiola","lower EAC ratio of LAs", 0.005, step=0.001),
numericInput("uEACratiola","upper EAC for ratio of LAs", 100, step=1),
numericInput("lEACratioSlope","lower EAC for ratio of slopes", 0.55, step=0.01),
numericInput("uEACratioSlope","upper EAC for ratio of slopes", 1.84, step=0.1),
numericInput("lEACratioua","lower EAC for ratio of UAs", 0.75, step=0.1),
numericInput("uEACratioua","upper EAC for ratio of UAs", 1.33, step=0.1),
numericInput("lowerPot","lower EAC for potency", 75, step=1),
numericInput("upperPot","upper EAC for potency", 133, step=1),
numericInput("lEACratioAdiff","lower EAC of ratio of asymptote differences", 0.75, step=0.01),
numericInput("uEACratioAdiff","upper EAC of ratio of asymptote differences", 1.33, step=0.01)
)),
column(4,
"4 PL ANOVA unrestricted",
DT::renderDataTable("ANOVA"),
h5("Please note that for the CIs of rel. potency the RSS of the restricted model is used"),
h5("RSS ... 'Residual error' in the SumSquares column"),
h5("MSE ... 'Residual error' in the MSs column"),
h5("SSE ... 'Pure error' in the SumSquares column"),
h5("RMSE ... Square root of the 'Residual Error' in the MS column"),
verbatimTextOutput("RMSE")
),
column(5,
DT::dataTableOutput("Conctab"))
)
)
)
)
}