M.Hiroi's Home Page
http://www.geocities.jp/m_hiroi/

Julia Language Programming

簡単なプログラム (4)

[ Home | Light | Julia ]

●N Queens Problem

「8 クイーン」はコンピュータに解かせるパズルの中でも特に有名な問題です。このパズルは 8 行 8 列のチェス盤の升目に、8 個のクイーンを互いの利き筋が重ならないように配置する問題です。クイーンは将棋の飛車と角をあわせた駒で、縦横斜めに任意に動くことができます。解答の一例を下図に示します。

               列           
         1 2 3 4 5 6 7 8    
       *-----------------*  
     1 | Q . . . . . . . |  
     2 | . . . . Q . . . |  
     3 | . . . . . . . Q |  
  行 4 | . . . . . Q . . |  
     5 | . . Q . . . . . |  
     6 | . . . . . . Q . |  
     7 | . Q . . . . . . |  
     8 | . . . Q . . . . |  
       *-----------------*  

    図 : 8 クイーンの解答例

N Queens Problem は「8 クイーン」の拡張バージョンで、N 行 N 列の盤面に N 個のクイーンを互いの利き筋が重ならないように配置する問題です。詳しい説明は C言語超入門: N Queens Problem をお読みください。今回はビット演算で高速化したプログラムを Julia に移植しました。

リスト : N Queens Problem

function queen(n, right, left)
    global cnt
    if n == 0
        cnt += 1
    else
        m = n
        while m > 0
            q = m & (-m)
            if q & (right | left) == 0
                queen(n $ q, (right | q) << 1, (left | q) >> 1)
            end
            m &= m - 1
        end
    end
end

# 実行
for i in 12 : 16
    global cnt
    cnt = 0
    @time queen((1 << i) - 1, 0, 0)
    println(cnt)
end
            表 : 実行結果 (時間 : 秒)

  個数 :  12   :  13   :  14   :   15    :   16
 ------+-------+-------+-------+---------+--------
  解   : 14200 : 73712 :365596 : 2279184 :14772512
  時間 : 0.019 : 0.10  : 0.61  :  3.836  : 25.61

実行環境 : Windows 7, Core i7-2670QM 2.20GHz

●騎士の巡歴

ナイト (騎士) はチェスの駒のひとつで将棋の桂馬の動きを前後左右にとることができます。次の図を見てください。

    ┌─┬─┬─┬─┬─┐    ┌─┬─┬─┬─┬─┐
    │  │●│  │●│  │    │K│  │  │  │  │
    ├─┼─┼─┼─┼─┤    ├─┼─┼─┼─┼─┤
    │●│  │  │  │●│    │  │  │  │  │  │
    ├─┼─┼─┼─┼─┤    ├─┼─┼─┼─┼─┤
    │  │  │K│  │  │    │  │  │  │  │  │
    ├─┼─┼─┼─┼─┤    ├─┼─┼─┼─┼─┤
    │●│  │  │  │●│    │  │  │  │  │  │
    ├─┼─┼─┼─┼─┤    ├─┼─┼─┼─┼─┤
    │  │●│  │●│  │    │  │  │  │  │  │
    └─┴─┴─┴─┴─┘    └─┴─┴─┴─┴─┘

 ●:ナイト (K) が動ける位置           問題 

                  問題 : 騎士の巡歴

このナイトを動かして、N 行 M 列の盤面のどのマスにもちょうど一回ずつ訪れるような経路を求めるのが問題です。ちなみに、3 行 3 列、4 行 4 列の盤面には解がありませんが、5 行 5 列の盤面には解があります。今回は 5 行 5 列の盤面でナイトの移動経路の総数を求めるプログラムを作ります。

盤面は 2 次元配列で表すことにします。この場合、騎士の移動手順は 5 行 5 列の盤面に記録したほうが簡単です。騎士が訪れていないマスを 0 とし、騎士の移動手順を 1 から始めれば、移動できるマスの判定を簡単に行うことができます。また、経路の出力も盤面を表示した方が直感的でわかりやすいかもしれません。

