Prolog勉強27日目
http://quiz-tairiku.com/logic/q9.html#q42
こちらの論理パズルを解くコードを記述。
サクッと書いたのでかなり適当。

calc_week(D,W):-W is (D-1+3) mod 7.
checks(t,M1,M1):-!.
checks(f,M1,M2):-M1\==M2.
check_exe([],[],[W,M,D]):-write([W,M,D]). 
check_exe([[M1,D1,W1]|Rest],Perm,[M,D,W]):-
	select(P1,Perm,Rest1),
	member(TFs,P1),
	[TFM,TFD,TFW]=TFs,
	checks(TFM,M,M1),
	checks(TFD,D,D1),
	checks(TFW,W,W1),
	check_exe(Rest,Rest1,[M,D,W]).
search:-
	Perm=[[[t,t,f],[t,f,t],[f,t,t]],[[t,f,f],[f,t,f],[f,f,t]],[[f,f,f]]],
	Date=[[5,12,1],[6,12,4],[6,14,2]],
	between(1,12,M),
 	between(1,31,D),
	D mod M=:=0,
	calc_week(D,W),
	check_exe(Date,Perm,[M,D,W]).





あいこでしょ というパズルをPrologで解くことに挑戦。
http://item.rakuten.co.jp/torito/891609/

4^8*8!*ピースの配置だからかなりの組み合わせ数になるのは確かだが。
アイコにならない場合がとても多そうにおもえたので、アイコにならない場合ができたら探索を打ち切る全探索でいどんだたらいつまでたっても答えが出なかった。
実装が悪かったのかもっと賢い方法がいるのか?
どっちだろう。
答えが出なかったのでいつかリベンジ予定。


round([],[],MaxY,MaxY):-!.
round([[X,Y,Te]|Rest],[[X1,Y1,Te]|Result],TempY,MaxY):-
	TempY<Y,!,
	round(Rest,Result,Y,MaxY),Y1 is X,X1 is -Y+MaxY.

round([[X,Y,Te]|Rest],[[X1,Y1,Te]|Result],TempY,MaxY):-
	round(Rest,Result,TempY,MaxY),Y1 is X,X1 is -Y+MaxY.
rounds(A,A).
rounds(A,B):-round(A,B,0,_).
rounds(A,C):-round(A,B,0,_),round(B,C,0,_).
rounds(A,D):-round(A,B,0,_),round(B,C,0,_),round(C,D,0,_).

piece(0,[[0,0,pa],[1,0,gu],[0,1,pa],[1,1,tyoki],[0,2,pa],[1,2,tyoki],[0,3,gu],[1,3,tyoki]]).
piece(1,[[0,0,tyoki],[1,0,pa],[0,1,gu],[1,1,pa],[0,2,gu],[1,2,pa],[0,3,gu],[1,3,tyoki]]).
piece(2,[[0,0,pa],[1,0,gu],[0,1,pa],[1,1,gu],[0,2,pa],[1,2,gu],[0,3,tyoki],[1,3,tyoki]]).
piece(3,[[0,0,tyoki],[1,0,pa],[0,1,gu],[1,1,pa],[0,2,gu],[1,2,pa],[0,3,tyoki],[1,3,gu]]).

piece(4,[[0,0,tyoki],[1,0,tyoki],[0,1,gu],[1,1,pa],[0,2,gu],[1,2,pa],[0,3,pa],[1,3,gu]]).
piece(5,[[0,0,pa],[1,0,gu],[0,1,tyoki],[1,1,pa],[0,2,tyoki],[1,2,pa],[0,3,gu],[1,3,tyoki]]).
piece(6,[[0,0,tyoki],[1,0,gu],[0,1,tyoki],[1,1,pa],[0,2,tyoki],[1,2,pa],[0,3,pa],[1,3,gu]]).
piece(7,[[0,0,tyoki],[1,0,gu],[0,1,gu],[1,1,pa],[0,2,gu],[1,2,pa],[0,3,pa],[1,3,tyoki]]). 

