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).
