Nothing
Fluorescence analysis report
In QurvE: Robust and User-Friendly Analysis of Growth and Fluorescence Curves
dir.create(paste0(tempdir(),"/Plots"), showWarnings = F)
wd.plots <- paste0(wd,"/Plots")
if(parallelize){
library(doParallel, quietly = TRUE)
library(foreach, quietly = TRUE)
cl <- parallel::makeCluster(parallel::detectCores(all.tests = FALSE, logical = TRUE)-1)
doParallel::registerDoParallel(cl)
}
knitr::opts_chunk$set(dev = "pdf")
knitr::opts_chunk$set(tidy.opts=list(width.cutoff=80), tidy=TRUE)
knit_table <- function(df, caption){
if (knitr::is_html_output()) {
DT::datatable(df, caption = caption, filter = 'top', escape = FALSE,
extensions = c('FixedColumns',"FixedHeader"),
options = list(scrollX = FALSE,
paging=TRUE,
pageLength = 15,
fixedHeader=TRUE))
} else {
colnames(df) <- colnames(df) %>% str_replace_all(.,"<br>", "\n") %>% str_replace_all(., "_", "\\\\char`_") %>% str_replace_all(., "slope<sub>max</sub>", "$slope_{max}$") %>% str_replace_all(., "λ", "$\\\\lambda$") %>% str_replace_all(., "Δ", "$\\\\Delta$") %>% str_replace_all(., "x<sub>start</sub>", "$x_{start}$") %>% str_replace_all(., "x<sub>D</sub>", "$x_{D}$") %>% str_replace_all(., "x<sub>end</sub>", "$x_{end}$") %>% str_replace_all(., "R<sup>2</sup>", "$R^2$") %>% str_replace_all(., "α", "$\\\\alpha$") %>% str_replace_all(., "x<sub>shift</sub>", "$x_{shift}$") %>% str_replace_all(., "ν", "$\\\\nu$") %>% str_replace_all(., "y<sub>max</sub>", "y$_{max}$") %>% str_replace_all(., "x<sub>max</sub>", "x$_{max}$")
colnames(df) <- kableExtra::linebreak(colnames(df), align = "c")
for(i in 2:ncol(df)){
df[,i] <- df[,i] %>% str_replace_all(., "^<b>", "\\\\textbf\\{") %>% str_replace_all(., "</b>", "\\}")
}
df[,1] <- str_replace_all(df[,1], "_", "\\\\char`_") %>% str_replace_all(., "%", "\\\\%")
df %>% knitr::kable("latex", align = "c", booktabs = T, escape = F, linesep = "", caption = caption, longtable = TRUE) %>% kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header", "striped"), full_width = F, position = "center", font_size = 8)
}
}
Summary
The dataset contains r nrow(flFitRes[["time"]]) samples.\
r length(levels(data[["fluorescence"]][["condition"]])) conditions were identified:\
r colFmt(levels(data[["fluorescence"]][["condition"]]), 'NavyBlue')\
r length(levels(data[["fluorescence"]][["concentration"]])) different concentrations were identified:\
r colFmt(levels(data[["fluorescence"]][["concentration"]]), 'NavyBlue')\
The following parameters were used to fit the data:
- minimum density considered:
r colFmt(ifelse(!is.null(control$min.density), control$min.density, "none"), 'NavyBlue')
- minimum time considered for linear and spline fits (t0):
r colFmt(control$t0, 'NavyBlue')
- maximum density considered:
r colFmt(ifelse(!is.null(control$max.density), control$max.density, "none"), 'NavyBlue')
- maximum time considered for linear and spline fits (tmax):
r colFmt(control$tmax, 'NavyBlue')
- data type used as independent variable (x):
r colFmt(control$x_type, 'NavyBlue')
r if(control$x_type == "time"){paste0("* normalized fluorescence used for fits:")} r if(control$x_type == "time"){colFmt(control$norm_fl, 'NavyBlue')}
- log-transform fluorescence values for spline fits:
r colFmt(control$log.y.spline, 'NavyBlue')
- log-transform fluorescence values for linear fits:
r colFmt(control$log.y.lin, 'NavyBlue')
- log-transform x values for spline fits:
r colFmt(control$log.x.spline, 'NavyBlue')
- log-transform x values for linear fits:
r colFmt(control$log.x.lin, 'NavyBlue')
- perform dose-response analysis:
r colFmt(ec50, 'NavyBlue')
r if(ec50){paste0("* method used for dose-response analysis:")} r if(ec50){colFmt(control$dr.method, 'NavyBlue')}
r if(ec50){paste0("* parameter used for dose-response analysis:")} r if(ec50){colFmt(control$dr.parameter, 'NavyBlue')}
- growth threshold:
r colFmt(control$growth.thresh, 'NavyBlue') r colFmt('* start_density', 'NavyBlue')
r if(any(c("l") %in% control$fit.opt)){paste0("* sliding window size in linear regression:")} r if(any(c("l") %in% control$fit.opt)){colFmt(ifelse(!is.null(control$lin.h), control$lin.h, "automated calculation"), 'NavyBlue')}
r if(any(c("l") %in% control$fit.opt)){paste0("* R2 threshold for linear regression:")} r if(any(c("l") %in% control$fit.opt)){colFmt(control$lin.R2, 'NavyBlue')}
r if(any(c("l") %in% control$fit.opt)){paste0("* RSD threshold for linear regression:")} r if(any(c("l") %in% control$fit.opt)){colFmt(control$lin.RSD, 'NavyBlue')}
r if(any(c("l") %in% control$fit.opt)){paste0("* Relative ΔY threshold for linear regression:")} r if(any(c("l") %in% control$fit.opt)){colFmt(control$lin.dY, 'NavyBlue')}
\pagebreak
Graphical overview - Fluorescence
suppressWarnings(
plot.dual(flFitRes, fluorescence = "fl", export = export, legend.position = "bottom", legend.ncol = 4)
)
Graphical overview - Normalized fluorescence
suppressWarnings(
plot.dual(flFitRes, fluorescence = "norm.fl", export = export, legend.position = "bottom", legend.ncol = 4)
)
r if((length(flFitRes$data$density)>1 && length(flFitRes$data$fluorescence)>1) || (length(flFitRes$data$density)>1 && length(flFitRes$data$norm.fluorescence)>1) || (length(flFitRes$data$density)>1 && length(flFitRes$data$norm.fluorescence2)>1)){"\\pagebreak"}
Fluorescence fit results
Grouped results
if(any(c("l") %in% control$fit.opt)){
if(!all(is.na(res.table.fl$lambda.linfit))){
table_linear_group <- table_group_fluorescence_linear(res.table.fl)
table_linear_group <- as.data.frame(apply(table_linear_group, 2, function(x) str_replace_all(x, "NA ± NA", "")))
table_linear_group[is.na(table_linear_group)] <- ""
if (knitr::is_html_output()) {
knit_table(table_linear_group, caption = ifelse(control$biphasic, "Linear Fit (Values in parentheses indicate parameters for secondary growth phase)", "Linear Fit"))
} else {
knit_table(table_linear_group, caption = ifelse(control$biphasic, "Linear Fit (Values in parentheses indicate parameters for secondary growth phase)", "Linear Fit")) %>% kableExtra::column_spec(column=1, width = "4cm")
}
}
}
try(suppressWarnings(
plot.parameter(flFitRes, param = "max_slope.linfit", export = export, out.dir = normalizePath(wd.plots)))
)
try(suppressWarnings(
plot.parameter(flFitRes, param = "lambda.linfit", export = export, out.dir = normalizePath(wd.plots)))
)
try(suppressWarnings(
plot.parameter(flFitRes, param = "dY.linfit", export = export, out.dir = normalizePath(wd.plots)))
)
r if(any(c("l") %in% control$fit.opt)){"\\clearpage"}
if(any(c("s") %in% control$fit.opt)){
if(!all(is.na(res.table.fl$lambda.spline))){
table_spline_group <- table_group_fluorescence_spline(res.table.fl)
# if ( control$nboot.gc > 1 ){
# table_spline <- cbind(table_spline, data.frame("slope<sub>max</sub><br>boot" = paste(round(as.numeric(res.table.fl$max_slope.bt), 3),"\u00B1", round(as.numeric(res.table.fl$stdmax_slope.bt),3)),
# "λ<br>boot" = paste(round(as.numeric(res.table.fl$lambda.bt), 2),"\u00B1", round(as.numeric(res.table.fl$stdlambda.bt),2)),
# "A<br>boot" = paste(round(as.numeric(res.table.fl$A.bt), 3),"\u00B1", round(as.numeric(res.table.fl$stdA.bt),3)),
# stringsAsFactors = F, check.names = F))
# }
table_spline_group <- as.data.frame(apply(table_spline_group, 2, function(x) str_replace_all(x, "NA ± NA", "")))
table_spline_group[is.na(table_spline_group)] <- ""
if (knitr::is_html_output()) {
knit_table(table_spline_group, caption = ifelse(control$biphasic, "Smooth Spline Fit (Values in parentheses indicate parameters for secondary growth phase)", "Smooth Spline Fit"))
} else {
knit_table(table_spline_group, caption = ifelse(control$biphasic, "Smooth Spline Fit (Values in parentheses indicate parameters for secondary growth phase)", "Smooth Spline Fit")) %>% kableExtra::column_spec(column=1, width = "4cm")
}
}
}
try(suppressWarnings(
plot.parameter(flFitRes, param = "max_slope.spline", export = export, out.dir = normalizePath(wd.plots)))
)
try(suppressWarnings(
plot.parameter(flFitRes, param = "lambda.spline", export = export, out.dir = normalizePath(wd.plots)))
)
try(suppressWarnings(
plot.parameter(flFitRes, param = "dY.spline", export = export, out.dir = normalizePath(wd.plots)))
)
\clearpage
Individual samples
if(any(c("l") %in% control$fit.opt)){
if(!all(is.na(res.table.fl$lambda.linfit))){
table_linear <- data.frame("Sample|Replicate|Conc." = paste(res.table.fl$TestId, res.table.fl$AddId, res.table.fl$concentration, sep = "|"),
"slope<sub>max</sub>" = ifelse(res.table.fl$max_slope.linfit==0 | is.na(res.table.fl$max_slope.linfit), "", ifelse(is.na(res.table.fl$max_slope2.linfit), round(as.numeric(res.table.fl$max_slope.linfit), 3), paste0("<b>", round(as.numeric(res.table.fl$max_slope.linfit), 3), "</b>", " (", round(as.numeric(res.table.fl$max_slope2.linfit), 3), ")"))),
"λ" = round(as.numeric(res.table.fl$lambda.linfit), 2),
"Δy" = round(as.numeric(res.table.fl$dY.linfit), 3),
"y<sub>max</sub>" = round(as.numeric(res.table.fl$A.linfit), 3),
"x<sub>start</sub><br>(slope<sub>max</sub>)" = ifelse(is.na(res.table.fl$max_slope2.linfit), round(as.numeric(res.table.fl$x.mu.start.linfit), 2), paste0("<b>", round(as.numeric(res.table.fl$x.mu.start.linfit), 2), "</b>", " (", round(as.numeric(res.table.fl$x.mu2.start.linfit), 2), ")")),
"x<sub>end</sub><br>(slope<sub>max</sub>)" = ifelse(is.na(res.table.fl$max_slope2.linfit), round(as.numeric(res.table.fl$x.mu.end.linfit), 2), paste0("<b>", round(as.numeric(res.table.fl$x.mu.end.linfit), 2), "</b>", " (", round(as.numeric(res.table.fl$x.mu2.end.linfit), 2), ")")),
"R<sup>2</sup><br>(linear fit)" = ifelse(is.na(res.table.fl$max_slope2.linfit), round(as.numeric(res.table.fl$r2mu.linfit), 3), paste0("<b>", round(as.numeric(res.table.fl$r2mu.linfit), 3), "</b>", " (", round(as.numeric(res.table.fl$r2mu2.linfit), 3), ")")),
stringsAsFactors = F, check.names = F)
table_linear <- as.data.frame(apply(table_linear, 2, function(x) str_replace_all(x, "NA ± NA", "")))
table_linear[is.na(table_linear)] <- ""
if (knitr::is_html_output()) {
knit_table(table_linear, caption = ifelse(control$biphasic, "Linear Fit (Values in parentheses indicate parameters for secondary growth phase)", "Linear Fit"))
} else {
knit_table(table_linear, caption = ifelse(control$biphasic, "Linear Fit (Values in parentheses indicate parameters for secondary growth phase)", "Linear Fit")) %>% kableExtra::column_spec(column=1, width = "4cm")
}
}
}
r if(any(c("l") %in% control$fit.opt)){"\\clearpage"}
if(any(c("s") %in% control$fit.opt)){
if(!all(is.na(res.table.fl$lambda.spline))){
table_spline <- data.frame("Sample|Replicate|Conc." = paste(res.table.fl$TestId, res.table.fl$AddId, res.table.fl$concentration, sep = "|"),
"slope<sub>max</sub>" = ifelse(res.table.fl$max_slope.spline==0 | is.na(res.table.fl$max_slope.spline), "", ifelse(is.na(res.table.fl$max_slope2.spline), round(as.numeric(res.table.fl$max_slope.spline), 3), paste0("<b>", round(as.numeric(res.table.fl$max_slope.spline), 3), "</b>", " (", round(as.numeric(res.table.fl$max_slope2.spline), 3), ")"))),
"λ" = round(as.numeric(res.table.fl$lambda.spline), 2),
"y<sub>max</sub>" = round(as.numeric(res.table.fl$A.spline), 3),
"Δy" = round(as.numeric(res.table.fl$dY.spline), 3),
"x<sub>max</sub>" = ifelse(is.na(res.table.fl$max_slope2.spline), round(as.numeric(res.table.fl$x.max.spline), 2), paste0("<b>", round(as.numeric(res.table.fl$x.max.spline), 2), "</b>", " (", round(as.numeric(res.table.fl$x.max2.spline), 2), ")")),
"smooth.<br>fac" = res.table.fl$smooth.spline,
stringsAsFactors = F, check.names = F)
# if ( control$nboot.gc > 1 ){
# table_spline <- cbind(table_spline, data.frame("slope<sub>max</sub><br>boot" = paste(round(as.numeric(res.table.fl$max_slope.bt), 3),"\u00B1", round(as.numeric(res.table.fl$stdmax_slope.bt),3)),
# "λ<br>boot" = paste(round(as.numeric(res.table.fl$lambda.bt), 2),"\u00B1", round(as.numeric(res.table.fl$stdlambda.bt),2)),
# "A<br>boot" = paste(round(as.numeric(res.table.fl$A.bt), 3),"\u00B1", round(as.numeric(res.table.fl$stdA.bt),3)),
# stringsAsFactors = F, check.names = F))
# }
table_spline <- as.data.frame(apply(table_spline, 2, function(x) str_replace_all(x, "NA ± NA", "")))
table_spline[is.na(table_spline)] <- ""
if (knitr::is_html_output()) {
knit_table(table_spline, caption = ifelse(control$biphasic, "Smooth Spline Fit (Values in parentheses indicate parameters for secondary growth phase)", "Smooth Spline Fit"))
} else {
knit_table(table_spline, caption = ifelse(control$biphasic, "Smooth Spline Fit (Values in parentheses indicate parameters for secondary growth phase)", "Smooth Spline Fit")) %>% kableExtra::column_spec(column=1, width = "4cm")
}
}
}
\clearpage
Plots
r if(any(c("l") %in% control$fit.opt)){"Linear Fits"}
if(any(c("l") %in% control$fit.opt)){
plot.flFitLinear2 <- function(flFittedLinear, log="", which=c("fit", "diagnostics"), title = "Linear fit",
plot = TRUE, export = FALSE, height = ifelse(which=="fit", 7, 5),
width = ifelse(which=="fit", 9, 9), out.dir = NULL, ...)
{
if(is(flFittedLinear) != "flFitLinear") stop("flFitLinear needs to be an object created with flFitLinear().")
which <- match.arg(which)
p <- function(){
switch(which,
fit = {
control <- flFittedLinear$control
if(control$x_type == "time"){
if(control$norm_fl){
if(control$log.y.lin){
ylab = "norm. Ln[FL/FL(0)]"
} else {
ylab = "norm. FL"
}
} else {
if(control$log.y.lin){
ylab = "Ln[FL/FL(0)]"
} else {
ylab = "Fluorescence"
}
}
} else {
if(control$log.y.lin){
ylab = "Ln[FL/FL(0)]"
} else {
ylab = "Fluorescence"
}
}
if(control$x_type == "time"){
if(control$log.x.lin){
xlab <- "Ln(time + 1)"
} else {
xlab <- "Time"
}
} else {
if(control$log.x.lin){
xlab <- "Ln(density + 1)"
} else {
xlab <- "Density"
}
}
par(mar=c(5.1, 4.1 + nchar(round(max(flFittedLinear$"filt.fl")))/3.5, 4.1, 2.1), cex.lab=1.5)
plot(flFittedLinear$"filt.fl" ~ flFittedLinear$"filt.x", xlab=xlab, ylab = "", col = scales::alpha("black", 0.5),
log=log, las=1, main = title, yaxt="n", xaxt="n", ...)
title(ylab = ylab, line = 3 + nchar(round(max(flFittedLinear$"filt.fl")))/4)
axis(1,cex.axis=1.3)
axis(2,cex.axis=1.3, las=1)
try(points(flFittedLinear$filt.fl[flFittedLinear$ndx] ~ flFittedLinear$filt.x[flFittedLinear$ndx], pch=21, col="black", bg="red"))
## lag phase
lag <- flFittedLinear$par["lag"]
coef_ <- flFittedLinear$par
if(flFittedLinear$fitFlag2){
try(points(flFittedLinear$raw.fl[flFittedLinear$ndx2] ~ flFittedLinear$raw.x[flFittedLinear$ndx2], pch=21, col="black", bg=ggplot2::alpha("magenta3", 1)))
lag2 <- flFittedLinear$par["lag2"]
if(lag2 < lag && lag2 > flFittedLinear$raw.x[1]){
try(time2 <- seq(lag2, max(flFittedLinear$"raw.x"), length=200), silent = T)
try(time <- seq(coef_["x.max_start"]-0.25*(coef_["x.max_end"]-coef_["x.max_start"]), max(flFittedLinear$"raw.x"), length=200), silent = T)
try(lines(time2, grow_linear(time2, c(y0=unname(coef_["y0_lm2"]), max_slope=unname(coef_["max_slope2"])))[,"y"], lty=2, lwd=2, col=ggplot2::alpha("magenta3", 0.7), ...), silent = T)
try(lines(c(min(flFittedLinear$"filt.x"[1]), lag2), rep(flFittedLinear$"filt.fl"[1], 2), lty=2, lwd=2, col=ggplot2::alpha("magenta3", 0.7)), silent = T)
try(lines(time, grow_linear(time, c(y0=unname(coef_["y0_lm"]), max_slope=unname(coef_["max_slope"])))[,"y"], lty=2, lwd=2, col=ggplot2::alpha("firebrick3", 0.7), ...), silent = T)
} else {
try(time2 <- seq(coef_["x.max2_start"]-0.25*(coef_["x.max2_end"]-coef_["x.max2_start"]), max(flFittedLinear$"raw.x"), length=200), silent = T)
try(time <- seq(coef_["x.max_start"]-0.25*(coef_["x.max_end"]-coef_["x.max_start"]), max(flFittedLinear$"raw.x"), length=200), silent = T)
try(lines(time, grow_linear(time, c(y0=unname(coef_["y0_lm"]), max_slope=unname(coef_["max_slope"])))[,"y"], lty=2, lwd=2, col=ggplot2::alpha("firebrick3", 0.7), ...), silent = T)
try(lines(time2, grow_linear(time2, c(y0=unname(coef_["y0_lm2"]), max_slope=unname(coef_["max_slope2"])))[,"y"], lty=2, lwd=2, col=ggplot2::alpha("magenta3", 0.7), ...), silent = T)
}
} else if(flFittedLinear$fitFlag){
if(lag < flFittedLinear$raw.x[flFittedLinear$ndx[1]]){
try(time <- seq(coef_["x.max_start"]-0.25*(coef_["x.max_end"]-coef_["x.max_start"]), max(flFittedLinear$"filt.x"), length=200), silent = T)
try(lines(time, grow_linear(time, coef_)[,"y"], lty=2, lwd=2, col=ggplot2::alpha("firebrick3", 0.7), ...), silent = T)
} else {
try(time <- seq(flFittedLinear$filt.x[flFittedLinear$ndx[1]]/2, max(flFittedLinear$"filt.x"), length=200), silent = T)
try(lines(time, grow_linear(time, coef_)[,"y"], lty=2, lwd=2, col=ggplot2::alpha("firebrick3", 0.7), ...), silent = T)
}
}
},
diagnostics = {
opar <- par(no.readonly = TRUE)
on.exit(par(opar))
par(mfrow=c(1,2))
## residuals vs. fitted
obs <- flFittedLinear$log.data
sim <- grow_linear(flFittedLinear$"raw.x", flFittedLinear$par)
plot(flFittedLinear$fit[["residuals"]] ~ fitted(flFittedLinear$fit), xlab="fitted", ylab="residuals")
abline(h=0, col="grey")
## normal q-q-plot
qqnorm(flFittedLinear$fit[["residuals"]])
qqline(flFittedLinear$fit[["residuals"]])
}
)
}
if (export == TRUE){
w <- width
h <- height
out.dir <- ifelse(is.null(out.dir), paste0(getwd(), "/Plots"), out.dir)
dir.create(out.dir, showWarnings = F)
grDevices::png(paste0(out.dir, "/", paste(flFittedLinear$gcID, collapse = "_"), "_LinFitPlot.png"),
width = w, height = h, units = 'in', res = 300)
p()
invisible(grDevices::dev.off())
suppressWarnings(grDevices::pdf(paste0(out.dir, "/", paste(flFittedLinear$gcID, collapse = "_"), "_LinFitPlot.pdf")))
p()
invisible(grDevices::dev.off())
}
if (plot == TRUE){
suppressWarnings(
p()
)
}
}
plot.ggLinear <- function(){
if(flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){
x <- flFitRes[["flFit"]][["flFittedLinear"]][[i]]
plot.flFitLinear2(flFittedLinear = x, title = gsub(" \\| NA", "", paste(x$ID, collapse = " | ")))
}
}
plotdir <- ifelse(export == TRUE, wd.plots, paste0(str_replace_all(tempdir(), "\\\\", "/"),"/Plots"))
if(all(c('pdf', 'html') %in% format)){
if (knitr::is_latex_output()) {
# foreach(i = 1:length(flFitRes[["flFit"]][["flFittedLinear"]]),
# .packages = "ggplot2") %dopar% {
# if(flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){
# pdf(file=paste0(plotdir, "/PlotLinear_", gsub("∙", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))))), ".pdf"), width = 8, height = 6); plot.ggLinear(); invisible(dev.off())
# }
# }
for(i in 1:length(flFitRes[["flFit"]][["flFittedLinear"]])){
if(length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))>0 && flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){
suppressWarnings(pdf(file=paste0(plotdir, "/PlotLinear_", gsub("∙", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))))), ".pdf"), width = 8, height = 6))
plot.ggLinear()
invisible(grDevices::dev.off())
}
}
}
} else{
# foreach(i = 1:length(flFitRes[["flFit"]][["flFittedLinear"]]),
# .packages = "ggplot2") %dopar% {
# if(flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){
# pdf(file=paste0(plotdir, "/PlotLinear_", gsub("∙", "_", gsub("%", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedLinear"]])[i])))))), ".pdf"), width = 8, height = 6); plot.ggLinear(); invisible(dev.off())
# }
# }
for(i in 1:length(flFitRes[["flFit"]][["flFittedLinear"]])){
if(length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))==0 && flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){
suppressWarnings(pdf(file=paste0(plotdir, "/PlotLinear_", gsub("∙|>|<|\\(|\\)", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))))), ".pdf"), width = 8, height = 6))
plot.ggLinear()
invisible(grDevices::dev.off())
}
}
}
Files_list <- list.files(path = plotdir,
pattern = "^PlotLinear_",
full.names = TRUE)
sort.ndx <- match(gsub("∙|>|<|\\(|\\)", "_", gsub("%", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes$flFit$flFittedLinear))))))), gsub(".+PlotLinear_","", gsub(".pdf", "", Files_list)))
sort.ndx <- sort.ndx[!is.na(sort.ndx)]
knitr::include_graphics(Files_list[sort.ndx], dpi = 300, error = F)
}
r if(any(c("s") %in% control$fit.opt)){"\\clearpage"}
r if(any(c("s") %in% control$fit.opt)){"Nonparametric Fits"}
if(any(c("s") %in% control$fit.opt)) {
plot.flFitSpline2 <- function(flFitSpline, add=FALSE, raw = TRUE, slope=TRUE, deriv = T, spline = T, log.y = F,
pch=1, colData=1, colSpline="dodgerblue3", cex=1, lwd = 0.7,
plot = TRUE, export = FALSE, width = 8, height = ifelse(deriv == TRUE, 8, 6),
out.dir = NULL, ...)
{
if(is(flFitSpline) != "flFitSpline") stop("flFitSpline needs to be an object created with flFitSpline().")
# /// check input parameters
if (is.logical(add)==FALSE) stop("Need logical value for: add")
if (is.logical(slope)==FALSE) stop("Need logical value for: slope")
if (is.numeric(pch)==FALSE) stop("Need numeric value for: pch")
if (is.numeric(cex)==FALSE) stop("Need numeric value for: cex")
# /// check if a data fit is available
if ((is.na(flFitSpline$fitFlag)==TRUE)|(flFitSpline$fitFlag==FALSE)){
warning("plot.flFitSpline: no data fit available!")
}
else{
if (add==TRUE){
if(spline == TRUE){
# /// try to plot data fit
if ((flFitSpline$control$log.x.spline==FALSE) && (flFitSpline$control$log.y.spline==FALSE)){
try( lines(flFitSpline$fit.x, flFitSpline$fit.fl, sub=flFitSpline$name.fit, col=colSpline, type="l", lwd=2.8*lwd) )
}
if ((flFitSpline$control$log.x.spline==FALSE) && (flFitSpline$control$log.y.spline==TRUE)){
try( lines(flFitSpline$fit.x, flFitSpline$fit.fl, sub=flFitSpline$name.fit, col=colSpline, type="l", lwd=2.8*lwd) )
}
if ((flFitSpline$control$log.x.spline==TRUE) && (flFitSpline$control$log.y.spline==FALSE)){
try( lines(flFitSpline$fit.x, flFitSpline$fit.fl, sub=flFitSpline$name.fit, col=colSpline, type="l", lwd=2.8*lwd ) )
}
if ((flFitSpline$control$log.x.spline==TRUE) && (flFitSpline$control$log.y.spline==TRUE)){
try( lines(flFitSpline$fit.x, flFitSpline$fit.fl, sub=flFitSpline$name.fit, col=colSpline, type="l", lwd=2.8*lwd) )
}
# /// add tangent at maximum slope
if (slope==TRUE){
mu <- as.numeric(flFitSpline$parameters$max_slope)
lambda <- as.numeric(flFitSpline$parameters$lambda)
x <- seq(lambda, max(flFitSpline$"fit.x"), length=200)
y_tangent <- flFitSpline$parameters["b.tangent"][[1]]+x*mu
try(lines(x, y_tangent, lty=2, lwd=2, col=ggplot2::alpha(colSpline, 0.85), ...))
try(lines(c(min(flFitSpline$"raw.x"[1]), lambda), rep(flFitSpline$"raw.fl"[1], 2), lty=2, lwd=2,
col=ggplot2::alpha(colSpline, 0.7)))
}
}
if (deriv == TRUE){
if ((flFitSpline$control$log.x.spline==FALSE)){
try( lines(flFitSpline$spline.deriv1$x, flFitSpline$spline.deriv1$y, xlab="", ylab="", col = colSpline) )
}
if ((flFitSpline$control$log.x.spline==TRUE)){
try( lines(flFitSpline$spline.deriv1$x, flFitSpline$spline.deriv1$y, xlab="", ylab="", col = colSpline) )
}
}
} # if (add == TRUE)
else {
coef <- flFitSpline[["parameters"]]
lag <- coef["lambda"][[1]][1]
# correct for log transformation
if(flFitSpline$control$log.y.spline == TRUE){
fit.fl <-
c(rep(NA, length(flFitSpline[["raw.fl"]]) - length(flFitSpline[["fit.fl"]])), exp(flFitSpline[["fit.fl"]]) *
flFitSpline[["raw.fl"]][1])
} else {
fit.fl <- c(rep(NA, length(flFitSpline[["raw.fl"]]) - length(flFitSpline[["fit.fl"]])), flFitSpline[["fit.fl"]])
}
df.raw <- data.frame("x" = flFitSpline[["x.in"]],
"data" = flFitSpline[["fl.in"]])
df.fit <- data.frame("fit.x" = c(rep(NA, length(flFitSpline[["raw.x"]])-length(flFitSpline[["fit.x"]])), flFitSpline[["fit.x"]]),
"fit.fl" = fit.fl)
x.label = if(flFitSpline$control$x_type == "density"){
"Density"
} else {
"Time"
}
y.label <- if(flFitSpline$control$norm_fl == TRUE && flFitSpline$control$x_type == "time"){
"Norm. fluorescence"
} else {
"Fluorescence"
}
p <- ggplot(NULL, aes(x=x, y=data)) +
geom_line(aes(x=fit.x, y = fit.fl, color = "spline"), data = df.fit, size = lwd) +
xlab(x.label) +
ylab(label = y.label) +
theme_classic(base_size = 16) +
ggtitle(gsub(" \\| NA", "", paste(flFitSpline$ID, collapse=" | "))) +
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(legend.key = element_blank(),
legend.background=element_blank(),
legend.title = element_blank(),
legend.position = c(0.90, 0.08),
plot.title = element_text(size=15),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()) +
scale_color_manual(name='Growth Model',
breaks = "Spline fit",
values=c("spline" = ggplot2::alpha(colSpline, 0.85), "Spline fit" = ggplot2::alpha(colSpline, 0.85)))
if(raw){
p <- p + geom_point(data = df.raw, shape=1, size = 2,alpha = 0.6, stroke=0.15)
}
p.yrange.end <- ggplot_build(p)$layout$panel_params[[1]]$y.range[2]
if(log.y == TRUE){
p <- p + scale_y_continuous(breaks = scales::pretty_breaks(), trans = 'log')
} else {
p <- p + scale_y_continuous(breaks = scales::pretty_breaks())
}
# /// add tangent at maximum slope
if(slope == TRUE && (flFitSpline$control$log.y.spline==F && log.y == F) ||
(flFitSpline$control$log.y.spline==T && log.y == T)){
mu <- as.numeric(coef$max_slope[1])
if(flFitSpline$fitFlag2){
lag2 <- coef$lambda2
fl.x <- flFitSpline$fit.x[which.max(flFitSpline$fit.fl)]
mu2 <- coef$max_slope2
if(lag2 < lag){
# x values for tangent at µmax
x_start.ndx <- which.min(abs(flFitSpline$fit.x-(coef$x.max-0.15*fl.x)))
x_start <- flFitSpline$fit.x[x_start.ndx]
x <- seq(x_start, max(flFitSpline$fit.x), length=200)
# y values for tangent at µmax
if(flFitSpline$control$log.y.spline){
bla <- (exp(coef["b.tangent"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu*x)
} else {
bla <- coef["b.tangent"][[1]] + (mu*x)
}
tangent.df <- data.frame("x" = x,
"y" = bla)
# x values for tangent at µmax2
x2 <- seq(ifelse(lag2<0, 0, lag2), max(flFitSpline$"fit.x"), length=200)
# y values for tangent at µmax
if(flFitSpline$control$log.y.spline){
bla2 <- (exp(coef["b.tangent2"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu2*x2)
} else {
bla2 <- coef["b.tangent2"][[1]] + (mu2*x2)
}
tangent.df2 <- data.frame("x" = x2,
"y" = bla2)
df.horizontal2 <- data.frame("x" = c(flFitSpline[["raw.x"]][1], lag2),
"y" = flFitSpline[["raw.fl"]][1])
p <- p + geom_segment(aes(x = x[which.min(abs(bla))], y = y[which.min(abs(bla))],
xend = x[which.min(abs(y - 1.1*p.yrange.end))],
yend = y[which.min(abs(y - 1.1*p.yrange.end))]),
data = tangent.df, linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5)
p <- p + geom_segment(aes(x = x[which.min(abs(bla2))], y = y[which.min(abs(bla2))],
xend = x[which.min(abs(y - 1.1*p.yrange.end))],
yend = y[which.min(abs(y - 1.1*p.yrange.end))]),
data = tangent.df2, linetype = "dashed", color = ggplot2::alpha("darkviolet", 0.85), size = 0.5)
if(!(lag2 <0)){
p <- p + geom_segment(aes(x = x[1], y = y[1], xend = x[2], yend = y[2]), data = df.horizontal2,
linetype = "dashed", color = ggplot2::alpha("darkviolet", 0.85), size = 0.5)
}
} # if(lag2 < lag)
else {
# x values for tangent at µmax
x <- seq(ifelse(lag<0, 0, lag), max(flFitSpline$"fit.x"), length=200)
# y values for tangent at µmax
if(flFitSpline$control$log.y.spline){
bla <- (exp(coef["b.tangent"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu*x)
} else {
bla <- coef["b.tangent"][[1]] + (mu*x)
}
tangent.df <- data.frame("x" = x,
"y" = bla)
df.horizontal <- data.frame("x" = c(flFitSpline[["raw.x"]][1], lag),
"y" = flFitSpline[["raw.fl"]][1])
# x values for tangent at µmax2
x2_start.ndx <- which.min(abs(flFitSpline$fit.x-(coef$x.max2-0.15*fl.x)))
x2_start <- flFitSpline$fit.x[x2_start.ndx]
x2 <- seq(x2_start, max(flFitSpline$"fit.x"), length=200)
# y values for tangent at µmax
if(flFitSpline$control$log.y.spline){
bla2 <- (exp(coef["b.tangent2"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu2*x2)
} else {
bla2 <- coef["b.tangent2"][[1]] + (mu2*x2)
}
tangent.df2 <- data.frame("x" = x2,
"y" = bla2)
p <- p + geom_segment(aes(x = x[which.min(abs(bla))], y = y[which.min(abs(bla))],
xend = x[which.min(abs(y - 1.1*p.yrange.end))],
yend = y[which.min(abs(y - 1.1*p.yrange.end))]),
data = tangent.df, linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5)
p <- p + geom_segment(aes(x = x[which.min(abs(bla2))], y = y[which.min(abs(bla2))],
xend = x[which.min(abs(y - 1.1*p.yrange.end))],
yend = y[which.min(abs(y - 1.1*p.yrange.end))]),
data = tangent.df2, linetype = "dashed", color = ggplot2::alpha("darkviolet", 0.85), size = 0.5)
# if(!(lag <0)){
# p <- p + geom_segment(aes(x = x[1], y = y[1], xend = x[2], yend = y[2]), data = df.horizontal,
# linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5)
# }
}
} # if(flFitSpline$fitFlag2)
else {
# x values for tangent
x <- seq(ifelse(lag<0, 0, lag), max(flFitSpline$"fit.x"), length=200)
# y values for tangent
if(flFitSpline$control$log.y.spline){
bla <- (exp(coef["b.tangent"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu*x)
} else {
bla <- coef["b.tangent"][[1]] + (mu*x)
}
tangent.df <- data.frame("x" = x,
"y" = bla)
df.horizontal <- data.frame("x" = c(flFitSpline[["raw.x"]][1], lag),
"y" = flFitSpline[["raw.fl"]][1])
p <- p + geom_segment(aes(x = x[which.min(abs(bla))], y = y[which.min(abs(bla))],
xend = x[which.min(abs(y - 1.1*p.yrange.end))],
yend = y[which.min(abs(y - 1.1*p.yrange.end))]),
data = tangent.df, linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5)
# if(!(lag <0)){
# p <- p + geom_segment(aes(x = x[1], y = y[1], xend = x[2], yend = y[2]), data = df.horizontal,
# linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5)
# }
} # else of if(flFitSpline$fitFlag2)
} # if(slope == TRUE && log.y == T)
# /// add panel with growth rate over x
if(deriv == TRUE){
df.mu <- data.frame(spline(flFitSpline$spline.deriv1$x, flFitSpline$spline.deriv1$y))
#add missing x values due to min.density and t0
x.missing <- df.raw[df.raw$x < df.mu$x[1], ]$x
df.mu <-
dplyr::bind_rows(data.frame(x = x.missing, y = rep(NA, length(x.missing))),
df.mu)
y.label.mu = if(flFitSpline$control$log.y.spline == TRUE){
paste0("Slope [d(Ln(F/F0))/d",x.label, "]")
} else {
paste0("Slope [dF/d", x.label,"]")
}
p.mu <- ggplot(df.mu, aes(x=x, y=y)) +
geom_line(color = colSpline, size = lwd) +
theme_classic(base_size = 15) +
xlab(x.label) +
ylab(label = y.label.mu) +
scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10))
p <- suppressWarnings(ggpubr::ggarrange(p, p.mu, ncol = 1, nrow = 2, align = "v", heights = c(2,1.1)))
}
if(export == FALSE && plot == FALSE){
return(p)
}
if (export == TRUE){
w <- width
h <- height
out.dir <- ifelse(is.null(out.dir), paste0(getwd(), "/Plots"), out.dir)
dir.create(out.dir, showWarnings = F)
grDevices::png(paste0(out.dir, "/", paste(flFitSpline$ID, collapse = "_"), "_SplineFit.png"),
width = w, height = h, units = 'in', res = 300)
print(p)
invisible(grDevices::dev.off())
suppressWarnings(grDevices::pdf(paste0(out.dir, "/", paste(flFitSpline$ID, collapse = "_"), "_SplineFit.pdf"), width = w, height = h))
print(p)
suppressWarnings(invisible(grDevices::dev.off()))
}
if (plot == TRUE){
print(p)
}
} # else of if (add == TRUE)
} # else of if ((is.na(flFitSpline$fitFlag)==TRUE)|(flFitSpline$fitFlag==FALSE))
}
#__________________ end function definition ______________
plotdir <- ifelse(export == TRUE, wd.plots, paste0(str_replace_all(tempdir(), "\\\\", "/"), "/Plots"))
plot.ggSpline <- function() {
tryCatch({
if (flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) {
pdf_filename <- paste0(plotdir, "/PlotSpline_", gsub("∙|\\n|\\r", "_", gsub("%", "_", gsub("\\?", "_", gsub(" ", "_",
gsub("\\/", "_", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedSplines"]])[i])))))), ".pdf")
pdf(file = pdf_filename)
plot.flFitSpline2(x)
}
}, finally = {
invisible(grDevices::dev.off()) # Ensure the device is closed
})
}
if(all(c('pdf', 'html') %in% format)){
if (knitr::is_latex_output()) {
if(parallelize){
foreach(i = 1:length(flFitRes[["flFit"]][["flFittedSplines"]]),
.packages = "ggplot2") %dopar% {
if (length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedSplines"]])[i]))==0 && flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) {
suppressWarnings( plot.ggSpline() )
}
}
} else {
for(i in 1:length(flFitRes[["flFit"]][["flFittedSplines"]])){
if (length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedSplines"]])[i]))==0 && flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) {
suppressWarnings( plot.ggSpline() )
}
}
}
}
} else { # of if(all(c('pdf', 'html') %in% format))
if(parallelize){
foreach(i = 1:length(flFitRes[["flFit"]][["flFittedSplines"]]),
.packages = "ggplot2") %dopar% {
if (length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedSplines"]])[i]))==0 && flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) {
suppressWarnings( plot.ggSpline() )
}
}
} else {
for(i in 1:length(flFitRes[["flFit"]][["flFittedSplines"]])){
if (length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedSplines"]])[i]))==0 && flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) {
suppressWarnings( plot.ggSpline() )
}
}
}
}
Files_list <- list.files(path = plotdir,
pattern = "^PlotSpline_",
full.names = TRUE)
sort.ndx <-
match(gsub("∙|>|<|\\(|\\)", "_", gsub("%", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(
" \\| ", "_", names(flFitRes$flFit$flFittedSplines)
)))))), gsub(".+PlotSpline_", "", gsub(".pdf", "", Files_list)))
sort.ndx <- sort.ndx[!is.na(sort.ndx)]
knitr::include_graphics(Files_list[sort.ndx], dpi = 300, error = F)
}
r if(ec50){"\\clearpage"}
r if(ec50 && control$dr.method == "spline"){"Dose-response analysis - Spline fit"} else if (ec50 && control$dr.method == "model"){"Dose-response analysis - Model fit"}
cat(paste0("_", length(flFitRes$drFit$drTable$Test), "_ conditions were identified:\n",
paste(colFmt(flFitRes$drFit$drTable$Test, 'NavyBlue'), "\n", collapse = ", ")))
cat(" \n")
ec50.df <- data.frame()
for(i in 1:length(flFitRes$drFit$drFittedSplines)){
ec50.df <- plyr::rbind.fill(ec50.df, data.frame("Condition" = names(flFitRes$drFit$drFittedSplines)[i],
"EC50" = round(flFitRes$drFit$drFittedSplines[[i]]$parameters$EC50, 3),
"Response" = round(flFitRes$drFit$drFittedSplines[[i]]$parameters$yEC50, 3))
)
}
names(ec50.df)[3] <- paste0("Response (", flFitRes$drFit$drFittedSplines[[1]]$parameters$test, ")")
knit_table(ec50.df, caption = "Dose-Response Analysis - Spline Fits")
suppressWarnings(
plot.drFit(flFitRes$drFit, export = export)
)
boot.ec50.df <- data.frame()
for (i in 1:length(flFitRes$drFit$drBootSplines)){
boot.ec50.df <-
plyr::rbind.fill(
boot.ec50.df,
data.frame(
"Condition" = flFitRes$drFit$drTable$Test[i],
"EC50.boot" = paste(round(as.numeric(flFitRes$drFit$drTable$drboot.meanEC50[i]), 3),"\u00B1", round(as.numeric(flFitRes$drFit$drTable$drboot.sdEC50[i]),3)),
"Response.boot" = paste(round(as.numeric(flFitRes$drFit$drTable$drboot.meanEC50y[i]), 3),"\u00B1", round(as.numeric(flFitRes$drFit$drTable$drboot.sdEC50y[i]),3))
)
)
}
knit_table(boot.ec50.df, caption = "Dose-Response Analysis - Bootstrapping")
for(i in 1:length(flFitRes$drFit$drBootSplines)){
if(flFitRes$drFit$drBootSplines[[i]]$bootFlag == TRUE){
plot.drBootSpline(flFitRes$drFit$drBootSplines[[i]], width = 6, height = 4.5, export = export, out.dir = normalizePath(wd.plots))
}
}
cat(paste0("_", length(flFitRes$drFit$drTable$Test), "_ conditions were identified:\n",
paste(colFmt(flFitRes$drFit$drTable$Test, 'NavyBlue'), collapse = ", ")))
cat(" \n")
ec50.df <- data.frame()
for(i in 1:length(flFitRes$drFit$drFittedModels)){
ec50.df <- plyr::rbind.fill(ec50.df, data.frame("Condition" = names(flFitRes$drFit$drFittedModels)[i],
"K" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$K.orig, 3),
"y.min" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$y.min, 3),
"y.max" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$y.max, 3),
"fold change" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$fc, 3),
"n" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$n, 3),
"yEC50" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$yEC50.orig, 3))
)
}
names(ec50.df)[7] <- paste0("Response (", flFitRes$drFit$drFittedModels[[1]]$parameters$test, ")")
knit_table(ec50.df, caption = "Dose-Response Analysis - Spline Fits")
for(i in 1:length(flFitRes[["drFit"]][["drFittedModels"]])){
try(
suppressWarnings(
plot.drFitFLModel(flFitRes$drFit$drFittedModels[[i]], export = export)
)
)
}
suppressWarnings(
plot.dr_parameter(flFitRes, param = "K", export = export)
)
suppressWarnings(
plot.dr_parameter(flFitRes, param = "fc", export = export)
)
suppressWarnings(
plot.dr_parameter(flFitRes, param = "y.min", export = export)
)
suppressWarnings(
plot.dr_parameter(flFitRes, param = "y.max", export = export)
)
r if((!is.null(mean.grp) | !is.null(mean.conc)) && (!is.na(mean.grp) | !is.na(mean.conc)) ){"\\clearpage"}
r if((!is.null(mean.grp) | !is.null(mean.conc)) && (!is.na(mean.grp) | !is.na(mean.conc)) ){"Group average plots"}
if("all" %in% mean.grp){
if(length(flFitRes$flFit$flFittedSplines[[1]]$spline)>1){
logy <- control$log.y.spline
suppressWarnings(
plot.flFitRes(flFitRes, basesize = 15, export = export, plot=TRUE, log.y = logy, mean = T, out.dir = normalizePath(wd.plots), legend.position = "bottom", legend.ncol = 4)
)
}
} else if(!is.null(mean.grp) && !is.na(mean.grp)){
for(i in 1:length(mean.grp)){
if(length(grep(mean.grp[i], as.character(names(flFitRes$flFit$flFittedSplines))))>0){
suppressWarnings(
plot.flFitRes(flFitRes, names = unlist(mean.grp[i]), basesize = 15, export = export, plot=TRUE, log.y = T, mean = T, out.dir = normalizePath(wd.plots), legend.position = "bottom", legend.ncol = 4)
)
}
}
}
if(!is.null(mean.conc) && !is.na(mean.conc)){
for(i in 1:length(mean.conc)){
if(length(grep(mean.conc[i], str_extract(names(flFitRes$flFit$flFittedSplines), "[:alnum:]+$")))>0){
suppressWarnings(
plot.flFitRes(flFitRes, conc = unlist(mean.conc[i]), basesize = 15, export = export, plot=TRUE, log.y = T, mean = T, out.dir = normalizePath(wd.plots), legend.position = "bottom", legend.ncol = 4)
)
}
}
}
Try the QurvE package in your browser
Any scripts or data that you put into this service are public.
QurvE documentation built on May 29, 2024, 3 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
dir.create(paste0(tempdir(),"/Plots"), showWarnings = F) wd.plots <- paste0(wd,"/Plots") if(parallelize){ library(doParallel, quietly = TRUE) library(foreach, quietly = TRUE) cl <- parallel::makeCluster(parallel::detectCores(all.tests = FALSE, logical = TRUE)-1) doParallel::registerDoParallel(cl) } knitr::opts_chunk$set(dev = "pdf") knitr::opts_chunk$set(tidy.opts=list(width.cutoff=80), tidy=TRUE) knit_table <- function(df, caption){ if (knitr::is_html_output()) { DT::datatable(df, caption = caption, filter = 'top', escape = FALSE, extensions = c('FixedColumns',"FixedHeader"), options = list(scrollX = FALSE, paging=TRUE, pageLength = 15, fixedHeader=TRUE)) } else { colnames(df) <- colnames(df) %>% str_replace_all(.,"<br>", "\n") %>% str_replace_all(., "_", "\\\\char`_") %>% str_replace_all(., "slope<sub>max</sub>", "$slope_{max}$") %>% str_replace_all(., "λ", "$\\\\lambda$") %>% str_replace_all(., "Δ", "$\\\\Delta$") %>% str_replace_all(., "x<sub>start</sub>", "$x_{start}$") %>% str_replace_all(., "x<sub>D</sub>", "$x_{D}$") %>% str_replace_all(., "x<sub>end</sub>", "$x_{end}$") %>% str_replace_all(., "R<sup>2</sup>", "$R^2$") %>% str_replace_all(., "α", "$\\\\alpha$") %>% str_replace_all(., "x<sub>shift</sub>", "$x_{shift}$") %>% str_replace_all(., "ν", "$\\\\nu$") %>% str_replace_all(., "y<sub>max</sub>", "y$_{max}$") %>% str_replace_all(., "x<sub>max</sub>", "x$_{max}$") colnames(df) <- kableExtra::linebreak(colnames(df), align = "c") for(i in 2:ncol(df)){ df[,i] <- df[,i] %>% str_replace_all(., "^<b>", "\\\\textbf\\{") %>% str_replace_all(., "</b>", "\\}") } df[,1] <- str_replace_all(df[,1], "_", "\\\\char`_") %>% str_replace_all(., "%", "\\\\%") df %>% knitr::kable("latex", align = "c", booktabs = T, escape = F, linesep = "", caption = caption, longtable = TRUE) %>% kableExtra::kable_styling(latex_options = c("hold_position", "repeat_header", "striped"), full_width = F, position = "center", font_size = 8) } }
Summary
The dataset contains r nrow(flFitRes[["time"]]) samples.\
r length(levels(data[["fluorescence"]][["condition"]])) conditions were identified:\
r colFmt(levels(data[["fluorescence"]][["condition"]]), 'NavyBlue')\
r length(levels(data[["fluorescence"]][["concentration"]])) different concentrations were identified:\
r colFmt(levels(data[["fluorescence"]][["concentration"]]), 'NavyBlue')\
The following parameters were used to fit the data:
- minimum density considered:
r colFmt(ifelse(!is.null(control$min.density), control$min.density, "none"), 'NavyBlue') - minimum time considered for linear and spline fits (t0):
r colFmt(control$t0, 'NavyBlue') - maximum density considered:
r colFmt(ifelse(!is.null(control$max.density), control$max.density, "none"), 'NavyBlue') - maximum time considered for linear and spline fits (tmax):
r colFmt(control$tmax, 'NavyBlue') - data type used as independent variable (x):
r colFmt(control$x_type, 'NavyBlue')r if(control$x_type == "time"){paste0("* normalized fluorescence used for fits:")}r if(control$x_type == "time"){colFmt(control$norm_fl, 'NavyBlue')} - log-transform fluorescence values for spline fits:
r colFmt(control$log.y.spline, 'NavyBlue') - log-transform fluorescence values for linear fits:
r colFmt(control$log.y.lin, 'NavyBlue') - log-transform x values for spline fits:
r colFmt(control$log.x.spline, 'NavyBlue') - log-transform x values for linear fits:
r colFmt(control$log.x.lin, 'NavyBlue') - perform dose-response analysis:
r colFmt(ec50, 'NavyBlue')r if(ec50){paste0("* method used for dose-response analysis:")}r if(ec50){colFmt(control$dr.method, 'NavyBlue')}r if(ec50){paste0("* parameter used for dose-response analysis:")}r if(ec50){colFmt(control$dr.parameter, 'NavyBlue')} - growth threshold:
r colFmt(control$growth.thresh, 'NavyBlue')r colFmt('* start_density', 'NavyBlue')r if(any(c("l") %in% control$fit.opt)){paste0("* sliding window size in linear regression:")}r if(any(c("l") %in% control$fit.opt)){colFmt(ifelse(!is.null(control$lin.h), control$lin.h, "automated calculation"), 'NavyBlue')}r if(any(c("l") %in% control$fit.opt)){paste0("* R2 threshold for linear regression:")}r if(any(c("l") %in% control$fit.opt)){colFmt(control$lin.R2, 'NavyBlue')}r if(any(c("l") %in% control$fit.opt)){paste0("* RSD threshold for linear regression:")}r if(any(c("l") %in% control$fit.opt)){colFmt(control$lin.RSD, 'NavyBlue')}r if(any(c("l") %in% control$fit.opt)){paste0("* Relative ΔY threshold for linear regression:")}r if(any(c("l") %in% control$fit.opt)){colFmt(control$lin.dY, 'NavyBlue')}
\pagebreak
Graphical overview - Fluorescence
suppressWarnings( plot.dual(flFitRes, fluorescence = "fl", export = export, legend.position = "bottom", legend.ncol = 4) )
Graphical overview - Normalized fluorescence
suppressWarnings( plot.dual(flFitRes, fluorescence = "norm.fl", export = export, legend.position = "bottom", legend.ncol = 4) )
r if((length(flFitRes$data$density)>1 && length(flFitRes$data$fluorescence)>1) || (length(flFitRes$data$density)>1 && length(flFitRes$data$norm.fluorescence)>1) || (length(flFitRes$data$density)>1 && length(flFitRes$data$norm.fluorescence2)>1)){"\\pagebreak"}
Fluorescence fit results
Grouped results
if(any(c("l") %in% control$fit.opt)){ if(!all(is.na(res.table.fl$lambda.linfit))){ table_linear_group <- table_group_fluorescence_linear(res.table.fl) table_linear_group <- as.data.frame(apply(table_linear_group, 2, function(x) str_replace_all(x, "NA ± NA", ""))) table_linear_group[is.na(table_linear_group)] <- "" if (knitr::is_html_output()) { knit_table(table_linear_group, caption = ifelse(control$biphasic, "Linear Fit (Values in parentheses indicate parameters for secondary growth phase)", "Linear Fit")) } else { knit_table(table_linear_group, caption = ifelse(control$biphasic, "Linear Fit (Values in parentheses indicate parameters for secondary growth phase)", "Linear Fit")) %>% kableExtra::column_spec(column=1, width = "4cm") } } }
try(suppressWarnings( plot.parameter(flFitRes, param = "max_slope.linfit", export = export, out.dir = normalizePath(wd.plots))) ) try(suppressWarnings( plot.parameter(flFitRes, param = "lambda.linfit", export = export, out.dir = normalizePath(wd.plots))) ) try(suppressWarnings( plot.parameter(flFitRes, param = "dY.linfit", export = export, out.dir = normalizePath(wd.plots))) )
r if(any(c("l") %in% control$fit.opt)){"\\clearpage"}
if(any(c("s") %in% control$fit.opt)){ if(!all(is.na(res.table.fl$lambda.spline))){ table_spline_group <- table_group_fluorescence_spline(res.table.fl) # if ( control$nboot.gc > 1 ){ # table_spline <- cbind(table_spline, data.frame("slope<sub>max</sub><br>boot" = paste(round(as.numeric(res.table.fl$max_slope.bt), 3),"\u00B1", round(as.numeric(res.table.fl$stdmax_slope.bt),3)), # "λ<br>boot" = paste(round(as.numeric(res.table.fl$lambda.bt), 2),"\u00B1", round(as.numeric(res.table.fl$stdlambda.bt),2)), # "A<br>boot" = paste(round(as.numeric(res.table.fl$A.bt), 3),"\u00B1", round(as.numeric(res.table.fl$stdA.bt),3)), # stringsAsFactors = F, check.names = F)) # } table_spline_group <- as.data.frame(apply(table_spline_group, 2, function(x) str_replace_all(x, "NA ± NA", ""))) table_spline_group[is.na(table_spline_group)] <- "" if (knitr::is_html_output()) { knit_table(table_spline_group, caption = ifelse(control$biphasic, "Smooth Spline Fit (Values in parentheses indicate parameters for secondary growth phase)", "Smooth Spline Fit")) } else { knit_table(table_spline_group, caption = ifelse(control$biphasic, "Smooth Spline Fit (Values in parentheses indicate parameters for secondary growth phase)", "Smooth Spline Fit")) %>% kableExtra::column_spec(column=1, width = "4cm") } } }
try(suppressWarnings( plot.parameter(flFitRes, param = "max_slope.spline", export = export, out.dir = normalizePath(wd.plots))) ) try(suppressWarnings( plot.parameter(flFitRes, param = "lambda.spline", export = export, out.dir = normalizePath(wd.plots))) ) try(suppressWarnings( plot.parameter(flFitRes, param = "dY.spline", export = export, out.dir = normalizePath(wd.plots))) )
\clearpage
Individual samples
if(any(c("l") %in% control$fit.opt)){ if(!all(is.na(res.table.fl$lambda.linfit))){ table_linear <- data.frame("Sample|Replicate|Conc." = paste(res.table.fl$TestId, res.table.fl$AddId, res.table.fl$concentration, sep = "|"), "slope<sub>max</sub>" = ifelse(res.table.fl$max_slope.linfit==0 | is.na(res.table.fl$max_slope.linfit), "", ifelse(is.na(res.table.fl$max_slope2.linfit), round(as.numeric(res.table.fl$max_slope.linfit), 3), paste0("<b>", round(as.numeric(res.table.fl$max_slope.linfit), 3), "</b>", " (", round(as.numeric(res.table.fl$max_slope2.linfit), 3), ")"))), "λ" = round(as.numeric(res.table.fl$lambda.linfit), 2), "Δy" = round(as.numeric(res.table.fl$dY.linfit), 3), "y<sub>max</sub>" = round(as.numeric(res.table.fl$A.linfit), 3), "x<sub>start</sub><br>(slope<sub>max</sub>)" = ifelse(is.na(res.table.fl$max_slope2.linfit), round(as.numeric(res.table.fl$x.mu.start.linfit), 2), paste0("<b>", round(as.numeric(res.table.fl$x.mu.start.linfit), 2), "</b>", " (", round(as.numeric(res.table.fl$x.mu2.start.linfit), 2), ")")), "x<sub>end</sub><br>(slope<sub>max</sub>)" = ifelse(is.na(res.table.fl$max_slope2.linfit), round(as.numeric(res.table.fl$x.mu.end.linfit), 2), paste0("<b>", round(as.numeric(res.table.fl$x.mu.end.linfit), 2), "</b>", " (", round(as.numeric(res.table.fl$x.mu2.end.linfit), 2), ")")), "R<sup>2</sup><br>(linear fit)" = ifelse(is.na(res.table.fl$max_slope2.linfit), round(as.numeric(res.table.fl$r2mu.linfit), 3), paste0("<b>", round(as.numeric(res.table.fl$r2mu.linfit), 3), "</b>", " (", round(as.numeric(res.table.fl$r2mu2.linfit), 3), ")")), stringsAsFactors = F, check.names = F) table_linear <- as.data.frame(apply(table_linear, 2, function(x) str_replace_all(x, "NA ± NA", ""))) table_linear[is.na(table_linear)] <- "" if (knitr::is_html_output()) { knit_table(table_linear, caption = ifelse(control$biphasic, "Linear Fit (Values in parentheses indicate parameters for secondary growth phase)", "Linear Fit")) } else { knit_table(table_linear, caption = ifelse(control$biphasic, "Linear Fit (Values in parentheses indicate parameters for secondary growth phase)", "Linear Fit")) %>% kableExtra::column_spec(column=1, width = "4cm") } } }
r if(any(c("l") %in% control$fit.opt)){"\\clearpage"}
if(any(c("s") %in% control$fit.opt)){ if(!all(is.na(res.table.fl$lambda.spline))){ table_spline <- data.frame("Sample|Replicate|Conc." = paste(res.table.fl$TestId, res.table.fl$AddId, res.table.fl$concentration, sep = "|"), "slope<sub>max</sub>" = ifelse(res.table.fl$max_slope.spline==0 | is.na(res.table.fl$max_slope.spline), "", ifelse(is.na(res.table.fl$max_slope2.spline), round(as.numeric(res.table.fl$max_slope.spline), 3), paste0("<b>", round(as.numeric(res.table.fl$max_slope.spline), 3), "</b>", " (", round(as.numeric(res.table.fl$max_slope2.spline), 3), ")"))), "λ" = round(as.numeric(res.table.fl$lambda.spline), 2), "y<sub>max</sub>" = round(as.numeric(res.table.fl$A.spline), 3), "Δy" = round(as.numeric(res.table.fl$dY.spline), 3), "x<sub>max</sub>" = ifelse(is.na(res.table.fl$max_slope2.spline), round(as.numeric(res.table.fl$x.max.spline), 2), paste0("<b>", round(as.numeric(res.table.fl$x.max.spline), 2), "</b>", " (", round(as.numeric(res.table.fl$x.max2.spline), 2), ")")), "smooth.<br>fac" = res.table.fl$smooth.spline, stringsAsFactors = F, check.names = F) # if ( control$nboot.gc > 1 ){ # table_spline <- cbind(table_spline, data.frame("slope<sub>max</sub><br>boot" = paste(round(as.numeric(res.table.fl$max_slope.bt), 3),"\u00B1", round(as.numeric(res.table.fl$stdmax_slope.bt),3)), # "λ<br>boot" = paste(round(as.numeric(res.table.fl$lambda.bt), 2),"\u00B1", round(as.numeric(res.table.fl$stdlambda.bt),2)), # "A<br>boot" = paste(round(as.numeric(res.table.fl$A.bt), 3),"\u00B1", round(as.numeric(res.table.fl$stdA.bt),3)), # stringsAsFactors = F, check.names = F)) # } table_spline <- as.data.frame(apply(table_spline, 2, function(x) str_replace_all(x, "NA ± NA", ""))) table_spline[is.na(table_spline)] <- "" if (knitr::is_html_output()) { knit_table(table_spline, caption = ifelse(control$biphasic, "Smooth Spline Fit (Values in parentheses indicate parameters for secondary growth phase)", "Smooth Spline Fit")) } else { knit_table(table_spline, caption = ifelse(control$biphasic, "Smooth Spline Fit (Values in parentheses indicate parameters for secondary growth phase)", "Smooth Spline Fit")) %>% kableExtra::column_spec(column=1, width = "4cm") } } }
\clearpage
Plots
r if(any(c("l") %in% control$fit.opt)){"Linear Fits"}
if(any(c("l") %in% control$fit.opt)){ plot.flFitLinear2 <- function(flFittedLinear, log="", which=c("fit", "diagnostics"), title = "Linear fit", plot = TRUE, export = FALSE, height = ifelse(which=="fit", 7, 5), width = ifelse(which=="fit", 9, 9), out.dir = NULL, ...) { if(is(flFittedLinear) != "flFitLinear") stop("flFitLinear needs to be an object created with flFitLinear().") which <- match.arg(which) p <- function(){ switch(which, fit = { control <- flFittedLinear$control if(control$x_type == "time"){ if(control$norm_fl){ if(control$log.y.lin){ ylab = "norm. Ln[FL/FL(0)]" } else { ylab = "norm. FL" } } else { if(control$log.y.lin){ ylab = "Ln[FL/FL(0)]" } else { ylab = "Fluorescence" } } } else { if(control$log.y.lin){ ylab = "Ln[FL/FL(0)]" } else { ylab = "Fluorescence" } } if(control$x_type == "time"){ if(control$log.x.lin){ xlab <- "Ln(time + 1)" } else { xlab <- "Time" } } else { if(control$log.x.lin){ xlab <- "Ln(density + 1)" } else { xlab <- "Density" } } par(mar=c(5.1, 4.1 + nchar(round(max(flFittedLinear$"filt.fl")))/3.5, 4.1, 2.1), cex.lab=1.5) plot(flFittedLinear$"filt.fl" ~ flFittedLinear$"filt.x", xlab=xlab, ylab = "", col = scales::alpha("black", 0.5), log=log, las=1, main = title, yaxt="n", xaxt="n", ...) title(ylab = ylab, line = 3 + nchar(round(max(flFittedLinear$"filt.fl")))/4) axis(1,cex.axis=1.3) axis(2,cex.axis=1.3, las=1) try(points(flFittedLinear$filt.fl[flFittedLinear$ndx] ~ flFittedLinear$filt.x[flFittedLinear$ndx], pch=21, col="black", bg="red")) ## lag phase lag <- flFittedLinear$par["lag"] coef_ <- flFittedLinear$par if(flFittedLinear$fitFlag2){ try(points(flFittedLinear$raw.fl[flFittedLinear$ndx2] ~ flFittedLinear$raw.x[flFittedLinear$ndx2], pch=21, col="black", bg=ggplot2::alpha("magenta3", 1))) lag2 <- flFittedLinear$par["lag2"] if(lag2 < lag && lag2 > flFittedLinear$raw.x[1]){ try(time2 <- seq(lag2, max(flFittedLinear$"raw.x"), length=200), silent = T) try(time <- seq(coef_["x.max_start"]-0.25*(coef_["x.max_end"]-coef_["x.max_start"]), max(flFittedLinear$"raw.x"), length=200), silent = T) try(lines(time2, grow_linear(time2, c(y0=unname(coef_["y0_lm2"]), max_slope=unname(coef_["max_slope2"])))[,"y"], lty=2, lwd=2, col=ggplot2::alpha("magenta3", 0.7), ...), silent = T) try(lines(c(min(flFittedLinear$"filt.x"[1]), lag2), rep(flFittedLinear$"filt.fl"[1], 2), lty=2, lwd=2, col=ggplot2::alpha("magenta3", 0.7)), silent = T) try(lines(time, grow_linear(time, c(y0=unname(coef_["y0_lm"]), max_slope=unname(coef_["max_slope"])))[,"y"], lty=2, lwd=2, col=ggplot2::alpha("firebrick3", 0.7), ...), silent = T) } else { try(time2 <- seq(coef_["x.max2_start"]-0.25*(coef_["x.max2_end"]-coef_["x.max2_start"]), max(flFittedLinear$"raw.x"), length=200), silent = T) try(time <- seq(coef_["x.max_start"]-0.25*(coef_["x.max_end"]-coef_["x.max_start"]), max(flFittedLinear$"raw.x"), length=200), silent = T) try(lines(time, grow_linear(time, c(y0=unname(coef_["y0_lm"]), max_slope=unname(coef_["max_slope"])))[,"y"], lty=2, lwd=2, col=ggplot2::alpha("firebrick3", 0.7), ...), silent = T) try(lines(time2, grow_linear(time2, c(y0=unname(coef_["y0_lm2"]), max_slope=unname(coef_["max_slope2"])))[,"y"], lty=2, lwd=2, col=ggplot2::alpha("magenta3", 0.7), ...), silent = T) } } else if(flFittedLinear$fitFlag){ if(lag < flFittedLinear$raw.x[flFittedLinear$ndx[1]]){ try(time <- seq(coef_["x.max_start"]-0.25*(coef_["x.max_end"]-coef_["x.max_start"]), max(flFittedLinear$"filt.x"), length=200), silent = T) try(lines(time, grow_linear(time, coef_)[,"y"], lty=2, lwd=2, col=ggplot2::alpha("firebrick3", 0.7), ...), silent = T) } else { try(time <- seq(flFittedLinear$filt.x[flFittedLinear$ndx[1]]/2, max(flFittedLinear$"filt.x"), length=200), silent = T) try(lines(time, grow_linear(time, coef_)[,"y"], lty=2, lwd=2, col=ggplot2::alpha("firebrick3", 0.7), ...), silent = T) } } }, diagnostics = { opar <- par(no.readonly = TRUE) on.exit(par(opar)) par(mfrow=c(1,2)) ## residuals vs. fitted obs <- flFittedLinear$log.data sim <- grow_linear(flFittedLinear$"raw.x", flFittedLinear$par) plot(flFittedLinear$fit[["residuals"]] ~ fitted(flFittedLinear$fit), xlab="fitted", ylab="residuals") abline(h=0, col="grey") ## normal q-q-plot qqnorm(flFittedLinear$fit[["residuals"]]) qqline(flFittedLinear$fit[["residuals"]]) } ) } if (export == TRUE){ w <- width h <- height out.dir <- ifelse(is.null(out.dir), paste0(getwd(), "/Plots"), out.dir) dir.create(out.dir, showWarnings = F) grDevices::png(paste0(out.dir, "/", paste(flFittedLinear$gcID, collapse = "_"), "_LinFitPlot.png"), width = w, height = h, units = 'in', res = 300) p() invisible(grDevices::dev.off()) suppressWarnings(grDevices::pdf(paste0(out.dir, "/", paste(flFittedLinear$gcID, collapse = "_"), "_LinFitPlot.pdf"))) p() invisible(grDevices::dev.off()) } if (plot == TRUE){ suppressWarnings( p() ) } } plot.ggLinear <- function(){ if(flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){ x <- flFitRes[["flFit"]][["flFittedLinear"]][[i]] plot.flFitLinear2(flFittedLinear = x, title = gsub(" \\| NA", "", paste(x$ID, collapse = " | "))) } } plotdir <- ifelse(export == TRUE, wd.plots, paste0(str_replace_all(tempdir(), "\\\\", "/"),"/Plots")) if(all(c('pdf', 'html') %in% format)){ if (knitr::is_latex_output()) { # foreach(i = 1:length(flFitRes[["flFit"]][["flFittedLinear"]]), # .packages = "ggplot2") %dopar% { # if(flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){ # pdf(file=paste0(plotdir, "/PlotLinear_", gsub("∙", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))))), ".pdf"), width = 8, height = 6); plot.ggLinear(); invisible(dev.off()) # } # } for(i in 1:length(flFitRes[["flFit"]][["flFittedLinear"]])){ if(length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))>0 && flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){ suppressWarnings(pdf(file=paste0(plotdir, "/PlotLinear_", gsub("∙", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))))), ".pdf"), width = 8, height = 6)) plot.ggLinear() invisible(grDevices::dev.off()) } } } } else{ # foreach(i = 1:length(flFitRes[["flFit"]][["flFittedLinear"]]), # .packages = "ggplot2") %dopar% { # if(flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){ # pdf(file=paste0(plotdir, "/PlotLinear_", gsub("∙", "_", gsub("%", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedLinear"]])[i])))))), ".pdf"), width = 8, height = 6); plot.ggLinear(); invisible(dev.off()) # } # } for(i in 1:length(flFitRes[["flFit"]][["flFittedLinear"]])){ if(length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))==0 && flFitRes[["flFit"]][["flFittedLinear"]][[i]][["fitFlag"]] == TRUE){ suppressWarnings(pdf(file=paste0(plotdir, "/PlotLinear_", gsub("∙|>|<|\\(|\\)", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedLinear"]])[i]))))), ".pdf"), width = 8, height = 6)) plot.ggLinear() invisible(grDevices::dev.off()) } } } Files_list <- list.files(path = plotdir, pattern = "^PlotLinear_", full.names = TRUE) sort.ndx <- match(gsub("∙|>|<|\\(|\\)", "_", gsub("%", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub(" \\| ", "_", names(flFitRes$flFit$flFittedLinear))))))), gsub(".+PlotLinear_","", gsub(".pdf", "", Files_list))) sort.ndx <- sort.ndx[!is.na(sort.ndx)] knitr::include_graphics(Files_list[sort.ndx], dpi = 300, error = F) }
r if(any(c("s") %in% control$fit.opt)){"\\clearpage"}
r if(any(c("s") %in% control$fit.opt)){"Nonparametric Fits"}
if(any(c("s") %in% control$fit.opt)) { plot.flFitSpline2 <- function(flFitSpline, add=FALSE, raw = TRUE, slope=TRUE, deriv = T, spline = T, log.y = F, pch=1, colData=1, colSpline="dodgerblue3", cex=1, lwd = 0.7, plot = TRUE, export = FALSE, width = 8, height = ifelse(deriv == TRUE, 8, 6), out.dir = NULL, ...) { if(is(flFitSpline) != "flFitSpline") stop("flFitSpline needs to be an object created with flFitSpline().") # /// check input parameters if (is.logical(add)==FALSE) stop("Need logical value for: add") if (is.logical(slope)==FALSE) stop("Need logical value for: slope") if (is.numeric(pch)==FALSE) stop("Need numeric value for: pch") if (is.numeric(cex)==FALSE) stop("Need numeric value for: cex") # /// check if a data fit is available if ((is.na(flFitSpline$fitFlag)==TRUE)|(flFitSpline$fitFlag==FALSE)){ warning("plot.flFitSpline: no data fit available!") } else{ if (add==TRUE){ if(spline == TRUE){ # /// try to plot data fit if ((flFitSpline$control$log.x.spline==FALSE) && (flFitSpline$control$log.y.spline==FALSE)){ try( lines(flFitSpline$fit.x, flFitSpline$fit.fl, sub=flFitSpline$name.fit, col=colSpline, type="l", lwd=2.8*lwd) ) } if ((flFitSpline$control$log.x.spline==FALSE) && (flFitSpline$control$log.y.spline==TRUE)){ try( lines(flFitSpline$fit.x, flFitSpline$fit.fl, sub=flFitSpline$name.fit, col=colSpline, type="l", lwd=2.8*lwd) ) } if ((flFitSpline$control$log.x.spline==TRUE) && (flFitSpline$control$log.y.spline==FALSE)){ try( lines(flFitSpline$fit.x, flFitSpline$fit.fl, sub=flFitSpline$name.fit, col=colSpline, type="l", lwd=2.8*lwd ) ) } if ((flFitSpline$control$log.x.spline==TRUE) && (flFitSpline$control$log.y.spline==TRUE)){ try( lines(flFitSpline$fit.x, flFitSpline$fit.fl, sub=flFitSpline$name.fit, col=colSpline, type="l", lwd=2.8*lwd) ) } # /// add tangent at maximum slope if (slope==TRUE){ mu <- as.numeric(flFitSpline$parameters$max_slope) lambda <- as.numeric(flFitSpline$parameters$lambda) x <- seq(lambda, max(flFitSpline$"fit.x"), length=200) y_tangent <- flFitSpline$parameters["b.tangent"][[1]]+x*mu try(lines(x, y_tangent, lty=2, lwd=2, col=ggplot2::alpha(colSpline, 0.85), ...)) try(lines(c(min(flFitSpline$"raw.x"[1]), lambda), rep(flFitSpline$"raw.fl"[1], 2), lty=2, lwd=2, col=ggplot2::alpha(colSpline, 0.7))) } } if (deriv == TRUE){ if ((flFitSpline$control$log.x.spline==FALSE)){ try( lines(flFitSpline$spline.deriv1$x, flFitSpline$spline.deriv1$y, xlab="", ylab="", col = colSpline) ) } if ((flFitSpline$control$log.x.spline==TRUE)){ try( lines(flFitSpline$spline.deriv1$x, flFitSpline$spline.deriv1$y, xlab="", ylab="", col = colSpline) ) } } } # if (add == TRUE) else { coef <- flFitSpline[["parameters"]] lag <- coef["lambda"][[1]][1] # correct for log transformation if(flFitSpline$control$log.y.spline == TRUE){ fit.fl <- c(rep(NA, length(flFitSpline[["raw.fl"]]) - length(flFitSpline[["fit.fl"]])), exp(flFitSpline[["fit.fl"]]) * flFitSpline[["raw.fl"]][1]) } else { fit.fl <- c(rep(NA, length(flFitSpline[["raw.fl"]]) - length(flFitSpline[["fit.fl"]])), flFitSpline[["fit.fl"]]) } df.raw <- data.frame("x" = flFitSpline[["x.in"]], "data" = flFitSpline[["fl.in"]]) df.fit <- data.frame("fit.x" = c(rep(NA, length(flFitSpline[["raw.x"]])-length(flFitSpline[["fit.x"]])), flFitSpline[["fit.x"]]), "fit.fl" = fit.fl) x.label = if(flFitSpline$control$x_type == "density"){ "Density" } else { "Time" } y.label <- if(flFitSpline$control$norm_fl == TRUE && flFitSpline$control$x_type == "time"){ "Norm. fluorescence" } else { "Fluorescence" } p <- ggplot(NULL, aes(x=x, y=data)) + geom_line(aes(x=fit.x, y = fit.fl, color = "spline"), data = df.fit, size = lwd) + xlab(x.label) + ylab(label = y.label) + theme_classic(base_size = 16) + ggtitle(gsub(" \\| NA", "", paste(flFitSpline$ID, collapse=" | "))) + scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) + theme(legend.key = element_blank(), legend.background=element_blank(), legend.title = element_blank(), legend.position = c(0.90, 0.08), plot.title = element_text(size=15), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + scale_color_manual(name='Growth Model', breaks = "Spline fit", values=c("spline" = ggplot2::alpha(colSpline, 0.85), "Spline fit" = ggplot2::alpha(colSpline, 0.85))) if(raw){ p <- p + geom_point(data = df.raw, shape=1, size = 2,alpha = 0.6, stroke=0.15) } p.yrange.end <- ggplot_build(p)$layout$panel_params[[1]]$y.range[2] if(log.y == TRUE){ p <- p + scale_y_continuous(breaks = scales::pretty_breaks(), trans = 'log') } else { p <- p + scale_y_continuous(breaks = scales::pretty_breaks()) } # /// add tangent at maximum slope if(slope == TRUE && (flFitSpline$control$log.y.spline==F && log.y == F) || (flFitSpline$control$log.y.spline==T && log.y == T)){ mu <- as.numeric(coef$max_slope[1]) if(flFitSpline$fitFlag2){ lag2 <- coef$lambda2 fl.x <- flFitSpline$fit.x[which.max(flFitSpline$fit.fl)] mu2 <- coef$max_slope2 if(lag2 < lag){ # x values for tangent at µmax x_start.ndx <- which.min(abs(flFitSpline$fit.x-(coef$x.max-0.15*fl.x))) x_start <- flFitSpline$fit.x[x_start.ndx] x <- seq(x_start, max(flFitSpline$fit.x), length=200) # y values for tangent at µmax if(flFitSpline$control$log.y.spline){ bla <- (exp(coef["b.tangent"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu*x) } else { bla <- coef["b.tangent"][[1]] + (mu*x) } tangent.df <- data.frame("x" = x, "y" = bla) # x values for tangent at µmax2 x2 <- seq(ifelse(lag2<0, 0, lag2), max(flFitSpline$"fit.x"), length=200) # y values for tangent at µmax if(flFitSpline$control$log.y.spline){ bla2 <- (exp(coef["b.tangent2"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu2*x2) } else { bla2 <- coef["b.tangent2"][[1]] + (mu2*x2) } tangent.df2 <- data.frame("x" = x2, "y" = bla2) df.horizontal2 <- data.frame("x" = c(flFitSpline[["raw.x"]][1], lag2), "y" = flFitSpline[["raw.fl"]][1]) p <- p + geom_segment(aes(x = x[which.min(abs(bla))], y = y[which.min(abs(bla))], xend = x[which.min(abs(y - 1.1*p.yrange.end))], yend = y[which.min(abs(y - 1.1*p.yrange.end))]), data = tangent.df, linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5) p <- p + geom_segment(aes(x = x[which.min(abs(bla2))], y = y[which.min(abs(bla2))], xend = x[which.min(abs(y - 1.1*p.yrange.end))], yend = y[which.min(abs(y - 1.1*p.yrange.end))]), data = tangent.df2, linetype = "dashed", color = ggplot2::alpha("darkviolet", 0.85), size = 0.5) if(!(lag2 <0)){ p <- p + geom_segment(aes(x = x[1], y = y[1], xend = x[2], yend = y[2]), data = df.horizontal2, linetype = "dashed", color = ggplot2::alpha("darkviolet", 0.85), size = 0.5) } } # if(lag2 < lag) else { # x values for tangent at µmax x <- seq(ifelse(lag<0, 0, lag), max(flFitSpline$"fit.x"), length=200) # y values for tangent at µmax if(flFitSpline$control$log.y.spline){ bla <- (exp(coef["b.tangent"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu*x) } else { bla <- coef["b.tangent"][[1]] + (mu*x) } tangent.df <- data.frame("x" = x, "y" = bla) df.horizontal <- data.frame("x" = c(flFitSpline[["raw.x"]][1], lag), "y" = flFitSpline[["raw.fl"]][1]) # x values for tangent at µmax2 x2_start.ndx <- which.min(abs(flFitSpline$fit.x-(coef$x.max2-0.15*fl.x))) x2_start <- flFitSpline$fit.x[x2_start.ndx] x2 <- seq(x2_start, max(flFitSpline$"fit.x"), length=200) # y values for tangent at µmax if(flFitSpline$control$log.y.spline){ bla2 <- (exp(coef["b.tangent2"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu2*x2) } else { bla2 <- coef["b.tangent2"][[1]] + (mu2*x2) } tangent.df2 <- data.frame("x" = x2, "y" = bla2) p <- p + geom_segment(aes(x = x[which.min(abs(bla))], y = y[which.min(abs(bla))], xend = x[which.min(abs(y - 1.1*p.yrange.end))], yend = y[which.min(abs(y - 1.1*p.yrange.end))]), data = tangent.df, linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5) p <- p + geom_segment(aes(x = x[which.min(abs(bla2))], y = y[which.min(abs(bla2))], xend = x[which.min(abs(y - 1.1*p.yrange.end))], yend = y[which.min(abs(y - 1.1*p.yrange.end))]), data = tangent.df2, linetype = "dashed", color = ggplot2::alpha("darkviolet", 0.85), size = 0.5) # if(!(lag <0)){ # p <- p + geom_segment(aes(x = x[1], y = y[1], xend = x[2], yend = y[2]), data = df.horizontal, # linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5) # } } } # if(flFitSpline$fitFlag2) else { # x values for tangent x <- seq(ifelse(lag<0, 0, lag), max(flFitSpline$"fit.x"), length=200) # y values for tangent if(flFitSpline$control$log.y.spline){ bla <- (exp(coef["b.tangent"][[1]])*flFitSpline[["raw.fl"]][1])*exp(mu*x) } else { bla <- coef["b.tangent"][[1]] + (mu*x) } tangent.df <- data.frame("x" = x, "y" = bla) df.horizontal <- data.frame("x" = c(flFitSpline[["raw.x"]][1], lag), "y" = flFitSpline[["raw.fl"]][1]) p <- p + geom_segment(aes(x = x[which.min(abs(bla))], y = y[which.min(abs(bla))], xend = x[which.min(abs(y - 1.1*p.yrange.end))], yend = y[which.min(abs(y - 1.1*p.yrange.end))]), data = tangent.df, linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5) # if(!(lag <0)){ # p <- p + geom_segment(aes(x = x[1], y = y[1], xend = x[2], yend = y[2]), data = df.horizontal, # linetype = "dashed", color = ggplot2::alpha(colSpline, 0.85), size = 0.5) # } } # else of if(flFitSpline$fitFlag2) } # if(slope == TRUE && log.y == T) # /// add panel with growth rate over x if(deriv == TRUE){ df.mu <- data.frame(spline(flFitSpline$spline.deriv1$x, flFitSpline$spline.deriv1$y)) #add missing x values due to min.density and t0 x.missing <- df.raw[df.raw$x < df.mu$x[1], ]$x df.mu <- dplyr::bind_rows(data.frame(x = x.missing, y = rep(NA, length(x.missing))), df.mu) y.label.mu = if(flFitSpline$control$log.y.spline == TRUE){ paste0("Slope [d(Ln(F/F0))/d",x.label, "]") } else { paste0("Slope [dF/d", x.label,"]") } p.mu <- ggplot(df.mu, aes(x=x, y=y)) + geom_line(color = colSpline, size = lwd) + theme_classic(base_size = 15) + xlab(x.label) + ylab(label = y.label.mu) + scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) + scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) p <- suppressWarnings(ggpubr::ggarrange(p, p.mu, ncol = 1, nrow = 2, align = "v", heights = c(2,1.1))) } if(export == FALSE && plot == FALSE){ return(p) } if (export == TRUE){ w <- width h <- height out.dir <- ifelse(is.null(out.dir), paste0(getwd(), "/Plots"), out.dir) dir.create(out.dir, showWarnings = F) grDevices::png(paste0(out.dir, "/", paste(flFitSpline$ID, collapse = "_"), "_SplineFit.png"), width = w, height = h, units = 'in', res = 300) print(p) invisible(grDevices::dev.off()) suppressWarnings(grDevices::pdf(paste0(out.dir, "/", paste(flFitSpline$ID, collapse = "_"), "_SplineFit.pdf"), width = w, height = h)) print(p) suppressWarnings(invisible(grDevices::dev.off())) } if (plot == TRUE){ print(p) } } # else of if (add == TRUE) } # else of if ((is.na(flFitSpline$fitFlag)==TRUE)|(flFitSpline$fitFlag==FALSE)) } #__________________ end function definition ______________ plotdir <- ifelse(export == TRUE, wd.plots, paste0(str_replace_all(tempdir(), "\\\\", "/"), "/Plots")) plot.ggSpline <- function() { tryCatch({ if (flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) { pdf_filename <- paste0(plotdir, "/PlotSpline_", gsub("∙|\\n|\\r", "_", gsub("%", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "_", gsub(" \\| ", "_", names(flFitRes[["flFit"]][["flFittedSplines"]])[i])))))), ".pdf") pdf(file = pdf_filename) plot.flFitSpline2(x) } }, finally = { invisible(grDevices::dev.off()) # Ensure the device is closed }) } if(all(c('pdf', 'html') %in% format)){ if (knitr::is_latex_output()) { if(parallelize){ foreach(i = 1:length(flFitRes[["flFit"]][["flFittedSplines"]]), .packages = "ggplot2") %dopar% { if (length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedSplines"]])[i]))==0 && flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) { suppressWarnings( plot.ggSpline() ) } } } else { for(i in 1:length(flFitRes[["flFit"]][["flFittedSplines"]])){ if (length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedSplines"]])[i]))==0 && flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) { suppressWarnings( plot.ggSpline() ) } } } } } else { # of if(all(c('pdf', 'html') %in% format)) if(parallelize){ foreach(i = 1:length(flFitRes[["flFit"]][["flFittedSplines"]]), .packages = "ggplot2") %dopar% { if (length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedSplines"]])[i]))==0 && flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) { suppressWarnings( plot.ggSpline() ) } } } else { for(i in 1:length(flFitRes[["flFit"]][["flFittedSplines"]])){ if (length(grep("^NA ", names(flFitRes[["flFit"]][["flFittedSplines"]])[i]))==0 && flFitRes[["flFit"]][["flFittedSplines"]][[i]][["fitFlag"]] == TRUE) { suppressWarnings( plot.ggSpline() ) } } } } Files_list <- list.files(path = plotdir, pattern = "^PlotSpline_", full.names = TRUE) sort.ndx <- match(gsub("∙|>|<|\\(|\\)", "_", gsub("%", "_", gsub("\\?", "_", gsub(" ", "_", gsub("\\/", "-", gsub( " \\| ", "_", names(flFitRes$flFit$flFittedSplines) )))))), gsub(".+PlotSpline_", "", gsub(".pdf", "", Files_list))) sort.ndx <- sort.ndx[!is.na(sort.ndx)] knitr::include_graphics(Files_list[sort.ndx], dpi = 300, error = F) }
r if(ec50){"\\clearpage"}
r if(ec50 && control$dr.method == "spline"){"Dose-response analysis - Spline fit"} else if (ec50 && control$dr.method == "model"){"Dose-response analysis - Model fit"}
cat(paste0("_", length(flFitRes$drFit$drTable$Test), "_ conditions were identified:\n", paste(colFmt(flFitRes$drFit$drTable$Test, 'NavyBlue'), "\n", collapse = ", "))) cat(" \n") ec50.df <- data.frame() for(i in 1:length(flFitRes$drFit$drFittedSplines)){ ec50.df <- plyr::rbind.fill(ec50.df, data.frame("Condition" = names(flFitRes$drFit$drFittedSplines)[i], "EC50" = round(flFitRes$drFit$drFittedSplines[[i]]$parameters$EC50, 3), "Response" = round(flFitRes$drFit$drFittedSplines[[i]]$parameters$yEC50, 3)) ) } names(ec50.df)[3] <- paste0("Response (", flFitRes$drFit$drFittedSplines[[1]]$parameters$test, ")") knit_table(ec50.df, caption = "Dose-Response Analysis - Spline Fits")
suppressWarnings( plot.drFit(flFitRes$drFit, export = export) )
boot.ec50.df <- data.frame() for (i in 1:length(flFitRes$drFit$drBootSplines)){ boot.ec50.df <- plyr::rbind.fill( boot.ec50.df, data.frame( "Condition" = flFitRes$drFit$drTable$Test[i], "EC50.boot" = paste(round(as.numeric(flFitRes$drFit$drTable$drboot.meanEC50[i]), 3),"\u00B1", round(as.numeric(flFitRes$drFit$drTable$drboot.sdEC50[i]),3)), "Response.boot" = paste(round(as.numeric(flFitRes$drFit$drTable$drboot.meanEC50y[i]), 3),"\u00B1", round(as.numeric(flFitRes$drFit$drTable$drboot.sdEC50y[i]),3)) ) ) } knit_table(boot.ec50.df, caption = "Dose-Response Analysis - Bootstrapping")
for(i in 1:length(flFitRes$drFit$drBootSplines)){ if(flFitRes$drFit$drBootSplines[[i]]$bootFlag == TRUE){ plot.drBootSpline(flFitRes$drFit$drBootSplines[[i]], width = 6, height = 4.5, export = export, out.dir = normalizePath(wd.plots)) } }
cat(paste0("_", length(flFitRes$drFit$drTable$Test), "_ conditions were identified:\n", paste(colFmt(flFitRes$drFit$drTable$Test, 'NavyBlue'), collapse = ", "))) cat(" \n") ec50.df <- data.frame() for(i in 1:length(flFitRes$drFit$drFittedModels)){ ec50.df <- plyr::rbind.fill(ec50.df, data.frame("Condition" = names(flFitRes$drFit$drFittedModels)[i], "K" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$K.orig, 3), "y.min" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$y.min, 3), "y.max" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$y.max, 3), "fold change" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$fc, 3), "n" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$n, 3), "yEC50" = round(flFitRes$drFit$drFittedModels[[i]]$parameters$yEC50.orig, 3)) ) } names(ec50.df)[7] <- paste0("Response (", flFitRes$drFit$drFittedModels[[1]]$parameters$test, ")") knit_table(ec50.df, caption = "Dose-Response Analysis - Spline Fits")
for(i in 1:length(flFitRes[["drFit"]][["drFittedModels"]])){ try( suppressWarnings( plot.drFitFLModel(flFitRes$drFit$drFittedModels[[i]], export = export) ) ) } suppressWarnings( plot.dr_parameter(flFitRes, param = "K", export = export) ) suppressWarnings( plot.dr_parameter(flFitRes, param = "fc", export = export) ) suppressWarnings( plot.dr_parameter(flFitRes, param = "y.min", export = export) ) suppressWarnings( plot.dr_parameter(flFitRes, param = "y.max", export = export) )
r if((!is.null(mean.grp) | !is.null(mean.conc)) && (!is.na(mean.grp) | !is.na(mean.conc)) ){"\\clearpage"}
r if((!is.null(mean.grp) | !is.null(mean.conc)) && (!is.na(mean.grp) | !is.na(mean.conc)) ){"Group average plots"}
if("all" %in% mean.grp){ if(length(flFitRes$flFit$flFittedSplines[[1]]$spline)>1){ logy <- control$log.y.spline suppressWarnings( plot.flFitRes(flFitRes, basesize = 15, export = export, plot=TRUE, log.y = logy, mean = T, out.dir = normalizePath(wd.plots), legend.position = "bottom", legend.ncol = 4) ) } } else if(!is.null(mean.grp) && !is.na(mean.grp)){ for(i in 1:length(mean.grp)){ if(length(grep(mean.grp[i], as.character(names(flFitRes$flFit$flFittedSplines))))>0){ suppressWarnings( plot.flFitRes(flFitRes, names = unlist(mean.grp[i]), basesize = 15, export = export, plot=TRUE, log.y = T, mean = T, out.dir = normalizePath(wd.plots), legend.position = "bottom", legend.ncol = 4) ) } } } if(!is.null(mean.conc) && !is.na(mean.conc)){ for(i in 1:length(mean.conc)){ if(length(grep(mean.conc[i], str_extract(names(flFitRes$flFit$flFittedSplines), "[:alnum:]+$")))>0){ suppressWarnings( plot.flFitRes(flFitRes, conc = unlist(mean.conc[i]), basesize = 15, export = export, plot=TRUE, log.y = T, mean = T, out.dir = normalizePath(wd.plots), legend.position = "bottom", legend.ncol = 4) ) } } }
Try the QurvE package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.