vain0x/!_Codetter.md

## !_Codetter.md

      
    Raw
  

              !_Codetter.md
            
          
    codetter にあげたもののまとめ

http://codetter.com/?tag=ue_dai

ペア比較マクロ
サブルーチン迷路
単独実行モジュール
文字列リテラルへのポインタを得るコマンド
特定のマスを特定の歩数目で踏んで迷路を抜けるパズル
[Prolog]十字型にライトをスイッチしてすべてのライトを点けるパズル
[Prolog]魔法陣 (入る値が与えられている場合)
[Prolog]魔法陣<4×4> (入る値が与えられている場合)
[Prolog]各部分の和が等しいように輪を分割するパズル
[Prolog]論理パズル/条件から住人と部屋の位置を推定する問題
[Prolog]論理パズル／正直者は誰？ (失敗例)
[Prolog]論理パズル／帽子は何色？
マッチ棒を動かして10を3つ作るパズル
21世紀における0～3の数字を2個ずつ使ってできる年月日の個数
21世紀における0～3の数字を2個ずつ使ってできる年月日の個数 (「禁則」によって表現するバージョン)
非決定性の述語 単位行列/2
非決定性の述語 単位行列/2 (「添字」を用いるバージョン)
dupptr 失敗
remove 述語の定義―リスト[a:1, a:2]から[a:_ をすべて取り除いた結果は？
(蛇足) can_unify/2を使って、定義3のremoveを定義1,2とよく似た形で定義する。
struct型変数への代入(HspVarStruct_Set)はメモリ解放のみ行いデストラクタを呼ばない
ifブロックのコンパイルエラー例2つ
変数引数に値を渡す


## constptr_hpi.cpp
/**
文字列リテラルへのポインタを得るコマンド

書いてから思ったけど、HSP自体がリソースのために持っているバッファ(DS)へのポインタを返すので、リテラルが書き換え可能になっちゃうっていう。……まぁそこらへんはいいか。
実数値リテラルもいけるけど、整数はCodeSegmentに直書きだからそれ自体へのポインタは無理で、どこかにコピーを書いて取る必要がある。面倒くさい。
実際に使用するときは #define global constptr __constptr || というマクロを用いる。いちいち括弧をつけなくていいので記述が楽。
//*/

// constptr || CONST_VALUE
int constptr( void** ppResult )	// この返値が *type_res に、*ppResult の値が reffunc の返値になるとする
{
	if ( *exinfo->npexflg & (EXFLG_1 | EXFLG_2) ) puterror( HSPERR_SYNTAX );
	static int stt_result;
	switch ( *type ) {
		case TYPE_STRING:
		case TYPE_DNUM:
			stt_result = reinterpret_cast<int>( &ctx->mem_mds[*val] );
			*ppResult = &stt_result;
			break;
		case TYPE_INUM:
			puterror( HSPERR_UNSUPPORTED_FUNCTION );	// CS中に埋め込まれているのでとれない
		default:
			puterror( HSPERR_SYNTAX );
	}
	code_next();
	if ( !(*type == TYPE_MARK && *val == 6) ) puterror( HSPERR_SYNTAX );	// or(||)
	code_next();
	return HSPVAR_FLAG_INT;
}

## count_days.prolog
/*
21世紀における0～3の数字を2個ずつ使ってできる年月日の個数

【出典】https://twitter.com/c_oi/status/301346035094126593 https://twitter.com/c_oi/status/301346039590436864
【引用】「0～3の数字を2個ずつ使ってできる年月日は21世紀(2001/01/01～2100/12/31)の間に何日間あるでしょう？」
//*/

remove1(E, [E|Tail], Tail).
remove1(E, [X|Tail], [X|List]) :- remove1(E, Tail, List).

permutation([], []).
permutation(List, [H|Tail]) :- remove1(H, List, List1), permutation(List1, Tail).

条件(L) :-
	permutation([0,0,1,1,2,2,3,3], L),
	L = [Y1, Y2, Y3, Y4, M1, M2, D1, D2],
	Y is (Y1 * 1000 + Y2 * 100 + Y3 * 10 + Y4),
	M is (M1 * 10 + M2),
	D is (D1 * 10 + D2),
	年の条件(Y),
	月日の条件(Y, M, D).

年の条件(Y) :- 2001 =< Y, Y =< 2100.
月日の条件(Y, M, D) :-
	月の日数(Y, M, Days),
	1 =< M, M =< 12,
	1 =< D, D =< Days.

月の日数(_, 1, 31).
月の日数(Y, 2, 29) :- 閏年(Y), !.
月の日数(Y, 2, 28).
月の日数(_, 3, 31).
月の日数(_, 4, 31).
月の日数(_, 5, 31).
月の日数(_, 6, 30).
月の日数(_, 7, 31).
月の日数(_, 8, 31).
月の日数(_, 9, 30).
月の日数(_, 10, 31).
月の日数(_, 11, 30).
月の日数(_, 12, 31).

閏年(Y) :- Y mod 4 == 0, (Y mod 100 \== 0 ; Y mod 400 == 0).

?- setof(L, 条件(L), Ls), length(Ls, N).
% N = 48

## count_days_by_using_forbidden.prolog
/*
21世紀における0～3の数字を2個ずつ使ってできる年月日の個数 (「禁則」によって表現するバージョン)

【前回】http://codetter.com/?p=898
【着想】http://nojiriko.asia/prolog/twitter_by_c_oi_20130213.html
　　　　(https://twitter.com/TakaoOzaki/status/301562885103026176)
【前回】と【着想】を混ぜて、いくらか書き加えたもの。
量化命題の自動証明を行う。
//*/

順列(Y,0,[]).
順列(Y,N,[A|X]) :- del(A,Y,Z), M is N - 1, 順列(Z,M,X).
del(A,[A|X],X).
del(A,[B|X],[B|Y]) :- del(A,X,Y).

小の月(2).
小の月(4).
小の月(6).
小の月(9).
小の月(11).
% 小の月(M) :- 月の日数(M, Days), Days < 31.

'「禁則」の簡略化のために利用する諸命題' :-
	'閏年か否かは考慮しなくてよい',
	'2月以外の小の月の存在は考慮しなくてよい',
	'0月、14～19月および40月以上の年月日ならびは発生しない',
	'0日および34日以上の年月日ならびは発生しない'.

'閏年か否かは考慮しなくてよい' :-
% ∀ L [ L : '順列と21世紀の条件'を満たす ⇒ L : 2月29日を表す年月日並びではない ]
% ⇔ ￢∃ L [ L : '順列と21世紀の条件'を満たす ∧ L : 2月29日を表す年月日並びである ]
	\+ 順列と21世紀の条件([_,_,_,_, 0,2, 2,9]).

'2月以外の小の月の存在は考慮しなくてよい' :-
	% 小の月：31日の存在しない月
	\+ (
		順列と21世紀の条件([_,_,_,_, M1,M2, 3,1]),
		M is (M1 * 10 + M2), '2月以外の小の月'(M)
	).

'2月以外の小の月'(M) :- M \== 2, 小の月(M).

'0月、14～19月および40月以上の年月日ならびは発生しない' :-
	% 0月が発生しないのは、21世紀だから、年が0を少なくとも1つ使うため
	\+ (
		順列と21世紀の条件([_,_,_,_, M1,M2, _,_]),
		M is (M1 * 10 + M2),
		( M == 0 ; (14 =< M, M =< 19) ; M >= 40 ) % まとめた
	).

'0日および34日以上の年月日ならびは発生しない' :-
	\+ (
		順列と21世紀の条件([_,_,_,_, _,_, D1,D2]),
		D is D1 * 10 + D2,
		( D == 0 ; D >= 34 )
	).

順列と21世紀の条件(L) :-
	順列([0,0,1,1,2,2,3,3], 8, L), % 「0～3の数字を2個ずつ使ってできる」こと
	[2,0,0,1, 0,1, 0,1] @=< L, % 「21世紀」であること
	L @=< [2,1,0,0, 1,2, 3,1].

禁則([_,_,_,_, 0,2, 3,_]) :- !.
禁則([_,_,_,_, 1,3, _,_]) :- !.
禁則([_,_,_,_, 2,_, _,_]) :- !.
禁則([_,_,_,_, 3,_, _,_]) :- !.
禁則([_,_,_,_, _,_, 3,2]) :- !.
禁則([_,_,_,_, _,_, 3,3]) :- !.

条件(L) :-
%	L = [Y1,Y2,Y3,Y4, M1,M2, D1,D2],
	順列と21世紀の条件(L),
	\+ 禁則(L). % 「年月日ならび」であるための条件 ('順列と21世紀の条件'と併せて)

?- '「禁則」の簡略化のために利用する諸命題',
	setof(L, 条件(L), Ls), length(Ls, N).
% N = 48

/*
備考：全称命題の証明は面倒くさいので、二重否定を使って“存在の否定”命題に変形した。
	'∀x p(x)' :- setof(x, p(x), (x の全体集合を表す整列されたリスト)).
%	:- setof(x, x ∈ 全体集合, (x の全体集合を表す整列されたリスト)).
*/

## dupptr_error.hsp
/**
dupptr 失敗

(2013/5/20 21:44)
//*/

#module
#defcfunc sizeOfType int vt
  assert (1 <= vt && vt <= 4) // ← コメントアウトするとエラーにならない
  return 4
#global

  v = 1
  dupptr r, varptr(v), sizeOfType(vartype(v))
  // r が正常に作成されない
  mes r //→ システムエラー(1)

## equal_sum_partitions.prolog
/**
[Prolog]各部分の和が等しいように輪を分割するパズル

元ネタ：https://twitter.com/puzzlegiver_bot/status/217544145630281729
ただし、解はアルファベットではなく、与えたリストの中での位置を返す。
//*/

append([], List, List).
append([Head|Tail], List, [Head|TailR]) :- append(Tail, List, TailR).

部分リスト(List, (I, I), []).
部分リスト(List, (0, End), SubList) :-
	number(End), End > 0, 部分リスト_(List, End, SubList).
部分リスト([Head|Tail], (Bgn, End), SubList) :-
	number(Bgn), Bgn > 0, Bgn1 is Bgn - 1,
	number(End), End > 0, End1 is End - 1,
	部分リスト(Tail, (Bgn1, End1), SubList).
部分リスト_(_, 0, []).
部分リスト_([Head|Tail], Cnt, [Head|TailAcc]) :-
	Cnt > 0, Cnt1 is Cnt - 1, 部分リスト_(Tail, Cnt1, TailAcc).

整数閉区間(L, L, R) :- L =< R.
整数閉区間(N, L, R) :- L =< R, L1 is L + 1, 整数閉区間(N, L1, R).

和([Head|Tail], Sum) :- 和_acc(Tail, Sum, Head).
和_acc([], Sum, SumAcc) :- Sum is SumAcc.
和_acc([Head|Tail], Sum, SumAcc) :- 和_acc(Tail, Sum, Head + SumAcc).

弧(List, (I, I), []).
弧(List, (0, End), Arc) :- 部分リスト(List, (0, End), Arc).
弧(List, (Bgn, 0), Arc) :- length(List, N), 部分リスト(List, (Bgn, N), Arc).
弧(List, (Bgn_, End_), Arc) :-
	number(Bgn_), number(End_), Bgn_ =\= 0, End_ =\= 0,
	length(List, N),
	Bgn is ((Bgn_ mod N) + N) mod N,	% 非負最小剰余
	End is ((End_ mod N) + N) mod N,
	( Bgn < End
		->	部分リスト(List, (Bgn, End), Arc)
		;	弧(List, (Bgn, 0), ArcLead), 部分リスト(List, (0, End), ArcTrail),
			append(ArcLead, ArcTrail, Arc)
	).

輪の等和分割(List, [X|Answer], Div) :-
	和(List, ListSum), ArcSum is ListSum / Div,
	length(List, N),
	整数閉区間(X, 0, N),	% 第一の切断点(の右)
	輪の等和分割(List, [X|Cut], Div, ArcSum, N, N),
	append(Answer, [X], Cut).

輪の等和分割(_, [_], 0, _, _, 0).
輪の等和分割(List, [Bgn, End|Cut], Div, Sum, LenFull, LenRemain) :-
	整数閉区間(Len, 1, LenRemain), End is (Bgn + Len) mod LenFull,
	弧(List, (Bgn, End), Arc),
	和(Arc, Sum),
	Div1 is Div - 1, LenRemain1 is LenRemain - Len,
	輪の等和分割(List, [End|Cut], Div1, Sum, LenFull, LenRemain1).

% 例題
	?- 輪の等和分割( [1, 12, 5, 8, 10, 3, 11, 9, 6, 7, 4, 2], Answer, 3 ).
/*
Answer = [2,6,9].	% つまり 5, 11, 7 の左側 B, F, I で切断する
*/

% ---------------------
% おまけ：特殊バージョン (3分割、数値に重複がないことが条件)
between(L, L, R) :- L < R.
between(N, L, R) :- L < R, L1 is L + 1, between(N, L1, R).

隣接(1, 12). 隣接(12, 5). 隣接(5, 8). 隣接(8, 10). 隣接(10, 3). 隣接(3, 11).
隣接(11, 9). 隣接(9, 6). 隣接(6, 7). 隣接(7, 4). 隣接(4, 2). 隣接(2, 1).

区間(X, R) :- 隣接(X, R) ; (X \== R, 隣接(R1, R), 区間(X, R1)).

弧和(X, R, Sum) :- 区間(X, R), 弧和_acc(X, R, Sum, 0).
弧和_acc(X, X, Sum, SumAcc) :- !, Sum is SumAcc.
弧和_acc(X, R, Sum, SumAcc) :- 隣接(X, X1), 弧和_acc(X1, R, Sum, SumAcc + X).

３分割( [X, Y, Z], Sum ) :-
	between(X, 1, 13),
	弧和(X, Y, Sum), 弧和(Y, Z, Sum), 弧和(Z, X, Sum).

?- Sum is ((12*(12 + 1))/2) / 3, ３分割(A, Sum).
% A = [5,11,7]	% B, F, I

## iden_matrix_by_using_index.prolog
/**
非決定性の述語 単位行列/2 (「添字」を用いるバージョン)

【目標】述語 単位行列/2 を“うまく”定義する。
【出典】http://codetter.com/?p=902
「添字」を考えて、単位行列 E_n := [ δ_i,j ]_n×n として定義する。
数値を用いると is によって双方向性を失ってしまうので、ペアノ自然数 s(N) を用いる。
ペアノ自然数と数値を相互に単一化させる述語 natural/2 に、めんどくさい条件分岐を押し付けることで、定義を簡潔にする試み。
//*/

natural(0).
natural(s(N)) :- natural(N).

natural(0, 0).
natural(s(N), X) :- number(X), !, X > 0, X1 is X - 1, natural(N, X1).	% N によって変項 X を単一化させる場合
natural(s(N), X) :- var(X), !, integer_itetate(X, 1), natural(s(N), X).	% 両方変項の場合
natural(s(N), X) :- natural_acc(N, X, 1), !.	% X によって変項 N を単一化させる場合
natural_acc(0, X, X).
natural_acc(s(N), X, Acc) :- Acc1 is Acc + 1, natural_acc(N, X, Acc1).

integer_itetate(X, X).
integer_itetate(X, L) :- L1 is L + 1, integer_itetate(X, L1).

mylength_n([], 0).
mylength_n([Head|Tail], s(N)) :- mylength_n(Tail, N).

at_n([Val|_], 0, Val).
at_n([_|List], s(N), Val) :- at_n(List, N, Val).

insertAt_n(List, 0, Val, [Val|List]).
insertAt_n([X|List], s(N), Val, [X|Tail]) :- insertAt_n(List, N, Val, Tail).

零リスト([]).
零リスト([0|T]) :- 零リスト(T).

単位行列_n(0, []).
単位行列_n(s(N), LL) :- 単位行列_n(s(N), LL, 0).	% 行番号によってループする

単位行列_n(N, [], N).
単位行列_n(N, [Row|RowT], M) :-
	mylength_n(Row, N), insertAt_n(RowRems, M, 1, Row), 零リスト(RowRems),
	単位行列_n(N, RowT, s(M)).

単位行列(X, LL) :- natural(N, X), 単位行列_n(N, LL).	% インターフェイス

?- 単位行列(2, [[1, 0], [0, 1]]).	%=> yes
?- 単位行列(N, [[1, 0], [0, 1]]).	%=> N = 2 ; ... (無限ループに陥る)
?- 単位行列(2, LL).	%=> LL = [[1,0],[0,1]] ; no
?- 単位行列(N, LL).	%=> N = 0, 1, 2, ... と順次成功する

## iden_matrix_nondeterministic_pred.prolog
/**
非決定性の述語 単位行列/2

【出典】https://twitter.com/TakaoOzaki/status/306175708726706177
【要約】述語 単位行列/2 を“うまく”定義する。
単位行列 E_n := [ δ_i,j ]_n×n からの連想として「添字」を用いる実装をすると、双方向性を保つのがめんどくさい
(組み込み述語 var による条件分岐がどうしても必要になる気がする)。
//*/

mylength([], 0).
mylength([_|T], N) :- mylength(T, N1), N is N1 + 1.

零リスト([]).
零リスト([0|T]) :- 零リスト(T).

単位行列(N, LL) :- mylength(LL, N), 単位行列_(N, LL).
単位行列_(0, []).
単位行列_(N, [[1|RowT]|T]) :-
%	number(N), N > 0,
	N1 is N - 1, mylength(RowT, N1), !,	% important!
	行列の左に列ベクトルを加える(T1, ClmT, T),
	零リスト(RowT), 零リスト(ClmT),
	単位行列_(N1, T1).

行列の左に列ベクトルを加える([], [], []).
行列の左に列ベクトルを加える([T|LL1], [H|V], [[H|T]|LL]) :-
	行列の左に列ベクトルを加える(LL1, V, LL).

?- 単位行列(2, [[1, 0], [0, 1]]).
/*
yes
*/

?- 単位行列(N, [[1, 0], [0, 1]]).
/*
N = 2 ;
no
*/

% うまく定義しないと no が返らず無限ループに陥ることも。

?- 単位行列(2, LL).
/*
LL = [[1, 0], [0, 1]] ;
... (無限ループに陥る)
*/

% no を返してほしいところだが、次の結果を得るためにはこの挙動にならざるをえない？

?- 単位行列(N, LL).
/*
N = 0, LL = [] ;
N = 1, LL = [[1, 0], [0, 1]] ;
N = 2, LL = [[1, 0, 0], [0, 1, 0], [0, 0, 1]] ;
N = 3, LL = [[1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]] ;
... (各Nについて無限に成功する)
*/

% うまく定義しないと N = 0, 1 だけで終わってしまうことも。

## if_syntax_error.hsp
/**
ifブロックのコンパイルエラー例2つ

HSP3.4
//*/

// 例1
// '}'が内側のifに対応すると判断される。
// '}' の前に改行があると問題なし
if 1 { if 1 : mes "a" : else : mes "b" } mes "c"

// 例2
// else の検出に失敗する。
if 1 { mes "a" } : else

// ちなみにこういうのはok
if 1 : { mes "a" } else
if 1 : *label { mes "a" } else

## lights_out_2.prolog
/**
[Prolog]十字型にライトをスイッチしてすべてのライトを点けるパズル

【ライツアウト2】https://twitter.com/puzzlegiver_bot/status/277035208719609856
ルール：
・ライトを on/off して、すべてのライトを点灯させる。
・ただし、on/off することを選んだライトの上下左右4つのライトも同時に on/off する。
参考：http://t.co/7YyBQOQ9 お気楽 Prolog プログラミング入門 / 反復深化
//*/

% 0 = 点灯(on), 1 = 消灯(off)とする。
% 解答として、すべて点灯させるためにスイッチすべきライトの成分のリストを返す。

% リスト・行列に関する諸述語
append( [], List, List ).
append( [Head|Tail], List, [Head|TailR] ) :- append(Tail, List, TailR).

at( [Head|Tail], 0, Head ).
at( [Head|Tail], Idx, Val ) :- number(Idx), Idx > 0, Idx1 is Idx - 1, at( Tail, Idx1, Val ).

at( [Head|Tail], (0, Y), Val ) :- at(Head, Y, Val).
at( [Head|Tail], (X, Y), Val ) :- X > 0, X1 is X - 1, at( Tail, (X1, Y), Val ).

reverse( [], [] ).
reverse( [Head|Tail], Reversed ) :- reverse( Tail, Remains ), append( Remains, [Head], Reversed ).

zero_list([]).
zero_list([0|Tail]) :- zero_list(Tail).
zero_matrix([]).
zero_matrix([Head|Tail]) :- zero_list(Head), zero_matrix(Tail).

between(L, L, R) :- L < R.
between(N, L, R) :- L < R, L1 is L + 1, between(N, L1, R).

% マンハッタン距離
abs( X, A ) :- number(X), X >= 0 -> A is X ; A is -X.
manhattan_distance( (Ax, Ay), (Bx, By), D ) :-
	X is Ax - Bx, abs( X, Dx ),
	Y is Ay - By, abs( Y, Dy ),
	D is Dx + Dy.

% 成分の順序 (辞書式順序)
positionLess( (X1, _), (X2, _) ) :- X1 < X2.
positionLess( (X, Y1), (X, Y2) ) :- Y1 < Y2.

% パズル
light_switch_pazzle( Q, A ) :- light_switch_pazzle( Q, A, (0, 1000) ).	% 省略引数
light_switch_pazzle( Q, A, (MinLv, MaxLv) ) :-
	length(Q, M), Q = [QHead|_], length(QHead, N),
	between(Limit, MinLv, MaxLv),		% 反復深化
%	write(Limit), nl,
	light_switch_pazzle_acc( (0, Limit), Q, (M, N), ARev, [] ),
	reverse(ARev, A).

light_switch_pazzle_acc( (Limit, Limit), Board, _, Path, Path ) :-
	zero_matrix(Board).
light_switch_pazzle_acc( (Lv, Limit), Board1, (M, N), A, Path ) :-
	Lv < Limit, Lv1 is Lv + 1,
	between(X, 0, M),
	between(Y, 0, N),
	( Path = [] ; Path = [PrevPath|_], positionLess( PrevPath, (X, Y) ) ),	% 順番違いの解を排除 (成分列を単調増加に限定する)
	light_switch( Board1, Board2, (X, Y) ),
	light_switch_pazzle_acc( (Lv1, Limit), Board2, (M, N), A, [(X, Y)|Path] ).

% 成分(X, Y)および上下左右(マンハッタン距離1以下)がスイッチした行列
light_switch( Board1, Board2, (X, Y) ) :-
	light_switch_matrix_( Board1, Board2, (X, Y), (0, 0) ).

light_switch_matrix_( [], [], _, _ ).
light_switch_matrix_( [Head1|Tail1], [Head2|Tail2], Point, (X, 0) ) :-
	light_switch_list_( Head1, Head2, Point, (X, 0) ),
	X1 is X + 1,
	light_switch_matrix_( Tail1, Tail2, Point, (X1, 0) ).

light_switch_list_( [], [], _, _ ).
light_switch_list_( [Head1|Tail1], [Head2|Tail2], Point, (X, Y) ) :-
	manhattan_distance( Point, (X, Y), D ),
	( D =< 1 -> Head2 is (1 - Head1); Head1 = Head2 ),
	Y1 is Y + 1,
	light_switch_list_( Tail1, Tail2, Point, (X, Y1) ).

% 例題
% 問題文で「最短4手」と明言されているので、実際は4手の解を探すだけで十分。
?- light_switch_pazzle( [
	[ 1, 0, 1, 1 ],
	[ 0, 0, 1, 0 ],
	[ 1, 1, 0, 1 ],
	[ 1, 0, 1, 1 ] ], Answer ).
/*
Answer:
[(0,0),(0,2),(2,0),(3,3)]	 % 最短
[(0,0),(0,3),(1,1),(2,1),(2,3),(3,1)]
[(0,0),(1,1),(1,2),(1,3),(3,0),(3,2)]
[(0,1),(1,1),(1,3),(2,0),(2,2),(2,3)]
[(0,2),(1,0),(1,1),(2,2),(3,1),(3,2)]
[(0,0),(0,1),(0,3),(1,0),(1,2),(2,1),(3,0),(3,3)]
[(0,0),(0,1),(1,0),(1,3),(2,3),(3,1),(3,2),(3,3)]
[(0,1),(0,2),(0,3),(1,3),(2,1),(2,2),(3,1),(3,3)]
[(0,1),(0,2),(1,2),(2,2),(2,3),(3,0),(3,2),(3,3)]
[(0,3),(1,0),(2,0),(2,1),(2,2),(2,3),(3,2),(3,3)]
[(1,0),(1,2),(1,3),(2,0),(2,2),(3,0),(3,1),(3,3)]
...
*/

## logic_puzzle_4.prolog
/**
[Prolog]論理パズル/条件から住人と部屋の位置を推定する問題

【論理パズル4】http://twitter.com/puzzlegiver_bot/status/274468300510089216
ベタ書き。部屋は行列にした方が「右側」などを綺麗に実装できる。
//*/

:- op(700, xfx, ∈).
∈(X, Y) :- contains(Y, X).

contains([Val|_], Val).
contains([_|Tail], Val) :- contains(Tail, Val).

部分集合([], _).
部分集合([E|L], R) :- E ∈ R, 部分集合(L, R).
集合同値(L, R) :- 部分集合(L, R), 部分集合(R, L).

階層(Room, 0) :- Room ∈ [g, h, i].
階層(Room, 1) :- Room ∈ [d, e, f].
階層(Room, 2) :- Room ∈ [a, b, c].
右隣(a, b). 右隣(b, c).
右隣(d, e). 右隣(e, f).
右隣(g, h). 右隣(h, i).
左隣(L, R) :- 右隣(R, L).
隣(X, Y) :- 右隣(X, Y) ; 左隣(X, Y).
右側(X, Y) :- X ∈ [a, d, g], Y ∈ [b, c, e, f, h, i].
右側(X, Y) :- X ∈ [b, e, h], Y ∈ [c, f, i].
左側(X, Y) :- 右側(Y, X).
真下(a, d). 真下(b, e). 真下(c, f).
真下(d, g). 真下(e, h). 真下(f, i).
真上(D, U) :- 真下(U, D).
上階(X, Y) :- 階層(X, XRank), 階層(Y, YRank), XRank > YRank.

?-	A = [Akamatsu, Aoki, Kihara, Shirasawa, Kuroi, Haitani, Kaneco, Nobody0, Nobody1],
	右側(Haitani, Kuroi),
	上階(Kihara, Aoki),
	左隣(Akamatsu, _), 右隣(Akamatsu, _),
	左側(Kaneco, Aoki),
	隣(Kihara, Shirasawa),
	階層(Haitani, 2),
	隣(Kuroi, X1),
	隣(Akamatsu, X2),
	真上(Kaneco, X3),
	集合同値([X1, X2, X3], [Nobody0, Nobody1]),
	\+(真上(Aoki, Shirasawa)),
	\+(真下(Kihara, Akamatsu)),
	\+(隣(Kaneco, Shirasawa)),
	\+(隣(Haitani, Shirasawa)),
	集合同値(A, [a, b, c, d, e, f, g, h, i]).
/*

A:
[h,d,b,c,e,a,i, g,f]
[h,d,b,c,e,a,i, f,g]
[h,d,b,c,e,a,i, g,f]
[h,d,b,c,e,a,i, f,g]

すなわち
A: ハイタニ, B: キハラ, C: シラサワ,
D: アオキ, E: クロイ, F: (空),
G: (空), H: アカマツ, I: カネコ,
*/

## logic_puzzle_WC.prolog
/**
[Prolog]論理パズル／帽子は何色？

意外とすっきりした解答が得られたので。
//*/

/*
	帽子は何色？
	論理的思考力を持つ3人の正直者 a, b, c に、5つの帽子(赤×3, 白×2)のうち3つを1つずつ被せる。
	どの人も、他2人の帽子の色を知っている(∵見えている)が、自身の帽子の色は知らない。
	出題者「あなたの帽子の色は？」　a「……わかりません。」
	出題者「あなたの帽子の色は？」　b「……わかりません。」
	出題者「あなたの帽子の色は？」　――さて、c の帽子の色は？

% 出展('数学ガール ゲーデルの不完全性定理', page: 16).
% (同値な問題だが、文字数圧縮のため問題文は書き直した。)
*/

insert(E, Set, [E|Set]).
insert(E, [X|Set0], [X|Set]) :- insert(E, Set0, Set).

部分集合([], X).
部分集合([H|L], R) :- insert(H, R0, R), 部分集合(L, R0).

不確定(X, Cond) :-		% 条件 Cond を満たす変数 X は一意に存在しない
	setof(X, Cond, L), \+(length(L, 1)).

?-	_hats = [赤, 赤, 赤, 白, 白],		% 簡単のため
	A = 赤, B = 赤, (C = 赤 ; C = 白),
%	部分集合([A, B, C], _hats),

	% a には自身の帽子の色 ASelf が確定できない
	不確定(ASelf, 部分集合([ASelf, B, C], _hats)),

	% a には自身の帽子の色 ASelf が確定できないことが分かっていても、
	% b には自身の帽子の色 BSelf が確定できない
	不確定(BSelf, (
		部分集合([A, BSelf, C], _hats),
		不確定(ASelf2, 部分集合([ASelf2, BSelf, C], _hats))
	)).

% A = 赤, B = 赤, C = 赤

## logic_puzzle_who_is_honest.prolog
/**
[Prolog]論理パズル／正直者は誰？ (失敗例)

非常に素直に実装してみたら解けてない。
「嘘つきは1人いる」か否かをチェックするために、「嘘つきは1人いる」か否かをチェックするため、無限再帰に陥る。
//*/

% 嘘つき問題
/*
	正直者は誰？
	A1「ここに、嘘つきは1人いる。」
	A2「ここに、嘘つきは2人いる。」
	A3「ここに、嘘つきは3人いる。」
	A4「ここに、嘘つきは4人いる。」
	A5「ここに、嘘つきは5人いる。」

	引用('数学ガール ゲーデルの不完全性定理', page: 3).
*/

% 定義
嘘(A) :- \+(A).

正直者(P) :- 人(P), \+(嘘つき(P)).
嘘つき(P) :- 人(P), 主張(P, A), 嘘(A).

'嘘つきはN人いる'(N) :- setof(P, 嘘つき(P), L), length(L, N).

% 問題
人(a1). 主張(a1, '嘘つきはN人いる'(1)).	% 元々閉世界なので「ここに、」は不要
人(a2). 主張(a2, '嘘つきはN人いる'(2)).
人(a3). 主張(a3, '嘘つきはN人いる'(3)).
人(a4). 主張(a4, '嘘つきはN人いる'(4)).
人(a5). 主張(a5, '嘘つきはN人いる'(5)).

:- trace. % ステップ実行にて無限再帰を確認なされ
?- setof(P, 正直者(P), L).	% 正直者リスト L を求める。
%	L = [a4]

## magic_square_1_4x4_given_sum.prolog
/**
[Prolog]魔法陣<4×4> (入る値が与えられている場合)

【魔法陣1】https://twitter.com/puzzlegiver_bot/status/278001662394777600
先ほどのコード(http://codetter.com/?p=849)を 4×4 に特殊化したもの (groups_4x4 と同じことを記述するのにコードの半分近くを費やしていたことになる)。与えられた問題を解くだけならこれだけのコードで十分である。
また、どうやら調べるグループの順序によって速度が大きく異なるらしく、前回同様の対角線→行→列の順でそれなりの速さになる (もっと速い順序もあるかもしれない)。Row0→3, Clm0→3, DiagL, DiagR の順では待てど暮らせど終わらなかったので、修整を間違えたかと焦ったが、どうやら時間がかかりすぎているだけのようだった。なぜかは知らない。
//*/

% 4×4 行列分解
groups_4x4(
	[
		[M00, M01, M02, M03],	% 行ベクトルのリスト
		[M10, M11, M12, M13],
		[M20, M21, M22, M23],
		[M30, M31, M32, M33]
	], [
		[M00, M10, M20, M30],	% 列ベクトルのリスト
		[M01, M11, M21, M31],
		[M02, M12, M22, M32],
		[M03, M13, M23, M33]
	],
	[ M00, M11, M22, M33 ],		% 主対角線 (左上→右下)
	[ M30, M12, M21, M03 ],		% 　対角線 (左下←右上)
	[ M00, M01, M02, M03,
	 M10, M11, M12, M13,
	 M20, M21, M22, M23,
	 M30, M31, M32, M33 ]	% 全成分のリスト
).

% addelem(S, E, S2): 集合Sに元Eを加えたものが、集合S2に等しいこと (ただし、主に S2 から E を取り除くために使う)
addelem(E, Set, [E|Set]).
addelem(E, [X|Set1], [X|Set2]) :- addelem(E, Set1, Set2).

% 多重集合の部分集合 '⊆'
multi_subset([], Rhs).
multi_subset([E|LhsTail], Rhs) :- addelem(E, Rhs1, Rhs), multi_subset(LhsTail, Rhs1).
multi_set_eq(L, R) :- multi_subset(L, R), multi_subset(R, L).	% 集合 '=' :⇔ '⊆' ∧ '⊇'

% 総和 Σ (sum(L, S): リストLの元の総和が数値Sumに等しい)
sum([Head|Tail], Sum) :- sum_acc(Tail, Sum, Head).
sum_acc([], Sum, Sum).
sum_acc([Head|Tail], Sum, SumAcc) :- SumAcc2 is SumAcc + Head, sum_acc(Tail, Sum, SumAcc2).

% 魔法陣
magic_matrix_4x4(M, A, Src) :-
	sum(Src, SumSrc), Sum is SumSrc / 4,
	M = A,
	M = [Row0, Row1, Row2, Row3],
	groups_4x4( M, [Clm0, Clm1, Clm2, Clm3], DiagL, DiagR, Flat ),
	magic_matrix_4x4_( [
		DiagL, DiagR,
		Row0, Row1, Row2, Row3,
		Clm0, Clm1, Clm2, Clm3 %,
	], Sum, Src ),
	multi_set_eq(Flat, Src).	% 成分列が Src の順列になること

magic_matrix_4x4_( [], _, _ ).
magic_matrix_4x4_( [Head|Tail], Sum, Src ) :-
	multi_subset(Head, Src),
	sum(Head, Sum),
	magic_matrix_4x4_(Tail, Sum, Src).

% 例題
?- magic_matrix_4x4( [
		[_, 18, _, _],
		[7, _, _, 10],
		[_, _, 9, _],
		[_, 5, _, _]
	], A, [2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19] ).

% A = [[6,18,17,2],[7,12,14,10],[11,8,9,15],[19,5,3,16]] (唯一解)

## magic_square_1_given_sum.prolog
/**
[Prolog]魔法陣 (入る値が与えられている場合)

【魔法陣1】https://twitter.com/puzzlegiver_bot/status/278001662394777600
パズルの定番。列、行、対角線の成分の総和がすべて等しくなるようにテーブルを完成させる。
ただし、入りうる値のリストが与えられている場合にのみ解答できる。そうでない場合は和の値が数値(number)ではなく変数であることを考慮して記述しなきゃなので、私には難しそうである。
それと、magic_matrixの P は“変数の少ない順”にソートした方が速い気がするけれど、この例題では違いがあまり感じられなかったので入れていない。無駄に長くなるし。
成分列が Src の順列であることの条件は、最初の3グループを調べるときに Src を減少させていく(‘⊆’の代わりに’∪’を使って差分も取っておき、それを次回のSrcにする)ことで記述できるけれど、そんな条件分岐を入れるとコードが読みづらくなるので省略した。時間の無駄とはいえ。
//*/

append([], List, List).
append([Head|Tail], List, [Head|TailR]) :- append(Tail, List, TailR).

at([Val|Tail], 0, Val).
at([Head|Tail], Idx, Val) :- number(Idx), Idx > 0, Idx1 is Idx - 1, at(Tail, Idx1, Val).

% 平坦化 (リストのリスト(2次配列)を、リストの垣根を崩して1次元配列にする)
flatten( Matrix, List ) :- flatten_acc( Matrix, List, [] ).
flatten_acc( [], List, List ).
flatten_acc( [Head|Tail], List, ListAcc ) :- append( ListAcc, Head, ListAcc2 ), flatten_acc( Tail, List, ListAcc2 ).

% 行列
matrix([[Val]]).
matrix([H|Tail]) :- list(H), length(H, CntColumns), matrix_(Tail, CntColumns).

matrix_([X|[]], CntColumns) :- list(X), length(X, CntColumns).
matrix_([H|Tail], CntColumns) :- list(H), length(H, CntColumns), matrix_(Tail, CntColumns).

matrix_size([H|Tail], (X, Y)) :- matrix([H|Tail]), length([H|Tail], X), length(H, Y).

% 対角成分
main_diag(M, L) :- matrix_size(M, (N, N)), diag_(M, L, 0, 1).
sub_diag(M, L) :- matrix_size(M, (N, N)), Idx is N - 1, diag_(M, L, Idx, -1).

diag_( [], [], _, _ ).
diag_( [Row|TailRows], [H|T], Idx, Step ) :- at(Row, Idx, H), Idx1 is Idx + Step, diag_( TailRows, T, Idx1, Step ).

% 列ベクトル
columns(M, Idx, List) :- number(Idx), columns_acc(M, Idx, List, []).
columns_acc([], Idx, List, List).
columns_acc([Row|MTail], Idx, List, ListAcc) :- at(Row, Idx, Val), append(ListAcc, [Val], ListAcc2), columns_acc( MTail, Idx, List, ListAcc2 ).

% 転置行列
transpose([], []).
transpose(M, Mt) :- matrix_size(M, (N, N)), transpose_( M, Mt, 0 ).
transpose_(M, [Head|Tail], Idx) :-
	number(Idx), Idx >= 0,
	columns(M, Idx, Head), Idx1 is Idx + 1,
	( length(M, Idx1) -> Tail = [] ; transpose_(M, Tail, Idx1) ).

% 集合操作
elem(E, [E|Others]).			% '∈'
elem(E, [_|Others]) :- elem(E, Others).

addelem(E, Set, [E|Set]).		% a.k.a. select
addelem(E, [X|Set1], [X|Set2]) :- addelem(E, Set1, Set2).

% 多重集合の部分集合 '⊆'
multi_subset([], Rhs).
multi_subset([E|LhsTail], Rhs) :- addelem(E, Rhs1, Rhs), multi_subset(LhsTail, Rhs1).

multi_set_eq([], []).
multi_set_eq([E|LhsTail], Rhs) :- addelem(E, Rhs1, Rhs), multi_set_eq(LhsTail, Rhs1).

% 総和 Σ
sum([Head|Tail], Sum) :- sum_acc(Tail, Sum, Head).
sum_acc([], Sum, SumAcc) :- Sum is SumAcc.
sum_acc([Head|Tail], Sum, SumAcc) :- sum_acc(Tail, Sum, Head + SumAcc).

% 魔法陣
magic_matrix(M, A, Src) :- matrix_size(M, (N, N)),
	M = A,
	sum(Src, SumSrc), Sum is SumSrc / N,	% 総和が実数で求まる
	transpose(A, T), main_diag(A, DiagL), sub_diag(A, DiagR),
	append( A, T, P0 ), append( [DiagL, DiagR], P0, P ),	% P : 和が Sum になるリストのリスト
%	write(P), nl,
	magic_lists(P, Sum, Src),
	flatten(A, Flat), multi_set_eq(Flat, Src).	% 成分列が Src の順列になること

magic_lists([], _, _).
magic_lists([Head|Tail], Sum, Src) :-
	multi_subset(Head, Src),
	sum(Head, Sum),
%	write(Head), nl,
	magic_lists(Tail, Sum, Src).

% 例題
?- magic_matrix( [
		[_, 18, _, _],
		[7, _, _, 10],
		[_, _, 9, _],
		[_, 5, _, _]
	], A, [2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19] ).

/*
A = [[6,18,17,2],[7,12,14,10],[11,8,9,15],[19,5,3,16]]	% (唯一解; 約8秒)
*/

## matchstick_puzzle.prolog

/**
マッチ棒を動かして10を3つ作るパズル

出典：【マッチ棒パズル1】https://twitter.com/puzzlegiver_bot/status/298325496985448449
「棒を3本動かして3つの式の答えをそれぞれ10にして下さい。」
5 – 1 + 5
4 × 7 – 5
6 – 4 + 8
1つ目の答えを出すのに数時間かかった。もう1つは未確認。酷い。
//*/

一要素置換([Bef|Tail], [Aft|Tail], (Bef, Aft)).
一要素置換([X|BefTail], [X|AftTail], Replace) :-
	一要素置換(BefTail, AftTail, Replace).

% デジタル文字の定義
デジタル文字(X) :- デジタル文字(X, _).
デジタル文字((number, Ptn), Char) :- デジタル数字((number, Ptn), Char).
デジタル文字((operator, Ptn), Char) :- デジタル演算子((operator, Ptn), Char).

デジタル数字((number, [1, 1, 1, 1, 0, 1, 1]), 0).		% 8 の各所に対応するマッチ棒の有無を表すリスト
デジタル数字((number, [0, 0, 1, 0, 0, 1, 0]), 1).
デジタル数字((number, [0, 1, 1, 1, 1, 0, 1]), 2).
デジタル数字((number, [0, 1, 1, 0, 1, 1, 1]), 3).
デジタル数字((number, [1, 0, 1, 0, 1, 1, 0]), 4).
デジタル数字((number, [1, 1, 0, 0, 1, 1, 1]), 5).
デジタル数字((number, [1, 1, 0, 1, 1, 1, 1]), 6).
デジタル数字((number, [1, 1, 1, 0, 0, 1, 0]), 7).		% “ワ”型
デジタル数字((number, [1, 1, 1, 1, 1, 1, 1]), 8).
デジタル数字((number, [1, 1, 1, 0, 1, 1, 1]), 9).

デジタル演算子((operator, [1, 1, 0, 0]), '+').
デジタル演算子((operator, [0, 1, 0, 0]), '-').
デジタル演算子((operator, [0, 0, 1, 1]), '*').		% ×
%デジタル演算子((operator, [0, 0, 0, 1]), '/').		% ／

デジタル文字列([]).
デジタル文字列([Head|Tail]) :- デジタル文字(Head), デジタル文字列(Tail).

デジタル文字列([], []).
デジタル文字列([DH|DigitString], [H|String]) :-
	デジタル文字(DH, H), デジタル文字列(DigitString, String).

棒を1本加える((Type, Ptn), (Type, PtnAfter)) :-	% 入出力がデジタル文字かは無視
	一要素置換(Ptn, PtnAfter, (0, 1)).
棒を1本減らす((Type, Ptn), (Type, PtnAfter)) :-
	一要素置換(Ptn, PtnAfter, (1, 0)).

棒を1本動かす(Chars, CharsAfter) :-
	棒を1本減らす(Chars, CharsTmp1),
	棒を1本加える(CharsTmp1, CharsAfter),
	Chars \== CharsAfter.

棒を1本加える([Char|Tail], [CharAfter|Tail]) :-
	棒を1本加える(Char, CharAfter).
棒を1本加える([X|CharsTail], [X|CharsAfterTail]) :-
	棒を1本加える(CharsTail, CharsAfterTail).

棒を1本減らす([Char|Tail], [CharAfter|Tail]) :-
	棒を1本減らす(Char, CharAfter).
棒を1本減らす([X|CharsTail], [X|CharsAfterTail]) :-
	棒を1本減らす(CharsTail, CharsAfterTail).

% 数式化 (ただし加減乗除 + - * / のみ)
数式化([X, Op1, Y, Op2, Z], Expr) :-
	current_op(Op1Priority, _, Op1),
	current_op(Op2Priority, _, Op2),
	Op1Priority =< Op2Priority
		-> ( Expr1 =.. [Op1, X, Y], Expr =.. [Op2, Expr1, Z] )
		; ( Expr1 =.. [Op2, Y, Z], Expr =.. [Op1, X, Expr1] ).

%	?- 数式化([1, '+', 2, '+', 3], X).
%	?- 数式化([1, '*', 2, '+', 3], X).
%	?- 数式化([1, '+', 2, '*', 3], X).
%	?- 数式化([1, '*', 2, '*', 3], X).

% 長さからリストを単一化できる述語 (AZ-Prolog の length にはその機能がない故)
mylen([], 0).
mylen([_|Tail], N) :- N > 0, N1 is N - 1, mylen(Tail, N1).

append([], L, L).
append([H|T1], L, [H|T2]) :- append(T1, L, T2).

append_fold([], []).
append_fold([H|Tail], Sum) :- append_fold(Tail, TailSum), append(H, TailSum, Sum).

% 例題
?-	Q = [
		5, '-', 1, '+', 4,
		4, '*', 7, '-', 5,
		6, '-', 4, '+', 8
	],
	% A は、Q のデジタル文字列の棒を3本動かしてできるデジタル文字列で表現できる
	デジタル文字列(Enc0, Q),
	棒を1本動かす(Enc0, Enc1),
	棒を1本動かす(Enc1, Enc2), Enc0 \== Enc2,
	棒を1本動かす(Enc2, Enc3), Enc0 \== Enc3, Enc1 \== Enc3,
	デジタル文字列(Enc3, A),
%	write(A), nl,

	% 3つの式の答えがすべて10である
	mylen(A1, 5), mylen(A2, 5), mylen(A3, 5),
	append_fold([A1, A2, A3], A),
	数式化(A1, E1), 10 is E1,	% E1 is 10 ではない
	数式化(A2, E2), 10 is E2,
	数式化(A3, E3), 10 is E3.

% 答えはおそらくこの2通り
% A = [7,-,1,+,4,4,*,4,-,6,6,-,4,+,8]
% A = [5,+,1,+,4,1,*,7,+,3,6,-,4,+,8]

## maze_puzzle.prolog
/**
特定のマスを特定の歩数目で踏んで迷路を抜けるパズル

【迷路5】https://twitter.com/puzzlegiver_bot/status/277296210212163584
課題：
・入口が左上(0,0)であることをルールに入れているのがイマイチ
・10秒待て！
・’;’ で別解を求めると同じ解が4回表示されてしまう。
//*/

append( [], List, List ).
append( [Head|Tail], List, [Head|TailR] ) :- append(Tail, List, TailR).

at( [Head|Tail], (0, Y), Val ) :- at(Head, Y, Val).
at( [Head|Tail], (X, Y), Val ) :- X > 0, X1 is X - 1, at( Tail, (X1, Y), Val ).

at( [Head|Tail], 0, Head ).
at( [Head|Tail], Idx, Val ) :- number(Idx), Idx > 0, Idx1 is Idx - 1, at( Tail, Idx1, Val ).
	?- at( [[1,2,3],[4,5],[6,7]], (0,2), 3 ).

% ルール
walk_maze(Q, A) :-
	Q = A,
	length(Q, M), Q = [H|_],
	length(H, N),
	walk_maze( Q, A, (M, N), (0, 0), 1 ).	% 左上を入口として入る

walk_maze( _, _, (M, N), _, StepEnd ) :- StepEnd is M * N.
walk_maze( Q, A, (M, N), (X, Y), Step ) :-
%	number(M), number(N), number(X), number(Y), number(Step),
	0 =< X, X < M, 0 =< Y, Y < N,
	at( Q, (X, Y), Step ),
	StepNext is Step + 1,
	(	% 次の一歩
		X1 is X - 1, walk_maze( Q, A, (M, N), (X1, Y), StepNext );
		Y1 is Y - 1, walk_maze( Q, A, (M, N), (X, Y1), StepNext );
		X2 is X + 1, walk_maze( Q, A, (M, N), (X2, Y), StepNext );
		Y2 is Y + 1, walk_maze( Q, A, (M, N), (X, Y2), StepNext )
	).

% 例題
	?- walk_maze( [
		[ 1, _, _, _, _, 36 ],
		[ _, _, _, _, _, _ ],
		[ _, _, _, _, _, _ ],
		[ _, 9, _,27, _, _ ],
		[ _,18, _, _, _, _ ],
		[ _, _, _, _, _, _ ] ], Answer ).
/*
Answer = [
	[ 1, 2, 3, 4, 35, 36 ],
	[ 12, 11, 6, 5, 34, 33 ],
	[ 13, 10, 7, 28, 29, 32 ],
	[ 14, 9, 8, 27, 30, 31 ],
	[ 15, 18, 19, 26, 25, 24 ],
	[ 16, 17, 20, 21, 22, 23 ]
]
*/

## pair_comparison.hsp
/**
ペア比較マクロ

(a, b) = (c, d) みたいな書き方ができるマクロ。見やすくなる時だけ使おう。
特殊展開マクロちゅっちゅちゅー
//*/

// コア
#define global ctype _pairOpPush2(%1, %2) %t_pairOp %s2 %s1	// 逆順 (%pN の N を(左:0→右:max)にするため)
#define global ctype _pairOpPush1(%1) %t_pairOp %s1
#define global _pairOpPop2 %t_pairOp %o0 %o0
#define global _pairOpPop1 %t_pairOp %o0

// 展開後の式の形
#define global _pairEq2Impl %t_pairOp (%p0 == %p2 && %p1 == %p3)
#define global _pairNe2Impl %t_pairOp (%p0 != %p2 || %p1 != %p3)

#define global _pairOp2Impl %t_pairOp %p0 %p4 %p2 , %p1 %p4 %p3

// { push, 展開式, pop }
#define global ctype _pairRel2(%1 = impl, %2 = args, %3) \
	_pairOpPush2 %3 _pairOpPush2 %2 \
	%1 \
	_pairOpPop2 _pairOpPop2

#define global ctype _pairOp2(%1 = impl, %2 = op, %3 = args, %4) \
	_pairOpPush1(%2) _pairOpPush2 %4 _pairOpPush2 %3 \
	%1 \
	_pairOpPop2 _pairOpPop2 _pairOpPop1

// public
#define global ctype pairEq(%1, %2) _pairRel2(_pairEq2Impl, %1, %2)
#define global ctype pairNe(%1, %2) _pairRel2(_pairNe2Impl, %1, %2)

#define global ctype pairOp(%1, %2 = op, %3) _pairOp2(_pairOp2Impl, %2, %1, %3)

// テキトーなサンプル
#if 1
#define ctype dbgstr(%1) ({"%1 = "} + (%1))
#define ctype dbgarr2(%1) ({"%1 = [ "} + %1(0) + ", " + %1(1) + " ]")

	a = 1
	b = 2
	mes dbgstr( pairEq((a, b), (1, 2)) )	// true
	mes dbgstr( pairNe((a, b), (3, 2)) )	// true

	x = pairOp( (1, 2), +, (3, 4) )	// ←見づらい
	mes dbgarr2( x )
#endif

/*
(a, b) を ctype マクロの引数にして、後は特殊展開マクロでよろしくやってるだけ
n-tuple について同様に可能
*/

## pass_value_to_ref_param.hsp
/**
変数引数に値を渡す

リテラルのポインタを得る関数があればコピーなしで運べるのに。
//*/

#module
// 文字列への参照を作る関数
#define global ctype ref_xs(%1) \
	%t__ref %i0 \
	%p@__ref(ref_xs_@__ref(%1, %p@__ref)) \
	%o0

#defcfunc ref_xs_@__ref str value, array ref_med
	ref_med = value //moveしたいところ
	return 0
#global

//例

	//x = strtrim(" hello world! ") //NG

	x = strtrim(ref_xs(" hello world! "))
	mes "{" + x + "}"
	//=> "{hello world!}"

## remove_by_using_can_unify.prolog
/**
(蛇足) can_unify/2を使って、定義3のremoveを定義1,2とよく似た形で定義する。

元：「remove 述語の定義―リスト[a:1, a:2]から「a:_」をすべて取り除いた結果は？」(http://codetter.com/?p=1077)
特にメリットはない。
//*/

% can_unify/2
% 「can_unify(X, Y) が成功する」⇔「X = Y が成功する」、ただし単一化は行われない。
can_unify(X, Y) :-
	setof(Z, (Z = X, X = Y), [_|_]).

?- can_unify(a:_, a:1).
?- \+ can_unify(b:_, a:_).

remove(_, [], []).
remove(E, [H|Src], Dst ) :- can_unify(E, H), !, remove(E, Src, Dst).
remove(E, [H|Src], [H|Dst]) :- remove(E, Src, Dst).

?- remove(a:_, [a:1, a:1, a:2, b:2], [b:2]).

## remove_pair_with_wildcard.prolog
/**
remove 述語の定義―リスト[a:1, a:2]から[a:_ をすべて取り除いた結果は？

リストからある値の要素をすべて除去する述語 removeを使って、
[a:1, a:1, a:2, b:2] から「a:_」を取り除く場合。
定義1、定義2 では a:2 が残る。(a:1 を除去する段階で _ が 1 に単一化されるため)
定義3 なら a:1, a:2 が両方消える。
//*/

% テストデータ
ls([a:1, a:1, a:2, b:2]).

% 定義1 - 等号の失敗を使って排除
remove_v1(_, [], []).
remove_v1(E, [E|L1], L2 ) :- remove_v1(E, L1, L2).
remove_v1(E, [H|L1], [H|L2]) :- \+(E = H), remove_v1(E, L1, L2).

?- ls(Src), setof(L, remove_v1(a:_, Src, L), [[a:2, b:2]]).

% 定義2 - 単一化の失敗とカットを使って排除
remove_v2(_, [], []).
remove_v2(E, [E|L1], L2) :- !, remove_v2(E, L1, L2).
remove_v2(E, [H|L1], [H|L2]) :- remove_v2(E, L1, L2).

?- ls(Src), setof(L, remove_v2(a:_, Src, L), [[a:2, b:2]]).

% 定義3 - 「単一化できない要素」全体を求める
remove_v3(Val, Ls, Rs) :-
	findall(E, (member(E, Ls), E \= Val), Rs).

?- ls(Src), setof(L, remove_v3(a:_, Src, L), [[b:2]]).

## run_alone.hsp
/**
単独実行モジュール

外部ファイルが必要な命令 (bload, noteload, picload, celload) を置換して
テキトーな処理に置き換えてしまうモジュール。ただしサイズは指定する必要あり。
それと noteload の対象バッファを取得するために黒魔術を使っている。notesel/noteunsel も置換した方がよかったかも。
//*/

// 単独実行モジュール

#ifndef IG_RUN_ALONE_AS
#define IG_RUN_ALONE_AS

#undef bload
#undef noteload
#undef picload
#undef celload

#define bload(%1 = "", %2, %3, %4 = 0) bload_impl %1, %2, %3, %4, __HERE__@RunAlone
#define noteload(%1 = "", %2, %3 = "") noteload_impl %1, %2, %3, __HERE__@RunAlone
#define picload(%1 = "", %2 = 0, %3 = -1, %4 = -1) picload_impl %1, %2, %3, %4, __HERE__@RunAlone
#define celload(%1 = "", %2 = -1, %3 = 0) celload_impl %1, %2, %3, %4, __HERE__@RunAlone

#module RunAlone

#define error(%1, %2 = _here) dialog %1 + "\n" + (%2), 1, "RunAlone" : assert
#define ctype RGB(%1,%2,%3) (((%1) & 0xFF) | ((%2) & 0xFF) << 8 | ((%3) & 0xFF) << 16)
#define ctype random_cref RGB(rnd(256), rnd(256), rnd(256))
#define __HERE__ (__FILE__ + " (#" + __LINE__ + ")")
dim ctx@exporter	// 警告抑制

// bload
// 前から順に 1, 2, 3, ..., 255, 1, ... と並んでいることにする
#deffunc bload_impl str fname, var buf, int size, int offset, str _here
	if ( size < 0 ) { error "bload にサイズを指定してください。" }
	if ( vartype(buf) == 2 ) { memexpand buf, size }
	repeat size
		poke buf, cnt, (offset + cnt) \ 255 + 1
	loop
	_strsize@exporter = size
	return

// noteload
// 各行に (行番号 + 1) * "X" を書き込む (謎)。
// @ 対象バッファを操作するために exporter を用いている。
#deffunc noteload_impl str fname, int _size, str dummy, str _here, local size, local buf, local pval, local data, local n, local k
	if ( dummy != "" ) {
		data = dummy
		if ( _size > 0 ) { data = strmid(data, 0, _size) }
	} else {
		if ( size < 0 ) { error "noteload にサイズ上限を指定してください。" }
		sdim data, _size + 1
		repeat , 1
			if ( n + cnt + 2 > _size ) { break }
			for k, 0, cnt : poke data, n + k, 'X' : next
			wpoke data, n + cnt, 0x0A0D
			n += cnt + 2
		loop
	}
	_strsize@exporter = strlen(data)
	AssignToPVal@exporter ctx@exporter(202), varptr(data), ctx@exporter(203)
	return

#deffunc picload_impl str fname, int mode, int cx, int cy, str _here
	if ( cx < 0 || cy < 0 ) { error "picload/celload には追加パラメータで画像サイズを与える必要があります。" }
	if ( mode == 0 || mode == 2 ) {
		width cx, cy : pos 0, 0
		if ( mode == 2 ) { gradf 0, 0, ginfo_winx, ginfo_winy, 0, 0, 0 }
	}
	gradf@hsp ginfo_cx, ginfo_cy, cx, cy, rnd(2), random_cref(), random_cref()
	return

#deffunc celload_impl str fname, int _id, int mode, int cx, int cy, str _here, local id, local id_bak
	id_bak = ginfo_sel
	if ( _id < 0 ) {
		buffer ginfo_newid, cx, cy, mode
		id = ginfo_sel
	} else {
		id = _id
		gsel id
	}
	picload_impl fname, 1, cx, cy, _here
	gsel id_bak
	return id

#global

#module exporter
// small

#deffunc local _init
	mref ctx, 68
	dupptr exinfo, ctx(219), 49 * 4
	dupptr _strsize, exinfo(8), 4
	return

#deffunc AssignToPVal@exporter int ppval, int ptr, int aptr, local pval, local hvp, local prm
	dupptr pval, ppval, 48
	prm = pval(0) & 0xFFFF
	dupptr hvp, callfunc( prm, exinfo(25), 1 ), 35 * 4
	pval(10) = aptr
	prm = ppval
	prm(1) = callfunc( prm, hvp(7), 1 )
	prm(2) = ptr
	return callfunc( prm, hvp(18), 3 )
#global

_init@exporter
randomize 256

#endif

## struct_seti_doesnt_invoke_dtor.hsp
/**
struct型変数への代入(HspVarStruct_Set)はメモリ解放のみ行いデストラクタを呼ばない

(2015/2/4 0:44)
HSP3.4
//*/

#module foo n_
#modinit int n
	n_ = n
	mes "init #" + n_
	return
#modterm
	mes "term #" + n_
	return
#global

newmod obj1, foo, 1
newmod obj2, foo, 2
obj1 = obj2 // obj1のインスタンスfoo{1}が破棄されるがmodtermが呼ばれない

// kill all
dim obj1
dim obj2

## subroutine_maze.hsp
/**
サブルーチン迷路

思考があらぬ方向に行って思いついた謎コード
//*/

	randomize
	lb  = *LBottom, *lb1, *lb2, *lb3, *lb4
	msg = "bottom", "*1", "*2", "*3", "*4"
	cntPtns = length(lb)

	goto *LStepMaze		// Enter Maze

*lb1
	mes msg(1) : gosub *LStepMaze : return
*lb2
	mes msg(2) : gosub *LStepMaze : return
*lb3
	mes msg(3) : gosub *LStepMaze : return
*lb4
	mes msg(4) : gosub *LStepMaze : return

*LBottom
	mes msg(0)
	assert		// 停止
	return

*LStepMaze
	wait 10		// wait 必須 : 停止しない可能性もなくはない
	goto lb( (rnd(12) + 1) * 13 \ cntPtns )

// @ 参照: http://goo.gl/xUPHk
// @ 「リターン先が静的にわからない」状況を簡単に考えようと思った。今は反省している。
// @ よく考えたら、リターン先は普通わからないものだった。サブルーチンと呼び出し元は一般的に一体一対応じゃないのだ。

// mes で出力された文字列を見ると戻り先がわかる。
// @ これは「サブルーチンを監視する」方法の一例
	/**
	文字列リテラルへのポインタを得るコマンド

	書いてから思ったけど、HSP自体がリソースのために持っているバッファ(DS)へのポインタを返すので、リテラルが書き換え可能になっちゃうっていう。……まぁそこらへんはいいか。
	実数値リテラルもいけるけど、整数はCodeSegmentに直書きだからそれ自体へのポインタは無理で、どこかにコピーを書いて取る必要がある。面倒くさい。
	実際に使用するときは #define global constptr __constptr \|\| というマクロを用いる。いちいち括弧をつけなくていいので記述が楽。
	//*/

	// constptr \|\| CONST_VALUE
	int constptr( void** ppResult ) // この返値が type_res に、ppResult の値が reffunc の返値になるとする
	{
	if ( *exinfo->npexflg & (EXFLG_1 \| EXFLG_2) ) puterror( HSPERR_SYNTAX );
	static int stt_result;
	switch ( *type ) {
	case TYPE_STRING:
	case TYPE_DNUM:
	stt_result = reinterpret_cast<int>( &ctx->mem_mds[*val] );
	*ppResult = &stt_result;
	break;
	case TYPE_INUM:
	puterror( HSPERR_UNSUPPORTED_FUNCTION ); // CS中に埋め込まれているのでとれない
	default:
	puterror( HSPERR_SYNTAX );
	}
	code_next();
	if ( !(type == TYPE_MARK && val == 6) ) puterror( HSPERR_SYNTAX ); // or(\|\|)
	code_next();
	return HSPVAR_FLAG_INT;
	}
	/*
	21世紀における0～3の数字を2個ずつ使ってできる年月日の個数

	【出典】https://twitter.com/c_oi/status/301346035094126593 https://twitter.com/c_oi/status/301346039590436864
	【引用】「0～3の数字を2個ずつ使ってできる年月日は21世紀(2001/01/01～2100/12/31)の間に何日間あるでしょう？」
	//*/

	remove1(E, [E\|Tail], Tail).
	remove1(E, [X\|Tail], [X\|List]) :- remove1(E, Tail, List).

	permutation([], []).
	permutation(List, [H\|Tail]) :- remove1(H, List, List1), permutation(List1, Tail).

	条件(L) :-
	permutation([0,0,1,1,2,2,3,3], L),
	L = [Y1, Y2, Y3, Y4, M1, M2, D1, D2],
	Y is (Y1 * 1000 + Y2 * 100 + Y3 * 10 + Y4),
	M is (M1 * 10 + M2),
	D is (D1 * 10 + D2),
	年の条件(Y),
	月日の条件(Y, M, D).

	年の条件(Y) :- 2001 =< Y, Y =< 2100.
	月日の条件(Y, M, D) :-
	月の日数(Y, M, Days),
	1 =< M, M =< 12,
	1 =< D, D =< Days.

	月の日数(_, 1, 31).
	月の日数(Y, 2, 29) :- 閏年(Y), !.
	月の日数(Y, 2, 28).
	月の日数(_, 3, 31).
	月の日数(_, 4, 31).
	月の日数(_, 5, 31).
	月の日数(_, 6, 30).
	月の日数(_, 7, 31).
	月の日数(_, 8, 31).
	月の日数(_, 9, 30).
	月の日数(_, 10, 31).
	月の日数(_, 11, 30).
	月の日数(_, 12, 31).

	閏年(Y) :- Y mod 4 == 0, (Y mod 100 \== 0 ; Y mod 400 == 0).

	?- setof(L, 条件(L), Ls), length(Ls, N).
	% N = 48
	/*
	21世紀における0～3の数字を2個ずつ使ってできる年月日の個数 (「禁則」によって表現するバージョン)

	【前回】http://codetter.com/?p=898
	【着想】http://nojiriko.asia/prolog/twitter_by_c_oi_20130213.html
	(https://twitter.com/TakaoOzaki/status/301562885103026176)
	【前回】と【着想】を混ぜて、いくらか書き加えたもの。
	量化命題の自動証明を行う。
	//*/

	順列(Y,0,[]).
	順列(Y,N,[A\|X]) :- del(A,Y,Z), M is N - 1, 順列(Z,M,X).
	del(A,[A\|X],X).
	del(A,[B\|X],[B\|Y]) :- del(A,X,Y).

	小の月(2).
	小の月(4).
	小の月(6).
	小の月(9).
	小の月(11).
	% 小の月(M) :- 月の日数(M, Days), Days < 31.

	'「禁則」の簡略化のために利用する諸命題' :-
	'閏年か否かは考慮しなくてよい',
	'2月以外の小の月の存在は考慮しなくてよい',
	'0月、14～19月および40月以上の年月日ならびは発生しない',
	'0日および34日以上の年月日ならびは発生しない'.

	'閏年か否かは考慮しなくてよい' :-
	% ∀ L [ L : '順列と21世紀の条件'を満たす ⇒ L : 2月29日を表す年月日並びではない ]
	% ⇔ ￢∃ L [ L : '順列と21世紀の条件'を満たす ∧ L : 2月29日を表す年月日並びである ]
	\+ 順列と21世紀の条件([_,_,_,_, 0,2, 2,9]).

	'2月以外の小の月の存在は考慮しなくてよい' :-
	% 小の月：31日の存在しない月
	\+ (
	順列と21世紀の条件([_,_,_,_, M1,M2, 3,1]),
	M is (M1 * 10 + M2), '2月以外の小の月'(M)
	).

	'2月以外の小の月'(M) :- M \== 2, 小の月(M).

	'0月、14～19月および40月以上の年月日ならびは発生しない' :-
	% 0月が発生しないのは、21世紀だから、年が0を少なくとも1つ使うため
	\+ (
	順列と21世紀の条件([_,_,_,_, M1,M2, _,_]),
	M is (M1 * 10 + M2),
	( M == 0 ; (14 =< M, M =< 19) ; M >= 40 ) % まとめた
	).

	'0日および34日以上の年月日ならびは発生しない' :-
	\+ (
	順列と21世紀の条件([_,_,_,_, _,_, D1,D2]),
	D is D1 * 10 + D2,
	( D == 0 ; D >= 34 )
	).

	順列と21世紀の条件(L) :-
	順列([0,0,1,1,2,2,3,3], 8, L), % 「0～3の数字を2個ずつ使ってできる」こと
	[2,0,0,1, 0,1, 0,1] @=< L, % 「21世紀」であること
	L @=< [2,1,0,0, 1,2, 3,1].

	禁則([_,_,_,_, 0,2, 3,_]) :- !.
	禁則([_,_,_,_, 1,3, _,_]) :- !.
	禁則([_,_,_,_, 2,_, _,_]) :- !.
	禁則([_,_,_,_, 3,_, _,_]) :- !.
	禁則([_,_,_,_, _,_, 3,2]) :- !.
	禁則([_,_,_,_, _,_, 3,3]) :- !.

	条件(L) :-
	% L = [Y1,Y2,Y3,Y4, M1,M2, D1,D2],
	順列と21世紀の条件(L),
	\+ 禁則(L). % 「年月日ならび」であるための条件 ('順列と21世紀の条件'と併せて)

	?- '「禁則」の簡略化のために利用する諸命題',
	setof(L, 条件(L), Ls), length(Ls, N).
	% N = 48

	/*
	備考：全称命題の証明は面倒くさいので、二重否定を使って“存在の否定”命題に変形した。
	'∀x p(x)' :- setof(x, p(x), (x の全体集合を表す整列されたリスト)).
	% :- setof(x, x ∈ 全体集合, (x の全体集合を表す整列されたリスト)).
	*/
	/**
	dupptr 失敗

	(2013/5/20 21:44)
	//*/

	#module
	#defcfunc sizeOfType int vt
	assert (1 <= vt && vt <= 4) // ← コメントアウトするとエラーにならない
	return 4
	#global

	v = 1
	dupptr r, varptr(v), sizeOfType(vartype(v))
	// r が正常に作成されない
	mes r //→ システムエラー(1)
	/**
	[Prolog]各部分の和が等しいように輪を分割するパズル

	元ネタ：https://twitter.com/puzzlegiver_bot/status/217544145630281729
	ただし、解はアルファベットではなく、与えたリストの中での位置を返す。
	//*/

	append([], List, List).
	append([Head\|Tail], List, [Head\|TailR]) :- append(Tail, List, TailR).

	部分リスト(List, (I, I), []).
	部分リスト(List, (0, End), SubList) :-
	number(End), End > 0, 部分リスト_(List, End, SubList).
	部分リスト([Head\|Tail], (Bgn, End), SubList) :-
	number(Bgn), Bgn > 0, Bgn1 is Bgn - 1,
	number(End), End > 0, End1 is End - 1,
	部分リスト(Tail, (Bgn1, End1), SubList).
	部分リスト_(_, 0, []).
	部分リスト_([Head\|Tail], Cnt, [Head\|TailAcc]) :-
	Cnt > 0, Cnt1 is Cnt - 1, 部分リスト_(Tail, Cnt1, TailAcc).

	整数閉区間(L, L, R) :- L =< R.
	整数閉区間(N, L, R) :- L =< R, L1 is L + 1, 整数閉区間(N, L1, R).

	和([Head\|Tail], Sum) :- 和_acc(Tail, Sum, Head).
	和_acc([], Sum, SumAcc) :- Sum is SumAcc.
	和_acc([Head\|Tail], Sum, SumAcc) :- 和_acc(Tail, Sum, Head + SumAcc).

	弧(List, (I, I), []).
	弧(List, (0, End), Arc) :- 部分リスト(List, (0, End), Arc).
	弧(List, (Bgn, 0), Arc) :- length(List, N), 部分リスト(List, (Bgn, N), Arc).
	弧(List, (Bgn_, End_), Arc) :-
	number(Bgn_), number(End_), Bgn_ =\= 0, End_ =\= 0,
	length(List, N),
	Bgn is ((Bgn_ mod N) + N) mod N, % 非負最小剰余
	End is ((End_ mod N) + N) mod N,
	( Bgn < End
	-> 部分リスト(List, (Bgn, End), Arc)
	; 弧(List, (Bgn, 0), ArcLead), 部分リスト(List, (0, End), ArcTrail),
	append(ArcLead, ArcTrail, Arc)
	).

	輪の等和分割(List, [X\|Answer], Div) :-
	和(List, ListSum), ArcSum is ListSum / Div,
	length(List, N),
	整数閉区間(X, 0, N), % 第一の切断点(の右)
	輪の等和分割(List, [X\|Cut], Div, ArcSum, N, N),
	append(Answer, [X], Cut).

	輪の等和分割(_, [_], 0, _, _, 0).
	輪の等和分割(List, [Bgn, End\|Cut], Div, Sum, LenFull, LenRemain) :-
	整数閉区間(Len, 1, LenRemain), End is (Bgn + Len) mod LenFull,
	弧(List, (Bgn, End), Arc),
	和(Arc, Sum),
	Div1 is Div - 1, LenRemain1 is LenRemain - Len,
	輪の等和分割(List, [End\|Cut], Div1, Sum, LenFull, LenRemain1).

	% 例題
	?- 輪の等和分割( [1, 12, 5, 8, 10, 3, 11, 9, 6, 7, 4, 2], Answer, 3 ).
	/*
	Answer = [2,6,9]. % つまり 5, 11, 7 の左側 B, F, I で切断する
	*/

	% ---------------------
	% おまけ：特殊バージョン (3分割、数値に重複がないことが条件)
	between(L, L, R) :- L < R.
	between(N, L, R) :- L < R, L1 is L + 1, between(N, L1, R).

	隣接(1, 12). 隣接(12, 5). 隣接(5, 8). 隣接(8, 10). 隣接(10, 3). 隣接(3, 11).
	隣接(11, 9). 隣接(9, 6). 隣接(6, 7). 隣接(7, 4). 隣接(4, 2). 隣接(2, 1).

	区間(X, R) :- 隣接(X, R) ; (X \== R, 隣接(R1, R), 区間(X, R1)).

	弧和(X, R, Sum) :- 区間(X, R), 弧和_acc(X, R, Sum, 0).
	弧和_acc(X, X, Sum, SumAcc) :- !, Sum is SumAcc.
	弧和_acc(X, R, Sum, SumAcc) :- 隣接(X, X1), 弧和_acc(X1, R, Sum, SumAcc + X).

	３分割( [X, Y, Z], Sum ) :-
	between(X, 1, 13),
	弧和(X, Y, Sum), 弧和(Y, Z, Sum), 弧和(Z, X, Sum).

	?- Sum is ((12*(12 + 1))/2) / 3, ３分割(A, Sum).
	% A = [5,11,7] % B, F, I
	/**
	非決定性の述語単位行列/2 (「添字」を用いるバージョン)

	【目標】述語単位行列/2 を“うまく”定義する。
	【出典】http://codetter.com/?p=902
	「添字」を考えて、単位行列 E_n := [ δ_i,j ]_n×n として定義する。
	数値を用いると is によって双方向性を失ってしまうので、ペアノ自然数 s(N) を用いる。
	ペアノ自然数と数値を相互に単一化させる述語 natural/2 に、めんどくさい条件分岐を押し付けることで、定義を簡潔にする試み。
	//*/

	natural(0).
	natural(s(N)) :- natural(N).

	natural(0, 0).
	natural(s(N), X) :- number(X), !, X > 0, X1 is X - 1, natural(N, X1). % N によって変項 X を単一化させる場合
	natural(s(N), X) :- var(X), !, integer_itetate(X, 1), natural(s(N), X). % 両方変項の場合
	natural(s(N), X) :- natural_acc(N, X, 1), !. % X によって変項 N を単一化させる場合
	natural_acc(0, X, X).
	natural_acc(s(N), X, Acc) :- Acc1 is Acc + 1, natural_acc(N, X, Acc1).

	integer_itetate(X, X).
	integer_itetate(X, L) :- L1 is L + 1, integer_itetate(X, L1).

	mylength_n([], 0).
	mylength_n([Head\|Tail], s(N)) :- mylength_n(Tail, N).

	at_n([Val\|_], 0, Val).
	at_n([_\|List], s(N), Val) :- at_n(List, N, Val).

	insertAt_n(List, 0, Val, [Val\|List]).
	insertAt_n([X\|List], s(N), Val, [X\|Tail]) :- insertAt_n(List, N, Val, Tail).

	零リスト([]).
	零リスト([0\|T]) :- 零リスト(T).

	単位行列_n(0, []).
	単位行列_n(s(N), LL) :- 単位行列_n(s(N), LL, 0). % 行番号によってループする

	単位行列_n(N, [], N).
	単位行列_n(N, [Row\|RowT], M) :-
	mylength_n(Row, N), insertAt_n(RowRems, M, 1, Row), 零リスト(RowRems),
	単位行列_n(N, RowT, s(M)).

	単位行列(X, LL) :- natural(N, X), 単位行列_n(N, LL). % インターフェイス

	?- 単位行列(2, [[1, 0], [0, 1]]). %=> yes
	?- 単位行列(N, [[1, 0], [0, 1]]). %=> N = 2 ; ... (無限ループに陥る)
	?- 単位行列(2, LL). %=> LL = [[1,0],[0,1]] ; no
	?- 単位行列(N, LL). %=> N = 0, 1, 2, ... と順次成功する
	/**
	非決定性の述語単位行列/2

	【出典】https://twitter.com/TakaoOzaki/status/306175708726706177
	【要約】述語単位行列/2 を“うまく”定義する。
	単位行列 E_n := [ δ_i,j ]_n×n からの連想として「添字」を用いる実装をすると、双方向性を保つのがめんどくさい
	(組み込み述語 var による条件分岐がどうしても必要になる気がする)。
	//*/

	mylength([], 0).
	mylength([_\|T], N) :- mylength(T, N1), N is N1 + 1.

	零リスト([]).
	零リスト([0\|T]) :- 零リスト(T).

	単位行列(N, LL) :- mylength(LL, N), 単位行列_(N, LL).
	単位行列_(0, []).
	単位行列_(N, [[1\|RowT]\|T]) :-
	% number(N), N > 0,
	N1 is N - 1, mylength(RowT, N1), !, % important!
	行列の左に列ベクトルを加える(T1, ClmT, T),
	零リスト(RowT), 零リスト(ClmT),
	単位行列_(N1, T1).

	行列の左に列ベクトルを加える([], [], []).
	行列の左に列ベクトルを加える([T\|LL1], [H\|V], [[H\|T]\|LL]) :-
	行列の左に列ベクトルを加える(LL1, V, LL).

	?- 単位行列(2, [[1, 0], [0, 1]]).
	/*
	yes
	*/

	?- 単位行列(N, [[1, 0], [0, 1]]).
	/*
	N = 2 ;
	no
	*/

	% うまく定義しないと no が返らず無限ループに陥ることも。

	?- 単位行列(2, LL).
	/*
	LL = [[1, 0], [0, 1]] ;
	... (無限ループに陥る)
	*/

	% no を返してほしいところだが、次の結果を得るためにはこの挙動にならざるをえない？

	?- 単位行列(N, LL).
	/*
	N = 0, LL = [] ;
	N = 1, LL = [[1, 0], [0, 1]] ;
	N = 2, LL = [[1, 0, 0], [0, 1, 0], [0, 0, 1]] ;
	N = 3, LL = [[1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]] ;
	... (各Nについて無限に成功する)
	*/

	% うまく定義しないと N = 0, 1 だけで終わってしまうことも。
	/**
	ifブロックのコンパイルエラー例2つ

	HSP3.4
	//*/

	// 例1
	// '}'が内側のifに対応すると判断される。
	// '}' の前に改行があると問題なし
	if 1 { if 1 : mes "a" : else : mes "b" } mes "c"

	// 例2
	// else の検出に失敗する。
	if 1 { mes "a" } : else

	// ちなみにこういうのはok
	if 1 : { mes "a" } else
	if 1 : *label { mes "a" } else
	/**
	[Prolog]十字型にライトをスイッチしてすべてのライトを点けるパズル

	【ライツアウト2】https://twitter.com/puzzlegiver_bot/status/277035208719609856
	ルール：
	・ライトを on/off して、すべてのライトを点灯させる。
	・ただし、on/off することを選んだライトの上下左右4つのライトも同時に on/off する。
	参考：http://t.co/7YyBQOQ9 お気楽 Prolog プログラミング入門 / 反復深化
	//*/

	% 0 = 点灯(on), 1 = 消灯(off)とする。
	% 解答として、すべて点灯させるためにスイッチすべきライトの成分のリストを返す。

	% リスト・行列に関する諸述語
	append( [], List, List ).
	append( [Head\|Tail], List, [Head\|TailR] ) :- append(Tail, List, TailR).

	at( [Head\|Tail], 0, Head ).
	at( [Head\|Tail], Idx, Val ) :- number(Idx), Idx > 0, Idx1 is Idx - 1, at( Tail, Idx1, Val ).

	at( [Head\|Tail], (0, Y), Val ) :- at(Head, Y, Val).
	at( [Head\|Tail], (X, Y), Val ) :- X > 0, X1 is X - 1, at( Tail, (X1, Y), Val ).

	reverse( [], [] ).
	reverse( [Head\|Tail], Reversed ) :- reverse( Tail, Remains ), append( Remains, [Head], Reversed ).

	zero_list([]).
	zero_list([0\|Tail]) :- zero_list(Tail).
	zero_matrix([]).
	zero_matrix([Head\|Tail]) :- zero_list(Head), zero_matrix(Tail).

	between(L, L, R) :- L < R.
	between(N, L, R) :- L < R, L1 is L + 1, between(N, L1, R).

	% マンハッタン距離
	abs( X, A ) :- number(X), X >= 0 -> A is X ; A is -X.
	manhattan_distance( (Ax, Ay), (Bx, By), D ) :-
	X is Ax - Bx, abs( X, Dx ),
	Y is Ay - By, abs( Y, Dy ),
	D is Dx + Dy.

	% 成分の順序 (辞書式順序)
	positionLess( (X1, _), (X2, _) ) :- X1 < X2.
	positionLess( (X, Y1), (X, Y2) ) :- Y1 < Y2.

	% パズル
	light_switch_pazzle( Q, A ) :- light_switch_pazzle( Q, A, (0, 1000) ). % 省略引数
	light_switch_pazzle( Q, A, (MinLv, MaxLv) ) :-
	length(Q, M), Q = [QHead\|_], length(QHead, N),
	between(Limit, MinLv, MaxLv), % 反復深化
	% write(Limit), nl,
	light_switch_pazzle_acc( (0, Limit), Q, (M, N), ARev, [] ),
	reverse(ARev, A).

	light_switch_pazzle_acc( (Limit, Limit), Board, _, Path, Path ) :-
	zero_matrix(Board).
	light_switch_pazzle_acc( (Lv, Limit), Board1, (M, N), A, Path ) :-
	Lv < Limit, Lv1 is Lv + 1,
	between(X, 0, M),
	between(Y, 0, N),
	( Path = [] ; Path = [PrevPath\|_], positionLess( PrevPath, (X, Y) ) ), % 順番違いの解を排除 (成分列を単調増加に限定する)
	light_switch( Board1, Board2, (X, Y) ),
	light_switch_pazzle_acc( (Lv1, Limit), Board2, (M, N), A, [(X, Y)\|Path] ).

	% 成分(X, Y)および上下左右(マンハッタン距離1以下)がスイッチした行列
	light_switch( Board1, Board2, (X, Y) ) :-
	light_switch_matrix_( Board1, Board2, (X, Y), (0, 0) ).

	light_switch_matrix_( [], [], _, _ ).
	light_switch_matrix_( [Head1\|Tail1], [Head2\|Tail2], Point, (X, 0) ) :-
	light_switch_list_( Head1, Head2, Point, (X, 0) ),
	X1 is X + 1,
	light_switch_matrix_( Tail1, Tail2, Point, (X1, 0) ).

	light_switch_list_( [], [], _, _ ).
	light_switch_list_( [Head1\|Tail1], [Head2\|Tail2], Point, (X, Y) ) :-
	manhattan_distance( Point, (X, Y), D ),
	( D =< 1 -> Head2 is (1 - Head1); Head1 = Head2 ),
	Y1 is Y + 1,
	light_switch_list_( Tail1, Tail2, Point, (X, Y1) ).

	% 例題
	% 問題文で「最短4手」と明言されているので、実際は4手の解を探すだけで十分。
	?- light_switch_pazzle( [
	[ 1, 0, 1, 1 ],
	[ 0, 0, 1, 0 ],
	[ 1, 1, 0, 1 ],
	[ 1, 0, 1, 1 ] ], Answer ).
	/*
	Answer:
	[(0,0),(0,2),(2,0),(3,3)] % 最短
	[(0,0),(0,3),(1,1),(2,1),(2,3),(3,1)]
	[(0,0),(1,1),(1,2),(1,3),(3,0),(3,2)]
	[(0,1),(1,1),(1,3),(2,0),(2,2),(2,3)]
	[(0,2),(1,0),(1,1),(2,2),(3,1),(3,2)]
	[(0,0),(0,1),(0,3),(1,0),(1,2),(2,1),(3,0),(3,3)]
	[(0,0),(0,1),(1,0),(1,3),(2,3),(3,1),(3,2),(3,3)]
	[(0,1),(0,2),(0,3),(1,3),(2,1),(2,2),(3,1),(3,3)]
	[(0,1),(0,2),(1,2),(2,2),(2,3),(3,0),(3,2),(3,3)]
	[(0,3),(1,0),(2,0),(2,1),(2,2),(2,3),(3,2),(3,3)]
	[(1,0),(1,2),(1,3),(2,0),(2,2),(3,0),(3,1),(3,3)]
	...
	*/
	/**
	[Prolog]論理パズル/条件から住人と部屋の位置を推定する問題

	【論理パズル4】http://twitter.com/puzzlegiver_bot/status/274468300510089216
	ベタ書き。部屋は行列にした方が「右側」などを綺麗に実装できる。
	//*/

	:- op(700, xfx, ∈).
	∈(X, Y) :- contains(Y, X).

	contains([Val\|_], Val).
	contains([_\|Tail], Val) :- contains(Tail, Val).

	部分集合([], _).
	部分集合([E\|L], R) :- E ∈ R, 部分集合(L, R).
	集合同値(L, R) :- 部分集合(L, R), 部分集合(R, L).

	階層(Room, 0) :- Room ∈ [g, h, i].
	階層(Room, 1) :- Room ∈ [d, e, f].
	階層(Room, 2) :- Room ∈ [a, b, c].
	右隣(a, b). 右隣(b, c).
	右隣(d, e). 右隣(e, f).
	右隣(g, h). 右隣(h, i).
	左隣(L, R) :- 右隣(R, L).
	隣(X, Y) :- 右隣(X, Y) ; 左隣(X, Y).
	右側(X, Y) :- X ∈ [a, d, g], Y ∈ [b, c, e, f, h, i].
	右側(X, Y) :- X ∈ [b, e, h], Y ∈ [c, f, i].
	左側(X, Y) :- 右側(Y, X).
	真下(a, d). 真下(b, e). 真下(c, f).
	真下(d, g). 真下(e, h). 真下(f, i).
	真上(D, U) :- 真下(U, D).
	上階(X, Y) :- 階層(X, XRank), 階層(Y, YRank), XRank > YRank.

	?- A = [Akamatsu, Aoki, Kihara, Shirasawa, Kuroi, Haitani, Kaneco, Nobody0, Nobody1],
	右側(Haitani, Kuroi),
	上階(Kihara, Aoki),
	左隣(Akamatsu, _), 右隣(Akamatsu, _),
	左側(Kaneco, Aoki),
	隣(Kihara, Shirasawa),
	階層(Haitani, 2),
	隣(Kuroi, X1),
	隣(Akamatsu, X2),
	真上(Kaneco, X3),
	集合同値([X1, X2, X3], [Nobody0, Nobody1]),
	\+(真上(Aoki, Shirasawa)),
	\+(真下(Kihara, Akamatsu)),
	\+(隣(Kaneco, Shirasawa)),
	\+(隣(Haitani, Shirasawa)),
	集合同値(A, [a, b, c, d, e, f, g, h, i]).
	/*

	A:
	[h,d,b,c,e,a,i, g,f]
	[h,d,b,c,e,a,i, f,g]
	[h,d,b,c,e,a,i, g,f]
	[h,d,b,c,e,a,i, f,g]

	すなわち
	A: ハイタニ, B: キハラ, C: シラサワ,
	D: アオキ, E: クロイ, F: (空),
	G: (空), H: アカマツ, I: カネコ,
	*/