リンク先パズル問題を解くコード
http://quiz-tairiku.com/q.cgi?mode=view&no=17217
まずありえる配分結果全てのリストを求め、次に全員のありえるランクを仮に決めてこのランクが証言と矛盾してないか調べます。
ランクに合わせて得点を配分しこの結果が全員の証言と矛盾してないものをゴール成功とします。
薄田さんの証言を使ってもっと計算量を抑えられますが記述が難しそうなので手抜き実装となりました。


selects([],_):-!.
selects([X|Rest],Perm):-select(X,Perm,Rest1),selects(Rest,Rest1).

rank_check(_,R12,_  ,R14,R15,_,
   _,R22,R23,R24,_,R26):-
R12<R22,
R14>R24,
R15<6,
R26<R23.
quick([X | Xs], Ys) :-
       mypartition(Xs, X, Littles, Bigs),
       quick(Littles, Ls),
       quick(Bigs, Bs),
       append(Ls, [X | Bs], Ys).
quick([], []).
mypartition([X | Xs], Y, [X | Ls], Bs) :-
       X =< Y, mypartition(Xs, Y, Ls, Bs).
mypartition([X | Xs], Y, Ls, [X | Bs]) :-
       X > Y, mypartition(Xs, Y, Ls, Bs).
mypartition([], _, [], []).

create_score_perm(5,Rest,Down,Result,[Rest|Result]):-
!,Down<Rest.
create_score_perm(N,Rest,Down,Perm,Result):-
N<5,
Down1 is Down+1,
Rest1 is Rest-1,
N1 is N+1,
between(Down1,Rest1,C1),
NextRest is Rest-C1,
create_score_perm(N1,NextRest,C1,[C1|Perm],Result).

set_max(S3,SMax,_,MaxName,SMax,MaxName):-S3<SMax.
set_max(S3,SMax,Name,_,S3,Name):-S3>SMax.
set_max(S3,SMax,_,_,S3,Result):-S3=:=SMax,Result=dammy.

check_matuo([],_,_,_,Max,Max):-!.
check_matuo([[Rank1,Name]|Ranks1],Ranks2,Scores1,Scores2,[SMax,MaxName],Result):-
member([Rank2,Name],Ranks2),
nth0(Rank1,Scores1,S1),
nth0(Rank2,Scores2,S2),
S3 is S1+S2,
set_max(S3,SMax,Name,MaxName,S4,MaxName4),
check_matuo(Ranks1,Ranks2,Scores1,Scores2,[S4,MaxName4],Result).

check_sakuraba(Ranks1,Ranks2,Scores1,Scores2):-
member([Rank1,sakuraba],Ranks1),
member([Rank2,sakuraba],Ranks2),
nth0(Rank1,Scores1,S1),
nth0(Rank2,Scores2,S1).
check_kabata([],_,_,_,[]):-!.
check_kabata([[Rank1,Name]|Ranks1],Ranks2,Scores1,Scores2,[S3|Result]):-
member([Rank2,Name],Ranks2),
nth0(Rank1,Scores1,S1),
nth0(Rank2,Scores2,S2),
S3 is S1+S2,
check_kabata(Ranks1,Ranks2,Scores1,Scores2,Result).

check_kabata2([S1,S1,S1,S1|_]):-!.
check_kabata2([_|Rest]):-check_kabata2(Rest).

check_yanagihara(Ranks1,Ranks2,Scores1,Scores2):-
member([Rank1,yanagihara],Ranks1),
member([Rank2,yanagihara],Ranks2),
nth0(Rank1,Scores1,S1),
	nth0(Rank2,Scores2,S1).
check_kiryuu(_,Ranks2,_,Scores2):-
member([Rank2,kiryuu],Ranks2),
nth0(Rank2,Scores2,1).




