visualization of context-dependent TF-TF cooperation network

1 import packages and functions

suppressMessages(library(igraph))
suppressMessages(library(ggplot2))
suppressMessages(library(dplyr))
suppressMessages(library(RColorBrewer))

2 load two networks first

g1 <- readRDS('graph_shrinkage_res0.9_s0.15_TexTerm_subset_TFs_v2.rds')
g2 <- readRDS('graph_shrinkage_res0.9_s0.15_TRM_subset_TFs_v2.rds')
gv1 <- igraph::as_data_frame(g1, "vertices")

## This graph was created by an old(er) igraph version.
##   Call upgrade_graph() on it to use with the current igraph version
##   For now we convert it on the fly...

gv2 <- igraph::as_data_frame(g2, "vertices")

## This graph was created by an old(er) igraph version.
##   Call upgrade_graph() on it to use with the current igraph version
##   For now we convert it on the fly...

common_tfs <- intersect(gv1$name, gv2$name)
tex_tfs <- setdiff(gv1$name, gv2$name)
trm_tfs <- setdiff(gv2$name, gv1$name)

3 combine two networks

first we prepared the edge info

# extract edge info: take mean if edge exists in both networks
ge1 <- igraph::as_data_frame(g1) %>% select(from, to, corr) %>% transform(from=pmin(from, to), to=pmax(from,to))
ge2 <- igraph::as_data_frame(g2) %>% select(from, to, corr) %>% transform(from=pmin(from, to), to=pmax(from,to))
ge <- ge1 %>% full_join(ge2, by = c('from','to')) %>% 
    mutate(corr=ifelse(is.na(corr.x), corr.y, ifelse(is.na(corr.y), corr.x, (corr.x+corr.y)/2)), 
           edge.color=ifelse(is.na(corr.x), '#009051', ifelse(is.na(corr.y), '#8AAA75', '#808080')),
           type=ifelse(is.na(corr.x), 'trm', ifelse(is.na(corr.y), 'tex', 'common'))) |> 
        select(from,to,corr,edge.color,type) |> na.omit()
knitr::kable(head(ge), caption = 'edge meta') |> kableExtra::kable_styling(latex_options = 'scale_down') 

edge meta

from	to	corr	edge.color	type
Ahr	Arid3a	0.0143988	#8AAA75	tex
Ahr	Arnt	0.0456422	#8AAA75	tex
Arnt	Arntl	0.9242606	#808080	common
Ahr	Atf1	0.0677564	#808080	common
Atf1	Atf2	0.1362224	#808080	common
Atf1	Atf7	0.6232261	#808080	common

Then we prepared the node info. Most of the TFs are in the same community in both contexts. Some TFs are different so they will be marked as “multi”

gv1 <- igraph::as_data_frame(g1, "vertices") %>% select(name, cluster)
gv2 <- igraph::as_data_frame(g2, "vertices") %>% mutate(cluster2=ifelse(cluster==1, 3, ifelse(cluster==3, 1, cluster)))%>% select(name, cluster2)
attrs2 <- gv1 %>% full_join(gv2, by=c('name')) %>% 
        mutate(group=ifelse(name %in% common_tfs, 'Common', ifelse(name %in% tex_tfs, 'Tex', 'Trm')), 
               color=ifelse(name %in% common_tfs, '#C0C0C0', ifelse(name %in% tex_tfs, '#BB8666', '#98D7AD')),
               cluster_c=ifelse(is.na(cluster),cluster2,ifelse(is.na(cluster2), cluster,ifelse(cluster==cluster2, cluster, 'mixed'))))
knitr::kable(head(attrs2), caption = 'node meta') |> kableExtra::kable_styling(latex_options = 'scale_down') 

node meta