check_through(0,0).
check_through(0,7).
check_through(7,0).



insert(_,_,_,[],State,State):-!.
insert(X,Y,No,[[DX,DY,Te]|Rest],State,[[X1,Y1,Te,No]|NextState]):-
	X1 is X+DX,
	Y1 is Y+DY,
	X1<8,
	Y1<8,
	not(member([X1,Y1,_,_],State)),
	insert(X,Y,No,Rest,State,NextState).

check_area_search(X,Y,Ans,P):-
	member([DX,DY],[[-1,-1],[-1,0],[-1,1],[0,-1],[0,0],[0,1],[1,-1],[1,0],[1,1]]),
	X1 is X+DX,
	Y1 is Y+DY,
	member([X1,Y1,_,P],Ans).

check_area_count(X,Y,Ans,Count):-
	findall(P,check_area_search(X,Y,Ans,P),Cells),
	length(Cells,Count).

get_area_te(_,_,_,[],Result,Result):-!.
get_area_te(X,Y,Ans,[[DX,DY]|Rest],Temp,Result):-
	X1 is X+DX,
	Y1 is Y+DY,
	member([X1,Y1,Te,PNo],Ans),
	select([_,PNo],Temp,RestTe),!,
	get_area_te(X,Y,Ans,Rest,[[Te,PNo]|RestTe],Result).
get_area_te(X,Y,Ans,[[DX,DY]|Rest],Temp,Result):-
	X1 is X+DX,
	Y1 is Y+DY,
	member([X1,Y1,Te,PNo],Ans),!,
	get_area_te(X,Y,Ans,Rest,[[Te,PNo]|Temp],Result).
get_area_te(X,Y,Ans,[_|Rest],Temp,Result):-
	get_area_te(X,Y,Ans,Rest,Temp,Result).

select_te([],[]).
select_te([[Te,_]|Rest],[Te|Result]):-select_te(Rest,Result).

check(X,Y,Ans):-
	get_area_te(X,Y,Ans,[[-1,-1],[0,-1],[-1,0],[0,0]],[],List),
	select_te(List,Te),
	sort(Te,Te1),
	length(Te1,Len),
	Len2 is Len mod 2,
	Len2=:=1.

out_t(tyoki,t).
out_t(pa,p).
out_t(gu,g).

row_print([]):-nl.
row_print([T1,P1|Rest]):-out_t(T1,T2),write([T2,P1]),row_print(Rest).

ans_print([]).
ans_print([[_,_,T1,P1],[_,_,T2,P2],[_,_,T3,P3],[_,_,T4,P4],[_,_,T5,P5],[_,_,T6,P6],[_,_,T7,P7],[_,_,T8,P8]|Rest]):- 
	row_print([T1,P1,T2,P2,T3,P3,T4,P4,T5,P5,T6,P6,T7,P7,T8,P8]),
	ans_print(Rest).

test(A,B):-(A=:=7;B=:=7;A=:=0;B=:=0),write(ok).

stack_check(_,[],[]):-!.
stack_check(Ans,[[X,Y]|RestCheck],Result):- 
	check_through(X,Y),
        stack_check(Ans,RestCheck,Result).

stack_check(Ans,[[X,Y]|RestCheck],Result):-
	(X=:=0;X=:=7;Y=:=0;Y=:=7),
	check_area_count(X,Y,Ans,Count),
	Count=:=6,!,
	(check(X,Y,Ans) -> true;fail),
	stack_check(Ans,RestCheck,Result).


stack_check(Ans,[[X,Y]|RestCheck],Result):-
	check_area_count(X,Y,Ans,Count),
	Count=:=9,!,
	(check(X,Y,Ans) -> true ;fail),
	stack_check(Ans,RestCheck,Result).
stack_check(Ans,[[X,Y]|RestCheck],[[X,Y]|Result]):-
	stack_check(Ans,RestCheck,Result).


