assignment friendships

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)
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 |> 
  group_by(nominated, nominator) |> 
  datatable(rownames = F,
            caption = 'Friendship ratings given and expected by each student')

  1. In looking at this data table, it seems that this data set follows the trend of rating and expected rating being the same.

    student_model <- lm(expected_score ~ score, data = friendships)
    friendships %>% 
plot_ly(x = ~score, y = ~expected_score) %>%
  add_markers() %>% 
  add_lines(y = fitted(student_model))
    1. The regression line is pretty straight, supporting my observation above.
friends <- friendships |> 
  filter(score > 3) |> 
  select(nominator, nominated) |> 
  rename(from = nominator) |> 
  rename(to = nominated)
student_network <- graph_from_data_frame(friends, friendship_nodes, directed = T)
degree(student_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 
33  1 13 12  8 19 11 10 19 14 56 13 12  9 14 17 10 12 20 16  7 15  2 22 22  4 
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 
 3  6 14 24 12 12  6  8 10 19  2 23 29 15 23 16 11 13 14 15  4 14  8 11 14 11 
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 
 3 19  2 27  3 15 22 14  9  8  9  7  6 15 19 11 16 12 18 27  2  9 15 11  9  4 
79 80 81 82 83 84 
 6 15  0 16 20 13 
friendship_nodes |> 
    mutate(named_friends = degree((student_network), mode = "out")) |> 
  mutate(named_by_others= degree((student_network), mode = "in")) |> 
  mutate(popularity = named_by_others - named_friends) %>% 
  select(name, named_friends, named_by_others, popularity) |> 
  datatable(rownames = F)
  1. It looks like student 11 had a bigger difference in named (41) and returned friendships (15). They however had the second most named by others ratings than anyone else. Student 1 had 19 named by others and named 14 themselves.
friendship_nodes %>% 
    mutate(named_friends = degree((student_network), mode = "out")) |> 
  mutate(named_by_others= degree((student_network), mode = "in")) |> 
  plot_ly(x = ~named_friends) %>% 
  add_histogram() %>% 
  layout(title = "How many friends students named")

  1. It looks like in this data set it was most common to name about 6 friends.

    reciprocity(student_network, mode = "ratio")
    [1] 0.5205479

  2. It looks like the reciprocity ratio was about half the named friendships.

    bestfriends <- friendships |> 
  filter(score > 4) |> 
  select(nominator, nominated) |> 
  rename(from = nominator) |> 
  rename(to = nominated)
student_networkbf <- graph_from_data_frame(bestfriends, friendship_nodes, directed = T)
friendship_nodes |> 
  mutate(value = degree(student_networkbf))
# A tibble: 84 × 3
      id  name value
   <dbl> <dbl> <dbl>
 1     1     1    10
 2     2     2     0
 3     3     3     6
 4     4     4     4
 5     5     5     8
 6     6     6     9
 7     7     7     5
 8     8     8     2
 9     9     9    11
10    10    10     5
# ℹ 74 more rows
student_networkbf |> 
  cluster_infomap() %>% 
  membership()
 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 
 1  2  3  4  5  6  6  7  8  9  1 10  9 11 10  1 12 11 13 10  5  9 14 13  9  5 
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 
15 16  9  1 16  5 17 18 19 10 20  1  7  4  6 12 17  8  8  9 21 19 18  6 22 12 
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 
 7  6 23  5 18 10  8  6  3  7  7 11 22  4  1 18  1 10  8  1 15  3  8  3 19 24 
79 80 81 82 83 84 
 8  9 25 11  1  6 
friendship_nodes |>  
   mutate(value = degree(student_networkbf)) %>% 
  mutate(group = membership(infomap.community(student_networkbf))) %>% 
visNetwork(bestfriends, main = "Network of student best-friendships") %>% 
  visIgraphLayout(layout = "layout_nicely") %>% 
  visEdges(arrows = "to") %>% 
  visOptions(highlightNearest = T, nodesIdSelection = T)
Warning: There was 1 warning in `mutate()`.
ℹ In argument: `group = membership(infomap.community(student_networkbf))`.
Caused by warning:
! `infomap.community()` was deprecated in igraph 2.0.0.
ℹ Please use `cluster_infomap()` instead.
  1. The best friends out of this data set cut the numbers in about half. Still a lot of students. Based on the degree function 11 has the most reciprocal best friend ratings. You can see the colored nodes with no connections named no one as their best friend and no one named them as theirs. I tried to add communities just for the best friends network, so I am not sure why it gave the outliars colors.