XLSX with 300WSs added, INFO boxes added to OPTIMIZE
This commit is contained in:
1 parent
e263ba66e4
commit
be376b096c
3 files changed
+185
-64
No files matched your search
Binary file not shown.
+44
@@ -1626,3 +1626,47 @@ bendFUN <- function(coeffsMR, coeffsMU) {
|
|||||||
)
|
)
|
||||||
return(BPsMR_MU)
|
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"),
|
h4("Settings for report"),
|
||||||
useShinyjs(),
|
useShinyjs(),
|
||||||
actionButton("btn", "Download 4PL PDF report", icon = icon("download")),
|
actionButton("btn", "Download 4PL PDF report", icon = icon("download")),
|
||||||
|
|
||||||
downloadButton("downloadXLReport", style = "visibility: hidden;"),
|
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"),
|
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}"),
|
tags$style(type = "text/css", "#downloadXLReportLin {background-color: #4FCBD9; color: black;font-family: Courier New}"),
|
||||||
textInput("Author", "Author", value = ""),
|
textInput("Author", "Author", value = ""),
|
||||||
@@ -604,7 +605,7 @@ server <- function(input, output, session) {
|
|||||||
#### UI wizard ----
|
#### UI wizard ----
|
||||||
output$wizard <- renderUI({
|
output$wizard <- renderUI({
|
||||||
navbarPage(
|
navbarPage(
|
||||||
title = "Dilution setting",
|
title = "Optimizing wizard",
|
||||||
tabPanel(
|
tabPanel(
|
||||||
"Plots",
|
"Plots",
|
||||||
sidebarLayout(
|
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",
|
title = "Upload multiple worksheets", status = "warning", solidHeader = TRUE, width = 12, "Please upload your EXCEL file here",
|
||||||
fileInput("MiFile", "", accept = ".xlsx")
|
fileInput("MiFile", "", accept = ".xlsx")
|
||||||
),
|
),
|
||||||
|
conditionalPanel(condition="input.tabs3 == 'Dilution slider'",
|
||||||
sliderInput("dilslider", "Adjust the dilutions(+-change in %)", min = -100,max=100, value=0, step=1, round=0),
|
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),
|
#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),
|
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("TolConf","confidence", value=0.95, step=0.01),
|
||||||
numericInput("TolPop","population", value=0.9, step=0.01)
|
numericInput("TolPop","population", value=0.9, step=0.01)
|
||||||
)
|
)
|
||||||
@@ -626,7 +630,7 @@ server <- function(input, output, session) {
|
|||||||
mainPanel(
|
mainPanel(
|
||||||
tabsetPanel(
|
tabsetPanel(
|
||||||
id = "tabs3",
|
id = "tabs3",
|
||||||
tabPanel("4pl",
|
tabPanel("Sigmoid fits",
|
||||||
|
|
||||||
|
|
||||||
column(12,
|
column(12,
|
||||||
@@ -634,15 +638,33 @@ server <- function(input, output, session) {
|
|||||||
# tableOutput("CIs"),
|
# tableOutput("CIs"),
|
||||||
# "The confidence interval table is interactive for changes in: variability slider (%SD), potency of test-slider,
|
# "The confidence interval table is interactive for changes in: variability slider (%SD), potency of test-slider,
|
||||||
# and 'Adjust the dilutions'-slider",
|
# and 'Adjust the dilutions'-slider",
|
||||||
# tableOutput("optimalDils"),
|
|
||||||
plotOutput("sigPlotREF"),
|
plotOutput("sigPlotREF"),
|
||||||
plotOutput("sigPlotTEST"),
|
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"))
|
#selectInput(inputId = "scenario", label = "Select an 'optimal' scenario:", choices = c("scenario 2", "scenario 3", "scenario 6", "steep slope"))
|
||||||
|
|
||||||
)),
|
),
|
||||||
tabPanel("Dilution slider",
|
tabPanel("Dilution slider",
|
||||||
h4("Adjust the dilutions"),
|
h4("Adjust the dilutions"),
|
||||||
plotOutput("plotfordilutions"),
|
plotOutput("plotfordilutions"),
|
||||||
|
box(title = "INFO for sigmiod plots", status = "info", solidHeader = TRUE, collapsible = TRUE, width = 12,collapsed=T,
|
||||||
|
uiOutput('ExplTextOPTdils'),
|
||||||
|
),
|
||||||
|
|
||||||
h5("Dilution factors"),
|
h5("Dilution factors"),
|
||||||
box(
|
box(
|
||||||
title = "Adjusted dilutions", status = "primary", solidHeader = TRUE, width = 12, collapsible = TRUE,
|
title = "Adjusted dilutions", status = "primary", solidHeader = TRUE, width = 12, collapsible = TRUE,
|
||||||
@@ -655,10 +677,12 @@ server <- function(input, output, session) {
|
|||||||
tabPanel("Plots",
|
tabPanel("Plots",
|
||||||
h4("Histograms of parameters"),
|
h4("Histograms of parameters"),
|
||||||
plotOutput("linerangeCIs"),
|
plotOutput("linerangeCIs"),
|
||||||
|
column(6,
|
||||||
plotOutput("ratioSlope"),
|
plotOutput("ratioSlope"),
|
||||||
plotOutput("ratioLas"),
|
plotOutput("ratioLas")),
|
||||||
|
column(6,
|
||||||
plotOutput("ratioUas"),
|
plotOutput("ratioUas"),
|
||||||
plotOutput("widthCIs"),
|
plotOutput("widthCIs")),
|
||||||
column(6,
|
column(6,
|
||||||
plotOutput("histEC50REF"),
|
plotOutput("histEC50REF"),
|
||||||
plotOutput("histLasREF"),
|
plotOutput("histLasREF"),
|
||||||
@@ -672,8 +696,7 @@ server <- function(input, output, session) {
|
|||||||
|
|
||||||
),
|
),
|
||||||
tabPanel(
|
tabPanel(
|
||||||
"Report",
|
"Download",
|
||||||
h4("Settings for report"),
|
|
||||||
#useShinyjs(),
|
#useShinyjs(),
|
||||||
#actionButton("btn2", "Download PDF report", icon = icon("download")),
|
#actionButton("btn2", "Download PDF report", icon = icon("download")),
|
||||||
downloadButton("downloadWizardData", label = "Download model and plots", class = "butt"),
|
downloadButton("downloadWizardData", label = "Download model and plots", class = "butt"),
|
||||||
@@ -748,19 +771,32 @@ server <- function(input, output, session) {
|
|||||||
#### input Wizard XL file ----
|
#### input Wizard XL file ----
|
||||||
observe({
|
observe({
|
||||||
if (!is.null(input$MiFile)) {
|
if (!is.null(input$MiFile)) {
|
||||||
|
withProgress(message = "You clicked this button.... Working...", value =0 , {
|
||||||
MinFile <- input$MiFile
|
MinFile <- input$MiFile
|
||||||
ext <- tools::file_ext(MinFile$name)
|
ext <- tools::file_ext(MinFile$name)
|
||||||
file.rename(MinFile$datapath, paste(MinFile$datapath, ".xlsx", sep = ""))
|
file.rename(MinFile$datapath, paste(MinFile$datapath, ".xlsx", sep = ""))
|
||||||
t.filelocation <- gsub("\\\\", "/", paste(MinFile$datapath, ext, sep = "."))
|
t.filelocation <- gsub("\\\\", "/", paste(MinFile$datapath, ext, sep = "."))
|
||||||
sheets <- openxlsx::getSheetNames(t.filelocation)
|
sheets <- openxlsx::getSheetNames(t.filelocation)
|
||||||
|
|
||||||
|
incProgress(.25,message = "Reading from EXCEL.... Working...")
|
||||||
dat <- lapply(sheets, openxlsx::read.xlsx, xlsxFile = t.filelocation)
|
dat <- lapply(sheets, openxlsx::read.xlsx, xlsxFile = t.filelocation)
|
||||||
|
|
||||||
|
incProgress(.35, message = "All WS read.... Working...")
|
||||||
names(dat) <- sheets
|
names(dat) <- sheets
|
||||||
Dat$Mws <- dat
|
Dat$Mws <- dat
|
||||||
names(Dat$Mws) <- sheets
|
names(Dat$Mws) <- sheets
|
||||||
Dat$Msheets <- sheets
|
Dat$Msheets <- sheets
|
||||||
Dat$MFileName <- input$MiFile[["name"]]
|
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 ----
|
#### process XLSX file ----
|
||||||
observe({
|
observe({
|
||||||
@@ -2251,7 +2287,7 @@ server <- function(input, output, session) {
|
|||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
#### Meta plots all XL ----
|
#### Wizard plots all XL ----
|
||||||
observe({
|
observe({
|
||||||
if (!is.null(Dat$Mws)) {
|
if (!is.null(Dat$Mws)) {
|
||||||
|
|
||||||
@@ -2259,7 +2295,11 @@ server <- function(input, output, session) {
|
|||||||
AllXL <- Dat$Mws
|
AllXL <- Dat$Mws
|
||||||
AllSheets <- Dat$Msheets
|
AllSheets <- Dat$Msheets
|
||||||
|
|
||||||
URMcoefsL <- RMcoefsL <- potEstL <- list()
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
URMcoefsL <- RMcoefsL <- potEstL <- UAciL <- SLOciL <- list()
|
||||||
|
|
||||||
for (N_WS in 1:length(AllXL)) {
|
for (N_WS in 1:length(AllXL)) {
|
||||||
|
|
||||||
@@ -2283,7 +2323,7 @@ server <- function(input, output, session) {
|
|||||||
CORro <- COR_FUNC(datWS[, logI], datWS[, 3])
|
CORro <- COR_FUNC(datWS[, logI], datWS[, 3])
|
||||||
}
|
}
|
||||||
Dat$datWS2 <- datWS2
|
Dat$datWS2 <- datWS2
|
||||||
|
#browser()
|
||||||
FITs <- Fitting_FUNC(datWS2, TransFlag = F, nameWS = nameWS)
|
FITs <- Fitting_FUNC(datWS2, TransFlag = F, nameWS = nameWS)
|
||||||
if (!is.character(FITs)) {
|
if (!is.character(FITs)) {
|
||||||
pot_est <- FITs[[3]]
|
pot_est <- FITs[[3]]
|
||||||
@@ -2295,6 +2335,10 @@ server <- function(input, output, session) {
|
|||||||
URMcoefs <- t(matrix(unlist(URMcoefs1[,1])))
|
URMcoefs <- t(matrix(unlist(URMcoefs1[,1])))
|
||||||
URMcoefs_ <- cbind(AllSheets[[N_WS]], URMcoefs)
|
URMcoefs_ <- cbind(AllSheets[[N_WS]], URMcoefs)
|
||||||
URMcoefsL[[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]]
|
SU_mr <- FITs[[1]]
|
||||||
RMcoefs1 <- SU_mr$coefficients
|
RMcoefs1 <- SU_mr$coefficients
|
||||||
@@ -2316,6 +2360,12 @@ server <- function(input, output, session) {
|
|||||||
}
|
}
|
||||||
} #for N_WS
|
} #for N_WS
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
#browser()
|
#browser()
|
||||||
URMcoefsDF <- t(matrix(unlist(URMcoefsL),nrow=9))
|
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")
|
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
|
UasRatio <- UasTEST/UasREF
|
||||||
ratioDF <- data.frame(WS_name = URMcoefsDF[,1], slopeRatio = slopeRatio, LasRatio = LasRatio, UasRatio = UasRatio)
|
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))
|
RMcoefsDF <- t(matrix(unlist(RMcoefsL),nrow=6))
|
||||||
colnames(RMcoefsDF) <- c("WS name", "lower asymptote","Hill's slope","upper asymptote","log(EC50 ref)","logEC50 difference")
|
colnames(RMcoefsDF) <- c("WS name", "lower asymptote","Hill's slope","upper asymptote","log(EC50 ref)","logEC50 difference")
|
||||||
Dat$URMcoefsDF <- URMcoefsDF
|
Dat$URMcoefsDF <- URMcoefsDF
|
||||||
@@ -2376,10 +2451,12 @@ server <- function(input, output, session) {
|
|||||||
xlab("dilutions") +
|
xlab("dilutions") +
|
||||||
ggtitle("REF sample 4PL-fits (unrestricted model, gray vertical lines: EC50)") +
|
ggtitle("REF sample 4PL-fits (unrestricted model, gray vertical lines: EC50)") +
|
||||||
theme_bw() +
|
theme_bw() +
|
||||||
|
{ if (nrow(SIGrefDF)>30) theme(legend.position="none") } +
|
||||||
theme(axis.text = element_text(face = "bold", size = 15),
|
theme(axis.text = element_text(face = "bold", size = 15),
|
||||||
plot.title = element_text(size = 15, face = "bold"),
|
plot.title = element_text(size = 15, face = "bold"),
|
||||||
plot.margin = unit(c(0.2, 0.2, 0.5, 0.5), "lines"))
|
plot.margin = unit(c(0.2, 0.2, 0.5, 0.5), "lines"))
|
||||||
|
|
||||||
|
|
||||||
output$sigPlotREF <- renderPlot({ p1 })
|
output$sigPlotREF <- renderPlot({ p1 })
|
||||||
Dat$sigPlotREF <- p1
|
Dat$sigPlotREF <- p1
|
||||||
|
|
||||||
@@ -2396,6 +2473,7 @@ server <- function(input, output, session) {
|
|||||||
xlab("dilutions") +
|
xlab("dilutions") +
|
||||||
ggtitle("TEST sample 4PL-fits (unrestricted model, gray vertical lines: EC50)") +
|
ggtitle("TEST sample 4PL-fits (unrestricted model, gray vertical lines: EC50)") +
|
||||||
theme_bw() +
|
theme_bw() +
|
||||||
|
{ if (nrow(SIGtestDF)>30) theme(legend.position="none") } +
|
||||||
theme(axis.text = element_text(face = "bold", size = 15),
|
theme(axis.text = element_text(face = "bold", size = 15),
|
||||||
plot.title = element_text(size = 15, face = "bold"))
|
plot.title = element_text(size = 15, face = "bold"))
|
||||||
|
|
||||||
@@ -2403,7 +2481,10 @@ server <- function(input, output, session) {
|
|||||||
|
|
||||||
Dat$sigPlotTEST <- p2
|
Dat$sigPlotTEST <- p2
|
||||||
|
|
||||||
#### histograms right panel ----
|
|
||||||
|
|
||||||
|
|
||||||
|
#### Wizard histograms ----
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -2424,23 +2505,26 @@ server <- function(input, output, session) {
|
|||||||
# scale_x_continuous(
|
# 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),
|
# 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_bw() +
|
||||||
theme(axis.text = element_text(face="bold", size=15),
|
theme(axis.text = element_text(face="bold", size=15),
|
||||||
axis.text.x = element_text(angle=90),
|
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
|
#P_linerangeCI
|
||||||
output$linerangeCIs <- renderPlot({ P_linerangeCI })
|
output$linerangeCIs <- renderPlot({ P_linerangeCI })
|
||||||
|
|
||||||
P_widthCIs <- ggplot(CalcPotDF, aes(x=width_CI, fill="blue")) +
|
P_widthCIs <- ggplot(CalcPotDF, aes(x=width_CI, fill="red"), ) +
|
||||||
geom_histogram(color="#e9ecef", alpha=0.6, position = "identity") +
|
geom_histogram(aes(y = after_stat(density)), bins = 10, position = "identity", alpha=0.6) +
|
||||||
geom_density(alpha = 0.1) +
|
geom_density(alpha = 0.5) +
|
||||||
#scale_fill_manual(values=c("darkgreen","darkblue","salmon2","tomato3")) +
|
#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")) +
|
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_bw() +
|
||||||
theme(axis.text = element_text(face="bold", size=15),
|
theme(axis.text = element_text(face="bold", size=15),
|
||||||
axis.text.x = element_text(angle=90),
|
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 })
|
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)
|
UasTol <- normtol.int(x = UasRatio, alpha = 1-input$TolConf, P = input$TolPop, side = 2)
|
||||||
|
|
||||||
P_ratioSlope <- ggplot(ratioDF, aes(x=slopeRatio, fill="turquoise")) +
|
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) +
|
geom_density(alpha = 0.1) +
|
||||||
#scale_fill_manual(values=c("darkgreen","darkblue","salmon2","tomato3")) +
|
#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")) +
|
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_bw() +
|
||||||
theme(axis.text = element_text(face="bold", size=15),
|
theme(axis.text = element_text(face="bold", size=15),
|
||||||
axis.text.x = element_text(angle=90),
|
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 })
|
output$ratioSlope <- renderPlot({ P_ratioSlope })
|
||||||
|
|
||||||
P_ratioLas <- ggplot(ratioDF, aes(x=LasRatio, fill="turquoise")) +
|
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) +
|
geom_density(alpha = 0.1) +
|
||||||
#scale_fill_manual(values=c("darkgreen","darkblue","salmon2","tomato3")) +
|
#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")) +
|
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_bw() +
|
||||||
theme(axis.text = element_text(face="bold", size=15),
|
theme(axis.text = element_text(face="bold", size=15),
|
||||||
axis.text.x = element_text(angle=90),
|
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 })
|
output$ratioLas <- renderPlot({ P_ratioLas })
|
||||||
|
|
||||||
P_ratioUas <- ggplot(ratioDF, aes(x=UasRatio, fill="turquoise")) +
|
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) +
|
geom_density(alpha = 0.1) +
|
||||||
#scale_fill_manual(values=c("darkgreen","darkblue","salmon2","tomato3")) +
|
#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")) +
|
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_bw() +
|
||||||
theme(axis.text = element_text(face="bold", size=15),
|
theme(axis.text = element_text(face="bold", size=15),
|
||||||
axis.text.x = element_text(angle=90),
|
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 })
|
output$ratioUas <- renderPlot({ P_ratioUas })
|
||||||
|
|
||||||
@@ -2537,41 +2624,7 @@ server <- function(input, output, session) {
|
|||||||
Dat$newDils <- dils2
|
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({
|
output$adjlogdil <- renderTable({
|
||||||
adjlogdilfactors <- round(dilfactors, 3)
|
adjlogdilfactors <- round(dilfactors, 3)
|
||||||
@@ -2620,6 +2673,8 @@ server <- function(input, output, session) {
|
|||||||
} # if (!is.null(p2))
|
} # if (!is.null(p2))
|
||||||
} # if !is.null Dat$Mws
|
} # if !is.null Dat$Mws
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
})
|
})
|
||||||
|
|
||||||
#### Dilutions CI table ----
|
#### Dilutions CI table ----
|
||||||
@@ -3057,6 +3112,28 @@ server <- function(input, output, session) {
|
|||||||
|
|
||||||
}, contentType = "application/zip"
|
}, 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)
|
shinyApp(ui, server)
|
||||||
Reference in new issue
Block a user