search(7,7,[],Ans,C1):-
	!,sort(Ans,Ans1),write(ok),nl,
	ans_print(Ans1),write(end),nl,write(C1).

search(X,Y,Perm,Ans,CheckList):-
	X=:=8,!,
	X1 is 0,
	Y1 is Y+1,
	write(Y1),
	%(Y=:=3 -> (sort(Ans,A1),nl,ans_print4(A1),write(CheckList),nl);true),
	stack_check(Ans,CheckList,NextCheckList),
	search(X1,Y1,Perm,Ans,NextCheckList).

search(X,Y,Perm,Ans,CheckList):-
	X1 is X+1,
	member([X,Y,_,_],Ans),
	!,
	stack_check(Ans,[[X,Y]|CheckList],NextCheckList),
	search(X1,Y,Perm,Ans,NextCheckList).

search(X,Y,Perm,Ans,CheckList):-
	not(member([X,Y,_,_],Ans)),
        select(No,Perm,Rest),
	piece(No,Piece),
	rounds(Piece,RPiece),
	insert(X,Y,No,RPiece,Ans,NextAns),
	stack_check(Ans,[[X,Y]|CheckList],NextCheckList),
	search(X,Y,Rest,NextAns,NextCheckList).
 main:-search(0,0,[0,1,2,3,4,5,6,7],[],[]). 




http://quiz-tairiku.com/logic/q9.html#q43
リンク先の問題No43を解くコード。
嘘つきと兄弟のあり得る全パタンを生成して嘘つき正直を考慮したうえで全員の証言と一致しているかを確認して解いた。
かなり手続きよりな感じのコードになっている。

combin([],Result,Result):-!.
combin([X|Rest],[X|Rest1],Result):-combin(Rest,Rest1,Result).
combin(Perm,[X|Rest],[X|Result]):-combin(Perm,Rest,Result).

perm_tf(t,t,f).
perm_tf(t,f,t).
perm_tf(f,t,t).
perm_tf(f,f,t).
perm_tf(f,t,f).
perm_tf(t,f,f).

count_f([],3):-!.
count_f([f|Rest],N):-!,N1 is N+1,count_f(Rest,N1).
count_f([_|Rest],N):-count_f(Rest,N).



checkA1(t,f,f):-!.
checkA1(f,TF2,TF3):-(TF2==t;TF3==t).
checkA(List):-
	select([T,a,TF1],List,Rest),
	select([T,_,TF2],Rest,Rest1),
	select([T,_,TF3],Rest1,_),
	checkA1(TF1,TF2,TF3).
checkB1(t,t,t):-!.
checkB1(f,TF2,TF3):-(TF2==f;TF3==f).

checkB(List):-
	select([T,b,TF1],List,Rest),
	select([T,_,TF2],Rest,Rest1),
	select([T,_,TF3],Rest1,_),
checkB1(TF1,TF2,TF3). 

checkC1(t,f,f):-!.
checkC1(f,TF2,TF3):-(TF2==t;TF3==t).

checkC(List):-
	select([_,c,TF1],List,Rest),
	select([_,a,TF2],Rest,Rest1),
	select([_,b,TF3],Rest1,_), 
	checkC1(TF1,TF2,TF3).
checkDE1(t,T,T).
checkDE1(f,T,T1):-T\==T1.

checkD(List):-
	member([T,d,TF1],List),
	member([T1,c,_],List),
	checkDE1(TF1,T,T1).
checkE(List):-
	member([T,e,TF1],List),
	member([T1,b,_],List),
	checkDE1(TF1,T,T1).
checkF1(t,t).
checkF1(f,f).
checkF(List):-
	member([_,f,TF1],List),
	member([_,e,TF2],List),
	checkF1(TF1,TF2).