次は盤面の構成を考えましょう。単純な 5 行 5 列の 2 次元配列にすると、騎士が盤面から飛び出さないようにするため座標の範囲チェックが必要になります。このような場合、盤面の外側に壁を設定するとプログラムが簡単になります。

騎士は最大で 2 マス移動するので、壁の厚さも 2 マス用意します。したがって、盤面を表す配列は 9 行 9 列の大きさになります。壁に 0 以外の値 (1) を設定しておけば、騎士が盤面から飛び出して壁の位置に移動しようとしても、盤面の値が 0 ではないので実際に移動することはできません。これで騎士を移動したときの範囲チェックを省略することができます。

リスト : 騎士の巡歴

# 盤面の初期化
function init_board()
    board = Array(Int, 9, 9)
    fill!(board, 1)
    for i in 3 : 7
        for j in 3 : 7
            board[i, j] = 0
        end
    end
    board[3, 3] = 1
    board
end

# 移動
dx = [1,  2,  2, 1, -1, -2, -2, -1]
dy = [-2, -1, 1, 2,  2,  1, -1, -2]

# 盤面の表示
function print_board(board)
    global cnt
    cnt += 1
    for i in 3 : 7
        for j in 3 : 7
            @printf "%2d " board[i, j]
        end
        println("")
    end
    println("")
end

# 解法
function solver(board, n, x, y)
    if n > 25
        print_board(board)
    else
        for i in 1 : 8
            x1 = x + dx[i]
            y1 = y + dy[i]
            if board[x1, y1] == 0
                board[x1, y1] = n;
                solver(board, n + 1, x1, y1);
                board[x1, y1] = 0;
            end
        end
    end
end

cnt = 0
solver(init_board(), 2, 3, 3)
println(cnt)

配列 dx は騎士の x 方向の変位、配列 dy は y 方向の変位を表します。現在の座標にこの値を加えることで、次の座標を決定します。配列 board は盤面を表します。関数 init_board() で、壁の部分は 1 に、実際の盤面は 0 に初期化しておきます。

関数 solver() は引数として手数 n と騎士の座標 x, y を受け取ります。まず、n が 25 よりも大きくなったかチェックします。そうであれば、騎士はすべてのマスを訪れたので、print_board() で盤面を出力します。

そうでなければ、次に移動するマスを選びます。for 文で dx と dy の要素を取り出して x と y の値に加え、solver() を再帰呼び出しします。再帰呼び出しから戻ってきたら、board[x1, y1] の値を 0 に戻すことをお忘れなく。あとはとくに難しいところはないと思います。

 1 16 21 10 25 
20 11 24 15 22 
17  2 19  6  9 
12  7  4 23 14 
 3 18 13  8  5 

・・・省略・・・

 1 16 11  6  3 
10  5  2 17 12 
15 22 19  4  7 
20  9 24 13 18 
23 14 21  8 25 

304

●ラテン方陣

「ラテン方陣」は数独の枠の条件を無くした方陣です。ラテン方陣の定義を 参考文献 より引用します。

『ラテン方陣を一般的にいうなら、n 行 n 列の正方形の枡に n 種類の記号を n 個ずつ配列して、各行各列に記号の重複のないものを n 次のラテン方陣というのです。』

このラテン方陣をパズルに応用したものが数独というわけです。

簡単な例を示しましょう。3 次のラテン方陣は次に示す 12 通りになります。

 0 1 2    0 1 2    0 2 1    0 2 1    1 0 2    1 0 2 
 1 2 0    2 0 1    1 0 2    2 1 0    0 2 1    2 1 0 
 2 0 1    1 2 0    2 1 0    1 0 2    2 1 0    0 2 1 
 標準形

 1 2 0    1 2 0    2 0 1    2 0 1    2 1 0    2 1 0 
 0 1 2    2 0 1    0 1 2    1 2 0    0 2 1    1 0 2 
 2 0 1    0 1 2    1 2 0    0 1 2    1 0 2    0 2 1 

               図 : 3 次のラテン方陣

