Rでフロイドの循環検出法を可視化する #R

フロイドの循環検出法(フロイドの循環検出法 - Wikipedia)はループを検出するアルゴリズムで、例えば循環小数の検出などに使える(cf.
Project Euler Problem 26 - 最も長い順環節を持つ循環小数 - もうカツ丼はいいよな)。

アルゴリズムの概要

循環に入るまでの長さを$\lambda$、循環部分の長さを$\mu$とする。例えば$\lambda = 8$、$\mu = 12$のリストをグラフで表すとこんな感じ。

1つずつ増えるインデックスと、2つずつ増えるインデックスの2種類を用意する。この2つをリストの最初から順番に進めていくと、両者はループの中の何処かで出会う。この時、遅いインデックスの進んだ距離を$m$とすると、早いインデックスは$2m$進んでいる。そして、両者の差である$m$はループの長さの整数倍になっている。

次に、片方のインデックスをスタート地点まで戻して、今度は両方共1つずつインデックスを進めていく。すると、スタートから開始したインデックスは(当たり前だが)$\lambda$進んだところでループの開始地点に達する。この時、地点$m=2m$から開始したインデックスは、スタートから考えると$\lambda+m$または$\lambda+2m$進んだ地点にいることになる。そして、$m$はループの整数倍なので、要するに$\lambda+m$の位置というのはループのスタート地点ということになる。つまり、等速で進んだ2つのインデックスはループのスタート地点で必ず出会うのであり、出会うまでに進んだ距離が$\lambda$ということになる。

さらに、そこから片方のインデックスの速度を再び2倍に戻す。すると、両者が再び出会うのは、ループの開始地点に戻ってきた時、つまり、$\mu$だけ進んだ時、ということになる。

よく分からないから図で示しておくれ

このアルゴリズムは別名ウサギとカメのアルゴリズムとも呼ばれている。ウサギとカメに例えると、このアルゴリズムの手順はこんな感じだ。

1歩ずつ進むカメさんと、カメさんの倍の速度で動くウサギさんを同時にスタートさせ、出会うまで動き続けさせる。両者が出会ったらウサギさんにはスタート地点まで戻っていただき、カメさんと同じ速度でスタートしてもらう。
再度両者が出会ったら、スタートからそこまでの距離を記録する。ウサギさんには再び倍速で移動しはじめてもらう。
再びカメさんとウサギさんが出会ったら、カメさんがそこまでに動いた距離を記録する。

図で示そう!!!

$m$と$\mu$が一緒だ。もしかすると最後の1周（ウサギさんにとっての2周)は要らないのでは…？

いや、そんなことはない。$\lambda < \mu$の場合には$m = \mu$となるが、$\lambda > \mu$の場合を考えてみると、$m > \mu$となる。$\lambda$と$\mu$は事前には分かっていないのだから、やはりこのステップは必要なのだ。

割と苦労したのでソース見て

なんかもっといいやり方があるのではないかと思いつつ、igraphとかggnetworkとか使ってアレしました。

ちなみに一番苦労したのはemojiの表示です(emojifontも試したけどなんか上手く行かなかった…)。

## フロイドの循環検出法を可視化する ----
library(dplyr)
library(igraph)
library(ggplot2)
library(GGally)
library(ggnetwork)
#devtools::install_github("dill/emoGG")
library(emoGG)

make_rho_graph <- function(lambda, mu, type = "network"){
  # ρの字型の有向グラフを作る
  nodes <- c(rep(1:(lambda+mu), rep(2, lambda+mu))[-c(1, 2*(lambda+mu))], lambda+mu, lambda+1) 
  if(type == "network"){
    nodes %>%
      matrix(ncol = 2, byrow = TRUE) %>%
      network
  } else {
    nodes %>% make_graph
  }
}

nextnode <- function(g, n){
  # 次のノードを返す
  ego(g, nodes = n, mode = "out")[[1]][2]
}