main:-
	T1=a,
	combin([T2,T3],[b,c,d,e,f],Rest),
	combin([T4,T5,T6],Rest,_),
	perm_tf(TF1,TF2,TF3),
	perm_tf(TF4,TF5,TF6),
	count_f([TF1,TF2,TF3,TF4,TF5,TF6],0),
	List=[[0,T1,TF1],[0,T2,TF2],[0,T3,TF3],[1,T4,TF4],[1,T5,TF5],[1,T6,TF6]],
	checkA(List),
	checkB(List),
	checkC(List),
	checkD(List),
	checkE(List),
	checkF(List),
	write(List),nl.



prolog勉強29日目
%http://quiz-tairiku.com/q.cgi?mode=view&no=17256
%リンク先パズルを解くコード


xai7([2,0],[4,0]).
xai7([3,0],[1,1]).
xai7([0,1],[2,1]).

xai7([5,0],[4,2]).
xai7([3,1],[5,1]).
xai7([4,1],[4,3]).

xai7([3,3],[3,5]).
xai7([1,4],[3,4]).
xai7([2,4],[4,5]).
 
%leitial(y,x,n)
xai7_insert(Y,X,N,Ans,[[Y1,X1,N1]|Ans]):-xai7([Y,X],[Y1,X1]),!,N1 is 7-N.
xai7_insert(_,_,_,Ans,Ans).
 
print_ans([]):-nl.
print_ans([[_,_,N1],[_,_,N2],[_,_,N3],[_,_,N4],[_,_,N5],[_,_,N6]|Rest]):-
    write([N1,N2,N3,N4,N5,N6]),nl,
        print_ans(Rest).
 
ok_xai([2,1],[[0,1],[1,1],[2,0],[4,0],[3,0],[2,1]]).
ok_xai([4,3],[[5,0],[3,1],[4,1],[5,1],[4,2],[4,3]]).
ok_xai([4,5],[[3,3],[1,4],[2,4],[3,4],[3,5],[4,5]]).


check_row(_,-1,_,_):-!.
check_row(Y,X,Ans,N):-member([Y,X,N1],Ans),
       N\==N1,X1 is X-1,check_row(Y,X1,Ans,N).
 
xai_check([],_,Xai):-sort(Xai,Xai1),length(Xai1,Len),Len==6.
xai_check([[Y,X]|Rest],Ans,Xai):-
       member([Y,X,N],Ans),xai_check(Rest,Ans,[N|Xai]).

search(_,_,[],[],Ans):-!,sort(Ans,Ans1),print_ans(Ans1).
search(Y,X,[],[ColSet|Rest],Ans):-
       !,
       Y==6,
       Y1 is 0,
       X1 is X+1,
       search(Y1,X1,ColSet,Rest,Ans).
search(Y,X,ColSet,Col,Ans):-
       XDell is X-1,
       Y1 is Y+1,
       member([Y,X,N],Ans),!,
       select(N,ColSet,Rest),
       check_row(Y,XDell,Ans,N),
       (ok_xai([Y,X],XaiList) -> xai_check(XaiList,Ans,[]);true),
        search(Y1,X,Rest,Col,Ans).
 
search(Y,X,ColSet,Cols,Ans):-
        Y1 is Y+1,
        XDell is X-1,
        select(N,ColSet,Rest),
        check_row(Y,XDell,Ans,N),
        (ok_xai([Y,X],XaiList) -> xai_check(XaiList,Ans,[]);true),
        xai7_insert(Y,X,N,Ans,NextAns),
        search(Y1,X,Rest,Cols,[[Y,X,N]|NextAns]).
main:-search(0,0,[1,2,3,4,5,6],[[1,2,3,4,5,6],[1,2,3,4,5,6],
                                [1,2,3,4,5,6],[1,2,3,4,5,6],[1,2,3,4,5,6]],
             [[0,3,4],[1,2,1],[2,5,2],[5,4,3]]).


コード記述者
小学校の算数までしかできないと噂を流されている堀江伸一
+ タグ編集
  • タグ:
  • 堀江伸一
  • 笑い物
  • 算数までしかできない

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

最終更新:2013年07月02日 17:00