With thanks to this tutorial on network analysis in R I’ve not followed all the suggestions, but it’s been a good springboard.

## Intro

Looks like I’m going to sometimes use tidygraph, sometimes go down one level and go to igraph as necessary.

Graph Theory (as I was taught it), or Network Theory (which makes googling it easier because there’s something else called a graph) is a nice bit of Discrete Maths. It opens with Euler trying to walk across all these bridges exactly once:

```
tribble(
~from, ~to,
"a", "b",
"a", "b",
"a", "c",
"a", "c",
"a", "d",
"b", "d",
"c", "d"
) %>%
as_tbl_graph(directed=FALSE) %>%
plot()
```

Which finds its way into general usage as “draw that figure without taking your pen off the paper”. (Or punching a hole in the paper, or folding the paper over to extend…)

That one can’t be done. Neither can these:

```
make_full_bipartite_graph(3,3) %>%
plot(layout=layout_as_bipartite)
```

```
make_full_graph(5) %>%
plot()
```

## Rock-Paper-Scissors-Psychic-Dark

All you need for a network is some objects and some relationship between them. If your relationship is “wins against” then rock-paper-scissors looks like:

```
tribble(
~from, ~to,
"rock", "scissors",
"scissors", "paper",
"paper", "rock"
) %>%
as_tbl_graph() %>%
plot(vertex.shape="none")
```

Which shows the symmetry and ‘fairness’ in RPS quite nicely. Rock-paper-scissors-lizard-Spock and a multitude of more have similar shapes.

Pokemon has a similar thing, but not the same symmetries. I’m going to focus on Pokemon-Go, because that’s what I’m currently playing.

Pokemon has normal damage, super-effective, not very effective, and immune. Go has implemented “immune” as not very effective 2ce, rather than actual immunity. The below shows these with different coloured arrows.

```
pogo_type_effectiveness <- read_csv(here("static", "data", "PoGo", "type_effectiveness.csv")) %>%
rename(from=X1) %>%
gather(to, value, -from)
pogo_graph <- pogo_type_effectiveness %>%
filter(!is.na(value)) %>%
mutate(game_text = case_when(
value<0.6 ~ "Immune",
value < 1 ~ "Not very effective",
TRUE ~ "Super-effective"
)) %>%
mutate(color = case_when(
value<0.6 ~ "maroon",
value < 1 ~ "red",
TRUE ~ "green"
)) %>%
as_tbl_graph()
plot(pogo_graph, edge.color = E(pogo_graph)$color, layout=layout_in_circle, vertex.shape = "none", edge.arrow.size=0.3, edge.curved=0.1)
```

This is absolutely a hairball graph!

Throwing tidygraph at it, I can filter out just the super effective, or the not very effective:

```
pogo_graph %>%
activate(edges) %>%
filter(color=="green") %>%
plot(edge.color="green", layout=layout_in_circle, vertex.shape = "none", edge.arrow.size=0.3, edge.curved=0.1)
```

```
pogo_graph %>%
activate(edges) %>%
filter(color=="red") %>%
plot(edge.color="red", layout=layout_in_circle, vertex.shape = "none", edge.arrow.size=0.3, edge.curved=0.1)
```

For the temptest cup

```
pogo_graph %>%
activate(nodes) %>%
filter(name %in% c("Electric", "Ice", "Flying", "Ground")) %>%
plot(layout=layout_in_circle, vertex.shape = "none", edge.arrow.size=0.3, edge.curved=0.1)
```

For the kingdom cup

```
pogo_graph %>%
activate(nodes) %>%
filter(name %in% c("Fire", "Ice", "Dragon", "Steel")) %>%
plot(layout=layout_in_circle, vertex.shape = "none", edge.arrow.size=0.3, edge.curved=0.1)
```

These are all static graphs, we’re online and we have JavaScript.

Using visNetwork:

```
nodes <- tibble(id = unique(pogo_type_effectiveness$from),
label=id)
edges <- pogo_type_effectiveness %>%
filter(!is.na(value)) %>%
mutate(color = case_when(
value<0.6 ~ "maroon",
value < 1 ~ "red",
TRUE ~ "green"
)) %>%
mutate(arrows="to") %>%
select(-value)
visNetwork(nodes, edges) %>%
visInteraction(navigationButtons = TRUE)
```

You can move this one around!

Or in networkD3:

No. I didn’t get networkD3 working.

## Collatz Conjecture

XKCD references the Collatz Conjecture:

and it makes me think every time I wear the shirt of it. Both the comic and the shirt have a directed graph, so let’s have a play.

First we need a function that takes an integer 2 or larger to the next number in the sequence. 1 can be the end of the sequence so I don’t get (directed) loops.

```
collatz <- function(n){
stopifnot(n == round(n, 0), n>1) #Type forcing means our integers might have become floats.
case_when(
n %% 2 == 0 ~ n/2,
TRUE ~ 3*n+1
)
}
```

At this point I’ve discovered ggraph, so I’m doing different graphs to earlier.

```
set_graph_style(plot_margin = margin(1,1,1,1))
collatz_graph <- tibble(from=2:250, to=collatz(from)) %>%
as_tbl_graph()
components <- components(collatz_graph) #Try to keep only the ones who have already mapped to 1
component_1 <- names(components$membership[components$membership==1] ) %>%
as.numeric()
collatz_graph %>%
activate(nodes) %>%
filter(name %in% component_1) %>%
ggraph() + geom_edge_link(arrow = arrow(length = unit(1, 'mm')),
start_cap = circle(1, 'mm'),
end_cap = circle(1, 'mm')) + geom_node_text(aes(label=name))
```

This scales, but not well:

```
plot_collatz <- function(upper_bound){
collatz_graph <- tibble(from=2:upper_bound, to=collatz(from)) %>%
as_tbl_graph()
components <- components(collatz_graph) #Try to keep only the ones who have already mapped to 1
component_1 <- names(components$membership[components$membership==1] ) %>%
as.numeric()
collatz_graph %>%
activate(nodes) %>%
filter(name %in% component_1) %>%
ggraph() + geom_edge_link(arrow = arrow(length = unit(1, 'mm')),
start_cap = circle(1, 'mm'),
end_cap = circle(1, 'mm')) + geom_node_text(aes(label=name))
}
plot_collatz(1000)
```

`plot_collatz(1e5)`

## Share this post

Twitter

Google+

Facebook

Reddit

LinkedIn

Pinterest

Email