friend network

STATS ASSIGNMENT

library(tidyverse)

Warning: package 'tidyverse' was built under R version 4.3.2

Warning: package 'lubridate' was built under R version 4.3.2

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.2     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.0
✔ ggplot2   3.4.2     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.0
✔ purrr     1.0.1     
── 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)

Warning: package 'DT' was built under R version 4.3.2

library(plotly)

Warning: package 'plotly' was built under R version 4.3.2

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.

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.

This is me setting up the libraries and dataset.

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

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

This is the mean friendship score that each student (designated by number) gave each other student (designated by number). Higher numbers mean more friendship that the nominator feels for the nominated.

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

tidy(student_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(student_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>

This is the correlation between the score each student gave each other student and the score they expected to get in return. Below is the correlation coefficient (r).

sqrt(0.9108098)

[1] 0.9543636

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

This is a scatterplot showing the correlation of score and expected score, like the data showed above.

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

student_network <- graph_from_data_frame(friends, nodes, directed = T)

degree(student_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 
19  1  7  9  4  7  6  6 11  7 15  7  4  5  8  7  6  7 12  9  4  7  1 13 12  3 
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  4  8 11  7  6  3  5  5 12  1  8 11  8  8  5  6  8  8  8  4  5  3  5  7  5 
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 
 2  8  2  3  2  7 14  8  6  4  6  4  4  7 10  9  7  6 12 11  1  6  7  6  6  0 
79 80 81 82 83 84 
 4  9  0  9 10  5 

Don’t mind this; it’s just computer stuff.

nodes |> 
    mutate(named_friends = degree((student_network), mode = "out")) |> 
  mutate(named_by_others= degree((student_network), mode = "in")) |>
  mutate(popularity = named_friends - named_by_others) |>
  select(name, named_friends, named_by_others, popularity) |> 
  datatable(rownames = F, caption = 'Number of named friends, times named by others, and popularity; by student')

This shows each student (by number), how many friends they named (people they scored over a 3), how may people named them as friends (score them over 3), and their popularity. Popularity is the difference between the number of friends they named and the number of people who named them as friends.

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= "Number of friends that students named")

This histogram shows the number of friends that students named, by frequency.

reciprocity(student_network, mode = "ratio")

[1] 0.5205479

This is the degree of friendship reciprocity (the people you see as friends seeing you as friends) in the sample.

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

student_network |> 
  infomap.community() |>
  membership()

Warning: `infomap.community()` was deprecated in igraph 2.0.0.
ℹ Please use `cluster_infomap()` instead.

 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  1  4  5  6  5  7  1  7  5  1  8  5  7  9  8  6  5  4  1 10  6  1  2 
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 
11 12  1  1 12  4 13  4  3  5 10  7 13  1  6  8 13  7  7  1  9  3  9  6 12  1 
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  6  5  4  9  5  7  6  8 13 13  8 12  1  7  9  7  5  7  7 11  8  7  6  3  5 
79 80 81 82 83 84 
13  1 14  8  7 12 

This is computer stuff.

nodes |> 
  mutate(value = degree(student_network)) |>
  mutate(group = membership(infomap.community(student_network))) |>
visNetwork(best_friends, main = "Network of student best-friendships") |> 
visIgraphLayout(layout = "layout_with_kk") |> 
visEdges(arrows = "to") |> 
visOptions(highlightNearest = T, nodesIdSelection = T)

This shows the networks of best friendships (scores of 5) and reciprocity of best friendships in the network. The colors demonstrate clusters of interrelationships and the size of the node is in relation to the number of friendships.