M.Hiroi's Home Page

Prolog Programming

制約論理プログラミング超入門

[ Home | Prolog | C L P ]

●騎士の巡歴

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

「騎士の巡歴 (Knight Tour)」は、ナイトを動かして N 行 N 列の盤面のどのマスにもちょうど一回ずつ訪れるような経路を求める問題です。ちなみに、3 行 3 列、4 行 4 列の盤面には解がありませんが、5 行 5 列の盤面には解があります。今回は条件をひとつ追加して、スタート (S) からゴール (G) までの経路を求めることにします。この場合、N が偶数だと解はありません。これは簡単に証明できるので、興味のある方は考えてみてください。

●隣接行列の作成

最初に、N 行 N 列の隣接行列を生成するプログラムを作りましょう。いきなり隣接行列を作るのは難しいので、隣接リストを作っておいて、それを隣接行列に変換することにします。たとえば、5 行 5 列盤の場合、下図のようにマスに番号を付けることにします。

この場合、0 から移動できる場所は 7 と 11 に、12 から移動できる場所は 1, 3, 5, 9, 15, 19, 21, 23 になります。

プログラムは次のようになります。

リスト : 隣接リストの生成

make_adjacent_sub(_, _, _, [], []).
make_adjacent_sub(X, Y, W, [Dx-Dy | Ds], [Z | Zs]) :-
    X1 is X + Dx,
    Y1 is Y + Dy,
    X1 >= 0, X1 < W, Y1 >= 0, Y1 < W,
    !,
    Z is Y1 * W + X1,
    make_adjacent_sub(X, Y, W, Ds, Zs).
make_adjacent_sub(X, Y, W, [_ | Ds], Zs) :-
    make_adjacent_sub(X, Y, W, Ds, Zs).

make_adjacent(N, W, []) :- N >= W * W.
make_adjacent(N, W, [Z | Zs]) :-
    X is N mod W,
    Y is N // W,
    Ds = [1-(-2), 2-(-1), 2-1, 1-2,
         (-1)-2, (-2)-1, (-2)-(-1), (-1)-(-2)],
    make_adjacent_sub(X, Y, W, Ds, Z),
    N1 is N + 1,
    make_adjacent(N1, W, Zs).

述語 make_adjacent の引数 N がマスの番号、W が盤面のサイズ、第 3 引数が隣接リストになります。N を座標 X, Y に変換し、騎士の移動方向を格納したリスト Ds といっしょに述語 make_adjacent_sub に渡します。make_adjacent_sub は騎士の移動位置 X1, Y1 を計算して、それが盤面の範囲内であれば、それをマスの番号 Z に変換して隣接リストに格納します。

簡単な実行例を示しましょう。

?- make_adjacent(0, 5, Xs), maplist(writeln, Xs).
[7,11]
[8,12,10]
[9,13,11,5]
[14,12,6]
[13,7]
[2,12,16]
[3,13,17,15]
[4,14,18,16,10,0]
[19,17,11,1]
[18,12,2]
[1,7,17,21]
[2,8,18,22,20,0]
[3,9,19,23,21,15,5,1]
[4,24,22,16,6,2]
[23,17,7,3]
[6,12,22]
[7,13,23,5]
[8,14,24,20,10,6]
[9,21,11,7]
[22,12,8]
[11,17]
[12,18,10]
[13,19,15,11]
[14,16,12]
[17,13]
Xs = [[7, 11], [8, 12, 10], [9, 13, 11, 5], [14, 12, 6], [13, 7], [2, 12, 16], [3, 13|...], 
[4|...], [...|...]|...] .

?-

次は隣接行列に変換する述語 make_matrix を作ります。

リスト : 隣接行列の生成

make_matrix_sub(N, W, _, []) :- N >= W * W.
make_matrix_sub(N, W, Xs, [_ | Zs]) :-
    member(N, Xs),
    !,
    N1 is N + 1,
    make_matrix_sub(N1, W, Xs, Zs).
make_matrix_sub(N, W, Xs, [0 | Zs]) :-
    N1 is N + 1,
    make_matrix_sub(N1, W, Xs, Zs).

make_matrix(_, [], []).
make_matrix(W, [X | Xs], [Y | Ys]) :-
    make_matrix_sub(0, W, X, Y),
    make_matrix(W, Xs, Ys).