checks(Ranks1,Ranks2,Scores1,Scores2):-
check_matuo(Ranks1,Ranks2,Scores1,Scores2,[0,dammy],[_,Name0]),
Name0=matuo,
check_sakuraba(Ranks1,Ranks2,Scores1,Scores2),
check_kabata(Ranks1,Ranks2,Scores1,Scores2,Re1),
quick(Re1,Re2),
       check_kabata2(Re2),
check_yanagihara(Ranks1,Ranks2,Scores1,Scores2),
check_kiryuu(Ranks1,Ranks2,Scores1,Scores2).


main:-
findall(Perm,create_score_perm(0,30,0,[],Perm),ScorePerm),
R11 is 1,
R21 is 0,
R25 is 5,
selects([R11,R12,R13,R14,R15,R16],[0,1,2,3,4,5]),
selects([R21,R22,R23,R24,R25,R26],[0,1,2,3,4,5]),
rank_check(R11,R12,R13,R14,R15,R16,
	   R21,R22,R23,R24,R25,R26),
Ranks1=[[R11,matuo],[R12,sakuraba],[R13,kabata],[R14,yanagihara],[R15,kiryuu],[R16,sakai]],
Ranks2=[[R21,matuo],[R22,sakuraba],[R23,kabata],[R24,yanagihara],[R25,kiryuu],[R26,sakai]],
sort(Ranks1,Ranks1A),
sort(Ranks2,Ranks2A),
member(Scores1,ScorePerm),
member(Scores2,ScorePerm),
checks(Ranks1A,Ranks2A,Scores1,Scores2),
write([Ranks1A,Scores1]),nl,
write([Ranks2A,Scores2]),nl.





http://quiz-tairiku.com/q.cgi?mode=view&no=17263
リンク先パズルを解くコード。
動かさない色があるというのはパズルとしてどうかな?
どのピースを動かすかが述語化してしまっている。
もうちょっと抽象的にどれかのピースを連続して動かすという述語があった方がよかったかも。

ds( 1,0,d).
ds(-1,0,u).
ds(0,1,r).
ds(0,-1,l).
first_set([[0,0],[1,0],[2,0],[3,0],[4,0],[0,2],[3,3],[4,3],[3,4]],
	 [[1,1],[1,2],[2,2],[2,3]],
 [[2,1],[3,1],[4,1],[3,2]],
 [[1,3],[0,4],[1,4],[2,4]],
 [[4,4]]).

move_exe(NextBoard,_,_,[],NextPiece,NextPiece,NextBoard).
move_exe(Board,DY,DX,[[Y,X]|PieceRest],TPiece,NextPiece,NextBoard):-
X1 is X+DX,
Y1 is Y+DY,
select([Y1,X1],Board,BoardRest),
move_exe(BoardRest,DY,DX,PieceRest,[[Y1,X1]|TPiece],NextPiece,NextBoard).

state_assert(T,[Board,G,P,R,K,Path],
    NBoard, NG,NP,NR,NK,NPath):-
not(state_table(_,[NBoard, NG,NP,NR,NK,_])),!,
T1 is T+1,
assert(state_table(T1,[NBoard, NG,NP,NR,NK,NPath])),
assert(state_chain(Board,G,P,R,K,Path,
			  NBoard,NG,NP,NR,NK,NPath)).


state_assert(T,[Board,G,P,R,K,Path],
	     NBoard, NG,NP,NR,NK,NPath):-
	T2 is T+1, 
	state_table(T1,[NBoard,NG,NP,NR,NK,Path1]),
        T1=:=T2,
	length(Path1,Len1),
	length(NPath,Len),
	Len<Len1,
	retractall(state_chain(_,_,_,_,_,_,NBoard,NG,NP,NR,NK,_)),
	retractall(state_table(T1,[NBoard,NG,NP,NR,NK,_])),
	assert(state_chain(Board,G,P,R,K,Path,
			  NBoard,NG,NP,NR,NK,NPath)),
	assert(state_table(T1,[NBoard,NG,NP,NR,NK,NPath])).

