Retriving relevant files and Data Preparation

packages = c('tidygraph', 'ggraph', 'visNetwork', 'lubridate', 'tidyverse','plotly','qgraph')

for(p in packages){library
  if(!require(p, character.only = T)){
    install.packages(p)
  }
  library(p, character.only = T)
}

p <- c('tidygraph', 'ggraph', 'visNetwork', 'lubridate', 'tidyverse')
lapply(p, require, character.only = TRUE)
[[1]]
[1] TRUE

[[2]]
[1] TRUE

[[3]]
[1] TRUE

[[4]]
[1] TRUE

[[5]]
[1] TRUE
GAStech_nodes <- read_csv("data/GAStech_email_node.csv")
Parsed with column specification:
cols(
  id = col_double(),
  label = col_character(),
  Department = col_character(),
  Title = col_character()
)
GAStech_edges <- read_csv("data/GAStech_email_edge-v2.csv")
Parsed with column specification:
cols(
  source = col_double(),
  target = col_double(),
  SentDate = col_character(),
  SentTime = col_time(format = ""),
  Subject = col_character(),
  MainSubject = col_character(),
  sourceLabel = col_character(),
  targetLabel = col_character()
)
GAStech_edges$SentDate  = dmy(GAStech_edges$SentDate)
GAStech_edges$Weekday = wday(GAStech_edges$SentDate, label = TRUE, abbr = FALSE)

GAStech_edges_aggregated <- GAStech_edges %>%
  filter(MainSubject == "Work related") %>%
  group_by(source, target, Weekday) %>%
    summarise(Weight = n()) %>%
  filter(source!=target) %>%
  filter(Weight > 1) %>%
  ungroup()
GAStech_graph <- tbl_graph(nodes = GAStech_nodes, edges = GAStech_edges_aggregated, directed = TRUE)
GAStech_graph %>%
  activate(edges) %>%
  arrange(desc(Weight))
# A tbl_graph: 54 nodes and 1456 edges
#
# A directed multigraph with 1 component
#
# Edge Data: 1,456 x 4 (active)
   from    to Weekday Weight
  <int> <int> <ord>    <int>
1    40    41 Tuesday     23
2    40    43 Tuesday     19
3    41    43 Tuesday     15
4    41    40 Tuesday     14
5    42    41 Tuesday     13
6    42    40 Tuesday     12
# ... with 1,450 more rows
#
# Node Data: 54 x 4
     id label           Department     Title           
  <dbl> <chr>           <chr>          <chr>           
1     1 Mat.Bramar      Administration Assistant to CEO
2     2 Anda.Ribera     Administration Assistant to CFO
3     3 Rachel.Pantanal Administration Assistant to CIO
# ... with 51 more rows
GAStech_graph %>%
  activate(edges) %>%
  arrange(desc(Weight))
# A tbl_graph: 54 nodes and 1456 edges
#
# A directed multigraph with 1 component
#
# Edge Data: 1,456 x 4 (active)
   from    to Weekday Weight
  <int> <int> <ord>    <int>
1    40    41 Tuesday     23
2    40    43 Tuesday     19
3    41    43 Tuesday     15
4    41    40 Tuesday     14
5    42    41 Tuesday     13
6    42    40 Tuesday     12
# ... with 1,450 more rows
#
# Node Data: 54 x 4
     id label           Department     Title           
  <dbl> <chr>           <chr>          <chr>           
1     1 Mat.Bramar      Administration Assistant to CEO
2     2 Anda.Ribera     Administration Assistant to CFO
3     3 Rachel.Pantanal Administration Assistant to CIO
# ... with 51 more rows

Task 1: Static Organization Graph
Original Design

set_graph_style()

g <- GAStech_graph %>%
  mutate(betweenness_centrality = centrality_betweenness()) %>%
  mutate(closeness_centrality = centrality_closeness()) %>%
  ggraph(layout = "nicely") + 
  geom_edge_link(aes( )) +
  geom_node_point(aes(colour = closeness_centrality, size=betweenness_centrality))

g + theme_graph()

Three aspects of graph to be improved:
1. There is overlap between edge link and nodes, making it hard to see the connections between nodes
2. Scale colour gradient of nodes colour are too dark to visualize
3. Edge line’s colour is too dark to have a clear view

Improved sketch
Network Graph - Bend

Improved plot

