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
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 slope A","F-test on slope B",
"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),
ifelse(pFR2_A<0.05,0,1),ifelse(pFR2_B<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,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_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,
p_F_slope_B,p_F_nonp,p_F_prep),
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"))
colnames(pot_est_log) <- c("estimate","lowerCI2","upperCI")
colnames(potU_est_log) <- c("estimate","lowerCI2","upperCI")
#browser()
su_mr_log <- summary(mr_log)
Dat$RMSE_Rlog <- su_mr_log$sigma
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
#browser()
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 Hill slopes",
"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$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))
potU <- drm(readout ~ Conc, isSample, data=all_l, fct=LL.4(names=c("b","d","a","c")),
pmodels=data.frame(isSample, isSample,isSample,isSample))
@@ -962,7 +962,7 @@ function(input,output, session) {
#browser()
cnSheets <- Dat$sheets
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, {
@@ -976,7 +976,7 @@ function(input,output, session) {
if (!is.null(input$iFile)) {
if (!is.null(input$sheet)) {
if (input$sheet != "please choose") {
#browser()
XLdat <- Dat$wb[input$sheet][[1]]
if (is.null(XLdat)) XLdat <- Dat$wb[Dat$sheets[1]][[1]]
@@ -1095,7 +1095,7 @@ function(input,output, session) {
observe({
pot_est3 <- data.frame(pot_est*100)
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
MinPl_ <- MinPl*0.9
@@ -1787,12 +1787,13 @@ function(input,output, session) {
#### output 4PL ANOVA tests ---
output$ANOVA <- DT::renderDataTable({
sigmoid <- sigmoid()
tab <- ANOVA4plUnresfunc(sim2(),sigmid)
dat <- datatable(df[,1:3],
tab <- ANOVA4plUnresfunc(sim2(),sigmoid)
#browser()
dat <- datatable(tab,
options=list(
dom="t",rownames=F
)) %>% formatStyle("p.value", target="row",
backgroundColor = styleEqual(c("p.value"),
)) %>% formatStyle("p_value", target="row",
backgroundColor = styleEqual(c("p_value"),
c("lightgrey")))
})