この中で、最初の行と列の要素を昇順に並べたものを「標準形」といいます。3 次のラテン方陣の場合、標準形は 1 種類しかありません。ラテン方陣は任意の行を交換する、または任意の列を交換してもラテン方陣になります。3 次のラテン方陣の場合、標準形から行または列を交換することで、残りの 11 種類のラテン方陣を生成することができます。

今回は標準形ラテン方陣の総数を求めるプログラムを作ります。

リスト : ラテン方陣

function check(mat, x, y, n, z)
    for i in 1 : n
        if mat[x, i] == z || mat[i, y] == z
            return false
        end
    end
    true
end

function solver_sub(mat, x, y, n)
    global cnt
    if y > n
        # println(mat)
        cnt += 1
    elseif x > n
        solver_sub(mat, 2, y + 1, n)
    else
        for z in 1 : n
            if check(mat, x, y, n, z)
                mat[x, y] = z
                solver_sub(mat, x + 1, y, n)
                mat[x, y] = 0
            end
        end
    end
end

function solver(n)
    global cnt
    cnt = 0
    mat = Array(Int, n, n)
    fill!(mat, 0)
    for i in 1 : n
        mat[1, i] = i
        mat[i, 1] = i
    end
    solver_sub(mat, 2, 2, n)
    println(cnt)
end

# 実行
for n in 3 : 7
    @time solver(n)
end

プログラムは簡単なので説明は割愛します。実行結果は次のようになりました。

1
  0.077024 seconds (14.92 k allocations: 535.315 KB)
4
  0.000990 seconds (14 allocations: 460 bytes)
56
  0.000940 seconds (14 allocations: 508 bytes)
9408
  0.022367 seconds (8.91 k allocations: 139.559 KB)
16942080
 58.505503 seconds (16.94 M allocations: 258.508 MB, 0.07% gc time)

実行環境 : Windows 7, Core i7-2670QM 2.20GHz

単純なプログラムなので実行時間は遅いですね。高次の標準形ラテン方陣の総数は、簡単に求めることができない非常にハードな問題だといわれています。興味のある方は挑戦してみてください。

-- 参考文献 --------
大村平, 『数理パズルのはなし』, 日科技連出版社, 1998

●8パズル (幅優先探索)

皆さんお馴染みの「8パズル」を幅優先探索で解くプログラムです。詳しい説明は拙作のページ C言語超入門: スライドパズル をお読みください。

リスト : 8パズルの解法 (幅優先探索)

# 盤面
# 1 2 3
# 4 5 6
# 7 8 9

# 隣接リスト
adjacent = Array{Int, 1}[
  [2, 4],       # 1
  [1, 3, 5],    # 2
  [2, 6],       # 3
  [1, 5, 7],    # 4
  [2, 4, 6, 8], # 5
  [3, 5, 9],    # 6
  [4, 8],       # 7
  [5, 7, 9],    # 8
  [6, 8]        # 9
]

# 局面
type State
    board    # 盤面
    space    # 空き場所の位置
    prev     # 1 手前の局面 (終端は nothing)
end

# キュー
que = Array(State, 181440)
front = 1
rear = 1

# 操作関数
enq(st) = (global rear; que[rear] = st; rear += 1)
deq() = (global front; st = que[front]; front += 1; st)
isempty() = front == rear

# 位置を返す
function position(xs, x)
    for i in 1 : length(xs)
        if xs[i] == x; return i; end
    end
    0
end

# 手順の表示
function print_answer(st)
    if st.prev != nothing
        print_answer(st.prev)
    end
    println(st.board)
end

# 幅優先探索
function solver(start, goal)
    chk = Dict{Array{Int, 1}, Bool}()
    enq(State(start, position(start, 0), nothing))
    chk[start] = true
    while !isempty()
        st = deq()
        for x in adjacent[st.space]
            new_board = copy(st.board)
            new_board[st.space] = new_board[x]
            new_board[x] = 0
            new_st = State(new_board, x, st)
            if new_board == goal
                print_answer(new_st)
                return
            elseif !haskey(chk, new_board)
                enq(new_st)
                chk[new_board] = true
            end
        end
    end
end

