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

report download fixed

Browse Source
This commit is contained in:
Franz Innerbichler
2026-04-16 09:18:14 +02:00
parent 7a8cb96b2a
commit 0103b70ec2
8 changed files with 479 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
Doc_BioassayReport.Rmd
View File

@@ -31,10 +31,10 @@ date: "`r paste(params$Subway, params$Version)`"
---
\fancyfoot[C]{\thepage\ of \pageref{LastPage}}
\newpage
<!-- \fancyfoot[C]{\thepage\ of \pageref{LastPage}} -->
<!-- \newpage -->
\newpage
<!-- \newpage -->
```{r setup, include=FALSE}
@@ -93,10 +93,10 @@ plot_f <- function(dat, sigmoid,det_sig) {
CORdat <- cor(dat[,1],dat[,ncol(dat)])
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)
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)
if(is.null(det_sig)) {
if (CORdat<0) {
startlist <- list(a=sigmoid[3], b=-sigmoid[5],cs=sigmoid[7],
@@ -109,7 +109,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
startlist <- list(a=det_sig[5], b=det_sig[1],cs=det_sig[7],
d=det_sig[3],r=det_sig[7] - det_sig[8])
}
#browser()
#browser()
tryCatch({
mr <- gsl_nls(fn = readout ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
data=all_l2,
@@ -125,12 +125,12 @@ plot_f <- function(dat, sigmoid,det_sig) {
cs <- s_mr$coefficients[3,1]
d <- s_mr$coefficients[4,1]
r <- s_mr$coefficients[5,1]
log_dose <- unique(all_l$log_dose)
seq_x <- seq(min(log_dose),max(log_dose),0.1)
SAMPLE <- a+(d-a)/(1+exp(b*(seq_x-(cs-r))))
REF <- a+(d-a)/(1+exp(b*(seq_x-(cs))))
if (is.null(det_sig)) {
SAMPLEtrue <- sigmoid[4] + (sigmoid[2] -sigmoid[4])/(1+exp(sigmoid[6]*(seq_x-(sigmoid[7]-sigmoid[8]))))
REFtrue <- sigmoid[3] + (sigmoid[1] -sigmoid[3])/(1+exp(sigmoid[5]*(seq_x-(sigmoid[7]))))
@@ -138,19 +138,19 @@ plot_f <- function(dat, sigmoid,det_sig) {
SAMPLEtrue <- det_sig[4] + (det_sig[6] -det_sig[4])/(1+exp(-det_sig[2]*(seq_x-(det_sig[8]))))
REFtrue <- det_sig[3] + (det_sig[5] -det_sig[3])/(1+exp(-det_sig[1]*(seq_x-(det_sig[7]))))
}
pl_df <- cbind(seq_x, SAMPLE, REF, SAMPLEtrue, REFtrue)
all_l2$readout[all_l2$readout < 0] <- 0.01
all_l2$readouttrans <- log(all_l2$readout)
slopeEC50 <- b*(a-d)/4
Xbendl3 <- cs-(1.31696/b)
Xbendu3 <- cs+(1.31696/b)
XbendlT <- cs-r-(1.31696/b)
XbenduT <- cs-r+(1.31696/b)
bendpoints <- c(bendREF_lower = round(Xbendl3,3), bendREF_upper=round(Xbendu3,3),
bendSAMPLE_lower = round(XbendlT,3), bendSAMPLE_upper=round(XbenduT,3))
p <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
geom_point(shape=factor(isRef), alpha=0.8) +
labs(title = paste("restricted 4pl; bendp:", round(Xbendl3,3),round(Xbendu3,3),round(XbendlT,3),round(XbenduT,3)),
@@ -159,7 +159,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
scale_shape_manual(labels=c("test","reference")) +
theme_bw() +
theme(axis.text = element_text(size=14))
p2 <- p + geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=SAMPLE), color="red",
inherit.aes = F) +
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REF), color="blue",
@@ -172,15 +172,15 @@ plot_f <- function(dat, sigmoid,det_sig) {
geom_vline(xintercept=c(XbendlT, XbenduT), col="red",linetype=2) +
annotate("text", x=cs, y=a+(d-a)/2, label="0", size=5) +
theme(legend.position="none")
# transformed plots
p_rt <- ggplot(all_l2, aes(x=log_dose, y=readouttrans, color=factor(isRef))) +
geom_point(shape=factor(isRef), alpha=0.8) +
labs(title = paste("restricted transformed 4pl"), color="product") +
scale_color_manual(labels=c("test","reference"), values=c("red","blue")) +
theme_bw()
mrt <- gsl_nls(fn = readouttrans ~ a+(d-a)/(1+exp(b*(log_dose-(cs-r*isSample)))),
data=all_l2,
start=startlist,
@@ -191,17 +191,17 @@ plot_f <- function(dat, sigmoid,det_sig) {
cs_trans <- s_mrt$coefficients[3,1]
d_trans <- s_mrt$coefficients[4,1]
r_trans <- s_mrt$coefficients[5,1]
XbendlTrans <- cs_trans-(1.31696/b_trans)
XbenduTrans <- cs_trans+(1.31696/b_trans)
XbendlTransT <- cs_trans-r_trans-(1.31696/b_trans)
XbenduTransT <- cs_trans-r_trans+(1.31696/b_trans)
bendpointsTRANS <- c(bendREF_lower = round(XbendlTrans,3), bendREF_upper=round(XbenduTrans,3),
bendSAMPLE_lower = round(XbendlTransT,3), bendSAMPLE_upper=round(XbenduTransT,3))
SAMPLEtrans <- a_trans+(d_trans-a_trans)/(1+exp(b_trans*(seq_x-(cs_trans-r_trans))))
REFtrans <- a_trans+(d_trans-a_trans)/(1+exp(b_trans*(seq_x-(cs_trans))))
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="red",
inherit.aes = F) +
@@ -236,7 +236,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
REFu <- ast + (dst-ast)/(1+exp(bst*(seq_x-cst)))
SAMPLEu <- ate + (dte-ate)/(1+exp(bte*(seq_x-cte)))
pl_df2 <- cbind(seq_x, SAMPLEu, REFu)
#browser()
#browser()
pu <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
geom_point() +
labs(title="unrestricted 4_pl-Model", color="product") +
@@ -246,7 +246,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
color="red", inherit.aes = F) +
geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=REFu),
color="blue", inherit.aes = F,
show.legend = F)
show.legend = F)
pu2_ <- pu2 +
theme(legend.position = "none", axis.text = element_text(size=14))
putrans <- ggplot(all_l2, aes(x=log_dose, y=readouttrans, color=factor(isRef))) +
@@ -254,7 +254,7 @@ plot_f <- function(dat, sigmoid,det_sig) {
labs(title="unrestricted transformed 4_pl-Model", color="product") +
scale_color_manual(labels = c("test","reference"), values=c("red","blue")) +
theme_bw()
unrestr_trans <- drm(readouttrans ~ exp(log_dose), isSample, data=all_l2, fct=LL.4(),
pmodels=data.frame(isSample, isSample,isSample,isSample))
Sum_ut <- summary(unrestr_trans)
@@ -266,16 +266,16 @@ plot_f <- function(dat, sigmoid,det_sig) {
cte_t <- log(Sum_ut$coefficients[8,1])
dst_t <- Sum_ut$coefficients[5,1]
dte_t <- Sum_ut$coefficients[6,1]
REFu_trans <- ast_t + (dst_t-ast_t)/(1+exp(bst_t*(seq_x-cst_t)))
SAMPLEu_trans <- ate_t + (dte_t-ate_t)/(1+exp(bte_t*(seq_x-cte_t)))
pl_df2u_t <- cbind(seq_x, SAMPLEu_trans, REFu_trans)
pu2_t <- putrans + geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=SAMPLEu_trans),
color="red", inherit.aes = F) +
geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=REFu_trans),
color="blue", inherit.aes = F,
show.legend = F)
show.legend = F)
pu3_t <- pu2_t
grid.arrange(p2,p_rt2,pu2_,pu3_t, nrow=2)
}
@@ -306,26 +306,26 @@ kable(testsTab[1:7,], row.names = F, format = "markdown", caption="SST results")
*...The estimate for F-test on regression and on non-linearity is the p-value
F-test on regression passes if F-value > F-crit and thus p < 0.05
F-test on non-linearity passes if F-value < F-crit and thus p > 0.05
Test results outcome:
Test results outcome:
0 ... test passed (for EQ tests: CI within limits);
1 ... test failed (for EQ tests CI not within limits);
-1 ... calculations unbound/denominator too close to 0
```{r, label= 'CIplot', echo=FALSE, warning=FALSE, fig.width=100, fig.cap='Selected SSt confidence intervals with entered limits', fig.align='center'}
<!-- ```{r, label= 'CIplot', echo=FALSE, warning=FALSE, fig.width=100, fig.cap='Selected SSt confidence intervals with entered limits', fig.align='center'} -->
png("CIplot.png")
print(CIplot)
dev.off()
<!-- png("CIplot.png") -->
<!-- print(CIplot) -->
<!-- dev.off() -->
```
<!-- ``` -->
![](CIplot.png){width=60%}
<!-- ![](CIplot.png){width=60%} -->
## Fitting results of the 4 models with bend points