## Registered S3 method overwritten by 'printr':
## method from
## knit_print.data.frame rmarkdown
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.
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)
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 Under development (unstable) (2024-10-21 r87258)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 24.04.1 LTS
##
## Matrix products: default
## BLAS: /home/biocbuild/bbs-3.21-bioc/R/lib/libRblas.so
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.12.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_GB 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: America/New_York
## tzcode source: system (glibc)
##
## attached base packages:
## [1] stats4 stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] edgeR_4.5.0 limma_3.63.0
## [3] zFPKM_1.29.0 tidyr_1.3.1
## [5] SummarizedExperiment_1.37.0 GenomicRanges_1.59.0
## [7] GenomeInfoDb_1.43.0 IRanges_2.41.0
## [9] S4Vectors_0.45.0 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.0 dplyr_1.1.4
## [17] printr_0.3
##
## loaded via a namespace (and not attached):
## [1] gtable_0.3.6 ggplot2_3.5.1 xfun_0.48
## [4] bslib_0.8.0 lattice_0.22-6 tzdb_0.4.0
## [7] vctrs_0.6.5 tools_4.5.0 generics_0.1.3
## [10] tibble_3.2.1 fansi_1.0.6 highr_0.11
## [13] pkgconfig_2.0.3 Matrix_1.7-1 checkmate_2.3.2
## [16] data.table_1.16.2 rentrez_1.2.3 lifecycle_1.0.4
## [19] GenomeInfoDbData_1.2.13 farver_2.1.2 compiler_4.5.0
## [22] munsell_0.5.1 statmod_1.5.0 htmltools_0.5.8.1
## [25] sass_0.4.9 yaml_2.3.10 pillar_1.9.0
## [28] crayon_1.5.3 jquerylib_0.1.4 DelayedArray_0.33.0
## [31] cachem_1.1.0 abind_1.4-8 locfit_1.5-9.10
## [34] tidyselect_1.2.1 digest_0.6.37 stringi_1.8.4
## [37] purrr_1.0.2 labeling_0.4.3 fastmap_1.2.0
## [40] grid_4.5.0 colorspace_2.1-1 cli_3.6.3
## [43] SparseArray_1.7.0 magrittr_2.0.3 S4Arrays_1.7.0
## [46] XML_3.99-0.17 utf8_1.2.4 readr_2.1.5
## [49] withr_3.0.2 scales_1.3.0 backports_1.5.0
## [52] UCSC.utils_1.3.0 rmarkdown_2.28 XVector_0.47.0
## [55] httr_1.4.7 hms_1.1.3 evaluate_1.0.1
## [58] knitr_1.48 rlang_1.1.4 glue_1.8.0
## [61] xml2_1.3.6 jsonlite_1.8.9 R6_2.5.1
## [64] zlibbioc_1.53.0