@time solver([8,6,7,2,5,4,3,0,1], [1,2,3,4,5,6,7,8,0])
[8,6,7,2,5,4,3,0,1]
[8,6,7,2,0,4,3,5,1]
[8,0,7,2,6,4,3,5,1]
[0,8,7,2,6,4,3,5,1]
[2,8,7,0,6,4,3,5,1]
[2,8,7,3,6,4,0,5,1]
[2,8,7,3,6,4,5,0,1]
[2,8,7,3,6,4,5,1,0]
[2,8,7,3,6,0,5,1,4]
[2,8,0,3,6,7,5,1,4]
[2,0,8,3,6,7,5,1,4]
[2,6,8,3,0,7,5,1,4]
[2,6,8,0,3,7,5,1,4]
[2,6,8,5,3,7,0,1,4]
[2,6,8,5,3,7,1,0,4]
[2,6,8,5,3,7,1,4,0]
[2,6,8,5,3,0,1,4,7]
[2,6,0,5,3,8,1,4,7]
[2,0,6,5,3,8,1,4,7]
[2,3,6,5,0,8,1,4,7]
[2,3,6,0,5,8,1,4,7]
[2,3,6,1,5,8,0,4,7]
[2,3,6,1,5,8,4,0,7]
[2,3,6,1,5,8,4,7,0]
[2,3,6,1,5,0,4,7,8]
[2,3,0,1,5,6,4,7,8]
[2,0,3,1,5,6,4,7,8]
[0,2,3,1,5,6,4,7,8]
[1,2,3,0,5,6,4,7,8]
[1,2,3,4,5,6,0,7,8]
[1,2,3,4,5,6,7,0,8]
[1,2,3,4,5,6,7,8,0]
  1.321937 seconds (2.34 M allocations: 78.702 MB, 17.80% gc time)

実行環境 : Windows 7, Core i7-2670QM 2.20GHz

●8パズル (反復深化)

皆さんお馴染みの「8パズル」を単純な反復深化で解くプログラムです。詳しい説明は拙作のページ C言語超入門: スライドパズル (2) をお読みください。

リスト : 8パズルの解法 (反復深化)

# 大域変数

# 盤面
board = [8,6,7,2,5,4,3,0,1]
goal  = [1,2,3,4,5,6,7,8,0]

# 手順
moves = [0]

# 盤面
# 1 2 3
# 4 5 6
# 7 8 9

# 隣接リスト
adjacent = Array{Int, 1}[
  [2, 4],       # 1
  [1, 3, 5],    # 2
  [2, 6],       # 3
  [1, 5, 7],    # 4
  [2, 4, 6, 8], # 5
  [3, 5, 9],    # 6
  [4, 8],       # 7
  [5, 7, 9],    # 8
  [6, 8]        # 9
]

# 位置を返す
function position(xs, x)
    for i in 1 : length(xs)
        if xs[i] == x; return i; end
    end
    0
end

# 単純な反復進化
function dfs(n, limit, space)
    global cnt
    if n == limit
        if board == goal
            println(moves[2:end])
            throw("found!")
        end
    else
        for x in adjacent[space]
            p = board[x]
            if moves[end] == p; continue; end
            push!(moves, p)
            board[space] = p
            board[x] = 0
            dfs(n + 1, limit, x)
            board[x] = p
            board[space] = 0
            pop!(moves)
        end
    end
end

# パリティ
parity = [
    1, 0, 1,
    0, 1, 0,
    1, 0, 1
]

s = parity[position(board, 0)] != parity[position(goal, 0)] ? 1 : 2
try
    for i in s : 2 : 31
        println("----- $i -----")
        dfs(0, i, position(board, 0))
    end
catch e
    println(e)
end
----- 1 -----
----- 3 -----
----- 5 -----
----- 7 -----
----- 9 -----
----- 11 -----
----- 13 -----
----- 15 -----
----- 17 -----
----- 19 -----
----- 21 -----
----- 23 -----
----- 25 -----
----- 27 -----
----- 29 -----
----- 31 -----
[5,6,8,2,3,5,1,4,7,8,6,3,5,1,4,7,8,6,3,5,1,4,7,8,6,3,2,1,4,7,8]
found!

