In rickhelmus/patRoon: Workflows for Mass-Spectrometry Based Non-Target Analysis

# knitr::knit_hooks$set(optipng = knitr::hook_pngquant)
knitr::knit_hooks$set(pngquant = function(before, options, envir) suppressMessages(knitr::hook_pngquant(before, options, envir)))
knitr::opts_chunk$set(echo = FALSE, fig.keep = "all", fig.retina = 1, dpi = 72)
if (rmdVars$optimizePng)
    knitr::opts_chunk$set(pngquant = "")

# utility funcs for plotting
getPlotPath <- function(link)
{
    if (rmdVars$selfContained)
        ret <- "."
    else if (link)
        ret <- file.path("report_files", "plots")
    else
        ret <- file.path(rmdVars$outPath, "report_files", "plots")
    mkdirp(ret)
    return(ret)
}

imgTags <- function(img, style = "") 
{
    if (rmdVars$selfContained)
        ret <- sprintf("<img src=%s style='%s'></img>", img, style)
    else
    {
        # return(sprintf("<img src=file://%s></img>", img))
        ret <- sprintf("<img src='%s' style='%s'></img>", img, style)
    }
    return(ifelse(nzchar(img), ret, ""))
}

makeInfoBox <- function(txt)
{
    sprintf("<div style='max-width: 300px; max-height: 432px; border: 1px solid black; border-style: dotted; margin: 1px; padding: 1px; overflow: auto; white-space: nowrap; text-align: left;'>%s</div>", txt)
}

rGroupLenNonEmpty <- length(unique(analysisInfo(removeEmptyAnalyses(rmdVars$fGroups))$group))
rGroupLen <- length(replicateGroups(rmdVars$fGroups))
anyOverlap <- rGroupLen > 1 &&
    length(unique(rmdVars$fGroups, which = replicateGroups(rmdVars$fGroups), outer = TRUE)) < length(rmdVars$fGroups)
if (length(rmdVars$fGroups) > 0 && anyOverlap && rGroupLenNonEmpty > 1)
{
    doPlotChord <- "chord" %in% rmdVars$reportPlots && rGroupLenNonEmpty > 2
    doPlotVenn <- "venn" %in% rmdVars$reportPlots && rGroupLen < 6
    doPlotUpSet <- "upset" %in% rmdVars$reportPlots
} else
    doPlotChord <- doPlotVenn <- doPlotUpSet <- FALSE
doAnnotation <- !is.null(rmdVars$compounds) || !is.null(rmdVars$compsCluster) || !is.null(rmdVars$formulas) ||
    !is.null(rmdVars$components) || inherits(rmdVars$fGroups, "featureGroupsScreening")
doEICs <- length(rmdVars$fGroups) > 0 && "eics" %in% rmdVars$reportPlots
doIS <- nrow(internalStandards(rmdVars$fGroups)) > 0
isComponentsTP <- !is.null(rmdVars$components) && inherits(rmdVars$components, "componentsTPs")
rmdText <- NULL

message("Generating chromatograms...")

plotPathFull <- getPlotPath(FALSE)

prog <- openProgBar(0, length(rmdVars$fGroups))
allPlots <- sapply(seq_len(length(rmdVars$fGroups)), function(grpi)
{
    path <- file.path(plotPathFull, sprintf("chrom_%d.png", grpi))
    makeCachedPlot(path, "plotChroms",
                   list(rmdVars$fGroups, groupName = names(rmdVars$fGroups)[grpi], EICParams = rmdVars$EICParams,
                        retMin = rmdVars$retMin, EICs = rmdVars$EICs, colourBy = "rGroup"),
                   7, 4.5, bg = NA, cacheDB = rmdVars$cacheDB)
    setTxtProgressBar(prog, grpi)
    return(path)
})
close(prog)

if (rmdVars$optimizePng && length(allPlots) > 0)
    optimizePngPlots(allPlots)

chromPaths <- file.path(getPlotPath(TRUE), sprintf("chrom_%d.png", seq_len(length(rmdVars$fGroups))))
chromPathsFull <- file.path(plotPathFull, sprintf("chrom_%d.png", seq_len(length(rmdVars$fGroups))))
if (rmdVars$selfContained)
    chromPaths <- sapply(chromPaths, knitr::image_uri)

# stuff everything together: https://stackoverflow.com/a/21730473
rmdText <- sprintf("<script>var chromPaths = [ %s ];</script>",
                   paste0("'", chromPaths, "'", collapse = ", "))

r if (!is.null(rmdText)) rmdText

Summary {data-orientation=rows}

{ data-height=350 }

EICs

par(mai = c(0.9, 0.8, 0.6, 0.1))
plotChroms(rmdVars$fGroups, EICParams = getDefEICParams(rtWindow = rmdVars$EICParams$rtWindow,
                                                        mzExpWindow = rmdVars$EICParams$mzExpWindow, topMost = 1),
           retMin = rmdVars$retMin, EICs = rmdVars$EICs, showPeakArea = TRUE, showFGroupRect = FALSE,
           colourBy = "fGroups", showLegend = FALSE)

{ data-height=300 }

Objects

objToShow <- list(rmdVars$fGroups, rmdVars$MSPeakLists, rmdVars$formulas,
                  rmdVars$compounds, rmdVars$components)
objToShow <- objToShow[!sapply(objToShow, is.null)]
for (obji in seq_along(objToShow))
{
    show(objToShow[[obji]])
    cat("\n")
}

Retention vs m/z

par(mai = c(0.9, 0.8, 0.1, 0.1))
plot(rmdVars$fGroups, colourBy = "fGroups", showLegend = FALSE, retMin = rmdVars$retMin)

r if (doPlotChord || doPlotVenn || doPlotUpSet) "## { data-height=425 } \n"

r if (doPlotChord) "### Chord diagram\n"

message("Creating chord diagram... ", appendLF = FALSE)
plotChord(rmdVars$fGroups, average = TRUE)
message("Done!")

r if (doPlotVenn) "### Venn diagram\n"

plotVenn(rmdVars$fGroups)

r if (doPlotUpSet) "### UpSet diagram\n"

plotUpSet(rmdVars$fGroups)

r if (doEICs) "EICs {data-navmenu=\"Features\"}\n===\n"

cat(sprintf("![%s](%s)", names(rmdVars$fGroups), chromPaths), sep = "\n")

r if (doIS) "Internal standard assignments {data-navmenu=\"Features\"}\n===\n"

# UNDONE: set onlyPresent?

rmdText <- if (isFGSet(rmdVars$fGroups))
{
    paste0("## Plots {.tabset}\n\n", paste0(sapply(sets(rmdVars$fGroups), function(s)
    {
        glue::glue("### { s } {{ data-height=600 }}\n\n",
                   "{ ticks } {{r}}\nplotGraph(rmdVars$fGroups, set = \"{ s }\")\n{ ticks }\n\n",
                   ticks = "```", s = s)
    }), collapse = ""))
} else
    glue::glue("##\n\n### {{ data-height=600 }}\n\n",
               "{ ticks }{{r}}\nplotGraph(rmdVars$fGroups)\n{ ticks }\n\n", ticks = "```")