XLSX with 300WSs added, INFO boxes added to OPTIMIZE
This commit is contained in:
Guxa committed
1 parent
e263ba66e4
commit
be376b096c
3 files changed
+221
-100
No files matched your search
Binary file not shown.
+44
@@ -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)))
|
||||
}
|
||||
@@ -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("<b>Note</b>: 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("<b>Note</b>: 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("<b>Note</b>: 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)
|
||||
Reference in new issue
Block a user