●11 パズル (下限値枝刈り法)

「11 パズル」を反復深化と下限値枝刈り法で解くプログラムです。詳しい説明は拙作のページ C言語超入門: スライドパズル (2) をお読みください。

リスト : 11 パズルの解法 (反復深化と下限値枝刈り法)

# 盤面
# 1  2  3  4
# 5  6  7  8
# 9 10 11 12

# 隣接リスト
const adjacent = Array{Int, 1}[
    [2, 5],        # 1
    [1, 3, 6],     # 2
    [2, 4 , 7],    # 3
    [3, 8],        # 4
    [1, 6, 9],     # 5
    [2, 5, 7, 10], # 6
    [3, 6, 8, 11], # 7
    [4, 7, 12],    # 8
    [5, 10],       # 9
    [6, 9, 11],    # 10
    [7, 10, 12],   # 11
    [8, 11]        # 12
]

# 距離
const distance = Array{Int, 1}[
    [0, 1, 2, 3, 1, 2, 3, 4, 2, 3, 4, 5],  # 1
    [1, 0, 1, 2, 2, 1, 2, 3, 3, 2, 3, 4],  # 2
    [2, 1, 0, 1, 3, 2, 1, 2, 4, 3, 2, 3],  # 3
    [3, 2, 1, 0, 4, 3, 2, 1, 5, 4, 3, 2],  # 4
    [1, 2, 3, 4, 0, 1, 2, 3, 1, 2, 3, 4],  # 5
    [2, 1, 2, 3, 1, 0, 1, 2, 2, 1, 2, 3],  # 6
    [3, 2, 1, 2, 2, 1, 0, 1, 3, 2, 1, 2],  # 7
    [4, 3, 2, 1, 3, 2, 1, 0, 4, 3, 2, 1],  # 8
    [2, 3, 4, 5, 1, 2, 3, 4, 0, 1, 2, 3],  # 9
    [3, 2, 3, 4, 2, 1, 2, 3, 1, 0, 1, 2],  # 10
    [4, 3, 2, 3, 3, 2, 1, 2, 2, 1, 0, 1]   # 11
]

# 盤面
const board = [0, 3, 2, 1, 8, 7, 6, 5, 4, 11, 10, 9]
const goal  = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 0]

# 手順
const move_piece = [0]

# 移動距離を求める
function get_distance()
    v = 0
    for i in 1 : length(board)
        p = board[i]
        if p != 0
            v += distance[p][i]
        end
    end
    v
end

# 深さ優先探索
function dfs(n, space, limit, lower)
    if n == limit
        if board == goal
            println(move_piece[2:end])
            throw("found!!!")
        end
    else
        for x in adjacent[space]
            p = board[x]
            # 同じコマを動かすと元の局面に戻る
            if move_piece[end] == p; continue; end
            # 下限値の計算
            new_lower = lower - distance[p][x] + distance[p][space]
            if new_lower + n <= limit
                push!(move_piece, p)
                board[space] = p
                board[x] = 0
                dfs(n + 1, x, limit, new_lower)
                board[x] = p
                board[space] = 0
                pop!(move_piece)
            end
        end
    end
end

function solver()
    const parity = [
        1, 0, 1, 0,
        0, 1, 0, 1,
        1, 0, 1, 0,
    ]
    lower = get_distance()
    if (parity[1] == parity[12] && lower % 2 != 0) ||
       (parity[1] != parity[12] && lower % 2 == 0)
        lower += 1
    end
    try
        for i in lower : 2 : 53
            println("----- $i -----")
            dfs(0, 1, i, lower)
        end
    catch e
        println(e)
    end
end

@time solver()
----- 23 -----
----- 25 -----
----- 27 -----
----- 29 -----
----- 31 -----
----- 33 -----
----- 35 -----
----- 37 -----
----- 39 -----
----- 41 -----
----- 43 -----
----- 45 -----
----- 47 -----
----- 49 -----
----- 51 -----
----- 53 -----
[3,2,6,5,1,6,2,7,5,1,9,10,11,4,8,5,1,9,10,11,4,8,5,1,9,10,11,4,8,9,10,2,7,3,1,5,
9,10,2,11,4,8,11,7,6,4,7,6,3,2,6,7,8]
found!!!
 35.133996 seconds (77.95 k allocations: 2.537 MB, 0.07% gc time)

