バケットソート（と計数ソート）（Ruby）

バケットソートはバケツソート、ビンソート、計数ソート（後記：計数ソートとバケットソートはちがう）などとも言います。非常に高速ですが、ソートされる対象は 0以上の整数値（またはそれに変換できるもの）であり、その最大値が大きくなるとメモリをバカ食いします。また、値に重複がない場合はここにあるように Ruby では

class Array
  def bucket_sort
    inject([]) {|mem, var| mem[var] = var; mem}.compact
  end
end

と驚異的にシンプルに書けますが、値の重複を許すとそんなに簡単ではないようです。

バケットソートについては小飼弾さんのブログ記事が啓蒙的です。

参考書の手続きを Ruby でコーディングしてみました。値が重複する場合も対応しています。

class Array
  def counting_sort
    #Integer{self[]} -> Integer{m, equal[], result}
    m = max + 1
    equal = Array.new(m, 0)
    size.times {|i| equal[self[i]] += 1}
    
    equal[-1] = 0
    (m - 1).times {|i| equal[i] += equal[i - 1]}
    
    result = Array.new(size)
    size.times do |i|
      result[equal[self[i] - 1]] = self[i]
      equal[self[i] - 1] += 1
    end
    result
  end
end

やっていることは、値の最大値 + 1 を m として、まず大きさ m の配列 equal を作り、値 a の（重複する）要素の個数を equal[a] に入れます。つまり、ソートすべき配列に 4の値が 3個あれば、equal[4] = 3 とするということです。

次に、値 a より小さいすべての要素の個数を equal[a - 1] に入れます。

最後に並べ直します。ソートすべき配列と同じ大きさの配列 result を作り、ソートすべき配列の i 番目の値 a が result[equal[a - 1]] に入ります。重複したものが重ねて入らないように equal[a - 1] をインクリメントします。これをすべての i について繰り返すと、result に答えが入っています。

バケットソート計数ソートは上を見てわかるとおり、「値の比較」というものをまったくやっていません。それが高速になる理由です。

※追記　どうやらこのソートはバケットソートではなく、計数ソートというべきのようです。日本語版 Wikipedia は記述がまちがっているようだ。計数ソートとバケットソートは同じではないらしい。計数ソートは「安定的な」ソートです。つまり重複部分で、オブジェクトなど、付随するデータの順序を変えません。

アルゴリズムの基本

　

※追記
ぐぐっていたらもっとシンプルな実装を見つけました。多少好みの書き方に直して下に記しておきます。（後記：これはバケットソートなんでしょうか、よくわかりません。）

class Array
  def bucket_sort
    m = max + 1
    equal = Array.new(m, 0)
    size.times {|i| equal[self[i]] += 1}
    
    result = []
    m.times do |i|
      equal[i].times {result << i}
    end
    result
  end
end

後半でループがネストしているのでサイズが大きくなると不利かなと思いましたが、ベンチマークしてみると、サイズが小さくても大きくてもこちらの方が若干速いようです。何といってもシンプルなので、こちらの方がいいですね。

ただひとつ気になるのは、こちらの実装だとサテライトデータ（ソートに付随するデータ）が扱えないのではないでしょうか（つまり、「安定的な」ソートではない）。最初の実装はサテライトデータを扱うことが可能です。

マージソートとクイックソートの比較（Ruby）

自分の実装で、マージソートとクイックソートのベンチマークをしてみました。
マージソートの実装はこれ、クイックソートのはこれ（いちばん下の実装）です。
　
マージソート。

クイックソート。

基本的にクイックソートの方が速いようである。

ベンチマーク。
bench_sorts.rb

require 'benchmark'

100.times do
  ar = (0..10_0000).to_a.shuffle
  Benchmark.bm 12 do |x|
    x.report("merge sort") {ar.merge_sort}
    x.report("quick sort") {ar.qsort}
  end
end

実行は $ ruby bench_sorts.rb > bench_sorts.txt。

Gnuplot でグラフ化。

require 'histogram/array'
require 'numo/gnuplot'

ar = open("bench_sorts.txt", &:readlines)
m = []
q = []
ar.each_slice(3) {|x| m << x[1]; q << x[2]}

pick_up = proc do |ar|
  ar.each_with_object([]) {|i, a| a << i.split(" ")[6].to_f}
end

mb, mf = pick_up.call(m).histogram
qb, qf = pick_up.call(q).histogram

Numo.gnuplot do
  set title: "merge sort"
  set terminal: [png: {size: [400, 300]}]
  set output: 'sort_m.png'
  set style: [:fill, :solid, {border: -1}]
  plot mb, mf, w: :boxes, lc: {rgb: "orange"}
end