make_matrix の引数 W が盤面のサイズ、第 2 引数が隣接リスト、第 3 引数が隣接行列になります。実際の処理は make_matrix_sub で 1 行ずつ作成していきます。引数 N が列の位置を表します。最初の規則で N が W * W 以上であれば処理を終了します。2 番目の規則で、N が隣接リスト Xs にあれば、行の要素を無名変数にします。そうでなければ、3 番目の規則で行の要素を 0 にします。

●解法プログラム

隣接行列ができると、あのプログラムは 経路の探索 (ハミルトン路) で作成したプログラムとほとんど同じです。解法プログラムは次のようになります。

リスト ; 騎士の巡歴

knight_tour(N) :-
    N mod 2 =\= 0,              % N が偶数だと解はない
    Size is N * N,
    make_adjacent(0, N, Adj),
    make_matrix(N, Adj, Xs),
    flatten(Xs, Ys),
    include(var, Ys, Vars),     % 変数を集める
    Vars ins 0..1,
    transpose(Xs, Zs),
    check1(1, 1, Size, Xs, Zs),
    %
    length(Node, Size),
    Node ins 1..Size,
    check2(Node, Xs, Node),
    element(1, Node, 1),
    element(Size, Node, Size),
    label(Vars),
    print_board(1, N, Node).

隣接行列を作成したあと、flatten と include で変数をリスト Vars に格納し、ins で変数の範囲を 0..1 に指定します。その他の制約は述語 check1 と check2 で設定します。あとは、element でスタートとゴールを設定し、label で Vars の値を探索するだけです。

あとのプログラムは簡単なので説明は割愛します。詳細は プログラムリスト1 をお読みください。

●実行結果

実行結果は次のようになりました。

?- time(knight_tour(5)).
1 10 17 12 23
16 5 22 9 18
21 2 11 24 13
6 15 4 19 8
3 20 7 14 25
% 338,942 inferences, 0.046 CPU in 0.046 seconds (100% CPU, 7387415 Lips)
true .

?- time(knight_tour(6)).
% 3 inferences, 0.000 CPU in 0.000 seconds (82% CPU, 215827 Lips)
false.

?- time(knight_tour(7)).
1 42 23 10 19 12 21
44 29 46 31 22 9 18
41 2 43 24 11 20 13
28 45 30 47 32 17 8
37 40 3 6 25 14 33
4 27 38 35 48 7 16
39 36 5 26 15 34 49
% 1,288,542 inferences, 0.155 CPU in 0.155 seconds (100% CPU, 8334500 Lips)
true .

?- time(knight_tour(9)).
1 22 3 60 39 62 35 64 37
24 55 26 57 28 59 38 45 34
21 2 23 4 61 40 63 36 65
54 25 56 27 58 29 44 33 46
75 20 11 14 5 8 41 66 43
72 53 74 7 10 13 30 47 32
19 76 71 12 15 6 9 42 67
52 73 78 17 50 69 80 31 48
77 18 51 70 79 16 49 68 81
% 4,199,128 inferences, 0.411 CPU in 0.411 seconds (100% CPU, 10215099 Lips)
true .

?- time(knight_tour(11)).
1 76 3 40 5 42 21 44 17 46 19
78 35 80 37 82 39 84 53 20 55 16
75 2 77 4 41 6 43 22 45 18 47
34 79 36 81 38 83 52 85 54 15 56
103 74 105 114 107 116 7 118 23 48 87
100 33 102 65 94 113 24 51 86 57 14
73 104 99 106 115 108 117 8 119 88 49
32 101 64 93 66 95 112 25 50 13 58
69 72 31 98 111 92 109 12 9 120 89
30 63 70 67 28 61 96 91 26 59 10
71 68 29 62 97 110 27 60 11 90 121
% 112,455,157 inferences, 9.790 CPU in 9.790 seconds (100% CPU, 11487140 Lips)
true .

?- time(knight_tour(13)).
1 82 3 114 5 116 7 118 59 120 55 122 57
84 109 86 111 88 113 90 39 92 41 58 43 54
81 2 83 4 115 6 117 8 119 60 121 56 123
108 85 110 87 112 89 38 91 40 93 42 53 44
157 80 159 26 161 28 163 30 9 32 61 124 95
154 107 156 23 144 25 146 37 62 13 94 45 52
79 158 153 160 27 162 29 164 31 10 33 96 125
106 155 22 143 24 145 36 147 12 63 14 51 46
71 78 135 152 19 140 149 16 165 34 11 126 97
134 105 70 21 142 151 18 35 148 15 64 47 50
75 72 77 136 139 20 141 150 17 166 49 98 127
104 133 74 69 102 131 138 67 100 129 168 65 48
73 76 103 132 137 68 101 130 167 66 99 128 169
% 1,418,847,733 inferences, 117.961 CPU in 117.963 seconds (100% CPU, 12028068 Lips)
true .

