David Lusseau, a researcher at the University of Aberdeen, observed the group of dolphins of Doubtful Sound. Every time a school of dolphins was encountered in the fjord between 1995 and 2001, each adult member of the school was photographed and identified from natural markings on the dorsal fin. This information was utilised to determine how often two individuals were seen together. Read the full story.

Dataset

Data challenges

  1. Are tied dolphins friends or lovers? [Hint: compute the frequency of links between dolphins of the same sex and compare with the frequency of homosexuality among animals]
  2. Compute degree, closeness, betweenness and PageRank on the network. Are top-ranked dolphins male or female?
  3. Study the correlation among the four centrality measures and visualize it with the corrplot package
library(tidyverse)
library(tidygraph)
library(ggraph)
library(corrplot)

edges = read_csv("dolphin_edges.csv")
nodes = read_csv("dolphin_nodes.csv")
nodes = mutate(nodes, id = row_number()) %>% select(id, everything())
dolphin = tbl_graph(nodes = nodes, edges = edges, directed = FALSE)
dolphin
## # A tbl_graph: 62 nodes and 159 edges
## #
## # An undirected simple graph with 1 component
## #
## # A tibble: 62 × 3
##      id name       sex  
##   <int> <chr>      <chr>
## 1     1 Beak       M    
## 2     2 Beescratch M    
## 3     3 Bumper     M    
## 4     4 CCL        F    
## 5     5 Cross      M    
## 6     6 DN16       F    
## # ℹ 56 more rows
## #
## # A tibble: 159 × 2
##    from    to
##   <int> <int>
## 1     4     9
## 2     6    10
## 3     7    10
## # ℹ 156 more rows
# Are tied dolphins friends or lovers?

actors = as.list(dolphin)$nodes
ties = as.list(dolphin)$edges

ties %>% 
  left_join(actors, by = c("from" = "id")) %>% 
  rename(nameFrom = name, sexFrom = sex) %>% 
  left_join(actors, by = c("to" = "id")) %>% 
  rename(nameTo = name, sexTo = sex) %>% 
  mutate(homo = sexFrom == sexTo) %>% 
  count(homo) %>%   
  mutate(p = n / sum(n))
## # A tibble: 2 × 3
##   homo      n     p
##   <lgl> <int> <dbl>
## 1 FALSE    55 0.346
## 2 TRUE    104 0.654
# Compute degree, closeness, betweenness and PageRank on the network. Are top-ranked dolphins male or female? 

dolphin = 
  dolphin %>% 
  activate(nodes) %>% 
  mutate(degree = centrality_degree(), 
         pagerank = centrality_pagerank(), 
         closeness = centrality_closeness(),
         betweenness = centrality_betweenness())

actors = as.list(dolphin)$nodes

actors %>% 
  group_by(sex) %>% 
  summarise(avg_degree = mean(degree),
            avg_pagerank = mean(pagerank),
            avg_closeness = mean(closeness),
            avg_betweenness = mean(betweenness))
## # A tibble: 3 × 5
##   sex   avg_degree avg_pagerank avg_closeness avg_betweenness
##   <chr>      <dbl>        <dbl>         <dbl>           <dbl>
## 1 F           5.6        0.0169       0.00529            86.2
## 2 M           5.06       0.0162       0.00493            66.8
## 3 U           2.75       0.0104       0.00431            24.8
# Study the correlation among the four centrality measures.

M = cbind(degree = actors$degree,
          pagerank = actors$pagerank,
          closeness = actors$closeness,
          betweenness = actors$betweenness)


(corM = cor(M))
##                degree  pagerank closeness betweenness
## degree      1.0000000 0.9830948 0.7126718   0.5902140
## pagerank    0.9830948 1.0000000 0.6217912   0.6021920
## closeness   0.7126718 0.6217912 1.0000000   0.6657346
## betweenness 0.5902140 0.6021920 0.6657346   1.0000000
corrplot(corM, method = "ellipse")