Guxa/dashboard-app
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cleanup and bugfix; linearity report made work

Browse Source
This commit is contained in:
Franz Innerbichler
2026-05-15 22:11:20 +02:00
parent 9422490f25
commit ec13d95387
4 changed files with 249 additions and 379 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Global.R
+12 -7
View File
@@ -2,6 +2,7 @@
Dat <- reactiveValues()
REP <- reactiveValues()
REPlin <- reactiveValues()
#' Levenberg Marquard fit of 4 pl
#'
@@ -188,11 +189,13 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
#browser()
p <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
geom_point(shape=factor(isRef), size=3,alpha=0.8) +
labs(title = paste("restricted 4pl"),
labs(title = paste("restricted 4pl model"),
color="product") +
scale_color_manual(labels=c("test","reference"), values=c("#C2173F","#4545BA")) +
scale_shape_manual(labels=c("test","reference")) +
theme_bw() +
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
#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="#C2173F",
@@ -205,8 +208,8 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
inherit.aes = F) +
geom_vline(xintercept=c(Xbendl3, Xbendu3), col="#4545BA",linetype=2) +
geom_vline(xintercept=c(XbendlT, XbenduT), col="#C2173F",linetype=2) +
geom_vline(xintercept=c( XasymplS, XasympuS), col="#4545BA55",linetype=2) +
geom_vline(xintercept=c(XasymplT, XasympuT), col="#C2173F55",linetype=2) +
geom_vline(xintercept=c( XasymplS, XasympuS), col="#4545BABB",linetype=3) +
geom_vline(xintercept=c(XasymplT, XasympuT), col="#C2173FBB",linetype=3) +
annotate("text", x=cs, y=a+(d-a)/2, label="0", size=5) +
geom_abline(slope = slopeEC50, intercept = Intercept) +
theme(legend.position="none")
@@ -274,7 +277,7 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
#browser()
pu <- ggplot(all_l2, aes(x=log_dose, y=readout, color=factor(isRef))) +
geom_point(size=3) +
labs(title="unrestricted 4_pl-Model", color="product") +
labs(title="unrestricted 4pl model", color="product") +
scale_color_manual(labels = c("test","reference"), values=c("#C2173F88","#4545BA88")) +
theme_bw()
pu2 <- pu + geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=SAMPLEu),
@@ -687,6 +690,8 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
#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)) +
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme_bw()
p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="#4545BA",
inherit.aes = F) +
@@ -699,7 +704,7 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
labs(title = paste("unrestricted PLA model"), subtitle = paste("Regression starts for reference sample:",indS, "for test sample:",indT)) +
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) +
size=5,alpha=0.2), col=c("black"), inherit.aes = FALSE) +
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
# fit intercept for test and ref and common slope
@@ -720,7 +725,7 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
subtitle = paste("Regression on highlighted points")) +
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), col=c("#1FE8B2"), stroke=2, inherit.aes = FALSE) +
size=5, alpha=0.2), col=c("black"), inherit.aes = FALSE) +
scale_shape_manual(labels=c("test","reference"), values=c(21,21))
return(grid.arrange(p3,pr3,nrow=1))
}