Numo.gnuplot do
  set title: "quick sort"
  set terminal: [png: {size: [400, 300]}]
  set output: 'sort_q.png'
  set style: [:fill, :solid, {border: -1}]
  plot qb, qf, w: :boxes, lc: {rgb: "orange"}
end

エイト・クイーン（8 queen）問題を Ruby で解いてみる

エイト・クイーン - Wikipedia

チェスの盤上に、8個のクイーンを配置する。このとき、どの駒も他の駒に取られるような位置においてはいけない。

　
チェスの盤面は 8×8 であり、クイーンのコマは前後左右斜めにどれだけでも進むことができます。盤面上に 8つのクイーンを置くとき、どのクイーンも他のいずれにも取られないような配置を考えるわけです。

最初の駒は任意に与えられるものとしましょう。また、ひとつでも解が見つかれば終了することにします。考え方としては、人間がやる場合と似て、適当に一駒ずつ置いていき、失敗すればひとつ前に戻って置き直していくという方法を取ります。いわゆる「バックトラック法」というやつです。Ruby で解いてみました。下は回答のひとつです。

$ time ruby eight_queen.rb
@.......
......@.
....@...
.......@
.@......
...@....
.....@..
..@.....

real	0m0.077s
user	0m0.044s
sys	0m0.000s

eight_queen.rb

N = 8

class EightQueen
  class Step
    def initialize(x, y)
      @x, @y = x, y
      @parent = nil
      @depth = 0
    end
    attr_accessor :x, :y, :parent, :depth
  end
  
  def initialize(x, y)
    @stack = [Step.new(x, y)]
  end
  
  def solve
    #Step{a, nxt}, Integer{y, board[][]}
    while (a = @stack.pop)
      y = a.y + 1
      board = get_board(a)
      N.times do |x|
        next if board[y][x] == 1
        nxt = Step.new(x, y)
        nxt.parent = a
        nxt.depth = a.depth + 1
        finish(nxt) if nxt.depth == N - 1
        @stack.push(nxt)
      end
    end
    raise "No answer."
  end
  
  def get_board(a)
    #board, d, x1, x2
    board = Array.new(N) {Array.new(N, 0)}
    begin
      N.times do |i|
        board[i][a.x] = 1
        board[i] = Array.new(N, 1) if i == a.y
        d = (i - a.y).abs
        next if d.zero?
        x1 = a.x - d
        x2 = a.x + d
        board[i][x1] = 1 if x1 >= 0
        board[i][x2] = 1 if x2 < N
      end
    end while (a = a.parent)
    board
  end
  
  def finish(a)
    bd = Array.new(N) {"." * N}
    while a
      bd[a.y][a.x] = "@"
      a = a.parent
    end
    bd.map {|x| puts x}
    exit
  end
end

EightQueen.new(rand(N), 0).solve

※追記（7/24）
コードを多少修正しました。また、すべてのパターン（92通り）も求めてみました。コードと結果は下の Gist に。実行時間は 0.1秒程度です。コードは上のものにほんの少し修正を加えただけです。
eight_queen_all.rb · GitHub
　
続編。
obelisk.hatenablog.com

与えられた迷路の最短経路を求める（Ruby）

人材獲得作戦・４ 試験問題ほか: 人生を書き換える者すらいた。

さて試験問題です。
内容は、壁とスペースで構成された迷路が与えられたとき、スタート地点からゴール地点に至る最短経路を求めよ、というものです。

　
おもしろそうなので Ruby で解いてみました。もともとはここで知ったものです。
僕はまだまだ不勉強で A* も dijkstra も知りませんが（そのうちお勉強する予定）、ふつうに幅優先探索ですよね。

というわけでやってみました。先に出力を載せておきます。

$ time ruby solve_maze.rb
**************************
*S* *$$$$                *
*$* *$ *$ *************  *
*$*$$$* $  ************  *
*$$$ *  $$$$$$$          *
**************$***********
* $$$$$$$$$$$$$          *
**$***********************
* $$$  *$$$$$$$$$$$$$$G  *
*  *$$$$$ *********** *  *
*    *        ******* *  *
*       *                *
**************************

real	0m0.164s
user	0m0.072s
sys	0m0.012s

こんな感じで解けました。

コードは以下。上に書いたとおり、単純な幅優先探索です。もちろん幅優先探索は最短経路を与えます。
solve_maze.rb

