pazzleのタグがつけられたコード一覧

TEXT [Prolog]魔法陣 (入る値が与えられている場合)

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秒)
*/

TEXT [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)]
...
*/

よく投稿されているコード

タグ

最近投稿されたコード