g <- 
  ggraph(GAStech_graph, layout = "nicely",) + 
  geom_edge_link(edge_colour = "gray60",aes()) +
  geom_node_point(aes(colour = centrality_closeness(), size=centrality_betweenness())) +
  scale_colour_gradient(low = "#00008B", high = "#63B8FF")

g + theme_graph() 

Alternative sketch
Network Graph - Bend

g <- GAStech_graph %>%
  mutate(betweenness_centrality = centrality_betweenness()) %>%
  mutate(closeness_centrality = centrality_closeness()) %>%

ggraph(layout = "nicely") + 
  geom_edge_bend(edge_colour = "gray69",aes()) +
  geom_node_point(aes(colour = closeness_centrality, size=betweenness_centrality))+
  scale_colour_gradient(low = "#00008B", high = "#63B8FF")

g + theme_graph()

Task 2: Interactivity Organization Graph

GAStech_edges_aggregated <- GAStech_edges %>%
  left_join(GAStech_nodes, by = c("sourceLabel" = "label")) %>%
  rename(from = id) %>%
  left_join(GAStech_nodes, by = c("targetLabel" = "label")) %>%
  rename(to = id) %>%
  filter(MainSubject == "Work related") %>%
  group_by(from, to) %>%
    summarise(weight = n()) %>%
  filter(from!=to) %>%
  filter(weight > 1) %>%
  ungroup()

GAStech_nodes <- GAStech_nodes %>%
  rename(group = Department)

Plot Alternative sketch
Network Graph - Bend

Original Plot

visNetwork(GAStech_nodes, GAStech_edges_aggregated) %>%
  visIgraphLayout(layout = "layout_with_fr") %>%
  visOptions(highlightNearest = TRUE, nodesIdSelection = TRUE)

Three aspects of graph to be improved:
1. All labels are displayed resulting in overlapping of labels
2. Labels are overlapping with the network links making it difficult to read the labels
3. It does not show the connections between nodes.

Improved plot

GAStech_nodes$shape = "circle"

visNetwork(GAStech_nodes, GAStech_edges_aggregated) %>%
  visIgraphLayout(layout = "layout_with_fr") %>%
  visInteraction(navigationButtons = TRUE) %>%
  visEdges(arrows = "from") %>% 
  visOptions(highlightNearest = list(enabled = TRUE,degree = 1, labelOnly = FALSE, hover = TRUE),
                                     nodesIdSelection = TRUE,)


