From f5575f84295987d2982203c8b3ceb8cb53e69919 Mon Sep 17 00:00:00 2001 From: Franz Innerbichler Date: Thu, 4 Jun 2026 10:27:28 +0200 Subject: [PATCH] merge conflict resolved app.R updated --- .DS_Store | Bin 10244 -> 14340 bytes .gitignore | 3 + dev/.DS_Store | Bin 8196 -> 8196 bytes dev/app.R | 642 +++++++++++++++++++++++++------------------------- 4 files changed, 325 insertions(+), 320 deletions(-) diff --git a/.DS_Store b/.DS_Store index 4c6b7a44b3d413c288fe358ff6e32f1c1f9fa7dd..4fe77ec9be3dc59981de8e7045f2ca2e4b0bb7d2 100644 GIT binary patch delta 357 zcmZn(XemfwU|?W$DortDU@%}{VBlbY&;mRR3=FCa3<@Bcfq{X638apJfq?}~2c;Az z=OpFl=P=}eBpDbOn8D%<46+cm00T^ZW8pORi4B6A**RD^82Kkp5>FOqXDDV!W+-CF zWGG-LVJL=~wfUpC7{|tjeD-=?utj85kH`85j`3v$60!^JIP%MMlQSrYc6P79e$#3sfdj5CB%qz#za-T#%HL zpTxkxursM(W8z}=$p$7Yi@7;C7$r9MDO9oZFfs(C6es5-<>%)xPUaCvp1faxd-GHQ zb`C*ih)D|E3=9me3=9H18xy}XPv$pKWCdBGFxk+=h*JZkhLM56U~-1Z#K~)g^fs%B Qy=9y{Pdy8(!7L!F0RP}CA^-pY diff --git a/.gitignore b/.gitignore index 1ca8486..4760e05 100644 --- a/.gitignore +++ b/.gitignore @@ -5,6 +5,9 @@ .Ruserdata .positai .png +.DS_Store +www/.DS_Store +dev/www/.DS_Store man docs pkgdown diff --git a/dev/.DS_Store b/dev/.DS_Store index 1f2a61bfaf266428c178c0e00c6938298e6535fc..2c3cac701b3ce08f2d3bc75376c8bdce8125a69f 100644 GIT binary patch delta 34 pcmZp1XmQvuO+eJl)L2Ks(Acb2N1@u#z{FTb!NS~l^J;-eegLZY2}l3{ delta 34 pcmZp1XmQvuO+eJx$Vf-Q+_+Xpq1w>c)IdkU(7@1e^J;-eegLX*2{Qly diff --git a/dev/app.R b/dev/app.R index 33230bc..5b6dc11 100644 --- a/dev/app.R +++ b/dev/app.R @@ -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----