コード製作者 堀江伸一

ナイトの交換というパズルを解くPrologプログラム。
盤面サイズは3*4。

move_t(0,5).
move_t(0,7).
move_t(1,6).
move_t(1,8).
move_t(2,3).
move_t(2,7).
move_t(3,8).
move_t(3,10).
move_t(4,9).
move_t(4,11).
move_t(5,6).
move_t(5,10).
move_t(6,11).
move_t(8,9).
move_perm(From,To):-move_t(From,To).
move_perm(From,To):-move_t(To,From).

print_path([]).
print_path(State):-state_chain(OldState,State),print_path(OldState),
	one_print(State,[0,1,2,n,3,4,5,n,6,7,8,n,9,10,11,n,n]).
print_rev_path([]).
print_rev_path(State):-one_print(State,[0,1,2,n,3,4,5,n,6,7,8,n,9,10,11,n,n]),
	state_chain(State,NextState),print_rev_path(NextState).

one_print([],[]):-!.
one_print(Log,[n|Rest]):-!,nl,one_print(Log,Rest).
one_print([[P,C]|Rest],[P|Rest1]):-!,write(C),one_print(Rest,Rest1).
one_print(Log,[_|Rest]):-write(s),one_print(Log,Rest).



all_next_search(N):-
	N1 is N+1,
	state_list(N,State),
	move_perm(From,To),
select([From,Color],State,Rest1),
	not(member([To,_],Rest1)),
	Temp=[[To,Color]|Rest1],
	sort(Temp,NextState),
	not(state_chain(_,NextState)),
	assert(state_chain(State,NextState)),
	assert(state_list(N1,NextState)),
	state_rev_list(_,NextState),
print_path(State),
 	print_rev_path(NextState),
	read(A),write(A).


all_old_search(N):-
	N1 is N+1,
	state_rev_list(N,State),
	move_perm(From,To),
	select([From,Color],State,Rest1),
	not(member([To,_],Rest1)),
	Temp=[[To,Color]|Rest1],
	sort(Temp,OldState),
	not(state_chain(OldState,_)),
	assert(state_chain(OldState,State)),
	assert(state_rev_list(N1,OldState)),
	state_list(_,OldState),
	print_path(OldState),
	print_rev_path(State),
	read(A),write(A).


next_search(N):-
	N <12,
	not(all_next_search(N)),
	not(all_old_search(N)),
	findall(State,state_list(N,State),List),length(List,Len),write([Len,l]),
	N1 is N+1,
	write(N1),nl,
	next_search(N1).

main:-     State=[[0,b],[1,b],[2,b],[9,w],[10,w],[11,w]],
StateRev=[[0,w],[1,w],[2,w],[9,b],[10,b],[11,b]],
 	assert(state_rev_list(0,StateRev)),
	assert(state_list(0,State)),
	assert(state_chain([],State)),
	retractall(state_list(_,_)),
	retractall(state_chain(_,_)),
	retractall(state_rev_list(_,_)),
	assert(state_list(0,State)),
	assert(state_chain([],State)),
	assert(state_chain(StateRev,[])),
	assert(state_rev_list(0,StateRev)),
	next_search(0).




http://blog.goo.ne.jp/handbill-puzzle/e/f5d4013bfeefba4607977c1faebbb05a
こちらのサイトにあったじゃんけんパズルその5を解かせた。
多分手作業で問いたら1分で解ける気もする。
コードももっと短くならないかなこれ?

con(1,[0,2]).
con(0,[1,3]).
con(3,[0,1,2,3,4,5]).
con(1,[2,6]).
con(1,[3,5,7]).
con(1,[4,6,7]). 

te(1,pa):-!.
te(7,gu):-!.
te(_,gu).
te(_,tyoki).
te(_,pa). 

v_count([Gu,Tyoki,Pa],0):-0<Gu,0<Tyoki,0<Pa,!.
v_count([_,0,0],0):-!.
v_count([0,_,0],0):-!.
v_count([0,0,_],0):-!.
v_count([Gu,_,0],Gu):-!.
v_count([_,0,Pa],Pa):-!.
v_count([0,Tyoki,_],Tyoki).

add(gu,Gu,Tyoki,Pa,ReGu,Tyoki,Pa):-
	ReGu is Gu+1.