green_move(T,OldStates,Board,G,P,R,K,Path):-
ds(DY,DX,Muki),
append(G,Board,BTemp),
move_exe(BTemp,DY,DX,G,[],GTemp,BTemp2),
sort(BTemp2,NextBoard),
sort(GTemp,NextG),
state_assert(T,OldStates,NextBoard,NextG,P,R,K,[Muki|Path]),
	green_move(T,OldStates,NextBoard,NextG,P,R,K,[Muki|Path]).


perple_move(T,OldStates,Board,G,P,R,K,Path):-
ds(DY,DX,Muki),
append(P,Board,BTemp),
move_exe(BTemp,DY,DX,P,[],PTemp,BTemp2),
sort(BTemp2,NextBoard),
sort(PTemp,NextP),
state_assert(T,OldStates,NextBoard,G,NextP,R,K,[Muki|Path]),
perple_move(T,OldStates,NextBoard,G,NextP,R,K,[Muki|Path]).
 
red_move(T,OldStates,Board,G,P,R,K,Path):-
ds(DY,DX,Muki),
append(R,Board,BTemp),
move_exe(BTemp,DY,DX,R,[],RTemp,BTemp2),
sort(BTemp2,NextBoard),
sort(RTemp,NextR),
state_assert(T,OldStates,NextBoard,G,P,NextR,K,[Muki|Path]),
red_move(T,OldStates,NextBoard,G,P,NextR,K,[Muki|Path]).
 
king_move(T,OldStates,Board,G,P,R,K,Path):-
ds(DY,DX,Muki),
append(K,Board,BTemp),
move_exe(BTemp,DY,DX,K,[],KTemp,BTemp2),
sort(BTemp2,NextBoard),
sort(KTemp,NextK),
state_assert(T,OldStates,NextBoard,G,P,R,NextK,[Muki|Path]),
king_move(T,OldStates,NextBoard, G,P,R,NextK,[Muki|Path]).
 
print_path([],_,_,_,_,_):-write(ok2).
print_path(Board,R,G,B,K,Path):-
state_chain(OldBoard,OldR,OldG,OldB,OldK,OldPath,
	   Board,R,G,B,K,Path),print_path(OldBoard,OldR,OldG,OldB,OldK,OldPath),reverse(Path,Path1),write(Path1),nl.

move_exe(_,[Board,R,G,B,[[2,0]],Path]):-!,nl,write(ok),nl,
	print_path(Board,R,G,B,[[2,0]],Path).
move_exe(T,OldStates):-
	[Board,G,P,R,K,_]=OldStates,
	not(green_move(T,OldStates,Board,G,P,R,K,[g])),
	not(perple_move(T,OldStates,Board,G,P,R,K,[p])),
	not(red_move(T,OldStates,Board,G,P,R,K,[r])),
	not(king_move(T,OldStates,Board,G,P,R,K,[k])).

move_exe_w(T):- 
	state_table(T,OldStates),
	move_exe(T,OldStates),
	fail.

search(T):-
	T<20,
	T1 is T+1,
	not(move_exe_w(T)),
	search(T1).


main:-first_set(BF,GF,PF,RF,KF),
	sort(BF,Board),
sort(GF,G),
sort(PF,P),
sort(RF,R),
sort(KF,K),
assert(state_table(0,[])),
assert(state_chain([],[],[],[],[],[],
		   [],[],[],[],[],[])),
retractall(state_table(_,_)),
retractall(state_chain(_,_,_,_,_,_,
		   _,_,_,_,_,_)),
assert(state_table(0,[Board,G,P,R,K,[]])),
assert(state_chain([],[],[],[],[],[],
		   Board,G,P,R,K,[])),
search(0).







%http://quiz-tairiku.com/q.cgi?mode=view&no=17222#bottom
%リンク先パズルを解くコード
rank([2,0],[2,1],>).
rank([2,2],[3,2],>).
rank([2,5],[3,5],>).
  
rank([3,2],[4,2],<).
rank([3,3],[4,3],>).
 
