fCpGs and other epigenetic clocks, Gabbutt and Duran-Ferrer 2025
10/07/2025
fCpG methylation represents a previously unrecognized type of CpG methylation and is different from any other reported epigenetic clock or cell-type specific CpG, repreenting neutral and cell lineage markers.
1 Load packages and fCpG information
library(data.table)
library(dplyr)
library(ComplexHeatmap)
library(methylCIPHER)
library(DunedinPACE)
library(pals)
options(stringsAsFactors = F,max.print = 10000,error=NULL,
"openxlsx.dateFormat" = "dd/mm/yyyy"
)
## fCpGs
fCpGs <- fread("../Data/FMC/Final_data/beta_all_samples_fcpgs_laplacian.csv",data.table = F)
rownames(fCpGs) <- fCpGs$V1
fCpGs <- fCpGs[,-1]
fCpGs[1:5,1:15]
head(fCpGs);dim(fCpGs)2 Load CpGs from epigenetic clocks
We next collect a huge number of CpGs that have been reported to be part of distinct calsses of “epigenetic clocks”, measuring differnt biological aspects such as chronological age, mitotic age, trait predictors, etc.
2.1 All clocks
ht_opt$legend_grid_width <- unit(2,"mm")
ht_opt$legend_grid_height <-unit(2,"mm")
ht_opt$legend_labels_gp <- gpar(fontsize=5)
ht_opt$legend_title_gp <- gpar(fontsize=5)
ht_opt$heatmap_column_title_gp <- gpar(fontsize=5)
ht_opt$heatmap_row_title_gp <- gpar(fontsize=5)
ht_opt$heatmap_row_names_gp <- gpar(fontsize=5)
ht_opt$heatmap_column_names_gp <- gpar(fontsize=5)
ht_opt$HEATMAP_LEGEND_PADDING <- unit(1,"mm")
ht_opt$ANNOTATION_LEGEND_PADDING <- unit(1,"mm")
ht_opt$legend_gap <- unit(c(1,1),"mm")
ht_opt$fast_hclust <- T
# Load epiCMIT CpGs
# download.file("https://github.com/Duran-FerrerM/Pan-B-cell-methylome/raw/master/data/Estimate.epiCMIT.RData", destfile = "Estimate.epiCMIT.RData", method="libcurl")
load("../Scripts/2_Deconvolution_clocks/Estimate.epiCMIT.RData")
##
## Load other clocks collected in methylCIPHER package
##
clockOptions()
length(sort(gsub("calc","",sort(clockOptions()))))
length(sort(grep("_CpG",ls("package:methylCIPHER"),value = T)))
clockOptions()
clockOptions()[1:30]
levine.clocks <- structure(grep("_CpG",ls("package:methylCIPHER"),value = T),
names=grep("_CpG",ls("package:methylCIPHER"),value = T)
)
sort(names(levine.clocks))
levine.clocks <- lapply(levine.clocks, function(clock.i){
writeLines(clock.i)
get(clock.i)
})
lapply(levine.clocks,head)
levine.clocks.CpGs <- lapply(levine.clocks, function(dat.i){
if(!is.null(dim(dat.i))){
dat.i <- data.frame(dat.i)
cpgs.col <- grep("Marker|ID|CpG",colnames(dat.i),ignore.case = T)
if(length(cpgs.col)==1){
cpgs <- dat.i[,cpgs.col]
}else if(length(cpgs.col)>1){
print(dat.i)
stop("re-code script")
}else{
cpgs <- rownames(dat.i)
}
}else{
cpgs <- dat.i
}
cpgs <- grep("^cg",cpgs,value = T)
return(cpgs)
})
length(levine.clocks)
length(levine.clocks.CpGs)==length(levine.clocks)
sapply(levine.clocks.CpGs,length)
##add dunedin CpGs
levine.clocks.CpGs <- c(c(levine.clocks.CpGs,
list(DunedinPACE=as.character(unlist(DunedinPACE::getRequiredProbes())))
)
)
length(levine.clocks.CpGs)
names(levine.clocks.CpGs)
clocks <- c(list(fCpGs=rownames(fCpGs),
epiCMIT=epiCMIT.v2.Annot$epiCMIT.450K.EPIC.hg19$Name),
levine.clocks.CpGs
)
names(clocks) <- gsub("_CpGs|_CpG","",names(clocks))
names(clocks)
## filter some clocks and organize them by biological insights
clocks.filtered <- clocks[!names(clocks) %in% c("LeeRobust","LeeControl","HRSInCHPhenoAge","calcHRSInChPhenoAge")]
sort(names(clocks.filtered))
length(clocks.filtered)
clock.type <- list("fCpGs"="fCpGs",
"Chronological"=c("Bocklandt","Garagnani","Hannum","Horvath1","Lin","VidalBralo","Weidner","Zhang2019"),
"Mitotic"=c("epiCMIT","hypoClock","EpiToc","EpiToc2","MiAge"),
"Gestational and pediatric age"=c("Bohlin","Knight","LeeRefinedRobust","Mayne","PEDBE"),
"Biological age and mortality"=c("DNAmTL","PhenoAge","DunedinPACE","Zhang_10"),
"Trait predictors"=c("Alcohol","BMI","Smoking"),
"Age non-blood"=c("Horvath2","DNAmClockCortical")
)
clock.type <- unlist(clock.type)
names(clock.type) <- gsub("\\d+","",names(clock.type))
clock.type
# sort clocks accordingly
clocks.filtered <- clocks.filtered[clock.type]
data.frame(names(clocks.filtered),clock.type)
clocks.colors <- structure(pals::kelly(length(unique(names(clock.type)))),
names=unique(names(clock.type)))
m <- make_comb_mat(clocks.filtered)
draw(UpSet(m = m,
comb_order = order(comb_size(m),decreasing = T),#order(comb_degree(m),decreasing = F),
comb_col = rev(brewer.blues(n = length((table(comb_degree(m))))))[comb_degree(m)],
set_order = order(set_size(m),decreasing = T),#clock.type,
row_names_side = "left",
# heatmap_legend_param = list(legend_direction="horizontal",
# legend_width = unit(5, "cm")
# ),
left_annotation = HeatmapAnnotation(which = "row",
# clock_names=anno_text(names(clocks.filtered)),
clocks=names(clock.type),
col=list(clocks=clocks.colors
)
# annotation_legend_param = list(legend_direction="horizontal")
),
top_annotation = upset_top_annotation(m = m,add_numbers = TRUE,annotation_name_rot = 90,numbers_rot=90),
right_annotation = upset_right_annotation(m = m,add_numbers = TRUE),
),
merge_legend=T,
heatmap_legend_side = "bottom",
# annotation_legend_side = "bottom"
)
2.1.1 Simplified clocks
##
## SIMPLIFY PLOT
##
data.frame(clock.type,names(clock.type))
clocks.filtered.simplified <- list("fCpGs"=unique(unlist(clocks.filtered[clock.type[which(names(clock.type)=="fCpGs")]])),
"Mitotic"=unique(unlist(clocks.filtered[clock.type[which(names(clock.type)=="Mitotic")]])),
"Age"=unique(unlist(clocks.filtered[c(clock.type[which(names(clock.type)=="Chronological")],
clock.type[which(names(clock.type)=="Age non-blood")],
clock.type[which(names(clock.type)=="Gestational and pediatric age")]
)])),
"Biological age and mortality"=unique(unlist(clocks.filtered[clock.type[which(names(clock.type)=="Biological age and mortality")]])),
"Trait predictors"=unique(unlist(clocks.filtered[clock.type[which(names(clock.type)=="Trait predictors")]]))
)
str(clocks.filtered.simplified)
m <- make_comb_mat(clocks.filtered.simplified)
draw(UpSet(m = m,
comb_order = order(comb_size(m),decreasing = T),#order(comb_degree(m),decreasing = F),
# comb_col = rev(brewer.blues(n = length((table(comb_degree(m))))))[comb_degree(m)],
set_order = order(set_size(m),decreasing = T),#clock.type,
row_names_side = "left",
# heatmap_legend_param = list(legend_direction="horizontal",
# legend_width = unit(5, "cm")
# ),
# left_annotation = HeatmapAnnotation(which = "row",
# # clock_names=anno_text(names(clocks.filtered)),
# clocks=names(clock.type),
# col=list(clocks=clocks.colors
# )
# # annotation_legend_param = list(legend_direction="horizontal")
# ),
top_annotation = upset_top_annotation(m = m,add_numbers = TRUE,annotation_name_rot = 90,numbers_rot=90),
right_annotation = upset_right_annotation(m = m,add_numbers = TRUE),
),
merge_legend=T,
heatmap_legend_side = "bottom",
# annotation_legend_side = "bottom"
)
3 Session info
print(sessionInfo())## R version 4.5.0 (2025-04-11)
## Platform: aarch64-apple-darwin20
## Running under: macOS Ventura 13.1
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.1
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: Europe/Madrid
## tzcode source: internal
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] pals_1.10 DunedinPACE_0.99.0 methylCIPHER_0.2.0
## [4] ComplexHeatmap_2.24.1 dplyr_1.1.4 data.table_1.17.8
## [7] BiocStyle_2.36.0
##
## loaded via a namespace (and not attached):
## [1] utf8_1.2.6 sass_0.4.10 generics_0.1.4
## [4] fastcluster_1.3.0 shape_1.4.6.1 digest_0.6.37
## [7] magrittr_2.0.3 evaluate_1.0.5 RColorBrewer_1.1-3
## [10] bookdown_0.44 iterators_1.0.14 maps_3.4.3
## [13] circlize_0.4.16 fastmap_1.2.0 foreach_1.5.2
## [16] doParallel_1.0.17 jsonlite_2.0.0 GenomeInfoDb_1.44.2
## [19] tinytex_0.57 GlobalOptions_0.1.2 BiocManager_1.30.26
## [22] httr_1.4.7 UCSC.utils_1.4.0 codetools_0.2-20
## [25] jquerylib_0.1.4 cli_3.6.5 rlang_1.1.6
## [28] crayon_1.5.3 XVector_0.48.0 cachem_1.1.0
## [31] yaml_2.3.10 tools_4.5.0 parallel_4.5.0
## [34] colorspace_2.1-1 GenomeInfoDbData_1.2.14 GetoptLong_1.0.5
## [37] BiocGenerics_0.54.0 mapproj_1.2.12 vctrs_0.6.5
## [40] R6_2.6.1 png_0.1-8 magick_2.8.7
## [43] matrixStats_1.5.0 stats4_4.5.0 lifecycle_1.0.4
## [46] S4Vectors_0.46.0 IRanges_2.42.0 clue_0.3-66
## [49] cluster_2.1.8.1 pkgconfig_2.0.3 pillar_1.11.0
## [52] bslib_0.9.0 Rcpp_1.1.0 glue_1.8.0
## [55] GenomicRanges_1.60.0 xfun_0.53 tibble_3.3.0
## [58] tidyselect_1.2.1 dichromat_2.0-0.1 rstudioapi_0.17.1
## [61] knitr_1.50 rjson_0.2.23 htmltools_0.5.8.1
## [64] rmarkdown_2.29 Cairo_1.6-5 compiler_4.5.0