Guxa/dashboard-app
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

report generation after new setup of repo; linearity XL report improved
Build and deploy Roxygen2|pkgdown documentation site / build-and-deploy-documentation (push) Successful in 48s
Details
run tests / build-and-deploy-documentation (push) Successful in 9s
Details

Browse Source
This commit is contained in:
Franz Innerbichler
2026-06-01 19:35:00 +02:00
parent cf1ce314e1
commit c480111552
7 changed files with 185 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dev/app.R
+131 -18
View File
@@ -548,6 +548,8 @@ server <- function(input, output, session) {
)
})
#### UI wizard ----
output$wizard <- renderUI({
navbarPage(
title = "Dilution setting",
@@ -557,14 +559,12 @@ server <- function(input, output, session) {
sidebarPanel(
width = 3,
fluidRow(
column(
6,
numericInput(
"Limits", p("limit to be >", bsButton("q4", label = "", icon = icon("info"), style = "primary", size = "extra-small")),
bsPopover(id = "q4", title = "", content = "The calculated limits ...")
column(6,
box(title = "Upload multiple worksheets", status = "warning", solidHeader = T, width = 12, "Please upload your EXCEL file here",
fileInput("MiFile", "", accept = ".xlsx"))
)
)
)
),
mainPanel(
tabsetPanel(
@@ -575,8 +575,7 @@ server <- function(input, output, session) {
title = "ANOVA table", status = "primary", solidHeader = T, width = 12,
tableOutput("Anovatab")
),
column(
4,
column(4,
h3("Confidence intervals"),
tableOutput("CIs"),
"The confidence interval table is interaactive for changes in: variability slider (%SD), potency of test-slider,
@@ -584,8 +583,7 @@ server <- function(input, output, session) {
tableOutput("optimalDils"),
selectInput(inputId = "scenario", label = "Select an 'optimal' scenario:", choices = c("scenario 2", "scenario 3", "scenario 6", "steep slope"))
),
column(
5,
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),
@@ -595,8 +593,7 @@ server <- function(input, output, session) {
"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,
column(3,
h3("Bend points"),
tableOutput("bps"),
tableOutput("extremebps"),
@@ -670,6 +667,22 @@ server <- function(input, output, session) {
})
observe({
if (!is.null(input$MiFile)) {
MinFile <- input$MiFile
ext <- tools::file_ext(MinFile$name)
file.rename(MinFile$datapath, paste(MinFile$datapath, ".xlsx", sep = ""))
t.filelocation <- gsub("\\\\", "/", paste(MinFile$datapath, ext, sep = "."))
sheets <- openxlsx::getSheetNames(t.filelocation)
dat <- lapply(sheets, openxlsx::read.xlsx, xlsxFile = t.filelocation)
names(dat) <- sheets
Dat$Mws <- dat
names(Dat$Mws) <- sheets
Dat$Msheets <- sheets
Dat$MFileName <- input$MiFile[["name"]]
}
})
#### process XLSX file ----
observe({
if (!is.null(input$iFile)) {
@@ -1339,7 +1352,7 @@ server <- function(input, output, session) {
if (is.null(input$PureErr)) {
return(NULL)
}
if (!is.null(Dat$FITsFlag)) {
if (Dat$FITsFlag) {
return(NULL)
}
@@ -1974,10 +1987,12 @@ server <- function(input, output, session) {
#### 4pl potency table XL ----
observe({
if (is.null(Dat$EXCEL)) {
return(NULL)
}
if (!is.null(Dat$FITsFlag)) {
if (Dat$FITsFlag) {
return(NULL)
}
ro_new <- Dat$EXCEL
@@ -2025,7 +2040,7 @@ server <- function(input, output, session) {
colnames(pottab4_) <- c("model", "potency", "lower95%CI", "upper95%CI", "relative_lower95%CI", "relative_upper95%CI", "test_result")
row.names(pottab4_) <- NULL
REP$pottab4plXL <- pottab4_[1:2, ]
#browser()
output$pottab4plXL <- DT::renderDataTable({
dat <- datatable(pottab4_[1:2, ],
rownames = F,
@@ -2055,8 +2070,101 @@ server <- function(input, output, session) {
#### Dilutions Simulator ----
output$plotfordilutions <- renderPlot({
tab <- sim2()
tab <- as.data.frame(tab)
if (!is.null(Dat$Mws))
AllXL <- Dat$Mws
AllSheets <- Dat$Msheets
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
FITs <- Fitting_FUNC(datWS2, TransFlag = F)
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
dils <- tab$log_dose
min_y <- min(tab[, 1:3])
max_y <- max(tab[, 1:3])
@@ -2077,7 +2185,10 @@ server <- function(input, output, session) {
dils2 <- dils_avsc + av
dilfactors <- 1 / exp(dils2 - lag(dils2))
}
} #for N_WS
Dat$newDils <- dils2
sigmoid <- sigmoid()
@@ -2538,6 +2649,8 @@ server <- function(input, output, session) {
params = list(
FileName = Dat$FileName,
author = Dat$Author,
NoP = Dat$NoP,
Assay = Dat$Assay,
REP = REP,
REPlin = REPlin,
coeffsLin = Dat$coeffs_UN