| name | bio-atac-seq-motif-deviation |
| description | Analyze transcription factor motif accessibility variability using chromVAR. Use when identifying which TF motifs show variable accessibility across samples or conditions in ATAC-seq data. |
| tool_type | r |
| primary_tool | chromVAR |
Motif Deviation Analysis
Measure per-sample variability in transcription factor motif accessibility using chromVAR. This identifies TFs whose binding sites show differential accessibility across conditions.
Required Packages
library(chromVAR)
library(motifmatchr)
library(BSgenome.Hsapiens.UCSC.hg38)
library(JASPAR2020)
library(TFBSTools)
library(SummarizedExperiment)
Basic Workflow
1. Load Peak Counts
library(chromVAR)
library(SummarizedExperiment)
peaks <- read.table('peaks.bed', col.names = c('chr', 'start', 'end'))
peak_ranges <- GRanges(seqnames = peaks$chr, ranges = IRanges(peaks$start, peaks$end))
counts <- read.table('counts.txt', header = TRUE, row.names = 1)
counts_matrix <- as.matrix(counts)
fragment_counts <- SummarizedExperiment(
assays = list(counts = counts_matrix),
rowRanges = peak_ranges
)
2. Add GC Bias Correction
library(BSgenome.Hsapiens.UCSC.hg38)
fragment_counts <- addGCBias(fragment_counts, genome = BSgenome.Hsapiens.UCSC.hg38)
3. Filter Low-Quality Peaks
fragment_counts <- filterSamples(fragment_counts, min_depth = 1500, min_in_peaks = 0.15)
fragment_counts <- filterPeaks(fragment_counts, non_overlapping = TRUE,
min_count = 10, n_samples_frac = 0.1)
Get Motif Annotations
From JASPAR
library(JASPAR2020)
library(TFBSTools)
library(motifmatchr)
pfm <- getMatrixSet(JASPAR2020, opts = list(collection = 'CORE', tax_group = 'vertebrates'))
motif_ix <- matchMotifs(pfm, fragment_counts, genome = BSgenome.Hsapiens.UCSC.hg38, p.cutoff = 5e-5)
From CIS-BP or Custom PWMs
library(universalmotif)
motifs <- read_meme('custom_motifs.meme')
pfm_list <- lapply(motifs, function(m) convert_motifs(m, class = 'TFBSTools-PFMatrix'))
motif_ix <- matchMotifs(pfm_list, fragment_counts, genome = BSgenome.Hsapiens.UCSC.hg38)
Compute Deviations
dev <- computeDeviations(object = fragment_counts, annotations = motif_ix)
deviation_scores <- deviations(dev)
variability <- computeVariability(dev)
Interpreting Results
Deviation Scores
dev_matrix <- deviations(dev)
print(dim(dev_matrix))
var_df <- variability
var_df <- var_df[order(-var_df$variability), ]
head(var_df, 20)
Variability Interpretation
| Variability | Interpretation |
|---|
| > 2.0 | Highly variable across samples |
| 1.0 - 2.0 | Moderately variable |
| < 1.0 | Low variability |
Visualization
Deviation Heatmap
library(pheatmap)
n_top <- 50
top_motifs <- head(rownames(var_df), n_top)
top_dev <- deviation_scores[top_motifs, ]
sample_info <- data.frame(
Condition = colData(fragment_counts)$condition,
row.names = colnames(top_dev)
)
pheatmap(top_dev, annotation_col = sample_info, scale = 'row',
clustering_method = 'ward.D2', show_rownames = TRUE)
Variability Plot
plotVariability(variability, use_plotly = FALSE)
PCA of Deviation Scores
library(ggplot2)
pca <- prcomp(t(deviation_scores), scale. = TRUE)
pca_df <- data.frame(PC1 = pca$x[,1], PC2 = pca$x[,2],
Condition = colData(fragment_counts)$condition)
ggplot(pca_df, aes(x = PC1, y = PC2, color = Condition)) +
geom_point(size = 3) +
theme_minimal() +
labs(title = 'PCA of chromVAR Deviations')
Differential Motif Accessibility
Compare Two Groups
library(limma)
groups <- factor(colData(fragment_counts)$condition)
design <- model.matrix(~ groups)
fit <- lmFit(deviation_scores, design)
fit <- eBayes(fit)
diff_motifs <- topTable(fit, coef = 2, number = Inf, p.value = 0.05)
print(head(diff_motifs, 20))
Volcano Plot
library(ggplot2)
all_results <- topTable(fit, coef = 2, number = Inf)
all_results$significant <- all_results$adj.P.Val < 0.05
ggplot(all_results, aes(x = logFC, y = -log10(adj.P.Val), color = significant)) +
geom_point(alpha = 0.6) +
geom_hline(yintercept = -log10(0.05), linetype = 'dashed') +
scale_color_manual(values = c('grey', 'red')) +
theme_minimal
labstitle
x y
Working with Single-Cell ATAC-seq
library(Matrix)
sparse_counts <- Matrix(counts_matrix, sparse = TRUE)
fragment_counts <- SummarizedExperiment(
assays = list(counts = sparse_counts),
rowRanges = peak_ranges
)
fragment_counts <- addGCBias(fragment_counts, genome = BSgenome.Hsapiens.UCSC.hg38)
Background Peaks Strategy
bg <- getBackgroundPeaks(object = fragment_counts, niterations = 50)
dev <- computeDeviations(object = fragment_counts, annotations = motif_ix, background_peaks = bg)
Export Results
write.csv(as.data.frame(deviation_scores), 'chromvar_deviations.csv')
write.csv(variability, 'chromvar_variability.csv')
write.csv(diff_motifs, 'differential_motifs.csv')
Complete Workflow
library(chromVAR)
library(motifmatchr)
library(BSgenome.Hsapiens.UCSC.hg38)
library(JASPAR2020)
library(TFBSTools)
fragment_counts <- getCounts('peaks.bed', c('sample1.bam', 'sample2.bam', 'sample3.bam'))
fragment_counts <- addGCBias(fragment_counts, genome = BSgenome.Hsapiens.UCSC.hg38)
fragment_counts <- filterPeaks(fragment_counts)
pfm <- getMatrixSet(JASPAR2020, opts = list(collection = 'CORE', tax_group = 'vertebrates'))
motif_ix <- matchMotifs(pfm, fragment_counts, genome = BSgenome.Hsapiens.UCSC.hg38
dev computeDeviationsfragment_counts motif_ix
variability computeVariabilitydev
plotVariabilityvariability
Related Skills
- differential-accessibility - Peak-level differential analysis with DiffBind
- footprinting - TF footprinting with TOBIAS
- atac-qc - Quality control before chromVAR
- chip-seq/motif-analysis - Alternative motif enrichment approaches