DouKaku? 1061 katsu: SWI-prologです。 recta...(長方形の交差判定)

Comment detail

SWI-prologです。
rectangle/2で矩形の名前と座標を定義し、
allOl/1で重なり合う矩形のペアを列挙します。
やっぱり、「全解探索」こそPrologのロマンだと思います。

# 矩形の定義
rectangle(rect1,rect(0,0,50,50)).
rectangle(rect2,rect(25,25,75,75)).
rectangle(rect3,rect(50,50,100,100)).

#重なり判定 oerlap/2

overlap(rect(L1,T1,R1,B1),rect(L2,T2,R2,B2)) :-
        T1 < B2, T2 < B1, L1 < R2, L2 < R1.

testOl(N1, N2) :- rectangle(N1, R1),rectangle(N2, R2), N1 \== N2, overlap(R1,R2).

allOl(L) :- allOl([],L).
allOl(L0, L):-
        testOl(N1,N2),
        P=pair(N1,N2),
        not(member(pair(N2,N1),L0)),
        not(member(P,L0)),
        !,
        allOl([P|L0], L).
allOl(L,L).

:-allOl(L),writeln(L).

おおぉ、、、お題の内容を超えて、全開検索まで。。。やはり、Prolog って独特の魅力ありますよね。。。

いや、全解探索でもしないと、実質overlap/2の一行で終わっちゃってつまらないから。

全解探索なら、findall/3を使えば良いんだけど、結果が冗長なので、フィルタする必要があって、それも作ってみたので、お目汚しですが。

%矩形の列挙
rectangle(rect1,rect(0,0,50,50)).
rectangle(rect2,rect(25,25,75,75)).
rectangle(rect3,rect(50,50,100,100)).
%オーバーラップしているか判定
overlap(rect(L1,T1,R1,B1),rect(L2,T2,R2,B2)) :-T1 < B2, T2 < B1, L1 < R2, L2 < R1.
%解を探索
testOl(pair(N1,N2)) :- rectangle(N1, R1),rectangle(N2, R2), N1 \== N2, overlap(R1,R2).
%解の重複削除
uniq([],[]).
uniq([A|As],[A|As2]):-A=pair(N1,N2),uniq(As,As3), delete(As3,pair(N2,N1),As2).
%全解探索&重複削除
:-findall(X,testOl(X),Xs), uniq(Xs,Xss),writeln(Xss).

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq