ggrah_circle_network_igraph

rm(list = ls())
#1.1 input data
dir_path <- "C:\\Users\\liyix\\OneDrive\\Desktop\\data\\"
dir_path_name <- list.files(pattern = ".*xlsx",dir_path,full.names = T, recursive = T)
#dir_path_name
library(openxlsx)
library(tidyverse)

## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --

## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.6     v dplyr   1.0.8
## v tidyr   1.2.0     v stringr 1.4.0
## v readr   2.1.2     v forcats 0.5.1

## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

#######################TWO_STEP_DATA
#getSheetNames(grep("edge.xlsx",dir_path_name, value = T))
data_1 <- read.xlsx(grep("data.xlsx",dir_path_name, value = T), sheet = 1,startRow = 1)
#head(data_1,2)
data_1

##   Prediction Molecular_Fingerprints Feature_Selection Data_Rebalancing
## 1     OPRD-a                   MACS               Chi           Up ing
## 2  OPRD-anta                   MACS               Chi           Up ing
## 3     OPRK-a                   MACS               Chi           Up ing
## 4  OPRK-anta                   MACS               Chi           Up ing
## 5     OPRM-a                   MACS               Chi           Up ing
## 6  OPRM-anta                   MACS               Chi           Up ing
##   Machine_Learning Model.peNBormace1 Model.peNBormace2 Model.peNBormace3
## 1               NB           AUC-ROC                BA               MCC
## 2               NB           AUC-ROC                BA               MCC
## 3               NB           AUC-ROC                BA               MCC
## 4               NB           AUC-ROC                BA               MCC
## 5               NB           AUC-ROC                BA               MCC
## 6               NB           AUC-ROC                BA               MCC

data_2 <- gather(data_1, key = key , value = value, -Prediction)
#head(data_2)
data_2$key <- paste0("(",data_2$key, ")")
data_2$to <- paste0(data_2$value, "\n",data_2$key)
data_2$key <- data_2$value <- NULL
colnames(data_2)[1] <- "from"
data_2$to <- gsub("_", " ", data_2$to)
#unique(data_2$to)
data_2$to <- gsub("\\.", " ", data_2$to)
data_2$to <- gsub("[[:digit:]]", "", data_2$to)
data_edge_1 <- data_2
#View(data_edge_1)
########################################################
data_node <- data.frame(c(unique(data_2$from), unique(data_2$to)))
colnames(data_node) <- "node"
#data_node; data_edge_1
data_edge_1$from %in% data_node$node

##  [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE

data_edge_1$to %in% data_node$node

##  [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE

#################################################data_2
hierarchy <- data.frame('from' = rep('origin', nrow(data_node)), 
                        'to' = data_node$node)
vertices <- data.frame(name = unique(c(as.character(hierarchy$from), as.character(hierarchy$to))) ) 
#View(hierarchy)    
#head(hierarchy)
library(ggraph)
library(igraph)

## 
## 载入程辑包：'igraph'

## The following objects are masked from 'package:dplyr':
## 
##     as_data_frame, groups, union

## The following objects are masked from 'package:purrr':
## 
##     compose, simplify

## The following object is masked from 'package:tidyr':
## 
##     crossing

## The following object is masked from 'package:tibble':
## 
##     as_data_frame

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

library(RColorBrewer)
mygraph <- graph_from_data_frame(hierarchy, vertices=vertices)
#igraph::as_data_frame(mygraph, what="vertices")
#igraph::as_data_frame(mygraph, what="edges")
#mygraph_1 <- create_layout(mygraph, layout = 'linear')
#mygraph_1
##########################################
from  <-  match(data_edge_1$from, vertices$name)
to  <-  match(data_edge_1$to,vertices$name)
ggraph(mygraph, layout = 'dendrogram', circular = TRUE) + 
  geom_conn_bundle(data = get_con(from = from, to = to), 
                   alpha=.3, width=1, tension = 0.9, aes(color = name)) +
  geom_node_text(aes( x = x*1.07, y=y*1.07,label=name,filter = leaf,
                      angle = node_angle(x, y), hjust = 'outward'), 
                 show.legend = F, size=2, alpha=1) +
  theme_void()  +
  geom_node_point(aes(filter = leaf), size = 5,
                  color = c(brewer.pal(n = 6, name = "Pastel2"), 
                            rep("#CCCCCC",7)),
                  alpha= 1, show.legend = F) +
  coord_fixed() +
  theme_graph() +
  scale_x_discrete(expand = c(.1,.1)) +
  scale_y_discrete(expand = c(.1,.1))+
  theme(legend.position="none",
        plot.margin=unit(c(0,0,0,0),"cm"))

###################################################
ggsave(paste0(Sys.Date(),"-model_ggraph1.tiff"), 
       plot = last_plot(), device = NULL, 
       path = dir_path,
       scale = 1, width =12, height = 12, units ="cm",dpi = 300, 
       limitsize = TRUE,compression = "lzw")
display.brewer.pal(n = 8, name = "Pastel2")

brewer.pal(n = 8, name = "Pastel2")

## [1] "#B3E2CD" "#FDCDAC" "#CBD5E8" "#F4CAE4" "#E6F5C9" "#FFF2AE" "#F1E2CC"
## [8] "#CCCCCC"

#https://ggraph.data-imaginist.com/reference/geom_edge_arc.html
#https://rdrr.io/cran/ggraph/man/node_angle.html
#https://r-graph-gallery.com/311-add-labels-to-hierarchical-edge-bundling.html

ggrah_circle_network_igraph_dendrogram.R

liyix

2022-07-06