実行環境 : Windows 7, Core i7-2670QM 2.20GHz

●三目並べ

皆さんお馴染みのゲーム「三目並べ」で、両者が最善を尽くすと引き分けになることを示すプログラムです。詳しい説明は拙作のページ Puzzle DE Programming 三目並べ をお読みください。

リスト : 三目並べ

# 盤面
# 1 2 3
# 4 5 6
# 7 8 9

# 直線
const line_table = Array{Int, 1}[
  [1, 2, 3], [4, 5, 6], [7, 8, 9],
  [1, 4, 7], [2, 5, 8], [3, 6, 9],
  [1, 5, 9], [3, 5, 7]
]

#  0 : 空き場所
#  1 : ○
# -1 : ×
const MARU = 1
const BATU = -1
const board = [0,0,0, 0,0,0, 0,0,0]
const SIZE = 9
const MIN_VALUE = -2
const MAX_VALUE = 2

# 3つ並んだか?
function check_line(x, y, z)
    p = board[x]
    if p == board[y] == board[z]
        p
    else
        0
    end
end

# 勝敗の判定
function check_winner()
    for line in line_table
        r = check_line(line...)
        if r != 0
            return r
        end
    end
    0
end

# 先手
function think_maru(n)
    value = MIN_VALUE
    for i in 1 : SIZE
        if board[i] != 0; continue; end
        # MARU を書く
        board[i] = MARU
        # 勝敗の判定
        v = check_winner();
        # 決着していなければ相手の手番へ
        if v == 0 && n < SIZE
            v = think_batu(n + 1)
        end
        # ミニマックス
        if v > value; value = v; end
        # 元に戻す */
        board[i] = 0
    end
    value
end

# 後手
function think_batu(n)
    value = MAX_VALUE
    for i in 1 : SIZE
        if board[i] != 0; continue; end
        # BATU を書く
        board[i] = BATU;
        # 勝敗の判定
        v = check_winner()
        # 決着していなければ相手の手番へ
        if v == 0 && n < SIZE
            v = think_maru(n + 1)
        end
        # ミニマックス
        if v < value; value = v; end
        # 元に戻す
        board[i] = 0
    end
    value
end

function solver()
    for i in 1 : SIZE
        # 初手
        board[i] = MARU
        # 相手の手番
        v = think_batu(2)
        # 結果
        println("pos = $i, value = $v")
        # 元に戻す
        board[i] = 0
    end
end

@time solver()
pos = 1, value = 0
pos = 2, value = 0
pos = 3, value = 0
pos = 4, value = 0
pos = 5, value = 0
pos = 6, value = 0
pos = 7, value = 0
pos = 8, value = 0
pos = 9, value = 0
  0.920104 seconds (3.76 M allocations: 228.400 MB, 8.70% gc time)

実行環境 : Windows 7, Core i7-2670QM 2.20GHz

ところで、ルールを 3 つ並んだほうが負けに変更すると、初手が中央以外は後手必勝になります。プログラムの修正は関数 check_line() の返り値 r を -r に変更するだけです。

pos = 1, value = -1
pos = 2, value = -1
pos = 3, value = -1
pos = 4, value = -1
pos = 5, value = 0
pos = 6, value = -1
pos = 7, value = -1
pos = 8, value = -1
pos = 9, value = -1
  0.924857 seconds (3.76 M allocations: 228.404 MB, 9.13% gc time)

実行環境 : Windows 7, Core i7-2670QM 2.20GHz

●整数の分割

整数 n を 1 以上の自然数の和で表すことを考えます。これを「整数の分割」といいます。整数を分割するとき、同じ自然数を何回使ってもかまいませんが、並べる順序が違うだけのものは同じ分割とします。詳しい説明は拙作のページ Puzzle DE Programming 分割数 をお読みください。今回は整数の分割の仕方を列挙するプログラムを示します。