add(tyoki,Gu,Tyoki,Pa,Gu,ReTyoki,Pa):-
	ReTyoki is Tyoki+1.
add(pa,Gu,Tyoki,Pa,Gu,Tyoki,RePa):-
	RePa is Pa+1.


te_count(_,[],[0,0,0]):-!.
te_count(List,[P|Rest],[ReGu,ReTyoki,RePa]):-
	member([P,Te],List),
	te_count(List,Rest,[Gu,Tyoki,Pa]),
	add(Te,Gu,Tyoki,Pa,ReGu,ReTyoki,RePa).

ans_check(Ans,[]):-write(Ans).
ans_check(List,[[V,Perm]|Rest]):-
	te_count(List,Perm,TeCount),
	v_count(TeCount,NowV),
	V=:=NowV,
	ans_check(List,Rest).

search(N,List):-
	N=:=8,!,
	reverse(List,List1),
	findall([V,Perm],con(V,Perm),AllSet),
	ans_check(List1,AllSet).

search(N,List):-
	te(N,Te),
	N1 is N+1,
	search(N1,[[N,Te]|List]).




28日目 Fn4パズルを解く

http://torito.jp/shopping/_fn4puzzle.shtml
探索空間が小さいパズルなのでピースの右端になる4点をcombin述語で求めその向きを指定して全探索してみた。
計算量を抑えることを考えたらこんな無駄な処理はいらないがこれはコードがわかりやすいという利点がある。

round90([],[]).
round90([[X,Y]|Rest],[[X1,Y1]|Result]):-
	Y1 is X,X1 is -Y,round90(Rest,Result).
slide(_,_,[],[]).
slide(DX,DY,[[X1,Y1]|Rest],[[X2,Y2]|Result]):-
	X2 is X1-DX,Y2 is Y1-DY,slide(DX,DY,Rest,Result).

round(Piece,Result):-round90(Piece,Piece1),
	sort(Piece1,Piece2),
	[[DX,DY]|_]=Piece2,
	slide(DX,DY,Piece2,Result). 

rounds(P,P).
rounds(P,P1):-round(P,P1).
rounds(P,P2):-round(P,P1),round(P1,P2).
rounds(P,P3):-round(P,P1),round(P1,P2),round(P2,P3).

reverse([],[]).
reverse([[X,Y]|Rest],[[X1,Y1]|Result]):-
	X1 is -X,Y1 is Y,reverse(Rest,Result).
reverse_exe(P,P).
 reverse_exe(P,Result):-reverse(P,P1),sort(P1,P2),
 	[[DX,DY]|_]=P2,slide(DX,DY,P2,Result).
 
 assert_piece:-
 	P=[[0,0],[0,1],[0,2],[1,-1],[1,0],[1,1],[1,2],[2,0],[2,1],[3,1]],
 	assert(piece(P)),
 	retractall(piece(_)),
 	reverse_exe(P,P1),
 	rounds(P1,P2),
 	sort(P2,P3),
 	assert(piece(P3)),fail.
 
 insert(_,_,_,[],Ans,Ans):-!.
 insert(X,Y,No,[[DX,DY]|Rest],Ans,[[X1,Y1,No]|Result]):-
 	X1 is X+DX,
 	Y1 is Y+DY,
 	0=<X1,
 	0=<Y1,
 	X1<7,
 	Y1<7,
 	not(member([X1,Y1,_],Ans)),
 	insert(X,Y,No,Rest,Ans,Result).
 
 combin([],_):-!.
 combin([X|Rest],[X|Rest1]):-combin(Rest,Rest1).
 combin(Perm,[_|Rest]):-combin(Perm,Rest).
 
 print_ans(_,_,[]):-!.
 print_ans(X,Y,Ans):-
 	Y=:=7,!,
 	nl,
	Y1 is 0,
 	X1 is X+1,
 	print_ans(X1,Y1,Ans).
 print_ans(X,Y,[[X,Y,No]|Rest]):-
 	write(No),!,Y1 is Y+1,
 	print_ans(X,Y1,Rest).
 print_ans(X,Y,Ans):-
 	Y1 is Y+1,
 	write(s),
 	print_ans(X,Y1,Ans).
 
 
 search([],[],Ans):-!,sort(Ans,Ans1),write(Ans1),nl,
 	print_ans(0,0,Ans1).
 search([No|Rest1],[[X,Y]|Rest2],Ans):-
 	piece(P1),
 	insert(X,Y,No,P1,Ans,NextAns),
 	search(Rest1,Rest2,NextAns).
 
 main:-not(assert_piece),
 	combin([A,B,C,D],
 	       [[0,0],[0,1],[0,2],[0,3],[0,4],[0,5],
 		[1,0],[1,1],[1,2],[1,3],[1,4],[1,5],
 		[2,0],[2,1],[2,2],[2,3],[2,4],[2,5],
 		[3,0],[3,1],[3,2],[3,3],[3,4],[3,5]]),
 	search([0,1,2,3],[A,B,C,D],[]).




