「prolog勉強２６日目　雑多なパズル一覧」の編集履歴（バックアップ）一覧はこちら

「prolog勉強２６日目　雑多なパズル一覧」(2013/07/01 (月) 19:49:41) の最新版変更点

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

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

コード製作者　堀江伸一

ナイトの交換というパズルを解くＰｒｏｌｏｇプログラム。
盤面サイズは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
こちらのサイトにあったじゃんけんパズルその５を解かせた。
多分手作業で問いたら１分で解ける気もする。
コードももっと短くならないかなこれ？
 
 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]).




*２８日目　Ｆｎ4パズルを解く
http://torito.jp/shopping/_fn4puzzle.shtml
探索空間が小さいパズルなのでピースの右端になる４点を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],[]).

コード製作者　堀江伸一

ナイトの交換というパズルを解くＰｒｏｌｏｇプログラム。
盤面サイズは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
こちらのサイトにあったじゃんけんパズルその５を解かせた。
多分手作業で問いたら１分で解ける気もする。
コードももっと短くならないかなこれ？
 
 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]).




*２８日目　Ｆｎ4パズルを解く
http://torito.jp/shopping/_fn4puzzle.shtml
探索空間が小さいパズルなのでピースの右端になる４点を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]).