?-

N が 5, 7, 9 の場合、最初の解は 1 秒もかからずに求めることができました。N が大きくなると時間がかかるようになりますが、N = 13 では約 2 分で解を求めることができました。


●騎士の周遊

ところで、騎士の巡歴は「どのマスにもちょうど一回ずつ訪れたのち最初のマスに戻ってくること」を条件にする場合があります。これを「騎士の周遊」と呼びます。この場合、4 行 4 列盤や 5 行 5 列盤には解がありません。また、N 行 N 列の盤面で N が奇数の場合も、騎士は出発点に戻ることはできません。これも簡単に証明することができます。興味のある方は考えてみてください。

今回は「騎士の周遊」を解くプログラムを作りましょう。

●プログラムの作成

それではプログラムを作りましょう。基本的には 経路の探索 (ハミルトン閉路) と同じ考え方でいいのですが、スタート地点に戻るときの辺の制約を変更します。

ハミルトン閉路では、辺を選んだときに進行方向の頂点の番号が +1 になるか、またはスタート地点 (1) に戻る、という条件を設定しました。ところが、頂点の個数が多くなると、この条件では時間がとてもかかってしまうのです。スタート地点と次の地点、そして最後の地点は決定済みなので、最後の地点からスタート地点に戻る辺は、制約から除外することにします。

プログラムは次のようになります。

リスト : 辺の制約

check3(_, [], []).
check3(X, [Y | Ys], [N | Ns]) :-
    var(Y), !, Y #==> X + 1 #= N, check3(X, Ys, Ns).
check3(X, [_ | Ys], [_ | Ns]) :-
    check3(X, Ys, Ns).

check2(_, _, [], [], _).
check2(G, G, [_ | Ns], [_ | Xs], Node) :-
    !, I1 is G + 1, check2(I1, G, Ns, Xs, Node).
check2(I, G, [N | Ns], [X | Xs], Node) :-
    check3(N, X, Node),
    I1 is I + 1,
    check2(I1, G, Ns, Xs, Node).

述語 check2 の引数 I が頂点の番号、引数 G が経路の最後の頂点の番号を表します。2 番目の規則で、頂点 I が G と等しい場合は述語 check3 を呼び出しません。これでスタートに戻る辺を制約から除外することができます。述語 check3 では、辺 Y を選択したら、頂点 X から 頂点 N に進むので、その値は X + 1 #= N を満たすことを制約として設定します。OR (#\/) がない分だけ制約はシンプルになります。

解法プログラムは次のようになります。

リスト : 騎士の周遊

solver(N) :-
    N mod 2 =:= 0,              % 奇数に解はない
    make_adjacent(0, N, Adj),
    make_matrix(N, Adj, Xs),
    flatten(Xs, Ys),
    include(var, Ys, Vars),     % 変数を集める
    Vars ins 0..1,
    transpose(Xs, Zs),
    maplist(check1, Xs, Zs),
    %
    Size is N * N,
    N1 is N + 3,
    N2 is N * 2 + 2,
    length(Node, Size),
    Node ins 1..Size,
    check2(1, N2, Node, Xs, Node),
    element(1, Node, 1),
    element(N1, Node, 2),
    element(N2, Node, Size),
    label(Vars),
    print_board(1, N, Node).

左上隅のマスを出発点 (1) とすると、移動できるマスは 2 つ (N + 3, N * 2 + 3) しかありません。たとえば、N が 5 の場合は 8 と 12 になります。今回は周遊路を求めるのですから、1 から 8 へ進む辺と、12 から 1 に戻る辺は必ず選択しなければいけません。つまり、頂点 8 の番号は 2 になり、頂点 13 の番号は 25 になるわけです。これを element で設定すればいいわけです。

あとのプログラム簡単なので説明は割愛します。詳細は プログラムリスト2 をお読みくださいませ。

●実行結果

実行結果は次のようになりました。

