library(tidyverse)
library(igraph)
library(visNetwork)
library(DT)
library(plotly)
library(broom)
These are the packages that I used for this assignment.
students <- read_csv("R Class/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.
student_links <- read_csv("R Class/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.
Question 1:
student_links %>%
datatable(rownames = F,
caption = 'Nominator and Nominated Scores and Expected Scores')
This is a data table showing the scores for the nominator and the
nominated showing how they each score and percieve their friendship. It
also shows the expected score that the nominated person believed that
the nominator would give them.
Question 2:
friendship_model <- lm(expected_score ~ score, data = student_links)
tidy(friendship_model)
glance(friendship_model)
student_links |>
plot_ly(x = ~score, y = ~expected_score) |>
add_markers() |>
add_lines(y = fitted(friendship_model))
This is a regression model showing how well a person can predict
expected scores compared to the actual scores of closeness in
friendships.
Question 3:
friends <- student_links |>
filter(score > 3) |>
select(nominator, nominated) |>
rename(from = nominator) |>
rename(to = nominated)
friendship_network <- graph_from_data_frame(friends, students, directed = T)
students |>
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(named_friends, named_by_others, popularity) |>
datatable(rownames = F)
This is a data table showing the variables named friends, named by
others, and popularity. Popularity was calculated by taking the number
of times a person named their friends minus the amount of times they
were named by others as a friend.
Question 4:
students |>
mutate(named_friends = degree((friendship_network), mode = "out")) |>
mutate(named_by_others= degree((friendship_network), mode = "in")) |>
plot_ly(x = ~named_friends) |>
add_histogram() |>
layout(title = "Number of Friends That Students Named")
This is a histogram showing the amount of times that a student named
another student as their friend.
Question 5:
reciprocity(friendship_network, mode = "ratio")
[1] 0.5205479
The reciprocity of friendships in the network is 52%, meaning that
52% of students that named another student as their friend were also
named back by that student as well.
Question 6:
bestfriends <- student_links |>
filter(score > 4) |>
select(nominator, nominated) |>
rename(from = nominator) |>
rename(to = nominated)
bestfriendship_network <- graph_from_data_frame(bestfriends, students, directed = T)
students |>
mutate(group = membership(infomap.community(bestfriendship_network))) |>
mutate(value = degree(bestfriendship_network)) |>
visNetwork(friends, main = "Network of 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(bestfriendship_network))`.
Caused by warning:
! `infomap.community()` was deprecated in igraph 2.0.0.
ℹ Please use `cluster_infomap()` instead.
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.
This shows a new network created using only best friends. The
different colors indicate communities of people that rated eachother
similarily. The size indicates the amount of best friends that a person
has.
LS0tCnRpdGxlOiAiTmV0d29yayBBbmFseXNpcyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3J9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGlncmFwaCkKbGlicmFyeSh2aXNOZXR3b3JrKQpsaWJyYXJ5KERUKQpsaWJyYXJ5KHBsb3RseSkKbGlicmFyeShicm9vbSkKYGBgCgpUaGVzZSBhcmUgdGhlIHBhY2thZ2VzIHRoYXQgSSB1c2VkIGZvciB0aGlzIGFzc2lnbm1lbnQuIAoKYGBge3J9CnN0dWRlbnRzIDwtIHJlYWRfY3N2KCJSIENsYXNzL2ZyaWVuZHNoaXBfbm9kZXMuY3N2IikKYGBgCgpgYGB7cn0Kc3R1ZGVudF9saW5rcyA8LSByZWFkX2NzdigiUiBDbGFzcy9mcmllbmRzaGlwcy5jc3YiKQpgYGAKClF1ZXN0aW9uIDE6CgpgYGB7cn0Kc3R1ZGVudF9saW5rcyAlPiUgCiAgZGF0YXRhYmxlKHJvd25hbWVzID0gRiwKICAgICAgICAgICAgY2FwdGlvbiA9ICdOb21pbmF0b3IgYW5kIE5vbWluYXRlZCBTY29yZXMgYW5kIEV4cGVjdGVkIFNjb3JlcycpCmBgYAoKVGhpcyBpcyBhIGRhdGEgdGFibGUgc2hvd2luZyB0aGUgc2NvcmVzIGZvciB0aGUgbm9taW5hdG9yIGFuZCB0aGUgbm9taW5hdGVkIHNob3dpbmcgaG93IHRoZXkgZWFjaCBzY29yZSBhbmQgcGVyY2lldmUgdGhlaXIgZnJpZW5kc2hpcC4gSXQgYWxzbyBzaG93cyB0aGUgZXhwZWN0ZWQgc2NvcmUgdGhhdCB0aGUgbm9taW5hdGVkIHBlcnNvbiBiZWxpZXZlZCB0aGF0IHRoZSBub21pbmF0b3Igd291bGQgZ2l2ZSB0aGVtLiAKClF1ZXN0aW9uIDI6CgpgYGB7cn0KZnJpZW5kc2hpcF9tb2RlbCA8LSBsbShleHBlY3RlZF9zY29yZSB+IHNjb3JlLCBkYXRhID0gc3R1ZGVudF9saW5rcykKCnRpZHkoZnJpZW5kc2hpcF9tb2RlbCkKYGBgCgpgYGB7cn0KZ2xhbmNlKGZyaWVuZHNoaXBfbW9kZWwpCmBgYAoKYGBge3J9CnN0dWRlbnRfbGlua3MgfD4KICBwbG90X2x5KHggPSB+c2NvcmUsIHkgPSB+ZXhwZWN0ZWRfc2NvcmUpIHw+CiAgYWRkX21hcmtlcnMoKSB8PgogIGFkZF9saW5lcyh5ID0gZml0dGVkKGZyaWVuZHNoaXBfbW9kZWwpKQpgYGAKClRoaXMgaXMgYSByZWdyZXNzaW9uIG1vZGVsIHNob3dpbmcgaG93IHdlbGwgYSBwZXJzb24gY2FuIHByZWRpY3QgZXhwZWN0ZWQgc2NvcmVzIGNvbXBhcmVkIHRvIHRoZSBhY3R1YWwgc2NvcmVzIG9mIGNsb3NlbmVzcyBpbiBmcmllbmRzaGlwcy4KClF1ZXN0aW9uIDM6CgpgYGB7cn0KZnJpZW5kcyA8LSBzdHVkZW50X2xpbmtzIHw+IAogIGZpbHRlcihzY29yZSA+IDMpIHw+IAogIHNlbGVjdChub21pbmF0b3IsIG5vbWluYXRlZCkgfD4gCiAgcmVuYW1lKGZyb20gPSBub21pbmF0b3IpIHw+IAogIHJlbmFtZSh0byA9IG5vbWluYXRlZCkKYGBgCgpgYGB7cn0KZnJpZW5kc2hpcF9uZXR3b3JrIDwtIGdyYXBoX2Zyb21fZGF0YV9mcmFtZShmcmllbmRzLCBzdHVkZW50cywgZGlyZWN0ZWQgPSBUKQpgYGAKCmBgYHtyfQpzdHVkZW50cyB8PiAKICAgIG11dGF0ZShuYW1lZF9mcmllbmRzID0gZGVncmVlKChmcmllbmRzaGlwX25ldHdvcmspLCBtb2RlID0gIm91dCIpKSB8PiAKICBtdXRhdGUobmFtZWRfYnlfb3RoZXJzPSBkZWdyZWUoKGZyaWVuZHNoaXBfbmV0d29yayksIG1vZGUgPSAiaW4iKSkgfD4gCiAgbXV0YXRlKHBvcHVsYXJpdHkgPSBuYW1lZF9ieV9vdGhlcnMgLSBuYW1lZF9mcmllbmRzKSB8PgogIHNlbGVjdChuYW1lZF9mcmllbmRzLCBuYW1lZF9ieV9vdGhlcnMsIHBvcHVsYXJpdHkpIHw+IAogIGRhdGF0YWJsZShyb3duYW1lcyA9IEYpCmBgYAoKVGhpcyBpcyBhIGRhdGEgdGFibGUgc2hvd2luZyB0aGUgdmFyaWFibGVzIG5hbWVkIGZyaWVuZHMsIG5hbWVkIGJ5IG90aGVycywgYW5kIHBvcHVsYXJpdHkuIFBvcHVsYXJpdHkgd2FzIGNhbGN1bGF0ZWQgYnkgdGFraW5nIHRoZSBudW1iZXIgb2YgdGltZXMgYSBwZXJzb24gbmFtZWQgdGhlaXIgZnJpZW5kcyBtaW51cyB0aGUgYW1vdW50IG9mIHRpbWVzIHRoZXkgd2VyZSBuYW1lZCBieSBvdGhlcnMgYXMgYSBmcmllbmQuICAKClF1ZXN0aW9uIDQ6CgpgYGB7cn0Kc3R1ZGVudHMgfD4gCiAgbXV0YXRlKG5hbWVkX2ZyaWVuZHMgPSBkZWdyZWUoKGZyaWVuZHNoaXBfbmV0d29yayksIG1vZGUgPSAib3V0IikpIHw+IAogIG11dGF0ZShuYW1lZF9ieV9vdGhlcnM9IGRlZ3JlZSgoZnJpZW5kc2hpcF9uZXR3b3JrKSwgbW9kZSA9ICJpbiIpKSB8PiAKICBwbG90X2x5KHggPSB+bmFtZWRfZnJpZW5kcykgfD4KICBhZGRfaGlzdG9ncmFtKCkgfD4KICBsYXlvdXQodGl0bGUgPSAiTnVtYmVyIG9mIEZyaWVuZHMgVGhhdCBTdHVkZW50cyBOYW1lZCIpCmBgYAoKVGhpcyBpcyBhIGhpc3RvZ3JhbSBzaG93aW5nIHRoZSBhbW91bnQgb2YgdGltZXMgdGhhdCBhIHN0dWRlbnQgbmFtZWQgYW5vdGhlciBzdHVkZW50IGFzIHRoZWlyIGZyaWVuZC4gIAoKUXVlc3Rpb24gNToKCmBgYHtyfQpyZWNpcHJvY2l0eShmcmllbmRzaGlwX25ldHdvcmssIG1vZGUgPSAicmF0aW8iKQoKYGBgCgpUaGUgcmVjaXByb2NpdHkgb2YgZnJpZW5kc2hpcHMgaW4gdGhlIG5ldHdvcmsgaXMgNTIlLCBtZWFuaW5nIHRoYXQgNTIlIG9mIHN0dWRlbnRzIHRoYXQgbmFtZWQgYW5vdGhlciBzdHVkZW50IGFzIHRoZWlyIGZyaWVuZCB3ZXJlIGFsc28gbmFtZWQgYmFjayBieSB0aGF0IHN0dWRlbnQgYXMgd2VsbC4gCgpRdWVzdGlvbiA2OgoKYGBge3J9CmJlc3RmcmllbmRzIDwtIHN0dWRlbnRfbGlua3MgfD4gCiAgZmlsdGVyKHNjb3JlID4gNCkgfD4gCiAgc2VsZWN0KG5vbWluYXRvciwgbm9taW5hdGVkKSB8PiAKICByZW5hbWUoZnJvbSA9IG5vbWluYXRvcikgfD4gCiAgcmVuYW1lKHRvID0gbm9taW5hdGVkKQpgYGAKCmBgYHtyfQpiZXN0ZnJpZW5kc2hpcF9uZXR3b3JrIDwtIGdyYXBoX2Zyb21fZGF0YV9mcmFtZShiZXN0ZnJpZW5kcywgc3R1ZGVudHMsIGRpcmVjdGVkID0gVCkKCmBgYAoKYGBge3J9CnN0dWRlbnRzIHw+ICAKICBtdXRhdGUoZ3JvdXAgPSBtZW1iZXJzaGlwKGluZm9tYXAuY29tbXVuaXR5KGJlc3RmcmllbmRzaGlwX25ldHdvcmspKSkgfD4KICBtdXRhdGUodmFsdWUgPSBkZWdyZWUoYmVzdGZyaWVuZHNoaXBfbmV0d29yaykpIHw+CiAgdmlzTmV0d29yayhmcmllbmRzLCBtYWluID0gIk5ldHdvcmsgb2YgYmVzdCBmcmllbmRzaGlwcyIpIHw+CiAgdmlzSWdyYXBoTGF5b3V0KGxheW91dCA9ICJsYXlvdXRfbmljZWx5IikgfD4KICB2aXNFZGdlcyhhcnJvd3MgPSAidG8iKSB8PgogIHZpc09wdGlvbnMoaGlnaGxpZ2h0TmVhcmVzdCA9IFQsIG5vZGVzSWRTZWxlY3Rpb24gPSBUKQpgYGAKClRoaXMgc2hvd3MgYSBuZXcgbmV0d29yayBjcmVhdGVkIHVzaW5nIG9ubHkgYmVzdCBmcmllbmRzLiBUaGUgZGlmZmVyZW50IGNvbG9ycyBpbmRpY2F0ZSBjb21tdW5pdGllcyBvZiBwZW9wbGUgdGhhdCByYXRlZCBlYWNob3RoZXIgc2ltaWxhcmlseS4gVGhlIHNpemUgaW5kaWNhdGVzIHRoZSBhbW91bnQgb2YgYmVzdCBmcmllbmRzIHRoYXQgYSBwZXJzb24gaGFzLiAKCgoKCgo=