LKNetworkAnalysisLK

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

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

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

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

The above data table displays the scores and average friendship ratings given by each student.

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

The above data table displays the scores and average friendship rating given to each student.

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

The above graph illustrates the relationship between actual friendship ratings and expected ratings among college students.

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

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

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

The above plot illustrates a regression analysis of the college students actual scores and their expected scores in regards to friendship ratings.

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

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

friend_network

IGRAPH 8e7cb7e DN-- 84 555 -- 
+ attr: name (v/n)
+ edges from 8e7cb7e (vertex names):
 [1]  1-> 4  1-> 8  1->11  1->25  1->29  1->30  1->38  1->40  1->59  1->66
[11]  1->67  1->69  1->72  1->80  3-> 6  3->35  3->74  3->76  3->77  3->84
[21]  4->15  4->40  4->66  5->21  5->32  5->39  5->56  6-> 3  6->12  6->15
[31]  6->20  6->27  6->36  6->41  6->58  6->70  6->76  6->83  6->84  7->19
[41]  7->24  7->41  7->50  7->60  8-> 1  8->11  8->36  8->55  9->11  9->44
[51]  9->45  9->54  9->59  9->71  9->75  9->83 10-> 1 10->13 10->22 10->25
[61] 10->29 10->46 10->80 11-> 1 11-> 4 11-> 7 11-> 8 11-> 9 11->12 11->14
[71] 11->15 11->16 11->17 11->18 11->19 11->20 11->21 11->22 11->24 11->26
+ ... omitted several edges

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

The above “in” code illustrates how many times each student was named by someone else as a friend.

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

The above “out” code illustrates how many times each student named someone else as a friend.

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

The above data table illustrates the students popularity based on the number of times they named others as friends and the number of times they were named friends by others.

friendship_nodes |> 
    mutate(named_friends = degree((friend_network), mode = "out")) |> 
  mutate(named_by_others= degree((friend_network), mode = "in")) |> 
mutate(popularity = named_friends - named_by_others) |> 
  plot_ly(x = ~named_friends) |> 
  add_histogram() |>
  layout(title = "Number of friends that students named")

The above histogram illustrates the number of friends that students named.

reciprocity(friend_network, mode = "ratio")

[1] 0.5205479

The above analysis illustrates the friendship reciprocity between the college students. Further, this demonstrates that friendship reciprocity among the students was lower than expected.

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

bestfriend_network <- graph_from_data_frame(friend_links, friendship_nodes, directed = T)

bestfriend_network

IGRAPH 8eacdb8 DN-- 84 555 -- 
+ attr: name (v/n)
+ edges from 8eacdb8 (vertex names):
 [1]  1-> 4  1-> 8  1->11  1->25  1->29  1->30  1->38  1->40  1->59  1->66
[11]  1->67  1->69  1->72  1->80  3-> 6  3->35  3->74  3->76  3->77  3->84
[21]  4->15  4->40  4->66  5->21  5->32  5->39  5->56  6-> 3  6->12  6->15
[31]  6->20  6->27  6->36  6->41  6->58  6->70  6->76  6->83  6->84  7->19
[41]  7->24  7->41  7->50  7->60  8-> 1  8->11  8->36  8->55  9->11  9->44
[51]  9->45  9->54  9->59  9->71  9->75  9->83 10-> 1 10->13 10->22 10->25
[61] 10->29 10->46 10->80 11-> 1 11-> 4 11-> 7 11-> 8 11-> 9 11->12 11->14
[71] 11->15 11->16 11->17 11->18 11->19 11->20 11->21 11->22 11->24 11->26
+ ... omitted several edges

degree(bestfriend_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 

The above analysis illustrates the number of times each student was named by someone else as a best friend.

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

The above analysis illustrates the number of times each student named someone as their best friend.