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

cTable <- componentTable(rmdVars$components)
cInfo <- componentInfo(rmdVars$components)
cNames <- names(rmdVars$components)

# the given fGroups may be a subset: make sure to only report components with
# given fGroups.
# NOTE: we cannot report a subset of the components object as it removes
# necessary metadata.
subComps <- rmdVars$components[, names(rmdVars$fGroups)]
indsWithFGroups <- which(names(rmdVars$components) %in% names(subComps))

message("Plotting components...")
prog <- openProgBar(0, length(indsWithFGroups))
allPlots <- vector("character", length(rmdVars$components) * 4)
curPlotInd <- 0
plotPathFull <- getPlotPath(FALSE)
plotPathLink <- getPlotPath(TRUE)

# HACK: this should be replaced some proper inheritance/methods at some point
isHClust <- inherits(rmdVars$components, "componentsIntClust")
isHomol <- inherits(rmdVars$components, "componentsNT")
isSet <- inherits(rmdVars$components, "componentsSet")

if (isHClust)
    clProps <- clusterProperties(rmdVars$components)

for (ci in indsWithFGroups)
{
    curPlotInd <- curPlotInd + 1
    allPlots[curPlotInd] <- file.path(plotPathFull, sprintf("component_spec_%d.png", ci))
    makeCachedPlot(allPlots[curPlotInd], "plotSpectrum",
                   list(rmdVars$components, ci,
                        main = sprintf("ret: %.1f; m/z: %.4f - %.4f", cInfo$ret[ci], min(cTable[[ci]]$mz), max(cTable[[ci]]$mz))),
                        7, 4.5, bg = NA, cacheDB = rmdVars$cacheDB)

    curPlotInd <- curPlotInd + 1
    allPlots[curPlotInd] <- file.path(plotPathFull, sprintf("component_eic_%d.png", ci))
    makeCachedPlot(allPlots[curPlotInd], "plotChroms",
                   list(rmdVars$components, ci, rmdVars$fGroups,
                        EICParams = getDefEICParams(rtWindow = rmdVars$EICParams$rtWindow,
                                                    mzExpWindow = rmdVars$EICParams$mzExpWindow),
                        retMin = rmdVars$retMin, EICs = rmdVars$EICs),
                   7, 4.5, bg = NA, cacheDB = rmdVars$cacheDB)

    if (isHClust)
    {
        curPlotInd <- curPlotInd + 1
        allPlots[curPlotInd] <- file.path(plotPathFull, sprintf("component_int_norm_%d.png", ci))
        makeCachedPlot(allPlots[curPlotInd], "plotInt",
                       list(rmdVars$components, index = ci, main = "normalized"),
                       3.3, 3.3, bg = NA, cacheDB = rmdVars$cacheDB)

        curPlotInd <- curPlotInd + 1
        allPlots[curPlotInd] <- file.path(plotPathFull, sprintf("component_int_abs_%d.png", ci))
        fg <- fGroups[, unique(cTable[[ci]]$group)]
        makeCachedPlot(allPlots[curPlotInd], "plotInt", list(fg, average = clProps$average, plotArgs = list(main = "absolute")),
                       3.3, 3.3, bg = NA, cacheDB = rmdVars$cacheDB)
    }

    setTxtProgressBar(prog, ci)
}

setTxtProgressBar(prog, length(indsWithFGroups))
close(prog)

if (rmdVars$optimizePng && curPlotInd > 0)
    optimizePngPlots(allPlots[seq_len(curPlotInd)])

Components {data-orientation=rows}

