源氏香の全解、または、集合を分割するプログラム
2015_01_12
@suharahiromichi
この文章のこの文章のソースコードは以下にあります。
https://github.com/suharahiromichi/prolog/blob/master/genji.swi
はじめに
有限の集合を分割（グループ化）できる総数をベル数という。サイズ3の集合なら、以下の5種類の分割があるので、3のベル数 B3 = 5 となる。
{a}, {b}, {c}
{a}, {b, c}
{b}, {a, c}
{c}, {a, b}
{a ,b, c}
香道における源氏香は、香りを5回嗅（聞）いて、そのグループ分けを当てるゲームなので、その答えは B5 = 52 から選ばれることになる。
52の個々に文様と、源氏物語全54帖からとった名前が付与されているのだそうだ。（一方、ベルの音を聞き分けるゲームがあるわけではないらしい。）
さて、ベル数を計算する方法はいくらでも見つかるが、実際に分割の方法を求める方法は見つけられなかったので、自分で考えてみた。
これは、計算アルゴリズムの問題というよりも、分割された集合をどのように表現するかのデータ構造の問題だから、PrologやCoqのような、データ構造を表現＋制約（証明）で与えられる言語で解くのがよさそう。。。と思ったが、今回の内容なら、どの言語でも大差ないだろう。
解き方
分割前の集合のサイズをl、1≦lとする。その要素を1からlまでの番号で呼ぶ。要素nが、x番めのグループに属することを、
Gn = x
と書く。グループは1からの番号を「欠番なく」付与する。これをグループ番号と呼ぶ。すべての要素が同じグループなら、グループ番号は1のみ。すべての要素が異なるなら、グループ番号はlまであることになる。
最初にしめしたサイズ3の集合の例では、a:1番め,b:2番め,c:3番めの各要素のグループ番号G1,G2,G2が、
1,2,3 なら、a,b,cがすべて異なるグループ
1,2,2 なら、bとcだけが同じグループ
1,2,1 なら、aとcだけが同じグループ
1,1,2 なら、aとbだけが同じグループ
1,1,1 なら、a,b,cがすべて同じグループ
であることを示す。
要素1は、かならず1番めのグループ、グループ番号1とする。
G1 = 1
グループ番号に欠番を生じないためには、n番めの要素 (2≦n) のグループ番号には以下の制約があることになる。
1 ≦ Gn ≦ max(i = 1, n-1)Gi + 1
ここで、max(i = 1, n-1)Gi は、G1からGn-1までの最大の数、つまり、要素1からn-1が属する最大のグループ番号を意味する。
つまり、n番めの要素は、既存のグループに含まれるか、さもなければ、新しいグループ(+1番のグループ番号)になるか、どちらかということになる。
プログラム
Prologで実装するとして、与えられた分割が、前節で示した制約を満たしているかをチェックする処理を作成する。gchk。N番めの要素がどのグループに属するかをリストLで表す。
制約チェック
要素ひとつの制約のチェック
N番めの要素が、制約を満たすかをチェックする。gchk1。
Lが与えられたとき、まず、1番めの要素の場合は、グループ番号は1とする（最初の節）。LのN番め, 1≦nが、Gnの値である。nth1。
要素1からn-1までの最大のグループ番号 max(i = 1, n-1)Gi は、Lの1番めからN-1番めの要素のグループ番号を取り出してその最大数をもとめることで得られる。gmax。最終的に、nth1と、gmaxの結果に+1したもの、を比較する。
gchk1(1, [1|_]) :- !. % G1 = 1
gchk1(N, L) :- % 1から数えてN番め。
nth1(N, L, X), % そのグループ番号
gmax(N, L, Max), % N-1の最大のグループ番号、N>1。
Max1 is Max + 1, % +1したものとを、
% writeln([X, Max1]),
X =< Max1. % ここがチェック。
gmax(N, L, Max) :-
N1 is N - 1,
head(N1, L, R),
max_list(R, Max).
すべての要素の対する制約のチェック
gchk1 を すべての要素に対して実行し、すべての要素に対して終了したら、成功終了とする。
gchk(L) :-
gchk(1, L).
gchk(N, L) :-
length(L, Len),
N > Len. % 成功終了
gchk(N, L) :-
gchk1(N, L), % N番めの要素をチェックする。
N1 is N + 1,
gchk(N1, L).
ハウスキーピング
%% リストの先頭からN要素、N ≧ 1。
head(0, L, []).
head(N, [X|L], [X|R]) :-
N1 is N - 1,
head(N1, L, R).
%% リストのN番めの要素、 N ≧ 1。
nth1(N, L, X) :-
N1 is N - 1,
nth0(N1, L, X).
テストプログラム
制約チェックが正しいかを確認するために、B5 (源氏香）の全解をもとめてみる。
長さNの自然数の組み合わせのリスト、N=5なら、[1,1,1,1,1]から[5,5,5,5,5]をもとめて、制約を満たしていたら印刷出力する。その数を数える。
[1,1,1,1,1]から[1,2,3,4,5]まででよいのだけれど、手抜きと念入とで。
長さNの自然数の組み合わせのリスト
未定変数リスト[X,Y,Z,U,V]に対して、値をユニファイして返す。
gen(L) :-
length(L, Len), !,
maplist(gen1(Len, 0), L).
gen1(N, M, N2) :-
N > M,
N1 is M + 1,
(N2 = N1;
gen1(N, N1, N2)).
解の数を数える
:- dynamic(count/1).
count(0).
countup(C1) :-
count(C),
C1 is C + 1,
retract(count(_)),
assert(count(C1)).
全体のドライバ
go :-
L = [X,Y,Z,U,V], gen(L),
gchk(L),
countup(C),
(use_opt -> % おまけを参照のこと。
thema(L, T), writeln([L, T]);
writeln([C, L])),
fail.
おまけ
源氏香の文様との対応はない。文様の対称性とも無関係だ。源氏物語の順番とも対応しない。
use_opt :- true.
thema(L, T) :-
thm(L, T), !.
thema(_, none). % 不正なテーマ
thm([1,2,3,4,5], 帚木).
thm([1,2,3,4,4], 空蝉).
thm([1,2,3,3,4], 夕顔).
thm([1,2,2,3,3], 若紫).
thm([1,1,1,1,2], 末摘花).
thm([1,2,2,3,2], 紅葉賀).
thm([1,2,3,4,3], 花宴).
thm([1,1,2,3,4], 葵).
thm([1,1,1,2,2], 賢木).
thm([1,2,3,2,3], 花散里).
thm([1,2,1,1,2], 須磨).
thm([1,2,2,3,4], 明石).
thm([1,2,3,2,2], 澪標).
thm([1,1,1,2,3], 逢生).
thm([1,2,2,2,3], 関屋).
thm([1,2,1,3,2], 絵合).
thm([1,1,2,2,3], 松風).
thm([1,2,2,2,2], 薄雲).
thm([1,2,1,1,3], 朝顔).
thm([1,2,1,3,4], 少女).
thm([1,1,2,2,2], 玉鬢).
thm([1,2,1,2,3], 初音).
thm([1,2,2,1,2], 胡蝶).
thm([1,1,2,1,3], 蛍).
thm([1,2,3,3,3], 常夏).
thm([1,2,3,2,4], 篝火).
thm([1,1,2,3,3], 野分).
thm([1,2,1,2,2], 御幸).
thm([1,2,3,1,4], 藤袴).
thm([1,2,3,2,1], 真木柱).
thm([1,1,1,2,1], 梅枝).
thm([1,2,3,3,2], 藤裏葉).
thm([1,1,2,2,1], 若菜上).
thm([1,2,1,3,3], 若菜下).
thm([1,2,1,3,1], 柏木).
thm([1,2,3,1,1], 横笛).
thm([1,2,3,3,1], 鈴虫).
thm([1,2,3,1,3], 夕霧).
thm([1,2,3,1,2], 御法).
thm([1,2,3,4,1], 幻).
thm([1,1,2,1,2], 匂宮).
thm([1,2,3,4,2], 紅梅).
thm([1,2,2,2,1], 竹河).
thm([1,2,1,1,1], 橋姫).
thm([1,2,2,1,3], 椎本).
thm([1,2,2,1,1], 総角).
thm([1,1,2,3,2], 早蕨).
thm([1,1,2,1,1], 宿木).
thm([1,1,2,3,1], 東屋).
thm([1,2,2,3,1], 浮舟).
thm([1,2,1,2,1], 蜉蝣).
thm([1,1,1,1,1], 手習).