[R] geom_edge & color

sibyiie@stoeckii m@iii@g oii gmx@ch sibyiie@stoeckii m@iii@g oii gmx@ch
Fri Mar 22 08:59:08 CET 2024


Dear community

 

Find enclosed the full working example.

 

Many thanks

Sibylle

 

Test_cat.csv


Names

Subcategory_type

sources.cyto

source

Factor


A.A

material

"A"

A

1


B.B

material

"B"

B

1


C.C

regulation

"C"

C

1


D.D

regulation

"D"

D

1


E.E

habitat

"E"

E

1


F.F

cultural

"F"

F

1

 

Test_adjac.csv

	
A.A

B.B

C.C

D.D

E.E

F.F


A.A

0

0

5

5

5

5


B.B

4

0

1

1

1

1


C.C

5

5

0

5

4

2


D.D

5

0

5

0

5

3


E.E

5

1

5

5

0

4


F.F

1

2

3

4

5

5

 

 

Edges_table-Test.csv

 


Names

target

weight

relationship


B.B

A.A

4

pos


C.C

A.A

5

pos


D.D

A.A

5

neg


E.E

A.A

5

pos


F.F

A.A

1

pos


C.C

B.B

5

pos


E.E

B.B

1

pos


F.F

B.B

2

neg


A.A

C.C

5

pos


B.B

C.C

1

pos


D.D

C.C

5

pos


E.E

C.C

5

pos


F.F

C.C

3

pos


A.A

D.D

5

neg


B.B

D.D

1

pos


C.C

D.D

5

pos


E.E

D.D

5

pos


F.F

D.D

4

pos


A.A

E.E

5

pos


B.B

E.E

1

pos


C.C

E.E

4

pos


D.D

E.E

5

pos


F.F

E.E

5

pos


A.A

F.F

5

pos


B.B

F.F

1

neg


C.C

F.F

2

pos


D.D

F.F

3

pos


E.E

F.F

4

pos


F.F

F.F

5

pos

 

 

 

#upload librairies

library(circlize)

library(ggplot2)

library(igraph)

library(tidyverse)

library(RColorBrewer)

library(stringi)

library(scico)

library(plotly)

library(ggraph)

 

#upload

aes<-read.csv("Test_adjac.csv", row.names = 1)

details<-read.csv("Test_cat.csv")

 

 

# adjacency  table 

aes_collapsed<-aes %>%

  rownames_to_column(var='Names') %>%

  tidyr::gather(target, weight, 1:ncol(aes)+1) %>%

  dplyr::filter(weight != 0) %>%

  mutate(weight = ifelse(weight == "-1", 0, weight)) # here 0 = negative values

 

write.csv(aes_collapsed, "edges_table-Test.csv", row.names = F)

edge_list<-read.csv("edges_table-Test.csv")

 

 

#create network and add some necessary attributes (vertices) for the plot

 

network <- graph_from_data_frame(aes_collapsed, directed= FALSE, 

                                 vertices = details)

 

### network and vertex with 'subcategory_type'

 

temp<-cluster_optimal(network)

temp<-cbind(membership=temp$membership, Names=temp$name)

aes_collapsed <- aes_collapsed %>%

  merge(temp, by="Names")

 

network <- network %>%

  set_edge_attr(name = "type", value = factor(aes_collapsed$Names, 

                                                 ordered = is.ordered(V(network)$name))) %>%

  set_edge_attr(name = "membership", value = aes_collapsed$membership) %>%

  set_edge_attr(name = "color", 

              value = c(viridis::viridis(21))

              [match(E(.)$type, c(factor(V(.)$name)))]) %>%

  set_vertex_attr(name = "trans_v_net", value = c(transitivity(., type = "local"))) %>%

  set_vertex_attr(name = "hub_score", value = c(hub_score(.)$vector)) %>%

  set_vertex_attr(name = "color", 

              value = c(viridis::viridis((21)))

              [match(V(.)$name, c(factor(V(.)$name)))]) %>%

  set_vertex_attr(name= "community", value=cluster_optimal(.)$Subcategory_type)

 