name	cluster	cluster2	group	color	cluster_c
Bhlhe40	1	1	Common	#C0C0C0	1
Nr4a2	2	2	Common	#C0C0C0	2
Snai3	3	3	Common	#C0C0C0	3
Xbp1	1	1	Common	#C0C0C0	1
Egr1	4	4	Common	#C0C0C0	4
Nfil3	2	2	Common	#C0C0C0	2

# create combined network from the edge meta
g <- graph_from_data_frame(ge, directed = FALSE, vertices = attrs2)
print(g, e=TRUE, v=TRUE)

## IGRAPH 51bade4 UN-- 198 3341 -- 
## + attr: name (v/c), cluster (v/n), cluster2 (v/n), group (v/c), color
## | (v/c), cluster_c (v/c), corr (e/n), edge.color (e/c), type (e/c)
## + edges from 51bade4 (vertex names):
##  [1] Ahr    --Arid3a  Ahr    --Arnt    Arnt   --Arntl   Ahr    --Atf1   
##  [5] Atf2   --Atf1    Atf1   --Atf7    Atf2   --Atf7    Arid3a --Bbx    
##  [9] Bhlhe40--Arnt    Bhlhe40--Arntl   Bhlhe41--Arid3a  Bhlhe41--Arnt   
## [13] Bhlhe41--Arntl   Bhlhe40--Bhlhe41 Ahr    --Cbfb    Cbfb   --Atf1   
## [17] Batf   --Cbfb    Cebpb  --Atf2    Ahr    --Creb1   Creb1  --Atf1   
## [21] Creb1  --Atf2    Creb1  --Atf7    Bhlhe41--Creb1   Crem   --Ahr    
## [25] Crem   --Atf1    Crem   --Atf2    Crem   --Atf7    Crem   --Bhlhe41
## + ... omitted several edges

4 network visualization

4.1 fix the network layout

G_Grouped = g
E(G_Grouped)$weight = 1

## Add edges with high weight between all nodes in the same group
for(i in unique(V(g)$cluster_c)) {
    GroupV = which(V(g)$cluster_c == i)
    G_Grouped = add_edges(G_Grouped, combn(GroupV, 2), attr=list(weight=1.8))
} 

## Now create a layout based on G_Grouped
set.seed(567)
LO = layout_with_fr(G_Grouped)

4.2 define function

# function to generate network
get_figure <- function(x,ge,cut_off=0.8,label=F){
    g <- graph_from_data_frame(ge, directed = FALSE, vertices = attrs2)
    G_Grouped = g
    E(G_Grouped)$weight = 1
    
    ## Add edges with high weight between all nodes in the same group
    for(i in unique(V(g)$cluster_c)) {
        GroupV = which(V(g)$cluster_c == i)
        G_Grouped = add_edges(G_Grouped, combn(GroupV, 2), attr=list(weight=1.8))
    } 
    
    ## Now create a layout based on G_Grouped
    set.seed(567)
    LO = layout_with_fr(G_Grouped)
    
    # get degree
    ge2 <- ge |> dplyr::filter(type==x)
    g2 <- graph_from_data_frame(ge2, directed = FALSE, vertices = attrs2) # to get customized node size in each context
    # generate label for all nodes
    V(g)$frame.color <- 'gray'
    V(g)$label <- NA
    if (label){V(g)$label <- V(g)$name}
    
    V(g)$label.color <- 'black'
    V(g)$size <- 0.2*degree(g2) # degree in each context
    # V(g)$label.cex <- 0.75 # part label
    V(g)$label.cex <- 0.5 # all label
    
    # set distance of label
    V(g)$label.dist <- 0.4
    
    # set edge color
    # E(g)$color <- "gray80"
    E(g)$color <- ifelse(E(g)$type=='common', '#C0C0C0', ifelse(E(g)$type=='trm', '#009051', '#945200'))
    E(g)$size <- 0.1
    E(g)$width <- 2*E(g)$corr
    E(g)$lty <- ifelse((E(g)$corr>=unname(quantile(E(g)$corr, cut_off))) & (E(g)$type==x), 1, 0)

    plot(g, layout=LO, main = paste0(x, ' network'))
}