?- time(solver(6)).
1 12 21 24 3 26
14 33 2 27 20 23
11 36 13 22 25 4
32 15 34 7 28 19
35 10 17 30 5 8
16 31 6 9 18 29
% 846,247 inferences, 0.109 CPU in 0.109 seconds (100% CPU, 7796285 Lips)
true .

?- time(solver(8)).
1 22 5 38 7 34 9 36
24 49 2 51 4 37 56 33
21 64 23 6 39 8 35 10
48 25 50 3 52 55 32 57
63 20 29 44 31 40 11 54
28 47 26 17 14 53 58 41
19 62 45 30 43 60 15 12
46 27 18 61 16 13 42 59
% 1,955,232 inferences, 0.203 CPU in 0.203 seconds (100% CPU, 9618735 Lips)
true .

?- time(solver(10)).
1 92 5 60 7 62 9 54 11 56
94 77 2 79 4 59 22 57 24 53
91 100 93 6 61 8 63 10 55 12
76 95 78 3 80 21 58 23 52 25
97 90 99 82 47 84 49 64 13 66
42 75 96 39 32 81 20 67 26 51
89 98 41 46 83 48 85 50 65 14
74 43 38 31 40 33 16 19 68 27
37 88 45 72 35 86 29 70 15 18
44 73 36 87 30 71 34 17 28 69
% 10,748,354 inferences, 0.892 CPU in 0.892 seconds (100% CPU, 12045449 Lips)
true .

?- time(solver(12)).
1 136 5 38 7 40 9 82 11 78 13 80
138 33 2 35 4 37 52 87 54 81 56 77
135 144 137 6 39 8 41 10 83 12 79 14
32 139 34 3 36 51 86 53 88 55 76 57
141 134 143 122 113 124 115 42 117 84 15 90
104 31 140 99 48 121 50 85 66 89 58 75
133 142 103 112 123 114 125 116 43 118 91 16
30 105 98 47 100 49 120 65 70 67 74 59
107 132 23 102 111 46 69 126 119 44 17 92
26 29 106 97 22 101 64 45 68 71 60 73
131 108 27 24 129 110 95 20 127 62 93 18
28 25 130 109 96 21 128 63 94 19 72 61
% 327,221,947 inferences, 25.426 CPU in 25.427 seconds (100% CPU, 12869592 Lips)
true .

?-

N が大きくなると時間がかかるようになりますが、それでも N = 12 で 30 秒かからずに解くことができました。


●プログラムリスト1

リスト : 騎士の巡歴 (knight1.pl)

:- use_module(library(clpfd)).

% 隣接リストの生成 (0 - W * W) 
make_adjacent_sub(_, _, _, [], []).
make_adjacent_sub(X, Y, W, [Dx-Dy | Ds], [Z | Zs]) :-
    X1 is X + Dx,
    Y1 is Y + Dy,
    X1 >= 0, X1 < W, Y1 >= 0, Y1 < W,
    !,
    Z is Y1 * W + X1,
    make_adjacent_sub(X, Y, W, Ds, Zs).
make_adjacent_sub(X, Y, W, [_ | Ds], Zs) :-
    make_adjacent_sub(X, Y, W, Ds, Zs).

make_adjacent(N, W, []) :- N >= W * W.
make_adjacent(N, W, [Z | Zs]) :-
    X is N mod W,
    Y is N // W,
    Ds = [1-(-2), 2-(-1), 2-1, 1-2,
         (-1)-2, (-2)-1, (-2)-(-1), (-1)-(-2)],
    make_adjacent_sub(X, Y, W, Ds, Z),
    N1 is N + 1,
    make_adjacent(N1, W, Zs).

% 隣接行列の生成
make_matrix_sub(N, W, _, []) :- N >= W * W.
make_matrix_sub(N, W, Xs, [_ | Zs]) :-
    member(N, Xs),
    !,
    N1 is N + 1,
    make_matrix_sub(N1, W, Xs, Zs).
make_matrix_sub(N, W, Xs, [0 | Zs]) :-
    N1 is N + 1,
    make_matrix_sub(N1, W, Xs, Zs).

make_matrix(_, [], []).
make_matrix(W, [X | Xs], [Y | Ys]) :-
    make_matrix_sub(0, W, X, Y),
    make_matrix(W, Xs, Ys).

