Introduction to zFPKM Transformation
## Registered S3 method overwritten by 'printr':
## method from
## knit_print.data.frame rmarkdownSummary
Perform the zFPKM transform on RNA-seq FPKM data. This algorithm is based on the publication by Hart et al., 2013 (Pubmed ID 24215113). The reference recommends using zFPKM > -3 to select expressed genes. Validated with ENCODE open/closed promoter chromatin structure epigenetic data on six of the ENCODE cell lines. It works well for gene level data using FPKM or TPM, but does not appear to calibrate well for transcript level data.
Identifying active genes for subsequent analysis
We calculate zFPKM for existing FPKM from gse94802.
library(dplyr)
library(GEOquery)
library(stringr)
library(SummarizedExperiment)
library(tidyr)
getSpecificGEOSupp <- function(url) {
temp <- tempfile()
download.file(url, temp)
out <- read.csv(gzfile(temp), row.names=1, check.names=FALSE)
out <- select(out, -MGI_Symbol)
return(out)
}
gse94802_fpkm <- "ftp://ftp.ncbi.nlm.nih.gov/geo/series/GSE94nnn/GSE94802/suppl/GSE94802_Minkina_etal_normalized_FPKM.csv.gz"
gse94802_counts <- "ftp://ftp.ncbi.nlm.nih.gov/geo/series/GSE94nnn/GSE94802/suppl/GSE94802_Minkina_etal_raw_counts.csv.gz"
if (file.exists("gse94802.rds")) {
esetlist <- readRDS("gse94802.rds")
} else {
esetlist <- getGEO("gse94802")
}
doe <- pData(esetlist[[1]])
colData <- DataFrame(
condition=ifelse(str_detect(doe$title, regex("control", ignore_case=TRUE)), "control", "mutant"),
sample_id=str_match(doe$title, "rep\\d_(.+)")[, 2],
row.names=str_match(doe$title, "rep\\d_(.+)")[, 2])
se <- SummarizedExperiment(assays=SimpleList(fpkm=getSpecificGEOSupp(gse94802_fpkm),
counts=getSpecificGEOSupp(gse94802_counts)),
colData=colData)
# clear namespace
rm(esetlist, gse94802_fpkm, gse94802_counts, doe, colData, getSpecificGEOSupp)We compute zFPKM.
We can also plot the Guassian fit to the FPKM data for which the z-scores are based.
To determine which genes are active, we compute the median expression within each group.
activeGenes <- assay(se, "zfpkm") %>%
mutate(gene=rownames(assay(se, "zfpkm"))) %>%
gather(sample_id, zfpkm, -gene) %>%
left_join(select(as.data.frame(colData(se)), sample_id, condition), by="sample_id") %>%
group_by(gene, condition) %>%
summarize(median_zfpkm=median(zfpkm)) %>%
ungroup() %>%
mutate(active=(median_zfpkm > -3)) %>%
filter(active) %>%
select(gene) %>%
distinct()
seActive <- SummarizedExperiment(
assays=SimpleList(counts=as.matrix(assay(se, "counts")[activeGenes$gene, ])),
colData=colData(se))In the following DE analysis, we only use genes that were active in either group.
library(limma)
library(edgeR)
# Generate normalized log2CPM from counts AFTER we filter for protein-coding
# genes that are detectably expressed.
dge <- DGEList(counts=assay(seActive, "counts"))
dge <- calcNormFactors(dge)
design <- model.matrix(~ 0 + condition, data=colData(seActive))
vq <- voomWithQualityWeights(dge, design, plot=TRUE)
fit <- lmFit(vq, design)
contrastMatrix <- makeContrasts(conditioncontrol - conditionmutant, levels=design)
fit <- contrasts.fit(fit, contrastMatrix)
fit <- eBayes(fit, robust=TRUE)
deGenes <- topTable(fit, number=Inf)References
Hart T, Komori HK, LaMere S, Podshivalova K, Salomon DR. Finding the active genes in deep RNA-seq gene expression studies. BMC Genomics. 2013 Nov 11;14:778. doi: 10.1186/1471-2164-14-778.
## R version 4.4.2 (2024-10-31)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 24.04.1 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.26.so; LAPACK version 3.12.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=C
## [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
##
## time zone: Etc/UTC
## tzcode source: system (glibc)
##
## attached base packages:
## [1] stats4 stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] edgeR_4.5.1 limma_3.63.2
## [3] zFPKM_1.29.0 tidyr_1.3.1
## [5] SummarizedExperiment_1.37.0 GenomicRanges_1.59.1
## [7] GenomeInfoDb_1.43.2 IRanges_2.41.2
## [9] S4Vectors_0.45.2 MatrixGenerics_1.19.0
## [11] matrixStats_1.4.1 stringr_1.5.1
## [13] GEOquery_2.75.0 Biobase_2.67.0
## [15] BiocGenerics_0.53.3 generics_0.1.3
## [17] dplyr_1.1.4 printr_0.3
## [19] rmarkdown_2.29
##
## loaded via a namespace (and not attached):
## [1] gtable_0.3.6 ggplot2_3.5.1 xfun_0.49
## [4] bslib_0.8.0 lattice_0.22-6 tzdb_0.4.0
## [7] vctrs_0.6.5 tools_4.4.2 tibble_3.2.1
## [10] pkgconfig_2.0.3 Matrix_1.7-1 checkmate_2.3.2
## [13] data.table_1.16.4 rentrez_1.2.3 lifecycle_1.0.4
## [16] GenomeInfoDbData_1.2.13 farver_2.1.2 compiler_4.4.2
## [19] munsell_0.5.1 statmod_1.5.0 htmltools_0.5.8.1
## [22] sys_3.4.3 buildtools_1.0.0 sass_0.4.9
## [25] yaml_2.3.10 pillar_1.10.0 crayon_1.5.3
## [28] jquerylib_0.1.4 DelayedArray_0.33.3 cachem_1.1.0
## [31] abind_1.4-8 locfit_1.5-9.10 tidyselect_1.2.1
## [34] digest_0.6.37 stringi_1.8.4 purrr_1.0.2
## [37] labeling_0.4.3 maketools_1.3.1 fastmap_1.2.0
## [40] grid_4.4.2 colorspace_2.1-1 cli_3.6.3
## [43] SparseArray_1.7.2 magrittr_2.0.3 S4Arrays_1.7.1
## [46] XML_3.99-0.17 readr_2.1.5 withr_3.0.2
## [49] scales_1.3.0 backports_1.5.0 UCSC.utils_1.3.0
## [52] XVector_0.47.0 httr_1.4.7 hms_1.1.3
## [55] evaluate_1.0.1 knitr_1.49 rlang_1.1.4
## [58] glue_1.8.0 xml2_1.3.6 jsonlite_1.8.9
## [61] R6_2.5.1 zlibbioc_1.52.0