Network Analysis

library(tidyverse)
Warning: package 'tidyverse' was built under R version 4.2.3
Warning: package 'ggplot2' was built under R version 4.2.3
Warning: package 'tibble' was built under R version 4.2.3
Warning: package 'tidyr' was built under R version 4.2.3
Warning: package 'readr' was built under R version 4.2.3
Warning: package 'purrr' was built under R version 4.2.3
Warning: package 'dplyr' was built under R version 4.2.3
Warning: package 'stringr' was built under R version 4.2.3
Warning: package 'forcats' was built under R version 4.2.3
Warning: package 'lubridate' was built under R version 4.2.3
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.4.4     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(igraph)                    
Warning: package 'igraph' was built under R version 4.2.3

Attaching package: 'igraph'

The following objects are masked from 'package:lubridate':

    %--%, union

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(visNetwork)                
Warning: package 'visNetwork' was built under R version 4.2.3
library(DT)
Warning: package 'DT' was built under R version 4.2.3
library(plotly)
Warning: package 'plotly' was built under R version 4.2.3

Attaching package: 'plotly'

The following object is masked from 'package:igraph':

    groups

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout
library(broom)                     
Warning: package 'broom' was built under R version 4.2.3
friendships <- read_csv("friendships.csv")
Rows: 6972 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl (4): nominator, nominated, score, expected_score

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
friendship_nodes <- read_csv("friendship_nodes.csv")
Rows: 84 Columns: 2
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl (2): id, name

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Data Tables

Let’s first create a table to see the average ratings given by each student in the study.

friendships |> 
  group_by(nominator) |> 
  summarize(Mean = round(mean(score), 1)) |> 
  arrange(-Mean) |> 
  datatable(rownames = F,
            caption = 'Average Friendship Ratings Given by Each Student')

Student 11 and 56 gave the highest scores overall, but are they reciprocated? Let’s see the average ratings given to each student:

friendships |> 
  group_by(nominated) |> 
  summarize(Mean = round(mean(score), 1)) |> 
  arrange(-Mean) |> 
  datatable(rownames = F,
            caption = 'Average Friendship Ratings Received by Each Student')

Student 11 reappears at the top of this list, while students 11 and 63 join them in the group of most well perceived students.

Regression Line

The following graph shows how well the scores students received match their expectations:

student_model <- lm(expected_score ~ score, data = friendships)
friendships |>
  plot_ly(x = ~ score, y = ~ expected_score) |>
  add_markers() |>
  add_lines(y = fitted(student_model))

There seems to be a lot of variance, but on average each student received the score they expected.

Popularity

The following code creates a new variable that looks for links between friends only, meaning they were given a score of 3 or higher. It also creates a variable called “network” used later for analyzing this group of students.

friends <- friendships |> 
  filter(score > 2) |> 
  select(nominator, nominated) |> 
  rename(from = nominator) |> 
  rename(to = nominated)
network <- graph_from_data_frame(friends, friendship_nodes, directed = T)

The following table shows how many names each student gave as their friend, how many other students called them friends, and a “popularity variable” based on this information:

friendship_nodes |> 
  mutate(named_friends = degree((network), mode = "out")) |> 
  mutate(named_by_others = degree((network), mode = "in")) |> 
  mutate(popularity = named_by_others - named_friends) |>
  select(name, named_friends, named_by_others, popularity) |> 
  arrange(-popularity) |>
  datatable(rownames = F)

It seems like student 63 is the most popular student among the group, with 30 people calling them friends while they only called 11 others friends. On the other hand, student 56 only had 23 people calling them friends, and they seemed to largely overestimate how many friends they think they have, leading to a low popularity score.

Histogram

The following histogram shows the number of friends each student named:

friendship_nodes |> 
  mutate(named_friends = degree((network), mode = "out")) |> 
  mutate(named_by_others= degree((network), mode = "in")) |> 
  plot_ly(x = ~named_friends) |>
  add_histogram() |>
  layout(title = "Number of Friends Students Named")

Most students claimed they had between 10-20 friends, with a few outliers at 45-50.

Reciprocity

The following code tells us the reciprocity of this specific student network:

reciprocity(network, mode = "ratio")
[1] 0.527088

The reciprocity in this group is roughly .53, which is higher than the group in the example study.

##Best Friends

Because of the large number of students in this group compared to the example, let’s look exclusively at best friend groups as they will show where the strongest connections are.

best_friends <- friendships |> 
  filter(score > 4) |> 
  select(nominator, nominated) |> 
  rename(from = nominator) |> 
  rename(to = nominated)
best_network <- graph_from_data_frame(friends, friendship_nodes, directed = T)

The following image shows the network of students in this group. Students with larger nodes will have more links than students with smaller nodes.

friendship_nodes |>  
  mutate(group = membership(cluster_infomap(best_network))) |>
  mutate(value = degree(best_network)) |> 
  visNetwork(friends, main = "Network of Student Friendships") |>
  visIgraphLayout(layout = "layout_nicely") |>
  visEdges(arrows = "to") |>
  visOptions(highlightNearest = T, nodesIdSelection = T)

The two largest networks of students seem to be between blue and yellow, while orange represents a student with no best friends in this student group. Ouch.