Nothing
## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
## ----setup, echo = FALSE------------------------------------------------------
library(BinaryDosage)
## ----files--------------------------------------------------------------------
vcf_file <- system.file("extdata", "set1a.vcf.gz", package = "BinaryDosage")
bd4_file <- system.file("extdata", "vcf1a.bdose", package = "BinaryDosage")
bdose_file <- file.path(tempdir(), "set1a.bdose")
## ----convert, eval = TRUE, echo = TRUE, message = FALSE, warning = FALSE------
if (requireNamespace("vcfppR", quietly = TRUE)) {
vcftobd(vcffile = vcf_file, bdose_file = bdose_file)
} else {
updatebd(bdfiles = bd4_file, bdose_file = bdose_file)
}
## ----convert_region, eval = F, echo = T---------------------------------------
# vcftobd(vcffile = vcf_file,
# bdose_file = bdose_file,
# region = "1:10000-15000")
## ----load_info, eval = TRUE, echo = T, message = F, warning = F---------------
bd5 <- getbdinfo(bdose_file)
## ----meta, eval = TRUE, echo = T----------------------------------------------
cat("Class: ", class(bd5), "\n")
cat("Uses family ID: ", bd5$usesfid, "\n")
cat("One chromosome: ", bd5$onechr, "\n")
cat("SNP ID format: ", bd5$snpidformat, "\n")
cat("Format: ", bd5$additionalinfo$format, "\n")
cat("Header size: ", bd5$additionalinfo$headersize, "bytes\n")
## ----samples, eval = TRUE, echo = T-------------------------------------------
cat("Number of samples:", nrow(bd5$samples), "\n")
knitr::kable(head(bd5$samples, 5), caption = "First 5 samples")
## ----snps, eval = TRUE, echo = T----------------------------------------------
cat("Number of SNPs:", nrow(bd5$snps), "\n")
knitr::kable(bd5$snps, caption = "SNP table")
## ----indices, eval = TRUE, echo = T-------------------------------------------
cat("Indices (bytes):", bd5$indices, "\n")
## ----snp_by_index, eval = TRUE, echo = T, message = F, warning = F------------
snp1 <- getbd5snp(bd5info = bd5, snp = 1L)
snp1_df <- data.frame(
SampleID = bd5$samples$sid,
Dosage = round(snp1$dosage, 4),
P_00 = round(snp1$p0, 4),
P_01 = round(snp1$p1, 4),
P_11 = round(snp1$p2, 4)
)
knitr::kable(head(snp1_df, 10),
caption = paste("SNP", bd5$snps$snpid[1], "— first 10 subjects"))
## ----snp_by_id, eval = TRUE, echo = T, message = F, warning = F---------------
snp_id <- "1:12000:T:C"
snp3 <- getbd5snp(bd5info = bd5, snp = snp_id)
snp3_df <- data.frame(
SampleID = bd5$samples$sid,
Dosage = round(snp3$dosage, 4),
P_00 = round(snp3$p0, 4),
P_01 = round(snp3$p1, 4),
P_11 = round(snp3$p2, 4)
)
knitr::kable(head(snp3_df, 10),
caption = paste("SNP", snp_id, "— first 10 subjects"))
## ----apply_bdapply, eval = TRUE, echo = T, message = F, warning = F-----------
getaaf <- function(dosage, p0, p1, p2) mean(dosage, na.rm = TRUE) / 2
aaf_list <- bdapply(bdinfo = bd5, func = getaaf)
aaf_table <- data.frame(snpid = bd5$snps$snpid,
aaf = round(unlist(aaf_list), 4))
knitr::kable(aaf_table, caption = "Alternate allele frequencies via bdapply")
## ----apply_con, eval = TRUE, echo = T, message = F, warning = F---------------
n_snps <- nrow(bd5$snps)
n_samp <- nrow(bd5$samples)
dosage <- numeric(n_samp)
p0 <- numeric(n_samp)
p1 <- numeric(n_samp)
p2 <- numeric(n_samp)
con <- openbd5con(bd5)
aaf <- numeric(n_snps)
for (i in seq_len(n_snps)) {
getbd5snp_con(bd5info = bd5, snp = i,
dosage = dosage, p0 = p0, p1 = p1, p2 = p2,
bd5con = con)
aaf[i] <- mean(dosage, na.rm = TRUE) / 2
}
closebd5con(con)
knitr::kable(data.frame(snpid = bd5$snps$snpid, aaf = round(aaf, 4)),
caption = "Alternate allele frequencies via getbd5snp_con")
## ----cleanup, include = FALSE, eval = TRUE------------------------------------
unlink(c(bdose_file, paste0(bdose_file, ".bdi")))
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.