friend network

library(tidyverse)
Warning: package 'tidyverse' was built under R version 4.2.3
Warning: package 'ggplot2' was built under R version 4.2.3
Warning: package 'tibble' was built under R version 4.2.3
Warning: package 'tidyr' was built under R version 4.2.3
Warning: package 'readr' was built under R version 4.2.3
Warning: package 'purrr' was built under R version 4.2.3
Warning: package 'dplyr' was built under R version 4.2.3
Warning: package 'stringr' was built under R version 4.2.3
Warning: package 'forcats' was built under R version 4.2.3
Warning: package 'lubridate' was built under R version 4.2.3
── 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.2.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.2.3
library(DT)
Warning: package 'DT' was built under R version 4.2.3
library(plotly)
Warning: package 'plotly' was built under R version 4.2.3

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
Warning: package 'broom' was built under R version 4.2.3
students <- read_csv("students.csv")
Rows: 10 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.
student_links <- read_csv("student_links.csv")
Rows: 90 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl (4): nominator, nominated, rating, expected_rating

ℹ 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.
student_links |> 
  group_by(nominator) |> 
  summarize(Mean = round(mean(rating), 1)) |> 
  arrange(-Mean) |> 
  datatable(rownames = F,
            caption = 'Average friendship ratings given by each student')
student_links |> 
  group_by(nominated) |> 
  summarize(Mean = round(mean(rating), 1)) |> 
  arrange(-Mean) |> 
  datatable(rownames = F,
            caption = 'Average friendship ratings given to each student')
student_model <- lm(expected_rating ~ rating, data = student_links)

tidy(student_model)
# A tibble: 2 × 5
  term        estimate std.error statistic  p.value
  <chr>          <dbl>     <dbl>     <dbl>    <dbl>
1 (Intercept)    0.130    0.0544      2.39 1.92e- 2
2 rating         0.963    0.0175     54.9  6.88e-70
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.972         0.971 0.273     3018. 6.88e-70     1  -9.95  25.9  33.4
# ℹ 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>
student_links |>
  plot_ly(x = ~ rating, y = ~ expected_rating) |>
  add_markers() |>
  add_lines(y = fitted(student_model))
friends <- student_links |> 
  filter(rating > 3) |> 
  select(nominator, nominated) |> 
  rename(from = nominator) |> 
  rename(to = nominated) 
student_network <- graph_from_data_frame(friends, students, directed = T)
students |> 
    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)
students |> 
    mutate(named_friends = degree((student_network), mode = "out")) |> 
  mutate(named_by_others= degree((student_network), mode = "in")) |> 
  select(name, named_friends, named_by_others) |>
  plot_ly(x = ~named_friends) |>
  add_histogram() |>
  layout(title = "friends named by friends")
reciprocity(student_network, mode = "ratio")
[1] 0.4285714
visNetwork(students, friends, main = "Network of student friendships") |>
  visIgraphLayout(layout = "layout_nicely") |>
  visEdges(arrows = "to") |>
  visOptions(highlightNearest = T, nodesIdSelection = T)