%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%                            pentomino.pl
%%
%% このプログラムは日本Prolog協会会員の秋田昌幸さまのご好意で転載させていただきました。
%% Prologらしさを生かしたオリジナルの逐次処理に加え、並列処理による高速化の好例でもあります。
%% 
%% プログラムの読み込み
%% >prolog -s pentomino.pl          コマンドプロンプトからソースファイルを指定して立ち上げる
%%    または
%% >prolog
%%  | ?- consult('pentomino.pl').   インタプリタにソースコードを読み込ませる
%%    または
%% >prolog
%%  | ?- compile('pentomino.pl').   インタプリタにソースコードをバイトコードコンパイルして読み込ませる
%%    または
%% >pentomino                       フルコンパイルされたプログラムを立ち上げる
%%
%% プログラムの起動
%% | ?- menu.                 一覧メニューから項目を選んで実行
%%
%% この二つはほとんどの処理系で動くでしょう（確認済：K-Prolog,SWI-Prolog)
%% | ?- s_test_count.         オリジナル（逐次処理）で全解の個数と実行時間のみを計測する
%% | ?- s_test_show.          前記に加え、結果を画面に表示する
%%
%% 以下はAZ-Prologのみです。
%% | ?- p_test_count(inte).   並列処理で全解の個数と実行時間のみを計測する(インタプリタモード）
%% | ?- p_test_count(byte).   並列処理で全解の個数と実行時間のみを計測する(バイトコードモード）
%% | ?- p_test_count(full).   並列処理で全解の個数と実行時間のみを計測する(フルコンパイルモード）
%%
%% | ?- p_test_show(inte).    前記に加え、結果を画面に表示する(インタプリタモード）
%% | ?- p_test_show(byte).    前記に加え、結果を画面に表示する(バイトコードモード）
%% | ?- p_test_show(full).    前記に加え、結果を画面に表示する(フルコンパイルモード）
%%
%% | ?- test_all.             ベンチマークのため、全てのモードの時間計測をおこなう

/*
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%オリジナルソース%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
　　ペントミノ(パズルその2)
　　Written by  秋田 昌幸 (masa520511@gmail.com)
*/
:- kanji_mode(_,off).

explanation('
--------------------------------------------------------------------------------
この問題は、日本Prolog協会のプログラミングコンテストで出題された問題です。
隣り合った5つの正方形からなる次の12個の駒があります。
駒を区別するため、それぞれ f、i、l、n、p、t、u、v、w、x、y、z と名付けましょう。

   f     i  l      n     p     t
　■■　■　■　　■　　■■　■■■
■■　　■　■　　■　　■■　　■
　■　　■　■　　■■　■　　　■
　　　　■　■■　　■　
　　　　■

   u     v        w       x       y     z
■　■　■　　　■　　　　■　　　■　■■
■■■　■　　　■■　　■■■　■■　　■
　　　　■■■　　■■　　■　　　■　　■■
　　　　　　　　　　　　　　　　　■

これを、次のような盤面上に隙間なく置くというのが問題です。駒は、回転したり、裏返したりして構いません。
プログラミングコンテストの問題は、解がいくつあるかを求めろというものでした。

Type=a
□□□□□□□□□□□□□□□□□□□□
□□□□□□□□□□□□□□□□□□□□
□□□□□□□□□□□□□□□□□□□□

Type=b
□□□□□□□□
□□□□□□□□
□□□□□□□□
□□□　　□□□
□□□　　□□□
□□□□□□□□
□□□□□□□□
□□□□□□□□

最初の3×20の盤面では、2つの答えがあります。 2つ目の8×8で、真ん中に穴の開いた盤面では65の解があります。
それぞれの盤面での答えを1つずつ示しておきます。

■■□■■■□■■■■★■□■■■□□□
■□□□■■□□□■★★■□□□■■★□
■■□★★★★★□★★■■■□★★★★□

□□□□□■■□
■■★■■■□□
■□★★★□□■
■□★　　■■■
■□□　　■□□
★□■■★□□■
★★■★★★□■
★★■■★■■■
').

/*
さて、このコンテストには全部で4つの解答が寄せられました。いかに速く解くかが、観点だったのですが、
私のプログラムは4作中3位というあまりいばれた成績ではありません。ただ、リスト処理を使ったProlog
らしいプログラムということで、技術賞という御褒美を頂きました。まあ、他のプログラムよりも確かに
見やすくはできていますので、ここで紹介しましょう。
これをさらに高速化するためには、リストのマッチングを述語単位のマッチングにすることが効果的です。
なお、このプログラムは、IF/Prologでしか試していません。

*/

doit :- solve_pentomino(a,_),fail.
doit :- solve_pentomino(b,_),fail.
doit.

/*
  盤面、駒のリストの構造は、かなり複雑ですが、問題の定義を容易にするため、
  動的に構造を作り出しています。
  この内、かなりの部分は、前もって計算してプログラムとしておくことも可能です。
  ただし、実際の問題を解く時間に比べると、構造の生成は大した時間は取りません。
*/

solve_pentomino(Type,Board) :-
  prepareBoard(Type,Board,Pieces),
  slim(Board,Board0),
  place(Pieces,Board0).

/*
  盤面と、駒のリストを用意します
*/

prepareBoard(Type,Board,Pieces) :-
  /* 盤面の対象性を調べます */
  reduceSym(Type,Os),
  /* 盤面の対象性を考慮した駒のリストを生成します */
  makePieces(Os,Pieces),
  /* 盤面の周りに幅2の外部を付けます */
  originalBoard(Type,Board0),
  addOutside(Board0,Board),
  /* 盤面の構造を生成します */
  makeStruct(Board),!.

slim([_,_|Board],Board0) :-
  slim0(Board,Board0).

slim0([],[]).
slim0([[_|L]|Ls],[L|Bs]) :-
  slim0(Ls,Bs).

/*
  盤面の対象性の計算です。
  考えられる8つの置き換えのうち、ユニークになるものを調べます。
*/

reduceSym(Type,Os) :-
  reduceSym0(Type,[[],[r],[r,r],[r,r,r],
                   [m],[m,r],[m,r,r],[m,r,r,r]],[],Os).

/*
  各置き換えで、ユニークな置き換えだけを集めます
*/

reduceSym0(_,[],_,[]).
reduceSym0(Type,[O|Os0],Boards,Os1) :-
  originalBoard(Type,Board),
  position(O,Board,Board0),
  member(Board0,Boards),!,
  reduceSym0(Type,Os0,Boards,Os1).
reduceSym0(Type,[O|Os0],Boards,[O|Os1]) :-
  originalBoard(Type,Board),
  position(O,Board,Board0),
  reduceSym0(Type,Os0,[Board0|Boards],Os1).

/*
  各駒について、ユニークな駒の配置のリストを求めます。
  ここで、fの駒だけを特別扱いしています。
  fの駒の配置を盤面の対象性と一致させることで、対象解を排除しています。
  特別扱いする駒は、fでなくても、対象性の無い駒ならば何でも構いません。
*/

makePieces(Os,[[f,Fs]|Others]) :-
  makePiecesF(Os,Fs),
  makePiecesOthers([i,l,n,p,t,u,v,w,x,y,z],Others).

/*
  fに関する配置の収集です。
  元の、駒の定義を持ってきて、それぞれの置き換えを行い、
  配置を行う構造のリストを生成しています。
*/

makePiecesF([],[]).
makePiecesF([O|Os],[R|Fs]) :-
  originalPiece(f,F0),
  position(O,F0,F),
  makeRelPos(F,F,R),
  makePiecesF(Os,Fs).

/*
  f以外の駒の配置を計算します。
*/

makePiecesOthers([],[]).
makePiecesOthers([T|Ts],[[T,P]|Ps]) :-
  originalPiece(T,O),
  makePiecesOthers0([[],[r],[r,r],[r,r,r],[m],[m,r],[m,r,r],[m,r,r,r]],O,[],[],P),
  makePiecesOthers(Ts,Ps).

/*
  与えられた駒の各置き換えについて、ユニークな置き換えだけを集めます。
*/

makePiecesOthers0([],_,_,P,P).
makePiecesOthers0([X|Xs],O,PP,P0,P) :-
  position(X,O,P1),
  member(P2,PP),
  same(P2,P1),!,
  makePiecesOthers0(Xs,O,PP,P0,P).
makePiecesOthers0([X|Xs],O,PP,P0,P) :-
  position(X,O,P1),
  makeRelPos(P1,P1,R),
  makePiecesOthers0(Xs,O,[P1|PP],[R|P0],P).

/*
  ここでは、各駒の配置において、最上段の一番左にあるマスで、
  分類を行っています。
  これと、対応する分類をplace0/3でも行っています。
  なお、各駒を回転しても、この7つの位置以外に最上段の左側はありません。
  分かりずらいので、例で説明しましょう。
  たとえば、iの駒は、

    [[_,_,i,_,_],    [[_,_,_,_,_],
     [_,_,i,_,_],     [_,_,_,_,_],
     [_,_,i,_,_],     [i,i,i,i,i],
     [_,_,i,_,_],     [_,_,_,_,_],
     [_,_,i,_,_]]     [_,_,_,_,_]]

  のいずれかの配置を取ります。
  これはそれぞれ、下の述語の1番目と5番目に対応します。
*/

makeRelPos(P,[[_,_,X|_]|_],R) :-
  nonvar(X),!,
  R = [[_,P]|_].
makeRelPos(P,[_,[_,X|_]|_],R) :-
  nonvar(X),!,
  R = [_,[_,P]|_].
makeRelPos(P,[_,[_,_,X|_]|_],R) :-
  nonvar(X),!,
  R = [_,_,[_,P]|_].
makeRelPos(P,[_,[_,_,_,X|_]|_],R) :-
  nonvar(X),!,
  R = [_,_,_,[_,P]|_].
makeRelPos(P,[_,_,[X|_]|_],R) :-
  nonvar(X),!,
  R = [_,_,_,_,[_,P]|_].
makeRelPos(P,[_,_,[_,X|_]|_],R) :-
  nonvar(X),!,
  R = [_,_,_,_,_,[_,P]|_].
makeRelPos(P,[_,_,[_,_,X|_]|_],R) :-
  nonvar(X),!,
  R = [_,_,_,_,_,_,[_,P]].

/*
  place/2は、3行ずつplace0/3に渡します。
*/

place([],_) :- !.
place(Ks,[L0,L1,L2|Board]) :-
  place0(Ks,Ks0,[L0,L1,L2]),
  place(Ks0,[L1,L2|Board]).

/*
  1行目の真ん中が、まだ決定していない時には、
  7個のマスを渡しています。
  このマスは、makeRelPos/3で作成した構造と対応します。
  実際の配置は、place1/3で行います。
  その後、残りのマスについても調べます。
*/

place0(Ks,Ks,[[_,_,_]|_]) :- !.
place0(Ks,Ks0,[[_,P01,P02|L0],[_|L1],[_|L2]]) :-
  P01 = [V,_],
  nonvar(V),!,
  place0(Ks,Ks0,[[P01,P02|L0],L1,L2]).

place0(Ks,Ks1,[[_,  P02,P03,P04|L0],
               [P11,P12,P13,P14|L1],
               [_,  P22,P23,P24|L2]]) :-
  place1(Ks,Ks0,[P22,P13,P12,P11,P04,P03,P02]),
  P02 = [V,_],
  nonvar(V),
  place0(Ks0,Ks1,[[P02,P03,P04|L0],
                  [P12,P13,P14|L1],
                  [P22,P23,P24|L2]]).

/*
  実際の配置を行います。
  駒を1種類選択し、この場所におけるかどうかチェックします。
*/

place1(Ks,Ks0,P) :- 
  pickup(Ks,Ks0,[_,K]),
  member(P,K).

/*
  リストから、1つ取り出し、残りを返します。
*/

pickup([X|Xs],Xs,X).
pickup([X|Xs],[X|Ys],Z) :-
  pickup(Xs,Ys,Z).

/*
  外側の付加。
  各マスは、[値, 近傍] の形式を持っています。
  近傍は、自分自身を中心とした 5 x 5 のマスの値の配列です。
  後で、makeStructで、構造を作りますので、
  ここでは、外部に関しては [o,_]、内部に関しては、 _ を入れておきます。
*/

addOutside([X|Xs],[O0,O1|Y]) :-
  outside(X,O0),
  outside(X,O1),
  addOutside0([X|Xs],X,Y).

addOutside0([],X,[O0,O1]) :-
  outside(X,O0),
  outside(X,O1).
addOutside0([X|Xs],L,[[[o,_],[o,_]|Y]|Ys]) :-
  addOutside1(X,Y),
  addOutside0(Xs,L,Ys).

addOutside1([],[[o,_],[o,_]]).
addOutside1([i|Xs],[_|Ys]) :-
  addOutside1(Xs,Ys).
addOutside1([o|Xs],[[o,_]|Ys]) :-
  addOutside1(Xs,Ys).

outside(X,[[o,_],[o,_]|Y]) :-
  outside0(X,Y).

outside0([],[[o,_],[o,_]]).
outside0([_|Xs],[[o,_]|Ys]) :-
  outside0(Xs,Ys).

/*
  近傍の構造を作ります。
*/

makeStruct([_,_,_,_]).
makeStruct([L0,L1,L2,L3,L4|R]) :-
  makeStruct0([L0,L1,L2,L3,L4]),
  makeStruct([L1,L2,L3,L4|R]).

makeStruct0([[_,_,_,_]|_]).
makeStruct0([[P00,P01,P02,P03,P04|L0],
             [P10,P11,P12,P13,P14|L1],
             [P20,P21,P22,P23,P24|L2],
             [P30,P31,P32,P33,P34|L3],
             [P40,P41,P42,P43,P44|L4]]) :-
  [[P00,P01,P02,P03,P04],
   [P10,P11,P12,P13,P14],
   [P20,P21,P22,P23,P24],
   [P30,P31,P32,P33,P34],
   [P40,P41,P42,P43,P44]]
  =
  [[[V00,_],[V01,_],[V02,_],[V03,_],[V04,_]],
   [[V10,_],[V11,_],[V12,_],[V13,_],[V14,_]],
   [[V20,_],[V21,_],[V22,Vs],[V23,_],[V24,_]],
   [[V30,_],[V31,_],[V32,_],[V33,_],[V34,_]],
   [[V40,_],[V41,_],[V42,_],[V43,_],[V44,_]]],
  Vs = [[V00,V01,V02,V03,V04],
        [V10,V11,V12,V13,V14],
        [V20,V21,V22,V23,V24],
        [V30,V31,V32,V33,V34],
        [V40,V41,V42,V43,V44]],
  makeStruct0([[P01,P02,P03,P04|L0],
              [P11,P12,P13,P14|L1],
              [P21,P22,P23,P24|L2],
              [P31,P32,P33,P34|L3],
              [P41,P42,P43,P44|L4]]).

/*
  盤面の定義です。
  駒を措ける所は i、置けない所は o を指定します。
*/

originalBoard(a,[[i,i,i],
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i],   
                 [i,i,i]]).
originalBoard(b,[[i,i,i,i,i,i,i,i],
                 [i,i,i,i,i,i,i,i],
                 [i,i,i,i,i,i,i,i],
                 [i,i,i,o,o,i,i,i],
                 [i,i,i,o,o,i,i,i],
                 [i,i,i,i,i,i,i,i],
                 [i,i,i,i,i,i,i,i],
                 [i,i,i,i,i,i,i,i]]).

/*
  考えられる置き換えです。
  最初の引数は、置き換えの操作を表します。
*/

position([],P,P).
position([r],P,P0) :-
  rotate(P,P0).
position([r,r],P,P1) :-
  rotate(P,P0),
  rotate(P0,P1).
position([r,r,r],P,P2) :-
  rotate(P,P0),
  rotate(P0,P1),
  rotate(P1,P2).
position([m],P,P0) :-
  mirror(P,P0).
position([m,r],P,P1) :-
  mirror(P,P0),
  rotate(P0,P1).
position([m,r,r],P,P2) :-
  mirror(P,P0),
  rotate(P0,P1),
  rotate(P1,P2).
position([m,r,r,r],P,P3) :-
  mirror(P,P0),
  rotate(P0,P1),
  rotate(P1,P2),
  rotate(P2,P3).

/*
  2次元配列の同一性を調べます。
*/

same(P0,P1) :-
  fix(P0,F0),
  fix(P1,F1),!,
  F0 = F1.

fix([],[]).
fix([P|Ps],[F|Fs]) :-
  fix0(P,F),
  fix(Ps,Fs).

fix0([],[]).
fix0([V|Ps],[x|Fs]) :-
  var(V),!,
  fix0(Ps,Fs).
fix0([P|Ps],[P|Fs]) :-
  fix0(Ps,Fs).

/*
  鏡面対称です。
*/

mirror(X,Y) :-
  myreverse(X,Y).

/*
  回転です。
*/

rotate([[]|_],[]).
rotate(O,[R|Rs]) :-
  firstColumn(O,[],R,Os),
  rotate(Os,Rs),!.

firstColumn([],R,R,[]).
firstColumn([[F|Rest]|Rows],Fs,R,[Rest|Rs]) :-
  firstColumn(Rows,[F|Fs],R,Rs).

/*
  駒の定義です。
  5 x 5の中に配置しています。
  ここで、中心には駒の対象性の中心(あれば)を置くようにします。
*/

originalPiece(f,[[_,_,_,_,_],
                 [_,_,f,f,_],
                 [_,f,f,_,_],
                 [_,_,f,_,_],
                 [_,_,_,_,_]]).
originalPiece(i,[[_,_,i,_,_],
                 [_,_,i,_,_],
                 [_,_,i,_,_],
                 [_,_,i,_,_],
                 [_,_,i,_,_]]).
originalPiece(l,[[_,_,l,_,_],
                 [_,_,l,_,_],
                 [_,_,l,_,_],
                 [_,_,l,l,_],
                 [_,_,_,_,_]]).
originalPiece(n,[[_,_,n,_,_],
                 [_,_,n,_,_],
                 [_,_,n,n,_],
                 [_,_,_,n,_],
                 [_,_,_,_,_]]).
originalPiece(p,[[_,_,_,_,_],
                 [_,_,p,p,_],
                 [_,_,p,p,_],
                 [_,_,p,_,_],
                 [_,_,_,_,_]]).
originalPiece(t,[[_,_,_,_,_],
                 [_,t,t,t,_],
                 [_,_,t,_,_],
                 [_,_,t,_,_],
                 [_,_,_,_,_]]).
originalPiece(u,[[_,_,_,_,_],
                 [_,u,_,u,_],
                 [_,u,u,u,_],
                 [_,_,_,_,_],
                 [_,_,_,_,_]]).
originalPiece(v,[[_,_,v,_,_],
                 [_,_,v,_,_],
                 [_,_,v,v,v],
                 [_,_,_,_,_],
                 [_,_,_,_,_]]).
originalPiece(w,[[_,_,_,_,_],
                 [_,w,_,_,_],
                 [_,w,w,_,_],
                 [_,_,w,w,_],
                 [_,_,_,_,_]]).
originalPiece(x,[[_,_,_,_,_],
                 [_,_,x,_,_],
                 [_,x,x,x,_],
                 [_,_,x,_,_],
                 [_,_,_,_,_]]).
originalPiece(y,[[_,_,_,_,_],
                 [_,_,y,_,_],
                 [_,y,y,_,_],
                 [_,_,y,_,_],
                 [_,_,y,_,_]]).
originalPiece(z,[[_,_,_,_,_],
                 [_,z,z,_,_],
                 [_,_,z,_,_],
                 [_,_,z,z,_],
                 [_,_,_,_,_]]).

/*
  結果表示です。
  特に説明は要らないでしょう。
*/

show_result([_,_|Board]) :-
  show_result0(Board).

show_result0([_,_]) :- !,
  nl.
show_result0([[_,_|L]|B]) :-
  show_line(L),nl,
  show_result0(B).

show_line([_,_]) :- !.
show_line([[C,_]|L]) :-
  show_item(C,Z),!,
  write(Z),
  show_line(L).

/*
  処理系によっては、全角文字が表示できないので、こちらを生かす

show_item(V,*):-var(V),!.
show_item(X,X).
*/

show_item(V,*):-var(V),!.
show_item(o,' ').
show_item(X,X).

/*
show_item(*,'？').
show_item(o,'　').
show_item(f,'■').
show_item(i,'□').
show_item(l,'○').
show_item(n,'●').
show_item(p,'◎').
show_item(t,'△').
show_item(u,'▲').
show_item(v,'＃').
show_item(w,'＄').
show_item(x,'％').
show_item(y,'¥').
show_item(z,'＊').
*/
/*
  処理系によっては、リスト反転、リスト要素は組込述語ですが
  汎用化のため、定義しておきます
*/
myreverse(X,Y):- rev(X,[],Y).
rev([],L,L):-!.
rev([A|R],S,An):- rev(R,[A|S],An).

% member(X,[X|_]).
% member(X,[_|L]):-member(X,L).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%オリジナルソースおわり%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%








%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%        オリジナル版にデモ用の述語、並列処理用の述語を追加  2009.11.10 Written By T.Inaba(SOFNEC)       %%%
%%%                                                                                                        %%%
%%% How To Compile:                                                                                        %%%
%%% >set AZPL=%AZ-Prolog%\system\pl                                                                        %%%
%%% >azpc -p pentomino.pl $(AZPL)\mlt_child.pl $(AZPL)\mlt_parent.pl $(AZPL)\utility.pl /e pentomino /fast %%%
%%% >azpc -p pentomino.pl /byte                                                                            %%%
%%% >del *.c & del *.obj & del mkaz.bat                                                                    %%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

s_test_count:-get_cputime(T0),doit(count_only), get_cputime(T1),Y is T1-T0,write(Y=sec),nl.
s_test_show:- get_cputime(T0),doit(show_result),get_cputime(T1),Y is T1-T0,write(Y=sec),nl.

p_test_count(Mode):-get_cputime(T0),p_doit(count_only,Mode), get_cputime(T1),Y is T1-T0,write(Y=sec),nl.
p_test_show(Mode):- get_cputime(T0),p_doit(show_result,Mode),get_cputime(T1),Y is T1-T0,write(Y=sec),nl.

%%%%%%%%%%%%
doit(D) :- ee_register(_,0),solve_pentomino(a,R),ee_register(N,N+1),show_type(D,N,R),fail.
doit(D) :- ee_register(N,0),write(a=N),nl,fail.
doit(D) :- solve_pentomino(b,R),ee_register(N,N+1),show_type(D,N,R),fail.
doit(D) :- ee_register(N,0),write(b=N),nl,fail.
doit(D).

p_doit(D,Mode) :- ee_register(_,0),solve_pentomino_para(Mode,a,R),ee_register(N,N+1),show_type(D,N,R),fail.
p_doit(D,Mode) :- ee_register(N,0),write(a=N),nl,fail.
p_doit(D,Mode) :- solve_pentomino_para(Mode,b,R),ee_register(N,N+1),show_type(D,N,R),fail.
p_doit(D,Mode) :- ee_register(N,0),write(b=N),nl,fail.
p_doit(D,Mode).

show_type(count_only,_,_):-!.
show_type(show_result,N,X) :- NN is N+1,write('No.'),write(NN),nl,show_result(X).

%% カウンタ定義
ee_register(N,S):-retract(mycounter(N)),!,W is S,assert(mycounter(W)).
ee_register(_,S):-W is S,assert(mycounter(W)).

%% CPUTIME 取得
get_cputime(T0):- statistics(_,_,_,_,T,_,_),!,T0 is T/1000.0.   % K-Prolog
get_cputime(T0):- T0 is cputime.                                % AZ-Prolog,SWI-Prolog

%% 処理系によっては以下でエラーが発生し、コンサルトが中断しますが  %%
%% ここまでで s_test_count/0 s_test_show/0 の実行は可能です        %%

:- unknown(_,fail).   % SWI-Prolog では unknownのdefault が　trace であるため。（AZ-Prologはfail)
:- bltin true/0.      % コンパイルしたときに動的にCallされる組込み述語を定義しておく。

%%% トップレベル起動述語の定義  %%%
menu:-
   prompt(P,'Select No.>'),
   repeat,
     nl,write(【ペントミノ】),nl,
     write('0  パズルの説明'),nl,
     write('1  表示なし全テスト'),nl,
     write('2  表示あり逐次処理'), check_my_mode(Mode),write(Mode),nl,
     write('3  表示あり並列処理（インタプリタコード）'),nl,
     write('4  表示あり並列処理（バイトコード）'),nl,
     write('5  表示あり並列処理（フルコンパイルコード）'),nl,
     write('6  終了'),nl,
     ttyget(X),
       switch([X],Y),call(Y),
   Y==true,!,
   prompt(_,P).

%% 起動モードのチェック（あんまりにもアバウトだけども）
check_my_mode(（フルコンパイルコード）):-
     my_system_name(Name),
     rexpl(Name,"[^\\^/]+$",[P,E,N,T,O,M,I,N,O|_]) ,!.
check_my_mode(（バイトコード）):-
     menu_name(X),clause(X,0,1,(menu:-bytecall(_,_))),!.
check_my_mode(（インタプリタコード）).

/* コンパイラをだますために定義 */
menu_name(menu).

switch("0",explanation):-!.
switch("1",test_all):-!.
switch("2",s_test_show):-!.
switch("3",p_test_show(inte)):-!.
switch("4",p_test_show(byte)):-!.
switch("5",p_test_show(full)):-!.
switch("6",true).

explanation:- explanation(EXP),write(EXP).


% 時間計測のみ全ておこなう
test_all:- 
     write(＜逐次処理＞),check_my_mode(Mode),write(Mode),nl,
     s_test_count,
     write(＜並列処理＞（インタプリタコード）),nl,
     p_test_count(inte),
     write(＜並列処理＞（バイトコード）),nl,
     p_test_count(byte),
     write(＜並列処理＞（フルコンパイルコード）),nl,
     p_test_count(full).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%      ペントミノに並列処理を追加する                        %%%
%%% 下記で▼はmlt_parent.plで定義されているコンパイル述語です  %%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% 親プロセス側 %%%%
%% 最上位の選択肢（１２ピースのどれを最初に試すか）で１２のプロセスに並列化する

solve_pentomino_para(Mode,Type,Board) :-
  prepareBoard(Type,Board,Pieces),              % オリジナルと同じ
  slim(Board,Board0),                           % オリジナルと同じ
  length(Pieces,Lng),                           % プロセスの個数はピース数
  get_proc_mode(Mode,EXE,Param),                % 実行モード別のEXE名、パラメータを取得 
  mlt_proc(Lng,EXE,'',Param,Proc),              % ▼実行モード別のプロセスを生成する
  mlt_pickup_send(Proc,Pieces,Board0,X-X),      % 全プロセスにゴールを設定
  ( mlt_scan_each(Proc,Board0) ;                % ▼早い順に結果を受け取る。バックトラックで次解取得
     mlt_kill(Proc),fail).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% モード別の子プロセスEXE,パラメータ

get_proc_mode(inte,prolog_c, consult('pentomino.pl')):-!.  % インタプリタコードで実行
get_proc_mode(byte,prolog_c, b_load(pentomino)      ):-!.  % バイトコードで実行
get_proc_mode(full,'./pentomino','').                          % フルコンパイルコードで実行

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 子プロセスにゴールを送る ここにオリジナルのplace/2で最初に呼ばれる pickup/3 が埋め込まれているので
%% 子側トップレベルではpickup/3を省く

mlt_pickup_send([],_,_,_):-!.
mlt_pickup_send([[_,I|_]|P],[K|Ks],Board,X-Ks):-         % 先頭ピースを取り出し、同時にそれ以外のピースリストを作る
    mlt_send_cmd(I, {place_child([K|X],Board),Board} ),  % ▼各プロセスに{ゴール,戻し値} ({}は強制バックトラック指示)を送信
    fail.                                                % それ以外のピースリスト(変数X)を開放するため、Failする
mlt_pickup_send([_|P],[K|Ks],Board,X-[K|Y]):-            % 前節で送信したピースリストの先頭をそれ以外のピース側に追加する
    mlt_pickup_send(P,Ks,Board,X-Y).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% 子プロセス側 %%%%
%% オリジナルのplace/2の最初に呼ばれるpickup/3(最初におくピースの選択)を親側で処理し以降を分散処理する
%% 子プロセス側はplace_child/3以下で使われている述語のみでいいのだが、簡便のため全コードを読み込ませてもよい

place_child([[_,K]|Ks0],[ [_,P02,P03,P04|L0], [P11,P12,P13|L1], [P21,P22|L2] |Board]):-
  member([P22,P13,P12,P11,P04,P03,P02],K),
  P02 = [V,_], 
  nonvar(V),
  place0(Ks0,Ks1,[ [P02,P03,P04|L0], [P12,P13|L1], [P22|L2] ]),
  place(Ks1,[ [P11,P12,P13|L1], [P21,P22|L2] |Board]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% オリジナルから分散処理のための子プロセストップレベル述語(place_child/3)を作る考え方 %%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% オリジナルプログラムは
% solve_pentomino(Type,Board) :-
%   prepareBoard(Type,Board,Pieces),     ボードとピースの構造生成
%   slim(Board,Board0),
%   place(Pieces,Board0).                ピースのボードへの割り当て =>この述語を並列化
%
% place/2では、すべてのピースが正しくボードを埋め尽くすまで、ピースを入れ替え(pickup/3)ピースの
% 回転、反転パターンを入れ替える(member/2)。
%
% place/2が初めてに呼ばれたとき、全１２ピースのどれから最初においていくかの選択があり、
% この１２の選択パターンで並列化することができる。
% このため、最初の選択がされた状態から以下を実行するプログラム(place_child/2)を作る。
% この述語作成の手順を説明する。

% 補足：このプログラムはコンパイルによる高速化比率の低い例としても特筆される。
%       AZ-Prolog においてはインタプリタ：フルコンパイルが高々２倍程度にしかならない。
%       この理由は、探索部分のプログラムは単純だが、動的に生成された複雑・巨大なリスト構造
%       どうしのユニフィケーションが本質であるので、この部分の実行速度はインタプリタも
%       コンパイルコードもさして変わらないからである。
%       並列処理による高速化が期待されるよい例とも言える。
%
%       コア数が４個であるCPU、Core i7上では、この並列処理化で３〜４倍の高速化がされている。
%       １２プロセス並列化なので、１２コアのCPUが登場すれば１２倍近くには期待できる。
%
% 課題：将来において、CPUコア数が十分多くなるならば、最上位のpickup/3とmember/2を掛け算した並列
%       も可能である。このための親側と子側のプログラムを作ってみてください。

%%%%%%% 分散処理のための述語作成概要 
% place([],_) :- !.               % 最上位呼び出しのみなのでこの節は利用しない 
% place(Ks,[L0,L1,L2|Board]) :-   % この節の内容で名前を place_childにした述語を新たに定義
%   place0(Ks,Ks0,[L0,L1,L2]),    % ★place0/3の第三節めを展開する
%   place(Ks0,[L1,L2|Board]). 
%
% place0(Ks,Ks,[[_,_,_]|_]) :- !.                   % 初回呼び出しのみなので利用しない 
% place0(Ks,Ks0,[[_,P01,P02|L0],[_|L1],[_|L2]]) :-  % 初回呼び出しのみなので利用しない 
%   P01=[V,_],nonvar(V),!,place0(Ks,Ks0,[[P01,P02|L0],L1,L2]).
%
% place0(Ks,Ks1,[[_,P02,P03,P04|L0],[P11,P12,P13|L1],[_,P22|L2]]) :-  % 変数は使われているものだけに整理済み
%   place1(Ks,Ks0,[P22,P13,P12,P11,P04,P03,P02]),                     % ★place1/3を展開する
%   P02 = [V,_],nonvar(V),                                     
%   place0(Ks0,Ks1,[ [P02,P03,P04|L0], [P12,P13|L1], [P22|L2] ]).
%
% place1(Ks,Ks0,P) :- 
%   pickup(Ks,Ks0,[_,K]),                       % ★ pickup/3の第一節めを展開する
%   member(P,K).
%
% pickup([X|Xs],Xs,X).                          % ★ 親側でピースの切り分をしているのでこの節のみ利用
% pickup([X|Xs],[X|Ys],Z) :- pickup(Xs,Ys,Z).   % 分散処理されるのでトップレベルではこの節を利用しない
%
%%%%%%%% place_child/2への書き換え手順
%
% [1] place1/3 のpickup/3第一節をインライン展開する
%
% place1(Ks,Ks0,P) :- 
%   ★ Call  ::pickup(Ks,       Ks0,   [_,K])
%   ☆ Define::pickup([X|Xs],   Xs,    X)
%                     Ks=[X|Xs],Ks0=Xs,[_,K]=X,   ==> Unifyを事前計算、親側変数へ畳込み
%                 ==> Ks=[[_,K]|Ks0] 
%   member(P,K).
%
% 【書き換え結果】
% place1([[_,K]|Ks0],Ks0,P):- member(P,K).    =>引数への畳込みで変数Ksを消去
%
% [2] place0/3/3 のplace1/3をインライン展開。展開時に親側と子側に同じ名前の変数名,無名変数があったときはレベル付する
%
% place0(Ks,Ks1,[[_,P02,P03,P04|L0],[P11,P12,P13|L1],[_,P22|L2]]) :- 
%   ★ Call::  place1(Ks,               Ks0,       [P22,P13,P12,P11,P04,P03,P02]),   
%   ☆ Define::place1([[_,K]|Ks0_1],    Ks0_1,     P ):- member(P,K).
%                     Ks=[[_,K]|Ks0_1], Ks0=Ks0_1, [P22,P13,P12,P11,P04,P03,P02]=P,member(P,K)  ==> 親側変数へ畳込み
%                 ==> Ks=[[_,K]|Ks0], member([P22,P13,P12,P11,P04,P03,P02],K)                   ==> Ks0_1とPが消去される
%   P02 = [V,_],nonvar(V),                                     
%   place0(Ks0,Ks1,[ [P02,P03,P04|L0], [P12,P13|L1], [P22|L2] ]).
%
% 【書き換え結果】
% place0([[_,K]|Ks0],Ks1,[[_,P02,P03,P04|L0],[P11,P12,P13|L1],[_,P22|L2]]) :-   ==>引数へ畳込みで変数Ksを消去
%   member([P22,P13,P12,P11,P04,P03,P02],K)
%   P02 = [V,_],nonvar(V),                                     
%   place0(Ks0,Ks1,[ [P02,P03,P04|L0], [P12,P13|L1], [P22|L2] ]).
%
% [3] place/2/2 のサブゴール,place0/3をインライン展開する。
%
% place(Ks,[L0,L1,L2|Board]) :-   
%   ★ Call::   place0(Ks,                Ks0,    [L0,                       L1,                    L2]),
%   ☆ Define:: place0([[_1,K]|Ks0_1],    Ks1,    [[_2,P02,P03,P04|L0],      [P11,P12,P13|L1],      [_3,P22|L2]]):-  
%                      Ks=[[_1,K]|Ks0_1], Ks0=Ks1, L0=[_2,P02,P03,P04|L0_1], L1=[P11,P12,P13|L1_1], L2=[_3,P22|L2_1],
%                  member([P22,P13,P12,P11,P04,P03,P02],K)
%                  P02 = [V,_4],nonvar(V),                                     
%                  place0(Ks0_1,Ks1,[ [P02,P03,P04|L0_1], [P12,P13|L1_1], [P22|L2_1] ]).
%   place(Ks0,[L1,L2|Board]). 
%
% 【書き換え結果】 書き換え後の述語名(place_child)に変更し変数を畳込んで完成。変数名を整理するともっと見やすくなる
% place_child([_1,K]|Ks0_1],[[_2,P02,P03,P04|L0_1],[P11,P12,P13|L1_1],[_3,P22|L2_1]|Board]):-  ==> 親側変数・引数へ畳込み
%   member([P22,P13,P12,P11,P04,P03,P02],K)
%   P02 = [V,_4],nonvar(V),                                     
%   place0(Ks0_1,Ks0,[ [P02,P03,P04|L0_1], [P12,P13|L1_1], [P22|L2_1] ]).
%   place(Ks0,[[P11,P12,P13|L1_1],[_3,P22|L2_1]|Board]). 

:- extern member/2.