floyd_plot <- function(lambda, mu){
  # グラフの作成
  g_n <- make_rho_graph(lambda, mu)
  g_i <- make_rho_graph(lambda, mu, "igraph")
  # 座標位置の決定
  x <- gplot.layout.fruchtermanreingold(g_n, NULL)
  g_n %v% "x" <- x[,1]
  g_n %v% "y" <- x[,2]
  p <- ggnet2(g_n, mode = c("x", "y"), label = TRUE, arrow.gap = 0.025, arrow.size = 10)
  xp <- p$data$x
  yp <- p$data$y
  # プロットの保存先
  plist <- list()
  pidx <- 1
  
  # 最初にウサギとカメが出会うまで
  m <- 0
  plist[[pidx]] <- p + 
    add_emoji("1f422", xp[1], yp[1], .2) + add_emoji("1f430", xp[1], yp[1], .15) +
    annotate("text", x = .5, y = .9, label = paste("m =", m))
  
  rabbit <- 3
  turtle <- 2
  pidx <- 2
  m <- 1
  
  while(rabbit != turtle){
    plist[[pidx]] <- p + 
      add_emoji("1f422", xp[turtle], yp[turtle], .2) + 
      add_emoji("1f430", xp[rabbit], yp[rabbit], .15) +
      annotate("text", x = .5, y = .9, label = paste("m =", m))
    rabbit <- nextnode(g_i, rabbit) %>% nextnode(g_i, .)
    turtle <- nextnode(g_i, turtle)
    pidx <- pidx + 1
    m <- m + 1
  }
  plist[[pidx]] <- p + 
    add_emoji("1f422", xp[turtle], yp[turtle], .2) + 
    add_emoji("1f430", xp[rabbit], yp[rabbit], .15) + 
    annotate("text", x = xp[turtle], yp[turtle]+0.1, label = "!", col = "tomato", size = 10) +
    annotate("text", x = .5, y = .9, label = paste("m =", m))
  pidx <- pidx + 1
  
  # 等速で動くウサギ
  rabbit <- 1
  lmd <- 0
  while(rabbit != turtle){
    plist[[pidx]] <- p + 
      add_emoji("1f422", xp[turtle], yp[turtle], .2) + 
      add_emoji("1f430", xp[rabbit], yp[rabbit], .15) +
      annotate("text", x = .5, y = .9, label = paste("m =", m, " λ = ", lmd))
    rabbit <- nextnode(g_i, rabbit)
    turtle <- nextnode(g_i, turtle)
    pidx <- pidx + 1
    lmd <- lmd + 1
  }
  plist[[pidx]] <- p + 
    add_emoji("1f422", xp[turtle], yp[turtle], .2) + 
    add_emoji("1f430", xp[rabbit], yp[rabbit], .15) + 
    annotate("text", x = xp[turtle], yp[turtle]+0.1, label = "!", col = "tomato", size = 13) +
    annotate("text", x = .5, y = .9, label = paste("m =", m, " λ = ", lmd))
  pidx <- pidx + 1
  
  # 再び倍速で動くウサギ
  mu <- 0
  plist[[pidx]] <- p + 
    add_emoji("1f422", xp[turtle], yp[turtle], .2) + 
    add_emoji("1f430", xp[rabbit], yp[rabbit], .15) +
    annotate("text", x = .5, y = .9, label = paste("m =", m, " λ =", lmd, " μ =", mu))
  rabbit <- nextnode(g_i, rabbit) %>% nextnode(g_i, .)
  turtle <- nextnode(g_i, turtle)
  pidx <- pidx + 1
  mu <- mu + 1
  while(rabbit != turtle){
    plist[[pidx]] <- p + 
      add_emoji("1f422", xp[turtle], yp[turtle], .2) + 
      add_emoji("1f430", xp[rabbit], yp[rabbit], .15) +
      annotate("text", x = .5, y = .9, label = paste("m =", m, " λ =", lmd, " μ =", mu))
    rabbit <- nextnode(g_i, rabbit) %>% nextnode(g_i, .)
    turtle <- nextnode(g_i, turtle)
    pidx <- pidx + 1
    mu <- mu + 1
  }
  plist[[pidx]] <- p + 
    add_emoji("1f422", xp[turtle], yp[turtle], .2) + 
    add_emoji("1f430", xp[rabbit], yp[rabbit], .15) + 
    annotate("text", x = xp[turtle], yp[turtle]+0.1, label = "!", col = "tomato", size = 15) +
    annotate("text", x = .5, y = .9, label = paste("m =", m, " λ =", lmd, " μ =", mu))
  
  return(plist)
}

library(animation)

result <- floyd_plot(8, 12)
saveGIF(lapply(result, print))

result <- floyd_plot(11, 5)
saveGIF(lapply(result, print), movie.name = "animation2.gif")

🐰🐢