Untitled

Network Analysis Assignment

library(tidyverse)

Warning: package 'ggplot2' was built under R version 4.3.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.5.0     ✔ 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)                  

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)               

Warning: package 'visNetwork' was built under R version 4.3.3

library(DT)

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

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)

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

1. This data table display’s the score given by each participant to the rest of the participants in the data pool. Scores go from 1 to 5, with 5 being best friends.

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

1. the table above displays the average friendship scores given to each student. 5 being best friends, and 1 being not known.

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

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

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

2. the scatter plot above compares individuals’ score given to others with the scores they received. There is a high correlation between score and expected score.

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

friendship_network <- graph_from_data_frame(friends, friendship_nodes, directed = T)

friendship_nodes |>
  mutate(named_friends = degree((friendship_network), mode= "out")) |>
  mutate(named_by_others = degree((friendship_network), mode= "in")) |>
  select(name, named_friends, named_by_others) 

# A tibble: 84 × 3
    name named_friends named_by_others
   <dbl>         <dbl>           <dbl>
 1     1            14              19
 2     2             0               1
 3     3             6               7
 4     4             3               9
 5     5             4               4
 6     6            12               7
 7     7             5               6
 8     8             4               6
 9     9             8              11
10    10             7               7
# ℹ 74 more rows

friendship_nodes |>
  mutate(named_friends = degree((friendship_network), mode= "out")) |>
  mutate(named_by_others = degree((friendship_network), mode= "in")) |>
  mutate(popularity = named_by_others - named_friends) |>
  select(name, named_friends, named_by_others, popularity)

# A tibble: 84 × 4
    name named_friends named_by_others popularity
   <dbl>         <dbl>           <dbl>      <dbl>
 1     1            14              19          5
 2     2             0               1          1
 3     3             6               7          1
 4     4             3               9          6
 5     5             4               4          0
 6     6            12               7         -5
 7     7             5               6          1
 8     8             4               6          2
 9     9             8              11          3
10    10             7               7          0
# ℹ 74 more rows

3. The data table above displays named friends, as well as the number of times they were named as friends by others. named friends subtracted from named by others creates a popularity score.

friendship_nodes |>
  mutate(named_friends = degree((friendship_network), mode= "out")) |>
  mutate(named_by_others = degree((friendship_network), mode= "in")) |>
  select(name, named_friends, named_by_others) |>
  plot_ly(x = ~named_friends) |>
  add_histogram() |>
  layout(title = "How many friends students named")

4. The histogram above displays the number of students named as friends across all individuals.

reciprocity(friendship_network, mode = "ratio")

[1] 0.5205479

5. About 50% of individuals that people thought were their friends, actually were their friends.

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

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

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

6. the network above displays each student, with colors designated to each community of friendships. Students with more friends are grouped by size.