merge conflict resolved app.R updated
This commit is contained in:
@@ -5,6 +5,9 @@
|
|||||||
.Ruserdata
|
.Ruserdata
|
||||||
.positai
|
.positai
|
||||||
.png
|
.png
|
||||||
|
.DS_Store
|
||||||
|
www/.DS_Store
|
||||||
|
dev/www/.DS_Store
|
||||||
man
|
man
|
||||||
docs
|
docs
|
||||||
pkgdown
|
pkgdown
|
||||||
|
|||||||
Vendored
BIN
Binary file not shown.
@@ -340,7 +340,10 @@ server <- function(input, output, session) {
|
|||||||
tabPanel(
|
tabPanel(
|
||||||
"Report",
|
"Report",
|
||||||
h4("Settings for 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}"),
|
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"),
|
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}"),
|
||||||
@@ -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",
|
title = "Upload multiple worksheets", status = "warning", solidHeader = TRUE, width = 12, "Please upload your EXCEL file here",
|
||||||
fileInput("MiFile", "", accept = ".xlsx")
|
fileInput("MiFile", "", accept = ".xlsx")
|
||||||
)
|
)
|
||||||
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
@@ -594,25 +598,26 @@ server <- function(input, output, session) {
|
|||||||
title = "ANOVA table", status = "primary", solidHeader = TRUE, width = 12,
|
title = "ANOVA table", status = "primary", solidHeader = TRUE, width = 12,
|
||||||
tableOutput("Anovatab")
|
tableOutput("Anovatab")
|
||||||
),
|
),
|
||||||
column(
|
|
||||||
4,
|
column(8,
|
||||||
h3("Confidence intervals"),
|
# h3("Confidence intervals"),
|
||||||
tableOutput("CIs"),
|
# tableOutput("CIs"),
|
||||||
"The confidence interval table is interaactive for changes in: variability slider (%SD), potency of test-slider,
|
# "The confidence interval table is interaactive for changes in: variability slider (%SD), potency of test-slider,
|
||||||
and 'Adjust the dilutions'-slider",
|
# and 'Adjust the dilutions'-slider",
|
||||||
tableOutput("optimalDils"),
|
# tableOutput("optimalDils"),
|
||||||
|
plotOutput("sigPlotREF"),
|
||||||
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"))
|
||||||
),
|
),
|
||||||
column(
|
column(5,
|
||||||
5,
|
|
||||||
plotOutput("plotfordilutions"),
|
plotOutput("plotfordilutions"),
|
||||||
h4("in grey: most extreme bend point lines of theoretical samples with 50% and 200% potency"),
|
# 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),
|
# 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),
|
||||||
h5("Dilution factors"),
|
# h5("Dilution factors"),
|
||||||
tableOutput("adjlogdil"),
|
# 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(),
|
# "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",
|
# "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(
|
column(
|
||||||
3,
|
3,
|
||||||
@@ -2107,12 +2112,15 @@ server <- function(input, output, session) {
|
|||||||
#### Dilutions Simulator ----
|
#### Dilutions Simulator ----
|
||||||
output$plotfordilutions <- renderPlot({
|
output$plotfordilutions <- renderPlot({
|
||||||
if (!is.null(Dat$Mws)) {
|
if (!is.null(Dat$Mws)) {
|
||||||
|
|
||||||
|
|
||||||
AllXL <- Dat$Mws
|
AllXL <- Dat$Mws
|
||||||
}
|
|
||||||
AllSheets <- Dat$Msheets
|
AllSheets <- Dat$Msheets
|
||||||
|
|
||||||
|
URMcoefsL <- list()
|
||||||
|
|
||||||
for (N_WS in 1:length(AllXL)) {
|
for (N_WS in 1:length(AllXL)) {
|
||||||
|
|
||||||
datWS <- as.data.frame(AllXL[[N_WS]])
|
datWS <- as.data.frame(AllXL[[N_WS]])
|
||||||
|
|
||||||
cn <- colnames(datWS)
|
cn <- colnames(datWS)
|
||||||
@@ -2133,29 +2141,36 @@ server <- function(input, output, session) {
|
|||||||
}
|
}
|
||||||
Dat$datWS2 <- datWS2
|
Dat$datWS2 <- datWS2
|
||||||
|
|
||||||
FITs <- Fitting_FUNC(datWS2, TransFlag = FALSE)
|
FITs <- Fitting_FUNC(datWS2, TransFlag = F)
|
||||||
|
|
||||||
pot_est <- FITs[[3]]
|
pot_est <- FITs[[3]]
|
||||||
potU_est <- FITs[[4]]
|
potU_est <- FITs[[4]]
|
||||||
# unrestricted
|
# unrestricted
|
||||||
SU_mu <- FITs[[2]]
|
SU_mu <- FITs[[2]]
|
||||||
URMcoeffs <- SU_mu$coefficients
|
URMcoefs1 <- SU_mu$coefficients
|
||||||
|
URMcoefs <- t(matrix(unlist(URMcoefs1[,1])))
|
||||||
|
URMcoefs_ <- cbind(AllSheets[[N_WS]], URMcoefs)
|
||||||
|
URMcoefsL[[N_WS]] <- URMcoefs_
|
||||||
|
|
||||||
X <- seq(min(log(datWS23$log_dose)), max(log(datWS2$log_dose)), 0.1)
|
X <- seq(min(datWS2$log_dose), max(datWS2$log_dose), 0.1)
|
||||||
sigRef <- URMcoefs[1, 1] + (URMcoefs1[4, 1] - URMcoefs[1, 1]) / (1 + exp(URMcoefs[2, 1] * (URMcoefs[3, 1] - X)))
|
sigRef <- URMcoefs[1,1] + (URMcoefs[1,3]-URMcoefs[1,1])/(1+exp(URMcoefs[1,2]*(URMcoefs[1,4]-X)))
|
||||||
sigTest1 <- URMcoefs[5, 1] + (URMcoefs[8, 1] - URMcoefs[5, 1]) / (1 + exp(URMcoefs[6, 1] * (URMcoefs[7, 1] - 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, Prod = pdfInd)
|
dfPlotsigRef <- data.frame(X=X, sigRef = sigRef, Sheet = AllSheets[[N_WS]])
|
||||||
dfPlotsigTest <- data.frame(X = X, sigTest = sigTest1, Prod = 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("SIGrefDF")) SIGrefDF <- dfPlotsigRef else SIGrefDF <- rbind(SIGrefDF, dfPlotsigRef)
|
||||||
if (!exists("SIGtestDF")) SIGtestDF <- dfPlotsigTest else SIGtestDF <- rbind(SIGtestDF,dfPlotsigTest)
|
if (!exists("SIGtestDF")) SIGtestDF <- dfPlotsigTest else SIGtestDF <- rbind(SIGtestDF,dfPlotsigTest)
|
||||||
|
|
||||||
EC50TEST <- as.numeric(c(URMcoefsDF[, 8]))
|
} #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]
|
# EC50TEST <- EC50TEST[!EC50TEST %in% boxplot.stats(EC50TEST)$out]
|
||||||
EC50REF <- as.numeric(URMcoefsDF[, 4])
|
EC50REF <- as.numeric(URMcoefsDF[,5])
|
||||||
# EC50REF <- EC50REF[!EC50REF %in% boxplot.stats(EC50REF)$out]
|
# EC50REF <- EC50REF[!EC50REF %in% boxplot.stats(EC50REF)$out]
|
||||||
UasREF <- as.numeric(URMcoefsDF[, 5])
|
UasREF <- as.numeric(URMcoefsDF[,4])
|
||||||
# UasREF <- UasREF[!UasREF %in% boxplot.stats(UasREF)$out]
|
# UasREF <- UasREF[!UasREF %in% boxplot.stats(UasREF)$out]
|
||||||
LasREF <- as.numeric(URMcoefsDF[,2])
|
LasREF <- as.numeric(URMcoefsDF[,2])
|
||||||
# LasREF <- LasREF[!LasREF %in% boxplot.stats(LasREF)$out]
|
# LasREF <- LasREF[!LasREF %in% boxplot.stats(LasREF)$out]
|
||||||
@@ -2165,24 +2180,25 @@ server <- function(input, output, session) {
|
|||||||
# Dat$CalcPot <- CalcPot
|
# Dat$CalcPot <- CalcPot
|
||||||
#
|
#
|
||||||
#### sigmoid plots ----
|
#### sigmoid plots ----
|
||||||
|
|
||||||
Slope <- as.numeric(URMcoefsDF[1,3])
|
Slope <- as.numeric(URMcoefsDF[1,3])
|
||||||
# if (Slope > 0) {
|
if (Slope > 0) {
|
||||||
# x_UA <- max(X); x_LA <- min(X)
|
x_UA <- max(X); x_LA <- min(X)
|
||||||
# } else { x_UA <- min(X); x_LA <- max(X) }
|
} else { x_UA <- min(X); x_LA <- max(X) }
|
||||||
#
|
|
||||||
# p1 <- ggplot(SIGrefDF, aes(x_X, y=sigRef, col=as.factor(Prod))) +
|
p1 <- ggplot(SIGrefDF, aes(x=X, y=sigRef, col=as.factor(Sheet))) +
|
||||||
# geom_line() +
|
geom_line() +
|
||||||
# annotate("text", label="x", x=x_UA, y=UasREF, alpha=0.2) +
|
annotate("text", label="x", x=x_UA, y=UasREF, alpha=0.2) +
|
||||||
# annotate("text", label="o", x=x_LA, y=LasREF, alpha=0.2) +
|
annotate("text", label="o", x=x_LA, y=LasREF, alpha=0.2) +
|
||||||
# geom_vline(xintercept = EC50REF, alpha = 0.2) +
|
geom_vline(xintercept = EC50REF, alpha = 0.2) +
|
||||||
# xlab("dilutions") +
|
xlab("dilutions") +
|
||||||
# ggtitle("Plot of all calculated reference fits (unrestricted model, in gray vertical lines: EC50)") +
|
ggtitle("Plot of all calculated reference fits (unrestricted model, in gray vertical lines: EC50)") +
|
||||||
# theme_bw() +
|
theme_bw() +
|
||||||
# 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"))
|
||||||
#
|
|
||||||
# output$sigPlotREF <- renderPlot({ p1 })
|
output$sigPlotREF <- renderPlot({ p1 })
|
||||||
#
|
|
||||||
# PLOTS$sigPlotREF <- p1
|
# PLOTS$sigPlotREF <- p1
|
||||||
#
|
#
|
||||||
# p2 <- ggplot(SIGtestDF, aes(x_X, y=sigTest, col=as.factor(Prod))) +
|
# p2 <- ggplot(SIGtestDF, aes(x_X, y=sigTest, col=as.factor(Prod))) +
|
||||||
@@ -2201,195 +2217,174 @@ server <- function(input, output, session) {
|
|||||||
# PLOTS$sigPlotTEST <- p2
|
# PLOTS$sigPlotTEST <- p2
|
||||||
|
|
||||||
|
|
||||||
dils <- tab$log_dose
|
# dils <- tab$log_dose
|
||||||
min_y <- min(tab[, 1:3])
|
# min_y <- min(tab[, 1:3])
|
||||||
max_y <- max(tab[, 1:3])
|
# max_y <- max(tab[, 1:3])
|
||||||
|
#
|
||||||
if (input$fixupper) {
|
# if (input$fixupper) {
|
||||||
dils_av <- dils - max(dils)
|
# dils_av <- dils - max(dils)
|
||||||
dils_av_ <- dils_av * (input$dilslider / 100 + 1)
|
# dils_av_ <- dils_av * (input$dilslider / 100 + 1)
|
||||||
dils2 <- round(dils_av_ + max(dils), 4)
|
# dils2 <- round(dils_av_ + max(dils), 4)
|
||||||
dilfactors <- 1 / exp(dils2 - lag(dils2))
|
# dilfactors <- 1 / exp(dils2 - lag(dils2))
|
||||||
} else {
|
# } else {
|
||||||
if (!is.null(Dat$cfordils)) {
|
# if (!is.null(Dat$cfordils)) {
|
||||||
av <- Dat$cfordils
|
# av <- Dat$cfordils
|
||||||
} else {
|
# } else {
|
||||||
av <- (min(dils) + max(dils)) / 2
|
# av <- (min(dils) + max(dils)) / 2
|
||||||
}
|
# }
|
||||||
dils_av <- dils - av
|
# dils_av <- dils - av
|
||||||
dils_avsc <- dils_av * (input$dilslider / 100 + 1)
|
# dils_avsc <- dils_av * (input$dilslider / 100 + 1)
|
||||||
dils2 <- dils_avsc + av
|
# dils2 <- dils_avsc + av
|
||||||
dilfactors <- 1 / exp(dils2 - lag(dils2))
|
# dilfactors <- 1 / exp(dils2 - lag(dils2))
|
||||||
}
|
# }
|
||||||
} # for N_WS
|
|
||||||
|
|
||||||
|
|
||||||
Dat$newDils <- dils2
|
|
||||||
|
|
||||||
sigmoid <- sigmoid()
|
|
||||||
|
|
||||||
BPs <- Dat$bendpoints
|
#Dat$newDils <- dils2
|
||||||
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)) {
|
#sigmoid <- sigmoid()
|
||||||
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)))
|
# BPs <- Dat$bendpoints
|
||||||
Xbend50l <- sigmoid[7] + 0.693147 - 1.5434 / sigmoid[5]
|
# EC50REF <- (BPs[2] + BPs[1]) / 2
|
||||||
Xbend200l <- sigmoid[7] - 0.693147 - 1.5434 / sigmoid[5]
|
# Einh <- abs((BPs[2] - BPs[1]) / 5)
|
||||||
Xbend50u <- sigmoid[7] + 0.693147 + 1.5434 / sigmoid[5]
|
# asyml <- EC50REF - 2 * (EC50REF - BPs[1])
|
||||||
Xbend200u <- sigmoid[7] - 0.693147 + 1.5434 / sigmoid[5]
|
# asymu <- EC50REF + 2 * (EC50REF - BPs[1])
|
||||||
Xbend50 <- max(Xbend50l, Xbend50u)
|
#
|
||||||
Xbend200 <- min(Xbend200l, Xbend200u)
|
# det_sig <- Dat$coeffs_UN
|
||||||
dummy <- plot_f(tab)
|
#
|
||||||
} else {
|
# if (is.null(Dat$coeffs_UN)) {
|
||||||
SAMPLE50 <- det_sig[3] + (det_sig[5] - det_sig[3]) / (1 + exp(det_sig[1] * (det_sig[7] + 0.693147 - dils2)))
|
# SAMPLE50 <- sigmoid[1] + (sigmoid[3] - sigmoid[1]) / (1 + exp(sigmoid[5] * ((sigmoid[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)))
|
# SAMPLE200 <- sigmoid[1] + (sigmoid[3] - sigmoid[1]) / (1 + exp(sigmoid[5] * ((sigmoid[7] - 0.693147) - dils2)))
|
||||||
Xbend50l <- det_sig[7] + 0.693147 - 1.5434 / det_sig[1]
|
# Xbend50l <- sigmoid[7] + 0.693147 - 1.5434 / sigmoid[5]
|
||||||
Xbend200l <- det_sig[7] - 0.693147 - 1.5434 / det_sig[1]
|
# Xbend200l <- sigmoid[7] - 0.693147 - 1.5434 / sigmoid[5]
|
||||||
Xbend50u <- det_sig[7] + 0.693147 + 1.5434 / det_sig[1]
|
# Xbend50u <- sigmoid[7] + 0.693147 + 1.5434 / sigmoid[5]
|
||||||
Xbend200u <- det_sig[7] - 0.693147 + 1.5434 / det_sig[1]
|
# Xbend200u <- sigmoid[7] - 0.693147 + 1.5434 / sigmoid[5]
|
||||||
Xbend50 <- max(Xbend50l, Xbend50u)
|
# Xbend50 <- max(Xbend50l, Xbend50u)
|
||||||
Xbend200 <- min(Xbend200l, Xbend200u)
|
# Xbend200 <- min(Xbend200l, Xbend200u)
|
||||||
dummy <- plot_f(tab)
|
# 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 ----
|
#### Dilutions CI table ----
|
||||||
@@ -2642,21 +2637,28 @@ server <- function(input, output, session) {
|
|||||||
|
|
||||||
#### download XL 4PL report----
|
#### download XL 4PL report----
|
||||||
|
|
||||||
observe({
|
observeEvent(input$btn, {
|
||||||
if (is.null(Dat$FITsFlag)) {
|
|
||||||
return(NULL)
|
|
||||||
}
|
|
||||||
if(!Dat$FITsFlag) {
|
if(!Dat$FITsFlag) {
|
||||||
browser()
|
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(
|
output$downloadXLReport <- downloadHandler(
|
||||||
filename = paste0("Report_4PLEvaluation", Dat$RepIdentifier, ".pdf"),
|
filename = paste0("Report_4PLEvaluation", Dat$RepIdentifier, ".pdf"),
|
||||||
content = function(file) {
|
content = function(file) {
|
||||||
tpdr <- tempdir()
|
tpdr <- tempdir()
|
||||||
tempReport <- file.path(tpdr, "Doc_BioassayReport.Rmd")
|
tempReport <- file.path(tpdr, "Doc_BioassayReport.Rmd")
|
||||||
file.copy("Doc_BioassayReport.Rmd", tempReport, overwrite = TRUE)
|
file.copy("Doc_BioassayReport.Rmd", tempReport, overwrite = T)
|
||||||
|
|
||||||
tempReportc <- file.path(tpdr, "logov2.png")
|
tempReportc <- file.path(tpdr, "logov2.png")
|
||||||
file.copy("logov2.png", tempReportc, overwrite = TRUE)
|
file.copy("logov2.png", tempReportc, overwrite = T)
|
||||||
|
|
||||||
rmarkdown::render(tempReport,
|
rmarkdown::render(tempReport,
|
||||||
output_file = file,
|
output_file = file,
|
||||||
@@ -2672,8 +2674,8 @@ server <- function(input, output, session) {
|
|||||||
)
|
)
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
}
|
|
||||||
})
|
|
||||||
|
|
||||||
#### download XL Lin report----
|
#### download XL Lin report----
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user