knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)
library(ironmarch)
library(dplyr)
library(igraph)
library(ggplot2)

print.data.table <- function(x) print(tibble::as_tibble(x))
print.data.frame <- function(x) print(tibble::as_tibble(x))

extract_ego <- function(g, ego_name, n_steps = 1L) {
  hood <- unlist(neighborhood(
    g,
    order = n_steps,
    nodes = which(vertex_attr(g, "screen_name") == ego_name)
  ), use.names = FALSE)

  induced_subgraph(g, hood)
}

vis_net <- function(ego_g, ego_name = NULL) {
  if (!is.null(ego_name) && ego_name %in% vertex_attr(ego_g, "screen_name")) {
    vertex_attr(ego_g, "color", 
                which(vertex_attr(ego_g, "screen_name") == ego_name)) <- "red"
  }
  edge_attr(ego_g, "title") <- edge_attr(ego_g, "msg_post")
  suppressWarnings(visNetwork::visIgraph(ego_g)) %>%
    visNetwork::visOptions(nodesIdSelection = TRUE, highlightNearest = TRUE)
}

igraph_options(print.full = FALSE)

Members and Messages

build_members()
build_messages()

Enrichment/Reference Data

im_personnel
im_groups
im_events
g <- im_message_network()

edge_density(g)
g %>% degree() %>% mean()

Node Table

tibble::as_tibble(vertex_attr(g))

Edge Table

tibble::as_tibble(igraph::edge_attr(g))

Ego Extraction

target_node <- "Blood and Iron"

ego_g <- g %>%
  extract_ego(ego_name = target_node, n_steps = 1)

vcount(ego_g)
ecount(ego_g)
ego_g %>%
  vis_net(ego_name = target_node)

ego_g_member_names <- vertex_attr(ego_g, "screen_name")
ego_g_member_names

Spatial Data

all_members_sf <- im_geocode_members() %>% filter(!is.na(member_id))
plot(all_members_sf$geometry)
all_members_sf
all_members_sf %>%
  mapview::mapview()

Spatial Ego Extraction

all_members_sf %>% 
  filter(name %in% ego_g_member_names) %>% 
  mapview::mapview()

Getting Spatial Data

us_sf <- sf::st_as_sf(
  raster::getData(
    country = "United States",
    level = 1
  )
)

plot(us_sf$geometry)

missouri_sf <- us_sf %>%
  filter(NAME_1 == "Missouri")

mapview::mapview(missouri_sf)

Cropping by Spatial Geometries

missouri_members_sf <- all_members_sf %>%
  sf::st_crop(missouri_sf)

missouri_members_sf

missouri_members_sf %>% mapview::mapview()
all_member_ranges_sf <- merge(
  ironmarch:::.all_geocoded_ips_df,
  build_messages(as_tibble = FALSE),
  by.x = "ip_address",
  by.y = "msg_ip_address"
  )[, .(msg_author_id, lon, lat)
    ] %>% 
  tibble::as_tibble() %>% 
  rename(member_id = msg_author_id) %>% 
  sf::st_as_sf(coords = c("lon", "lat"), crs = 4326L) %>% 
  group_by(member_id) %>%
  summarise() %>%
  inner_join(build_members(), by = "member_id") %>% 
  arrange(member_id)
all_member_ranges_sf

member_ranges_for_gg <- all_member_ranges_sf %>% 
  filter(member_id %in% 1:6) %>% 
  mutate(screen_name = name) %>% 
  sf::st_transform(crs = 3857L)
world_data <- rnaturalearthdata::sovereignty110 %>% 
  sf::st_as_sf() %>% tibble::as_tibble() %>% sf::st_as_sf() %>% 
  sf::st_transform(crs = 3857L) %>% 
  sf::st_crop(sf::st_buffer(member_ranges_for_gg, 2e5))

member_ranges_gg <- member_ranges_for_gg %>% 
  ggplot() +
  geom_sf(data = world_data) +
  geom_sf(aes(color = screen_name), size = 5, show.legend = "point") +
  guides(color = guide_legend(title = "member_id")) +
  theme_minimal() +
  theme(legend.position = "bottom")

member_ranges_gg
member_ranges_gg + facet_wrap(~ screen_name, ncol = 2) + guides(color = FALSE)
all_member_ranges_sf %>% 
  filter(member_id == 1) %>%  # Alexander Slavros
  mapview::mapview()


knapply/ironmarch documentation built on July 14, 2020, 12:50 a.m.