library(tidyverse)

## ── Attaching packages ────────── tidyverse 1.2.1 ──

## ✔ ggplot2 3.1.0     ✔ purrr   0.2.5
## ✔ tibble  1.4.2     ✔ dplyr   0.7.8
## ✔ tidyr   0.8.2     ✔ stringr 1.3.1
## ✔ readr   1.1.1     ✔ forcats 0.3.0

## ── Conflicts ───────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

library(tidygraph)

## 
## Attaching package: 'tidygraph'

## The following object is masked from 'package:stats':
## 
##     filter

set.seed(20181208)

# Workaround für https://github.com/thomasp85/tidygraph/issues/83
to_all_shortest_paths <- function(graph, from, mode = "out", weights = NULL) {
  nodes <- as_tibble(graph, "nodes")
  from <- rlang::eval_tidy(enquo(from), nodes)
  from <- tidygraph:::as_ind(from, igraph:::gorder(graph))
  weights <- rlang::eval_tidy(enquo(weights), as_tibble(graph, active = "edges"))
  path <- igraph::shortest_paths(graph, from = from, mode = mode, weights = weights, output = "both")
  short_path <- slice(activate(graph, "edges"), unique(as.integer(unlist(path$epath))))
  short_path <- slice(activate(short_path, "nodes"), unique(as.integer(unlist(path$vpath))))
  list(
    shortest_path = short_path
  )
}

to_all_distances <- function(graph, from, mode = "out", weights = NULL, dist = "dist") {
  nodes <- as_tibble(graph, "nodes")
  from <- rlang::eval_tidy(enquo(from), nodes)
  from <- tidygraph:::as_ind(from, igraph:::gorder(graph))
  weights <- rlang::eval_tidy(enquo(weights), as_tibble(graph, active = "edges"))
  distances <- igraph::distances(graph, v = from, mode = mode, weights = weights)
  distance_frame <- enframe(distances[1, ], "name", dist)
  distance_attr <- left_join(activate(graph, "nodes"), distance_frame, by = "name")

  list(
    distance_attr = distance_attr
  )
}

# Zelldaten erzeugen
cells <-
  crossing(x = 1:10, y = 1:10) %>%
  mutate(cost = runif(length(x)))

# In welche Richtung dürfen wir uns aus einer Zelle heraus bewegen?
delta <-
  crossing(dx = -1:1, dy = -1:1) %>%
  filter(dx != 0 | dy != 0) %>%
  mutate(factor = sqrt(dx * dx + dy * dy))

# Graph erzeugen: Zuweisung der Kosten der Zielzelle zu der Kante
graph <-
  crossing(cells, delta) %>%
  mutate(x2 = x + dx, y2 = y + dy) %>%
  select(-dx, -dy) %>%
  filter(x2 > 0, x2 <= 10, y2 > 0, y2 <= 10) %>%
  unite("origin", x2, y2, sep = "_") %>%
  unite("dest", x, y, sep = "_") %>%
  transmute(origin, dest, cost = cost * factor) %>%
  as_tbl_graph()

# Startknoten definieren:
origin <- "6_6"

# Distanzen zu Startknoten:
distances <-
  graph %>%
  convert(to_all_distances, name == origin, weights = cost) %>%
  as_tibble("nodes")

distances

## # A tibble: 100 x 3
##    name  .tidygraph_node_index  dist
##    <chr>                 <int> <dbl>
##  1 1_2                       1 1.76 
##  2 2_1                       2 2.45 
##  3 2_2                       3 1.61 
##  4 1_1                       4 2.28 
##  5 1_3                       5 1.77 
##  6 2_3                       6 1.28 
##  7 1_4                       7 2.02 
##  8 2_4                       8 1.52 
##  9 1_5                       9 1.28 
## 10 2_5                      10 0.910
## # ... with 90 more rows

# Kürzeste Wege zu Startknoten (nur für Visualisierung):
paths <-
  graph %>%
  convert(to_all_shortest_paths, name == origin, weights = cost)

# Visualisierung:
path_nodes <-
  paths %>%
  as_tibble("nodes")

path_data <-
  paths %>%
  as_tibble("edges") %>%
  select(-cost) %>%
  gather("node", ".tidygraph_node_index", from, to, factor_key = TRUE) %>%
  left_join(path_nodes, by = ".tidygraph_node_index") %>%
  separate(name, into = c("x", "y"), convert = TRUE) %>%
  arrange(node)


distance_data <-
  cells %>%
  unite("name", x, y) %>%
  left_join(distances, by = "name") %>%
  mutate(dist = round(dist, 1)) %>%
  select(-.tidygraph_node_index) %>%
  separate(name, into = c("x", "y"), convert = TRUE)

p <-
  ggplot(distance_data, aes(x = x, y = y)) +
  geom_tile(aes(fill = cost, dist = dist)) +
  geom_path(
    data = path_data,
    aes(group = .tidygraph_edge_index),
    color = "red",
    arrow = arrow(length = unit(0.05, "inches"), type = "closed")
  ) +
  scale_fill_viridis_c(option = "plasma")

## Warning: Ignoring unknown aesthetics: dist

p +
  geom_text(aes(label = dist))

plotly::ggplotly(p)