4.3 generate figures

tmps <- lapply(c('common','trm','tex'), function(x) get_figure(x=x, ge=ge, cut_off=0.8,label=T))

5 individual TF’s neighbors in different contexts

# define function
get_graph <- function(id){
    ge1 <- igraph::as_data_frame(g1) %>% select(from, to, corr) %>% transform(from=pmin(from, to), to=pmax(from,to)) %>% mutate(edge.color='#7F6000')
    ge2 <- igraph::as_data_frame(g2) %>% select(from, to, corr) %>% transform(from=pmin(from, to), to=pmax(from,to)) %>% mutate(edge.color='#009051')
    ge <- rbind(ge1,ge2)
    
    ge3 <- ge %>% filter(from == id | to == id)
    nodes <- union(ge3$from, ge3$to)
    attrs3 = data.frame('name'=nodes) %>% mutate(color=ifelse(name %in% common_tfs, '#C0C0C0', ifelse(name %in% tex_tfs, '#7F6000', '#009051')))

    g <- graph_from_data_frame(ge3, directed = FALSE, vertices = attrs3)
    V(g)$label.color <- 'black'
    # V(g)$size <- 10*degree(g)
    V(g)$size <- ifelse(V(g)$name == id, 12, 7)
    # V(g)$label.cex <- 0.75 # part label
    V(g)$label.cex <- 1 # all label

    # set distance of label
    V(g)$label.dist <- 1

    # set edge color
    # E(g)$color <- "gray80"
    E(g)$color <- ge3$edge.color
    E(g)$size <- 1
    E(g)$width <- 3*E(g)$corr
    G_Grouped = g
    E(G_Grouped)$weight = 1

    ## make edges of the same type close to each other in the layout
    for(i in unique(V(g)$color)) {
        GroupV = which(V(g)$color == i)
        G_Grouped = add_edges(G_Grouped, combn(GroupV, 2), attr=list(weight=0.1))
    } 

    ## Now create a layout based on G_Grouped
    set.seed(567)
    LO = layout_with_fr(G_Grouped)    
    
    set.seed(1)
    plot(g, layout=LO, main = paste0(id, ' network'))

}

Now we can visualize some TFs’ neighbors in both TRM and TEXterm. Hic1 is a common TF in both contexts. Zfp324 is TEXterm-specific TF. Fosb is TRM-specific TF.

# visualize some example TFs
tmp <- lapply(c('Hic1','Fosb','Zfp324'), get_graph)

6 TF-regulatee network

# prepare edge info
df <- read.csv('Hic1_Prdm1_RegulationFlipping_figure_input_20240529-lc.csv')[,c(1:4)] |> na.omit() |> mutate(pair=paste0(regulator,'-',regulatee)) |> dplyr::select(pair, TexTerm, TRM) |> tibble::column_to_rownames('pair')

df <- df |> tibble::rownames_to_column('pair') |> tidyr::separate('pair',into = c('from','to'),sep = '-') |> 
    tidyr::pivot_longer(!c('from','to'),names_to='group', values_to = 'corr') |> 
    # mutate(edge.color=ifelse(group=='TexTerm','#7F6000','#009051'), edge.lty=ifelse(corr<0, 1, 2), abs.corr=abs(corr)) |> 
    mutate(edge.color=ifelse(corr<0, '#C00000', '#0070C0'), abs.corr=abs(corr)) |> 
    filter(corr!=0)
knitr::kable(head(df), caption = 'edge meta') |> kableExtra::kable_styling(latex_options = 'scale_down') 

edge meta

