## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(linf)
article_link <- function(name, title) {
if (identical(Sys.getenv("IN_PKGDOWN"), "true")) {
url <- paste0(name, ".html")
} else if (isTRUE(getOption("linf.local.preview"))) {
url <- paste0("../articles/", name, ".html")
} else {
url <- paste0("https://github.com/pgajer/linf/blob/main/vignettes/articles/",
name, ".Rmd")
title <- paste0(title, " (article source)")
}
sprintf("[%s](%s)", title, url)
}
# Keep table rendering separate from the runnable analysis code.
knitr::opts_chunk$set(render = function(x, options) {
rendered <- knitr::knit_print(x, options = options)
if (inherits(x, "knitr_kable")) {
knitr::asis_output(paste0(
'
\n\n',
rendered, '\n\n
\n'
))
} else rendered
})
## ----first-workflow-----------------------------------------------------------
X <- rbind(
s1 = c(10, 8, 1), s2 = c(9, 7, 2),
s3 = c(10, 1, 8), s4 = c(9, 2, 7),
s5 = c(1, 10, 2), s6 = c(2, 9, 1)
)
colnames(X) <- c("asv_1", "asv_2", "asv_3")
labels <- c("Taxon A", "Taxon B", "Taxon C")
M <- normalize.linf(X)
dominant <- linf.dominant.features(M, feature.labels = labels)
dominant$id
fit1 <- linf.csts(M, feature.labels = labels, n0 = 2,
low.freq.policy = "pure")
fit2 <- refine.linf.csts(M, fit1, n0 = 2, refinement.factor = 2,
low.freq.policy = "pure", verbose = FALSE)
accounting <- summary(fit2)
fields <- c("depth", "n.lineages", "input.samples",
"assigned.samples", "unassigned.samples", "rare.samples")
knitr::kable(accounting[, fields],
col.names = c("Depth", "Groups", "Input", "Assigned", "Unassigned", "Rare"))
## ----unordered-states---------------------------------------------------------
U <- rbind(c(A = 9, B = 5, C = 1), c(A = 8, B = 4, C = 1),
c(A = 4, B = 9, C = 1), c(A = 3, B = 8, C = 1),
c(A = 1, B = 3, C = 9))
unordered <- linf.udcsts(U, level = 2, n0 = 3, low.freq.policy = "filter")
unordered$frequency.table
U[unordered$keep, , drop = FALSE]
unordered$feature.labels[unordered$feature.sets[1, ]]
## ----explicit-refinement------------------------------------------------------
explicit <- refine.linf.csts(
M, fit1, lineages.to.refine = "asv_1", n0 = 2,
low.freq.policy = "pure", verbose = FALSE
)
stopifnot(identical(explicit$lineage.ids, fit2$lineage.ids))
## ----landmark-example---------------------------------------------------------
landmarks <- linf.landmarks(M, fit2, view = "absorb",
landmark.types = c("endpoint.min", "mean.rep"))
knitr::kable(landmarks$landmarks[, c(
"lineage.label", "landmark.type", "point.name", "observed.value",
"target.value"
) ], digits = 3)
# Retrieve the complete observed profiles, if needed:
profiles <- M[landmarks$landmarks$point.index, , drop = FALSE]
## ----pipeline-----------------------------------------------------------------
out <- linf.dcst.landmark.pipeline(
X, feature.labels = labels, n0.depth1 = 2, n0.depth2 = 2,
refinement.factor = 2, verbose = FALSE
)
names(out)
stopifnot(identical(out$dcst.depth2$lineage.ids, fit2$lineage.ids))
## ----transfer-records---------------------------------------------------------
query <- M[c("s1", "s5"), c("asv_2", "asv_1"), drop = FALSE]
transferred <- transfer.dcsts(query, fit2, view = "pure")
transferred$assignment.ids
knitr::kable(transferred$feature.match)
knitr::kable(transferred$diagnostics[, c("sample.id", "assigned.depth", "reason")])
fit2$history[[2]][c("n0", "selection.mode", "selected.lineage.ids", "tie.method")]
## ----performance-location, eval=FALSE-----------------------------------------
# cat(readLines(system.file("PERFORMANCE.md", package = "linf", mustWork = TRUE)),
# sep = "\n")
## ----help-navigation, eval=FALSE----------------------------------------------
# help(package = "linf")
# help("linf-package", package = "linf")
# browseVignettes("linf")
# vignette("example-datasets", package = "linf")
## ----triple-graph-------------------------------------------------------------
G <- rbind(c(A=6, B=3, C=1), c(A=6, B=1, C=3), c(A=1, B=6, C=3))
graph <- linf.udcst.graph(G, coverage=60, min.support=1)
graph$nodes
graph$edges[, c("pair.a", "pair.b", "triple", "min.support", "length")]
graph$faces