「prolog勉強３１日目 雑多な問題」の編集履歴（バックアップ）一覧に戻る
リンク先パズル問題を解くコード
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).