class SolveMaze
  class Step
    def initialize(x, y)
      @x, @y = x, y
      @parent = nil
    end
    attr_accessor :x, :y, :parent
    
    [:up, :down, :left, :right].each_with_index do |mt, i|
      define_method(mt) do
        a = [Step.new(x, y - 1), Step.new(x, y + 1),
             Step.new(x - 1, y), Step.new(x + 1, y)][i]
        a.parent = self
        a
      end
    end
  end
  
  def initialize
    @map = DATA.readlines
  end
  
  def get(st)
    @map[st.y][st.x]
  end
  
  def set(st, ch)
    @map[st.y][st.x] = ch
  end
  
  def go
    stack = [Step.new(1, 1)]
    
    while (a = stack.shift)
      [a.up, a.down, a.left, a.right].each do |nxt|
        case get(nxt)
        when "G" then finish(a)
        when " "
          set(nxt, "@")
          stack.push(nxt)
        end
      end
    end
  end
  
  def finish(a)
    @map.map! {|x| x.gsub(/@/, " ")}
    while a.parent
      set(a, "$")
      a = a.parent
    end
    @map.each {|x| puts x}
    exit
  end
end

SolveMaze.new.go

__END__
**************************
*S* *                    *
* * *  *  *************  *
* *   *    ************  *
*    *                   *
************** ***********
*                        *
** ***********************
*      *              G  *
*  *      *********** *  *
*    *        ******* *  *
*       *                *
**************************

メインループは SolveMaze#go の while 文です。SolveMaze#finish は回答を出力して終了します。それぞれのステップをクラス（Step クラス）にするまでもなかったかも知れませんが、まあいいんじゃないでしょうか。

DRY原則を満たすためにちょっとだけメタプログラミングを使っている以外は、素直なコードではないかと思います。

僕などがいうまでもないのですが、幅優先探索が気になる方は、while (a = stack.shift) と stack.push(nxt) の部分に特に気をつけてコードを読んでみて下さい。ちなみに、この shift を pop に替えるだけで深さ優先探索になりますよ。これでも解は求められますが、一般に最短経路になりません。一行替えるだけでのちがい、やってみるとおもしろいと思います。

なお、Ruby コミッターの「まめめも」さんのコードはすごいです。え、こんなに短いの、という感じ。自分などはまだまだですね。

　

別解

別様に解いてみました（2018/12/12）。上の半分ほどの行数になっています。

solve_maze1.rb

Position = Struct.new(:x, :y, :parent)

field = DATA.readlines
start = Position.new
field.each_with_index {|l, i| start.x, start.y = (l.index("S") or next), i}
stack = [start]

# solve
finish = loop do
  po = stack.shift
  break po if field[po.y][po.x] == "G"
  [[1, 0], [0, -1], [-1, 0], [0, 1]].each do |dx, dy|
    nx, ny = po.x + dx, po.y + dy
    a = field[ny][nx]
    field[ny][nx] = "@" if a == " "
    stack << Position.new(nx, ny, po) if a == " " or a == "G"
  end
end

# 結果の表示
field.map! {|l| l.gsub("@", " ")}
prev = finish.parent
until prev == start
  field[prev.y][prev.x] = "$"
  prev = prev.parent
end
puts field

__END__
**************************
*S* *                    *
* * *  *  *************  *
* *   *    ************  *
*    *                   *
************** ***********
*                        *
** ***********************
*      *              G  *
*  *      *********** *  *
*    *        ******* *  *
*       *                *
**************************

マージソート（Ruby）

後記。以下の実装のほとんどはふつういうマージソートの実装ではありません。何かしら別物です。追記された merge_sort2.rb のみがふつういうマージソートの実装なので注意してください。というか、参考にしないで下さい。
　

---

アルゴリズムの基本

マージソートのアルゴリズムだけ勉強して、自力で Ruby で実装してみました。

merge_sort.rb

class Array
  def merge_sort
    return [] if empty?
    each_slice(1).to_a.merge
  end
  
  def merge
    #ar0, ar
    ar0 = []

    each_slice(2) do |x|
      ar = []
      if x.size == 1
        ar = x[0]
      else
        while x[0].size.nonzero? and x[1].size.nonzero?
          ar.push((x[0][0] < x[1][0]) ? x[0].shift : x[1].shift)
        end
        ar += x[0] + x[1]　
      end
      ar0 << ar
    end
    
    return ar0[0] if ar0.size == 1
    ar0.merge
  end
  protected :merge
end

a = (0..10).to_a.shuffle
a.merge_sort

Array#merge は分割されたソート済みの配列を2つずつ選んで結合します。結合をしているのは while 以下の 4行で、配列 x[0] と x[1] から値の小さい順に要素を選んで配列 ar に push します（値の小さい順に選んでいるので、配列 ar もソート済になります）。そしてそれを再帰的に繰り返し、すべて結合したら終了となります。
　
　
ここでの実装（これは本を参考にした）の方がすっきりしていますかねえ。でも、自力の実装もアルゴリズムに素直だという利点があると思います。