LS0tDQp0aXRsZTogIkRhdGF2aXogTWFrZW92ZXIgMiINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCjxmb250IHNpemU9IjUiPlJldHJpdmluZyByZWxldmFudCBmaWxlcyBhbmQgRGF0YSBQcmVwYXJhdGlvbjwvZm9udD4NCmBgYHtyfQ0KcGFja2FnZXMgPSBjKCd0aWR5Z3JhcGgnLCAnZ2dyYXBoJywgJ3Zpc05ldHdvcmsnLCAnbHVicmlkYXRlJywgJ3RpZHl2ZXJzZScsJ3Bsb3RseScsJ3FncmFwaCcpDQoNCmZvcihwIGluIHBhY2thZ2VzKXtsaWJyYXJ5DQogIGlmKCFyZXF1aXJlKHAsIGNoYXJhY3Rlci5vbmx5ID0gVCkpew0KICAgIGluc3RhbGwucGFja2FnZXMocCkNCiAgfQ0KICBsaWJyYXJ5KHAsIGNoYXJhY3Rlci5vbmx5ID0gVCkNCn0NCg0KcCA8LSBjKCd0aWR5Z3JhcGgnLCAnZ2dyYXBoJywgJ3Zpc05ldHdvcmsnLCAnbHVicmlkYXRlJywgJ3RpZHl2ZXJzZScpDQpsYXBwbHkocCwgcmVxdWlyZSwgY2hhcmFjdGVyLm9ubHkgPSBUUlVFKQ0KDQpHQVN0ZWNoX25vZGVzIDwtIHJlYWRfY3N2KCJkYXRhL0dBU3RlY2hfZW1haWxfbm9kZS5jc3YiKQ0KR0FTdGVjaF9lZGdlcyA8LSByZWFkX2NzdigiZGF0YS9HQVN0ZWNoX2VtYWlsX2VkZ2UtdjIuY3N2IikNCg0KR0FTdGVjaF9lZGdlcyRTZW50RGF0ZSAgPSBkbXkoR0FTdGVjaF9lZGdlcyRTZW50RGF0ZSkNCkdBU3RlY2hfZWRnZXMkV2Vla2RheSA9IHdkYXkoR0FTdGVjaF9lZGdlcyRTZW50RGF0ZSwgbGFiZWwgPSBUUlVFLCBhYmJyID0gRkFMU0UpDQoNCkdBU3RlY2hfZWRnZXNfYWdncmVnYXRlZCA8LSBHQVN0ZWNoX2VkZ2VzICU+JQ0KICBmaWx0ZXIoTWFpblN1YmplY3QgPT0gIldvcmsgcmVsYXRlZCIpICU+JQ0KICBncm91cF9ieShzb3VyY2UsIHRhcmdldCwgV2Vla2RheSkgJT4lDQogICAgc3VtbWFyaXNlKFdlaWdodCA9IG4oKSkgJT4lDQogIGZpbHRlcihzb3VyY2UhPXRhcmdldCkgJT4lDQogIGZpbHRlcihXZWlnaHQgPiAxKSAlPiUNCiAgdW5ncm91cCgpDQpHQVN0ZWNoX2dyYXBoIDwtIHRibF9ncmFwaChub2RlcyA9IEdBU3RlY2hfbm9kZXMsIGVkZ2VzID0gR0FTdGVjaF9lZGdlc19hZ2dyZWdhdGVkLCBkaXJlY3RlZCA9IFRSVUUpDQpHQVN0ZWNoX2dyYXBoICU+JQ0KICBhY3RpdmF0ZShlZGdlcykgJT4lDQogIGFycmFuZ2UoZGVzYyhXZWlnaHQpKQ0KDQpHQVN0ZWNoX2dyYXBoICU+JQ0KICBhY3RpdmF0ZShlZGdlcykgJT4lDQogIGFycmFuZ2UoZGVzYyhXZWlnaHQpKQ0KYGBgDQoNCmBgYHtyfQ0KDQpgYGANCjxmb250IHNpemU9IjUiPlRhc2sgMTogU3RhdGljIE9yZ2FuaXphdGlvbiBHcmFwaDxicj48L2ZvbnQ+DQo8Zm9udCBzaXplPSI1Ij5PcmlnaW5hbCBEZXNpZ248L2ZvbnQ+DQoNCmBgYHtyfQ0Kc2V0X2dyYXBoX3N0eWxlKCkNCg0KZyA8LSBHQVN0ZWNoX2dyYXBoICU+JQ0KICBtdXRhdGUoYmV0d2Vlbm5lc3NfY2VudHJhbGl0eSA9IGNlbnRyYWxpdHlfYmV0d2Vlbm5lc3MoKSkgJT4lDQogIG11dGF0ZShjbG9zZW5lc3NfY2VudHJhbGl0eSA9IGNlbnRyYWxpdHlfY2xvc2VuZXNzKCkpICU+JQ0KICBnZ3JhcGgobGF5b3V0ID0gIm5pY2VseSIpICsgDQogIGdlb21fZWRnZV9saW5rKGFlcyggKSkgKw0KICBnZW9tX25vZGVfcG9pbnQoYWVzKGNvbG91ciA9IGNsb3NlbmVzc19jZW50cmFsaXR5LCBzaXplPWJldHdlZW5uZXNzX2NlbnRyYWxpdHkpKQ0KDQpnICsgdGhlbWVfZ3JhcGgoKQ0KYGBgDQo8Zm9udCBzaXplPSI1Ij5UaHJlZSBhc3BlY3RzIG9mIGdyYXBoIHRvIGJlIGltcHJvdmVkOjxicj48L2ZvbnQ+DQoxLiBUaGVyZSBpcyBvdmVybGFwIGJldHdlZW4gZWRnZSBsaW5rIGFuZCBub2RlcywgbWFraW5nIGl0IGhhcmQgdG8gc2VlIHRoZSBjb25uZWN0aW9ucyBiZXR3ZWVuIG5vZGVzPGJyPg0KMi4gU2NhbGUgY29sb3VyIGdyYWRpZW50IG9mIG5vZGVzIGNvbG91ciBhcmUgdG9vIGRhcmsgdG8gdmlzdWFsaXplPGJyPg0KMy4gRWRnZSBsaW5lJ3MgY29sb3VyIGlzIHRvbyBkYXJrIHRvIGhhdmUgYSBjbGVhciB2aWV3PGJyPg0KDQo8Zm9udCBzaXplPSI1Ij5JbXByb3ZlZCBza2V0Y2g8YnI+PC9mb250Pg0KIVtOZXR3b3JrIEdyYXBoIC0gQmVuZF0oV1dXL3Rhc2sxXzMuanBnKXsjaWQgLmNsYXNzIHdpZHRoPTUwJSBoZWlnaHQ9NTAlfQ0KDQo8Zm9udCBzaXplPSI1Ij5JbXByb3ZlZCBwbG90PC9mb250Pg0KDQpgYGB7cn0NCmcgPC0gDQogIGdncmFwaChHQVN0ZWNoX2dyYXBoLCBsYXlvdXQgPSAibmljZWx5IiwpICsgDQogIGdlb21fZWRnZV9saW5rKGVkZ2VfY29sb3VyID0gImdyYXk2MCIsYWVzKCkpICsNCiAgZ2VvbV9ub2RlX3BvaW50KGFlcyhjb2xvdXIgPSBjZW50cmFsaXR5X2Nsb3NlbmVzcygpLCBzaXplPWNlbnRyYWxpdHlfYmV0d2Vlbm5lc3MoKSkpICsNCiAgc2NhbGVfY29sb3VyX2dyYWRpZW50KGxvdyA9ICIjMDAwMDhCIiwgaGlnaCA9ICIjNjNCOEZGIikNCg0KZyArIHRoZW1lX2dyYXBoKCkgDQpgYGANCg0KDQo8Zm9udCBzaXplPSI1Ij5BbHRlcm5hdGl2ZSBza2V0Y2g8YnI+PC9mb250Pg0KIVtOZXR3b3JrIEdyYXBoIC0gQmVuZF0oV1dXL3Rhc2tfMV8yLmpwZyl7I2lkIC5jbGFzcyB3aWR0aD01MCUgaGVpZ2h0PTUwJX0NCg0KDQpgYGB7cn0NCmcgPC0gR0FTdGVjaF9ncmFwaCAlPiUNCiAgbXV0YXRlKGJldHdlZW5uZXNzX2NlbnRyYWxpdHkgPSBjZW50cmFsaXR5X2JldHdlZW5uZXNzKCkpICU+JQ0KICBtdXRhdGUoY2xvc2VuZXNzX2NlbnRyYWxpdHkgPSBjZW50cmFsaXR5X2Nsb3NlbmVzcygpKSAlPiUNCg0KZ2dyYXBoKGxheW91dCA9ICJuaWNlbHkiKSArIA0KICBnZW9tX2VkZ2VfYmVuZChlZGdlX2NvbG91ciA9ICJncmF5NjkiLGFlcygpKSArDQogIGdlb21fbm9kZV9wb2ludChhZXMoY29sb3VyID0gY2xvc2VuZXNzX2NlbnRyYWxpdHksIHNpemU9YmV0d2Vlbm5lc3NfY2VudHJhbGl0eSkpKw0KICBzY2FsZV9jb2xvdXJfZ3JhZGllbnQobG93ID0gIiMwMDAwOEIiLCBoaWdoID0gIiM2M0I4RkYiKQ0KDQpnICsgdGhlbWVfZ3JhcGgoKQ0KDQpgYGANCjxmb250IHNpemU9IjUiPlRhc2sgMjogSW50ZXJhY3Rpdml0eSBPcmdhbml6YXRpb24gR3JhcGg8L2ZvbnQ+DQpgYGB7cn0NCkdBU3RlY2hfZWRnZXNfYWdncmVnYXRlZCA8LSBHQVN0ZWNoX2VkZ2VzICU+JQ0KICBsZWZ0X2pvaW4oR0FTdGVjaF9ub2RlcywgYnkgPSBjKCJzb3VyY2VMYWJlbCIgPSAibGFiZWwiKSkgJT4lDQogIHJlbmFtZShmcm9tID0gaWQpICU+JQ0KICBsZWZ0X2pvaW4oR0FTdGVjaF9ub2RlcywgYnkgPSBjKCJ0YXJnZXRMYWJlbCIgPSAibGFiZWwiKSkgJT4lDQogIHJlbmFtZSh0byA9IGlkKSAlPiUNCiAgZmlsdGVyKE1haW5TdWJqZWN0ID09ICJXb3JrIHJlbGF0ZWQiKSAlPiUNCiAgZ3JvdXBfYnkoZnJvbSwgdG8pICU+JQ0KICAgIHN1bW1hcmlzZSh3ZWlnaHQgPSBuKCkpICU+JQ0KICBmaWx0ZXIoZnJvbSE9dG8pICU+JQ0KICBmaWx0ZXIod2VpZ2h0ID4gMSkgJT4lDQogIHVuZ3JvdXAoKQ0KDQpHQVN0ZWNoX25vZGVzIDwtIEdBU3RlY2hfbm9kZXMgJT4lDQogIHJlbmFtZShncm91cCA9IERlcGFydG1lbnQpDQpgYGANCjxmb250IHNpemU9IjUiPlBsb3QgQWx0ZXJuYXRpdmUgc2tldGNoPGJyPjwvZm9udD4NCiFbTmV0d29yayBHcmFwaCAtIEJlbmRdKFdXVy90YXNrMi5qcGcpeyNpZCAuY2xhc3Mgd2lkdGg9NTAlIGhlaWdodD01MCV9DQoNCg0KPGZvbnQgc2l6ZT0iNSI+T3JpZ2luYWwgUGxvdDwvZm9udD4NCmBgYHtyfQ0KdmlzTmV0d29yayhHQVN0ZWNoX25vZGVzLCBHQVN0ZWNoX2VkZ2VzX2FnZ3JlZ2F0ZWQpICU+JQ0KICB2aXNJZ3JhcGhMYXlvdXQobGF5b3V0ID0gImxheW91dF93aXRoX2ZyIikgJT4lDQogIHZpc09wdGlvbnMoaGlnaGxpZ2h0TmVhcmVzdCA9IFRSVUUsIG5vZGVzSWRTZWxlY3Rpb24gPSBUUlVFKQ0KYGBgDQoNCjxmb250IHNpemU9IjUiPlRocmVlIGFzcGVjdHMgb2YgZ3JhcGggdG8gYmUgaW1wcm92ZWQ6IDxicj48L2ZvbnQ+DQoxLiBBbGwgbGFiZWxzIGFyZSBkaXNwbGF5ZWQgcmVzdWx0aW5nIGluIG92ZXJsYXBwaW5nIG9mIGxhYmVsczxicj4NCjIuIExhYmVscyBhcmUgb3ZlcmxhcHBpbmcgd2l0aCB0aGUgbmV0d29yayBsaW5rcyBtYWtpbmcgaXQgZGlmZmljdWx0IHRvIHJlYWQgdGhlIGxhYmVsczxicj4NCjMuIEl0IGRvZXMgbm90IHNob3cgdGhlIGNvbm5lY3Rpb25zIGJldHdlZW4gbm9kZXMuPGJyPg0KDQo8Zm9udCBzaXplPSI1Ij5JbXByb3ZlZCBwbG90PC9mb250Pg0KYGBge3J9DQpHQVN0ZWNoX25vZGVzJHNoYXBlID0gImNpcmNsZSINCg0KdmlzTmV0d29yayhHQVN0ZWNoX25vZGVzLCBHQVN0ZWNoX2VkZ2VzX2FnZ3JlZ2F0ZWQpICU+JQ0KICB2aXNJZ3JhcGhMYXlvdXQobGF5b3V0ID0gImxheW91dF93aXRoX2ZyIikgJT4lDQogIHZpc0ludGVyYWN0aW9uKG5hdmlnYXRpb25CdXR0b25zID0gVFJVRSkgJT4lDQogIHZpc0VkZ2VzKGFycm93cyA9ICJmcm9tIikgJT4lIA0KICB2aXNPcHRpb25zKGhpZ2hsaWdodE5lYXJlc3QgPSBsaXN0KGVuYWJsZWQgPSBUUlVFLGRlZ3JlZSA9IDEsIGxhYmVsT25seSA9IEZBTFNFLCBob3ZlciA9IFRSVUUpLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG5vZGVzSWRTZWxlY3Rpb24gPSBUUlVFLCkNCmBgYA0KDQo8YnI+