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)])
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 ""
r if (nzchar(rmdText)) rmdText
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.