diff --git a/MultiL3.xlsx b/MultiL3.xlsx
new file mode 100644
index 0000000..c44d0cc
Binary files /dev/null and b/MultiL3.xlsx differ
diff --git a/R/Global.R b/R/Global.R
index 26e6c07..29f0c68 100644
--- a/R/Global.R
+++ b/R/Global.R
@@ -1626,3 +1626,47 @@ bendFUN <- function(coeffsMR, coeffsMU) {
)
return(BPsMR_MU)
}
+
+#' Fitting of Gumbel location and scale parameters, and plotting function
+#'
+#'
+#' @param H Histogram density results with the mid-points of the histograms.
+#' @returns A ggplot object and a table of Gumbel quantiles 0.95, 0.99, and 0.999.
+#' @export
+#' @examples
+#' suppressMessages(source("../../dev/setup.R"))
+#'
+#' H = structure(list(breaks = c(1.02, 1.04, 1.06, 1.08, 1.1, 1.12, 1.14),
+#' counts = c(2L, 12L, 11L, 4L, 0L, 1L),
+#' density = c(3.33333333333333, 20, 18.3333333333333, 6.66666666666666, 0, 1.66666666666667),
+#' mids = c(1.03, 1.05, 1.07, 1.09, 1.11, 1.13), xname = 'UppAsympt',
+#' equidist = TRUE), class = "histogram")
+#' Titel <- "test"
+#'
+#' GumbPlotFUN(H)
+GumbPlotFUN <- function(H, Titel="Maximum deviation of confidence limit") {
+
+ H_df <- data.frame(Density = H[[3]], Mids=H[[4]])
+ startlist <- list(mu = 1.1, b = 1)
+
+ GuM <- gsl_nls(
+ fn = Density ~ 1/b*exp(-((Mids-mu)/b+exp(-(Mids-mu)/b))),
+ data = H_df,
+ start = startlist, # race=T,
+ control = gsl_nls_control(xtol = 1e-6, ftol = 1e-6, gtol = 1e-6)
+ )
+ SuGuM <- summary(GuM)$coefficients
+ X_gu <- seq(min(H[["breaks"]]), max(H[["breaks"]]), by=0.001)
+ DGu <- dgumbel(X_gu, loc=SuGuM[1,1], scale = SuGuM[2,1])
+ DGuDF <- data.frame(X = X_gu, Y = DGu)
+ Quantiles <- qgumbel(c(0.95,0.99,0.999),loc=SuGuM[1,1], scale = SuGuM[2,1] )
+ INV_Quantiles <- 1/Quantiles
+
+ p_gu <- ggplot(H_df) +
+ geom_col(mapping=aes(x=Mids, y=Density)) +
+ geom_line(DGuDF, mapping=aes(x=X, y=Y), inherit.aes = F) +
+ geom_vline(xintercept = Quantiles, linetype=2, col="blue") +
+ ggtitle(Titel) +
+ theme_bw()
+ return(list(p_gu, data.frame(Probabilities= c(0.95,0.99,0.999), INV_Quantiles,Quantiles)))
+}
diff --git a/dev/app.R b/dev/app.R
index 3cd7d4a..82fe6dd 100644
--- a/dev/app.R
+++ b/dev/app.R
@@ -374,9 +374,10 @@ server <- function(input, output, session) {
h4("Settings for report"),
useShinyjs(),
actionButton("btn", "Download 4PL PDF report", icon = icon("download")),
+
downloadButton("downloadXLReport", style = "visibility: hidden;"),
- #downloadButton("downloadXLReport", label = "Download 4PL PDF report", class = "butt"),
- tags$style(type = "text/css", "#downloadXLReport {background-color: orange; color: black;font-family: Courier New}"),
+
+ tags$style(type = "text/css", "#downloadXLReport {background-color: #4FCBD9; 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 = ""),
@@ -604,7 +605,7 @@ server <- function(input, output, session) {
#### UI wizard ----
output$wizard <- renderUI({
navbarPage(
- title = "Dilution setting",
+ title = "Optimizing wizard",
tabPanel(
"Plots",
sidebarLayout(
@@ -616,9 +617,12 @@ server <- function(input, output, session) {
title = "Upload multiple worksheets", status = "warning", solidHeader = TRUE, width = 12, "Please upload your EXCEL file here",
fileInput("MiFile", "", accept = ".xlsx")
),
- 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),
- sliderInput("dilmover", "Move the dilutions(+-move in log-units)", min = -3,max=3, value=0, step=0.1, round=1),
+ conditionalPanel(condition="input.tabs3 == 'Dilution slider'",
+ 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),
+ sliderInput("dilmover", "Move the dilutions(+-move in log-units)", min = -3,max=3, value=0, step=0.1, round=1),
+ ),
+
numericInput("TolConf","confidence", value=0.95, step=0.01),
numericInput("TolPop","population", value=0.9, step=0.01)
)
@@ -626,7 +630,7 @@ server <- function(input, output, session) {
mainPanel(
tabsetPanel(
id = "tabs3",
- tabPanel("4pl",
+ tabPanel("Sigmoid fits",
column(12,
@@ -634,15 +638,33 @@ server <- function(input, output, session) {
# tableOutput("CIs"),
# "The confidence interval table is interactive for changes in: variability slider (%SD), potency of test-slider,
# and 'Adjust the dilutions'-slider",
- # tableOutput("optimalDils"),
- plotOutput("sigPlotREF"),
- plotOutput("sigPlotTEST"),
+ plotOutput("sigPlotREF"),
+ plotOutput("sigPlotTEST")),
+ box(title = "INFO for sigmiod plots", status = "info", solidHeader = TRUE, collapsible = TRUE, width = 12,collapsed=T,
+ uiOutput('ExplTextOPTsigs'),
+
+ ),
+
+ column(8,
+ plotOutput("GuPlotUA")),
+ column(4, tableOutput("GuTabUA")),
+ column(8, plotOutput("GuPlotSLO")),
+ column(4,
+ tableOutput("GuTabSLO")),
+ box(title = "INFO for histograms", status = "info", solidHeader = TRUE, collapsible = TRUE, width = 12,collapsed=T,
+ uiOutput('ExplTextOPTGumbel'),
+ br()
+ )
#selectInput(inputId = "scenario", label = "Select an 'optimal' scenario:", choices = c("scenario 2", "scenario 3", "scenario 6", "steep slope"))
- )),
+ ),
tabPanel("Dilution slider",
h4("Adjust the dilutions"),
plotOutput("plotfordilutions"),
+ box(title = "INFO for sigmiod plots", status = "info", solidHeader = TRUE, collapsible = TRUE, width = 12,collapsed=T,
+ uiOutput('ExplTextOPTdils'),
+ ),
+
h5("Dilution factors"),
box(
title = "Adjusted dilutions", status = "primary", solidHeader = TRUE, width = 12, collapsible = TRUE,
@@ -655,10 +677,12 @@ server <- function(input, output, session) {
tabPanel("Plots",
h4("Histograms of parameters"),
plotOutput("linerangeCIs"),
+ column(6,
plotOutput("ratioSlope"),
- plotOutput("ratioLas"),
+ plotOutput("ratioLas")),
+ column(6,
plotOutput("ratioUas"),
- plotOutput("widthCIs"),
+ plotOutput("widthCIs")),
column(6,
plotOutput("histEC50REF"),
plotOutput("histLasREF"),
@@ -672,8 +696,7 @@ server <- function(input, output, session) {
),
tabPanel(
- "Report",
- h4("Settings for report"),
+ "Download",
#useShinyjs(),
#actionButton("btn2", "Download PDF report", icon = icon("download")),
downloadButton("downloadWizardData", label = "Download model and plots", class = "butt"),
@@ -748,19 +771,32 @@ server <- function(input, output, session) {
#### input Wizard XL file ----
observe({
if (!is.null(input$MiFile)) {
- MinFile <- input$MiFile
- ext <- tools::file_ext(MinFile$name)
- file.rename(MinFile$datapath, paste(MinFile$datapath, ".xlsx", sep = ""))
- t.filelocation <- gsub("\\\\", "/", paste(MinFile$datapath, ext, sep = "."))
- sheets <- openxlsx::getSheetNames(t.filelocation)
- dat <- lapply(sheets, openxlsx::read.xlsx, xlsxFile = t.filelocation)
- names(dat) <- sheets
- Dat$Mws <- dat
- names(Dat$Mws) <- sheets
- Dat$Msheets <- sheets
- Dat$MFileName <- input$MiFile[["name"]]
+ withProgress(message = "You clicked this button.... Working...", value =0 , {
+ MinFile <- input$MiFile
+ ext <- tools::file_ext(MinFile$name)
+ file.rename(MinFile$datapath, paste(MinFile$datapath, ".xlsx", sep = ""))
+ t.filelocation <- gsub("\\\\", "/", paste(MinFile$datapath, ext, sep = "."))
+ sheets <- openxlsx::getSheetNames(t.filelocation)
+
+ incProgress(.25,message = "Reading from EXCEL.... Working...")
+ dat <- lapply(sheets, openxlsx::read.xlsx, xlsxFile = t.filelocation)
+
+ incProgress(.35, message = "All WS read.... Working...")
+ names(dat) <- sheets
+ Dat$Mws <- dat
+ names(Dat$Mws) <- sheets
+ Dat$Msheets <- sheets
+ Dat$MFileName <- input$MiFile[["name"]]
+
+ #output$downloadData
+ incProgress(1, message = "Calculating...COMPLETE!")
+ # Sys.sleep to show message 1 sec
+ Sys.sleep(1)
+ })
+
}
})
+ observeEvent(input$MiFile, {showSpinner("sigPlotREF")})
#### process XLSX file ----
observe({
@@ -2251,7 +2287,7 @@ server <- function(input, output, session) {
})
- #### Meta plots all XL ----
+ #### Wizard plots all XL ----
observe({
if (!is.null(Dat$Mws)) {
@@ -2259,7 +2295,11 @@ server <- function(input, output, session) {
AllXL <- Dat$Mws
AllSheets <- Dat$Msheets
- URMcoefsL <- RMcoefsL <- potEstL <- list()
+
+
+
+
+ URMcoefsL <- RMcoefsL <- potEstL <- UAciL <- SLOciL <- list()
for (N_WS in 1:length(AllXL)) {
@@ -2283,7 +2323,7 @@ server <- function(input, output, session) {
CORro <- COR_FUNC(datWS[, logI], datWS[, 3])
}
Dat$datWS2 <- datWS2
-
+ #browser()
FITs <- Fitting_FUNC(datWS2, TransFlag = F, nameWS = nameWS)
if (!is.character(FITs)) {
pot_est <- FITs[[3]]
@@ -2295,6 +2335,10 @@ server <- function(input, output, session) {
URMcoefs <- t(matrix(unlist(URMcoefs1[,1])))
URMcoefs_ <- cbind(AllSheets[[N_WS]], URMcoefs)
URMcoefsL[[N_WS]] <- URMcoefs_
+ URMV_V <- SU_mu$cov.unscaled
+ SEsRMSE <- sqrt(diag(URMV_V) * SU_mu$sigma^2)
+ UAciL[[N_WS]] <- ParamCI_F(URMcoefs[1,7], URMcoefs[1,3], SEsRMSE[7],SEsRMSE[3], CoVar=0, SU_mu$df[2], Conf = 0.975)
+ SLOciL[[N_WS]] <- ParamCI_F(URMcoefs[1,6], URMcoefs[1,2], SEsRMSE[6],SEsRMSE[2], CoVar=0, SU_mu$df[2], Conf = 0.975)
SU_mr <- FITs[[1]]
RMcoefs1 <- SU_mr$coefficients
@@ -2316,6 +2360,12 @@ server <- function(input, output, session) {
}
} #for N_WS
+
+
+
+
+
+
#browser()
URMcoefsDF <- t(matrix(unlist(URMcoefsL),nrow=9))
colnames(URMcoefsDF) <- c("WS name", "lowerAs REF","slope REF","upperAs REF","EC50 REF", "lowerAs TEST","slope TEST","upperAs TEST","EC50 Difference")
@@ -2337,6 +2387,31 @@ server <- function(input, output, session) {
UasRatio <- UasTEST/UasREF
ratioDF <- data.frame(WS_name = URMcoefsDF[,1], slopeRatio = slopeRatio, LasRatio = LasRatio, UasRatio = UasRatio)
+ UAciM <- t(matrix(unlist(UAciL),nrow=2))
+ SLOciM <- t(matrix(unlist(SLOciL),nrow=2))
+ colnames(UAciM) <- c("lowerCL_upperA", "upperCL_upperA")
+ colnames(SLOciM) <- c("lowerCL_Hslope","upperCL_Hslope")
+ UAciDF <- data.frame("lowerCL_upperA" =UAciM[,1], "upperCL_upperA" = UAciM[,2],"reciLowerCI"= 1/UAciM[,1])
+ UAciDF$MaxDeviation <- apply(UAciDF, 1,max)
+ SLOciDF <- data.frame("lowerCL_upperA" =SLOciM[,1], "upperCL_upperA" = SLOciM[,2],"reciLowerCI"= 1/SLOciM[,1])
+ SLOciDF$MaxDeviation <- apply(SLOciDF, 1,max)
+ #browser()
+ H <- hist(UAciDF[,4])
+
+ GumbelL <- GumbPlotFUN(H, Titel="Histogram of max. deviation of upper asymptote ratio confidence limits")
+ p_gu <- GumbelL[[1]]
+ Gu_tab <- GumbelL[[2]]
+ output$GuPlotUA <- renderPlot({ p_gu })
+ output$GuTabUA <- renderTable({ Gu_tab }, digits=3)
+
+ H_s <- hist(SLOciDF[,4])
+
+ GumbelL_s <- GumbPlotFUN(H_s, Titel="Histogram of max. deviation of Hill's slope ratio confidence limits")
+ p_gu_s <- GumbelL_s[[1]]
+ Gu_tab_s <- GumbelL_s[[2]]
+ output$GuPlotSLO <- renderPlot({ p_gu_s })
+ output$GuTabSLO <- renderTable({ Gu_tab_s }, digits = 3)
+
RMcoefsDF <- t(matrix(unlist(RMcoefsL),nrow=6))
colnames(RMcoefsDF) <- c("WS name", "lower asymptote","Hill's slope","upper asymptote","log(EC50 ref)","logEC50 difference")
Dat$URMcoefsDF <- URMcoefsDF
@@ -2355,31 +2430,33 @@ server <- function(input, output, session) {
x_UA <- max(X); x_LA <- min(X)
} else { x_UA <- min(X); x_LA <- max(X) }
- #browser()
+#browser()
BoxDF <- data.frame(EC50REF = EC50REF, EC50TEST = EC50TEST, LasREF = LasREF, UasREF = UasREF)
UasParTolREF <- normtol.int(x = UasREF, alpha = 1-input$TolConf, P = input$TolPop, side = 2)
LasParTolREF <- normtol.int(x = LasREF, alpha = 1-input$TolConf, P = input$TolPop, side = 2)
- p1 <- ggplot(SIGrefDF, aes(x=X, y=sigRef, col=as.factor(Sheet))) +
- geom_line() +
- annotate("text", label="x", x=x_UA, y=UasREF, alpha=0.2) +
- annotate("text", label="o", x=x_LA, y=LasREF, alpha=0.2) +
- geom_hline(yintercept = c(UasParTolREF[[4]], UasParTolREF[[5]]), linetype=2, col="grey") +
- geom_hline(yintercept = c(LasParTolREF[[4]], LasParTolREF[[5]]), linetype=2, col="grey") +
- geom_vline(xintercept = EC50REF, alpha = 0.2) +
- scale_x_continuous(expand = c(0, 0)) +
- scale_y_continuous(expand = c(0, 0)) +
- expand_limits(y = c(min(SIGrefDF$sigRef) - 0.1 * diff(range(SIGrefDF$sigRef)),
- max(SIGrefDF$sigRef) + 0.1 * diff(range(SIGrefDF$sigRef)))) +
- expand_limits(x = c(min(SIGrefDF$X) - 0.1 * diff(range(SIGrefDF$X)),
- max(SIGrefDF$X) + 0.1 * diff(range(SIGrefDF$X)))) +
- xlab("dilutions") +
- ggtitle("REF sample 4PL-fits (unrestricted model, gray vertical lines: EC50)") +
- theme_bw() +
- theme(axis.text = element_text(face = "bold", size = 15),
- plot.title = element_text(size = 15, face = "bold"),
- plot.margin = unit(c(0.2, 0.2, 0.5, 0.5), "lines"))
+ p1 <- ggplot(SIGrefDF, aes(x=X, y=sigRef, col=as.factor(Sheet))) +
+ geom_line() +
+ annotate("text", label="x", x=x_UA, y=UasREF, alpha=0.2) +
+ annotate("text", label="o", x=x_LA, y=LasREF, alpha=0.2) +
+ geom_hline(yintercept = c(UasParTolREF[[4]], UasParTolREF[[5]]), linetype=2, col="grey") +
+ geom_hline(yintercept = c(LasParTolREF[[4]], LasParTolREF[[5]]), linetype=2, col="grey") +
+ geom_vline(xintercept = EC50REF, alpha = 0.2) +
+ scale_x_continuous(expand = c(0, 0)) +
+ scale_y_continuous(expand = c(0, 0)) +
+ expand_limits(y = c(min(SIGrefDF$sigRef) - 0.1 * diff(range(SIGrefDF$sigRef)),
+ max(SIGrefDF$sigRef) + 0.1 * diff(range(SIGrefDF$sigRef)))) +
+ expand_limits(x = c(min(SIGrefDF$X) - 0.1 * diff(range(SIGrefDF$X)),
+ max(SIGrefDF$X) + 0.1 * diff(range(SIGrefDF$X)))) +
+ xlab("dilutions") +
+ ggtitle("REF sample 4PL-fits (unrestricted model, gray vertical lines: EC50)") +
+ theme_bw() +
+ { if (nrow(SIGrefDF)>30) theme(legend.position="none") } +
+ theme(axis.text = element_text(face = "bold", size = 15),
+ plot.title = element_text(size = 15, face = "bold"),
+ plot.margin = unit(c(0.2, 0.2, 0.5, 0.5), "lines"))
+
output$sigPlotREF <- renderPlot({ p1 })
Dat$sigPlotREF <- p1
@@ -2396,6 +2473,7 @@ server <- function(input, output, session) {
xlab("dilutions") +
ggtitle("TEST sample 4PL-fits (unrestricted model, gray vertical lines: EC50)") +
theme_bw() +
+ { if (nrow(SIGtestDF)>30) theme(legend.position="none") } +
theme(axis.text = element_text(face = "bold", size = 15),
plot.title = element_text(size = 15, face = "bold"))
@@ -2403,7 +2481,10 @@ server <- function(input, output, session) {
Dat$sigPlotTEST <- p2
- #### histograms right panel ----
+
+
+
+ #### Wizard histograms ----
@@ -2424,23 +2505,26 @@ server <- function(input, output, session) {
# scale_x_continuous(
# breaks=seq(trunc(min(all_lPot$Potency_and_CI, na.rm=T)*10)/10, max(all_lPot$Potency_and_CI, na.rm=T)*1.1, by=0.4),
# ) +
+ xlab("Index of worksheets") +
theme_bw() +
theme(axis.text = element_text(face="bold", size=15),
axis.text.x = element_text(angle=90),
- plot.title= element_text(size=15, face="bold"))
+ plot.title= element_text(size=15, face="bold")) +
+ theme(legend.position="none")
#P_linerangeCI
output$linerangeCIs <- renderPlot({ P_linerangeCI })
- P_widthCIs <- ggplot(CalcPotDF, aes(x=width_CI, fill="blue")) +
- geom_histogram(color="#e9ecef", alpha=0.6, position = "identity") +
- geom_density(alpha = 0.1) +
+ P_widthCIs <- ggplot(CalcPotDF, aes(x=width_CI, fill="red"), ) +
+ geom_histogram(aes(y = after_stat(density)), bins = 10, position = "identity", alpha=0.6) +
+ geom_density(alpha = 0.5) +
#scale_fill_manual(values=c("darkgreen","darkblue","salmon2","tomato3")) +
labs(title = "Histogram of width of CLs", subtitle = paste("with upper",input$TolConf,input$TolPop, "tolerance interval")) +
- geom_vline(xintercept = widthCLTol[[5]]) +
+ geom_vline(xintercept = widthCLTol[[5]], linetype=2) +
theme_bw() +
theme(axis.text = element_text(face="bold", size=15),
axis.text.x = element_text(angle=90),
- plot.title= element_text(size=15, face="bold"))
+ plot.title= element_text(size=15, face="bold")) +
+ theme(legend.position="none")
output$widthCIs <- renderPlot({ P_widthCIs })
@@ -2449,41 +2533,44 @@ server <- function(input, output, session) {
UasTol <- normtol.int(x = UasRatio, alpha = 1-input$TolConf, P = input$TolPop, side = 2)
P_ratioSlope <- ggplot(ratioDF, aes(x=slopeRatio, fill="turquoise")) +
- geom_histogram(color="#e9ecef", alpha=0.6, position = "identity") +
+ geom_histogram(aes(y = after_stat(density)),color="#e9ecef", alpha=0.6, position = "identity",bins = 10) +
geom_density(alpha = 0.1) +
#scale_fill_manual(values=c("darkgreen","darkblue","salmon2","tomato3")) +
labs(title = "Histogram of Hill's slope ratios ", subtitle = paste("with",input$TolConf,input$TolPop, "tolerance interval")) +
- geom_vline(xintercept = c(SlopeTol[[4]], SlopeTol[[5]]), linetype=2, col="grey") +
+ geom_vline(xintercept = c(SlopeTol[[4]], SlopeTol[[5]]), linetype=2) +
theme_bw() +
theme(axis.text = element_text(face="bold", size=15),
axis.text.x = element_text(angle=90),
- plot.title= element_text(size=15, face="bold"))
+ plot.title= element_text(size=15, face="bold")) +
+ theme(legend.position="none")
output$ratioSlope <- renderPlot({ P_ratioSlope })
P_ratioLas <- ggplot(ratioDF, aes(x=LasRatio, fill="turquoise")) +
- geom_histogram(color="#e9ecef", alpha=0.6, position = "identity") +
+ geom_histogram(aes(y = after_stat(density)),color="#e9ecef", alpha=0.6, position = "identity", bins = 10) +
geom_density(alpha = 0.1) +
#scale_fill_manual(values=c("darkgreen","darkblue","salmon2","tomato3")) +
labs(title = "Histogram of lower asymptote ratios ", subtitle = paste("with",input$TolConf,input$TolPop, "tolerance interval")) +
- geom_vline(xintercept = c(LasTol[[4]], LasTol[[5]]), linetype=2, col="grey") +
+ geom_vline(xintercept = c(LasTol[[4]], LasTol[[5]]), linetype=2) +
theme_bw() +
theme(axis.text = element_text(face="bold", size=15),
axis.text.x = element_text(angle=90),
- plot.title= element_text(size=15, face="bold"))
+ plot.title= element_text(size=15, face="bold")) +
+ theme(legend.position="none")
output$ratioLas <- renderPlot({ P_ratioLas })
P_ratioUas <- ggplot(ratioDF, aes(x=UasRatio, fill="turquoise")) +
- geom_histogram(color="#e9ecef", alpha=0.6, position = "identity") +
+ geom_histogram(aes(y = after_stat(density)),color="#e9ecef", alpha=0.6, position = "identity", bins = 10) +
geom_density(alpha = 0.1) +
#scale_fill_manual(values=c("darkgreen","darkblue","salmon2","tomato3")) +
labs(title = "Histogram of upper asymptote ratios ", subtitle = paste("with",input$TolConf,input$TolPop, "tolerance interval")) +
- geom_vline(xintercept = c(UasTol[[4]], UasTol[[5]]), linetype=2, col="grey") +
+ geom_vline(xintercept = c(UasTol[[4]], UasTol[[5]]), linetype=2) +
theme_bw() +
theme(axis.text = element_text(face="bold", size=15),
axis.text.x = element_text(angle=90),
- plot.title= element_text(size=15, face="bold"))
+ plot.title= element_text(size=15, face="bold")) +
+ theme(legend.position="none")
output$ratioUas <- renderPlot({ P_ratioUas })
@@ -2537,41 +2624,7 @@ server <- function(input, output, session) {
Dat$newDils <- dils2
- #sigmoid <- sigmoid()
-
- # BPs <- Dat$bendpoints
- # EC50REF <- (BPs[2] + BPs[1]) / 2
- # Einh <- abs((BPs[2] - BPs[1]) / 5)
- # asyml <- EC50REF - 2 * (EC50REF - BPs[1])
- # asymu <- EC50REF + 2 * (EC50REF - BPs[1])
- #
- # det_sig <- Dat$coeffs_UN
- #
- # if (is.null(Dat$coeffs_UN)) {
- # SAMPLE50 <- sigmoid[1] + (sigmoid[3] - sigmoid[1]) / (1 + exp(sigmoid[5] * ((sigmoid[7] + 0.693147) - dils2)))
- # SAMPLE200 <- sigmoid[1] + (sigmoid[3] - sigmoid[1]) / (1 + exp(sigmoid[5] * ((sigmoid[7] - 0.693147) - dils2)))
- # Xbend50l <- sigmoid[7] + 0.693147 - 1.5434 / sigmoid[5]
- # Xbend200l <- sigmoid[7] - 0.693147 - 1.5434 / sigmoid[5]
- # Xbend50u <- sigmoid[7] + 0.693147 + 1.5434 / sigmoid[5]
- # Xbend200u <- sigmoid[7] - 0.693147 + 1.5434 / sigmoid[5]
- # Xbend50 <- max(Xbend50l, Xbend50u)
- # Xbend200 <- min(Xbend200l, Xbend200u)
- # dummy <- plot_f(tab)
- # } else {
- # SAMPLE50 <- det_sig[3] + (det_sig[5] - det_sig[3]) / (1 + exp(det_sig[1] * (det_sig[7] + 0.693147 - dils2)))
- # SAMPLE200 <- det_sig[3] + (det_sig[5] - det_sig[3]) / (1 + exp(det_sig[1] * (det_sig[7] - 0.693147 - dils2)))
- # Xbend50l <- det_sig[7] + 0.693147 - 1.5434 / det_sig[1]
- # Xbend200l <- det_sig[7] - 0.693147 - 1.5434 / det_sig[1]
- # Xbend50u <- det_sig[7] + 0.693147 + 1.5434 / det_sig[1]
- # Xbend200u <- det_sig[7] - 0.693147 + 1.5434 / det_sig[1]
- # Xbend50 <- max(Xbend50l, Xbend50u)
- # Xbend200 <- min(Xbend200l, Xbend200u)
- # dummy <- plot_f(tab)
- # }
- #
- #
- # pl_df <- cbind(dils2, SAMPLE50, SAMPLE200)
- #
+
output$adjlogdil <- renderTable({
adjlogdilfactors <- round(dilfactors, 3)
@@ -2620,6 +2673,8 @@ server <- function(input, output, session) {
} # if (!is.null(p2))
} # if !is.null Dat$Mws
+
+
})
#### Dilutions CI table ----
@@ -3057,6 +3112,28 @@ server <- function(input, output, session) {
}, contentType = "application/zip"
)
+
+ output$ExplTextOPTsigs = renderUI({
+ HTML("Note: The plots above contain the sigmiod fits of all uploaded worksheets, separated for reference and test, as long as a fit was possible.
+ The estimated upper and lower asymptotes are shown with a grey 'x' or 'o' at each side of the plots.
+ The horizontal grey dashed lines indicate the tolerance interval of the asymptotes.
+ Please note that the asymptotes are often not normally distributed, or contain different groups, when the assay setup was changed.
+ Therefore the tolerance interval should be seen as a gross surrogate.")
+ })
+ output$ExplTextOPTGumbel = renderUI({
+ HTML("Note: The histograms show the 'maximum deviation' of the confidence interval.
+ The 'maximum deviation' is either the upper confidence limit, or 1/lower confidence limit, whichever is greater.
+ The blue dashed lines are the 0.95, 0.99 and 0.999 quantiles of the distribution.
+ The tables on the right list the 0.95, 0.99 and 0.999 quantiles, and the inverses thereof, i.e. 1/quantiles.
+ Thus, the number pairs are symmetric on a log-scale. Any of the number-pairs can be used to set the equivalence limits.")
+ })
+ output$ExplTextOPTdils = renderUI({
+ HTML("Note: All sigmoids of the test samples are shown, because the test samples contain a wider variability, with stability and forced degradation samples.
+ To adjust the width of the dilution range, draw the slider to the left to shrink or to the right to increase the range.
+ Once the width is set, move the dilution range to the right or to the left, using the 2nd slider.
+ The dilutions and the steps inbetween are annotated in red on the plot.
+ The table below shows again the dilution concentrations and the steps.")
+ })
}
shinyApp(ui, server)