Guxa/wizard
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

updated code, test files added

Browse Source
This commit is contained in:
Franz Innerbichler
2026-05-01 11:37:59 +02:00
parent 0103b70ec2
commit b2aeed525e
9 changed files with 18 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Doc_BioassayReport.Rmd
-1
View File
@@ -365,7 +365,6 @@ The results of the non-linear fitting procedure for the unrestricted model (8 pa
kable(UnRPLAausw, format = "markdown", caption= "UNrestricted 4PL evaluation", digits=3, row.names = F) kable(UnRPLAausw, format = "markdown", caption= "UNrestricted 4PL evaluation", digits=3, row.names = F)
``` ```
TestInhibitor.numbers
BIN
View File
Binary file not shown.
TestInhibitor.xlsx
BIN
View File
Binary file not shown.
Tests3Plates.xlsx
BIN
View File
Binary file not shown.
Testsdfac0.2b1.xlsx
BIN
View File
Binary file not shown.
Testsdfac0.2b_3.xlsx
BIN
View File
Binary file not shown.
Testsdfac0.2b_3Dil12.xlsx
BIN
View File
Binary file not shown.
server.R
+14 -13
View File
@@ -448,10 +448,10 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
"F-test on R^2 A","F_test on R^2 B", "F-test on R^2 A","F_test on R^2 B",
"F-test on slope A","F-test on slope B", "F-test on slope A","F-test on slope B",
"F-test on non-parallelism","F-test on preparation"), "F-test on non-parallelism","F-test on preparation"),
test_results = c(ifelse(p_F_regr<0.05,0,1),ifelse(p_F_nonlin<0.05,0,1), test_results = c(ifelse(p_F_regr<0.05,0,1),ifelse(p_F_nonlin<0.05,1,0),
ifelse(pFR2_A<0.05,0,1),ifelse(pFR2_B<0.05,0,1), ifelse(pFR2_A<0.05,1,0),ifelse(pFR2_B<0.05,1,0),
ifelse(p_F_slope_A<0.05,0,1),ifelse(p_F_slope_B<0.05,0,1), ifelse(p_F_slope_A<0.05,0,1),ifelse(p_F_slope_B<0.05,0,1),
ifelse(p_F_nonp<0.05,0,1),ifelse(p_F_prep<0.05,0,1)), ifelse(p_F_nonp<0.05,1,0),ifelse(p_F_prep<0.05,0,1)),
estimate = c(p_F_regr, p_F_nonlin,pFR2_A,pFR2_B,p_F_slope_A, estimate = c(p_F_regr, p_F_nonlin,pFR2_A,pFR2_B,p_F_slope_A,
p_F_slope_B,p_F_nonp,p_F_prep), p_F_slope_B,p_F_nonp,p_F_prep),
Source = c("Treatment","Preparation","Regression","Non-parallelism", Source = c("Treatment","Preparation","Regression","Non-parallelism",
@@ -571,7 +571,7 @@ pot4plFUNC <- function(ro_new, PureErrFlag) {
potU_est_log <- exp(confintd(mu_log, "r", method="asymptotic")) potU_est_log <- exp(confintd(mu_log, "r", method="asymptotic"))
colnames(pot_est_log) <- c("estimate","lowerCI2","upperCI") colnames(pot_est_log) <- c("estimate","lowerCI2","upperCI")
colnames(potU_est_log) <- c("estimate","lowerCI2","upperCI") colnames(potU_est_log) <- c("estimate","lowerCI2","upperCI")
#browser()
su_mr_log <- summary(mr_log) su_mr_log <- summary(mr_log)
Dat$RMSE_Rlog <- su_mr_log$sigma Dat$RMSE_Rlog <- su_mr_log$sigma
su_mu_log <- summary(mu_log) su_mu_log <- summary(mu_log)
@@ -800,7 +800,7 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
test_lowA <- test_d; test_uppA <- test_a test_lowA <- test_d; test_uppA <- test_a
#browser() #browser()
res_tab <- data.frame(test= c("F-test on sign. of regression*", res_tab <- data.frame(test= c("F-test on sign. of regression*",
"EQ test on significance of lower asymptotes", "EQ test on lower asymptotes difference",
"EQ test ratio of lower asymptotes", "EQ test ratio of lower asymptotes",
"EQ test ratio of Hill slopes", "EQ test ratio of Hill slopes",
"EQ test ratio of upper asymptotes", "EQ test ratio of upper asymptotes",
@@ -834,7 +834,7 @@ ANOVA4plUnresfunc <- function(ro_new, sigmoid) {
all_l$Conc <- exp(all_l$log_dose) all_l$Conc <- exp(all_l$log_dose)
all_l$readout[all_l$readout < 0] <- 0.01 all_l$readout[all_l$readout < 0] <- 0.01
pot <- drm(readout ~ Conc, isSample, data=all_l2, fct=LL.4(names=c("b","d","a","c")), pot <- drm(readout ~ Conc, isSample, data=all_l, fct=LL.4(names=c("b","d","a","c")),
pmodels=data.frame(1,1,1,isSample)) pmodels=data.frame(1,1,1,isSample))
potU <- drm(readout ~ Conc, isSample, data=all_l, fct=LL.4(names=c("b","d","a","c")), potU <- drm(readout ~ Conc, isSample, data=all_l, fct=LL.4(names=c("b","d","a","c")),
pmodels=data.frame(isSample, isSample,isSample,isSample)) pmodels=data.frame(isSample, isSample,isSample,isSample))
@@ -962,7 +962,7 @@ function(input,output, session) {
#browser() #browser()
cnSheets <- Dat$sheets cnSheets <- Dat$sheets
cnSheets2 <- c("please choose", cnSheets) cnSheets2 <- c("please choose", cnSheets)
selectInput(inputId = "sheet", label="Select a sheet:",choices = cnSheets2) selectInput(inputId = "sheet", label="Select a sheet:",choices = cnSheets)
} }
}) })
observeEvent(input$sign_out, { observeEvent(input$sign_out, {
@@ -976,7 +976,7 @@ function(input,output, session) {
if (!is.null(input$iFile)) { if (!is.null(input$iFile)) {
if (!is.null(input$sheet)) { if (!is.null(input$sheet)) {
if (input$sheet != "please choose") { if (input$sheet != "please choose") {
#browser()
XLdat <- Dat$wb[input$sheet][[1]] XLdat <- Dat$wb[input$sheet][[1]]
if (is.null(XLdat)) XLdat <- Dat$wb[Dat$sheets[1]][[1]] if (is.null(XLdat)) XLdat <- Dat$wb[Dat$sheets[1]][[1]]
@@ -1095,7 +1095,7 @@ function(input,output, session) {
observe({ observe({
pot_est3 <- data.frame(pot_est*100) pot_est3 <- data.frame(pot_est*100)
MaxPl <- max(input$upperPot, pot_est3$upperCI) MaxPl <- max(input$upperPot, pot_est3$upperCI)
MinPl <- max(input$lowerPot, pot_est3$lowerCI) MinPl <- min(input$lowerPot, pot_est3$lowerCI)
MaxPl_ <- MaxPl*1.1 MaxPl_ <- MaxPl*1.1
MinPl_ <- MinPl*0.9 MinPl_ <- MinPl*0.9
@@ -1787,12 +1787,13 @@ function(input,output, session) {
#### output 4PL ANOVA tests --- #### output 4PL ANOVA tests ---
output$ANOVA <- DT::renderDataTable({ output$ANOVA <- DT::renderDataTable({
sigmoid <- sigmoid() sigmoid <- sigmoid()
tab <- ANOVA4plUnresfunc(sim2(),sigmid) tab <- ANOVA4plUnresfunc(sim2(),sigmoid)
dat <- datatable(df[,1:3], #browser()
dat <- datatable(tab,
options=list( options=list(
dom="t",rownames=F dom="t",rownames=F
)) %>% formatStyle("p.value", target="row", )) %>% formatStyle("p_value", target="row",
backgroundColor = styleEqual(c("p.value"), backgroundColor = styleEqual(c("p_value"),
c("lightgrey"))) c("lightgrey")))
}) })
ui.R
+4 -4
View File
@@ -236,9 +236,9 @@ function(req) {
sliderInput("sdfac","Variability as % of lower to upper asymptote", max=10, value=3, min=0.1, step=0.1), sliderInput("sdfac","Variability as % of lower to upper asymptote", max=10, value=3, min=0.1, step=0.1),
checkboxInput("heterosked","heteroskedastic noise", FALSE), checkboxInput("heterosked","heteroskedastic noise", FALSE),
sliderInput("potencydiff","potency of test (%)", max=200, min=50, value=100, step=1), sliderInput("potencydiff","potency of test (%)", max=200, min=50, value=100, step=1),
sliderInput("outlL","outlier in lower asymptote", min=0, max=1.5, value=0, step=1), sliderInput("outlL","outlier in lower asymptote", min=0, max=1.5, value=0, step=0.1),
sliderInput("outlM","outlier in mid part", min=0, max=1.5,value=0, step=1), sliderInput("outlM","outlier in mid part", min=0, max=1.5,value=0, step=0.1),
sliderInput("outlU","outlier in upper asymptote", min=0, max=1.5,value=0, step=1) sliderInput("outlU","outlier in upper asymptote", min=0, max=1.5,value=0, step=0.1)
), ),
column(1, column(1,
tags$table(id="dose-table", tags$table(id="dose-table",
@@ -258,7 +258,7 @@ function(req) {
)), )),
column(4, column(4,
"4 PL ANOVA unrestricted", "4 PL ANOVA unrestricted",
DT::renderDataTable("ANOVA"), DT::dataTableOutput("ANOVA"),
h5("Please note that for the CIs of rel. potency the RSS of the restricted model is used"), h5("Please note that for the CIs of rel. potency the RSS of the restricted model is used"),
h5("RSS ... 'Residual error' in the SumSquares column"), h5("RSS ... 'Residual error' in the SumSquares column"),
h5("MSE ... 'Residual error' in the MSs column"), h5("MSE ... 'Residual error' in the MSs column"),