リスト : 整数の分割

function part_int_sub(f, n, k, a)
    if n == 0
        f(a)
    elseif n == 1
        push!(a, 1)
        f(a)
        pop!(a)
    elseif k == 1
        for _ in 1 : n; push!(a, 1); end
        f(a)
        for _ in 1 : n; pop!(a); end
    else
        if n >= k
            push!(a, k)
            part_int_sub(f, n - k, k, a)
            pop!(a)
        end
        part_int_sub(f, n, k - 1, a)
    end
end

partition_of_int(f, n) = part_int_sub(f, n, n, Int[])

partition_of_int(println, 5)
partition_of_int(println, 6)
partition_of_int(println, 7)
[5]
[4,1]
[3,2]
[3,1,1]
[2,2,1]
[2,1,1,1]
[1,1,1,1,1]
[6]
[5,1]
[4,2]
[4,1,1]
[3,3]
[3,2,1]
[3,1,1,1]
[2,2,2]
[2,2,1,1]
[2,1,1,1,1]
[1,1,1,1,1,1]
[7]
[6,1]
[5,2]
[5,1,1]
[4,3]
[4,2,1]
[4,1,1,1]
[3,3,1]
[3,2,2]
[3,2,1,1]
[3,1,1,1,1]
[2,2,2,1]
[2,2,1,1,1]
[2,1,1,1,1,1]
[1,1,1,1,1,1,1]

●集合の分割 (1)

配列で表した集合 ls を分割することを考えます。たとえば、集合 [1, 2, 3] は次のように分割することができます。

1 分割 : [[1, 2, 3]]
2 分割 : [[1, 2], [3]], [[1, 3], [2]], [[1], [2, 3]]
3 分割 ; [[1], [2], [3]]

このように、分割した集合 xs は元の集合 ls の部分集合になります。分割した部分集合の積は空集合になり、分割した部分集合のすべての和を求めると元の集合になります。今回は分割の仕方をすべて求める関数 parititon_of_set() を作ります。

リスト : 集合の分割

function part_sub(f, ls, a)
    if length(ls) == 0
        f(a)
    else
        for i = 1 : length(a)
            push!(a[i], ls[1])
            part_sub(f, ls[2:end], a)
            pop!(a[i])
        end
        push!(a, [ls[1]])
        part_sub(f, ls[2:end], a)
        pop!(a)
    end
end

function partition_of_set(f, ls)
    a = Int[]
    push!(a, ls[1])
    b = Array{Int, 1}[]
    push!(b, a)
    part_sub(f, ls[2:end], b)
end

partition_of_set(println, [1, 2, 3])
partition_of_set(println, [1, 2, 3, 4])
[[1,2,3]]
[[1,2],[3]]
[[1,3],[2]]
[[1],[2,3]]
[[1],[2],[3]]
[[1,2,3,4]]
[[1,2,3],[4]]
[[1,2,4],[3]]
[[1,2],[3,4]]
[[1,2],[3],[4]]
[[1,3,4],[2]]
[[1,3],[2,4]]
[[1,3],[2],[4]]
[[1,4],[2,3]]
[[1],[2,3,4]]
[[1],[2,3],[4]]
[[1,4],[2],[3]]
[[1],[2,4],[3]]
[[1],[2],[3,4]]
[[1],[2],[3],[4]]

●集合の分割 (2)

k 個の要素をもつ集合 ls を要素数が等しい m 個の部分集合に分割することを考えます。部分集合の要素数 n は k / m になります。今回は分割の仕方をすべて求める高階関数 group_partition() を作ります。

リスト : 集合の分割 (2)

function group_part_sub(f, ls, n, m, a)
    if length(ls) == 0
        f(a)
    else
        for i = 1 : length(a)
            if length(a[i]) < n
                push!(a[i], ls[1])
                group_part_sub(f, ls[2:end], n, m, a)
                pop!(a[i])
            end
        end
        if length(a) < m
            push!(a, [ls[1]])
            group_part_sub(f, ls[2:end], n, m, a)
            pop!(a)
        end
    end