http://torito.jp/shopping/_lpuzzle.shtml
リンク先Lパズルを解く。
回転解が4つでてこないとおかしいような、あれ何か変だ?

piece(s,[[0,0],[0,1],[0,2],[1,2]]).
piece(s,[[0,0],[1,0],[2,0],[2,-1]]).
piece(s,[[0,0],[1,0],[1,1],[1,2]]).
piece(s,[[0,0],[0,1],[1,0],[2,0]]). 

piece(l,[[0,0],[0,1],[0,2],[0,3],[1,3]]).
piece(l,[[0,0],[1,0],[2,0],[3,0],[3,-1]]).
piece(l,[[0,0],[1,0],[1,1],[1,2],[1,3]]).
piece(l,[[0,0],[0,1],[1,0],[2,0],[3,0]]). 

piece(r,[[0,0],[0,1],[1,1],[2,1]]).
piece(r,[[0,0],[0,1],[0,2],[-1,2]]).
piece(r,[[0,0],[1,0],[2,0],[2,1]]).
piece(r,[[0,0],[0,1],[0,2],[1,0]]). 

to_hex(N,N):-N<10.
to_hex(10,a).
to_hex(11,b).

print_ans(_,_,[]):-!.
print_ans(X,Y,Ans):-
	Y=:=7,!,
	nl,
	Y1 is 0,
	X1 is X+1,
	print_ans(X1,Y1,Ans).
print_ans(X,Y,[[X,Y,No]|Rest]):-
	to_hex(No,S),
	write(S),!,Y1 is Y+1,
	print_ans(X,Y1,Rest).
print_ans(X,Y,Ans):-
	Y1 is Y+1,
	write(s),
	print_ans(X,Y1,Ans).

insert(_,_,_,[],Ans,Ans):-!.
insert(X,Y,No,[[DX,DY]|Rest],Ans,[[X1,Y1,No]|Result]):-
	X1 is X+DX,
	Y1 is Y+DY,
	0=<X1,
	0=<Y1,
	X1<7,
	Y1<7,
	not(member([X1,Y1,_],Ans)),
	insert(X,Y,No,Rest,Ans,Result).


search(_,_,_,0,0,Ans,[]):-
	!,
	sort(Ans,Ans1),
	nl,print_ans(0,0,Ans1).
search(X,Y,No,L,R,Ans,PList):-
	Y=:=7,!,
	Y1 is 0,
	X1 is X+1,
	search(X1,Y1,No,L,R,Ans,PList).

search(X,Y,No,L,R,Ans,PList):-
	member([X,Y,_],Ans),!,
	Y1 is Y+1,
	search(X,Y1,No,L,R,Ans,PList).
search(X,Y,No,L,R,Ans,[_|Rest]):-
        piece(s,P1),
	insert(X,Y,No,P1,Ans,NextAns),
	No1 is No+1,
	search(X,Y,No1,L,R,NextAns,Rest).
search(X,Y,No,1,R,Ans,[_|Rest]):-
	piece(l,P1),
	insert(X,Y,No,P1,Ans,NextAns),
	No1 is No+1,
	search(X,Y,No1,0,R,NextAns,Rest).
search(X,Y,No,L,1,Ans,[_|Rest]):-
piece(r,P1),
	insert(X,Y,No,P1,Ans,NextAns),
	No1 is No+1,
	search(X,Y,No1,L,0,NextAns,Rest).


main:-search(0,0,0,1,1,[],[s,s,s,s,s,s,s,s,s,s,s,l]).

タグ:

+ タグ編集
  • タグ:

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

最終更新:2013年07月01日 19:49