merge conflict resolved app.R updated
This commit is contained in:
@@ -5,6 +5,9 @@
|
||||
.Ruserdata
|
||||
.positai
|
||||
.png
|
||||
.DS_Store
|
||||
www/.DS_Store
|
||||
dev/www/.DS_Store
|
||||
man
|
||||
docs
|
||||
pkgdown
|
||||
|
||||
Vendored
BIN
Binary file not shown.
@@ -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]])
|
||||
|
||||
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
|
||||
datWS <- as.data.frame(AllXL[[N_WS]])
|
||||
|
||||
FITs <- Fitting_FUNC(datWS2, TransFlag = FALSE)
|
||||
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
|
||||
|
||||
pot_est <- FITs[[3]]
|
||||
potU_est <- FITs[[4]]
|
||||
# unrestricted
|
||||
SU_mu <- FITs[[2]]
|
||||
URMcoeffs <- SU_mu$coefficients
|
||||
FITs <- Fitting_FUNC(datWS2, TransFlag = F)
|
||||
|
||||
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)))
|
||||
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_
|
||||
|
||||
dfPlotsigRef <- data.frame(X = X, sigRef = sigRef, Prod = pdfInd)
|
||||
dfPlotsigTest <- data.frame(X = X, sigTest = sigTest1, Prod = AllSheets[[N_WS]])
|
||||
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)
|
||||
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
|
||||
} #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"))
|
||||
|
||||
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
|
||||
|
||||
|
||||
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))
|
||||
}
|
||||
} # for N_WS
|
||||
# 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
|
||||
|
||||
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])
|
||||
#Dat$newDils <- dils2
|
||||
|
||||
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)
|
||||
#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)
|
||||
# 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 = 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,39 +2637,46 @@ 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----
|
||||
|
||||
output$downloadXLReportLin <- downloadHandler(
|
||||
|
||||
Reference in New Issue
Block a user