end

function group_partition(f, n, m, ls)
    a = Int[]
    push!(a, ls[1])
    b = Array{Int, 1}[]
    push!(b, a)
    group_part_sub(f, ls[2:end], n, m, b)
end

group_partition(println, 2, 2, [1,2,3,4])
group_partition(println, 2, 3, [1,2,3,4,5,6])
[[1,2],[3,4]]
[[1,3],[2,4]]
[[1,4],[2,3]]
[[1,2],[3,4],[5,6]]
[[1,2],[3,5],[4,6]]
[[1,2],[3,6],[4,5]]
[[1,3],[2,4],[5,6]]
[[1,3],[2,5],[4,6]]
[[1,3],[2,6],[4,5]]
[[1,4],[2,3],[5,6]]
[[1,5],[2,3],[4,6]]
[[1,6],[2,3],[4,5]]
[[1,4],[2,5],[3,6]]
[[1,4],[2,6],[3,5]]
[[1,5],[2,4],[3,6]]
[[1,6],[2,4],[3,5]]
[[1,5],[2,6],[3,4]]
[[1,6],[2,5],[3,4]]

●カークマンの 15 人の女生徒

[問題]

15 人の女生徒が毎日 3 人ずつ 5 組に分かれて散歩をするとき、1 週間 (7 日) のうちに、どの女生徒も他のすべての女生徒と 1 回ずつ同じ組になるような組み合わせを作ってください。

出典 : 大村平 (著), 『数理パズルの話』, 日科技連出版社, 1998

「カークマンの 15 人の女生徒」の解法プログラムは group_partition() を改造することで簡単に作成することができます。

リスト : カークマンの 15 人の女生徒

const check_table = Array{Int, 1}[
    [], [], [], [], [],
    [], [], [], [], [],
    [], [], [], [], [],
]

function check_student(xs, y)
    for x in xs
        if y in check_table[x]; return false; end
    end
    true
end

function add_student(xs, y)
    for x in xs
        push!(check_table[x], y)
        push!(check_table[y], x)
    end
end

function del_student(xs, y)
    for x in xs
        pop!(check_table[x])
        pop!(check_table[y])
    end
end

#
function kirakman_sub(ls, a, b)
    if length(ls) == 0
        push!(b, a)
        if length(b) == 7
            println(b)
            throw("found!!!")
        else
            kirakman_sub(collect(2:15), Array{Int,1}[[1]], b)
        end
        pop!(b)
    else
        for i = 1 : length(a)
            if length(a[i]) < 3 && check_student(a[i], ls[1])
                add_student(a[i], ls[1])
                push!(a[i], ls[1])
                kirakman_sub(ls[2:end], a, b)
                pop!(a[i])
                del_student(a[i], ls[1])
            end
        end
        if length(a) < 5
            push!(a, [ls[1]])
            kirakman_sub(ls[2:end], a, b)
            pop!(a)
        end
    end
end

function kirkman()
    try
        kirakman_sub(collect(2:15), Array{Int,1}[[1]], Array{Array{Int,1}, 1}[])
    catch e
        println(e)
    end
end

@time kirkman()
[[[1,2,3],[4,5,6],[7,8,9],[10,11,12],[13,14,15]],
 [[1,4,7],[2,5,10],[3,6,13],[8,11,14],[9,12,15]],
 [[1,5,14],[2,4,15],[3,8,12],[6,9,11],[7,10,13]],
 [[1,9,13],[2,7,12],[3,4,11],[5,8,15],[6,10,14]],
 [[1,8,10],[2,11,13],[3,5,9],[4,12,14],[6,7,15]],
 [[1,6,12],[2,9,14],[3,10,15],[4,8,13],[5,7,11]],
 [[1,11,15],[2,6,8],[3,7,14],[4,9,10],[5,12,13]]]
found!!!
  9.974719 seconds (35.54 M allocations: 2.185 GB, 2.74% gc time)

実行環境 : Windows 7, Core i7-2670QM 2.20GHz

Copyright (C) 2016 Makoto Hiroi
All rights reserved.

[ Home | Light | Julia ]