clrs<-scico(3, palette = "batlow")

 

windowsFonts(Helvetica = windowsFont("Helvetica")) 

 

par(bg="black")

network %>% plot(

     vertex.color=clrs[V(.)$community], 

     vertex.size=V(.)$hub_score*20, 

     vertex.frame.color=V(.)$color, 

     vertex.label.color="white", 

     vertex.label.cex=0.4, 

     vertex.label.family="Helvetica",

     vertex.label.font=0.75,

     edge.curved=0.5,

     edge.width= E(.)$weight,

     edge.color = ifelse(edge_list$relationship == "pos", "blue", "red"),

     layout=layout_with_mds(.))

 

tiff("figures/Test_network_bysubcatecory.tiff", width=1000, height=900, res=120)

network %>%

  ggraph(., layout = "auto")+

  geom_edge_arc(curvature=0.3, aes(width=(E(network)$weight/10), color=c("darkblue", "red")[as.factor(edge_list$relationship)], alpha=0.5)) + 

  geom_node_point(aes(size = V(network)$hub_score*200, color= as.factor(V(network)$community))) +

  geom_node_text(aes(label =  V(network)$name), size=3, color="white", repel=T)+

  scale_color_scico_d(palette = "batlow")+

  scale_edge_width(range = c(0.2,4))+

  scale_size(range = c(0.5,15)) +

  theme(plot.background = element_rect(fill = "black"),

        legend.position = "right",

        panel.background = element_rect(fill = "black"))

dev.off()

 

-----Original Message-----
From: R-help <r-help-bounces using r-project.org> On Behalf Of Kimmo Elo
Sent: Thursday, March 21, 2024 10:51 AM
To: r-help using r-project.org
Subject: Re: [R] geom_edge & color

 

Dear Sibylle,

 

your example is not working! E.g. no data for "aes_collapsed".

 

Best,

 

Kimmo

 

ke, 2024-03-20 kello 19:28 +0100, SIBYLLE STÖCKLI via R-help kirjoitti:

> Dear community

> 

> I am using ggraph to plot a network analysis. See part 2 in the 

> working example.

> Besides different colors for different groups of nodes:

> --> geom_node_point(aes(size = V(network)$hub_score*200, color=

> as.factor(V(network)$community)))

> I additionally want to consider different colors for different edge 

> groups The grouping is defined in the edge_list$relationship: negative 

> relationship = red and positive relationship = darkblue. The code is 

> working in the way that the  groups are separated by two colors. 

> However, the code uses not the assigned colors. Does anyone have any 

> idea how to adapt the code?

> --> geom_edge_arc(curvature=0.3, aes(width=(E(network)$weight/10),

> color=c("darkblue", "red")[as.factor(edge_list$relationship)],

> alpha=0.5)) +

> 

> Kind regards

> Sibylle

> 

> 

> 

> 

> Working example

> 

> library(circlize)

> library(ggplot2)

> library(igraph)

> library(tidyverse)

> library(RColorBrewer)

> library(stringi)

> library(scico)

> library(plotly)

> library(ggraph)

> 

> edges_table_Test.csv

> 

> Names   target  weight relationship

> B.B     A.A     4           pos

> C.C     A.A     5           pos

> D.D     A.A     5           neg

> E.E     A.A     5          neg

> F.F     A.A     1          pos

> C.C     B.B     5         pos

> E.E     B.B     1           pos

> F.F     B.B     2          pos

> A.A     C.C     5        pos

> B.B     C.C     1        pos

> D.D     C.C     5         pos

> E.E     C.C     5         pos

> F.F     C.C     3         pos

> A.A     D.D     5        neg

> B.B     D.D     1        neg

> C.C     D.D     5        neg

> E.E     D.D     5        neg

> F.F     D.D     4         neg

> A.A     E.E     5         neg

> B.B     E.E     1        neg

> C.C     E.E     4        neg

> D.D     E.E     5        neg

> F.F     E.E     5       pos

> A.A     F.F     5        pos

