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.0
✔ 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

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
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

Friendship data finished

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.

friendships |>
    plot_ly(x = ~score) |>
    add_histogram()

friendships |> 
  group_by(nominator) |> 
  summarize(Mean = round(mean(score), 1)) |> 
  arrange(-Mean) |> 
  datatable(rownames = F,
            caption = 'Average friendship ratings given by each individual')

Question 1

friendships |> 
  group_by(nominated) |> 
  summarize(Mean = round(mean(score), 1)) |> 
  arrange(-Mean) |> 
  datatable(rownames = F,
            caption = 'Average ratings given to each individual')

Question 1 - This data table shows the average friendship scores given to each individual by the other participants.

friendships |> 
  group_by(nominator) |> 
  summarize(Mean = round(mean(score), 1)) |> 
  arrange(-Mean) |> 
  datatable(rownames = F,
            caption = 'Average friendship ratings given by each individual')

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

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

tidy(friend_model)

# A tibble: 2 × 5
  term        estimate std.error statistic  p.value
  <chr>          <dbl>     <dbl>     <dbl>    <dbl>
1 (Intercept)   0.0987   0.00739      13.4 3.22e-40
2 score         0.940    0.00352     267.  0       

glance(friend_model)

# A tibble: 1 × 12
  r.squared adj.r.squared sigma statistic p.value    df logLik   AIC   BIC
      <dbl>         <dbl> <dbl>     <dbl>   <dbl> <dbl>  <dbl> <dbl> <dbl>
1     0.911         0.911 0.339    71178.       0     1 -2353. 4713. 4733.
# ℹ 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>

sqrt(0.9108098)

[1] 0.9543636

Question 2

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

Question 2 - This plot chart shows the regression line of the friends scores and their expected scores.

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

# A tibble: 1,353 × 2
    from    to
   <dbl> <dbl>
 1     1     4
 2     1     8
 3     1     9
 4     1    10
 5     1    11
 6     1    16
 7     1    22
 8     1    25
 9     1    29
10     1    30
# ℹ 1,343 more rows

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

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

besties_network <- graph_from_data_frame(besties, friendship_nodes, directed = T)

degree(friend_network)

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

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

question 4 > 2nd histogram

friendship_nodes |> 
    mutate(named_friends = degree((besties_network), mode = "out")) |> 
  mutate(named_by_others = degree((besties_network), mode = "in")) |> 
  plot_ly(x = ~named_friends) |>
  add_histogram() |>
  layout(title = "How many besties individuals named")

friendship_nodes |> 
    mutate(named_friends = degree((besties_network), mode = "out")) |> 
  mutate(named_by_others = degree((besties_network), mode = "in")) |> 
  plot_ly(x = ~named_by_others) |>
  add_histogram() |>
  layout(title = "How many times besties were named by others")

Question 4 - This second histogram shows the amount of times that friends were named by other students.

Question 3 >

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

Question 3 - This chart shows the people who were rated as most popular and least popular based on the ratings given by others.

Question 5 >

reciprocity(friend_network, mode = "ratio")

[1] 1

reciprocity(besties_network, mode = "ratio")

[1] 0.4385965

Question 5 - These show that there are 43% of people who had reciprocal relations to who they believed were their best friends while there is a 52% reciprocal relation between those who rated others as general friends.

plot(besties_network)

visNetwork(friendship_nodes, besties)

friendship_nodes |>  
  mutate(group = membership(infomap.community(besties_network)))

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

# A tibble: 84 × 3
      id  name group     
   <dbl> <dbl> <membrshp>
 1     1     1 1         
 2     2     2 2         
 3     3     3 3         
 4     4     4 4         
 5     5     5 5         
 6     6     6 6         
 7     7     7 6         
 8     8     8 7         
 9     9     9 8         
10    10    10 9         
# ℹ 74 more rows

Question 6 >

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

question 6 - Shows the network of people who are besties with each other and the correlated groups by color.