rmdText <- knitr::knit(text = glue::glue("
## {{data-height=350}}

### heatmap

{ ticks } {{r fig.width=6, fig.height=5}}
plotHeatMap(rmdVars$components, interactive = { inter })
{ ticks }

### dendrogram

{ ticks } {{r fig.width=6, fig.height=5}}
plot(rmdVars$components)
{ ticks }

", ticks = "```", inter = as.character(rmdVars$interactiveHeat)))

rmdText <- knitr::knit(text = glue::glue("
##

### Linked series

{ ticks } {{r}}
plotGraph(rmdVars$components, onlyLinked = TRUE)
{ ticks }

", ticks = "```"))

r if (isHClust || isHomol) rmdText

makeCompDT <- function(s, scrollY)
{
    if (is.null(s))
        compInds <- indsWithFGroups
    else
        compInds <- intersect(cInfo[set == s, which = TRUE], indsWithFGroups)

    sppaths <- file.path(plotPathLink, sprintf("component_spec_%d.png", compInds))
    eicpaths <- file.path(plotPathLink, sprintf("component_eic_%d.png", compInds))

    if (rmdVars$selfContained)
    {
        sppaths <- sapply(sppaths, knitr::image_uri)
        eicpaths <- sapply(eicpaths, knitr::image_uri)
    }

    # clearout useless columns with only NA in them
    cTable <- sapply(cTable, function(ct)
    {
        ct[, sapply(ct, function(x) !all(is.na(x))), with = FALSE]
    }, simplify = FALSE)
    infoTables <- sapply(compInds, function(compi) knitr::kable(cTable[[compi]], "html") %>%
                             kableExtra::kable_styling(font_size = 11) %>%
                             kableExtra::scroll_box(extra_css = "overflow: auto; width: 350px; height: 300px;"))

    compTable <- data.table(component = names(rmdVars$components)[compInds],
                            info = infoTables,
                            EIC = imgTags(eicpaths))

    if (isHClust)
    {
        intnpaths <- file.path(plotPathLink, sprintf("component_int_norm_%d.png", compInds))
        intapaths <- file.path(plotPathLink, sprintf("component_int_abs_%d.png", compInds))

        if (rmdVars$selfContained)
        {
            intnpaths <- sapply(intnpaths, knitr::image_uri)
            intapaths <- sapply(intapaths, knitr::image_uri)
        }

        compTable[, intensities := paste0(imgTags(intnpaths), "<br>", imgTags(intapaths))]
    } else
        compTable[, spectrum := imgTags(sppaths)]

    eId <- if (!is.null(s)) paste0("componentsTable_", s) else "componentsTable"
    initDT <- DT::JS("function(settings, json) {",
                     "setTimeout(function() {",
                     sprintf("$(\"#%s .dataTable\").DataTable().columns.adjust().draw(); }", eId),
                     ", 25); }")
    DT::datatable(compTable, options = list(scrollX = TRUE, scrollY = paste0(scrollY, "px"), deferRender = TRUE,
                                            dom = "lrtip", pageLength = 25, autoWidth = FALSE,
                                            initComplete = initDT, ordering = FALSE),
                  class = "striped row-border", elementId = eId,
                  fillContainer = TRUE, rownames = FALSE, escape = FALSE)
}

compTableHeight <- if (isHClust || isHomol) 800 else 1200
hd <- function(cl) sprintf("## { data-height=%d .components %s }\n\n", compTableHeight, cl)
subhd <- function(t) paste0(sprintf("### %s { .components }\n\n", t),
                            "NOTE: only components with feature group data are shown here.\n\n")
body <- function(s) glue::glue("\n{ ticks } {{r}}\nmakeCompDT({ s }, { h })\n{ ticks }\n\n",
                               ticks = "```", s = s, h = compTableHeight - 200)

if (isSet)
{
    rmdText <- hd(".tabset")
    for (s in sets(rmdVars$components))
        rmdText <- c(rmdText, paste0(subhd(s), body(paste0("\"", s, "\""))))

} else
    rmdText <- paste0(hd(""), subhd("Components"), body("NULL"))

rmdText <- if (length(rmdText) > 0) paste0(knitr::knit(text = rmdText), collapse = "\n") else ""