R Notebook

library(tidyverse)
library(DT)
library(igraph)
library(rtweet)
library(visNetwork)
library(graphTweets)

token <- create_token(
  app = "",
  consumer_key = "",
  consumer_secret = "",
  access_token = "",
  access_secret = )

Error in twitter_init_oauth1.0(self$endpoint, self$app, permission = self$params$permission,  : 
  Bad Request (HTTP 400).

Use the us-senate list to get the last 200 tweets from US senators.

senate <- lists_members(slug = "us-senate",owner_user = "TwitterGov")

senate_tweets <- get_timeline(senate$screen_name, n = 200)

Create a network of retweets.

senate_retweets_network <- senate_tweets %>% 
  filter(retweet_screen_name %in% senate$screen_name) %>% 
  gt_edges(screen_name, retweet_screen_name, text) %>% 
  gt_graph

senate_retweet_nodes <- as_data_frame(senate_retweets_network, what = "vertices")

senate_retweet_nodes <- senate_retweet_nodes %>% 
  mutate(id= name) %>% 
  mutate(title = name) %>% 
  mutate(degree = degree(senate_retweets_network)) %>% 
  mutate(value = degree)


senate_retweets_edges <- as_data_frame(senate_retweets_network, what = "edges")

senate_retweets_edges <-senate_retweets_edges %>% 
  mutate(title = text)

visNetwork(senate_retweet_nodes, senate_retweets_edges, main = "US Senate Official Account Retweet Network") %>% 
  visIgraphLayout(layout = "layout_nicely") %>% 
  visEdges(arrows = "to") %>% 
  visOptions(highlightNearest = T, nodesIdSelection = T, selectedBy = "group")

Can't find 'group' in node data.frame

NA

Here is a map of the US Senate network of retweets. It’s a fairly spaced out network, with a small number of notable senators (Carper, Harris, Durbin, and Baldwin to name a few) that have a large number of retweets from other senators. A couple (Sullivan, Lee, Forri) have no retweet activity.

Get a count of nodes and edges, and get the density of the network.

senate_retweets_network %>% 
  vcount

[1] 166

The number of nodes in this network is 166. This shows the total number of people in the network, which in this case is the number of senators with an official and (in some cases) personal Twitter account in the United States government.

senate_retweets_network %>% 
  ecount

[1] 754

The count for the Senate retweet edges is 754. This shows that there are 754 total connections between the senators’ retweeting each other.

senate_retweets_network %>% 
  edge_density()

[1] 0.02752829

The density of the Senate retweet network is less than 0.03. This indicates that the network is relatively spread out, without any major senators connecting “farther” senators together.

Create a data table of the senators, showing only their names and degree.

senate_retweet_nodes %>% 
  select(name, degree) %>% 
  datatable

Here is a datatable highlighting the the senator’s name and degree of connection with other senator’s by their retweets. The senator with the highest number of connections is Mike Braun of Indiana, with 59 total connections. The lowest is Rand Paul of Kentucky with one single connection. It seems as though Mr. Paul is not very active on Twitter.

Find communities and make a network diagram showing the communities. (You may make two diagrams, one with the communities and one without.)

senate_retweet_nodes <- senate_retweet_nodes %>% 
    mutate(group = membership(infomap.community(senate_retweets_network)))

Modularity is implemented for undirected graphs only.

  
  visNetwork(senate_retweet_nodes, senate_retweets_edges, main = "US Senate Official Account Retweet Network") %>% 
  visIgraphLayout(layout = "layout_nicely") %>% 
  visEdges(arrows = "to") %>% 
  visOptions(highlightNearest = T, nodesIdSelection = T, selectedBy = "group")

Here is a map highlighting the communities of senator retweets. Since the network is not very dense, there are larger communities of retweets (which are indicated by lower numbers) and smaller communities of retweets (indicated by higher numbers).

LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3J9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KERUKQpsaWJyYXJ5KGlncmFwaCkKbGlicmFyeShydHdlZXQpCmxpYnJhcnkodmlzTmV0d29yaykKbGlicmFyeShncmFwaFR3ZWV0cykKYGBgCgpgYGB7cn0KdG9rZW4gPC0gY3JlYXRlX3Rva2VuKAogIGFwcCA9ICIiLAogIGNvbnN1bWVyX2tleSA9ICIiLAogIGNvbnN1bWVyX3NlY3JldCA9ICIiLAogIGFjY2Vzc190b2tlbiA9ICIiLAogIGFjY2Vzc19zZWNyZXQgPSApCmdldF90b2tlbigpCmBgYAoKCjEuIFVzZSB0aGUgdXMtc2VuYXRlIGxpc3QgdG8gZ2V0IHRoZSBsYXN0IDIwMCB0d2VldHMgZnJvbSBVUyBzZW5hdG9ycy4gICAKCmBgYHtyfQpzZW5hdGUgPC0gbGlzdHNfbWVtYmVycyhzbHVnID0gInVzLXNlbmF0ZSIsb3duZXJfdXNlciA9ICJUd2l0dGVyR292IikKCnNlbmF0ZV90d2VldHMgPC0gZ2V0X3RpbWVsaW5lKHNlbmF0ZSRzY3JlZW5fbmFtZSwgbiA9IDIwMCkKYGBgCgoKMi4gQ3JlYXRlIGEgbmV0d29yayBvZiByZXR3ZWV0cy4gIAoKYGBge3J9CnNlbmF0ZV9yZXR3ZWV0c19uZXR3b3JrIDwtIHNlbmF0ZV90d2VldHMgJT4lIAogIGZpbHRlcihyZXR3ZWV0X3NjcmVlbl9uYW1lICVpbiUgc2VuYXRlJHNjcmVlbl9uYW1lKSAlPiUgCiAgZ3RfZWRnZXMoc2NyZWVuX25hbWUsIHJldHdlZXRfc2NyZWVuX25hbWUsIHRleHQpICU+JSAKICBndF9ncmFwaAoKc2VuYXRlX3JldHdlZXRfbm9kZXMgPC0gYXNfZGF0YV9mcmFtZShzZW5hdGVfcmV0d2VldHNfbmV0d29yaywgd2hhdCA9ICJ2ZXJ0aWNlcyIpCgpzZW5hdGVfcmV0d2VldF9ub2RlcyA8LSBzZW5hdGVfcmV0d2VldF9ub2RlcyAlPiUgCiAgbXV0YXRlKGlkPSBuYW1lKSAlPiUgCiAgbXV0YXRlKHRpdGxlID0gbmFtZSkgJT4lIAogIG11dGF0ZShkZWdyZWUgPSBkZWdyZWUoc2VuYXRlX3JldHdlZXRzX25ldHdvcmspKSAlPiUgCiAgbXV0YXRlKHZhbHVlID0gZGVncmVlKQoKCnNlbmF0ZV9yZXR3ZWV0c19lZGdlcyA8LSBhc19kYXRhX2ZyYW1lKHNlbmF0ZV9yZXR3ZWV0c19uZXR3b3JrLCB3aGF0ID0gImVkZ2VzIikKCnNlbmF0ZV9yZXR3ZWV0c19lZGdlcyA8LXNlbmF0ZV9yZXR3ZWV0c19lZGdlcyAlPiUgCiAgbXV0YXRlKHRpdGxlID0gdGV4dCkKCnZpc05ldHdvcmsoc2VuYXRlX3JldHdlZXRfbm9kZXMsIHNlbmF0ZV9yZXR3ZWV0c19lZGdlcywgbWFpbiA9ICJVUyBTZW5hdGUgT2ZmaWNpYWwgQWNjb3VudCBSZXR3ZWV0IE5ldHdvcmsiKSAlPiUgCiAgdmlzSWdyYXBoTGF5b3V0KGxheW91dCA9ICJsYXlvdXRfbmljZWx5IikgJT4lIAogIHZpc0VkZ2VzKGFycm93cyA9ICJ0byIpICU+JSAKICB2aXNPcHRpb25zKGhpZ2hsaWdodE5lYXJlc3QgPSBULCBub2Rlc0lkU2VsZWN0aW9uID0gVCwgc2VsZWN0ZWRCeSA9ICJncm91cCIpCiAgCmBgYApIZXJlIGlzIGEgbWFwIG9mIHRoZSBVUyBTZW5hdGUgbmV0d29yayBvZiByZXR3ZWV0cy4gSXQncyBhIGZhaXJseSBzcGFjZWQgb3V0IG5ldHdvcmssIHdpdGggYSBzbWFsbCBudW1iZXIgb2Ygbm90YWJsZSBzZW5hdG9ycyAoQ2FycGVyLCBIYXJyaXMsIER1cmJpbiwgYW5kIEJhbGR3aW4gdG8gbmFtZSBhIGZldykgdGhhdCBoYXZlIGEgbGFyZ2UgbnVtYmVyIG9mIHJldHdlZXRzIGZyb20gb3RoZXIgc2VuYXRvcnMuIEEgY291cGxlIChTdWxsaXZhbiwgTGVlLCBGb3JyaSkgaGF2ZSBubyByZXR3ZWV0IGFjdGl2aXR5LiAKCjMuIEdldCBhIGNvdW50IG9mIG5vZGVzIGFuZCBlZGdlcywgYW5kIGdldCB0aGUgZGVuc2l0eSBvZiB0aGUgbmV0d29yay4gIAoKYGBge3J9CnNlbmF0ZV9yZXR3ZWV0c19uZXR3b3JrICU+JSAKICB2Y291bnQKYGBgClRoZSBudW1iZXIgb2Ygbm9kZXMgaW4gdGhpcyBuZXR3b3JrIGlzIDE2Ni4gVGhpcyBzaG93cyB0aGUgdG90YWwgbnVtYmVyIG9mIHBlb3BsZSBpbiB0aGUgbmV0d29yaywgd2hpY2ggaW4gdGhpcyBjYXNlIGlzIHRoZSBudW1iZXIgb2Ygc2VuYXRvcnMgd2l0aCBhbiBvZmZpY2lhbCBhbmQgKGluIHNvbWUgY2FzZXMpIHBlcnNvbmFsIFR3aXR0ZXIgYWNjb3VudCBpbiB0aGUgVW5pdGVkIFN0YXRlcyBnb3Zlcm5tZW50LgoKYGBge3J9CnNlbmF0ZV9yZXR3ZWV0c19uZXR3b3JrICU+JSAKICBlY291bnQKYGBgClRoZSBjb3VudCBmb3IgdGhlIFNlbmF0ZSByZXR3ZWV0IGVkZ2VzIGlzIDc1NC4gVGhpcyBzaG93cyB0aGF0IHRoZXJlIGFyZSA3NTQgdG90YWwgY29ubmVjdGlvbnMgYmV0d2VlbiB0aGUgc2VuYXRvcnMnIHJldHdlZXRpbmcgZWFjaCBvdGhlci4KCmBgYHtyfQpzZW5hdGVfcmV0d2VldHNfbmV0d29yayAlPiUgCiAgZWRnZV9kZW5zaXR5KCkKYGBgClRoZSBkZW5zaXR5IG9mIHRoZSBTZW5hdGUgcmV0d2VldCBuZXR3b3JrIGlzIGxlc3MgdGhhbiAwLjAzLiBUaGlzIGluZGljYXRlcyB0aGF0IHRoZSBuZXR3b3JrIGlzIHJlbGF0aXZlbHkgc3ByZWFkIG91dCwgd2l0aG91dCBhbnkgbWFqb3Igc2VuYXRvcnMgY29ubmVjdGluZyAiZmFydGhlciIgc2VuYXRvcnMgIHRvZ2V0aGVyLgoKCjQuIENyZWF0ZSBhIGRhdGEgdGFibGUgb2YgdGhlIHNlbmF0b3JzLCBzaG93aW5nIG9ubHkgdGhlaXIgbmFtZXMgYW5kIGRlZ3JlZS4gIAoKCmBgYHtyfQpzZW5hdGVfcmV0d2VldF9ub2RlcyAlPiUgCiAgc2VsZWN0KG5hbWUsIGRlZ3JlZSkgJT4lIAogIGRhdGF0YWJsZQpgYGAKSGVyZSBpcyBhIGRhdGF0YWJsZSBoaWdobGlnaHRpbmcgdGhlIHRoZSBzZW5hdG9yJ3MgbmFtZSBhbmQgZGVncmVlIG9mIGNvbm5lY3Rpb24gd2l0aCBvdGhlciBzZW5hdG9yJ3MgYnkgdGhlaXIgcmV0d2VldHMuIFRoZSBzZW5hdG9yIHdpdGggdGhlIGhpZ2hlc3QgbnVtYmVyIG9mIGNvbm5lY3Rpb25zIGlzIE1pa2UgQnJhdW4gb2YgSW5kaWFuYSwgd2l0aCA1OSB0b3RhbCBjb25uZWN0aW9ucy4gVGhlIGxvd2VzdCBpcyBSYW5kIFBhdWwgb2YgS2VudHVja3kgd2l0aCBvbmUgc2luZ2xlIGNvbm5lY3Rpb24uIEl0IHNlZW1zIGFzIHRob3VnaCBNci4gUGF1bCBpcyBub3QgdmVyeSBhY3RpdmUgb24gVHdpdHRlci4gCgo1LiBGaW5kIGNvbW11bml0aWVzIGFuZCBtYWtlIGEgbmV0d29yayBkaWFncmFtIHNob3dpbmcgdGhlIGNvbW11bml0aWVzLiAoWW91IG1heSBtYWtlIHR3byBkaWFncmFtcywgb25lIHdpdGggdGhlIGNvbW11bml0aWVzIGFuZCBvbmUgd2l0aG91dC4pIAoKCmBgYHtyfQpzZW5hdGVfcmV0d2VldF9ub2RlcyA8LSBzZW5hdGVfcmV0d2VldF9ub2RlcyAlPiUgCiAgICBtdXRhdGUoZ3JvdXAgPSBtZW1iZXJzaGlwKGluZm9tYXAuY29tbXVuaXR5KHNlbmF0ZV9yZXR3ZWV0c19uZXR3b3JrKSkpCiAgCiAgdmlzTmV0d29yayhzZW5hdGVfcmV0d2VldF9ub2Rlcywgc2VuYXRlX3JldHdlZXRzX2VkZ2VzLCBtYWluID0gIlVTIFNlbmF0ZSBPZmZpY2lhbCBBY2NvdW50IFJldHdlZXQgTmV0d29yayIpICU+JSAKICB2aXNJZ3JhcGhMYXlvdXQobGF5b3V0ID0gImxheW91dF9uaWNlbHkiKSAlPiUgCiAgdmlzRWRnZXMoYXJyb3dzID0gInRvIikgJT4lIAogIHZpc09wdGlvbnMoaGlnaGxpZ2h0TmVhcmVzdCA9IFQsIG5vZGVzSWRTZWxlY3Rpb24gPSBULCBzZWxlY3RlZEJ5ID0gImdyb3VwIikKYGBgCkhlcmUgaXMgYSBtYXAgaGlnaGxpZ2h0aW5nIHRoZSBjb21tdW5pdGllcyBvZiBzZW5hdG9yIHJldHdlZXRzLiBTaW5jZSB0aGUgbmV0d29yayBpcyBub3QgdmVyeSBkZW5zZSwgdGhlcmUgYXJlIGxhcmdlciBjb21tdW5pdGllcyBvZiByZXR3ZWV0cyAod2hpY2ggYXJlIGluZGljYXRlZCBieSBsb3dlciBudW1iZXJzKSBhbmQgc21hbGxlciBjb21tdW5pdGllcyBvZiByZXR3ZWV0cyAoaW5kaWNhdGVkIGJ5IGhpZ2hlciBudW1iZXJzKS4K