from	to	group	corr	edge.color	abs.corr
Prdm1	Hic1	TexTerm	37.107090	#0070C0	37.107090
Prdm1	Hic1	TRM	-32.398273	#C00000	32.398273
Prdm1	Nfil3	TexTerm	25.451106	#0070C0	25.451106
Prdm1	Nfil3	TRM	-16.058449	#C00000	16.058449
Prdm1	Egr2	TexTerm	24.422237	#0070C0	24.422237
Prdm1	Egr2	TRM	-8.764937	#C00000	8.764937

# set node color
nodes <- read.csv('node_color_20240529.csv')
tex_nodes <- nodes |> filter(color=='#B2876B') |> pull(node) |> unique()
trm_nodes <- nodes |> filter(color=='#A5D4AF') |> pull(node) |> unique()

# define function
get_TF_regulatee_graph <- function(id){
  ge <- df |> filter(from==id)
  g <- graph_from_data_frame(ge, directed = FALSE)
  
  edge.width.max <- 10
  upper.limit <- 50
  lower.limit <- 5
  max_corr <- max(E(g)$abs.corr)
  min_corr <- min(E(g)$abs.corr)
  valuesq <- lapply(V(g)$name, function(x) ifelse(x %in% tex_nodes, return(c(0,1)), ifelse(x %in% trm_nodes, return(c(1,0)), return(c(1,1)))))
  V(g)$size <- ifelse(V(g)$name == id, 20, 15)
  V(g)$pie.color = list(c('#A5D4AF','#B2876B')) # first is TRM, second is TEX
  V(g)$frame.color = ifelse(V(g)$name %in% tex_nodes, '#B2876B', '#A5D4AF')
  V(g)[which(V(g)$name==id)]$pie.color = list(c('#808080','#808080'))
  V(g)[which(V(g)$name==id)]$frame.color = '#808080'
  
  E(g)$color <- ge$edge.color
  # E(g)$width <- 0.5*E(g)$corr
  E(g)$width <- 0.1*ifelse(E(g)$abs.corr>=upper.limit, upper.limit, ifelse(E(g)$abs.corr<=lower.limit,lower.limit,E(g)$abs.corr))
  
  set.seed(1)
  plot(g, arrow.mode=0, vertex.shape='pie',vertex.label.color='black', vertex.label.cex=1, vertex.pie=valuesq,curved=T)
}

# generate graph
tmp <- lapply(c('Hic1','Prdm1'), get_TF_regulatee_graph)

7 session info

sessionInfo()

## R version 4.3.1 (2023-06-16)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Sonoma 14.4.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## 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: America/Los_Angeles
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] RColorBrewer_1.1-3 dplyr_1.1.2        ggplot2_3.4.2      igraph_1.5.0      
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.3      jsonlite_1.8.7    highr_0.10        compiler_4.3.1   
##  [5] webshot_0.5.5     tidyselect_1.2.0  stringr_1.5.0     xml2_1.3.4       
##  [9] tidyr_1.3.0       jquerylib_0.1.4   systemfonts_1.0.4 scales_1.2.1     
## [13] yaml_2.3.7        fastmap_1.1.1     R6_2.5.1          generics_0.1.3   
## [17] knitr_1.43        tibble_3.2.1      kableExtra_1.3.4  munsell_0.5.0    
## [21] svglite_2.1.1     bslib_0.5.0       pillar_1.9.0      rlang_1.1.1      
## [25] utf8_1.2.3        stringi_1.7.12    cachem_1.0.8      xfun_0.39        
## [29] sass_0.4.6        viridisLite_0.4.2 cli_3.6.1         withr_2.5.0      
## [33] magrittr_2.0.3    digest_0.6.31     rvest_1.0.3       grid_4.3.1       
## [37] rstudioapi_0.14   lifecycle_1.0.3   vctrs_0.6.3       evaluate_0.21    
## [41] glue_1.6.2        fansi_1.0.4       colorspace_2.1-0  purrr_1.0.1      
## [45] rmarkdown_2.23    httr_1.4.6        tools_4.3.1       pkgconfig_2.0.3  
## [49] htmltools_0.5.5