IMPORTANT added linting configuration
linting can be started by clicking Addins in RStudio, then "Lint current file". This commit also contains quick fixes for common linter messages like changing F to FALSE and T to TRUE.
This commit is contained in:
Simon Innerbichler
@@ -0,0 +1,11 @@
|
||||
linters: linters_with_defaults(
|
||||
line_length_linter(150),
|
||||
commented_code_linter = NULL,
|
||||
object_name_linter = NULL,
|
||||
brace_linter = NULL
|
||||
)
|
||||
exclusions: list(
|
||||
"inst/doc/creating_linters.R" = 1,
|
||||
"inst/example/bad.R",
|
||||
"tests/testthat/exclusions-test"
|
||||
)
|
||||
+40
-40
@@ -45,7 +45,7 @@ library(scales)
|
||||
#' Dat <- list()
|
||||
#' te <- Fitting_FUNC(dat, TransF)
|
||||
#' print(te)
|
||||
Fitting_FUNC <- function(ro_new, TransFlag = F) {
|
||||
Fitting_FUNC <- function(ro_new, TransFlag = FALSE) {
|
||||
CORro <- cor(ro_new[, 1], ro_new[, ncol(ro_new)])
|
||||
# browser()
|
||||
all_l <- melt(data.frame(ro_new), id.vars = "log_dose", variable.name = "replname", value.name = "readout")
|
||||
@@ -268,7 +268,7 @@ plotSingularity <- function(dat) { # sigmoid,det_sig,
|
||||
#' Dat <- list()
|
||||
#' p <- plot_f(dat, sigmoid, det_sig, TransF)
|
||||
#' print(p)
|
||||
plot_f <- function(dat, TransFlag = F) { # sigmoid,det_sig,
|
||||
plot_f <- function(dat, TransFlag = FALSE) { # sigmoid,det_sig,
|
||||
CORdat <- cor(dat[, 1], dat[, ncol(dat)])
|
||||
# browser()
|
||||
all_l <- melt(data.frame(dat), id.vars = "log_dose", variable.name = "replname", value.name = "readout")
|
||||
@@ -276,7 +276,7 @@ plot_f <- function(dat, TransFlag = F) { # sigmoid,det_sig,
|
||||
isSample <- rep(c(0, 1), 1, each = nrow(all_l) / 2)
|
||||
all_l2 <- cbind(all_l, isRef, isSample)
|
||||
# browser()
|
||||
MODLS <- Fitting_FUNC(dat, TransFlag = F)
|
||||
MODLS <- Fitting_FUNC(dat, TransFlag = FALSE)
|
||||
s_mr <- MODLS[[1]]
|
||||
a <- s_mr$coefficients["a", 1]
|
||||
b <- s_mr$coefficients["b", 1]
|
||||
@@ -340,23 +340,23 @@ plot_f <- function(dat, TransFlag = F) { # sigmoid,det_sig,
|
||||
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
|
||||
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
|
||||
# theme_bw() +
|
||||
theme(axis.text.x = element_text(size = 12, angle=90), axis.text.y = element_text(size = 12))
|
||||
theme(axis.text.x = element_text(size = 12, angle = 90), axis.text.y = element_text(size = 12))
|
||||
|
||||
p2 <- p + geom_line(
|
||||
data = as.data.frame(pl_df), aes(x = seq_x, y = SAMPLE), color = "#C2173F",
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = as.data.frame(pl_df), aes(x = seq_x, y = REF), color = "#4545BA",
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = as.data.frame(pl_df), aes(x = seq_x, y = SAMPLEtrue), color = "#C2173F", linetype = 2, alpha = 0.4,
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = as.data.frame(pl_df), aes(x = seq_x, y = REFtrue), color = "#4545BA", linetype = 2, alpha = 0.4,
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_vline(xintercept = c(Xbendl3, Xbendu3), col = "#4545BA", linetype = 2) +
|
||||
geom_vline(xintercept = c(XbendlT, XbenduT), col = "#C2173F", linetype = 2) +
|
||||
@@ -397,11 +397,11 @@ plot_f <- function(dat, TransFlag = F) { # sigmoid,det_sig,
|
||||
pl_df_trans <- cbind(seq_x, SAMPLEtrans, REFtrans)
|
||||
p_rt2 <- p_rt + geom_line(
|
||||
data = as.data.frame(pl_df_trans), aes(x = seq_x, y = SAMPLEtrans), color = "#C2173F",
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = as.data.frame(pl_df_trans), aes(x = seq_x, y = REFtrans), color = "#4545BA",
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_vline(xintercept = c(XbendlTrans, XbenduTrans), col = "#4545BA", linetype = 2) +
|
||||
geom_vline(xintercept = c(XbendlTransT, XbenduTransT), col = "#C2173F", linetype = 2) +
|
||||
@@ -432,12 +432,12 @@ plot_f <- function(dat, TransFlag = F) { # sigmoid,det_sig,
|
||||
theme_bw()
|
||||
pu2 <- pu + geom_line(
|
||||
data = as.data.frame(pl_df2), aes(x = seq_x, y = SAMPLEu),
|
||||
color = "#C2173F", inherit.aes = F
|
||||
color = "#C2173F", inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = as.data.frame(pl_df2), aes(x = seq_x, y = REFu),
|
||||
color = "#4545BA", inherit.aes = F,
|
||||
show.legend = F
|
||||
color = "#4545BA", inherit.aes = FALSE,
|
||||
show.legend = FALSE
|
||||
)
|
||||
pu2_ <- pu2 +
|
||||
theme(legend.position = "none", axis.text = element_text(size = 14))
|
||||
@@ -465,12 +465,12 @@ plot_f <- function(dat, TransFlag = F) { # sigmoid,det_sig,
|
||||
|
||||
pu2_t <- putrans + geom_line(
|
||||
data = as.data.frame(pl_df2u_t), aes(x = seq_x, y = SAMPLEu_trans),
|
||||
color = "#C2173F", inherit.aes = F
|
||||
color = "#C2173F", inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = as.data.frame(pl_df2u_t), aes(x = seq_x, y = REFu_trans),
|
||||
color = "#4545BA", inherit.aes = F,
|
||||
show.legend = F
|
||||
color = "#4545BA", inherit.aes = FALSE,
|
||||
show.legend = FALSE
|
||||
)
|
||||
pu3_t <- pu2_t
|
||||
if (TransFlag) grid.arrange(p_rt2, pu3_t, nrow = 1) else grid.arrange(p2, pu2_, nrow = 1)
|
||||
@@ -782,19 +782,19 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
|
||||
# F-test on regression: MSSreg/MSSE
|
||||
if (is.na(F_nonlin)) F_nonlin <- 0
|
||||
if (F_nonlin > 0) {
|
||||
p_F_nonlin <- round(pf(F_nonlin, 2, dfPureE, lower.tail = F), 5)
|
||||
p_F_nonlin <- round(pf(F_nonlin, 2, dfPureE, lower.tail = FALSE), 5)
|
||||
} else {
|
||||
p_F_nonlin <- "SSnonlin neg or 0"
|
||||
}
|
||||
|
||||
# significances
|
||||
F_regr <- (SSreg / 1) / (SSRes / dfRes)
|
||||
p_F_regr <- round(pf(F_regr, 1, dfRes, lower.tail = F), 3)
|
||||
p_F_treat <- round(pf(F_treat, 3, dfRes, lower.tail = F), 3)
|
||||
p_F_prep <- round(pf(F_prep, 1, dfRes, lower.tail = F), 3)
|
||||
p_F_slope_A <- round(pf(F_slope_A, 1, (nrow(circ_Al) - 2), lower.tail = F), 3)
|
||||
p_F_slope_B <- round(pf(F_slope_B, 1, (nrow(circ_Bl) - 2), lower.tail = F), 3)
|
||||
p_F_nonp <- round(pf(F_nonpar, 1, dfRes, lower.tail = F), 3)
|
||||
p_F_regr <- round(pf(F_regr, 1, dfRes, lower.tail = FALSE), 3)
|
||||
p_F_treat <- round(pf(F_treat, 3, dfRes, lower.tail = FALSE), 3)
|
||||
p_F_prep <- round(pf(F_prep, 1, dfRes, lower.tail = FALSE), 3)
|
||||
p_F_slope_A <- round(pf(F_slope_A, 1, (nrow(circ_Al) - 2), lower.tail = FALSE), 3)
|
||||
p_F_slope_B <- round(pf(F_slope_B, 1, (nrow(circ_Bl) - 2), lower.tail = FALSE), 3)
|
||||
p_F_nonp <- round(pf(F_nonpar, 1, dfRes, lower.tail = FALSE), 3)
|
||||
p_F_LoF <- p_F_nonlin
|
||||
|
||||
res_tab_lin <- data.frame(
|
||||
@@ -869,7 +869,7 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
|
||||
#'
|
||||
#' PlotLinPLA_FUNC(circle, sigmoid, all_l2, pl_df, indS, indT)
|
||||
PlotLinPLA_FUNC <- function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
#browser()
|
||||
# browser()
|
||||
mLin <- gsl_nls(readout ~ (intS + r) * isSample + intS * isRef + k * log_dose,
|
||||
data = circle,
|
||||
start = list(intS = 0, k = 1, r = 0),
|
||||
@@ -901,17 +901,17 @@ PlotLinPLA_FUNC <- function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
theme_bw()
|
||||
p2 <- p + geom_line(
|
||||
data = pl_df, aes(x = lnC, y = plotS), color = "#4545BA",
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = pl_df, aes(x = lnC, y = plotT), color = "#C2173F",
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
{
|
||||
if (!is.null(truePL_df)) {
|
||||
geom_line(
|
||||
data = data.frame(truePL_df), aes(x = seq_x, y = SAMPLEtrue), color = "#C2173F", linetype = 2, alpha = 0.4,
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
)
|
||||
}
|
||||
} +
|
||||
@@ -919,7 +919,7 @@ PlotLinPLA_FUNC <- function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
if (!is.null(truePL_df)) {
|
||||
geom_line(
|
||||
data = data.frame(truePL_df), aes(x = seq_x, y = REFtrue), color = "#4545BA", linetype = 2, alpha = 0.4,
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
)
|
||||
}
|
||||
} +
|
||||
@@ -939,17 +939,17 @@ PlotLinPLA_FUNC <- function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
|
||||
pr2 <- p + geom_line(
|
||||
data = pl_rest, aes(x = lnC, y = plotS), color = "#4545BA",
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = pl_rest, aes(x = lnC, y = plotT), color = "#C2173F",
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
{
|
||||
if (!is.null(truePL_df)) {
|
||||
geom_line(
|
||||
data = data.frame(truePL_df), aes(x = seq_x, y = SAMPLEtrue), color = "#C2173F", linetype = 2, alpha = 0.4,
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
)
|
||||
}
|
||||
} +
|
||||
@@ -957,7 +957,7 @@ PlotLinPLA_FUNC <- function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
if (!is.null(truePL_df)) {
|
||||
geom_line(
|
||||
data = data.frame(truePL_df), aes(x = seq_x, y = REFtrue), color = "#4545BA", linetype = 2, alpha = 0.4,
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
)
|
||||
}
|
||||
} +
|
||||
@@ -1012,7 +1012,7 @@ pot4plFUNC <- function(ro_new, PureErrFlag) {
|
||||
CORdat <- cor(ro_new[, 1], ro_new[, ncol(ro_new)])
|
||||
if (CORdat < 0) SLOPE <- -1 else SLOPE <- 1
|
||||
#
|
||||
FITs <- Fitting_FUNC(ro_new, TransFlag = F)
|
||||
FITs <- Fitting_FUNC(ro_new, TransFlag = FALSE)
|
||||
if (!PureErrFlag) {
|
||||
pot_est <- FITs[[3]]
|
||||
potU_est <- FITs[[4]]
|
||||
@@ -1205,10 +1205,10 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
|
||||
SSnonlin <- sum((predict(lm(readout ~ factor(Conc) * isSample, all_l)) - predPotU)^2)
|
||||
LoF_df <- FitAnova[1, 1] + FitAnova[2, 1]
|
||||
F_regr <- (SSregr / AnovaDFs[3]) / ERR
|
||||
p_F_regr <- round(pf(F_regr, AnovaDFs[3], ERR_df, lower.tail = F), 5)
|
||||
p_F_regr <- round(pf(F_regr, AnovaDFs[3], ERR_df, lower.tail = FALSE), 5)
|
||||
if (ncol(ro_new) < 4) F_nonlin <- 0 else F_nonlin <- (SSnonlin / AnovaDFs[6]) / ERR
|
||||
if (F_nonlin > 0) {
|
||||
p_F_nonlin <- round(pf(F_nonlin, AnovaDFs[6], ERR_df, lower.tail = F), 5)
|
||||
p_F_nonlin <- round(pf(F_nonlin, AnovaDFs[6], ERR_df, lower.tail = FALSE), 5)
|
||||
} else {
|
||||
p_F_nonlin <- "SSnonlin neg or single dilutions"
|
||||
}
|
||||
@@ -1404,11 +1404,11 @@ ANOVA4plUnresfunc <- function(ro_new) {
|
||||
MSE <- RSS / RSS_df
|
||||
noConc <- length(unique(all_l$Conc))
|
||||
AnovaDFs <- c(noConc - 1, 1, 3, noConc - 4 - 1, nrow(all_l) - noConc, noConc, nrow(all_l) - noConc - noConc, nrow(all_l) - 1)
|
||||
p_SStreat <- round(pf((SStreat / AnovaDFs[1]) / MSE, AnovaDFs[1], RSS_df, lower.tail = F), 3)
|
||||
p_SSprep <- round(pf((SSprep / AnovaDFs[2]) / MSE, AnovaDFs[2], RSS_df, lower.tail = F), 3)
|
||||
p_SSregr <- round(pf((SSregr / AnovaDFs[3]) / MSE, AnovaDFs[3], RSS_df, lower.tail = F), 3)
|
||||
p_SSnonp <- round(pf((SSnonparallel / AnovaDFs[4]) / MSE, AnovaDFs[3], RSS_df, lower.tail = F), 3)
|
||||
p_SSLoF <- round(pf((SSnonlin / LoF_df) / (SSE / SSE_df), LoF_df, SSE_df, lower.tail = F), 5)
|
||||
p_SStreat <- round(pf((SStreat / AnovaDFs[1]) / MSE, AnovaDFs[1], RSS_df, lower.tail = FALSE), 3)
|
||||
p_SSprep <- round(pf((SSprep / AnovaDFs[2]) / MSE, AnovaDFs[2], RSS_df, lower.tail = FALSE), 3)
|
||||
p_SSregr <- round(pf((SSregr / AnovaDFs[3]) / MSE, AnovaDFs[3], RSS_df, lower.tail = FALSE), 3)
|
||||
p_SSnonp <- round(pf((SSnonparallel / AnovaDFs[4]) / MSE, AnovaDFs[3], RSS_df, lower.tail = FALSE), 3)
|
||||
p_SSLoF <- round(pf((SSnonlin / LoF_df) / (SSE / SSE_df), LoF_df, SSE_df, lower.tail = FALSE), 5)
|
||||
|
||||
ANOVAtab <- data.frame(
|
||||
Source = c(
|
||||
|
||||
@@ -104,20 +104,18 @@ server <- function(input, output, session) {
|
||||
font-family: 'Helvetica Neue', Helvetica, Arial, sans-serif;font-size: 12px;} ")),
|
||||
h4("Introduction to the plateflow software"),
|
||||
# tags$mark("linear regression"), br(),
|
||||
column(6,
|
||||
column(
|
||||
6,
|
||||
"INSPECT your plate reader data: This is the right place if you want to visualize your data in the context of a 4 PL fit or a linear regression fit. ",
|
||||
"Bring your data in a readable format and start inspecting.",br(),
|
||||
"Example of EXCEL/csv/numbers file:",br(),
|
||||
|
||||
"Bring your data in a readable format and start inspecting.", br(),
|
||||
"Example of EXCEL/csv/numbers file:", br(),
|
||||
tags$img(src = "ExampleXL.png", class = "adv_logo", width = "100%"),
|
||||
"It needs to contain 1 column with the dilution concentrations (first or last column) and at least 2 columns of reference and test sample readouts, respectively.",
|
||||
"The reference readout columns have to be before the test sample readout columns. The column names for reference and test are free to set, but different for all columns.",
|
||||
"The column name of the dilution concentrations can be as follows: concentration, dose, log_concentration, log_dose (first letter can be capital)",
|
||||
"It is assumed, that the concentrations are in anti-log or in natural log mode.",
|
||||
),
|
||||
column(6,
|
||||
|
||||
)
|
||||
column(6, )
|
||||
),
|
||||
tabPanel(
|
||||
"Documentation",
|
||||
@@ -146,7 +144,7 @@ server <- function(input, output, session) {
|
||||
3,
|
||||
# img(src="Screenshot.png", width=200),
|
||||
box(
|
||||
title = "Upload", status = "warning", solidHeader = T, width = 12, "Please upload your EXCEL file here",
|
||||
title = "Upload", status = "warning", solidHeader = TRUE, width = 12, "Please upload your EXCEL file here",
|
||||
fileInput("iFile", "", accept = ".xlsx")
|
||||
),
|
||||
uiOutput(outputId = "sheetName"),
|
||||
@@ -186,7 +184,6 @@ server <- function(input, output, session) {
|
||||
selected = c("1", "2", "3", "4", "5", "6", "7", "8")
|
||||
)
|
||||
),
|
||||
|
||||
column(2,
|
||||
style = "background: #7FAEFF88",
|
||||
numericInput("lEACratiola", "lower EAC ratio of LAs", 0.005, step = 0.001),
|
||||
@@ -194,16 +191,16 @@ server <- function(input, output, session) {
|
||||
numericInput("lEACratioSlope", "lower EAC for ratio of slopes", 0.55, step = 0.01),
|
||||
numericInput("uEACratioSlope", "upper EAC for ratio of slopes", 1.84, step = 0.1),
|
||||
numericInput("lEACratioua", "lower EAC for ratio of UAs", 0.75, step = 0.1),
|
||||
numericInput("uEACratioua", "upper EAC for ratio of UAs", 1.33, step = 0.1)),
|
||||
column(2, style = "background: #7FAEFF88",
|
||||
numericInput("uEACratioua", "upper EAC for ratio of UAs", 1.33, step = 0.1)
|
||||
),
|
||||
column(2,
|
||||
style = "background: #7FAEFF88",
|
||||
numericInput("lowerPot", "lower EAC for potency", 75, step = 1),
|
||||
numericInput("upperPot", "upper EAC for potency", 133, step = 1),
|
||||
numericInput("lEACratioAdiff", "lower EAC of ratio of asymptote differences", 0.75, step = 0.01),
|
||||
numericInput("uEACratioAdiff", "upper EAC of ratio of asymptote differences", 1.33, step = 0.01),
|
||||
numericInput("lEACdiffla", "lower EAC for diff. of LA", -0.175, step = 0.001),
|
||||
numericInput("uEACdiffla", "upper EAC for diff. of LA", 0.189, step = 0.001)
|
||||
|
||||
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
@@ -226,22 +223,29 @@ server <- function(input, output, session) {
|
||||
tableOutput("AIC"),
|
||||
h5("First row: restricted model; 2nd row: unrestricted model"),
|
||||
h5("Smaller values of AIC indicate better fit to the data"),
|
||||
box(title = "Useful information", status = "info", solidHeader = T, width = 12, "", collapsible = T,
|
||||
tableOutput("VarDiagn"))
|
||||
box(
|
||||
title = "Useful information", status = "info", solidHeader = TRUE, width = 12, "", collapsible = TRUE,
|
||||
tableOutput("VarDiagn")
|
||||
)
|
||||
),
|
||||
column(
|
||||
8,
|
||||
plotOutput("XLplot"),
|
||||
htmlOutput("No4PLFitText"),
|
||||
|
||||
DTOutput("pottab4plXL"),
|
||||
box(title = "Residuals and QQ-plot", status = "info", solidHeader = T, width = 12, "", collapsible = T,
|
||||
plotOutput("diagnplot")),
|
||||
box(title = "Assay Suitability Tests", status = "info", solidHeader = T, width = 12, "", collapsible = T,
|
||||
DTOutput("EQtests")),
|
||||
box(
|
||||
title = "Residuals and QQ-plot", status = "info", solidHeader = TRUE, width = 12, "", collapsible = TRUE,
|
||||
plotOutput("diagnplot")
|
||||
),
|
||||
box(
|
||||
title = "Assay Suitability Tests", status = "info", solidHeader = TRUE, width = 12, "", collapsible = TRUE,
|
||||
DTOutput("EQtests")
|
||||
),
|
||||
DTOutput("pottab4plTransXL"),
|
||||
box(title = "ANOVA", status = "info", solidHeader = T, width = 12, "", collapsible = T,
|
||||
tableOutput("ANOVAXLS"))
|
||||
box(
|
||||
title = "ANOVA", status = "info", solidHeader = TRUE, width = 12, "", collapsible = TRUE,
|
||||
tableOutput("ANOVAXLS")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -285,14 +289,14 @@ server <- function(input, output, session) {
|
||||
12,
|
||||
h3("Tests for linear PLA:"),
|
||||
box(
|
||||
title = "Suitability tests", status = "primary", solidHeader = T, width = 12,
|
||||
title = "Suitability tests", status = "primary", solidHeader = TRUE, width = 12,
|
||||
DTOutput("TESTSlin")
|
||||
),
|
||||
h5("The estimate is the p-value of the test"),
|
||||
h5("F-tests on regression, significance of slopes, and preparation need to have a p-value <0.05 to pass"),
|
||||
h5("All other tests pass if p-value > 0.05"),
|
||||
"SST CI for difference of slopes:",
|
||||
#tableOutput("SlopeDiffCI"),
|
||||
# tableOutput("SlopeDiffCI"),
|
||||
h3("ANOVA for parallel line assay"),
|
||||
DTOutput("ANOVAlin")
|
||||
)
|
||||
@@ -437,7 +441,7 @@ server <- function(input, output, session) {
|
||||
column(
|
||||
8,
|
||||
box(
|
||||
title = "Simulated data per log-concentration", status = "warning", solidHeader = T, width = 12, "incl. mean, sd and CV%",
|
||||
title = "Simulated data per log-concentration", status = "warning", solidHeader = TRUE, width = 12, "incl. mean, sd and CV%",
|
||||
DT::dataTableOutput("ConctabMeta")
|
||||
),
|
||||
verbatimTextOutput("logdil")
|
||||
@@ -472,7 +476,7 @@ server <- function(input, output, session) {
|
||||
8,
|
||||
"4 PL ANOVA unrestricted",
|
||||
box(
|
||||
title = "ANOVA unrestricted", status = "warning", solidHeader = T, width = 12, "",
|
||||
title = "ANOVA unrestricted", status = "warning", solidHeader = TRUE, width = 12, "",
|
||||
DT::dataTableOutput("ANOVA")
|
||||
),
|
||||
h5("Please note that for the CIs of rel. potency the RSS of the restricted model is used"),
|
||||
@@ -512,19 +516,19 @@ server <- function(input, output, session) {
|
||||
5,
|
||||
h3("Tests for linear PLA:"),
|
||||
box(
|
||||
title = "Suitability tests", status = "primary", solidHeader = T, collapsible = T, width = 12,
|
||||
title = "Suitability tests", status = "primary", solidHeader = TRUE, collapsible = TRUE, width = 12,
|
||||
DTOutput("TESTSlinMeta")
|
||||
),
|
||||
h5("The estimate is the p-value of the test"),
|
||||
h5("F-tests on regression, significance of slopes, and preparation need to have a p-value <0.05 to pass"),
|
||||
h5("All other tests pass if p-value > 0.05"),
|
||||
box(
|
||||
title = "Unrestricted linear model (SSSI):", status = "primary", solidHeader = T, collapsible = T, width = 12,
|
||||
title = "Unrestricted linear model (SSSI):", status = "primary", solidHeader = TRUE, collapsible = TRUE, width = 12,
|
||||
tableOutput("SummaryModABuMeta")
|
||||
),
|
||||
h4("Restricted linear model (CSSI):"),
|
||||
box(
|
||||
title = "Restricted linear model (CSSI):", status = "primary", solidHeader = T, collapsible = T, width = 12,
|
||||
title = "Restricted linear model (CSSI):", status = "primary", solidHeader = TRUE, collapsible = TRUE, width = 12,
|
||||
tableOutput("SummaryModABMeta")
|
||||
)
|
||||
),
|
||||
@@ -532,7 +536,7 @@ server <- function(input, output, session) {
|
||||
6,
|
||||
h3("ANOVA for parallel line assay"),
|
||||
box(
|
||||
title = "ANOVA for simultated data", status = "primary", solidHeader = T, collapsible = T, width = 12,
|
||||
title = "ANOVA for simultated data", status = "primary", solidHeader = TRUE, collapsible = TRUE, width = 12,
|
||||
DTOutput("ANOVAlinMeta")
|
||||
),
|
||||
" CI for difference of slopes:",
|
||||
@@ -572,12 +576,14 @@ server <- function(input, output, session) {
|
||||
sidebarPanel(
|
||||
width = 3,
|
||||
fluidRow(
|
||||
column(6,
|
||||
box(title = "Upload multiple worksheets", status = "warning", solidHeader = T, width = 12, "Please upload your EXCEL file here",
|
||||
fileInput("MiFile", "", accept = ".xlsx"))
|
||||
column(
|
||||
6,
|
||||
box(
|
||||
title = "Upload multiple worksheets", status = "warning", solidHeader = TRUE, width = 12, "Please upload your EXCEL file here",
|
||||
fileInput("MiFile", "", accept = ".xlsx")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
),
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
@@ -585,10 +591,11 @@ server <- function(input, output, session) {
|
||||
tabPanel(
|
||||
"4pl",
|
||||
box(
|
||||
title = "ANOVA table", status = "primary", solidHeader = T, width = 12,
|
||||
title = "ANOVA table", status = "primary", solidHeader = TRUE, 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,
|
||||
@@ -596,7 +603,8 @@ 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),
|
||||
@@ -606,7 +614,8 @@ 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"),
|
||||
@@ -625,7 +634,6 @@ server <- function(input, output, session) {
|
||||
})
|
||||
|
||||
|
||||
|
||||
v <- reactiveValues(num_dose = 0, next.dose.t = 0)
|
||||
|
||||
sigmoid <- reactive({
|
||||
@@ -701,13 +709,12 @@ server <- function(input, output, session) {
|
||||
if (!is.null(input$iFile)) {
|
||||
if (!is.null(input$sheet)) {
|
||||
if (input$sheet != "please choose") {
|
||||
|
||||
Dat$RepIdentifier <- input$RepIdentifier
|
||||
Dat$Author <- input$Author
|
||||
Dat$NoP <- input$NoP
|
||||
Dat$Assay <- input$Assay
|
||||
Dat$FITsFlag <- FALSE
|
||||
#browser()
|
||||
# browser()
|
||||
XLdat <- Dat$wb[input$sheet][[1]]
|
||||
if (is.null(XLdat)) XLdat <- Dat$wb[Dat$sheets[1]][[1]]
|
||||
cn <- colnames(XLdat)
|
||||
@@ -778,30 +785,61 @@ server <- function(input, output, session) {
|
||||
ifelse(Dat$FITsFlag, "No meaningful 4PL fit was possible. This may havea several reasons: \nA control sample was tested/\n
|
||||
the EC50 is not catched with the dilutions/\n the assay/reader had a problem",
|
||||
"Footnote: bendpoints (linear part) and asymptote points (point where asymptote is reached) are plotted in dashed and dotted lines. They indicate whether the linear part and asymptotes are catched with the current dilutions.
|
||||
Black line is the true slope at EC50 of REF.")
|
||||
Black line is the true slope at EC50 of REF."
|
||||
)
|
||||
})
|
||||
output$No4PLFitText <- renderText(warning_textNo4PLFit())
|
||||
|
||||
output$relpotTestTab <- renderTable({ NULL })
|
||||
output$relpotTestPlot <- renderPlot({ NULL })
|
||||
output$relpotTestTab <- renderTable({
|
||||
NULL
|
||||
})
|
||||
output$relpotTestPlot <- renderPlot({
|
||||
NULL
|
||||
})
|
||||
|
||||
output$AIC <- renderTable({ NULL })
|
||||
output$VarDiagn <- renderTable({ NULL })
|
||||
output$AIC <- renderTable({
|
||||
NULL
|
||||
})
|
||||
output$VarDiagn <- renderTable({
|
||||
NULL
|
||||
})
|
||||
|
||||
output$pottab4plXL <- renderDT({ NULL })
|
||||
output$diagnplot <- renderPlot({ NULL })
|
||||
output$EQtests <- renderDT({ NULL })
|
||||
output$pottab4plXL <- renderDT({
|
||||
NULL
|
||||
})
|
||||
output$diagnplot <- renderPlot({
|
||||
NULL
|
||||
})
|
||||
output$EQtests <- renderDT({
|
||||
NULL
|
||||
})
|
||||
#
|
||||
output$pottab4plTransXL <- renderDT({ NULL })
|
||||
output$ANOVAXLS <- renderTable({ NULL })
|
||||
output$pottab4plTransXL <- renderDT({
|
||||
NULL
|
||||
})
|
||||
output$ANOVAXLS <- renderTable({
|
||||
NULL
|
||||
})
|
||||
|
||||
output$coeffs_r <- renderTable({ NULL})
|
||||
output$coeffs_r <- renderTable({
|
||||
NULL
|
||||
})
|
||||
|
||||
output$bends_r2 <- renderTable({ NULL })
|
||||
output$coeffs_unr <- renderTable({ NULL })
|
||||
output$logcoeffs_r <- renderTable({ NULL })
|
||||
output$bends_unr2 <- renderTable({ NULL })
|
||||
output$logcoeffs_unr <- renderTable({ NULL })
|
||||
output$bends_r2 <- renderTable({
|
||||
NULL
|
||||
})
|
||||
output$coeffs_unr <- renderTable({
|
||||
NULL
|
||||
})
|
||||
output$logcoeffs_r <- renderTable({
|
||||
NULL
|
||||
})
|
||||
output$bends_unr2 <- renderTable({
|
||||
NULL
|
||||
})
|
||||
output$logcoeffs_unr <- renderTable({
|
||||
NULL
|
||||
})
|
||||
|
||||
|
||||
return(NULL)
|
||||
@@ -963,7 +1001,7 @@ server <- function(input, output, session) {
|
||||
{
|
||||
Filesample
|
||||
},
|
||||
rownames = F
|
||||
rownames = FALSE
|
||||
)
|
||||
|
||||
UnRPLAausw <- data.frame(
|
||||
@@ -976,7 +1014,7 @@ server <- function(input, output, session) {
|
||||
Results = unlist(c("UNRESTRICTED", round(coeffsMU, 3), round(potU_est * 100, 3)))
|
||||
) # von psl_nls
|
||||
|
||||
# "log relative potency", "log lower CI", "log upper CI", round(logpotest, 3), round(compParm(potu, "c", display = F), 3)
|
||||
# "log relative potency", "log lower CI", "log upper CI", round(logpotest, 3), round(compParm(potu, "c", display = FALSE), 3)
|
||||
|
||||
output$coeffs_unr <- renderTable({
|
||||
UnRPLAausw
|
||||
@@ -1026,7 +1064,7 @@ server <- function(input, output, session) {
|
||||
bendsAll
|
||||
},
|
||||
digits = 3,
|
||||
rownames = T
|
||||
rownames = TRUE
|
||||
)
|
||||
|
||||
REP$PLAausw <- PLAAusw
|
||||
@@ -1089,7 +1127,7 @@ server <- function(input, output, session) {
|
||||
|
||||
##### Plot XL 4PL ----
|
||||
output$XLplot <- renderPlot({
|
||||
XLplot4pl <- plot_f(XLdat2, TransFlag = F)
|
||||
XLplot4pl <- plot_f(XLdat2, TransFlag = FALSE)
|
||||
REP$XLplot4pl <- XLplot4pl
|
||||
|
||||
XLplot4pl
|
||||
@@ -1278,7 +1316,7 @@ server <- function(input, output, session) {
|
||||
|
||||
sigmoid <- sigmoid()
|
||||
det_sig <- NULL
|
||||
plot_f(sim2(), TransFlag = F)
|
||||
plot_f(sim2(), TransFlag = FALSE)
|
||||
})
|
||||
|
||||
#### Plot 4pl Meta Transformed ----
|
||||
@@ -1291,7 +1329,7 @@ server <- function(input, output, session) {
|
||||
output$PureErrWLogMeta <- renderText(warning_text3())
|
||||
sigmoid <- sigmoid()
|
||||
det_sig <- NULL
|
||||
plot_f(sim2(), TransFlag = T)
|
||||
plot_f(sim2(), TransFlag = TRUE)
|
||||
})
|
||||
|
||||
|
||||
@@ -1328,11 +1366,11 @@ server <- function(input, output, session) {
|
||||
REP$testsTab <- tab
|
||||
tab2 <- tab[1:7, ]
|
||||
|
||||
dat <- datatable(tab2, rownames = F, options = list(
|
||||
dat <- datatable(tab2, rownames = FALSE, options = list(
|
||||
paging = TRUE,
|
||||
dom = "t",
|
||||
rownames = FALSE
|
||||
)) %>% formatStyle("test_results",
|
||||
)) |> formatStyle("test_results",
|
||||
target = "row",
|
||||
backgroundColor = styleEqual(
|
||||
c(-1, 0, 1),
|
||||
@@ -1391,7 +1429,7 @@ server <- function(input, output, session) {
|
||||
paging = TRUE,
|
||||
dom = "t"
|
||||
)
|
||||
) %>% formatStyle("test_results",
|
||||
) |> formatStyle("test_results",
|
||||
target = "row",
|
||||
backgroundColor = styleEqual(
|
||||
c(-1, 0, 1),
|
||||
@@ -1437,7 +1475,7 @@ server <- function(input, output, session) {
|
||||
paste("R", seq(1, (ncol(tab2) - 1) / 2)), "log_conc"
|
||||
)
|
||||
dat <- datatable(tab2, options = list(
|
||||
paging = T,
|
||||
paging = TRUE,
|
||||
pageLength = 20,
|
||||
dom = "t"
|
||||
))
|
||||
@@ -1462,17 +1500,17 @@ server <- function(input, output, session) {
|
||||
Dat$Conctab <- Conctab
|
||||
|
||||
dat <- datatable(Conctab, options = list(
|
||||
paging = T,
|
||||
paging = TRUE,
|
||||
pageLength = 12,
|
||||
dom = "t"
|
||||
)) %>%
|
||||
)) |>
|
||||
formatStyle(0,
|
||||
target = "row",
|
||||
backgroundColor = styleEqual(
|
||||
c("avs", "sds", "cv", "avs_test", "sds_test", "cv_test"),
|
||||
c("lightgrey", "lightgreen", "pink", "lightgrey", "lightgreen", "pink")
|
||||
)
|
||||
) %>%
|
||||
) |>
|
||||
formatRound(columns = colnames(Conctab), digits = 3)
|
||||
})
|
||||
|
||||
@@ -1495,17 +1533,17 @@ server <- function(input, output, session) {
|
||||
Dat$Conctab <- Conctab
|
||||
|
||||
dat <- datatable(Conctab, options = list(
|
||||
paging = T,
|
||||
paging = TRUE,
|
||||
pageLength = 12,
|
||||
dom = "t"
|
||||
)) %>%
|
||||
)) |>
|
||||
formatStyle(0,
|
||||
target = "row",
|
||||
backgroundColor = styleEqual(
|
||||
c("avs", "sds", "cv", "avs_test", "sds_test", "cv_test"),
|
||||
c("lightgrey", "lightgreen", "pink", "lightgrey", "lightgreen", "pink")
|
||||
)
|
||||
) %>%
|
||||
) |>
|
||||
formatRound(columns = colnames(Conctab), digits = 3)
|
||||
})
|
||||
|
||||
@@ -1666,9 +1704,9 @@ server <- function(input, output, session) {
|
||||
Dat$ANOVAMeta <- df[, 4:length(df)]
|
||||
dat <- datatable(df2[, 1:3],
|
||||
options = list(
|
||||
paging = T, dom = "t", rownames = F
|
||||
paging = TRUE, dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("test_results", target = "row", backgroundColor = styleEqual(
|
||||
) |> formatStyle("test_results", target = "row", backgroundColor = styleEqual(
|
||||
c(-1, 0, 1),
|
||||
c("pink", "lightgreen", "lightgrey")
|
||||
))
|
||||
@@ -1771,9 +1809,9 @@ server <- function(input, output, session) {
|
||||
Dat$ANOVA <- df[, 4:length(df)]
|
||||
dat <- datatable(df2[, 1:3],
|
||||
options = list(
|
||||
paging = T, dom = "t", rownames = F
|
||||
paging = TRUE, dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("test_results", target = "row", backgroundColor = styleEqual(
|
||||
) |> formatStyle("test_results", target = "row", backgroundColor = styleEqual(
|
||||
c(-1, 0, 1),
|
||||
c("pink", "lightgreen", "lightgrey")
|
||||
))
|
||||
@@ -1788,9 +1826,9 @@ server <- function(input, output, session) {
|
||||
tab <- ANOVA4plUnresfunc(sim2()) # ,sigmoid
|
||||
dat <- datatable(tab,
|
||||
options = list(
|
||||
dom = "t", rownames = F
|
||||
dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("p_value",
|
||||
) |> formatStyle("p_value",
|
||||
target = "row",
|
||||
backgroundColor = styleEqual(
|
||||
c("p_value"),
|
||||
@@ -1807,7 +1845,7 @@ server <- function(input, output, session) {
|
||||
# dat <- datatable(tab,
|
||||
# options=list(
|
||||
# dom="t",rownames=F
|
||||
# )) %>% formatStyle("p_value", target="row",
|
||||
# )) |> formatStyle("p_value", target="row",
|
||||
# backgroundColor = styleEqual(c("p_value"),
|
||||
# c("lightgrey")))
|
||||
# })
|
||||
@@ -1833,9 +1871,9 @@ server <- function(input, output, session) {
|
||||
ANOVAlin <- Dat$ANOVA
|
||||
dat <- datatable(ANOVAlin,
|
||||
options = list(
|
||||
dom = "t", rownames = F
|
||||
dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("p.value",
|
||||
) |> formatStyle("p.value",
|
||||
target = "cell",
|
||||
backgroundColor = styleEqual(
|
||||
c("p.value"),
|
||||
@@ -1848,9 +1886,9 @@ server <- function(input, output, session) {
|
||||
ANOVAlin <- Dat$ANOVAMeta
|
||||
dat <- datatable(ANOVAlin,
|
||||
options = list(
|
||||
dom = "t", rownames = F
|
||||
dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("p.value",
|
||||
) |> formatStyle("p.value",
|
||||
target = "cell",
|
||||
backgroundColor = styleEqual(
|
||||
c("p.value"),
|
||||
@@ -1884,9 +1922,9 @@ server <- function(input, output, session) {
|
||||
|
||||
dat <- datatable(LinPotTab,
|
||||
options = list(
|
||||
dom = "t", rownames = F
|
||||
dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("test_result",
|
||||
) |> formatStyle("test_result",
|
||||
target = "row",
|
||||
backgroundColor = styleEqual(c(0, 1), c("#B5C74055", "#F9545488"))
|
||||
)
|
||||
@@ -1907,9 +1945,9 @@ server <- function(input, output, session) {
|
||||
pottab <- LinPotTab(circles, Lim, PureErrFlag = PureErrFlag)
|
||||
dat <- datatable(pottab,
|
||||
options = list(
|
||||
dom = "t", rownames = F
|
||||
dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("test_result",
|
||||
) |> formatStyle("test_result",
|
||||
target = "row",
|
||||
backgroundColor = styleEqual(c(0, 1), c("#B5C74055", "#F9545488"))
|
||||
)
|
||||
@@ -1968,9 +2006,9 @@ server <- function(input, output, session) {
|
||||
dat <- datatable(pottab4_[1:2, ],
|
||||
options = list(
|
||||
digits = 3,
|
||||
paging = T, dom = "t", rownames = F
|
||||
paging = TRUE, dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("test_result", target = "row", backgroundColor = styleEqual(
|
||||
) |> formatStyle("test_result", target = "row", backgroundColor = styleEqual(
|
||||
c(0, 1),
|
||||
c("lightgreen", "pink")
|
||||
))
|
||||
@@ -1979,9 +2017,9 @@ server <- function(input, output, session) {
|
||||
dat <- datatable(pottab4_[3:4, ],
|
||||
options = list(
|
||||
digits = 3,
|
||||
paging = T, dom = "t", rownames = F
|
||||
paging = TRUE, dom = "t", rownames = FALSE
|
||||
)
|
||||
) %>% formatStyle("test_result", target = "row", backgroundColor = styleEqual(
|
||||
) |> formatStyle("test_result", target = "row", backgroundColor = styleEqual(
|
||||
c(0, 1),
|
||||
c("lightgreen", "pink")
|
||||
))
|
||||
@@ -1990,8 +2028,6 @@ server <- function(input, output, session) {
|
||||
|
||||
#### 4pl potency table XL ----
|
||||
observe({
|
||||
|
||||
|
||||
if (is.null(Dat$EXCEL)) {
|
||||
return(NULL)
|
||||
}
|
||||
@@ -2043,25 +2079,25 @@ 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()
|
||||
# browser()
|
||||
output$pottab4plXL <- DT::renderDataTable({
|
||||
dat <- datatable(pottab4_[1:2, ],
|
||||
rownames = F,
|
||||
rownames = FALSE,
|
||||
options = list(
|
||||
digits = 3,
|
||||
paging = T, dom = "t"
|
||||
paging = TRUE, dom = "t"
|
||||
)
|
||||
) %>% formatStyle("test_result", target = "row", backgroundColor = styleEqual(
|
||||
) |> formatStyle("test_result", target = "row", backgroundColor = styleEqual(
|
||||
c("passed", "failed"),
|
||||
c("#B5C74055", "#F9545455")
|
||||
))
|
||||
})
|
||||
output$pottab4plTransXL <- DT::renderDataTable({
|
||||
dat <- datatable(pottab4_[3:4, -ncol(pottab4_)],
|
||||
rownames = F,
|
||||
rownames = FALSE,
|
||||
options = list(
|
||||
digits = 3,
|
||||
paging = T, dom = "t"
|
||||
paging = TRUE, dom = "t"
|
||||
)
|
||||
)
|
||||
})
|
||||
@@ -2070,13 +2106,13 @@ server <- function(input, output, session) {
|
||||
|
||||
#### Dilutions Simulator ----
|
||||
output$plotfordilutions <- renderPlot({
|
||||
if (!is.null(Dat$Mws))
|
||||
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)
|
||||
@@ -2097,7 +2133,7 @@ server <- function(input, output, session) {
|
||||
}
|
||||
Dat$datWS2 <- datWS2
|
||||
|
||||
FITs <- Fitting_FUNC(datWS2, TransFlag = F)
|
||||
FITs <- Fitting_FUNC(datWS2, TransFlag = FALSE)
|
||||
|
||||
pot_est <- FITs[[3]]
|
||||
potU_est <- FITs[[4]]
|
||||
@@ -2106,22 +2142,22 @@ server <- function(input, output, session) {
|
||||
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)))
|
||||
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]])
|
||||
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)
|
||||
if (!exists("SIGtestDF")) SIGtestDF <- dfPlotsigTest else SIGtestDF <- rbind(SIGtestDF, dfPlotsigTest)
|
||||
|
||||
EC50TEST <- as.numeric(c(URMcoefsDF[,8]))
|
||||
EC50TEST <- as.numeric(c(URMcoefsDF[, 8]))
|
||||
# EC50TEST <- EC50TEST[!EC50TEST %in% boxplot.stats(EC50TEST)$out]
|
||||
EC50REF <- as.numeric(URMcoefsDF[,4])
|
||||
EC50REF <- as.numeric(URMcoefsDF[, 4])
|
||||
# EC50REF <- EC50REF[!EC50REF %in% boxplot.stats(EC50REF)$out]
|
||||
UasREF <- as.numeric(URMcoefsDF[,5])
|
||||
UasREF <- as.numeric(URMcoefsDF[, 5])
|
||||
# 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]
|
||||
#
|
||||
# Dat$URMcoefsDF <- URMcoefsDF
|
||||
@@ -2129,7 +2165,7 @@ server <- function(input, output, session) {
|
||||
# Dat$CalcPot <- CalcPot
|
||||
#
|
||||
#### sigmoid plots ----
|
||||
Slope <- as.numeric(URMcoefsDF[1,3])
|
||||
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) }
|
||||
@@ -2185,8 +2221,7 @@ server <- function(input, output, session) {
|
||||
dils2 <- dils_avsc + av
|
||||
dilfactors <- 1 / exp(dils2 - lag(dils2))
|
||||
}
|
||||
} #for N_WS
|
||||
|
||||
} # for N_WS
|
||||
|
||||
|
||||
Dat$newDils <- dils2
|
||||
@@ -2277,11 +2312,11 @@ server <- function(input, output, session) {
|
||||
) +
|
||||
geom_line(
|
||||
data = as.data.frame(pl_df), aes(x = dils2, y = SAMPLE50), color = "grey15", linetype = 2,
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_line(
|
||||
data = as.data.frame(pl_df), aes(x = dils2, y = SAMPLE200), color = "grey15", linetype = 2,
|
||||
inherit.aes = F
|
||||
inherit.aes = FALSE
|
||||
) +
|
||||
geom_vline(xintercept = c(Xbend50, Xbend200), col = "grey15", linetype = 2) +
|
||||
{
|
||||
@@ -2500,13 +2535,13 @@ server <- function(input, output, session) {
|
||||
)
|
||||
DF_U <- nrow(all_l) - 8
|
||||
|
||||
uAsratio <- compParm(potU, "a", display = F)
|
||||
uAsratio <- compParm(potU, "a", display = FALSE)
|
||||
uCIuAs <- uAsratio[1] + qt(0.975, DF_U) * uAsratio[2]
|
||||
lCIuAs <- uAsratio[1] - qt(0.975, DF_U) * uAsratio[2]
|
||||
lAsratio <- compParm(potU, "d", display = F)
|
||||
lAsratio <- compParm(potU, "d", display = FALSE)
|
||||
uCIlAs <- lAsratio[1] + qt(0.975, DF_U) * lAsratio[2]
|
||||
lCIlAs <- lAsratio[1] - qt(0.975, DF_U) * lAsratio[2]
|
||||
Sloperatio <- compParm(potU, "b", display = F)
|
||||
Sloperatio <- compParm(potU, "b", display = FALSE)
|
||||
uCISlo <- Sloperatio[1] + qt(0.975, DF_U) * Sloperatio[2]
|
||||
lCISlo <- Sloperatio[1] - qt(0.975, DF_U) * Sloperatio[2]
|
||||
su <- summary(potU)
|
||||
@@ -2608,7 +2643,9 @@ server <- function(input, output, session) {
|
||||
#### download XL 4PL report----
|
||||
|
||||
observe({
|
||||
if (is.null(Dat$FITsFlag)) return(NULL)
|
||||
if (is.null(Dat$FITsFlag)) {
|
||||
return(NULL)
|
||||
}
|
||||
if (!Dat$FITsFlag) {
|
||||
browser()
|
||||
output$downloadXLReport <- downloadHandler(
|
||||
@@ -2616,10 +2653,10 @@ server <- function(input, output, session) {
|
||||
content = function(file) {
|
||||
tpdr <- tempdir()
|
||||
tempReport <- file.path(tpdr, "Doc_BioassayReport.Rmd")
|
||||
file.copy("Doc_BioassayReport.Rmd", tempReport, overwrite = T)
|
||||
file.copy("Doc_BioassayReport.Rmd", tempReport, overwrite = TRUE)
|
||||
|
||||
tempReportc <- file.path(tpdr, "logov2.png")
|
||||
file.copy("logov2.png", tempReportc, overwrite = T)
|
||||
file.copy("logov2.png", tempReportc, overwrite = TRUE)
|
||||
|
||||
rmarkdown::render(tempReport,
|
||||
output_file = file,
|
||||
@@ -2645,10 +2682,10 @@ server <- function(input, output, session) {
|
||||
content = function(file) {
|
||||
tpdr <- tempdir()
|
||||
tempReport <- file.path(tpdr, "Doc_BioassayLinReport.Rmd")
|
||||
file.copy("Doc_BioassayLinReport.Rmd", tempReport, overwrite = T)
|
||||
file.copy("Doc_BioassayLinReport.Rmd", tempReport, overwrite = TRUE)
|
||||
|
||||
tempReportc <- file.path(tpdr, "logov2.png")
|
||||
file.copy("logov2.png", tempReportc, overwrite = T)
|
||||
file.copy("logov2.png", tempReportc, overwrite = TRUE)
|
||||
|
||||
rmarkdown::render(tempReport,
|
||||
output_file = file,
|
||||
|
||||
Reference in New Issue
Block a user