rank([4,0],[5,0],<).
rank([4,3],[5,3],<).
rank([4,4],[4,5],<).

rank([5,4],[5,5],<).
 
check_area(2,1).
check_area(5,1).
check_area(2,3).
check_area(5,3).
check_area(2,5).
check_area(5,5).
 

rev_c(<,>).
rev_c(>,<).
 
ranks(A,B,C):-rank(A,B,C).
ranks(A,B,C1):-rank(B,A,C),rev_c(C,C1).
 
first_date(Cell):-
    between(0,5,Y),
        between(0,5,X),
        Cell=[Y,X,0,5].
 
max(M1,M2,M1):-M1>M2,!.
max(_,M2,M2).
min(M1,M2,M1):-M1<M2,!.
min(_,M2,M2).
 
min_update(Min1,Min2,>,Re1):-
       M2 is Min2+1,max(M2,Min1,Re1).
max_update(Up1,Up2,<,Re1):-
       U2 is Up2-1,min(U2,Up1,Re1).

board_min_update_a(10,Board,Board):-!.
board_min_update_a(R,Board,Result):-
       R1 is R+1,
       findall(Cell,board_min_update(Cell,Board),NextBoard),
       board_min_update_a(R1,NextBoard,Result).

board_min_update(Cell,Board):-
       between(0,5,Y),
       between(0,5,X),
       member([Y,X,R1,Up],Board),
       (ranks([Y,X],[Y1,X1],>) ->
           (member([Y1,X1,Min1,_],Board),
            min_update(R1,Min1,>,Min2),
            Cell=[Y,X,Min2,Up]);
            Cell=[Y,X,R1,Up]).

board_max_update_a(10,Board,Board).
board_max_update_a(R,Board,Result):-
       R1 is R+1,
       findall(Cell,board_max_update(Cell,Board),NextBoard),
       board_max_update_a(R1,NextBoard,Result).

board_max_update(Cell,Board):-
       between(0,5,Y),
       between(0,5,X),
       member([Y,X,Min,Up],Board),
       (ranks([Y,X],[Y1,X1],<) ->
       (   member([Y1,X1,_,Up1],Board),
       max_update(Up,Up1,<,Up2),
       Cell=[Y,X,Min,Up2]);
       Cell=[Y,X,Min,Up]).

area_check(_,_,[],_,Coins):-!,sort(Coins,Coins1),length(Coins1,Len),Len=:=6.
area_check(Y,X,[[DY,DX]|Rest],Board,Coins):-
       X1 is X+DX,
       Y1 is Y+DY,
       member([Y1,X1,Coin],Board),
       area_check(Y,X,Rest,Board,[Coin|Coins]).

area_check_a(Y,X,Board,Coin):-
       area_check(Y,X,[[-1,0],[0,-1],[-1,-1],[-2,0],[-2,-1]],Board,[Coin]).

bad_perm(C1,C2,<):-C1>=C2,!.
bad_perm(C1,C2,>):-C1=<C2,!.
small_and_large_ok(Y,X,Board,Coin1):-ranks(A,B,C),
       [Y,X]=A,[Y1,X1]=B,
       member([Y1,X1,Coin2],Board),
       bad_perm(Coin1,Coin2,C),!,fail.
small_and_large_ok(_,_,_,_).

col_check(0,_,_,_):-!.
col_check(Y,X,Board,Coin):-
       Y1 is Y-1,
       member([Y1,X,C1],Board),
       Coin\==C1,
       col_check(Y1,X,Board,Coin).

search(6,0,_,Board,_,_):-!,sort(Board,Ans1),print_ans(Ans1).
search(Y,6,MinUp,Board,_,[Col|Cols]):-
       !,
       X1 is 0,
       Y1 is Y+1,
       search(Y1,X1,MinUp,Board,Col,Cols).
search(Y,X,[[_,_,Min,Up]|MinUp],Board,Col,Cols):-
       X1 is X+1,
       between(Min,Up,Coin),
       select(Coin,Col,RestCol),
       (check_area(Y,X)->area_check_a(Y,X,Board,Coin);true),
       small_and_large_ok(Y,X,Board,Coin),
       col_check(Y,X,Board,Coin),
       search(Y,X1,MinUp,[[Y,X,Coin]|Board],RestCol,Cols).

print_ans([]):-!.
print_ans([[_,_,C1],[_,_,C2],[_,_,C3],[_,_,C4],[_,_,C5],[_,_,C6]|Rest]):-
       write([C1,C2,C3,C4,C5,C6]),nl,
       print_ans(Rest).

main:-findall(Cell,first_date(Cell),Board),
       board_min_update_a(0,Board,ReBoard),
       board_max_update_a(0,ReBoard,ReBoard2),
       sort(ReBoard2,MinUp),!,
       search(0,0,MinUp,[],[0,1,2,3,4,5],[[0,1,2,3,4,5],
                                             [0,1,2,3,4,5],
                                             [0,1,2,3,4,5],
                                             [0,1,2,3,4,5],
                                             [0,1,2,3,4,5],
                                             [0,1,2,3,4,5]]).





http://quiz-tairiku.com/q.cgi?mode=view&no=17131
リンク先パズル問題を解くプログラムを記述。
コード製作者
算数の問題までしか解けないという噂を創価学会員に流されてまくっている堀江伸一こと私。
一つ解が見つかればよいと考え幅優先探索で解いたら別解が見つかりました。
こういう問題を考える人には感心するな。
大学の数学とかがヒントになってんのかな。
リンク先は今日本で一番パズル愛好家が集うサイトだと思う。
とりあえず模範解答は正答したけど、このパズルの真の解は泥棒ができる限り出口に近いところに移動しようとする場合も考慮したものとなるはず。
ここまで考えるとこの問題は実装が少し難しくなる。


change(o,c).
change(c,o).
change(s,s).

push_exe([A,c,B|Rest],N,PushNo,[A1,o,B1|Rest]):-
	N1 is N+1,
N1 =:=PushNo,!,
	change(A,A1),
	change(B,B1).

push_exe([A,c,B|Rest],N,PushNo,[A|Result]):-
	N1 is N+1,
	N1<PushNo,
	push_exe([c,B|Rest],N1,PushNo,Result).

push_exe([A,o,B|Rest],N,PushNo,[A|Result]):-
push_exe([o,B|Rest],N,PushNo,Result).

print_ans(-1,_):-!.
print_ans(PushNo,State):-
state_chain(OldPush,OldState,PushNo,State),
	print_ans(OldPush,OldState),
	write(PushNo),write(State),nl.

next_calc(_,PushNo,[s,o,o,o,o,o,o,o,o,o,o,s]):-!,
	print_ans(PushNo,[s,o,o,o,o,o,o,o,o,o,o,s]).
next_calc(T1,OldPush,State):-
	between(1,3,PushNo),
	OldPush\==PushNo,
	push_exe(State,0,PushNo,NextState),
	not(state_chain(_,_,PushNo,NextState)),
	assert(state_chain(OldPush,State,PushNo,NextState)),
	assert(states(T1,PushNo,NextState)),fail.



search_exe(T):-
	T1 is T+1,
	states(T,OldPush,State),
	next_calc(T1,OldPush,State).
search(T):-
	T1 is T+1,
	not(search_exe(T)),
	search(T1).
main:-FirstState=[s,c,o,o,o,o,o,o,o,o,c,s],
	assert(states(0,-1,FirstState)),
	assert(state_chain(-1,[],-1,FirstState)),
	retractall(states(_,_,_)),
	retractall(state_chain(_,_,_,_)),
	assert(states(0,-1,FirstState)),
	assert(state_chain(-1,[],-1,FirstState)),
	search(0).

タグ:

+ タグ編集
  • タグ:

このサイトはreCAPTCHAによって保護されており、Googleの プライバシーポリシー利用規約 が適用されます。

最終更新:2013年07月05日 20:46