merge conflict resolved app.R updated
Build and deploy Roxygen2|pkgdown documentation site / build-and-deploy-documentation (push) Successful in 46s
run tests / build-and-deploy-documentation (push) Successful in 8s

This commit is contained in:
2026-06-04 10:27:28 +02:00
parent 058027f721
commit f5575f8429
4 changed files with 325 additions and 320 deletions
Vendored
BIN
View File
Binary file not shown.
+3
View File
@@ -5,6 +5,9 @@
.Ruserdata
.positai
.png
.DS_Store
www/.DS_Store
dev/www/.DS_Store
man
docs
pkgdown
BIN
View File
Binary file not shown.
+322 -320
View File
@@ -340,7 +340,10 @@ server <- function(input, output, session) {
tabPanel(
"Report",
h4("Settings for report"),
downloadButton("downloadXLReport", label = "Download 4PL PDF report", class = "butt"),
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}"),
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}"),
@@ -582,6 +585,7 @@ 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")
)
)
)
),
@@ -594,25 +598,26 @@ server <- function(input, output, session) {
title = "ANOVA table", status = "primary", solidHeader = TRUE, width = 12,
tableOutput("Anovatab")
),
column(
4,
h3("Confidence intervals"),
tableOutput("CIs"),
"The confidence interval table is interaactive for changes in: variability slider (%SD), potency of test-slider,
and 'Adjust the dilutions'-slider",
tableOutput("optimalDils"),
column(8,
# h3("Confidence intervals"),
# tableOutput("CIs"),
# "The confidence interval table is interaactive for changes in: variability slider (%SD), potency of test-slider,
# and 'Adjust the dilutions'-slider",
# tableOutput("optimalDils"),
plotOutput("sigPlotREF"),
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(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,
@@ -2107,289 +2112,279 @@ server <- function(input, output, session) {
#### Dilutions Simulator ----
output$plotfordilutions <- renderPlot({
if (!is.null(Dat$Mws)) {
AllXL <- Dat$Mws
}
AllXL <- Dat$Mws
AllSheets <- Dat$Msheets
URMcoefsL <- list()
for (N_WS in 1:length(AllXL)) {
datWS <- as.data.frame(AllXL[[N_WS]])
datWS <- as.data.frame(AllXL[[N_WS]])
cn <- colnames(datWS)
logI <- grep("log|ln", cn)
logDoseI <- grep("log_dose", cn)
if (length(logI) > 0 & length(logDoseI) == 0) {
datWS$log_dose <- datWS[, logI]
datWS2 <- datWS[, -logI]
CORro <- cor(datWS$log_dose, datWS[, 3])
} else if (length(logI) == 0 & length(logDoseI) == 0) {
Ind <- grep(".ilution|.ose|.onc", cn)
datWS$log_dose <- log(datWS[, Ind])
CORro <- cor(datWS[, Ind], datWS[, 3])
datWS2 <- datWS[, -Ind]
} else if (length(logI) > 0 & length(logDoseI) > 0) {
datWS2 <- datWS
CORro <- cor(datWS[, logI], datWS[, 3])
}
Dat$datWS2 <- datWS2
FITs <- Fitting_FUNC(datWS2, TransFlag = F)
pot_est <- FITs[[3]]
potU_est <- FITs[[4]]
# unrestricted
SU_mu <- FITs[[2]]
URMcoefs1 <- SU_mu$coefficients
URMcoefs <- t(matrix(unlist(URMcoefs1[,1])))
URMcoefs_ <- cbind(AllSheets[[N_WS]], URMcoefs)
URMcoefsL[[N_WS]] <- URMcoefs_
X <- seq(min(datWS2$log_dose), max(datWS2$log_dose), 0.1)
sigRef <- URMcoefs[1,1] + (URMcoefs[1,3]-URMcoefs[1,1])/(1+exp(URMcoefs[1,2]*(URMcoefs[1,4]-X)))
sigTest1 <- URMcoefs[1,5] + (URMcoefs[1,7]-URMcoefs[1,5])/(1+exp(URMcoefs[1,6]*(URMcoefs[1,4] - URMcoefs[1,8]-X)))
#browser()
dfPlotsigRef <- data.frame(X=X, sigRef = sigRef, Sheet = AllSheets[[N_WS]])
dfPlotsigTest <- data.frame(X=X, sigTest = sigTest1, Sheet = AllSheets[[N_WS]])
if (!exists("SIGrefDF")) SIGrefDF <- dfPlotsigRef else SIGrefDF <- rbind(SIGrefDF, dfPlotsigRef)
if (!exists("SIGtestDF")) SIGtestDF <- dfPlotsigTest else SIGtestDF <- rbind(SIGtestDF,dfPlotsigTest)
cn <- colnames(datWS)
logI <- grep("log|ln", cn)
logDoseI <- grep("log_dose", cn)
if (length(logI) > 0 & length(logDoseI) == 0) {
datWS$log_dose <- datWS[, logI]
datWS2 <- datWS[, -logI]
CORro <- cor(datWS$log_dose, datWS[, 3])
} else if (length(logI) == 0 & length(logDoseI) == 0) {
Ind <- grep(".ilution|.ose|.onc", cn)
datWS$log_dose <- log(datWS[, Ind])
CORro <- cor(datWS[, Ind], datWS[, 3])
datWS2 <- datWS[, -Ind]
} else if (length(logI) > 0 & length(logDoseI) > 0) {
datWS2 <- datWS
CORro <- cor(datWS[, logI], datWS[, 3])
}
Dat$datWS2 <- datWS2
} #for N_WS
#browser()
URMcoefsDF <- t(matrix(unlist(URMcoefsL),nrow=9))
EC50TEST <- as.numeric(URMcoefsDF[,5]) - as.numeric(URMcoefsDF[,9])
# EC50TEST <- EC50TEST[!EC50TEST %in% boxplot.stats(EC50TEST)$out]
EC50REF <- as.numeric(URMcoefsDF[,5])
# EC50REF <- EC50REF[!EC50REF %in% boxplot.stats(EC50REF)$out]
UasREF <- as.numeric(URMcoefsDF[,4])
# UasREF <- UasREF[!UasREF %in% boxplot.stats(UasREF)$out]
LasREF <- as.numeric(URMcoefsDF[,2])
# LasREF <- LasREF[!LasREF %in% boxplot.stats(LasREF)$out]
#
# Dat$URMcoefsDF <- URMcoefsDF
# Dat$RestrM <- RestrM
# Dat$CalcPot <- CalcPot
#
#### sigmoid plots ----
Slope <- as.numeric(URMcoefsDF[1,3])
if (Slope > 0) {
x_UA <- max(X); x_LA <- min(X)
} else { x_UA <- min(X); x_LA <- max(X) }
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_vline(xintercept = EC50REF, alpha = 0.2) +
xlab("dilutions") +
ggtitle("Plot of all calculated reference fits (unrestricted model, in gray vertical lines: EC50)") +
theme_bw() +
theme(axis.text = element_text(face = "bold", size = 15),
plot.title = element_text(size = 15, face = "bold"))
FITs <- Fitting_FUNC(datWS2, TransFlag = FALSE)
output$sigPlotREF <- renderPlot({ p1 })
pot_est <- FITs[[3]]
potU_est <- FITs[[4]]
# unrestricted
SU_mu <- FITs[[2]]
URMcoeffs <- SU_mu$coefficients
X <- seq(min(log(datWS23$log_dose)), max(log(datWS2$log_dose)), 0.1)
sigRef <- URMcoefs[1, 1] + (URMcoefs1[4, 1] - URMcoefs[1, 1]) / (1 + exp(URMcoefs[2, 1] * (URMcoefs[3, 1] - X)))
sigTest1 <- URMcoefs[5, 1] + (URMcoefs[8, 1] - URMcoefs[5, 1]) / (1 + exp(URMcoefs[6, 1] * (URMcoefs[7, 1] - X)))
dfPlotsigRef <- data.frame(X = X, sigRef = sigRef, Prod = pdfInd)
dfPlotsigTest <- data.frame(X = X, sigTest = sigTest1, Prod = AllSheets[[N_WS]])
if (!exists("SIGrefDF")) SIGrefDF <- dfPlotsigRef else SIGrefDF <- rbind(SIGrefDF, dfPlotsigRef)
if (!exists("SIGtestDF")) SIGtestDF <- dfPlotsigTest else SIGtestDF <- rbind(SIGtestDF, dfPlotsigTest)
EC50TEST <- as.numeric(c(URMcoefsDF[, 8]))
# EC50TEST <- EC50TEST[!EC50TEST %in% boxplot.stats(EC50TEST)$out]
EC50REF <- as.numeric(URMcoefsDF[, 4])
# EC50REF <- EC50REF[!EC50REF %in% boxplot.stats(EC50REF)$out]
UasREF <- as.numeric(URMcoefsDF[, 5])
# UasREF <- UasREF[!UasREF %in% boxplot.stats(UasREF)$out]
LasREF <- as.numeric(URMcoefsDF[, 2])
# LasREF <- LasREF[!LasREF %in% boxplot.stats(LasREF)$out]
#
# Dat$URMcoefsDF <- URMcoefsDF
# Dat$RestrM <- RestrM
# Dat$CalcPot <- CalcPot
#
#### sigmoid plots ----
Slope <- as.numeric(URMcoefsDF[1, 3])
# if (Slope > 0) {
# x_UA <- max(X); x_LA <- min(X)
# } else { x_UA <- min(X); x_LA <- max(X) }
#
# p1 <- ggplot(SIGrefDF, aes(x_X, y=sigRef, col=as.factor(Prod))) +
# 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_vline(xintercept = EC50REF, alpha = 0.2) +
# xlab("dilutions") +
# ggtitle("Plot of all calculated reference fits (unrestricted model, in gray vertical lines: EC50)") +
# theme_bw() +
# theme(axis.text = element_text(face = "bold", size = 15),
# plot.title = element_text(size = 15, face = "bold"))
#
# output$sigPlotREF <- renderPlot({ p1 })
#
# PLOTS$sigPlotREF <- p1
#
# p2 <- ggplot(SIGtestDF, aes(x_X, y=sigTest, col=as.factor(Prod))) +
# 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_vline(xintercept = EC50TEST, alpha = 0.2) +
# xlab("dilutions") +
# ggtitle("Plot of all calculated reference fits (unrestricted model, in gray vertical lines: EC50)") +
# theme_bw() +
# theme(axis.text = element_text(face = "bold", size = 15),
# plot.title = element_text(size = 15, face = "bold"))
#
# output$sigPlotREF <- renderPlot({ p2 })
#
# PLOTS$sigPlotTEST <- p2
# PLOTS$sigPlotREF <- p1
#
# p2 <- ggplot(SIGtestDF, aes(x_X, y=sigTest, col=as.factor(Prod))) +
# 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_vline(xintercept = EC50TEST, alpha = 0.2) +
# xlab("dilutions") +
# ggtitle("Plot of all calculated reference fits (unrestricted model, in gray vertical lines: EC50)") +
# theme_bw() +
# theme(axis.text = element_text(face = "bold", size = 15),
# plot.title = element_text(size = 15, face = "bold"))
#
# output$sigPlotREF <- renderPlot({ p2 })
#
# PLOTS$sigPlotTEST <- p2
# dils <- tab$log_dose
# min_y <- min(tab[, 1:3])
# max_y <- max(tab[, 1:3])
#
# if (input$fixupper) {
# dils_av <- dils - max(dils)
# dils_av_ <- dils_av * (input$dilslider / 100 + 1)
# dils2 <- round(dils_av_ + max(dils), 4)
# dilfactors <- 1 / exp(dils2 - lag(dils2))
# } else {
# if (!is.null(Dat$cfordils)) {
# av <- Dat$cfordils
# } else {
# av <- (min(dils) + max(dils)) / 2
# }
# dils_av <- dils - av
# dils_avsc <- dils_av * (input$dilslider / 100 + 1)
# dils2 <- dils_avsc + av
# dilfactors <- 1 / exp(dils2 - lag(dils2))
# }
#Dat$newDils <- dils2
dils <- tab$log_dose
min_y <- min(tab[, 1:3])
max_y <- max(tab[, 1:3])
#sigmoid <- sigmoid()
if (input$fixupper) {
dils_av <- dils - max(dils)
dils_av_ <- dils_av * (input$dilslider / 100 + 1)
dils2 <- round(dils_av_ + max(dils), 4)
dilfactors <- 1 / exp(dils2 - lag(dils2))
} else {
if (!is.null(Dat$cfordils)) {
av <- Dat$cfordils
} else {
av <- (min(dils) + max(dils)) / 2
}
dils_av <- dils - av
dils_avsc <- dils_av * (input$dilslider / 100 + 1)
dils2 <- dils_avsc + av
dilfactors <- 1 / exp(dils2 - lag(dils2))
}
} # for N_WS
# 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)
# adjlogdils <- round(dils2, 3)
# adjdils <- round(exp(dils2), 3)
# DilsTable <- data.frame(
# "adjusted ln(dilutions)" = adjlogdils,
# "adjusted ln_dilution_factors" = adjlogdilfactors,
# "adjusted dilutions" = adjdils
# )
# DilsTable
# })
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)
# if (!is.null(Dat$p2)) {
# p2 <- Dat$p2
# p_dil <- p2 +
# annotate("pointrange", x = dils2, y = rep(min_y, length(dils2)), xmin = min(dils2), xmax = max(dils2)) +
# annotate("text", x = dils2, y = rep(min_y + (max_y - min_y) * 0.05, length(dils2)), label = as.character(round(dils2, 3))) +
# annotate("text",
# x = dils2[-1] + (max(dils2) - min(dils2)) * 0.05,
# y = rep(min_y + (max_y - min_y) * 0.1, length(dils2[-1])),
# label = as.character(round(dilfactors[-1], 3))
# ) +
# geom_line(
# data = as.data.frame(pl_df), aes(x = dils2, y = SAMPLE50), color = "grey15", linetype = 2,
# inherit.aes = F
# ) +
# geom_line(
# data = as.data.frame(pl_df), aes(x = dils2, y = SAMPLE200), color = "grey15", linetype = 2,
# inherit.aes = F
# ) +
# geom_vline(xintercept = c(Xbend50, Xbend200), col = "grey15", linetype = 2) +
# {
# if (input$scenario == "scenario 6") {
# annotate("pointrange",
# x = optdils2, y = rep(min_y + (max_y - min_y) * 0.2, length(optdils2)),
# xmin = min(optdils2), xmax = max(optdils2), color = "seagreen"
# )
# }
# } +
# {
# if (input$scenario == "scenario 6") {
# annotate("text",
# x = optdils2, y = rep(min_y + (max_y - min_y) * 0.25, length(optdils2)),
# label = as.character(round(optdils2, 3)), color = "seagreen"
# )
# }
# } +
# {
# if (input$scenario == "scenario 2") {
# annotate("pointrange",
# x = optdils, y = rep(min_y + (max_y - min_y) * 0.2, length(optdils)),
# xmin = min(optdils), xmax = max(optdils), color = "seagreen"
# )
# }
# } +
# {
# if (input$scenario == "scenario 2") {
# annotate("text",
# x = optdils, y = rep(min_y + (max_y - min_y) * 0.25, length(optdils)),
# label = as.character(round(optdils, 3)), color = "seagreen"
# )
# }
# } +
# {
# if (input$scenario == "scenario 3") {
# annotate("pointrange",
# x = optdils_3, y = rep(min_y + (max_y - min_y) * 0.2, length(optdils_3)),
# xmin = min(optdils_3), xmax = max(optdils_3), color = "seagreen"
# )
# }
# } +
# {
# if (input$scenario == "scenario 3") {
# annotate("text",
# x = optdils_3, y = rep(min_y + (max_y - min_y) * 0.25, length(optdils_3)),
# label = as.character(round(optdils_3, 3)), color = "seagreen"
# )
# }
# } +
# {
# if (input$scenario == "steep slope") {
# annotate("pointrange",
# x = optdils3, y = rep(min_y + (max_y - min_y) * 0.2, length(optdils3)),
# xmin = min(optdils3), xmax = max(optdils3), color = "seagreen"
# )
# }
# } +
# {
# if (input$scenario == "steep slope") {
# annotate("text",
# x = optdils3, y = rep(min_y + (max_y - min_y) * 0.25, length(optdils3)),
# label = as.character(round(optdils3, 3)), color = "seagreen"
# )
# }
# } +
# annotate("text",
# x = optdils[1], y = (max_y + min_y) * 0.5,
# label = paste("in green: optimal \n dilutions acc. to Whitepaper\n", input$scenario), color = "seagreen",
# size = 14 / .pt, fontface = "bold"
# )
# }
#print(p_dil)
# }
}
pl_df <- cbind(dils2, SAMPLE50, SAMPLE200)
# scenario2
eqSpac <- abs((BPs[1] - BPs[2]) / 5)
optdils <- c((asyml + BPs[1]) / 2, BPs[1], BPs[1] + 1 * eqSpac, BPs[1] + 2 * eqSpac, BPs[1] + 3 * eqSpac, BPs[1] + 4 * eqSpac, BPs[2], (asymu + BPs[2]) / 2)
# scenario 3
eqSpac_3 <- abs((BPs[1] - BPs[2]) / 3)
optdils_3 <- c(BPs[1] - 2 * eqSpac_3, BPs[1] - eqSpac_3, BPs[1], BPs[1] + 1 * eqSpac_3, BPs[1] + 2 * eqSpac_3, BPs[2], BPs[2] + eqSpac_3, BPs[2] + 2 * eqSpac_3)
# scenario 6
Einh2 <- abs(((BPs[2] - BPs[1]) * 0.7) / 5)
eqSpac2 <- (2 * 0.7 / Einh) / 3
optdils2 <- c((asyml + BPs[1]) / 2, BPs[1], EC50REF - 1.5 * Einh2, EC50REF - 0.5 * Einh2, EC50REF + 0.5 * Einh2, EC50REF + 1.5 * Einh2, BPs[2], (asymu + BPs[2]) / 2)
# steep slope
eqSpac3 <- (abs(Xbend200 - Xbend50)) / 5
optdils3 <- c(Xbend200 - eqSpac3, Xbend200, Xbend200 + 1 * eqSpac3, Xbend200 + 2 * eqSpac3, Xbend200 + 3 * eqSpac3, Xbend200 + 4 * eqSpac3, Xbend50, Xbend50 + eqSpac3)
output$extremebps <- renderTable({
ExtremeBPs <- c(Xbend50, Xbend200)
DF2 <- data.frame(sample = c("50% sample (right)", "200% sample (left)"), Extreme_BPs = ExtremeBPs)
DF2
})
optD <- data.frame(cbind(optdils, optdils_3, optdils2, optdils3))
colnames(optD) <- c("scenario2", "scenario3", "scenario6", "steep slope")
output$optimalDils <- renderTable({
optD
})
output$adjlogdil <- renderTable({
adjlogdilfactors <- round(dilfactors, 3)
adjlogdils <- round(dils2, 3)
adjdils <- round(exp(dils2), 3)
DilsTable <- data.frame(
"adjusted ln(dilutions)" = adjlogdils,
"adjusted ln_dilution_factors" = adjlogdilfactors,
"adjusted dilutions" = adjdils
)
DilsTable
})
if (!is.null(Dat$p2)) {
p2 <- Dat$p2
p_dil <- p2 +
annotate("pointrange", x = dils2, y = rep(min_y, length(dils2)), xmin = min(dils2), xmax = max(dils2)) +
annotate("text", x = dils2, y = rep(min_y + (max_y - min_y) * 0.05, length(dils2)), label = as.character(round(dils2, 3))) +
annotate("text",
x = dils2[-1] + (max(dils2) - min(dils2)) * 0.05,
y = rep(min_y + (max_y - min_y) * 0.1, length(dils2[-1])),
label = as.character(round(dilfactors[-1], 3))
) +
geom_line(
data = as.data.frame(pl_df), aes(x = dils2, y = SAMPLE50), color = "grey15", linetype = 2,
inherit.aes = FALSE
) +
geom_line(
data = as.data.frame(pl_df), aes(x = dils2, y = SAMPLE200), color = "grey15", linetype = 2,
inherit.aes = FALSE
) +
geom_vline(xintercept = c(Xbend50, Xbend200), col = "grey15", linetype = 2) +
{
if (input$scenario == "scenario 6") {
annotate("pointrange",
x = optdils2, y = rep(min_y + (max_y - min_y) * 0.2, length(optdils2)),
xmin = min(optdils2), xmax = max(optdils2), color = "seagreen"
)
}
} +
{
if (input$scenario == "scenario 6") {
annotate("text",
x = optdils2, y = rep(min_y + (max_y - min_y) * 0.25, length(optdils2)),
label = as.character(round(optdils2, 3)), color = "seagreen"
)
}
} +
{
if (input$scenario == "scenario 2") {
annotate("pointrange",
x = optdils, y = rep(min_y + (max_y - min_y) * 0.2, length(optdils)),
xmin = min(optdils), xmax = max(optdils), color = "seagreen"
)
}
} +
{
if (input$scenario == "scenario 2") {
annotate("text",
x = optdils, y = rep(min_y + (max_y - min_y) * 0.25, length(optdils)),
label = as.character(round(optdils, 3)), color = "seagreen"
)
}
} +
{
if (input$scenario == "scenario 3") {
annotate("pointrange",
x = optdils_3, y = rep(min_y + (max_y - min_y) * 0.2, length(optdils_3)),
xmin = min(optdils_3), xmax = max(optdils_3), color = "seagreen"
)
}
} +
{
if (input$scenario == "scenario 3") {
annotate("text",
x = optdils_3, y = rep(min_y + (max_y - min_y) * 0.25, length(optdils_3)),
label = as.character(round(optdils_3, 3)), color = "seagreen"
)
}
} +
{
if (input$scenario == "steep slope") {
annotate("pointrange",
x = optdils3, y = rep(min_y + (max_y - min_y) * 0.2, length(optdils3)),
xmin = min(optdils3), xmax = max(optdils3), color = "seagreen"
)
}
} +
{
if (input$scenario == "steep slope") {
annotate("text",
x = optdils3, y = rep(min_y + (max_y - min_y) * 0.25, length(optdils3)),
label = as.character(round(optdils3, 3)), color = "seagreen"
)
}
} +
annotate("text",
x = optdils[1], y = (max_y + min_y) * 0.5,
label = paste("in green: optimal \n dilutions acc. to Whitepaper\n", input$scenario), color = "seagreen",
size = 14 / .pt, fontface = "bold"
)
}
print(p_dil)
})
#### Dilutions CI table ----
@@ -2642,38 +2637,45 @@ server <- function(input, output, session) {
#### download XL 4PL report----
observe({
if (is.null(Dat$FITsFlag)) {
return(NULL)
}
if (!Dat$FITsFlag) {
browser()
output$downloadXLReport <- downloadHandler(
filename = paste0("Report_4PLEvaluation", Dat$RepIdentifier, ".pdf"),
content = function(file) {
tpdr <- tempdir()
tempReport <- file.path(tpdr, "Doc_BioassayReport.Rmd")
file.copy("Doc_BioassayReport.Rmd", tempReport, overwrite = TRUE)
tempReportc <- file.path(tpdr, "logov2.png")
file.copy("logov2.png", tempReportc, overwrite = TRUE)
rmarkdown::render(tempReport,
output_file = file,
params = list(
FileName = Dat$FileName,
author = Dat$Author,
NoP = Dat$NoP,
Assay = Dat$Assay,
REP = REP,
coeffs = Dat$coeffs_UN
),
envir = new.env(parent = globalenv())
)
}
)
observeEvent(input$btn, {
if(!Dat$FITsFlag) {
runjs("$('#downloadXLReport')[0].click();")
} else {
showModal(modalDialog(
title = "No 4PL model to Download",
"Please select other data before download.",
easyClose = TRUE,
footer = NULL
))
}
})
output$downloadXLReport <- downloadHandler(
filename = paste0("Report_4PLEvaluation", Dat$RepIdentifier, ".pdf"),
content = function(file) {
tpdr <- tempdir()
tempReport <- file.path(tpdr, "Doc_BioassayReport.Rmd")
file.copy("Doc_BioassayReport.Rmd", tempReport, overwrite = T)
tempReportc <- file.path(tpdr, "logov2.png")
file.copy("logov2.png", tempReportc, overwrite = T)
rmarkdown::render(tempReport,
output_file = file,
params = list(
FileName = Dat$FileName,
author = Dat$Author,
NoP = Dat$NoP,
Assay = Dat$Assay,
REP = REP,
coeffs = Dat$coeffs_UN
),
envir = new.env(parent = globalenv())
)
}
)
#### download XL Lin report----