% 制約
check1(_, _, _, [], []).
check1(S, S, G, [X | Xs], [Y | Ys]) :-
    sum(X, #=, 1),   % スタートは出る辺しかない
    sum(Y, #=, 0),
    N1 #= S + 1,
    check1(N1, S, G, Xs, Ys).
check1(G, S, G, [X | Xs], [Y | Ys]) :-
    sum(X, #=, 0),   % ゴールは入る辺しかない
    sum(Y, #=, 1),
    N1 #= G + 1,
    check1(N1, S, G, Xs, Ys).
check1(N, S, G, [X | Xs], [Y | Ys]) :-
    sum(X, #=, 1),   % 出る辺と入る辺の数が同じ (1)
    sum(Y, #=, 1),
    N1 #= N + 1,
    check1(N1, S, G, Xs, Ys).

check3(_, [], []).
check3(X, [Y | Ys], [N | Ns]) :-
    var(Y), !, Y #==> X + 1 #= N, check3(X, Ys, Ns).
check3(X, [_ | Ys], [_ | Ns]) :-
    check3(X, Ys, Ns).

check2([], [], _).
check2([N | Ns], [X | Xs], Node) :-
    check3(N, X, Node),
    check2(Ns, Xs, Node).

% 盤面の表示
print_board(_, _, []).
print_board(I, N, [X | Xs]) :-
    format('~d ', X),
    (I mod N =:= 0 -> nl; true),     
    I1 is I + 1,
    print_board(I1, N, Xs).

% N 行 N 列盤で、左上から右下までの経路を求める
knight_tour(N) :-
    N mod 2 =\= 0,              % N が偶数だと解はない
    Size is N * N,
    make_adjacent(0, N, Adj),
    make_matrix(N, Adj, Xs),
    flatten(Xs, Ys),
    include(var, Ys, Vars),     % 変数を集める
    Vars ins 0..1,
    transpose(Xs, Zs),
    check1(1, 1, Size, Xs, Zs),
    %
    length(Node, Size),
    Node ins 1..Size,
    check2(Node, Xs, Node),
    element(1, Node, 1),
    element(Size, Node, Size),
    label(Vars),
    print_board(1, N, Node).

●プログラムリスト2

リスト : 騎士の周遊 (knight2.pl)

:- use_module(library(clpfd)).

% 隣接リストの生成 (0 - W * W) 
make_adjacent_sub(_, _, _, [], []).
make_adjacent_sub(X, Y, W, [Dx-Dy | Ds], [Z | Zs]) :-
    X1 is X + Dx,
    Y1 is Y + Dy,
    X1 >= 0, X1 < W, Y1 >= 0, Y1 < W,
    !,
    Z is Y1 * W + X1,
    make_adjacent_sub(X, Y, W, Ds, Zs).
make_adjacent_sub(X, Y, W, [_ | Ds], Zs) :-
    make_adjacent_sub(X, Y, W, Ds, Zs).

make_adjacent(N, W, []) :- N >= W * W.
make_adjacent(N, W, [Z | Zs]) :-
    X is N mod W,
    Y is N // W,
    Ds = [1-(-2), 2-(-1), 2-1, 1-2,
         (-1)-2, (-2)-1, (-2)-(-1), (-1)-(-2)],
    make_adjacent_sub(X, Y, W, Ds, Z),
    N1 is N + 1,
    make_adjacent(N1, W, Zs).

% 隣接行列の生成
make_matrix_sub(N, W, _, []) :- N >= W * W.
make_matrix_sub(N, W, Xs, [_ | Zs]) :-
    member(N, Xs),
    !,
    N1 is N + 1,
    make_matrix_sub(N1, W, Xs, Zs).
make_matrix_sub(N, W, Xs, [0 | Zs]) :-
    N1 is N + 1,
    make_matrix_sub(N1, W, Xs, Zs).

make_matrix(_, [], []).
make_matrix(W, [X | Xs], [Y | Ys]) :-
    make_matrix_sub(0, W, X, Y),
    make_matrix(W, Xs, Ys).

% 制約
check1(Xs, Ys) :- sum(Xs, #=, 1), sum(Ys, #=, 1).

check3(_, [], []).
check3(X, [Y | Ys], [N | Ns]) :-
    var(Y), !, Y #==> X + 1 #= N, check3(X, Ys, Ns).
check3(X, [_ | Ys], [_ | Ns]) :-
    check3(X, Ys, Ns).

check2(_, _, [], [], _).
check2(G, G, [_ | Ns], [_ | Xs], Node) :-
    !, I1 is G + 1, check2(I1, G, Ns, Xs, Node).
check2(I, G, [N | Ns], [X | Xs], Node) :-
    check3(N, X, Node),
    I1 is I + 1,
    check2(I1, G, Ns, Xs, Node).
	
% 盤面の表示
print_board(_, _, []).
print_board(I, N, [X | Xs]) :-
    format('~d ', X),
    (I mod N =:= 0 -> nl; true),     
    I1 is I + 1,
    print_board(I1, N, Xs).

% 騎士の周遊
solver(N) :-
    N mod 2 =:= 0,              % 奇数に解はない
    make_adjacent(0, N, Adj),
    make_matrix(N, Adj, Xs),
    flatten(Xs, Ys),
    include(var, Ys, Vars),     % 変数を集める
    Vars ins 0..1,
    transpose(Xs, Zs),
    maplist(check1, Xs, Zs),
    %
    Size is N * N,
    N1 is N + 3,
    N2 is N * 2 + 2,
    length(Node, Size),
    Node ins 1..Size,
    check2(1, N2, Node, Xs, Node),
    element(1, Node, 1),
    element(N1, Node, 2),
    element(N2, Node, Size),
    label(Vars),
    print_board(1, N, Node).

●敷き詰め問題

今回は正方形や長方形を敷き詰める問題を解いてみましょう。SWI-Prolog のライブラリ clpfd には、このような問題を解くのにぴったりの述語 disjoint2/1 が用意されています。

disjoint2(Xs).
Xs は rect(x 座標, x 方向の長さ, y 座標, y 方向の長さ) を格納したリスト

disjoint2 は引数のリストに格納された長方形が重ならないような配置を求める述語です。長方形は任意の複合項で表します。名前は rect でなくてもかまいません。第 1 要素と第 3 要素で座標 (長方形の左上隅) を表し、第 2 要素と第 4 要素で長方形の大きさを表します。

簡単な例を示しましょう。下図に示す正方形と長方形を 6 * 4 の長方形に敷き詰めます。

プログラムは簡単です。次のリストを見てください。

リスト : 長方形の敷き詰め

:- use_module(library(clpfd)).

make_rect(_,_,[],[],[]).
make_rect(W, H, [X1-Y1 | Xs], [X, Y | Ps], [rect(X, X1, Y, Y1) | Rs]) :-
    A is W - X1,
    X in 0..A,
    B is H - Y1,
    Y in 0..B,
    make_rect(W, H, Xs, Ps, Rs).

solver :-
    %                 A    B    C    D    E
    make_rect(6, 4, [2-2, 3-3, 1-4, 5-1, 2-1], Ps, Rs),
    disjoint2(Rs),
    label(Ps),
    writeln(Rs).

述語 make_rect で長方形を格納したリストと、座標を表す変数を格納したリストを作ります。引数 W, H が大きな長方形のサイズ、第 3 引数のリストが図形の大きさ、第 4 引数のリストの要素 X, Y が図形の位置を表します。図形の大きさが X1-Y1 の場合、その図形を置くことができる範囲は x 方向で 0 から W - X1, y 方向で 0 から H - Y1 の範囲になります。この範囲を in で指定します。あとは 述語 solver で make_rect を呼び出して、disjoint2 に rect を格納したリスト Rs を渡して、label で座標を求めるだけです。

実行結果は次のようになりました。

?- solver.
[rect(0,2,0,2),rect(2,3,0,3),rect(5,1,0,4),rect(0,5,3,1),rect(0,2,2,1)]
true ;
[rect(0,2,1,2),rect(2,3,0,3),rect(5,1,0,4),rect(0,5,3,1),rect(0,2,0,1)]
true ;
[rect(0,2,1,2),rect(2,3,1,3),rect(5,1,0,4),rect(0,5,0,1),rect(0,2,3,1)]
true .

?-

最初の解を図に示すと次のようになります。

●正方形の敷き詰め

次は 32 * 33 の長方形に大きさの異なる 9 枚の正方形を敷き詰めてみましょう。正方形の種類を示します。

1, 4, 7, 8, 9, 10, 14, 15, 18

プログラムは次のようになります。

リスト : 正方形の敷き詰め

make_square(_,_,[],[],[]).
make_square(W, H, [N | Ns], [X, Y | Ps], [square(X, N, Y, N) | Rs]) :-
    A is W - N,
    X in 0..A,
    B is H - N,
    Y in 0..B,
    make_square(W, H, Ns, Ps, Rs).

solver1 :-
    Ns = [18, 15, 14, 10, 9, 8, 7, 4, 1],
    make_square(33, 32, Ns, Ps, Rs),
    disjoint2(Rs),
    label(Ps),
    maplist(writeln, Rs).

プログラムは簡単だと思いますが、リスト Ns の正方形の並べ方に注意してください。たとえば、リスト Ns を昇順に並べると大きさ 1 の正方形の位置から決めることになりますが、そうすると実行時間がとてもかかるのです。この場合、大きな正方形から位置を決めたほうが速くなります。

実行結果は次のようになりました。

?- time(solver1).
square(0,18,0,18)
square(18,15,0,15)
square(0,14,18,14)
square(14,10,22,10)
square(24,9,23,9)
square(25,8,15,8)
square(18,7,15,7)
square(14,4,18,4)
square(24,1,22,1)
% 13,258,195 inferences, 1.078 CPU in 1.078 seconds (100% CPU, 12296177 Lips)
true .

?-

約 1 秒で解を求めることができました。

●重なりのチェック

ところで、長方形や正方形が重ならないようにする制約は、disjoint2 を使わなくても簡単に定義することができます。次のリストを見てください。

リスト : 重なりのチェック

check_sub(square(X, W, Y, H), square(X1, W1, Y1, H1)) :-
    X + W #=< X1 #\/ X1 + W1 #=< X #\/ Y + H #=< Y1 #\/ Y1 + H1 #=< Y.

check([]).
check([R | Rs]) :- maplist(check_sub(R), Rs), check(Rs).

述語 check の引数は square を格納したリストです。リストを先頭要素 R と Rs に分割し、maplist で R と Rs の要素が重ならないように制約を設定します。X + W が X1 以下ならば、(X, Y) は (X1, Y1) の左側にあって重なることはありません。Y + H が Y1 以下ならば、(X, Y) は (X1, Y1) の下側にあって重なることはありません。同様に、X1 + W1 #=< X または Y1 + H1 #=< Y であれば重なることはありません。あとは、check を再帰呼び出しすれば、すべての要素が重ならないという制約を設定することができます。

実際に試してみたところ、正方形の敷き詰めは 0.27 秒で解くことができました。

●正方形の敷き詰め (2)

次は 65 * 47 の長方形に大きさの異なる 10 個の正方形 (25, 24, 23, 22, 19, 17, 11, 6, 5, 3) を敷き詰めてみましょう。プログラムは次のようになります。

リスト : 正方形の敷き詰め (2)

solver2 :-
    Ns = [25, 24, 23, 22, 19, 17, 11, 6, 5, 3],
    make_square(47, 65, Ns, Ps, Rs),
    check(Rs),
    label(Ps),
    maplist(writeln, Rs).

正方形の位置は X 座標から決定していくので、X の範囲を狭くしたほうが速くなります。長方形は 47 * 65 として make_square に渡します。実行結果は次のようになりました。

?- time(solver2).
square(0,25,0,25)
square(23,24,41,24)
square(0,23,42,23)
square(25,22,0,22)
square(28,19,22,19)
square(0,17,25,17)
square(17,11,25,11)
square(17,6,36,6)
square(23,5,36,5)
square(25,3,22,3)
% 255,948,272 inferences, 19.597 CPU in 19.600 seconds (100% CPU, 13060389 Lips)
true .

?-

約 20 秒で解くことができました。けっこう時間がかかりますね。ちなみに、make_square の第 1 引数に 65 を渡すと、実行時間は約 2 倍の 40 秒になります。また,正方形の並べ方を [25, 22, 23, 24, ...] とすると、実行時間は 2.4 秒になりました。今回のプログラムでは、正方形の並べ方によって実行速度に大きな差がでるようです。

最後に、112 * 112 の正方形に大きさの異なる 21 個の正方形を敷き詰める問題 (ルジンの問題) に挑戦してみたのですが、このプログラムでは時間がかかりすぎて途中であきらめました。参考 URL 2 の答えを見て、正方形の並べ方を答えと同じようにすると解けるのですが、それではダメですね。興味のある方は挑戦してみてください。

●参考 URL

  1. 方積問題と箱詰め問題, (Ikuro さん)
  2. ルジンの問題 - Wikipedia

初版 2016 年 6 月 25 日
改訂 2023 年 5 月 14 日

Copyright (C) 2016-2023 Makoto Hiroi
All rights reserved.

[ Home | Prolog | C L P ]