friend network

library(tidyverse)

── 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)                    # This is the package to analyze the network

Warning: package 'igraph' was built under R version 4.3.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)                # Creates visualizations of the network

Warning: package 'visNetwork' was built under R version 4.3.3

library(DT)
library(plotly)

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)                     # includes some of our regression functions

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.

1. Create a data table with scores for nominator and nominated, and be sure to include an appropriate title.

friendships |> 
  group_by(nominated, nominator) |> 
  summarize(Mean = round(mean(score), 1)) |> 
  arrange(-Mean) |> 
  datatable(rownames = F,
            caption = 'Friendship Score')

`summarise()` has grouped output by 'nominated'. You can override using the
`.groups` argument.

1. This table shows each friendship score given to every person by their peers. This table is organized by the best friendships to the worst friendships.

2. Plot the scores and the expected_scores, and include a regression line.

friendships_model <- lm(expected_score ~ score, data = friendships)

friendships |> 
  plot_ly(x = ~score, y = ~expected_score) |> 
  add_markers() |> 
  add_lines(y = fitted(friendships_model))

2. This regression line shows that no matter how people expected to be scored, there was always inconsistency when compared with their actual score.

3. After creating the network object, use the degree function to create a data table with named_friends, named_by_others, and popularity.

friends <- friendships |> 
  filter(score > 2) |> 
  select(nominator, nominated) |> 
  rename(from = nominator) |> 
  rename(to = nominated)
  

friend_network <- graph_from_data_frame(friends, friendship_nodes, directed = T)

friend_network

IGRAPH 5247b2c DN-- 84 1353 -- 
+ attr: name (v/n)
+ edges from 5247b2c (vertex names):
  [1] 1-> 4 1-> 8 1-> 9 1->10 1->11 1->16 1->22 1->25 1->29 1->30 1->38 1->40
 [13] 1->43 1->45 1->46 1->52 1->59 1->66 1->67 1->69 1->71 1->72 1->75 1->80
 [25] 1->82 1->83 2->26 2->34 2->57 2->62 2->65 3-> 6 3-> 7 3->19 3->24 3->28
 [37] 3->31 3->35 3->36 3->38 3->41 3->43 3->48 3->50 3->51 3->54 3->61 3->74
 [49] 3->76 3->77 3->84 4-> 1 4->15 4->20 4->30 4->36 4->40 4->52 4->58 4->59
 [61] 4->66 4->70 4->72 4->79 5->21 5->24 5->32 5->34 5->39 5->46 5->56 5->62
 [73] 5->65 5->80 6-> 3 6-> 5 6-> 9 6->12 6->15 6->19 6->20 6->27 6->28 6->35
 [85] 6->36 6->38 6->41 6->44 6->48 6->50 6->51 6->52 6->54 6->58 6->60 6->66
+ ... omitted several edges

degree(friend_network)

 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
58  9 39 29 22 51 30 19 39 28 78 28 28 18 30 36 22 30 32 43 24 41 12 55 42 22 
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 
 7 23 26 60 43 22 11 22 28 42  9 62 49 46 42 40 33 38 36 25 21 38 16 42 45 50 
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 
23 56  4 78  9 29 41 28 29 20 41 12 32 32 31 38 33 29 45 59  2 23 53 25 26 18 
79 80 81 82 83 84 
19 26  0 39 37 28 

degree(friend_network, mode = "in")

 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
32  4 19 16 12 20 15 12 23 12 26 14  9 12 11 14 11 12 19 13  9 23  3 25 28 12 
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 
 5 16 13 27 25 13  7 14 12 20  3 24 20 26 20 13 19 20 21 15 18 14  5 18 21 28 
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 
13 29  2 23  6 14 24 17 16 11 30  9 16 21 18 22 16 10 19 28  1 15 33 10 19  4 
79 80 81 82 83 84 
14 16  0 16 23 15 

degree(friend_network, mode = "out")

 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
26  5 20 13 10 31 15  7 16 16 52 14 19  6 19 22 11 18 13 30 15 18  9 30 14 10 
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 
 2  7 13 33 18  9  4  8 16 22  6 38 29 20 22 27 14 18 15 10  3 24 11 24 24 22 
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 
10 27  2 55  3 15 17 11 13  9 11  3 16 11 13 16 17 19 26 31  1  8 20 15  7 14 
79 80 81 82 83 84 
 5 10  0 23 14 13 

friendship_nodes |> 
  mutate(named_friends = degree ((friend_network), mode = "out"))

# A tibble: 84 × 3
      id  name named_friends
   <dbl> <dbl>         <dbl>
 1     1     1            26
 2     2     2             5
 3     3     3            20
 4     4     4            13
 5     5     5            10
 6     6     6            31
 7     7     7            15
 8     8     8             7
 9     9     9            16
10    10    10            16
# ℹ 74 more rows

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

3. This data tables shows how many friends each person named and how many people named them as friends. The last column shows a popularity score where a positive integer shows that more people named them as friends compared to how many people the person named as friends.

4. Create a histogram using plotly of the number of friends that students named.

friendship_nodes |> 
    mutate(named_friends = degree((friend_network), mode = "out")) |> 
    mutate(named_by_others= degree((friend_network), mode = "in")) |> 
    plot_ly(x = ~named_friends) |> 
    add_histogram() |> 
    layout(title = "How many friends each student named")

4. This histogram shows the amount of people who named friends in each group. The largest group of named friends was 10-14 with the smallest group being 40-49.

5. Find the reciprocity in the network.

reciprocity(friend_network, mode = "ratio")

[1] 0.527088

5. The reciprocity for friendship with this data set was a little over 50% of the time.

6. Because there are too many students to visualize all friendships clearly, create a new network using only best friends. Size the nodes by degree, and include different colors for the communities.

best_friends <- friendships |> 
  filter(score > 4) |> 
  select(nominator, nominated) |> 
  rename(from = nominator) |> 
  rename(to = nominated)

best_friend_network <- graph_from_data_frame(best_friends, friendship_nodes, directed = T)

friendship_nodes |> 
  mutate(group = membership(infomap.community(best_friend_network))) |>   
  visNetwork(best_friends, main = "Network of Best Friends") |> 
  visIgraphLayout(layout = "layout_with_kk") |> 
  visEdges(arrows = "to") |> 
  visOptions(highlightNearest = T, nodesIdSelection = T) 

Warning: There was 1 warning in `mutate()`.
ℹ In argument: `group = membership(infomap.community(best_friend_network))`.
Caused by warning:
! `infomap.community()` was deprecated in igraph 2.0.0.
ℹ Please use `cluster_infomap()` instead.

6. This network of best friends shows each connection of the strongest friendship, a score of 5, between two people. It also shows that some people were rated as best friends but did not rate others back and who rated other people as best friends but did not have the feelings reciprocated. Lastly, there were some people who neither rated anyone as a best friend or was rated by others as a best friend.