app made independent XL and metadata, functions roxygenized
This commit is contained in:
+5
-20
@@ -1,23 +1,8 @@
|
||||
dat <- data.frame(REF1=c(1.1,1.2,2.1,3,5,6,8.1,9), REF1=c(1.2,1.5,2.1,3.1,4.9,6.1,8.3,9.1),
|
||||
TEST1=c(1,1.3,2.5,3.5,5.9,6.9,8.1,9.1), TEST2=c(1.4,1.2,2.6,3.4,5.8,6.7,8.6,9.3), log_dose=c(1,0,-1,-2,-3,-4,-5,-6))
|
||||
|
||||
all_l <- melt(data.frame(dat), id.vars="log_dose", variable.name="replname", value.name = "readout")
|
||||
isRef <- rep(c(1,0),1,each=nrow(all_l)/2)
|
||||
isSample <- rep(c(0,1),1,each=nrow(all_l)/2)
|
||||
all_l2 <- cbind(all_l, isRef, isSample)
|
||||
|
||||
startlistmu <- list(as=1, bs=-1,cs=-3,
|
||||
ds=10,at=1, bt=-1,
|
||||
dt=10,r=0)
|
||||
|
||||
|
||||
mu <- gsl_nls(fn = readout ~ as*isRef + at*isSample + (ds*isRef + dt*isSample - as*isRef - at*isSample)/
|
||||
(1+isRef*exp(bs*(cs - log_dose)) + isSample*exp(bt*(cs-r*isSample-log_dose))),
|
||||
data=all_l,
|
||||
start=startlistmu,
|
||||
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6))
|
||||
s_mu <- summary(mu)$coefficients[,1]
|
||||
s_mu
|
||||
################################################################################
|
||||
# Test file for functions of plateflow
|
||||
# F. Innerbichler
|
||||
# 13.5.2026
|
||||
################################################################################
|
||||
|
||||
|
||||
CIRC <- data.frame(log_dose = c(-2.5,-2.5,-2.5, -3.2,-3.2,-3.2,-3.9,-3.9,-3.9,
|
||||
|
||||
@@ -669,6 +669,66 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
|
||||
return(RET)
|
||||
}
|
||||
|
||||
PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
|
||||
|
||||
mLin <- gsl_nls(readout ~ (intS+r)*isSample + intS*isRef + k*log_dose,
|
||||
data=circle,
|
||||
start=list(intS = 0, k=1,r=0),
|
||||
control = gsl_nls_control(xtol=1e-10,ftol=1e-10,gtol=1e-10))
|
||||
# alternativ: modAB <- lm(readout ~ log_dose+isSample, circle)
|
||||
sum_mLin <- summary(mLin)
|
||||
|
||||
log_dose <- unique(all_l2$log_dose)
|
||||
seq_x <- seq(min(log_dose), max(log_dose),0.1)
|
||||
SAMPLEtrue <- sigmoid[5] + (sigmoid[7]-sigmoid[5])/(1+exp(sigmoid[6]*((sigmoid[4]-sigmoid[8]-seq_x))))
|
||||
REFtrue <- sigmoid[1] + (sigmoid[3]-sigmoid[1])/(1+exp(sigmoid[2]*((sigmoid[4]-seq_x))))
|
||||
|
||||
truePL_df <- cbind(seq_x,SAMPLEtrue, REFtrue)
|
||||
|
||||
p <- ggplot(all_l2,aes(x=log_dose,y=readout, color=factor(isRef))) +
|
||||
geom_point() +
|
||||
labs(title=paste("linear regression model", indS,indT), color="product") +
|
||||
scale_colour_manual(labels = c("test","reference"), values=c("#C2173F","#4545BA")) +
|
||||
ylim(min(all_l2$readout),max(all_l2$readout)) +
|
||||
theme_bw()
|
||||
p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="#4545BA",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=pl_df,aes(x=lnC,y=plotT),color="#C2173F",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
labs(title = paste("unrestricted linear regression model",indS,indT), color="product") +
|
||||
theme(legend.position="none", axis.text = element_text(size=14))
|
||||
p3 <- p2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
|
||||
size=5,alpha=0.2), inherit.aes = FALSE) +
|
||||
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
|
||||
# fit intercept for test and ref and common slope
|
||||
|
||||
|
||||
pl_restS <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[2,1]*log_dose
|
||||
pl_restT <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[3,1] + sum_mLin$coefficients[2,1]*log_dose
|
||||
pl_rest <- data.frame(lnC=log_dose, plotS=pl_restS, plotT=pl_restT)
|
||||
|
||||
pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="#4545BA",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=pl_rest,aes(x=lnC,y=plotT),color="#C2173F",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
labs(title = paste("restricted linear regression model",indS,indT), color="product") +
|
||||
theme(legend.position="none", axis.text = element_text(size=14))
|
||||
pr3 <- pr2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
|
||||
size=5,alpha=0.2), inherit.aes = FALSE) +
|
||||
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
|
||||
return(grid.arrange(p3,pr3,nrow=1))
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Calculates the potency of 4PL PLA of all models model
|
||||
#'
|
||||
#' The gradient method is used for calculating the potency for a restricted model, an unrestricteed model,
|
||||
@@ -1247,7 +1307,7 @@ server <- function(input, output, session) {
|
||||
verbatimTextOutput("sessioninfo"))
|
||||
)
|
||||
})
|
||||
|
||||
##### UI XL ----
|
||||
output$Dataupload <- renderUI({
|
||||
navbarPage(title="Information",
|
||||
tabPanel(title = "Real data",
|
||||
@@ -1312,11 +1372,11 @@ server <- function(input, output, session) {
|
||||
),
|
||||
column(8,
|
||||
plotOutput("XLplot"),
|
||||
|
||||
DTOutput("pottab4plXL"),
|
||||
plotOutput("diagnplot"),
|
||||
DTOutput("EQtests"),
|
||||
DTOutput("pottab4pl"),
|
||||
DTOutput("pottab4plTrans"),
|
||||
|
||||
DTOutput("pottab4plTransXL"),
|
||||
tableOutput("ANOVAXLS")
|
||||
)
|
||||
|
||||
@@ -1335,7 +1395,6 @@ server <- function(input, output, session) {
|
||||
mainPanel(
|
||||
tabsetPanel(id="tabs",
|
||||
tabPanel("linear PLA",
|
||||
|
||||
column(12,
|
||||
htmlOutput("PureErrW3"),
|
||||
tags$head(tags$style("#PureErrW3{color: red;
|
||||
@@ -1348,7 +1407,7 @@ server <- function(input, output, session) {
|
||||
tableOutput("SummaryModABu"),
|
||||
h4("Restricted linear model (CSSI):"),
|
||||
tableOutput("SummaryModAB"),
|
||||
|
||||
|
||||
h3("Tests for linear PLA):"),
|
||||
box(title="Suitability tests", status="primary",solidHeader = T, width=12,
|
||||
DTOutput("TESTSlin")),
|
||||
@@ -1357,9 +1416,10 @@ server <- function(input, output, session) {
|
||||
h5("All other tests pass if p-value > 0.05"),
|
||||
"SST CI for difference of slopes:",
|
||||
tableOutput("SlopeDiffCI"),
|
||||
|
||||
|
||||
h3("ANOVA for parallel line assay"),
|
||||
DTOutput("ANOVAlin"))),
|
||||
DTOutput("ANOVAlin"))
|
||||
),
|
||||
tabPanel("Report",
|
||||
h4("Settings for report")
|
||||
))
|
||||
@@ -1396,9 +1456,9 @@ server <- function(input, output, session) {
|
||||
|
||||
|
||||
|
||||
|
||||
##### UI Meta ----
|
||||
output$fourPL <- renderUI({
|
||||
navbarPage(title="4PL",
|
||||
navbarPage(title="4PL+linear reg",
|
||||
tabPanel("Analysis and Plots",
|
||||
#sidebarLayout(
|
||||
# sidebarPanel(
|
||||
@@ -1410,7 +1470,7 @@ server <- function(input, output, session) {
|
||||
tabsetPanel(id="tabs",
|
||||
tabPanel("Settings",
|
||||
h4("Settings of 4PL regression"),
|
||||
div(checkboxInput("PureErr4pl", "Should pure error be used for calculation of CIs?", FALSE),
|
||||
div(checkboxInput("PureErrMeta", "Should pure error be used for calculation of CIs?", FALSE),
|
||||
style = "font-size: 24px !important;color: #C2173F"),
|
||||
|
||||
h4("User help"),
|
||||
@@ -1472,7 +1532,10 @@ server <- function(input, output, session) {
|
||||
sliderInput("outlU","outlier in upper asymptote", min=0, max=1.5,value=0, step=0.1)
|
||||
),
|
||||
h4("log-dilutions from settings above"),
|
||||
verbatimTextOutput("logdil")
|
||||
verbatimTextOutput("logdil"),
|
||||
column(8,
|
||||
box(title = "Simulated data per log-concentration", status="warning",solidHeader = T, width=12, "incl. mean, sd and CV%",
|
||||
DT::dataTableOutput("ConctabMeta")))
|
||||
|
||||
#)
|
||||
),
|
||||
@@ -1487,7 +1550,7 @@ server <- function(input, output, session) {
|
||||
tags$style(span(htmlOutput("PureErrW3"), style="color: red")),
|
||||
htmlOutput("PureErrW3"),
|
||||
|
||||
plotOutput("plot", width = "80%"),
|
||||
plotOutput("plot4plMeta", width = "80%"),
|
||||
DTOutput("pottab4pl"),
|
||||
"Footnote: test performed on relative CIs.",
|
||||
|
||||
@@ -1510,18 +1573,51 @@ server <- function(input, output, session) {
|
||||
h5("SSE ... 'Pure error' in the SumSquares column"),
|
||||
h5("RMSE ... Square root of the 'Residual Error' in the MeanSquares column"),
|
||||
verbatimTextOutput("RMSE")
|
||||
),
|
||||
column(8,
|
||||
box(title = "Simulated data per log-concentration", status="warning",solidHeader = T, width=12, "incl. mean, sd and CV%",
|
||||
DT::dataTableOutput("Conctab")))
|
||||
)
|
||||
))
|
||||
),
|
||||
|
||||
tabPanel("ln-transformed y",
|
||||
h4("ln-transformed y-axis plots"),
|
||||
plotOutput("plot4plTrans", width = "80%"),
|
||||
plotOutput("plot4plTransMeta", width = "80%"),
|
||||
DT::dataTableOutput("pottab4plTrans"),
|
||||
),
|
||||
tabPanel("linear regression",
|
||||
h4("Evaluations from meta-data"),
|
||||
htmlOutput("PureErrW3"),
|
||||
tags$head(tags$style("#PureErrW3{color: red;
|
||||
font-size: 16px;
|
||||
font_style: italic;}")),
|
||||
column(12,
|
||||
|
||||
plotOutput("plotLinMeta"),
|
||||
"Delta method is used for potency CIs",
|
||||
DTOutput("pottabMeta")
|
||||
),
|
||||
column(5,
|
||||
h3("Tests for linear PLA:"),
|
||||
box(title="Suitability tests", status="primary",solidHeader = T,collapsible=T, 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,
|
||||
tableOutput("SummaryModABuMeta")),
|
||||
h4("Restricted linear model (CSSI):"),
|
||||
box(title="Restricted linear model (CSSI):", status="primary",solidHeader = T,collapsible=T, width=12,
|
||||
tableOutput("SummaryModABMeta"))
|
||||
),
|
||||
|
||||
column(6,
|
||||
|
||||
h3("ANOVA for parallel line assay"),
|
||||
box(title="ANOVA for simultated data", status="primary",solidHeader = T, collapsible=T, width=12,
|
||||
DTOutput("ANOVAlinMeta")),
|
||||
" CI for difference of slopes:",
|
||||
tableOutput("SlopeDiffCIMeta"),
|
||||
)
|
||||
),
|
||||
tabPanel("Report",
|
||||
h4("Settings for report"),
|
||||
downloadButton("downloadXLReport", label="Download PDF report", class="butt"),
|
||||
@@ -1795,13 +1891,13 @@ server <- function(input, output, session) {
|
||||
REP$DiagnTable <- DiagnTable
|
||||
|
||||
logpotest <- FITsTrans[[3]] #exp(confintd(mrlog, "r", method = "asymptotic")) # compParm(logpot, "c")
|
||||
logpotuest <- FITsTrans[[4]] # exp(confintd(mulog, "r", method = "asymptotic")) # compParm(logpotu, "c")
|
||||
logpotUest <- FITsTrans[[4]] # exp(confintd(mulog, "r", method = "asymptotic")) # compParm(logpotu, "c")
|
||||
|
||||
# Berechnung der Konfidenzintervalle (CI)
|
||||
# logpotCI <- c(exp(Smrlog[5,1] - qt(0.975, nrow(all_1)-5) * Smrlog[5,2]), exp(Smrlog[5,1]), exp(Smrlog[5,1] + qt(0.975, nrow(all_1)-5) * Smrlog[5,2]))
|
||||
colnames(logpotest) <- c("estimate", "lowerCI", "upperCI")
|
||||
|
||||
colnames(logpotuest) <- c("estimate", "lowerCI", "upperCI")
|
||||
colnames(logpotUest) <- c("estimate", "lowerCI", "upperCI")
|
||||
#browser()
|
||||
cnXL <- colnames(XLdat2)
|
||||
Filesample <- data.frame(Test = c("File name", "samples"), Test2=c(Dat$FileName, paste(cnXL[1], " vs ", cnXL[4])))
|
||||
@@ -1839,8 +1935,7 @@ server <- function(input, output, session) {
|
||||
coeffs_R <- coeffsMR # pot$coefficients
|
||||
coeffs_R[5] <- coeffs_R[4] - coeffs_R[5]
|
||||
names(coeffs_R) <- c("lower A", "slope", "upper A", "EC50 REF", "EC50 TEST")
|
||||
# coeffs_R[4] <- log(coeffs_R[4])
|
||||
# coeffs_R[5] <- log(coeffs_R[5])
|
||||
|
||||
# --- Ergebnistabelle: RESTRICTED ---
|
||||
PLAAusw <- data.frame(
|
||||
Information = c("model", "lower asymptote", "Hill's slope", "upper asymptote","EC50 Ref",
|
||||
@@ -1856,7 +1951,7 @@ server <- function(input, output, session) {
|
||||
REP$PLAausw <- PLAAusw
|
||||
REP$PLBend <- PLAAusw2
|
||||
|
||||
# --- Koeffizienten-Extraktion ---
|
||||
#### Koeffizienten-Extraktion ----
|
||||
logcoeffs_R <- SRlog$coefficients[, 1] # logpot$coefficients
|
||||
names(logcoeffs_R) <- c("lower A", "Hill's slope", "upper A", "EC50 REF","EC50 DIFF")
|
||||
|
||||
@@ -1867,7 +1962,7 @@ server <- function(input, output, session) {
|
||||
"EC50 difference", "log relative potency",
|
||||
"log lower CI", "log upper CI"),
|
||||
Results = unlist(c("LOG RESTRICTED", round(logcoeffs_R, 3),
|
||||
round(logpotest * 100, 3)))) # von gs1_nls
|
||||
round(logpotest * 100, 3)))) # von gsl_nls
|
||||
|
||||
output$logcoeffs_r <- renderTable({ LogPLAAusw })
|
||||
REP$LogPLAausw <- LogPLAAusw
|
||||
@@ -1885,7 +1980,7 @@ server <- function(input, output, session) {
|
||||
"relative potency", "lower CI", "upper CI"),
|
||||
|
||||
Results = unlist(c("LOG UNRESTRICTED", round(logcoeffs_UNR, 3),
|
||||
round(logpotest * 100, 3)))) # von gs1_nls
|
||||
round(logpotUest * 100, 3)))) # von gsl_nls
|
||||
|
||||
output$logcoeffs_unr <- renderTable({
|
||||
LogUnrPLAAusw
|
||||
@@ -1900,7 +1995,7 @@ server <- function(input, output, session) {
|
||||
} else Dat$dilution <- exp(XLdat[,logI])
|
||||
# --- Plot-Ausgabe ---
|
||||
output$XLplot <- renderPlot({
|
||||
plot_f(XLdat2, sigmoid = NULL, det_sig = coeffsMU, TransFlag=F)
|
||||
plot_f(XLdat2, TransFlag=F)
|
||||
})
|
||||
|
||||
REP$XLdat2 <- XLdat2
|
||||
@@ -1967,82 +2062,82 @@ server <- function(input, output, session) {
|
||||
})
|
||||
|
||||
#### updateSlider on XLSX ----
|
||||
observe({
|
||||
if (!is.null(Dat$potDiffXL)) {
|
||||
updateSliderInput(session, "potencydiff",
|
||||
value=round(as.numeric(Dat$potDiffXL[[1]]),5))
|
||||
}
|
||||
})
|
||||
observeEvent(input$potencydiff, {
|
||||
if (!is.null(Dat$potDiffXL)) {
|
||||
updateSliderInput(session, "potencydiff",
|
||||
value=round(as.numeric(input$potencydiff),5))
|
||||
}
|
||||
})
|
||||
observe({
|
||||
if (!is.null(Dat$ProzSD_XL)) {
|
||||
updateSliderInput(session, "sdfacf",
|
||||
value=round(as.numeric(Dat$ProzSD_XL[[1]]),5))
|
||||
}
|
||||
})
|
||||
observeEvent(input$sdfac, {
|
||||
if (!is.null(Dat$ProzSD_XL)) {
|
||||
updateSliderInput(session, "sdfac",
|
||||
value=round(as.numeric(Dat$ProzSD_XL[[1]]),5))
|
||||
}
|
||||
})
|
||||
# observe({
|
||||
# if (!is.null(Dat$potDiffXL)) {
|
||||
# updateSliderInput(session, "potencydiff",
|
||||
# value=round(as.numeric(Dat$potDiffXL[[1]]),5))
|
||||
# }
|
||||
# })
|
||||
# observeEvent(input$potencydiff, {
|
||||
# if (!is.null(Dat$potDiffXL)) {
|
||||
# updateSliderInput(session, "potencydiff",
|
||||
# value=round(as.numeric(input$potencydiff),5))
|
||||
# }
|
||||
# })
|
||||
# observe({
|
||||
# if (!is.null(Dat$ProzSD_XL)) {
|
||||
# updateSliderInput(session, "sdfac",
|
||||
# value=round(as.numeric(Dat$ProzSD_XL[[1]]),5))
|
||||
# }
|
||||
# })
|
||||
# observeEvent(input$sdfac, {
|
||||
# if (!is.null(Dat$ProzSD_XL)) {
|
||||
# updateSliderInput(session, "sdfac",
|
||||
# value=round(as.numeric(Dat$ProzSD_XL[[1]]),5))
|
||||
# }
|
||||
# })
|
||||
|
||||
#### updaterNumeric Input ----
|
||||
observe({
|
||||
if(!is.null(Dat$coeffs_UN)) {
|
||||
updateNumericInput(session, "lowAsymptREF",
|
||||
value=round(as.numeric(Dat$coeffs_UN[3]),5), min=0)
|
||||
updateNumericInput(session, "lowAsymptTEST",
|
||||
value=round(as.numeric(Dat$coeffs_UN[4]),5), min=0)
|
||||
updateNumericInput(session, "uppAsymptREF",
|
||||
value=round(as.numeric(Dat$coeffs_UN[5]),5), min=0)
|
||||
updateNumericInput(session, "uppAsymptTEST",
|
||||
value=round(as.numeric(Dat$coeffs_UN[6]),5), min=0)
|
||||
updateNumericInput(session, "slopeREF",
|
||||
value=round(as.numeric(Dat$coeffs_UN[1]),5))
|
||||
updateNumericInput(session, "slopeTEST",
|
||||
value=round(as.numeric(Dat$coeffs_UN[2]),5))
|
||||
updateNumericInput(session, "EC50",
|
||||
value=round(as.numeric(Dat$coeffs_UN[7]),5))
|
||||
updateNumericInput(session, "potDiff",
|
||||
value=round(as.numeric(Dat$coeffs_UN[7])- as.numeric(Dat$coeffs_UN[8]),5))
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
if(!is.null(Dat$dilution)) {
|
||||
updateNumericInput(session, "CONC1",
|
||||
value=as.numeric(Dat$dilution[1]))
|
||||
updateNumericInput(session, "CONC2",
|
||||
value=as.numeric(Dat$dilution[2]))
|
||||
updateNumericInput(session, "CONC3",
|
||||
value=as.numeric(Dat$dilution[3]))
|
||||
updateNumericInput(session, "CONC4",
|
||||
value=as.numeric(Dat$dilution[4]))
|
||||
updateNumericInput(session, "CONC5",
|
||||
value=as.numeric(Dat$dilution[5]))
|
||||
updateNumericInput(session, "CONC6",
|
||||
value=as.numeric(Dat$dilution[6]))
|
||||
updateNumericInput(session, "CONC7",
|
||||
value=as.numeric(Dat$dilution[7]))
|
||||
updateNumericInput(session, "CONC8",
|
||||
value=as.numeric(Dat$dilution[8]))
|
||||
updateNumericInput(session, "CONC9",
|
||||
value=as.numeric(Dat$dilution[9]))
|
||||
updateNumericInput(session, "CONC10",
|
||||
value=as.numeric(Dat$dilution[10]))
|
||||
updateNumericInput(session, "CONC11",
|
||||
value=as.numeric(Dat$dilution[11]))
|
||||
updateNumericInput(session, "CONC12",
|
||||
value=as.numeric(Dat$dilution[12]))
|
||||
|
||||
}
|
||||
})
|
||||
# observe({
|
||||
# if(!is.null(Dat$coeffs_UN)) {
|
||||
# updateNumericInput(session, "lowAsymptREF",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[3]),5), min=0)
|
||||
# updateNumericInput(session, "lowAsymptTEST",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[4]),5), min=0)
|
||||
# updateNumericInput(session, "uppAsymptREF",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[5]),5), min=0)
|
||||
# updateNumericInput(session, "uppAsymptTEST",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[6]),5), min=0)
|
||||
# updateNumericInput(session, "slopeREF",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[1]),5))
|
||||
# updateNumericInput(session, "slopeTEST",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[2]),5))
|
||||
# updateNumericInput(session, "EC50",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[7]),5))
|
||||
# updateNumericInput(session, "potDiff",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[7])- as.numeric(Dat$coeffs_UN[8]),5))
|
||||
# }
|
||||
# })
|
||||
#
|
||||
# observe({
|
||||
# if(!is.null(Dat$dilution)) {
|
||||
# updateNumericInput(session, "CONC1",
|
||||
# value=as.numeric(Dat$dilution[1]))
|
||||
# updateNumericInput(session, "CONC2",
|
||||
# value=as.numeric(Dat$dilution[2]))
|
||||
# updateNumericInput(session, "CONC3",
|
||||
# value=as.numeric(Dat$dilution[3]))
|
||||
# updateNumericInput(session, "CONC4",
|
||||
# value=as.numeric(Dat$dilution[4]))
|
||||
# updateNumericInput(session, "CONC5",
|
||||
# value=as.numeric(Dat$dilution[5]))
|
||||
# updateNumericInput(session, "CONC6",
|
||||
# value=as.numeric(Dat$dilution[6]))
|
||||
# updateNumericInput(session, "CONC7",
|
||||
# value=as.numeric(Dat$dilution[7]))
|
||||
# updateNumericInput(session, "CONC8",
|
||||
# value=as.numeric(Dat$dilution[8]))
|
||||
# updateNumericInput(session, "CONC9",
|
||||
# value=as.numeric(Dat$dilution[9]))
|
||||
# updateNumericInput(session, "CONC10",
|
||||
# value=as.numeric(Dat$dilution[10]))
|
||||
# updateNumericInput(session, "CONC11",
|
||||
# value=as.numeric(Dat$dilution[11]))
|
||||
# updateNumericInput(session, "CONC12",
|
||||
# value=as.numeric(Dat$dilution[12]))
|
||||
#
|
||||
# }
|
||||
# })
|
||||
|
||||
observe({
|
||||
if(!is.null(Dat$MetaConc)) {
|
||||
@@ -2119,33 +2214,33 @@ server <- function(input, output, session) {
|
||||
####sim2 ----
|
||||
sim2 <- reactive({
|
||||
tab <- sim()
|
||||
if (is.null(Dat$EXCEL)) return(tab) else return(Dat$EXCEL)
|
||||
#if (is.null(Dat$EXCEL)) return(tab) else return(Dat$EXCEL)
|
||||
})
|
||||
|
||||
|
||||
#### Plot 4pl ----
|
||||
output$plot <- renderPlot({
|
||||
output$plot4plMeta <- renderPlot({
|
||||
#browser()
|
||||
sigmoid <- sigmoid()
|
||||
det_sig=NULL
|
||||
plot_f(sim2(),sigmoid, det_sig, TransFlag = F)
|
||||
plot_f(sim2(), TransFlag = F)
|
||||
})
|
||||
|
||||
#### Plot 4pl Transformed ----
|
||||
output$plot4plTrans <- renderPlot({
|
||||
output$plot4plTransMeta <- renderPlot({
|
||||
#browser()
|
||||
sigmoid <- sigmoid()
|
||||
det_sig=NULL
|
||||
plot_f(sim2(),sigmoid, det_sig, TransFlag = T)
|
||||
plot_f(sim2(), TransFlag = T)
|
||||
})
|
||||
|
||||
|
||||
#### Testergebnisse für 4PL ----
|
||||
observe({
|
||||
if (is.null(sim2())) return(NULL)
|
||||
if (is.null(input$PureErr4pl)) return(NULL)
|
||||
if (is.null(input$PureErrMeta)) return(NULL)
|
||||
#observeEvent(input$StartCalc,{
|
||||
PureErrFlag <- input$PureErr4pl
|
||||
PureErrFlag <- input$PureErrMeta
|
||||
warning_text3 <- reactive({
|
||||
ifelse(PureErrFlag, 'Pure error selected','')
|
||||
})
|
||||
@@ -2261,6 +2356,31 @@ server <- function(input, output, session) {
|
||||
dom="t"
|
||||
))
|
||||
})
|
||||
##### Concentrationtab Meta ----
|
||||
output$ConctabMeta <- DT::renderDataTable({
|
||||
if (!is.na(Dils()[1]) & is.na(Dils()[4])) return(NULL)
|
||||
tab <- sim2()
|
||||
if (is.character(tab)) stop(tab)
|
||||
if (!is.na(Dils()[4])) {
|
||||
noDilSer <- Dils()[4]
|
||||
} else if (!is.null(Dat$noDilSeriesXL)) {
|
||||
noDilSer <- Dat$noDilSeriesXL
|
||||
} else { noDilSer <- 3 }
|
||||
|
||||
Conc <- CONC()
|
||||
Conctab <- perConcTab(tab, noDilSeries = noDilSer)
|
||||
Dat$Conctab <- Conctab
|
||||
|
||||
dat <- datatable(Conctab, options=list(
|
||||
paging=T,
|
||||
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)
|
||||
})
|
||||
|
||||
output$Conctab <- DT::renderDataTable({
|
||||
if (!is.na(Dils()[1]) & is.na(Dils()[4])) return(NULL)
|
||||
@@ -2287,10 +2407,10 @@ server <- function(input, output, session) {
|
||||
) %>% formatRound(columns=colnames(Conctab), digits=3)
|
||||
})
|
||||
|
||||
#### linear Plot output ----
|
||||
|
||||
#### process XL linearly, Plot output ----
|
||||
output$plotLin <- renderPlot({
|
||||
|
||||
|
||||
if (is.null(Dat$EXCEL)) return(NULL)
|
||||
tab <- Dat$EXCEL
|
||||
|
||||
# tab <- sim2()
|
||||
@@ -2336,70 +2456,25 @@ server <- function(input, output, session) {
|
||||
|
||||
Dat$circles <- circle
|
||||
#browser()
|
||||
mLin <- gsl_nls(readout ~ (intS+r)*isSample + intS*isRef + k*log_dose,
|
||||
data=circle,
|
||||
start=list(intS = 0, k=1,r=0),
|
||||
control = gsl_nls_control(xtol=1e-10,ftol=1e-10,gtol=1e-10))
|
||||
# alternativ: modAB <- lm(readout ~ log_dose+isSample, circle)
|
||||
sum_mLin <- summary(mLin)
|
||||
sigmoid <- Dat$coeffsMUnr
|
||||
log_dose <- unique(all_l$log_dose)
|
||||
seq_x <- seq(min(log_dose), max(log_dose),0.1)
|
||||
SAMPLEtrue <- sigmoid[5] + (sigmoid[7]-sigmoid[5])/(1+exp(sigmoid[6]*((sigmoid[4]-sigmoid[8]-seq_x))))
|
||||
REFtrue <- sigmoid[1] + (sigmoid[3]-sigmoid[1])/(1+exp(sigmoid[2]*((sigmoid[4]-seq_x))))
|
||||
|
||||
truePL_df <- cbind(seq_x,SAMPLEtrue, REFtrue)
|
||||
|
||||
p <- ggplot(all_l2,aes(x=log_dose,y=readout, color=factor(isRef))) +
|
||||
geom_point() +
|
||||
labs(title=paste("linear regression model", indS,indT), color="product") +
|
||||
scale_colour_manual(labels = c("test","reference"), values=c("#C2173F","#4545BA")) +
|
||||
ylim(min(all_l2$readout),max(all_l2$readout)) +
|
||||
theme_bw()
|
||||
p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="#4545BA",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=pl_df,aes(x=lnC,y=plotT),color="#C2173F",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
labs(title = paste("unrestricted linear regression model",indS,indT), color="product") +
|
||||
theme(legend.position="none", axis.text = element_text(size=14))
|
||||
p3 <- p2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
|
||||
size=5,alpha=0.2), inherit.aes = FALSE) +
|
||||
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
|
||||
# fit intercept for test and ref and common slope
|
||||
|
||||
|
||||
pl_restS <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[2,1]*log_conc
|
||||
pl_restT <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[3,1] + sum_mLin$coefficients[2,1]*log_conc
|
||||
pl_rest <- data.frame(lnC=log_conc, plotS=pl_restS, plotT=pl_restT)
|
||||
|
||||
pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="#4545BA",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=pl_rest,aes(x=lnC,y=plotT),color="#C2173F",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
labs(title = paste("restricted linear regression model",indS,indT), color="product") +
|
||||
theme(legend.position="none", axis.text = element_text(size=14))
|
||||
pr3 <- pr2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
|
||||
size=5,alpha=0.2), inherit.aes = FALSE) +
|
||||
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
|
||||
grid.arrange(p3,pr3,nrow=1)
|
||||
pLin <- PlotLinPLA_FUNC(circle, sigmoid = sigmoid, all_l2, pl_df, indS, indT)
|
||||
|
||||
|
||||
pLin
|
||||
})
|
||||
|
||||
|
||||
output$plotLin2 <- renderPlot({
|
||||
#### process metadata, Plot output ----
|
||||
output$plotLinMeta <- renderPlot({
|
||||
tab <- sim2()
|
||||
|
||||
if(is.null(tab)) return(NULL)
|
||||
if (is.character(tab)) stop(tab)
|
||||
#browser()
|
||||
if (!is.na(Dils()[4])) noDilSer <- Dils()[4] else noDilSer = (ncol(tab)-1)/2
|
||||
Conc <- CONC()
|
||||
Conctab <- Dat$Conctab
|
||||
log_conc <- log(Conc)
|
||||
Conctab <- perConcTab(tab, noDilSer)
|
||||
if (!is.na(Dils()[3])) noDil <- Dils()[3] else noDil = length(Conc)
|
||||
|
||||
slopeSt <- slopeTe <- matrix(NA, nrow=noDil-2,ncol=2)
|
||||
@@ -2434,67 +2509,56 @@ server <- function(input, output, session) {
|
||||
circleT <- all_mT[(indT*noDilSer-(noDilSer-1)):((indT+2)*noDilSer),]
|
||||
circle <- rbind(circleS,circleT)
|
||||
|
||||
Dat$circles <- circle
|
||||
Dat$circlesMeta <- circle
|
||||
sigmoid <- sigmoid()
|
||||
log_dose <- unique(all_l$log_dose)
|
||||
seq_x <- seq(min(log_dose), max(log_dose),0.1)
|
||||
SAMPLEtrue <- sigmoid[2] + (sigmoid[4]-sigmoid[2])/(1+exp(sigmoid[6]*((sigmoid[7]-log(input$potencydiff/100)-seq_x))))
|
||||
REFtrue <- sigmoid[1] + (sigmoid[3]-sigmoid[1])/(1+exp(sigmoid[5]*((sigmoid[7]-seq_x))))
|
||||
|
||||
truePL_df <- cbind(seq_x,SAMPLEtrue, REFtrue)
|
||||
|
||||
p <- ggplot(all_l2,aes(x=log_dose,y=readout, color=factor(isRef))) +
|
||||
geom_point() +
|
||||
labs(title=paste("linear regression model", indS,indT), color="product") +
|
||||
scale_colour_manual(labels = c("test","reference"), values=c("red","blue")) +
|
||||
ylim(min(all_l2$readout),max(all_l2$readout)) +
|
||||
theme_bw()
|
||||
p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="blue",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=pl_df,aes(x=lnC,y=plotT),color="red",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="red", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="blue", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
labs(title = paste("unrestricted linear regression model",indS,indT), color="product") +
|
||||
theme(legend.position="none", axis.text = element_text(size=14))
|
||||
p3 <- p2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
|
||||
size=5,alpha=0.2), inherit.aes = FALSE) +
|
||||
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
|
||||
|
||||
mLin <- gsl_nls(readout ~ (intS+r)*isSample + intS*isRef + k*log_dose,
|
||||
data=circle,
|
||||
start=list(intS = 0, k=1,r=0),
|
||||
control = gsl_nls_control(xtol=1e-10,ftol=1e-10,gtol=1e-10))
|
||||
# alternativ: modAB <- lm(readout ~ log_dose+isSample, circle)
|
||||
sum_mLin <- summary(mLin)
|
||||
|
||||
pl_restS <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[2,1]*log_conc
|
||||
pl_restT <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[3,1] + sum_mLin$coefficients[2,1]*log_conc
|
||||
pl_rest <- data.frame(lnC=log_conc, plotS=pl_restS, plotT=pl_restT)
|
||||
|
||||
pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="blue",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=pl_rest,aes(x=lnC,y=plotT),color="red",
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="red", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="blue", linetype=2,alpha=0.4,
|
||||
inherit.aes = F) +
|
||||
labs(title = paste("restricted linear regression model",indS,indT), color="product") +
|
||||
theme(legend.position="none", axis.text = element_text(size=14))
|
||||
pr3 <- pr2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
|
||||
size=5,alpha=0.2), inherit.aes = FALSE) +
|
||||
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
|
||||
grid.arrange(p3,pr3,nrow=1)
|
||||
#browser()
|
||||
pLin2 <- PlotLinPLA_FUNC(circle, sigmoid = sigmoid, all_l2, pl_df,indS, indT)
|
||||
pLin2
|
||||
})
|
||||
|
||||
#### linear PLA tests ----
|
||||
output$TESTSlin <- DT::renderDataTable({
|
||||
#### linear PLA tests Metadata ----
|
||||
output$TESTSlinMeta <- DT::renderDataTable({
|
||||
tab <- sim2()
|
||||
if (is.character(tab)) stop(tab)
|
||||
if (is.null(tab)) return(NULL)
|
||||
Conc <- CONC()
|
||||
Limite <- Dat$limite
|
||||
|
||||
circlesMeta <- Dat$circlesMeta
|
||||
PureErrFlag <- input$PureErrMeta
|
||||
warning_text <- reactive({
|
||||
ifelse(PureErrFlag, 'Pure error is selected','')
|
||||
})
|
||||
output$PureErrW <- renderText(warning_text())
|
||||
browser()
|
||||
LIN <- ANOVAlintests(tab,circlesMeta,Limite,PureErrFlag=PureErrFlag)
|
||||
df <- LIN[[1]]
|
||||
su_modU <- LIN[[2]]
|
||||
su_mod2 <- LIN[[4]]
|
||||
|
||||
output$SummaryModABuMeta <- renderTable({ su_modU }, digits=5)
|
||||
output$SummaryModABMeta <- renderTable({ su_mod2 }, digits=5)
|
||||
|
||||
slopeDiffCI <- t(data.frame(LIN[[3]]))
|
||||
colnames(slopeDiffCI) <- c("slope difference","lower CI","upper CI")
|
||||
output$SlopeDiffCIMeta <- renderTable({ slopeDiffCI },digits=5)
|
||||
|
||||
SelTestsL <- as.numeric(input$selectedSSTsLinear)
|
||||
df2 <- df
|
||||
|
||||
Dat$ANOVAMeta <- df[,4:length(df)]
|
||||
dat <- datatable(df2[,1:3],
|
||||
options=list(
|
||||
paging=T, dom="t",rownames=F
|
||||
)) %>% formatStyle("test_results", target="row",backgroundColor = styleEqual(c(-1,0,1),
|
||||
c("pink","lightgreen","lightgrey")))
|
||||
|
||||
})
|
||||
|
||||
#### linear PLA tests XLinput ----
|
||||
output$TESTSlin <- DT::renderDataTable({
|
||||
tab <- Dat$EXCEL
|
||||
if (is.character(tab)) stop(tab)
|
||||
Conc <- exp(tab$log_dose)
|
||||
Limite <- list(as.numeric(input$lEACdiffla), as.numeric(input$uEACdiffla),
|
||||
as.numeric(input$lEACratiola), as.numeric(input$uEACratiola),
|
||||
as.numeric(input$lEACratioSlope), as.numeric(input$uEACratioSlope),
|
||||
@@ -2502,14 +2566,49 @@ server <- function(input, output, session) {
|
||||
as.numeric(input$lowerPot), as.numeric(input$upperPot),
|
||||
as.numeric(input$lEACratioAdiff), as.numeric(input$uEACratioAdiff))
|
||||
|
||||
circles <- Dat$circles
|
||||
noDil <- nrow(tab)
|
||||
noDilSer <- Dat$noDilSeriesXL
|
||||
Conctab <- perConcTab(tab, noDilSeries = noDilSer)
|
||||
#browser()
|
||||
slopeSt <- slopeTe <- matrix(NA, nrow=noDil-2,ncol=2)
|
||||
for (i in 1:(noDil-2)) {
|
||||
avs <- Conctab[noDilSer+1,]
|
||||
threes <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avs[i:(i+2)])
|
||||
lm3St <- lm(resp ~ lnC, data=threes)
|
||||
slopeSt[i,] <- lm3St$coefficients
|
||||
avt <- Conctab[noDilSer*2+4,]
|
||||
threet <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avt[i:(i+2)])
|
||||
lm3Te <- lm(resp ~ lnC, data=threet)
|
||||
slopeTe[i,] <- lm3Te$coefficients
|
||||
}
|
||||
|
||||
indS <- which(abs(slopeSt[,2]) == max(abs(slopeSt[,2])))
|
||||
indT <- which(abs(slopeTe[,2]) == max(abs(slopeTe[,2])))
|
||||
|
||||
# pl_ <- slopeSt[indS,1]+slopeSt[indS,2]*log_conc
|
||||
# pl_T <- slopeTe[indT,1]+slopeTe[indT,2]*log_conc
|
||||
# pl_df <- data.frame(lnC=log_conc, plotS=pl_, plotT=pl_T)
|
||||
|
||||
all_l <- melt(data.frame(tab), id.vars="log_dose",variable.name="replname",value.name="readout")
|
||||
isRef <- rep(c(1,0), 1,each=nrow(all_l)/2)
|
||||
isSample <- rep(c(0,1), 1,each=nrow(all_l)/2)
|
||||
all_l2 <- cbind(all_l,isRef, isSample)
|
||||
all_l2S <- all_l2[all_l2$isRef == 1,]
|
||||
all_l2T <- all_l2[all_l2$isRef == 0,]
|
||||
all_mS <- all_l2S[order(all_l2S$log_dose, decreasing=TRUE),]
|
||||
all_mT <- all_l2T[order(all_l2T$log_dose, decreasing=TRUE),]
|
||||
|
||||
circleS <- all_mS[(indS*noDilSer-(noDilSer-1)):((indS+2)*noDilSer),]
|
||||
circleT <- all_mT[(indT*noDilSer-(noDilSer-1)):((indT+2)*noDilSer),]
|
||||
circle <- rbind(circleS,circleT)
|
||||
|
||||
PureErrFlag <- input$PureErr
|
||||
warning_text <- reactive({
|
||||
ifelse(PureErrFlag, 'Pure error is selected','')
|
||||
})
|
||||
output$PureErrW <- renderText(warning_text())
|
||||
|
||||
LIN <- ANOVAlintests(tab,circles,Limite,PureErrFlag=PureErrFlag)
|
||||
output$PureErrW3 <- renderText(warning_text())
|
||||
#browser()
|
||||
LIN <- ANOVAlintests(tab,circle,Limite,PureErrFlag=PureErrFlag)
|
||||
df <- LIN[[1]]
|
||||
su_modU <- LIN[[2]]
|
||||
su_mod2 <- LIN[[4]]
|
||||
@@ -2533,7 +2632,7 @@ server <- function(input, output, session) {
|
||||
|
||||
})
|
||||
|
||||
#### output 4PL ANOVA tests ---
|
||||
#### output 4PL ANOVA tests Meta ----
|
||||
output$ANOVA <- DT::renderDataTable({
|
||||
sigmoid <- sigmoid()
|
||||
tab <- ANOVA4plUnresfunc(sim2()) # ,sigmoid
|
||||
@@ -2545,18 +2644,33 @@ server <- function(input, output, session) {
|
||||
c("lightgrey")))
|
||||
})
|
||||
|
||||
#### output 4PL ANOVA tests XL ----
|
||||
# not needed
|
||||
# output$ANOVA_XL <- DT::renderDataTable({
|
||||
# tab <- Dat$EXCEL
|
||||
# tab <- ANOVA4plUnresfunc(sim2()) # ,sigmoid
|
||||
# dat <- datatable(tab,
|
||||
# options=list(
|
||||
# dom="t",rownames=F
|
||||
# )) %>% formatStyle("p_value", target="row",
|
||||
# backgroundColor = styleEqual(c("p_value"),
|
||||
# c("lightgrey")))
|
||||
# })
|
||||
|
||||
|
||||
#### output RMSEs ----
|
||||
output$RMSE <- renderText({
|
||||
paste("RMSE (unrestricted model):", Dat$RMSE_unr, "(~ entered % upper-lower asymptote)\n",
|
||||
"RMSE restricted model:", Dat$RMSE_r, "\n",
|
||||
"Pure RMSE unrestricted model:", Dat$RMSE_pure, "\n",
|
||||
"%SD (unr model): ", Dat$RMSE_unr*100/Dat$up_lowAs, "(calculated as: RMSE/(upper-lower Asymptote)*100\n",
|
||||
paste("RMSE (unrestricted model):", Dat$RMSE_unr, "(Use it to compare against RMSE restr. model for non-parallelism)\n",
|
||||
"RMSE (restricted model):", Dat$RMSE_r, "\n",
|
||||
"Pure RMSE (unrestricted model):", Dat$RMSE_pure, "\n",
|
||||
"%SD (unr. model): ", Dat$RMSE_unr*100/Dat$up_lowAs, "(calculated as: RMSE/(upper-lower Asymptote)*100\n",
|
||||
"RMSE (log restr. model): ", Dat$RMSE_Rlog, "\n",
|
||||
"RMSE (log unrestr. model): ", Dat$RMSE_Ulog, "\n",
|
||||
"%SDlog (unr model): ", Dat$RMSE_Ulog*100/Dat$up_lowAslog )
|
||||
})
|
||||
|
||||
output$ANOVAlin <- DT::renderDataTable({
|
||||
if (is.null(Dat$ANOVA)) return(NULL)
|
||||
ANOVAlin <- Dat$ANOVA
|
||||
dat <- datatable(ANOVAlin,
|
||||
options=list(
|
||||
@@ -2565,9 +2679,19 @@ server <- function(input, output, session) {
|
||||
backgroundColor = styleEqual(c("p.value"),
|
||||
c("lightgrey")))
|
||||
})
|
||||
### output pot tab ----
|
||||
|
||||
output$ANOVAlinMeta <- DT::renderDataTable({
|
||||
ANOVAlin <- Dat$ANOVAMeta
|
||||
dat <- datatable(ANOVAlin,
|
||||
options=list(
|
||||
dom="t",rownames=F
|
||||
)) %>% formatStyle("p.value", target='cell',
|
||||
backgroundColor = styleEqual(c("p.value"),
|
||||
c("lightgrey")))
|
||||
})
|
||||
#### output Lin pot tab XL ----
|
||||
output$pottab <- DT::renderDataTable({
|
||||
|
||||
if (is.null(Dat$circles)) return(NULL)
|
||||
Lim <- list(as.numeric(input$lEACdiffla), as.numeric(input$uEACdiffla),
|
||||
as.numeric(input$lEACratiola), as.numeric(input$uEACratiola),
|
||||
as.numeric(input$lEACratioSlope), as.numeric(input$uEACratioSlope),
|
||||
@@ -2582,17 +2706,38 @@ server <- function(input, output, session) {
|
||||
options=list(
|
||||
dom="t",rownames=F
|
||||
)) %>% formatStyle("test_result", target='row',
|
||||
backgroundColor = styleEqual(c(0,1), c("lightgrey")))
|
||||
backgroundColor = styleEqual(c(0,1), c("lightgrey","#F9545488")))
|
||||
})
|
||||
|
||||
#### 4pl potency table ----
|
||||
|
||||
### output pot tab Meta ----
|
||||
output$pottabMeta <- DT::renderDataTable({
|
||||
|
||||
Lim <- list(as.numeric(input$lEACdiffla), as.numeric(input$uEACdiffla),
|
||||
as.numeric(input$lEACratiola), as.numeric(input$uEACratiola),
|
||||
as.numeric(input$lEACratioSlope), as.numeric(input$uEACratioSlope),
|
||||
as.numeric(input$lEACratioua), as.numeric(input$uEACratioua),
|
||||
as.numeric(input$lowerPot), as.numeric(input$upperPot))
|
||||
|
||||
circles <- Dat$circlesMeta
|
||||
PureErrFlag <- input$PureErrMeta
|
||||
pottab <- LinPotTab(circles,Lim,PureErrFlag = PureErrFlag)
|
||||
#browser()
|
||||
dat <- datatable(pottab,
|
||||
options=list(
|
||||
dom="t",rownames=F
|
||||
)) %>% formatStyle("test_result", target='row',
|
||||
backgroundColor = styleEqual(c(0,1), c("lightgrey","#F9545488")))
|
||||
})
|
||||
|
||||
#### 4pl potency table Meta ----
|
||||
observe({
|
||||
#browser()
|
||||
if (is.null(sim2()) | is.null(Dils())) return(NULL)
|
||||
ro_new <- sim2()
|
||||
Dils_ <- Dils()
|
||||
if (!is.na(Dils()[4])) noDilSer <- Dils()[4] else noDilSer <- 3
|
||||
PureErrFl <- input$PureErr4pl
|
||||
PureErrFl <- input$PureErrMeta
|
||||
pottab4 <- pot4plFUNC(ro_new = ro_new, PureErrFlag = PureErrFl)
|
||||
#browser()
|
||||
Lim <- list(as.numeric(input$lEACdiffla), as.numeric(input$uEACdiffla),
|
||||
@@ -2640,6 +2785,62 @@ server <- function(input, output, session) {
|
||||
})
|
||||
})
|
||||
|
||||
#### 4pl potency table XL ----
|
||||
observe({
|
||||
#browser()
|
||||
if (is.null(Dat$EXCEL)) return(NULL)
|
||||
ro_new <- Dat$EXCEL
|
||||
|
||||
noDilSer <- Dat$noDilSeriesXL
|
||||
PureErrFl <- input$PureErr
|
||||
pottab4 <- pot4plFUNC(ro_new = ro_new, PureErrFlag = PureErrFl)
|
||||
#browser()
|
||||
Lim <- list(as.numeric(input$lEACdiffla), as.numeric(input$uEACdiffla),
|
||||
as.numeric(input$lEACratiola), as.numeric(input$uEACratiola),
|
||||
as.numeric(input$lEACratioSlope), as.numeric(input$uEACratioSlope),
|
||||
as.numeric(input$lEACratioua), as.numeric(input$uEACratioua),
|
||||
as.numeric(input$lowerPot), as.numeric(input$upperPot))
|
||||
|
||||
|
||||
pottab4_ <- data.frame(pottab4)
|
||||
pottab4_$potency <- round(as.numeric(pottab4[,2])*100,1)
|
||||
pottab4_$`lower95%CI` <- round(as.numeric(pottab4[,3])*100,2)
|
||||
pottab4_$`upper95%CI` <- round(as.numeric(pottab4[,4])*100,2)
|
||||
pottab4_$relative_lowerCL <- round(pottab4_[,6]/pottab4_[,5]*100,2)
|
||||
pottab4_$relative_upperCL <- round(pottab4_[,7]/pottab4_[,5]*100,2)
|
||||
|
||||
if (as.numeric(pottab4_$relative_lowerCL[1]) > Lim[[9]] & as.numeric(pottab4_$relative_upperCL[1]) < Lim[[10]] ) {
|
||||
test_potCI <- 0
|
||||
} else {test_potCI <- 1 }
|
||||
if (as.numeric(pottab4_$relative_lowerCL[2]) > Lim[[9]] & as.numeric(pottab4_$relative_upperCL[2]) < Lim[[10]] ) {
|
||||
test_potUCI <- 0
|
||||
} else {test_potUCI <- 1 }
|
||||
if (as.numeric(pottab4_$relative_lowerCL[3]) > Lim[[9]] & as.numeric(pottab4_$relative_upperCL[3]) < Lim[[10]] ) {
|
||||
test_potCI_t <- 0
|
||||
} else {test_potCI_t <- 1 }
|
||||
if (as.numeric(pottab4_$relative_lowerCL[4]) > Lim[[9]] & as.numeric(pottab4_$relative_upperCL[4]) < Lim[[10]] ) {
|
||||
test_potUCI_t <- 0
|
||||
} else {test_potUCI_t <- 1 }
|
||||
pottab4_ <- cbind(pottab4_[,-(2:4)], data.frame(tests=c(test_potCI, test_potUCI,test_potCI_t,test_potUCI_t)))
|
||||
colnames(pottab4_) <- c("model","potency","lower95%CI","upper95%CI","relative_lower95%CI","relative_upper95%CI","test_result")
|
||||
|
||||
output$pottab4plXL <- DT::renderDataTable({
|
||||
dat <- datatable(pottab4_[1:2,],
|
||||
options=list(digits=3,
|
||||
paging=T, dom="t",rownames=F
|
||||
)) %>% formatStyle("test_result", target="row",backgroundColor = styleEqual(c(0,1),
|
||||
c("#B5C74055","#F9545455")))
|
||||
})
|
||||
output$pottab4plTransXL <- DT::renderDataTable({
|
||||
dat <- datatable(pottab4_[3:4,],
|
||||
options=list(digits=3,
|
||||
paging=T, dom="t",rownames=F
|
||||
)) %>% formatStyle("test_result", target="row",backgroundColor = styleEqual(c(0,1),
|
||||
c("#B5C74055","#F9545455")))
|
||||
})
|
||||
})
|
||||
|
||||
|
||||
#### Dilutions Simulator ----
|
||||
output$plotfordilutions <- renderPlot({
|
||||
tab <- sim2()
|
||||
@@ -2686,7 +2887,7 @@ server <- function(input, output, session) {
|
||||
Xbend200u <- sigmoid[7] - 0.693147+1.5434/sigmoid[5]
|
||||
Xbend50 <- max(Xbend50l, Xbend50u)
|
||||
Xbend200 <- min(Xbend200l, Xbend200u)
|
||||
dummy <- plot_f(tab,sigmoid,det_sig=NULL)
|
||||
dummy <- plot_f(tab)
|
||||
} else {
|
||||
|
||||
#browser()
|
||||
@@ -2698,7 +2899,7 @@ server <- function(input, output, session) {
|
||||
Xbend200u <- det_sig[7] - 0.693147+1.5434/det_sig[1]
|
||||
Xbend50 <- max(Xbend50l, Xbend50u)
|
||||
Xbend200 <- min(Xbend200l, Xbend200u)
|
||||
dummy <- plot_f(tab,sigmoid=NULL,det_sig=det_sig)
|
||||
dummy <- plot_f(tab)
|
||||
}
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user