※追記（2018/2/9）
別様に実装してみました。
merge_sort1.rb

class Array
  def merge_sort
    join = lambda do |a, b|
      result = []
      while a.size.nonzero? and b.size.nonzero?
        result.push((a[0] < b[0]) ? a.shift : b.shift)
      end
      result + a + b
    end
    msort = lambda do |ar|
      return ar[0] if ar.size <= 1
      merged = []
      ar.each_slice(2) {|a, b| merged << join.call(a, (b or []))}
      msort.call(merged)
    end
    msort.call(map {|x| [x]})
  end
end

アルゴリズムどおりに素直に実装しました。まず与えられた配列をバラバラにしてそれぞれを配列化します。関数 msort は二つずつ配列を取り出して join します。関数 join[a, b] は、ソート済の二つの配列 a, b を、うまくソート済になるように結合します。

※再追記（2018/3/12）
さらに別様に実装してみました。これがふつういうマージソートの実装です。
merge_sort2.rb

class Array
  def merge_sort
    merge = ->(a, b) {
      result = []
      while a.size.nonzero? and b.size.nonzero?
        result.push((a[0] <= b[0]) ? a.shift : b.shift)
      end
      result + a + b
    }
    
    return self if length <= 1
    q = length / 2
    merge.(self[0...q].merge_sort, self[q..-1].merge_sort)
  end
end

Ruby でたらいまわし関数を遅延評価する

Haskell が遅延評価で「たらいまわし関数」を高速に実行できるなら、Ruby でも Proc で遅延評価できるので、Ruby でも「たらいまわし関数」を高速化できるのではないかと思った。でぐぐってみたら、そのものズバリの記事を発見。
　
おお、きちんとまとまったわかりやすい記事である。このリンクだけで充分なのだが、やはり自分でやってみないとということでやってみました。基本的に上記事のコードと同じ内容です（多少好みに書き換えました）。

tarai_lazy.rb

class Proc
  def -(lmd)
    ->{self.call - lmd.call}
  end
end


def tak_lazy(x, y, z)
  ->{
    xval = x.call
    yval = y.call
    if xval <= yval
      yval
    else
      tak_lazy(tak_lazy(x - ->{1}, y, z),
               tak_lazy(y - ->{1}, z, x),
               tak_lazy(z - ->{1}, x, y)).call
    end
  }
end

x, y, z = 12, 6, 0
tak = tak_lazy(->{x}, ->{y}, ->{z}).call
puts "tak(#{x}, #{y}, #{z}) = #{tak}"

数値まで lambda で包んでしまう。実行結果。

$ time ruby tarai_lazy.rb
tak(12, 6, 0) = 12

real	0m0.096s
user	0m0.036s
sys	0m0.020s

おお、圧倒的に速い！（Linux Mint 18.2 @ Core i5 4210U 1.70GHz; Ruby 2.3.3）

なんと、過去記事での C言語より速いではないか！　遅延評価を使わない Ruby 版と比べると、約20倍の高速化になっている（以上 user で比較）。なるほど、「たらいまわし関数」は遅延評価と相性がいいのだなと納得。まあ、Haskell 版にはさすがに敵いませんが。

Haskell でたらいまわし関数

まだ Haskell は全然わかりませんが、Haskell では「たらいまわし関数」がすごいということなのでやってみました。「たらいまわし関数」については、このブログにも簡単な記事があって、Ruby などでやってみております。簡単にいうと、これは関数呼び出しのベンチマークに使われる関数です。竹内関数とも呼ばれます。

で、Haskell のコードです。面倒な部分（つまり入出力）ははしょって、超初心者らしく書いております（他人のコードを参考にして、というかもろパクっています）。

tarai :: Int -> Int -> Int -> Int
tarai x y z
    | x <= y    = y
    | otherwise = tarai
                    (tarai (x - 1) y z)
                    (tarai (y - 1) z x)
                    (tarai (z - 1) x y)
                    
main = putStrLn $ show $ tarai 12 6 0

　
実行結果。

$ ghc tarai.hs
$ time ./tarai
12

real	0m0.003s
user	0m0.000s
sys	0m0.000s

なんというか…、言葉も出ません。

これはどういうことかというのですが、何なんでしょうね。詳しくは
で色いろ調べられております（自分にはよくわかりませんが）。遅延評価のためということなのでしょう。カリー化は？　これも自分にはよくわかりませんが、もちろん関係しているのでしょうな。たらいまわし関数に関しては Haskell 最強という話であります。

※追記
インタプリタでやっても速いので、これはやはり遅延評価自体の威力なんだろうなあ。

$ time runghc tarai.hs
12

real	0m0.192s
user	0m0.148s
sys	0m0.036s