> B.B     F.F     1       pos

> C.C     F.F     2       pos

> D.D     F.F     3      pos

> E.E     F.F     4       pos

> F.F     F.F     5       pos

> 

> edge_list<-read.csv("edges_table_Test.csv")

> 

> network <- graph_from_data_frame(aes_collapsed, directed= FALSE,

>                                  vertices = details)

> 

> temp<-cluster_optimal(network)

> temp<-cbind(membership=temp$membership, Names=temp$name) aes_collapsed 

> <- aes_collapsed %>%

>   merge(temp, by="Names")

> 

> 

> network <- network %>%

>   set_edge_attr(name = "type", value = factor(aes_collapsed$Names,

>                                                  ordered =

> is.ordered(V(network)$name))) %>%

>   set_edge_attr(name = "membership", value = aes_collapsed$membership) 

> %>%

>   set_edge_attr(name = "color",

>               value = c(viridis::viridis(5))

>               [match(E(.)$type, c(factor(V(.)$name)))]) %>%

>   set_vertex_attr(name = "trans_v_net", value = c(transitivity(., type 

> =

> "local"))) %>%

>   set_vertex_attr(name = "hub_score", value = c(hub_score(.)$vector)) 

> %>%

>   set_vertex_attr(name = "color",

>               value = c(viridis::viridis((5)))

>               [match(V(.)$name, c(factor(V(.)$name)))]) %>%

>   set_vertex_attr(name= "community", 

> value=cluster_optimal(.)$membership)

> clrs<-scico(3, palette = "batlow")

> 

> ### part 1: network plot

> par(bg="black")

> network %>% plot(

>      vertex.color=clrs[V(.)$community],

>      vertex.size=V(.)$hub_score*5,

>      vertex.frame.color=V(.)$color,

>      vertex.label.color="white",

>      vertex.label.cex=0.5,

>      vertex.label.family="Helvetica",

>      vertex.label.font=1,

>      edge.curved=0.5,

>      edge.width= network,

>      layout=layout_with_mds(.))

> 

> ### part 2: ggraph

> tiff("figures/AES_network_bymembership.tiff", width=1000, height=700,

> res=120) network %>%

>   ggraph(., layout = "auto")+

> geom_edge_arc(curvature=0.3, aes(width=(E(network)$weight/10), 

> color=c("darkblue", "red")[as.factor(edge_list$relationship)],

> alpha=0.5)) +

> 

>   geom_node_point(aes(size = V(network)$hub_score*200, color=

> as.factor(V(network)$community))) +

>   geom_node_text(aes(label =  V(network)$name), size=5, color="white", 

> repel=T)+

>   scale_color_scico_d(palette = "batlow")+

>   scale_edge_width(range = c(0.2,4))+

>   scale_size(range = c(0.5,20)) +

>   #scale_edge_color_manual(values = c(scico(21, palette="batlow")))+

>   theme(plot.background = element_rect(fill = "black"),

>         legend.position = "right",

>         panel.background = element_rect(fill = "black"))

> dev.off()

> 

> ______________________________________________

>  <mailto:R-help using r-project.org> R-help using r-project.org mailing list -- To UNSUBSCRIBE and more, see 

>  <https://stat.ethz.ch/mailman/listinfo/r-help> https://stat.ethz.ch/mailman/listinfo/r-help

> PLEASE do read the posting guide

>  <http://www.R-project.org/posting-guide.html> http://www.R-project.org/posting-guide.html

> and provide commented, minimal, self-contained, reproducible code.

 

______________________________________________

 <mailto:R-help using r-project.org> R-help using r-project.org mailing list -- To UNSUBSCRIBE and more, see  <https://stat.ethz.ch/mailman/listinfo/r-help> https://stat.ethz.ch/mailman/listinfo/r-help

PLEASE do read the posting guide  <http://www.R-project.org/posting-guide.html> http://www.R-project.org/posting-guide.html

and provide commented, minimal, self-contained, reproducible code.


	[[alternative HTML version deleted]]



More information about the R-help mailing list