#! /usr/local/bin/prologcgi

:-s_charset(_,utf8).
:- kanji_mode(_,off).

:-s_mode(_,on).

top_call:-
    (get_param(resolve,Res)->true,Checked=' checked ';Res='',Checked=''),      %% 全解のチェックボックス
    (get_param(compile,COMP)->true;COMP=''),    %% コンパイルチェックボックス
    otameshi_get_param(A,B,FN),                 %% その他呼び出し引数を得る
    local_time([Nen,Getu,Youbi,Niti,Ji,Fun,Sec|MiS]),youbi(Youbi,You),
    atom_appends([Nen,年,Getu,月,Niti,日,You,Ji,時,Fun,分,Sec,秒],Nengetu),
    s_randomize(Fun,Sec),s_random(16,Rand0),to_hex(Rand0,Rand),
    html_call([
    "Content-Type: text/html; charset=utf-8

<html lang='ja'>
<head>
<meta http-equiv='Content-Type' content='text/html; charset=utf-8'>
<title>おためしAZ-Prolog</title>
<link href='../demo/css/setting.css' rel='stylesheet' type='text/css'>
</head>
<body>
<div class='header clearfix'>
  <h1>おためしAZ-Prologインタプリタ/コンパイラ</h1>
</div>
<div class='box effect'>
  <h3><a href='puttxt.exe?otameshi.cgi' target='source'>このページのソース表示</a></h3>
</div>
<div class='inner'>
  <div class='container'> プログラム入力欄、質問入力欄に入力またはSelectし【Go】押下でAZ-Prologの実行をお試し頂けます。<br>
    [全解]チェックボックスはトップレベルで強制的にバックトラックを発生し全解を表示します。<br>
    [Compile]チェックボックスは入力プログラムをバイトコードコンパイル後に実行します。<br>
    <br>
    <table width='100%' border='0' class='bordered'>
      <form action='otameshi.cgi' method='POST' class='form-container'>
        <tr>
          <td class='col1'>プログラム</td>
          <td><textarea  class='form-field3' cols='90' rows='15' name = 'pg' >",
            call(otameshi_puts(A)), "</textarea></td>
        </tr>
        <tr>
          <td class='col1'>質問</td>
          <td> | ?-
            <input name='query' size='45' type='text' class='form-field2' value='",call(otameshi_puts(B)),"'>
            <select name='program'>
              <option selected value='input' >【入力質問Call】",
              call(all_options),
              "
            </select>
            <input type='submit' value='Go'>
            <br>
            <br>
            全解
            <input type='checkbox' name='resolve' ",Checked," value=';'>
            Compile
            <input type='checkbox' name='compile' value='compile'>
      </form>
      <div class='uploadbox'>
        <form enctype='multipart/Form-data' action='otameshi.cgi' method='POST'>
          <font color='Blue'><b>User Program: </b></font>",FN," 
          <input type='file' name='user_file' >
          <input type='submit' value='UpLoad'>
        </form>
      </div>
      </td>
      </tr>
      <tr>
        <th class='answer'>解</th>
        <td class='answer'><pre>",
            call(otameshi_go(COMP,Res,A,B)),
    "</pre></td>
      </tr>
    </table>
    <br>
    <br>
    <div class='container'>領域サイズ<br>
      <pre>",
call(statistics),
"</pre>
    </div>
  </div>
</div>
<div class='center'><br>
<a href='http://az-prolog.com/showcase/' class='bkbtn'>RETURN</a>
</div>
</body>
</html>" ]).


%%%%%% カウンタ処理 %%%%%%%%%%

disp_counter(ID,Name):-
	get_counterR(ID,Count),
	html_call(["<span class='right'>Counter:",Count," </span>"]).

%% ?-get_counterR(ProgramID,Number).
get_counterR(ID,CC):- 
	s_version(_,'Win32',_,_),
	get_counter(ID,CC),!.

get_counterR(ID,CC):- 
	fileerrors(_,fail),
	atom_appends(['tmp/',ID,'.cnt'],F),
	(see(F) ->read(C),seen; C = 0),
	CC is C+1,tell(F),!,write(CC),write('.'),nl,told.
get_counterR(ID,0). 

%% ?-get_counter(odbctest,X).   X=N
get_counter(ID,X):- exec_direct(counter(update),[ID]),select_each([X],counter(select),[ID]),!,odbc_close.
get_counter(ID,X):- odbc_close,exec_direct(counter(insert),[ID]),!,get_counter(ID,X).
get_counter(ID,X):- odbc_close,exec_direct(counter(create),[]),!,get_counter(ID,X).

youbi(0,' 日曜日 '):-!.
youbi(1,' 月曜日 '):-!.
youbi(2,' 火曜日 '):-!.
youbi(3,' 水曜日 '):-!.
youbi(4,' 木曜日 '):-!.
youbi(5,' 金曜日 '):-!.
youbi(6,' 土曜日 '):-!.

to_hex(X,X):- X<10,!.
to_hex(X,[Y]):- Y is "A"+X-10.

%%%%%%%%%%%%%%%% 
sql_connect_data(counter(_),           "test","test","test").    

sql_statement(counter(create),[],      ["create table count_tbl ( countid char(10) primary key,countno integer)"]).
sql_statement(counter(insert),[],      ["insert into count_tbl (countid,countno) values('",_,"',0)"]).
sql_statement(counter(select),[long],  ["select countno from count_tbl where countid='",_,"'"]).
sql_statement(counter(update),[],      ["update count_tbl set countno=countno+1 where countid='",_,"'"]).


%%%%%% パラメータ処理 %%%%%%%%%%
otameshi_get_param(FileContents,'',FileName):- get_param(user_file,{FileName,X,FileContents}),!.
otameshi_get_param(A,B,''):- ( get_param(program,C);C=trans ),!,otameshi_get_param2(C,A,B).

otameshi_get_param2(input,A,B):-get_param(pg,A),get_param(query,B),!.
otameshi_get_param2(S,A,B):-  select_query(S,_,B,A),!.

%%%%%%%%%%%%%%%%
otameshi_go(_,_,_,''):-!.
otameshi_go(COMP,Res,PG,Query):-
    (atom(PG) -> atom(PG,L);length(PG,L)),e_create(L*3+100),     % Program 文字数X2+αのエディタバッファを確保
    tell(edit),otameshi_puts(PG),told,e_markend,e_jump(0),       % Program をエディタバッファに書き込む
    otameshi_errorset_cut('プログラム',e_reconsult),             % エディタバッファからDCGコンサルト
    otameshi_check_query(Query,Query0),                          % クエリの末のピリオッドチェック
    otameshi_errorset_cut('問い合わせ',term_atom(Term,Query0)),  % 問い合わせを項に変換
    compile_source(COMP),                                        % コンパイルチェック処理
    set_exit_timer(5000),                                        % 無限ループ等にそなえ5秒でプロセスを自滅させる
    rm_builtins,                                                 % system に悪影響を与える可能性のある処理をさせないための措置
    Start is cputime,
      call_v(Res,Term),                                          % 問い合わせが成功すれば結果とYesを表示
    Time is cputime-Start,
    write_listnl(['<br><br>(',Time,' Seconds)']).
otameshi_go(_,_,_,_).

%%%%%%% 入力エリアのチェックとエラー時のエラー部分表示処理 %%%%%
otameshi_errorset_cut(_,X):-  errorset(X,succ),!.

otameshi_errorset_cut(M,_):- 
	write_listnl(['<H3><font color=red>',M,にエラーがあります,'</font></H3>']),fail.

otameshi_errorset_cut(プログラム,_):- 
	errormode(_,0),e_jump(0),e_markend,see(edit),
	repeat,e_pos(X),errorsetcut(read(T),S),(S==succ->T==end_of_file;e_pos(Y)),!,
	e_jump(Y),e_mark,e_jump(X),copy0,seen,fail.

errorsetcut(X,S):-errorset(X,S),!.

%%%% 入力質問のチェック %%%% 
otameshi_check_query(X,Y):- rexpl(X,"(.+)\.[ \t]*$",_,_,_,[X0]),!,name(Y,X0).   % 文末の"."を削除
otameshi_check_query(X,X).                                                      % "."が無い場合はまあ、いいか。

%%%% 文字列の表示 %%%%
otameshi_puts([]):- !.
otameshi_puts([C|T]):- !,put(C),otameshi_puts(T).
otameshi_puts(A):- write(A).

%%%% サーバーに悪影響の可能性のある組み込み述語の削除 %%%%
%%%% たとえばつぎのような質問をされるとDiskがパンクしてしまう
%%%% ?- tell(temp),repeat,write(error),fail.

rm_builtins:-
    rm_builtin(s_new,0),rm_builtin(tell,1),rm_builtin(tella,1),
    rm_builtin(log,0),rm_builtin(log,1),rm_builtin(tell,2),
    rm_builtin(tella,2),rm_builtin(system,1),rm_builtin(sh,0),
    rm_builtin(d_open,1),rm_builtin(d_create,2),rm_builtin(save,1),
    rm_builtin(rename,2),rm_builtin(system,2),rm_builtin(s_child,5),
    rm_builtin(winCallApi,7).

%%%% 変数の対応充足値出力つきCall%%%%%%%
call_v(Res,X):-
	s_freevar(X,[],Y),      % 入力質問から変数名つき変数を取り出す
	   call(X),                  % 質問を呼び出す
	write_each(Res,Y),           % Trueの場合、変数名=結果値 を表示
	(Res = ';' ->Y=[];true),     % 全解チェック(;)で変数があるならバックトラック
	write(yes).                  % yes を表示

call_v(_,_):-  write(no).        % FAILの場合、no を表示

write_each(T,[]):-!,nl.
write_each(T,[B,A|L]):-
	(L=[] ->D=T;D=','),            % 最後の変数で無い場合は値の後ろに ","をつける
	to_atom(B,B),                  % 変数のままのときは変数名を表示
	write_listnl([A,'	= ',B,D]), 
	write_each(T,L).

%% [1,2,3|<LOOP>] の<LOOP>などがタグと扱われて表示されないので、エディタバッファを利用
%% して文字列とし、一文字ずつ出力する。
%% と、しようと思ったが、tell/1 を削除してしまっていたので使えない。

write_through_edit(B):-
	e_new,tell(edit),write(B),told,e_mark(M),MM is M-1,
	e_jump(0),see(edit),repeat(S),get0(X),put(X),S==MM,!,seen.

%%%%%% プログラムをユニークな名前のファイルに吐き出し、コンパイルして読み込む
compile_source(''):- !.
compile_source(_):- 
	s_pid(PID),
	atom_appends(['tmp_',PID,'.pl'],TMP0),
	atom_append('tmp/',TMP0,TMP),
	atom_appends(['tmp/tmp_',PID,'.b'],TMPB),
	tell(TMP),listing,write(':- publicall.'),nl,told,
	atom_append('cd tmp && azpc -p /byte /no_module /NOM ',TMP0,XX),
	errorset(system(XX),_),!,b_load(TMPB),
	rename(TMP,[]),rename(TMPB,[]),

	write('【コンパイル(バイトコード)による実行】<br>'),nl.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 入力クエリから変数のみ取り出し、重複を省いた変数名とのペアリストを作る
%% s_freevar(入力項,INキュー,OUTキュー)
%%
%% ?-s_freevar((b([A|X]),S=[a,1,A]),[],Qout).
%%
%% Qout= [A_2,'A',X_4,'X',S_6,'S']

s_freevar(X,    Que,Que ):- atomic(X),!.                                 % アトムは変数ではない
s_freevar(X,    Qin,Qout):- var(X),!,check_que(X,Qin,Qout).              % 変数のキューチェック/エントリ
s_freevar([X|L],Qin,Qout):- !,s_freevar(X,Qin,Qw),s_freevar(L,Qw,Qout).  % リストはCar,Cdrに分けて処理
s_freevar(TM,   Qin,Qout):- TM =..[_|L],s_freevar(L,Qin,Qout).           % その他の項の処理

check_que(X,[],     [X,N]):- !,to_atom(X,N).       % キューが空なら変数名と変数のペアを追加
check_que(X,[V|Q],  [V|Q]):- X==V,!.               % すでにキューに入っている
check_que(X,[V,N|Q],[V,N|R]):- check_que(X,Q,R).   % のこりのキューのチェック

%% 変数はヒープにあるとき、VarName_セルアドレス値 となるので "_セルアドレス値"を削除しアトム化

to_atom(V,A):- var(V),!,
	term_atom(a(V),At), rexpl(At,"a\((.+)_[0-9]+\)$",_,_,_,[AL]),!,
	(AL=[]->A=At;name(A,AL)).
to_atom(_,_).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Select Option の出力 %%%%

all_options:- bagof([X,Y],(A,B)^select_query(X,Y,A,B),L),!, write_all_options(L).

write_all_options([]):-!.
write_all_options([[X,Y]|L]):-
	write_listnl(['<option value="',X,'" > ',Y]),
	write_all_options(L).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%Prolog例題の簡易入力%%%%%%%
%% select_query(オプションValue,オプション表示値,デフォルト質問,プログラム).

select_query(clear,'【領域クリア】','','').

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
select_query(fatal,定言三段論法,
'死ぬ(ソクラテス).',
"%  ?- 死ぬ(X).

人間(ソクラテス).
人間(アリストテレス).
死ぬ(X) :- 人間(X). ").

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
select_query(append,リストの結合,
'my_append([1,2,3],[4,5,6],X).',
"% リストの結合
% ?-my_append(X,Y,[1,2,3,4,5,6]).

my_append([],L,L).
my_append([A|L],B,[A|LB]):-my_append(L,B,LB). ").

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
select_query(nrev,'Nrevベンチマーク',
'do_nrev.',
"% Nreverse ベンチマークテスト
% 30要素のリストの反転を1万回実行し1秒間の推論スピードを計算する
% ?-do_nrev.   

% 1MLips(1Mega Logical Inference Per Second) は1秒間に100万回の推論能力を示します
% ここではインタプリタとバイトコードでのベンチマークが計測できます
% バイトコードコンパイルには【compile】 のチェックボックスをチェックしてください

% インタプリタ:バイトコード:フルコンパイルの速度性能比は概ね、1:4:10 です 

%do_nrev:- write(done),nl.
do_nrev:- do_nrev(1000).

do_nrev(N):-
      N >= 1,                                 % N(繰り返し数)が1以上
      data(L),                                % 30要素のリスト
      X is cputime,                           % スタートのCPU時間(秒)
         repeat(X1),nrev(L,_),N is X1+1,!,    % Nrev をN回繰り返す
      Y is cputime,                           % 処理後のCPU時間(秒)
         repeat(X2),N is X2+1,!,              % 繰り返えし制御のみをN回おこなう
      Z is cputime,                           % 処理後のCPU時間(秒)
      Full is Y-X,                            % NrevをN回おこなった時間+繰り返しの制御時間
      Null is Z-Y,                            % Nrevを除く制御にかかった時間
      True is Full-Null,                      % N回のNrevの実時間
      True \== 0.0,                           % 実時間が計測できない場合はNを増やす必要有り
      Lips is (496*N)/True,                   % 1秒あたりの推論回数
      MLips is Lips/1000000,                  % 1秒あたりの推論回数(Mega換算)
      write_listnl([MLips,' MLips']).

data([ 1, 2, 3, 4, 5, 6, 7, 8, 9,10,
      11,12,13,14,15,16,17,18,19,20,
      21,22,23,24,25,26,27,28,29,30]).

% 30要素のリスト反転 は496論理推論。 N要素の推論数は次の計算となる
%{N+(N−1)+(N−2)+(N−3)...+1}+(N+1)
% ------------ s_append/3 の呼び出し ---------------    nrev/2の呼び出し

:- mode nrev(+,-).
nrev([],[]).
nrev([A|X],Y):- nrev(X,P),s_append(P,[A],Y).

:- mode s_append(+,+,-).
s_append([],L,L).
s_append([A|B],C,[A|BC]):- s_append(B,C,BC).
").

%%%%%%%%%%%%%%%%%%%%%%%%%%%
select_query(queens,'Nクイーン',
'put([1,2,3,4,5,6,7,8],[],X).',
"/*
  ?-put([1,2,3,4,5,6,7,8],[],X).   % 8クイーン1解ずつ結果をリストで表示
  ?-put([1,2,3,4,5,6,7,8],[],[]).  % 8クイーン全解(結果表示なし)
*/
%% put(要素リスト,既置リスト,答え).
put([],L,L):-!.        % 初期リストが空なら、既置リストが結果リストである
put(S,L,Ans):-
  select(S,A,B),       % 初期リストから要素を一つ取り出す。取り出した残りリストがB
  safe(A,A,L),         % これが今までに置いたものと衝突しないか調べる
  put(B,[A|L],Ans).    % 取り出した要素を既置リストに加え残りリストを更に置く

%%  Generate
%% リストから要素を一つ選ぶ。それを省いたリストを得る  < 非決定性
select([A|B],A,B).                % 先頭は要素である。
select([A|B],S,[A|L]):-           % 先頭以外からの要素も要素である
  select(B,S,L).

%%   Test
%% 安全に置けるかテストする
safe(_,_,[]):-!.        % テスト対象が空なら真(True)
safe(A,B,[C|D]):-       % テスト対象の最初の既置位置(C)が
  AA is A-1,AA \==C,    % 新要素の左下が既置位置と衝突しない
  BB is B+1,BB \==C,    % 新要素の右下が既置位置と衝突しない
  safe(AA,BB,D).        % 残りの既置位置が衝突しない
").

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
select_query(cabocha,かぼちゃ(係り受け解析),
'go("昨日、わたしは北アルプスの槍ヶ岳に行ってきました").',
"%%
 %% かぼちゃ(係り受け解析)
 %%
go(A):-
	(atom(A) ->name(A,STATEMENT);A=STATEMENT),!,
	cabocha_new(CABO, []), 
		write('<pre>'),nl,
			cabocha_sparse_tostr(CABO, STATEMENT, RESULT),
				puts(RESULT),
		write('%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'),nl,
			cabocha_sparse_totree(CABO, STATEMENT, TREE),
			cabocha_tree_size(TREE, SIZE),
			cabocha_tree_get_chunk_list(TREE, CHUNK_LIST),
				write(size=SIZE),nl,nl,
				write_chunk_list(CHUNK_LIST),
		write('</pre>'),nl,
	cabocha_destroy(CABO).

go(_).

%%%%%%%%%%%%%
puts([]):- !,nl.
puts([C|T]):- puta([C]), puts(T).

puta(""<""):-write('&lt;'),!.
puta("">""):-write('&gt;'),!.
puta([X]):- put(X),!.

%%%%%%%%%%%%%
write_chunk_list([]):- !.
write_chunk_list([[A,B,C,D,E|F]|T]):- 
	write([A,B,C,D,E]),nl,write(F),nl,nl,
	write_chunk_list(T).
").
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
select_query(trans,英日翻訳,
'trans("time flies like an arrow",S,X).',
"/*
 **** 翻訳プログラム例題 ****
 */
 
trans(Bun,IMI,J):-
    bagof(A,L^(rexpl(Bun,'[^ ^\.]+',L),name(A,L)),E),  % 文字列をアトム並びへ変換
    s(IMI,E,[]),                                       % 英語の構文解析
    js(IMI,J,[]).                                      % 同一構文を持つ日本語生成 

%%%%%%%%%%%%%%%%%%%%%%%%
%% 英語構文規則、辞書 %%

% 通常文
    s([s,Np,Vp]) --> np(Np),vp(Vp).
% 命令文
    s([s,Vp])    --> vp(Vp).

% 名詞句
    np([np,Noun])     --> n(Noun).
    np([np,N,Np])     --> n(N),np(Np).
    np([np,Det,Noun]) --> det(Det),n(Noun).

% 動詞句
    vp([vp,Vi,PP]) --> vi(Vi),pp(PP).
    vp([vp,Vi])    --> vi(Vi).

    vp([vp,Vt,Np])    --> vt(Vt),np(Np).
    vp([vp,Vt,Np,PP]) --> vt(Vt),np(Np),pp(PP).

% 前置詞句
    pp([pp,P,Np]) --> p(P),np(Np).

% 終端節
    n([n,time])  --> [time].
    n([n,'I'])   --> ['I'].
    n([n,you])   --> [you].
    n([n,arrow]) --> [arrow].
    n([n,flies]) --> [flies].
    n([n,like])  --> [like].

    det([det,a]) --> [an].
    p([p,like])  --> [like].

  % 動詞
    vi([vi,flies]) --> [flies].
    vi([vi,like])  --> [like].
    vt([vt,time])  --> [time].
    vt([vt,like])  --> [like].

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 日本語構文規則、辞書                      %%
%%  <<注意>>                                 %%
%%  英語の文法規則、単語を意味表現としている %%

% 通常文
    js([s,Np,Vp]) --> jnp(Np),[は],jvp(Vp).
% 命令文
    js([s,Vp])    --> jvp(Vp).

% 名詞句
    jnp([np,N,Np])     -->jn(N),[の],jnp(Np).
    jnp([np,Det,Noun]) -->jdet(Det),jn(Noun).
    jnp([np,Noun])     -->jn(Noun).

% 動詞句
    jvp([vp,Vi])       -->jvi(Vi).
    jvp([vp,Vi,PP])    -->jpp(PP),jvi(Vi).

    jvp([vp,Vt,Np])    --> jnp(Np),[を],jvt(Vt).
    jvp([vp,Vt,Np,PP]) --> jnp(Np),[を],jpp(PP),jvt(Vt).

% 前置詞句
    jpp([pp,P,Np]) --> jnp(Np),jp(P).

% 終端節
    jn([n,time])  --> [時].
    jn([n,'I'])   --> [私].
    jn([n,you])   --> [あなた].
    jn([n,arrow]) --> [矢].
    jn([n,flies]) --> [蝿].
    jn([n,flies]) --> [てんぷら].
    jn([n,like])  --> [好み].

    jdet([det,a])   -->[ひとつの].
    jp([p,like])    -->[のように].

  % 動詞
    jvi([vi,flies]) -->[飛ぶ].
    jvi([vi,flies]) -->[揚がる].
    jvi([vi,like])  -->[好む].
    jvt([vt,time])  -->[計る].
    jvt([vt,like])  -->[好む].
    jvt([vt,flies]) -->[揚げる].
").

select_query(sudoku,'数独パズル',
'go(1).',
"
% SUDOKU SOLVER   2013.11.24  T.Inaba(SOFNEC.CO.LTD)
% | ?- go(PatterNo).    % PatternNo 1-4 : 9x9     5 : 25x25
 
sudoku_pattern(1,
	[[9,_,_,  _,_,8,  _,_,3],
	 [_,8,_,  1,_,_,  5,_,_],
	 [_,_,_,  _,_,7,  _,1,_],
 
	 [_,4,_,  _,1,_,  _,_,9],
	 [_,_,7,  _,_,_,  4,_,_],
	 [3,_,_,  _,6,_,  _,5,_],

	 [_,3,_,  8,_,_,  _,_,_],
	 [_,_,6,  _,_,3,  _,2,_],
	 [2,_,_,  9,_,_,  _,_,7]]).
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% http://gigazine.net/news/20100822_hardest_sudoku/

sudoku_pattern(2,
	[[_,_,5,  3,_,_,  _,_,_],
	 [8,_,_,  _,_,_,  _,2,_],
	 [_,7,_,  _,1,_,  5,_,_],
 
	 [4,_,_,  _,_,5,  3,_,_],
	 [_,1,_,  _,7,_,  _,_,6],
	 [_,_,3,  2,_,_,  _,8,_],

	 [_,6,_,  5,_,_,  _,_,9],
	 [_,_,4,  _,_,_,  _,3,_],
	 [_,_,_,  _,_,9,  7,_,_]]).

sudoku_pattern(3,
	[[1,2,3,  4,5,6,  7,8,9],
	 [4,5,6,  7,8,9,  1,2,3],
	 [7,8,9,  1,2,3,  4,5,6],
 
	 [2,_,_,  _,_,_,  _,_,_],
	 [_,_,_,  _,_,_,  _,_,_],
	 [_,_,_,  _,_,_,  _,_,_],

	 [_,_,_,  _,_,_,  _,_,_],
	 [_,_,_,  _,_,_,  _,_,_],
	 [_,_,_,  _,_,_,  _,_,_]]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% http://rocketnews24.com/2012/07/03/22654/

sudoku_pattern(4,
	[[8,_,_,  _,_,_,  _,_,_],
	 [_,_,3,  6,_,_,  _,_,_],
	 [_,7,_,  _,9,_,  2,_,_],
 
	 [_,5,_,  _,_,7,  _,_,_],
	 [_,_,_,  _,4,5,  7,_,_],
	 [_,_,_,  1,_,_,  _,3,_],

	 [_,_,1,  _,_,_,  _,6,8],
	 [_,_,8,  5,_,_,  _,1,_],
	 [_,9,_,  _,_,_,  4,_,_]]).

 %%%%%%%%%%%%%%%%%%%%%%%
 %%%% Pattern 25x25 %%%%

sudoku_pattern(5,
 [[ 2, _, _, _, 6,24, 9,16,20, 3, _, 4,23, _,11,13, _,10,17, _, _,14, _,19, 5],
  [16, 1,22, _, 5,23,19, _, _, _,12, 2, _, _,25,11, _, _, _, 9, _, _,18,21, 6],
  [ _,24, _, _, _, 4, _, 8, _, _,16,19,18, 5, 3, _, _,12, _, 6, _, _, 9, 1,25],
  [11, _,23, _, _,10, _, 1, _,25, 6,17,20, _,13, 4, _, 2,22, _, _, _, _,16,24],
  [ 8, _,13,21, 3, _, 6,18, _,17, _, 9,22, _,14, 1, _, 5, _,25, 7, _, _, _, _],
  [24, _, _, _,15, 7, _, 3,16,20, _, _,21,10, 2, _, 1, _,11, 8,25, _, _, 4, _],
  [25, _, _,23, _,21, _, _, _,19,24, _, 3, 6, _,17, _, _,18,16, 9, 2, _, _, _],
  [ _,21,19, _,10, _, 4, _,15, _, 5,18,25,23,12, _, _,13, _,20,11, _, _,14, _],
  [22,13,20,17, _, 6, _, _,25, _,19,11,14, _, 4, _, 2,21, _,23, _, 8,15, _, _],
  [ _, _, 6, _, _,17,14,13,22, 9, _, _, _,16, _, _, _,25, _, _,24,19, 3,23, _],
  [10, _, 2, 9,11, 8,17, _, _,16, _, _, 7, _, _,22, _, _,13, _, _,25,20,18,15],
  [13, _, _, _,22, _, _,21, _, 1, _, _, _, _,15, _, _, _, _, 5, 2,12, _, _,19],
  [ 1, _,15, 8,14,22,25,23, 7,11, _, 6, 2, _,10, _,20, _,21, _, _,24, 5, _, _],
  [ _,20, _,25, _, 5, _,15,19, 2, _,16,11, _,24, 6, _,18, 8,17,23, 9, _,22, _],
  [21, 6,18,19, _,20,12, _,14, _, _, _,17, _,22, _, _, _, _, 2,16, 7,11, _, 1],
  [ _, _, _, _,17,25, 2,20, _,10, _, _, _, 4, 1, _,12,24, _,15,22, 5, _, _, _],
  [ 5, 2,24, _,25, _, 8,19, _, 7, _,10,12, _, 6, 3, _, 4, _,13, _, _, _, _, _],
  [ 4, 3, _, 6,20, _,15,22, _,21, _,25, 5, 8, _,16, _, _, _,11, _, _,23,12,18],
  [ _,23, 9,10,19, _, _, _, 3, 4, _, _, _,22, _, _, 5, 8, 6, 1, _,13,16, _,11],
  [ _,18, _, _, _, 1, _,11, _,14,13, 7,19, _,20, 2,17,23,10,22, 8, _,24, _, _],
  [ 9, _, _, 1, _, _,20,25, _, 5, _, _, _, 2,16,12, _, _, _, _, 4,15, _,11, 8],
  [ _, _,25, 7, _,15,16, _,17,13,14, _,10,20, _, _, _, 9, 5, _, 1, _,21, 3, 2],
  [23, _, _, 2,12, _, _, _, _, 6, 7, 8, _,19, _,18,21,16,24, _,17, _, _,13, 9],
  [20, 4,14, _,21, _, _, _, _, _,22,15, 6,25, _, _,13, _, _, _, _,16, _, _, 7],
  [ _, 8,16, 3, _, 9,24, _, _,12, _,21, 1,17,23, _, _, _, 2, _, 6,22,14, _,10]]).

 %%%%%%%%%%%%%%%%%%%%%
 %%%% Pattern 4x4 %%%%
sudoku_pattern(6,
	[[_,1,  _,_],
	 [_,_,  2,_],
 
	 [3,_,  _,_],
	 [_,_,  _,4]]).

:- dlib_require(clp).

go:- go(1),go(2),go(3),go(4),go(5).

go(No):- 
  sudoku_pattern(No,Horizontal),!,
  get_vars(Horizontal,Vertical,Box,Write0,Length,VL),
  add_color(Write0,Write), 
  write('<table><tr><td>'),
  mapcar(writeo,['No.',No,' Problem ',Length,x,Length,' '|Write],[]),
    statistics(runtime,[Begin,_]),
	mapcar(in,           Horizontal, [1..Length]),
	mapcar(alldifferent, Horizontal, []),
	mapcar(alldifferent, Vertical,   []),
	mapcar(alldifferent, Box,        []),
	mapcar(labeling,     Horizontal, []),
    statistics(runtime,[End,_]),
  Time is End-Begin,
  verify(VL,Horizontal,Vertical,Box,Verify),
  (No=5 -> true;write('</td><td> </td><td>')),
  mapcar(write,['Solved! ',Time,msec,Verify|Write],[]),
  write('</td></tr></table>').

%%%% map call
mapcar(Func,[Arg1|R],Arg2):- !,G=..[Func,Arg1|Arg2],call(G),mapcar(Func,R,Arg2).
mapcar(_,   [],_).

%%%% result verify
verify(L,H,V,B,' Verify OK!'):-
	mapcar(sort,H,L),mapcar(sort,V,L),mapcar(sort,B,L),!.
verify(_,_,_,_,' Verify NG!').

%%% End Of Main Program %%%
%%%%%%%%%%%%%%%%%%%%%%%%%%% 
writeo(L):- writeo(L,'[').

writeo([],_):-!,write(']').
writeo([X|L],SP):- !,write(SP),writev(X,Y),write(Y),writeo(L,',').
writeo(X,_):- write(X).

writev(X,'_'):- var(X),!.
writev(X,X).

add_color(X,Y):-integer(X),!,atom_appends(['<font color=red>',X,'</font>'],Y).
add_color(X,X):- var(X),!.
add_color([],[]):-!.
add_color([X|L],[XX|R]):- !,add_color(X,XX),add_color(L,R).
add_color(X,X).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Making Var List For Constraint if not created 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
?- get_vars(Horizontal,Vertical,Box,Write,4,VerifyL).

Horizontal = [[X1, X2,  X3, X4],     % in 1..4,alldifferent
              [X5, X6,  X7, X8],     % in 1..4,alldifferent
              [X9, X10, X11,X12],    % in 1..4,alldifferent
              [X13,X14, X15,X16]]    % in 1..4,alldifferent

Vertical   = [[X1,X5,X9,X13],        % alldifferent
              [X2,X6,X10,X14],       % alldifferent
              [X3,X7,X11,X15],       % alldifferent
              [X4,X8,X12,X16]]       % alldifferent

Box        = [[X1,X2,X5,X6],         % alldifferent
              [X3,X4,X7,X8],         % alldifferent
              [X9,X10,X13,X14],      % alldifferent
              [X11,X12,X15,X16]]     % alldifferent

Write      = [[X1,X2],  ' ',[X3,X4],'
',            [X5,X6],  ' ',[X7,X8],'
','
',            [X9,X10], ' ',[X11,X12],'
',            [X13,X14],' ',[X15,X16],'
','
']

VerifyL    = [[1,2,3,4]]

*/

:- dynamic sudoku_vars/6.              % dummy for contorol unknown ERROR!
get_vars(H,V,B,W,Length,VL):-             % Created !
	sudoku_vars(H,V,B,W,Length,VL),!.
get_vars(HH,V,B,W,Length,VL):-             % Not Created Yet! 
  	length(HH,Length),
  	S is integer(sqrt(Length)),
	   make_h(Length,Length,H,[],VL),
	   make_v(H,V),
	   make_b(S,H,B),
	   make_w(NL,H,S,S,W),
	asserta(sudoku_vars(H,V,B,W,Length,VL)),
	H=HH,make_w(P,H,S,S,W).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Making Horizontal vars List
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
make_h(_,0,[],   VL,[VL]):-!.
make_h(N,M,[B|H],VL,VLR):- make_h2(N,B),MM is M-1, make_h(N,MM,H,[M|VL],VLR).
  %%
make_h2(0,[]):-!.
make_h2(N,[X|B]):- M is N-1,make_h2(M,B).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Horizontal  ==> Vertical vars
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
make_v([[]|_],[]):-!.
make_v(H,     [B|V]):-make_v2(H,B-B,NextH),make_v(NextH,V).
  %%
make_v2([],       _-[],   []):-!.
make_v2([[X|Q]|H],B-[X|T],[Q|NextH]):- make_v2(H,B-T,NextH).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Horizontal ==> Box vars List
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
make_b(_,[],[]):- !.
make_b(S,[[]|L],Ans):-!,make_b(S,L,Ans).                % delete Null EOL
make_b(S,H,     [B|Ans]):-make_b2(S,S,S,H,B-B,NextH),make_b(S,NextH,Ans).
  %%
make_b2(_,1,0,NextH,    _-[],   NextH):-!.                           % EndOfBox
make_b2(S,M,0,[Q|H],    B,      [Q|R]):-!,N is M-1,make_b2(S,N,S,H,B,R).  % EOL
make_b2(S,M,C,[[X|Q]|H],B-[X|T],NextH):-D is C-1,make_b2(S,M,D,[Q|H],B-T,NextH).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% Horizontal ==> write Goal
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
make_w(Z,H,    S,0,[Z|R]):-!,make_w(Z,H,S,S,R).
make_w(Z,[B|H],S,N,[Z|R]):-!,make_w2(B,S,S,Q-Q,R-T),M is N-1,make_w(Z,H,S,M,T).
make_w(Z,[],   _,_,[Z]):- make_cr(Z).
  %%
make_w2([],   _,_,Q-[],   [Q|R]-R):-!.
make_w2(B,    S,0,Q-[],   [Q,' '|R]-T):-!,make_w2(B,S,S,Y-Y,R-T).
make_w2([X|B],S,N,Q-[X|P],Result):- M is N-1,make_w2(B,S,M,Q-P,Result).
  %%
make_cr('<br>
').

").

:-s_mode(_,off).