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

formatted Global.R

Browse Source
This commit is contained in:
Simon Innerbichler
2026-05-19 11:21:39 +02:00
parent a69a7db1b7
commit 1b3af203a2
1 changed files with 1015 additions and 825 deletions
Download Patch File Download Diff File Expand all files Collapse all files
R/Global.R
+395 -205
View File
@@ -14,16 +14,16 @@
#' potency estimates and respective CIs of restricted and unrestricted models, and the predictions thereof. #' potency estimates and respective CIs of restricted and unrestricted models, and the predictions thereof.
#' @export #' @export
#' @examples #' @examples
#' dat <- data.frame(REF1=c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2=c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497), #' dat <- data.frame(
#' REF1 = c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2 = c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497),
#' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665), #' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665),
#' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591), #' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591),
#' TEST3=c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose=c(5.01,3.401,2.708,2.015,1.32176,0.62861,-0.0645385,-1.6739764)) #' TEST3 = c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose = c(5.01, 3.401, 2.708, 2.015, 1.32176, 0.62861, -0.0645385, -1.6739764)
#' )
#' TransF <- FALSE #' TransF <- FALSE
#' Dat <- list() #' Dat <- list()
#' te <- Fitting_FUNC(dat, TransF) #' te <- Fitting_FUNC(dat, TransF)
#' print(te) #' print(te)
Fitting_FUNC <- function(ro_new, TransFlag = F) { Fitting_FUNC <- function(ro_new, TransFlag = F) {
CORro <- cor(ro_new[, 1], ro_new[, ncol(ro_new)]) CORro <- cor(ro_new[, 1], ro_new[, ncol(ro_new)])
# browser() # browser()
@@ -36,64 +36,99 @@ Fitting_FUNC <- function(ro_new, TransFlag=F) {
if (!TransFlag) { if (!TransFlag) {
startlist <- list(a = min(ro_new[, 2]), b = SLOPE, d = max(ro_new[, 2]), cs = mean(all_l$log_dose), r = 0) startlist <- list(a = min(ro_new[, 2]), b = SLOPE, d = max(ro_new[, 2]), cs = mean(all_l$log_dose), r = 0)
mr <- tryCatch({gsl_nls(fn = readout ~ a+(d-a)/(1+exp(b*((cs-r*isSample)-log_dose))), mr <- tryCatch(
{
gsl_nls(
fn = readout ~ a + (d - a) / (1 + exp(b * ((cs - r * isSample) - log_dose))),
data = all_l2, data = all_l2,
start = startlist, # race=T, start = startlist, # race=T,
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6)) control = gsl_nls_control(xtol = 1e-6, ftol = 1e-6, gtol = 1e-6)
)
}, },
warning = function(e) { warning = function(e) {
mr <<- "In nlsModel singular gradient matrix" mr <<- "In nlsModel singular gradient matrix"
}) }
)
# Stop if singular gradient matrix # Stop if singular gradient matrix
if (is.character(mr)) return(mr) if (is.character(mr)) {
return(mr)
}
s_mr <- tryCatch({ s_mr <- tryCatch(
{
s_mr <- summary(mr) s_mr <- summary(mr)
}, },
error = function(err) { error = function(err) {
s_mr <- NULL s_mr <- NULL
}) }
)
} else { } else {
startlist <- list(a = log(min(ro_new[, 2])), b = SLOPE, d = log(max(ro_new[, 2])), cs = mean(all_l$log_dose), r = 0) startlist <- list(a = log(min(ro_new[, 2])), b = SLOPE, d = log(max(ro_new[, 2])), cs = mean(all_l$log_dose), r = 0)
mrT <- gsl_nls(fn = log(readout) ~ a+(d-a)/(1+exp(b*((cs-r*isSample)-log_dose))), mrT <- gsl_nls(
fn = log(readout) ~ a + (d - a) / (1 + exp(b * ((cs - r * isSample) - log_dose))),
data = all_l2, data = all_l2,
start = startlist, start = startlist,
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6)) control = gsl_nls_control(xtol = 1e-6, ftol = 1e-6, gtol = 1e-6)
)
s_mr <- summary(mrT) s_mr <- summary(mrT)
} }
if (!TransFlag) { if (!TransFlag) {
startlistmu <- list(as=min(ro_new[,2]), bs=SLOPE, ds=max(ro_new[,2]), cs=mean(all_l$log_dose), startlistmu <- list(
at=min(ro_new[,2]), bt=SLOPE, dt=max(ro_new[,2]), r=0) as = min(ro_new[, 2]), bs = SLOPE, ds = max(ro_new[, 2]), cs = mean(all_l$log_dose),
tryCatch({ at = min(ro_new[, 2]), bt = SLOPE, dt = max(ro_new[, 2]), r = 0
mu <- gsl_nls(fn = readout ~ as*isRef + at*isSample + (ds*isRef + dt*isSample - as*isRef - at*isSample)/ )
tryCatch(
{
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))), (1 + isRef * exp(bs * (cs - log_dose)) + isSample * exp(bt * (cs - r * isSample - log_dose))),
data = all_l, data = all_l,
start = startlistmu, start = startlistmu,
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6)) control = gsl_nls_control(xtol = 1e-6, ftol = 1e-6, gtol = 1e-6)
)
}, },
error = function(msg) { error = function(msg) {
return(0) }) return(0)
}
)
Sum_u <- tryCatch({ summary(mu) }, Sum_u <- tryCatch(
{
summary(mu)
},
error = function(msg) { error = function(msg) {
return(0) }) return(0)
}
)
} else { } else {
startlistmu <- list(as=log(min(ro_new[,2])), bs=SLOPE, ds=log(max(ro_new[,2])), cs=mean(all_l$log_dose), startlistmu <- list(
at=log(min(ro_new[,2])), bt=SLOPE, dt=log(max(ro_new[,2])), r=0) as = log(min(ro_new[, 2])), bs = SLOPE, ds = log(max(ro_new[, 2])), cs = mean(all_l$log_dose),
tryCatch({ at = log(min(ro_new[, 2])), bt = SLOPE, dt = log(max(ro_new[, 2])), r = 0
muT <- gsl_nls(fn = log(readout) ~ as*isRef + at*isSample + (ds*isRef + dt*isSample - as*isRef - at*isSample)/ )
tryCatch(
{
muT <- gsl_nls(
fn = log(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))), (1 + isRef * exp(bs * (cs - log_dose)) + isSample * exp(bt * (cs - r * isSample - log_dose))),
data = all_l, data = all_l,
start = startlistmu, start = startlistmu,
control=gsl_nls_control(xtol=1e-6,ftol=1e-6, gtol=1e-6)) control = gsl_nls_control(xtol = 1e-6, ftol = 1e-6, gtol = 1e-6)
)
}, },
error = function(msg) { error = function(msg) {
return(0) }) return(0)
}
)
Sum_u <- tryCatch({ summary(muT) }, Sum_u <- tryCatch(
{
summary(muT)
},
error = function(msg) { error = function(msg) {
return(0) }) return(0)
}
)
} }
if (!TransFlag) { if (!TransFlag) {
pot_est <- exp(confintd(mr, "r", method = "asymptotic")) pot_est <- exp(confintd(mr, "r", method = "asymptotic"))
@@ -119,25 +154,40 @@ Fitting_FUNC <- function(ro_new, TransFlag=F) {
#' @returns A grid object with 2 linearity plots, restricted and unrestricted model. #' @returns A grid object with 2 linearity plots, restricted and unrestricted model.
#' @export #' @export
#' @examples #' @examples
#' data.frame(R_dil1 = c(10.0651024695491, 10.9844983291817, 10.7635586089293, 10.4597656321327, 10.3898668457823, 10.8171761349909, #' data.frame(
#' 10.319758021908, 10.1304854046653), #' R_dil1 = c(
#' R_dil2 = c(10.9649145494504, 10.0202868589385, 10.8424145955735, 10.9311360356894, 10.3284659026404, #' 10.0651024695491, 10.9844983291817, 10.7635586089293, 10.4597656321327, 10.3898668457823, 10.8171761349909,
#' 10.6890147558796, 10.3014450252305, 10.9594838595181), #' 10.319758021908, 10.1304854046653
#' R_dil3 = c(10.4630510824383, 10.4566715089363, 10.2350765290036, 10.3300581874798, 10.9648088137065, #' ),
#' 10.286893755805, 10.4856643841389, 10.5275521552307), #' R_dil2 = c(
#' T_dil1 = c(12.732175566336, 12.7756403995095, 12.1672539684741, 12.7060603907892, 12.8000685682832, #' 10.9649145494504, 10.0202868589385, 10.8424145955735, 10.9311360356894, 10.3284659026404,
#' 12.8800092157515, 12.7160581291873, 12.6996878912416), #' 10.6890147558796, 10.3014450252305, 10.9594838595181
#' T_dil2 = c(12.3923194313831, 12.0943488144175, 12.7955302154828, 12.4825917078735, 12.6856540203788, #' ),
#' 12.7348548498556, 12.9222470610476, 12.1186618671252), #' R_dil3 = c(
#' T_dil3 = c(12.7899182255274, 12.9722600411128, 12.7078445380891, 12.4913523531941, 12.1718281909609, #' 10.4630510824383, 10.4566715089363, 10.2350765290036, 10.3300581874798, 10.9648088137065,
#' 12.5313873615133, 12.952802332772, 12.5960321394342), #' 10.286893755805, 10.4856643841389, 10.5275521552307
#' log_dose = c(0, -1.09861228866811, -2.19722457733622, -3.29583686600433, -4.39444915467244, #' ),
#' -5.49306144334055, -6.59167373200866, -7.69028602067677)) #' T_dil1 = c(
#' 12.732175566336, 12.7756403995095, 12.1672539684741, 12.7060603907892, 12.8000685682832,
#' 12.8800092157515, 12.7160581291873, 12.6996878912416
#' ),
#' T_dil2 = c(
#' 12.3923194313831, 12.0943488144175, 12.7955302154828, 12.4825917078735, 12.6856540203788,
#' 12.7348548498556, 12.9222470610476, 12.1186618671252
#' ),
#' T_dil3 = c(
#' 12.7899182255274, 12.9722600411128, 12.7078445380891, 12.4913523531941, 12.1718281909609,
#' 12.5313873615133, 12.952802332772, 12.5960321394342
#' ),
#' log_dose = c(
#' 0, -1.09861228866811, -2.19722457733622, -3.29583686600433, -4.39444915467244,
#' -5.49306144334055, -6.59167373200866, -7.69028602067677
#' )
#' )
#' #'
#' #'
#' p <- plotSingularity(dat) #' p <- plotSingularity(dat)
#' print(p) #' print(p)
#'
plotSingularity <- function(dat) { # sigmoid,det_sig, plotSingularity <- function(dat) { # sigmoid,det_sig,
CORdat <- cor(dat[, 1], dat[, ncol(dat)]) CORdat <- cor(dat[, 1], dat[, ncol(dat)])
# browser() # browser()
@@ -158,8 +208,10 @@ plotSingularity <- function(dat) { #sigmoid,det_sig,
# browser() # browser()
pSing <- ggplot(all_l2, aes(x = log_dose, y = readout, color = factor(isRef))) + pSing <- ggplot(all_l2, aes(x = log_dose, y = readout, color = factor(isRef))) +
geom_point(shape = factor(isRef), size = 3, alpha = 0.8) + geom_point(shape = factor(isRef), size = 3, alpha = 0.8) +
labs(title = paste("No 4pl fit possible"), labs(
color="product") + title = paste("No 4pl fit possible"),
color = "product"
) +
scale_color_manual(labels = c("test", "reference"), values = c("#C2173F", "#4545BA")) + scale_color_manual(labels = c("test", "reference"), values = c("#C2173F", "#4545BA")) +
scale_shape_manual(labels = c("test", "reference")) + scale_shape_manual(labels = c("test", "reference")) +
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) + scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
@@ -171,8 +223,6 @@ plotSingularity <- function(dat) { #sigmoid,det_sig,
} }
#' Plot sigmoidal curve #' Plot sigmoidal curve
#' #'
#' Returns the final plots of the 4pl function as sigmoidal lines, and the single readouts as scatter, with REF in blue and TEST in red. #' Returns the final plots of the 4pl function as sigmoidal lines, and the single readouts as scatter, with REF in blue and TEST in red.
@@ -185,18 +235,18 @@ plotSingularity <- function(dat) { #sigmoid,det_sig,
#' @returns A grid object either of the original scale or the natural log of the readouts. #' @returns A grid object either of the original scale or the natural log of the readouts.
#' @export #' @export
#' @examples #' @examples
#' dat <- data.frame(REF1=c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2=c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497), #' dat <- data.frame(
#' REF1 = c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2 = c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497),
#' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665), #' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665),
#' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591), #' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591),
#' TEST3=c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose=c(5.01,3.401,2.708,2.015,1.32176,0.62861,-0.0645385,-1.6739764)) #' TEST3 = c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose = c(5.01, 3.401, 2.708, 2.015, 1.32176, 0.62861, -0.0645385, -1.6739764)
#' )
#' sigmoid <- c(0.7163324, 0.5636804, 10.6156340, 9.9784160, -0.7504673, -0.7108692, -3.5788141, -0.6662962) #' sigmoid <- c(0.7163324, 0.5636804, 10.6156340, 9.9784160, -0.7504673, -0.7108692, -3.5788141, -0.6662962)
#' det_sig <- FALSE #' det_sig <- FALSE
#' TransF <- FALSE #' TransF <- FALSE
#' Dat <- list() #' Dat <- list()
#' p <- plot_f(dat, sigmoid, det_sig, TransF) #' p <- plot_f(dat, sigmoid, det_sig, TransF)
#' print(p) #' print(p)
plot_f <- function(dat, TransFlag = F) { # sigmoid,det_sig, plot_f <- function(dat, TransFlag = F) { # sigmoid,det_sig,
CORdat <- cor(dat[, 1], dat[, ncol(dat)]) CORdat <- cor(dat[, 1], dat[, ncol(dat)])
# browser() # browser()
@@ -249,17 +299,21 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
XasympuS <- cs + (3 / b) XasympuS <- cs + (3 / b)
XasymplT <- cs - r - (3 / b) XasymplT <- cs - r - (3 / b)
XasympuT <- cs - r + (3 / b) XasympuT <- cs - r + (3 / b)
bendpoints <- c(bendREF_lower = round(Xbendl3,3), bendREF_upper=round(Xbendu3,3), bendpoints <- c(
bendREF_lower = round(Xbendl3, 3), bendREF_upper = round(Xbendu3, 3),
bendSAMPLE_lower = round(XbendlT, 3), bendSAMPLE_upper = round(XbenduT, 3), bendSAMPLE_lower = round(XbendlT, 3), bendSAMPLE_upper = round(XbenduT, 3),
asympREF_lower = round(XasymplS, 3), asympREF_upper = round(XasympuS, 3), asympREF_lower = round(XasymplS, 3), asympREF_upper = round(XasympuS, 3),
asympSAMPLE_lower = round(XasymplT,3), asympSAMPLE_upper=round(XasympuT,3)) asympSAMPLE_lower = round(XasymplT, 3), asympSAMPLE_upper = round(XasympuT, 3)
)
Dat$bendpoints <- bendpoints Dat$bendpoints <- bendpoints
Dat$cfordils <- cs Dat$cfordils <- cs
# browser() # browser()
p <- ggplot(all_l2, aes(x = log_dose, y = readout, color = factor(isRef))) + p <- ggplot(all_l2, aes(x = log_dose, y = readout, color = factor(isRef))) +
geom_point(shape = factor(isRef), size = 3, alpha = 0.8) + geom_point(shape = factor(isRef), size = 3, alpha = 0.8) +
labs(title = paste("restricted 4pl model"), labs(
color="product") + title = paste("restricted 4pl model"),
color = "product"
) +
scale_color_manual(labels = c("test", "reference"), values = c("#C2173F", "#4545BA")) + scale_color_manual(labels = c("test", "reference"), values = c("#C2173F", "#4545BA")) +
scale_shape_manual(labels = c("test", "reference")) + scale_shape_manual(labels = c("test", "reference")) +
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) + scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
@@ -267,14 +321,22 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
# theme_bw() + # theme_bw() +
theme(axis.text = element_text(size = 14)) 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", p2 <- p + geom_line(
inherit.aes = F) + data = as.data.frame(pl_df), aes(x = seq_x, y = SAMPLE), color = "#C2173F",
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REF), color="#4545BA", inherit.aes = F
inherit.aes = F) + ) +
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=SAMPLEtrue), color="#C2173F", linetype=2, alpha=0.4, geom_line(
inherit.aes = F) + data = as.data.frame(pl_df), aes(x = seq_x, y = REF), color = "#4545BA",
geom_line(data=as.data.frame(pl_df), aes(x=seq_x, y=REFtrue), color="#4545BA", linetype=2, alpha=0.4, inherit.aes = F
inherit.aes = F) + ) +
geom_line(
data = as.data.frame(pl_df), aes(x = seq_x, y = SAMPLEtrue), color = "#C2173F", linetype = 2, alpha = 0.4,
inherit.aes = F
) +
geom_line(
data = as.data.frame(pl_df), aes(x = seq_x, y = REFtrue), color = "#4545BA", linetype = 2, alpha = 0.4,
inherit.aes = F
) +
geom_vline(xintercept = c(Xbendl3, Xbendu3), col = "#4545BA", linetype = 2) + geom_vline(xintercept = c(Xbendl3, Xbendu3), col = "#4545BA", linetype = 2) +
geom_vline(xintercept = c(XbendlT, XbenduT), col = "#C2173F", linetype = 2) + geom_vline(xintercept = c(XbendlT, XbenduT), col = "#C2173F", linetype = 2) +
geom_vline(xintercept = c(XasymplS, XasympuS), col = "#4545BABB", linetype = 3) + geom_vline(xintercept = c(XasymplS, XasympuS), col = "#4545BABB", linetype = 3) +
@@ -303,17 +365,23 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
XbenduTrans <- cs_trans + (1.5434 / b_trans) XbenduTrans <- cs_trans + (1.5434 / b_trans)
XbendlTransT <- cs_trans - r_trans - (1.5434 / b_trans) XbendlTransT <- cs_trans - r_trans - (1.5434 / b_trans)
XbenduTransT <- cs_trans - r_trans + (1.5434 / b_trans) XbenduTransT <- cs_trans - r_trans + (1.5434 / b_trans)
bendpointsTRANS <- c(bendREF_lower = round(XbendlTrans,3), bendREF_upper=round(XbenduTrans,3), bendpointsTRANS <- c(
bendSAMPLE_lower = round(XbendlTransT,3), bendSAMPLE_upper=round(XbenduTransT,3)) bendREF_lower = round(XbendlTrans, 3), bendREF_upper = round(XbenduTrans, 3),
bendSAMPLE_lower = round(XbendlTransT, 3), bendSAMPLE_upper = round(XbenduTransT, 3)
)
Dat$bendpointsTRANS <- bendpointsTRANS Dat$bendpointsTRANS <- bendpointsTRANS
SAMPLEtrans <- a_trans + (d_trans - a_trans) / (1 + exp(b_trans * ((cs_trans - r_trans) - seq_x))) SAMPLEtrans <- a_trans + (d_trans - a_trans) / (1 + exp(b_trans * ((cs_trans - r_trans) - seq_x)))
REFtrans <- a_trans + (d_trans - a_trans) / (1 + exp(b_trans * ((cs_trans) - seq_x))) REFtrans <- a_trans + (d_trans - a_trans) / (1 + exp(b_trans * ((cs_trans) - seq_x)))
pl_df_trans <- cbind(seq_x, SAMPLEtrans, REFtrans) 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="#C2173F", p_rt2 <- p_rt + geom_line(
inherit.aes = F) + data = as.data.frame(pl_df_trans), aes(x = seq_x, y = SAMPLEtrans), color = "#C2173F",
geom_line(data=as.data.frame(pl_df_trans), aes(x=seq_x, y=REFtrans), color="#4545BA", inherit.aes = F
inherit.aes = F) + ) +
geom_line(
data = as.data.frame(pl_df_trans), aes(x = seq_x, y = REFtrans), color = "#4545BA",
inherit.aes = F
) +
geom_vline(xintercept = c(XbendlTrans, XbenduTrans), col = "#4545BA", linetype = 2) + geom_vline(xintercept = c(XbendlTrans, XbenduTrans), col = "#4545BA", linetype = 2) +
geom_vline(xintercept = c(XbendlTransT, XbenduTransT), col = "#C2173F", linetype = 2) + geom_vline(xintercept = c(XbendlTransT, XbenduTransT), col = "#C2173F", linetype = 2) +
theme(legend.position = "none", axis.text = element_text(size = 14)) theme(legend.position = "none", axis.text = element_text(size = 14))
@@ -349,11 +417,15 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
labs(title = "unrestricted 4pl model", color = "product") + labs(title = "unrestricted 4pl model", color = "product") +
scale_color_manual(labels = c("test", "reference"), values = c("#C2173F88", "#4545BA88")) + scale_color_manual(labels = c("test", "reference"), values = c("#C2173F88", "#4545BA88")) +
theme_bw() theme_bw()
pu2 <- pu + geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=SAMPLEu), pu2 <- pu + geom_line(
color="#C2173F", inherit.aes = F) + data = as.data.frame(pl_df2), aes(x = seq_x, y = SAMPLEu),
geom_line(data=as.data.frame(pl_df2), aes(x=seq_x, y=REFu), color = "#C2173F", inherit.aes = F
) +
geom_line(
data = as.data.frame(pl_df2), aes(x = seq_x, y = REFu),
color = "#4545BA", inherit.aes = F, color = "#4545BA", inherit.aes = F,
show.legend = F) show.legend = F
)
pu2_ <- pu2 + pu2_ <- pu2 +
theme(legend.position = "none", axis.text = element_text(size = 14)) theme(legend.position = "none", axis.text = element_text(size = 14))
@@ -378,11 +450,15 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
SAMPLEu_trans <- ate_t + (dte_t - ate_t) / (1 + exp(bte_t * (cte_t - seq_x))) SAMPLEu_trans <- ate_t + (dte_t - ate_t) / (1 + exp(bte_t * (cte_t - seq_x)))
pl_df2u_t <- cbind(seq_x, SAMPLEu_trans, REFu_trans) 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), pu2_t <- putrans + geom_line(
color="#C2173F", inherit.aes = F) + data = as.data.frame(pl_df2u_t), aes(x = seq_x, y = SAMPLEu_trans),
geom_line(data=as.data.frame(pl_df2u_t), aes(x=seq_x, y=REFu_trans), color = "#C2173F", inherit.aes = F
) +
geom_line(
data = as.data.frame(pl_df2u_t), aes(x = seq_x, y = REFu_trans),
color = "#4545BA", inherit.aes = F, color = "#4545BA", inherit.aes = F,
show.legend = F) show.legend = F
)
pu3_t <- pu2_t pu3_t <- pu2_t
if (TransFlag) grid.arrange(p_rt2, pu3_t, nrow = 1) else grid.arrange(p2, pu2_, nrow = 1) if (TransFlag) grid.arrange(p_rt2, pu3_t, nrow = 1) else grid.arrange(p2, pu2_, nrow = 1)
} }
@@ -401,13 +477,23 @@ plot_f <- function(dat, TransFlag=F) { #sigmoid,det_sig,
#' @returns A data-frame with readouts and natural log of concentrations. #' @returns A data-frame with readouts and natural log of concentrations.
#' @export #' @export
#' @examples #' @examples
#' as=3; bs=1; cs=-4; ds=10; at=3; bt=1; dt=10;r=0.0001;ct=cs-r;sd_fac=0.1; gt=1; gs=1; #' as <- 3
#' lnConc=c(1,0,-1,-2,-3,-4,-5,-6) #' bs <- 1
#' cs <- -4
#' ds <- 10
#' at <- 3
#' bt <- 1
#' dt <- 10
#' r <- 0.0001
#' ct <- cs - r
#' sd_fac <- 0.1
#' gt <- 1
#' gs <- 1
#' lnConc <- c(1, 0, -1, -2, -3, -4, -5, -6)
#' heteroNoise <- FALSE #' heteroNoise <- FALSE
#' noDilS <- 3 #' noDilS <- 3
#' noD <- 8 #' noD <- 8
#' Calc_DilRes(as, bs, cs, ds, at, bt, dt, r, ct, sd_fac, gt, gs, log_conc = lnConc, heteroNoise, noDilS, noD) #' Calc_DilRes(as, bs, cs, ds, at, bt, dt, r, ct, sd_fac, gt, gs, log_conc = lnConc, heteroNoise, noDilS, noD)
Calc_DilRes <- function(as = 3, bs = 1, cs = -4, ds = 10, at = 3, bt = 1, dt = 10, r = 0.0001, ct = cs - r, Calc_DilRes <- function(as = 3, bs = 1, cs = -4, ds = 10, at = 3, bt = 1, dt = 10, r = 0.0001, ct = cs - r,
sd_fac = 0.1, gt = 1, gs = 1, log_conc, sd_fac = 0.1, gt = 1, gs = 1, log_conc,
heteroNoise = FALSE, noDilSeries, noDils) { heteroNoise = FALSE, noDilSeries, noDils) {
@@ -447,20 +533,24 @@ Calc_DilRes <- function(as=3, bs=1, cs=-4, ds=10, at=3, bt=1, dt=10,r=0.0001,ct
#' @returns A data-frame with potency estimate, absolute CIs, test result, relative CIs. #' @returns A data-frame with potency estimate, absolute CIs, test result, relative CIs.
#' @export #' @export
#' @examples #' @examples
#' CIRC <- data.frame(log_dose = c(-2.5,-2.5,-2.5, -3.2,-3.2,-3.2,-3.9,-3.9,-3.9, #' CIRC <- data.frame(
#' -3.2,-3.2,-3.2,-3.9,-3.9,-3.9,-4.7,-4.7,-4.7), #' log_dose = c(
#' replname= c("R_dil1","R_dil1","R_dil1", "R_dil2","R_dil2","R_dil2", "R_dil3","R_dil3","R_dil3", #' -2.5, -2.5, -2.5, -3.2, -3.2, -3.2, -3.9, -3.9, -3.9,
#' "T_dil1","T_dil1","T_dil1", "T_dil2","T_dil2","T_dil2", "T_dil3","T_dil3","T_dil3"), #' -3.2, -3.2, -3.2, -3.9, -3.9, -3.9, -4.7, -4.7, -4.7
#' ),
#' replname = c(
#' "R_dil1", "R_dil1", "R_dil1", "R_dil2", "R_dil2", "R_dil2", "R_dil3", "R_dil3", "R_dil3",
#' "T_dil1", "T_dil1", "T_dil1", "T_dil2", "T_dil2", "T_dil2", "T_dil3", "T_dil3", "T_dil3"
#' ),
#' readout = c(72.1, 75.8, 76.04, 59.8, 61, 62.7, 43.6, 45, 41.5, 53.5, 62.2, 65.9, 48.3, 43.8, 43.14, 28.17, 29.2, 31.2), #' readout = c(72.1, 75.8, 76.04, 59.8, 61, 62.7, 43.6, 45, 41.5, 53.5, 62.2, 65.9, 48.3, 43.8, 43.14, 28.17, 29.2, 31.2),
#' isRef = c(rep(1, 9), rep(0, 9)), #' isRef = c(rep(1, 9), rep(0, 9)),
#' isSample = c(rep(0,9), rep(1,9))) #' isSample = c(rep(0, 9), rep(1, 9))
#' )
#' Lim <- c(rep(0, 8), 70, 130) # only Lim 9 and 10 relevant #' Lim <- c(rep(0, 8), 70, 130) # only Lim 9 and 10 relevant
#' PureErrF <- TRUE #' PureErrF <- TRUE
#' #'
#' #'
#' LinPotTab(circles = CIRC, Lim, PureErrF) #' LinPotTab(circles = CIRC, Lim, PureErrF)
LinPotTab <- function(circles, Lim, PureErrFlag) { LinPotTab <- function(circles, Lim, PureErrFlag) {
circ_ABl <- circles circ_ABl <- circles
circ_Al <- circ_ABl[circ_ABl$isSample == 1, ] circ_Al <- circ_ABl[circ_ABl$isSample == 1, ]
@@ -468,11 +558,14 @@ LinPotTab <- function(circles, Lim, PureErrFlag) {
# restr CSSI model # restr CSSI model
modAB <- lm(readout ~ log_dose + isSample, circ_ABl) modAB <- lm(readout ~ log_dose + isSample, circ_ABl)
coeffs <- modAB$coefficients coeffs <- modAB$coefficients
SU_modAB <- tryCatch({ SU_modAB <- tryCatch(
{
SU_modAB <- summary(modAB) SU_modAB <- summary(modAB)
}, error = function(msg) { },
error = function(msg) {
return(NA) return(NA)
}) }
)
# Intercept diff/slope modAB # Intercept diff/slope modAB
linPot <- exp(modAB$coefficients[3] / modAB$coefficients[2]) linPot <- exp(modAB$coefficients[3] / modAB$coefficients[2])
@@ -504,8 +597,10 @@ LinPotTab <- function(circles, Lim, PureErrFlag) {
relLinpotCI <- ExpLinPot / linPot * 100 relLinpotCI <- ExpLinPot / linPot * 100
if (relLinpotCI[2] > Lim[[9]] & relLinpotCI[3] < Lim[[10]]) test_potCI <- 0 else test_potCI <- 1 if (relLinpotCI[2] > Lim[[9]] & relLinpotCI[3] < Lim[[10]]) test_potCI <- 0 else test_potCI <- 1
pottab <- cbind(round(linPot*100,3), round(ExpLinPot[2]*100,3), round(ExpLinPot[3]*100,3), pottab <- cbind(
round(test_potCI,3), round(relLinpotCI[2],3),round(relLinpotCI[3],3)) round(linPot * 100, 3), round(ExpLinPot[2] * 100, 3), round(ExpLinPot[3] * 100, 3),
round(test_potCI, 3), round(relLinpotCI[2], 3), round(relLinpotCI[3], 3)
)
colnames(pottab) <- c("Potency", "lower 95%CI", "upper 95%CI", "test_result", "lowerRel95%CI", "upperRel95%CI") colnames(pottab) <- c("Potency", "lower 95%CI", "upper 95%CI", "test_result", "lowerRel95%CI", "upperRel95%CI")
return(pottab) return(pottab)
} }
@@ -524,23 +619,25 @@ LinPotTab <- function(circles, Lim, PureErrFlag) {
#' 4) summary of restricted linear model. #' 4) summary of restricted linear model.
#' @export #' @export
#' @examples #' @examples
#' dat <- data.frame(R_dil1 =c(10221, 18258, 31993, 49336, 68332, 83527, 95584, 102229), #' dat <- data.frame(
#' R_dil1 = c(10221, 18258, 31993, 49336, 68332, 83527, 95584, 102229),
#' R_dil2 = c(10136, 19078, 31925, 49003, 68034, 83776, 95495, 101608), #' R_dil2 = c(10136, 19078, 31925, 49003, 68034, 83776, 95495, 101608),
#' T_dil1 = c(10830, 19891, 33915, 52131, 70617, 85784, 95937, 102791), #' T_dil1 = c(10830, 19891, 33915, 52131, 70617, 85784, 95937, 102791),
#' T_dil2 = c(11169, 20153, 34007, 52179, 69962, 85543, 96439, 102655), #' T_dil2 = c(11169, 20153, 34007, 52179, 69962, 85543, 96439, 102655),
#' log_dose=c( -1.2029, -1.89712, -2.590267, -3.2834, -3.97656, -4.66917, -5.362323, -6.05334)) #' log_dose = c(-1.2029, -1.89712, -2.590267, -3.2834, -3.97656, -4.66917, -5.362323, -6.05334)
#' CIRC <- data.frame(log_dose=c( -2.590267, -2.590267, -3.2834 , -3.2834, -3.97656, -3.97656, -2.590267, -2.590267,-3.2834, -3.2834, -3.97656, -3.97656), #' )
#' CIRC <- data.frame(
#' log_dose = c(-2.590267, -2.590267, -3.2834, -3.2834, -3.97656, -3.97656, -2.590267, -2.590267, -3.2834, -3.2834, -3.97656, -3.97656),
#' replname = c("R_dil1", "R_dil2", "R_dil1", "R_dil2", "R_dil1", "R_dil2", "T_dil1", "T_dil2", "T_dil1", "T_dil2", "T_dil1", "T_dil2"), #' replname = c("R_dil1", "R_dil2", "R_dil1", "R_dil2", "R_dil1", "R_dil2", "T_dil1", "T_dil2", "T_dil1", "T_dil2", "T_dil1", "T_dil2"),
#' readout = c(31993, 31925, 49336, 49003, 68332, 68034, 33915, 34007, 52131, 52179, 70617, 69962), #' readout = c(31993, 31925, 49336, 49003, 68332, 68034, 33915, 34007, 52131, 52179, 70617, 69962),
#' isRef = c(rep(1, 6), rep(0, 6)), #' isRef = c(rep(1, 6), rep(0, 6)),
#' isSample = c(rep(0,6), rep(1,6))) #' isSample = c(rep(0, 6), rep(1, 6))
#' )
#' Lim <- c(rep(0, 8), 70, 130) # only Lim 9 and 10 relevant #' Lim <- c(rep(0, 8), 70, 130) # only Lim 9 and 10 relevant
#' PureErrF <- TRUE #' PureErrF <- TRUE
#' #'
#' #'
#' ANOVAlintests(ro_new, circles, Lim, PureErrF) #' ANOVAlintests(ro_new, circles, Lim, PureErrF)
ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) { ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
all_l <- melt(data.frame(ro_new), id.vars = "log_dose", variable.name = "replname", value.name = "readout") all_l <- melt(data.frame(ro_new), 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)
@@ -594,11 +691,14 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
if (PureErrFlag) { if (PureErrFlag) {
FitAnova <- anova(lm(readout ~ factor(log_dose) * isSample, circ_ABl)) FitAnova <- anova(lm(readout ~ factor(log_dose) * isSample, circ_ABl))
meanPureErr <- FitAnova[4, 3] meanPureErr <- FitAnova[4, 3]
SU_modAB <- tryCatch({ SU_modAB <- tryCatch(
{
SU_modAB <- summary(modAB) SU_modAB <- summary(modAB)
}, error = function(msg) { },
error = function(msg) {
return(NA) return(NA)
}) }
)
if (length(SU_modAB) > 1) s_modABcoeffs <- summary(modAB)$coefficients if (length(SU_modAB) > 1) s_modABcoeffs <- summary(modAB)$coefficients
DFsPure <- FitAnova[4, 1] DFsPure <- FitAnova[4, 1]
@@ -626,7 +726,6 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
SSRes <- SSE SSRes <- SSE
dfRes <- dfPureE dfRes <- dfPureE
} else { } else {
SSRes <- RSS SSRes <- RSS
dfRes <- dfRMSE dfRes <- dfRMSE
@@ -671,7 +770,9 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
if (is.na(F_nonlin)) F_nonlin <- 0 if (is.na(F_nonlin)) F_nonlin <- 0
if (F_nonlin > 0) { if (F_nonlin > 0) {
p_F_nonlin <- round(pf(F_nonlin, 2, dfPureE, lower.tail = F), 5) p_F_nonlin <- round(pf(F_nonlin, 2, dfPureE, lower.tail = F), 5)
} else { p_F_nonlin <- "SSnonlin neg or 0"; } } else {
p_F_nonlin <- "SSnonlin neg or 0"
}
# significances # significances
F_regr <- (SSreg / 1) / (SSRes / dfRes) F_regr <- (SSreg / 1) / (SSRes / dfRes)
@@ -683,28 +784,44 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
p_F_nonp <- round(pf(F_nonpar, 1, dfRes, lower.tail = F), 3) p_F_nonp <- round(pf(F_nonpar, 1, dfRes, lower.tail = F), 3)
p_F_LoF <- p_F_nonlin p_F_LoF <- p_F_nonlin
res_tab_lin <- data.frame(test = c("F-test on sign. of regression", "F_test on non-lin", res_tab_lin <- data.frame(
test = c(
"F-test on sign. of regression", "F_test on non-lin",
"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,1,0), ),
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(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,1,0),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), estimate = c(
Source = c("Treatment","Preparation","Regression","Non-parallelism", p_F_regr, p_F_nonlin, pFR2_A, pFR2_B, p_F_slope_A,
"Resid Error","Non-linearity","Pure error", "Total"), p_F_slope_B, p_F_nonp, p_F_prep
),
Source = c(
"Treatment", "Preparation", "Regression", "Non-parallelism",
"Resid Error", "Non-linearity", "Pure error", "Total"
),
df = c(dfTreat, 1, 1, 1, dfRMSE, 2, dfPureE, lenCirc - 1), df = c(dfTreat, 1, 1, 1, dfRMSE, 2, dfPureE, lenCirc - 1),
SumSquares = c(round(SStreat,5),round(SSprep,5),round(SSreg,5), SumSquares = c(
round(SStreat, 5), round(SSprep, 5), round(SSreg, 5),
round(SSnonpar, 5), round(RSS, 5), round(SSnonlin, 5), round(SSnonpar, 5), round(RSS, 5), round(SSnonlin, 5),
round(SSE,5),round(SStot,5)), round(SSE, 5), round(SStot, 5)
MS = c(round(SStreat/dfTreat,5),round(SSprep,5),round(SSreg,5), ),
MS = c(
round(SStreat / dfTreat, 5), round(SSprep, 5), round(SSreg, 5),
round(SSnonpar, 5), round(RSS / dfRMSE, 5), round(SSnonlin / 2, 5), round(SSnonpar, 5), round(RSS / dfRMSE, 5), round(SSnonlin / 2, 5),
round(SSE/dfPureE,5),round(SStot/dfTotal,5)), round(SSE / dfPureE, 5), round(SStot / dfTotal, 5)
"F-value" = c(round(F_treat,5), round(F_prep,5),round(F_regr,5), ),
round(F_nonpar,5),"",round(F_nonlin,5),"",""), "F-value" = c(
"p-value" = c(p_F_treat, p_F_prep, p_F_regr, p_F_nonp, "", p_F_LoF, "","")) round(F_treat, 5), round(F_prep, 5), round(F_regr, 5),
round(F_nonpar, 5), "", round(F_nonlin, 5), "", ""
),
"p-value" = c(p_F_treat, p_F_prep, p_F_regr, p_F_nonp, "", p_F_LoF, "", "")
)
RET <- list(res_tab_lin, su_modU2, SlopeDiffCI, su_mod2) RET <- list(res_tab_lin, su_modU2, SlopeDiffCI, su_mod2)
return(RET) return(RET)
} }
@@ -730,20 +847,21 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
#' sigmoid <- c(10.0, 10.0, 110.0, 110.0, 1.0, 1.0, -3.5, 0.0) #' sigmoid <- c(10.0, 10.0, 110.0, 110.0, 1.0, 1.0, -3.5, 0.0)
#' indS <- 3 #' indS <- 3
#' indT <- 3 #' indT <- 3
#' pl_df <- data.frame(lnC=c(-1.203973,-1.897120 ,-2.590267,-3.283414,-3.976562,-4.669176,-5.362323,-6.053340), #' pl_df <- data.frame(
#' lnC = c(-1.203973, -1.897120, -2.590267, -3.283414, -3.976562, -4.669176, -5.362323, -6.053340),
#' plotS = c(113.772511, 97.668371, 81.564231, 65.460091, 49.355952, 33.264200, 17.160060, 1.105405), #' plotS = c(113.772511, 97.668371, 81.564231, 65.460091, 49.355952, 33.264200, 17.160060, 1.105405),
#' plotT = c(114.213375,97.588663,80.963951,64.339239,47.714527,31.102604,14.477892,-2.095735)) #' plotT = c(114.213375, 97.588663, 80.963951, 64.339239, 47.714527, 31.102604, 14.477892, -2.095735)
#' )
#' #'
#' #'
#' PlotLinPLA_FUNC(circle, sigmoid, all_l2, pl_df, indS, indT) #' PlotLinPLA_FUNC(circle, sigmoid, all_l2, pl_df, indS, indT)
PlotLinPLA_FUNC <- function(circle, sigmoid, all_l2, pl_df, indS, indT) { PlotLinPLA_FUNC <- function(circle, sigmoid, all_l2, pl_df, indS, indT) {
# browser() # browser()
mLin <- gsl_nls(readout ~ (intS + r) * isSample + intS * isRef + k * log_dose, mLin <- gsl_nls(readout ~ (intS + r) * isSample + intS * isRef + k * log_dose,
data = circle, data = circle,
start = list(intS = 0, k = 1, r = 0), start = list(intS = 0, k = 1, r = 0),
control = gsl_nls_control(xtol=1e-10,ftol=1e-10,gtol=1e-10)) control = gsl_nls_control(xtol = 1e-10, ftol = 1e-10, gtol = 1e-10)
)
# alternativ: modAB <- lm(readout ~ log_dose+isSample, circle) # alternativ: modAB <- lm(readout ~ log_dose+isSample, circle)
sum_mLin <- summary(mLin) sum_mLin <- summary(mLin)
@@ -760,8 +878,6 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
} }
p <- ggplot(all_l2, aes(x = log_dose, y = readout, color = factor(isRef))) + p <- ggplot(all_l2, aes(x = log_dose, y = readout, color = factor(isRef))) +
geom_point(size = 2) + geom_point(size = 2) +
# labs(title=paste("linear regression model", indS,indT), color="product") + # labs(title=paste("linear regression model", indS,indT), color="product") +
@@ -770,18 +886,36 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) + scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) + scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme_bw() theme_bw()
p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="#4545BA", p2 <- p + geom_line(
inherit.aes = F) + data = pl_df, aes(x = lnC, y = plotS), color = "#4545BA",
geom_line(data=pl_df,aes(x=lnC,y=plotT),color="#C2173F", inherit.aes = F
inherit.aes = F) + ) +
{if (!is.null(truePL_df)) geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4, geom_line(
inherit.aes = F) } + data = pl_df, aes(x = lnC, y = plotT), color = "#C2173F",
{if (!is.null(truePL_df)) geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4, inherit.aes = F
inherit.aes = F)} + ) +
{
if (!is.null(truePL_df)) {
geom_line(
data = data.frame(truePL_df), aes(x = seq_x, y = SAMPLEtrue), color = "#C2173F", linetype = 2, alpha = 0.4,
inherit.aes = F
)
}
} +
{
if (!is.null(truePL_df)) {
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 PLA model"), subtitle = paste("Regression starts for reference sample:", indS, "for test sample:", 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)) 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), p3 <- p2 + geom_point(circle, mapping = aes(
size=5,alpha=0.2), col=c("black"), inherit.aes = FALSE) + x = log_dose, y = readout, shape = factor(isRef),
size = 5, alpha = 0.2
), col = c("black"), inherit.aes = FALSE) +
scale_shape_manual(labels = c("test", "reference"), values = c(21, 21)) scale_shape_manual(labels = c("test", "reference"), values = c(21, 21))
# fit intercept for test and ref and common slope # fit intercept for test and ref and common slope
@@ -790,25 +924,44 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
pl_restT <- sum_mLin$coefficients[1, 1] + sum_mLin$coefficients[3, 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) 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", pr2 <- p + geom_line(
inherit.aes = F) + data = pl_rest, aes(x = lnC, y = plotS), color = "#4545BA",
geom_line(data=pl_rest,aes(x=lnC,y=plotT),color="#C2173F", inherit.aes = F
inherit.aes = F) + ) +
{if (!is.null(truePL_df)) geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4, geom_line(
inherit.aes = F) } + data = pl_rest, aes(x = lnC, y = plotT), color = "#C2173F",
{if (!is.null(truePL_df)) geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4, inherit.aes = F
inherit.aes = F) } + ) +
labs(title = paste("restricted linear regression model"), {
subtitle = paste("Regression on highlighted points")) + if (!is.null(truePL_df)) {
geom_line(
data = data.frame(truePL_df), aes(x = seq_x, y = SAMPLEtrue), color = "#C2173F", linetype = 2, alpha = 0.4,
inherit.aes = F
)
}
} +
{
if (!is.null(truePL_df)) {
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"),
subtitle = paste("Regression on highlighted points")
) +
theme(legend.position = "none", axis.text = element_text(size = 14)) 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), pr3 <- pr2 + geom_point(circle, mapping = aes(
size=5, alpha=0.2), col=c("black"), inherit.aes = FALSE) + x = log_dose, y = readout, shape = factor(isRef),
size = 5, alpha = 0.2
), col = c("black"), inherit.aes = FALSE) +
scale_shape_manual(labels = c("test", "reference"), values = c(21, 21)) scale_shape_manual(labels = c("test", "reference"), values = c(21, 21))
return(grid.arrange(p3, pr3, nrow = 1)) return(grid.arrange(p3, pr3, nrow = 1))
} }
#' Calculates the potency of 4PL PLA of all models model #' 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, #' The gradient method is used for calculating the potency for a restricted model, an unrestricteed model,
@@ -822,17 +975,17 @@ PlotLinPLA_FUNC <-function(circle, sigmoid, all_l2, pl_df, indS, indT) {
#' 4) summary of restricted linear model. #' 4) summary of restricted linear model.
#' @export #' @export
#' @examples #' @examples
#' ro_new <- data.frame(R_dil1 =c(10221, 18258, 31993, 49336, 68332, 83527, 95584, 102229), #' ro_new <- data.frame(
#' R_dil1 = c(10221, 18258, 31993, 49336, 68332, 83527, 95584, 102229),
#' R_dil2 = c(10136, 19078, 31925, 49003, 68034, 83776, 95495, 101608), #' R_dil2 = c(10136, 19078, 31925, 49003, 68034, 83776, 95495, 101608),
#' T_dil1 = c(10830, 19891, 33915, 52131, 70617, 85784, 95937, 102791), #' T_dil1 = c(10830, 19891, 33915, 52131, 70617, 85784, 95937, 102791),
#' T_dil2 = c(11169, 20153, 34007, 52179, 69962, 85543, 96439, 102655), #' T_dil2 = c(11169, 20153, 34007, 52179, 69962, 85543, 96439, 102655),
#' log_dose=c( -1.2029, -1.89712, -2.590267, -3.2834, -3.97656, -4.66917, -5.362323, -6.05334)) #' log_dose = c(-1.2029, -1.89712, -2.590267, -3.2834, -3.97656, -4.66917, -5.362323, -6.05334)
#' )
#' PureErrF <- TRUE #' PureErrF <- TRUE
#' #'
#' #'
#' pot4plFUNC(ro_new, PureErrF) #' pot4plFUNC(ro_new, PureErrF)
pot4plFUNC <- function(ro_new, PureErrFlag) { pot4plFUNC <- function(ro_new, PureErrFlag) {
all_l <- melt(data.frame(ro_new), id.vars = "log_dose", variable.name = "replname", value.name = "readout") all_l <- melt(data.frame(ro_new), 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)
@@ -869,8 +1022,10 @@ pot4plFUNC <- function(ro_new, PureErrFlag) {
# V_V <- VCOV/SU_mr$sigma^2 # V_V <- VCOV/SU_mr$sigma^2
V_V <- SU_mr$cov.unscaled V_V <- SU_mr$cov.unscaled
SEsPure <- sqrt(diag(V_V) * meanPureErr) SEsPure <- sqrt(diag(V_V) * meanPureErr)
pot_est <- c(exp(SU_mrCoeff['r',1]),exp(SU_mrCoeff['r',1]-qt(0.975,DFsPure)*SEsPure['r']), pot_est <- c(
exp(SU_mrCoeff['r',1]+qt(0.975,DFsPure)*SEsPure['r'])) exp(SU_mrCoeff["r", 1]), exp(SU_mrCoeff["r", 1] - qt(0.975, DFsPure) * SEsPure["r"]),
exp(SU_mrCoeff["r", 1] + qt(0.975, DFsPure) * SEsPure["r"])
)
# unrestricted # unrestricted
SU_mu <- FITs[[2]] SU_mu <- FITs[[2]]
s_muCoeff <- SU_mu$coefficients s_muCoeff <- SU_mu$coefficients
@@ -878,8 +1033,10 @@ pot4plFUNC <- function(ro_new, PureErrFlag) {
# VCOVu <- vcov(mu) # VCOVu <- vcov(mu)
V_Vu <- SU_mu$cov.unscaled V_Vu <- SU_mu$cov.unscaled
SEsPureU <- sqrt(diag(V_Vu) * meanPureErr) SEsPureU <- sqrt(diag(V_Vu) * meanPureErr)
potU_est <- c(exp(s_muCoeff['r',1]),exp(s_muCoeff['r',1]-qt(0.975,DFsPure)*SEsPureU['r']), potU_est <- c(
+ exp(s_muCoeff['r',1]+qt(0.975,DFsPure)*SEsPureU['r'])) exp(s_muCoeff["r", 1]), exp(s_muCoeff["r", 1] - qt(0.975, DFsPure) * SEsPureU["r"]),
+exp(s_muCoeff["r", 1] + qt(0.975, DFsPure) * SEsPureU["r"])
)
} # PureErrFlag } # PureErrFlag
FITstrans <- Fitting_FUNC(ro_new, TransFlag = TRUE) FITstrans <- Fitting_FUNC(ro_new, TransFlag = TRUE)
@@ -918,13 +1075,14 @@ pot4plFUNC <- function(ro_new, PureErrFlag) {
#' @returns A data-frame with the lower and upper CI in anti-log form. #' @returns A data-frame with the lower and upper CI in anti-log form.
#' @export #' @export
#' @examples #' @examples
#' xs=2; xt=3.2; se_xt=0.34;se_xs=0.23; DFs=32-16 #' xs <- 2
#' xt <- 3.2
#' se_xt <- 0.34
#' se_xs <- 0.23
#' DFs <- 32 - 16
#' #'
#' #'
#' ParamCI_F(xt, xs, se_xt, se_xs, CoVar, DFs, Conf = 0.975) #' ParamCI_F(xt, xs, se_xt, se_xs, CoVar, DFs, Conf = 0.975)
ParamCI_F <- function(xt, xs, se_xt, se_xs, CoVar, DFs, Conf = 0.975) { ParamCI_F <- function(xt, xs, se_xt, se_xs, CoVar, DFs, Conf = 0.975) {
log_xs <- log(abs(xs)) log_xs <- log(abs(xs))
log_xt <- log(abs(xt)) log_xt <- log(abs(xt))
@@ -951,18 +1109,17 @@ ParamCI_F <- function(xt,xs,se_xt, se_xs, CoVar,DFs, Conf=0.975) {
#' @export #' @export
#' @examples #' @examples
#' #'
#' dat <- data.frame(REF1=c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2=c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497), #' dat <- data.frame(
#' REF1 = c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2 = c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497),
#' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665), #' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665),
#' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591), #' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591),
#' TEST3=c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose=c(5.01,3.401,2.708,2.015,1.32176,0.62861,-0.0645385,-1.6739764)) #' TEST3 = c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose = c(5.01, 3.401, 2.708, 2.015, 1.32176, 0.62861, -0.0645385, -1.6739764)
#' )
#' Lim <- c(-1, 1, 0.005, 2, 0.5, 2, 0.5, 2, 75, 133, 75, 133) #' Lim <- c(-1, 1, 0.005, 2, 0.5, 2, 0.5, 2, 75, 133, 75, 133)
#' PureErrF <- FALSE #' PureErrF <- FALSE
#' #'
#' tests_FUNC(ro_new, Lim, PureErrF) #' tests_FUNC(ro_new, Lim, PureErrF)
tests_FUNC <- function(ro_new, Lim, PureErrFlag) { tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
all_l <- melt(data.frame(ro_new), id.vars = "log_dose", variable.name = "replname", value.name = "readout") all_l <- melt(data.frame(ro_new), 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) isSample <- rep(c(0, 1), 1, each = nrow(all_l) / 2)
@@ -972,7 +1129,9 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
all_l$readout[all_l$readout < 0] <- 0.01 all_l$readout[all_l$readout < 0] <- 0.01
# browser() # browser()
FITs <- Fitting_FUNC(ro_new = ro_new, TransFlag = FALSE) FITs <- Fitting_FUNC(ro_new = ro_new, TransFlag = FALSE)
if (is.character(FITs)) return(FITs) # if singularity if (is.character(FITs)) {
return(FITs)
} # if singularity
POTr_CI <- FITs[[3]][2:3] POTr_CI <- FITs[[3]][2:3]
potAll2 <- FITs[[3]] potAll2 <- FITs[[3]]
@@ -991,7 +1150,6 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
DFsPure <- FitAnova[4, 1] DFsPure <- FitAnova[4, 1]
testPOTr <- logical() testPOTr <- logical()
if (POTr_CI[1] * 100 > Lim[[9]] & POTr_CI[2] * 100 < Lim[[10]]) testPOTr <- 0 else testPOTr <- 1 if (POTr_CI[1] * 100 > Lim[[9]] & POTr_CI[2] * 100 < Lim[[10]]) testPOTr <- 0 else testPOTr <- 1
@@ -1024,7 +1182,13 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
PureMSE <- SSE / SSE_df PureMSE <- SSE / SSE_df
RMSE_pure <- sqrt(PureMSE) RMSE_pure <- sqrt(PureMSE)
## non-lin = LoF ## non-lin = LoF
if (PureErrFlag) { ERR <- PureMSE; ERR_df <- SSE_df } else { ERR <- MSEunr; ERR_df <- RSS_df } if (PureErrFlag) {
ERR <- PureMSE
ERR_df <- SSE_df
} else {
ERR <- MSEunr
ERR_df <- RSS_df
}
SSnonlin <- sum((predict(lm(readout ~ factor(Conc) * isSample, all_l)) - predPotU)^2) SSnonlin <- sum((predict(lm(readout ~ factor(Conc) * isSample, all_l)) - predPotU)^2)
LoF_df <- FitAnova[1, 1] + FitAnova[2, 1] LoF_df <- FitAnova[1, 1] + FitAnova[2, 1]
F_regr <- (SSregr / AnovaDFs[3]) / ERR F_regr <- (SSregr / AnovaDFs[3]) / ERR
@@ -1032,7 +1196,9 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
if (ncol(ro_new) < 4) F_nonlin <- 0 else F_nonlin <- (SSnonlin / AnovaDFs[6]) / ERR if (ncol(ro_new) < 4) F_nonlin <- 0 else F_nonlin <- (SSnonlin / AnovaDFs[6]) / ERR
if (F_nonlin > 0) { if (F_nonlin > 0) {
p_F_nonlin <- round(pf(F_nonlin, AnovaDFs[6], ERR_df, lower.tail = F), 5) p_F_nonlin <- round(pf(F_nonlin, AnovaDFs[6], ERR_df, lower.tail = F), 5)
} else { p_F_nonlin <- "SSnonlin neg or single dilutions" } } else {
p_F_nonlin <- "SSnonlin neg or single dilutions"
}
test_a <- test_b <- test_d <- test_ad <- logical() test_a <- test_b <- test_d <- test_ad <- logical()
@@ -1122,10 +1288,16 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
Dat$up_lowAs <- abs(ds - as) Dat$up_lowAs <- abs(ds - as)
lowerCIlowerA <- lAsCI2[1]; lowerCIupperA <- uAsCI2[1]; upperCIlowerA <- lAsCI2[2]; upperCIupperA <- uAsCI2[2] lowerCIlowerA <- lAsCI2[1]
test_lowA <- test_d; test_uppA <- test_a lowerCIupperA <- uAsCI2[1]
upperCIlowerA <- lAsCI2[2]
upperCIupperA <- uAsCI2[2]
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 lower asymptotes difference", "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",
@@ -1133,19 +1305,28 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
"F-test on non-linearity*", "F-test on non-linearity*",
"EQ test ratio of asymptote difference", "EQ test ratio of asymptote difference",
"geom. rel. CI restr. model", "geom. rel. CI restr. model",
"geom. rel. CI unrestr. model"), "geom. rel. CI unrestr. model"
test_results = c(ifelse(p_F_regr<0.05,0,1), test_la_diff, test_lowA, test_b, test_uppA, ),
test_results = c(
ifelse(p_F_regr < 0.05, 0, 1), test_la_diff, test_lowA, test_b, test_uppA,
ifelse(p_F_nonlin > 1, 1, ifelse(p_F_nonlin < 0.05, 1, 0)), test_ad, ifelse(p_F_nonlin > 1, 1, ifelse(p_F_nonlin < 0.05, 1, 0)), test_ad,
testPOTr, test_c), testPOTr, test_c
estimate = c(round(p_F_regr, 3), round(lAs_diff, 5), ),
estimate = c(
round(p_F_regr, 3), round(lAs_diff, 5),
estLowA, round(bs / bt, 5), estUppA, p_F_nonlin, estLowA, round(bs / bt, 5), estUppA, p_F_nonlin,
round(dt_at/ds_as, 5), round(potAll2[1]*100,2),round(potAllU2[1]*100,2)), round(dt_at / ds_as, 5), round(potAll2[1] * 100, 2), round(potAllU2[1] * 100, 2)
),
lower_limit = c("-", Lim[[1]], Lim[[3]], Lim[[5]], Lim[[7]], "-", Lim[[11]], Lim[[9]], Lim[[9]]), lower_limit = c("-", Lim[[1]], Lim[[3]], Lim[[5]], Lim[[7]], "-", Lim[[11]], Lim[[9]], Lim[[9]]),
upper_limit = c("-", Lim[[2]], Lim[[4]], Lim[[6]], Lim[[8]], "-", Lim[[12]], Lim[[10]], Lim[[10]]), upper_limit = c("-", Lim[[2]], Lim[[4]], Lim[[6]], Lim[[8]], "-", Lim[[12]], Lim[[10]], Lim[[10]]),
lower_CI = c(RMSE_r, round(lCI_laDiff,3), round(lAsCI2[1],5), round(slopeCI2[1],5), lower_CI = c(
round(uAsCI2[1],5), "-", round(AsDiffCI2[1],5), round(potAll2[2],2), round(potAllU2[2],2)), RMSE_r, round(lCI_laDiff, 3), round(lAsCI2[1], 5), round(slopeCI2[1], 5),
upper_CI = c(RMSE_pure, round(uCI_laDiff,3), round(lAsCI2[2],5), round(slopeCI2[2],5), round(uAsCI2[1], 5), "-", round(AsDiffCI2[1], 5), round(potAll2[2], 2), round(potAllU2[2], 2)
round(uAsCI2[2],5), "-", round(AsDiffCI2[2],5), round(potAll2[3],2), round(potAllU2[3],2)) ),
upper_CI = c(
RMSE_pure, round(uCI_laDiff, 3), round(lAsCI2[2], 5), round(slopeCI2[2], 5),
round(uAsCI2[2], 5), "-", round(AsDiffCI2[2], 5), round(potAll2[3], 2), round(potAllU2[3], 2)
)
) )
return(res_tab) return(res_tab)
} }
@@ -1160,15 +1341,15 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
#' @export #' @export
#' @examples #' @examples
#' #'
#' ro_new <- data.frame(REF1=c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2=c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497), #' ro_new <- data.frame(
#' REF1 = c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2 = c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497),
#' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665), #' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665),
#' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591), #' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591),
#' TEST3=c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose=c(5.01,3.401,2.708,2.015,1.32176,0.62861,-0.0645385,-1.6739764)) #' TEST3 = c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose = c(5.01, 3.401, 2.708, 2.015, 1.32176, 0.62861, -0.0645385, -1.6739764)
#' )
#' #'
#' #'
#' ANOVA4plUnresfunc(ro_new) #' ANOVA4plUnresfunc(ro_new)
ANOVA4plUnresfunc <- function(ro_new) { ANOVA4plUnresfunc <- function(ro_new) {
all_l <- melt(data.frame(ro_new), id.vars = "log_dose", variable.name = "replname", value.name = "readout") all_l <- melt(data.frame(ro_new), id.vars = "log_dose", variable.name = "replname", value.name = "readout")
all_len <- nrow(all_l) all_len <- nrow(all_l)
@@ -1216,17 +1397,26 @@ ANOVA4plUnresfunc <- function(ro_new) {
p_SSnonp <- round(pf((SSnonparallel / AnovaDFs[4]) / MSE, AnovaDFs[3], RSS_df, lower.tail = F), 3) p_SSnonp <- round(pf((SSnonparallel / AnovaDFs[4]) / MSE, AnovaDFs[3], RSS_df, lower.tail = F), 3)
p_SSLoF <- round(pf((SSnonlin / LoF_df) / (SSE / SSE_df), LoF_df, SSE_df, lower.tail = F), 5) p_SSLoF <- round(pf((SSnonlin / LoF_df) / (SSE / SSE_df), LoF_df, SSE_df, lower.tail = F), 5)
ANOVAtab <- data.frame(Source = c("Treatment","Preparation","Regression", ANOVAtab <- data.frame(
Source = c(
"Treatment", "Preparation", "Regression",
"Non-Parallelism", "Residual Error", "Non-linearity", "Non-Parallelism", "Residual Error", "Non-linearity",
"Pure Error","Total"), "Pure Error", "Total"
),
DF = AnovaDFs, DF = AnovaDFs,
SumSquares = c(SStreat, SSprep,SSregr, SSnonparallel, SumSquares = c(
RSS, SSnonlin,SSE, SStot), SStreat, SSprep, SSregr, SSnonparallel,
MeanSquares = c(round(SStreat/AnovaDFs[1],3), SSprep, round(SStreat/AnovaDFs[3],3),round(SSnonparallel/AnovaDFs[4],3), RSS, SSnonlin, SSE, SStot
round(MSE,5), round(SSnonlin/LoF_df,5), round(SSE/SSE_df,5),""), ),
"F-value" = c(round((SStreat/AnovaDFs[1])/MSE,5), round((SSprep/AnovaDFs[2])/MSE,5), MeanSquares = c(
round(SStreat / AnovaDFs[1], 3), SSprep, round(SStreat / AnovaDFs[3], 3), round(SSnonparallel / AnovaDFs[4], 3),
round(MSE, 5), round(SSnonlin / LoF_df, 5), round(SSE / SSE_df, 5), ""
),
"F-value" = c(
round((SStreat / AnovaDFs[1]) / MSE, 5), round((SSprep / AnovaDFs[2]) / MSE, 5),
round((SSregr / AnovaDFs[3]) / MSE, 5), round((SSnonparallel / AnovaDFs[4]) / MSE, 5), round((SSregr / AnovaDFs[3]) / MSE, 5), round((SSnonparallel / AnovaDFs[4]) / MSE, 5),
"",round((SSnonlin/LoF_df)/(SSE/SSE_df),5),"",""), "", round((SSnonlin / LoF_df) / (SSE / SSE_df), 5), "", ""
),
"p_value" = c(round(p_SStreat, 3), p_SSprep, round(p_SSregr, 3), p_SSnonp, "", p_SSLoF, "", "") "p_value" = c(round(p_SStreat, 3), p_SSprep, round(p_SSregr, 3), p_SSnonp, "", p_SSLoF, "", "")
) )
@@ -1243,16 +1433,15 @@ ANOVA4plUnresfunc <- function(ro_new) {
#' @export #' @export
#' @examples #' @examples
#' #'
#' ro_new <- data.frame(REF1=c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2=c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497), #' ro_new <- data.frame(
#' REF1 = c(1547, 1620, 1644, 2504, 3426, 3512, 3401, 3787), REF2 = c(1492, 1536, 1384, 2286, 3046, 3479, 3516, 3497),
#' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665), #' REF3 = c(1468, 1827, 1558, 2252, 3002, 3349, 2945, 3665),
#' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591), #' TEST1 = c(1405, 1523, 1502, 1474, 2383, 3221, 3589, 3445), TEST2 = c(1420, 1516, 1544, 1512, 2226, 3219, 3327, 3591),
#' TEST3=c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose=c(5.01,3.401,2.708,2.015,1.32176,0.62861,-0.0645385,-1.6739764)) #' TEST3 = c(1399, 1376, 1588, 1475, 2148, 3083, 2942, 3466), log_dose = c(5.01, 3.401, 2.708, 2.015, 1.32176, 0.62861, -0.0645385, -1.6739764)
#' )
#' #'
#' #'
#' perConcTab(ro_new, noDilSeries = 3) #' perConcTab(ro_new, noDilSeries = 3)
perConcTab <- function(ro_new, noDilSeries) { perConcTab <- function(ro_new, noDilSeries) {
Reftab <- ro_new[, c(1:noDilSeries)] Reftab <- ro_new[, c(1:noDilSeries)]
Testtab <- ro_new[, c((noDilSeries + 1):(2 * noDilSeries))] Testtab <- ro_new[, c((noDilSeries + 1):(2 * noDilSeries))]
@@ -1273,7 +1462,6 @@ perConcTab <- function(ro_new, noDilSeries) {
tTesttab2 <- rbind(tTesttab, avs_test, sds_test, cv_test) tTesttab2 <- rbind(tTesttab, avs_test, sds_test, cv_test)
concTab <- rbind(tReftab2, tTesttab2) concTab <- rbind(tReftab2, tTesttab2)
return(concTab) return(concTab)
} }
#' Calculates dilution series. #' Calculates dilution series.
@@ -1289,17 +1477,19 @@ perConcTab <- function(ro_new, noDilSeries) {
#' @export #' @export
#' @examples #' @examples
#' #'
#' x <- 1; Div <- 3;N <- 0; res <- c(); noDil <- 7 #' x <- 1
#' Div <- 3
#' N <- 0
#' res <- c()
#' noDil <- 7
#' #'
#' divFUN(x, Div, N, res, noDil) #' divFUN(x, Div, N, res, noDil)
divFUN <- function(x, Div, N, res, noDil) { divFUN <- function(x, Div, N, res, noDil) {
N <- N + 1 N <- N + 1
y <- x / Div y <- x / Div
res <- c(res, y) res <- c(res, y)
if (N==noDil) { return(res) } if (N == noDil) {
return(res)
}
divFUN(y, Div, N, res, noDil) divFUN(y, Div, N, res, noDil)
} }