「prolog勉強31日目 雑多な問題」の編集履歴(バックアップ)一覧はこちら

prolog勉強31日目 雑多な問題」(2013/07/05 (金) 20:46:22) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

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).
リンク先パズル問題を解くコード 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).

表示オプション

横に並べて表示:
変化行の前後のみ表示: