問題はこちら->http://nabetani.sakura.ne.jp/hena/orde18twintri/
二つの三角形の六条件から面積を求める方法がわからず、また、
4方向ｘ２の組み合わせで分類すのも複雑すぎる気がしましたので、
片方の三角形のすべての要素を、もう一方の三角形の条件でチェックしました。
何とか全問解けました。
似たような規則が並んでいます。もう少しすっきりさせたかったのですが・・・
makem([_,_,_,0],_,C,C):-!.
makem([X,Y,'R',N],[X1,Y1,D,H],C,CR):-
N1 is N-1,XX is X-N1, make1(y,D,XX,Y,X1,Y1,H,N1,C,C1),
makem([X,Y,'R',N1],[X1,Y1,D,H],C1,CR).
makem([X,Y,'L',N],[X1,Y1,D,H],C,CR):-
N1 is N-1,XX is X+N1, make1(y,D,XX,Y,X1,Y1,H,N1,C,C1),
makem([X,Y,'L',N1],[X1,Y1,D,H],C1,CR).
makem([X,Y,'T',N],[X1,Y1,D,H],C,CR):-
N1 is N-1,YY is Y+N1, make1(t,D,X,YY,X1,Y1,H,N1,C,C1),
makem([X,Y,'T',N1],[X1,Y1,D,H],C1,CR).
makem([X,Y,'B',N],[X1,Y1,D,H],C,CR):-
N1 is N-1,YY is Y-N1, make1(t,D,X,YY,X1,Y1,H,N1,C,C1),
makem([X,Y,'B',N1],[X1,Y1,D,H],C1,CR).
make1(y,D,X,Y,X1,Y1,H,0,C,CR):-cond(D,X,Y,X1,Y1,H)->CR is C+1;CR =C.
make1(y,D,X,Y,X1,Y1,H,N,C,CR):-
YY is Y+N,(cond(D,X,YY,X1,Y1,H)->C1 is C+1;C1 =C),
YYY is Y-N,(cond(D,X,YYY,X1,Y1,H)->C2 is C1+1;C2 =C1),
N1 is N-1,make1(y,D,X,Y,X1,Y1,H,N1,C2,CR).
make1(t,D,X,Y,X1,Y1,H,0,C,CR):-cond(D,X,Y,X1,Y1,H)->CR is C+1;CR =C.
make1(t,D,X,Y,X1,Y1,H,N,C,CR):-
XX is X+N,(cond(D,XX,Y,X1,Y1,H)->C1 is C+1;C1 =C),
XXX is X-N,(cond(D,XXX,Y,X1,Y1,H)->C2 is C1+1;C2 =C1),
N1 is N-1,make1(t,D,X,Y,X1,Y1,H,N1,C2,CR).
cond('R',X,Y,X1,Y1,N):-Y>=X+Y1-X1,Y+X=<Y1+X1,X>=X1-N.
cond('L',X,Y,X1,Y1,N):-Y=<X+Y1-X1,Y+X>=Y1+X1,X1+N>=X.
cond('T',X,Y,X1,Y1,N):-Y>=X+Y1-X1,Y+X>=Y1+X1,Y=<Y1+N.
cond('B',X,Y,X1,Y1,N):-Y=<X+Y1-X1,Y+X=<Y1+X1,Y>=Y1-N.
check1(N,[X2,Y2,D2,H2],[X1,Y1,D1,H1]):-H11 is H1-1,
makem([X2,Y2,D2,H2],[X1,Y1,D1,H11],0,C),
(N=:=C->write("yes ");write("no ")),write(C),write("\n"),!.
begin:-str(S),split_string(S,"\s,\n","\s",L0),solve(L0).
solve([],_,_).
solve([_,B,C,D,E|T]):-
number_chars(N1,B),split_string(C,"/","",[CH|[CT]]),
string_chars(CH,CH1),ston(CH1,[],[],CR10),CR1=[N1|CR10],
string_chars(D,D1),ston(D1,[],[],CR20),number_chars(N2,CT),
CR2=[N2|CR20],number_chars(N3,E),check1(N3,CR1,CR2),solve(T).
ston([],A,L,LR):-number_chars(N,A),LR0=[N|L],reverse(LR0,LR),!.
ston([H|T],A0,L0,RL):-
r(R),(member(H,R)->(number_chars(N1,A0),L=[H,N1|L0],ston(T,[],L,RL));
append(A0,[H],A),ston(T,A,L0,RL)).
r(['R','L','T','B']).
str("0 7,0R6/3,1B5 15
1 1,6L4/4,9R9 4
2 0,2R4/1,3B4 3
3 1,2L4/1,2L5 16
4 3,2L5/5,6B4 8
5 4,1B3/6,3B4 4
6 4,4R7/4,3R5 20
7 4,5R9/0,7T3 7
8 4,7T9/1,6T3 1
9 4,8B7/3,7L4 10
10 5,3L3/9,8L4 0
11 5,6B4/4,4R2 3
12 5,6B4/8,5R4 8
13 5,8B9/5,2L2 4
14 6,1L5/7,1T2 3
15 7,2B4/7,2T4 1
16 7,3T9/9,6L6 11
17 8,0R6/8,1R7 30
18 0,4R7/4,6R10 36
19 10,4L4/9,1T6 9
20 2,2T7/6,7T10 4
21 2,7R4/1,6L8 2
22 3,0R10/1,2T7 7
23 3,5T2/3,6B10 2
24 4,7R10/8,2T8 6
25 6,8B10/4,5B6 36
26 9,2B7/1,1B10 6
27 9,3R14/2,4R1 1
28 3,0R10/0,6B10 54
29 4,10T8/4,10T8 64
30 1,5T10/1,20B10 56
31 15,16L4/5,12L12 4
32 12,11T18/7,18R18 34
33 15,16T14/5,12L15 44
34 5,10L40/22,22B10 100
35 46,34T34/34,29T14 30
36 52,75L12/88,69T54 0
37 67,83B70/99,48T14 52
38 291,11T120/258,54B130 424
39 62,170L139/133,172R21 441
40 98,189B116/183,127R27 240
41 646,684B96/435,690R772 0
42 113,668L866/581,859L852 158404
43 309,321B162/137,420B423 15750
44 5474,6459R9089/8177,150R5120 376996
45 2399,1640B2451/1718,2100L1623 221334
46 5621,8460T7612/2715,5697L8851 861192").
%begin.
2017.10.10追加
一応まともに動くので気が付きませんでしたが、solve/1の先頭にバグがあります。
少し解答時間を短くしたのがありますので、bug fixを兼ねてそちらを載せます。
makem([_,_,_,0],_,C,C):-!.
makem([X,Y,'R',N],[D,H],C,CR):- %変数節約を兼ね片方の三角形の頂点を原点に移動している
N1 is N-1,XX is X-N+1,YY is Y-N,N2 is N*2-1,make1(F,y,D,XX,YY,H,N2,C,C1),
makem([X,Y,'R',N1],[D,H],C1,CR).
makem([X,Y,'L',N],[D,H],C,CR):-
N1 is N-1,XX is X+N1,YY is Y-N,N2 is N*2-1,make1(F,y,D,XX,YY,H,N2,C,C1),
makem([X,Y,'L',N1],[D,H],C1,CR).
makem([X,Y,'T',N],[D,H],C,CR):-
N1 is N-1,YY is Y+N1,XX is X-N,N2 is N1*2+1,make1(F,t,D,XX,YY,H,N2,C,C1),
makem([X,Y,'T',N1],[D,H],C1,CR).
makem([X,Y,'B',N],[D,H],C,CR):-
N1 is N-1,YY is Y-N1,XX is X-N,N2 is N1*2+1,make1(F,t,D,XX,YY,H,N2,C,C1),
makem([X,Y,'B',N1],[D,H],C1,CR).
make1(_,y,_,_,_,_,0,C,C):-!. %F-> 横にはみ出した時のフラグ
make1(F,y,D,X,Y,H,N,C,CR):- % 変数を増やすとout of stackなので縦は不可
YY is Y+N,(cond(D,X,YY,H)->(F1=g,C1 is C+1,N1 is N-1);
(F1=F,C1 =C,(F==g->N1=0;N1 is N-1))), make1(F1,y,D,X,Y,H,N1,C1,CR).
make1(_,t,_,_,_,_,0,C,C):-!.
make1(F,t,D,X,Y,H,N,C,CR):-
XX is X+N,(cond(D,XX,Y,H)->(F1=g,C1 is C+1,N1 is N-1);
(F1=F,C1 =C,(F==g->N1=0;N1 is N-1))),
make1(F1,t,D,X,Y,H,N1,C1,CR).
cond('R',X,Y,N):-Y>=X,Y+X=<0,X+N>=0,!.
cond('L',X,Y,N):-Y=<X,Y+X>=0,N>=X,!.
cond('T',X,Y,N):-Y>=X,Y+X>=0,Y=<N,!.
cond('B',X,Y,N):-Y=<X,Y+X=<0,Y+N>=0,!.
check1(N,[X2,Y2,D2,H2],[D1,H1]):-H11 is H1-1,
makem([X2,Y2,D2,H2],[D1,H11],0,C),
(N=:=C->write("yes ");write("no ")),write(C),write("\n"),!.
begin:-str(S),split_string(S,"\s,\n","\s",L0),solve(L0),!.
solve([]):-!.
solve([_,B,C,D,E|T]):-
number_chars(X1,B),split_string(C,"/","",[CH|[CT]]),
string_chars(CH,CH1),ston(CH1,[],[],CR10),
string_chars(D,D1),ston(D1,[],[],CR20),number_chars(X2,CT),
CR10=[Y1,P1,N1],CR20=[Y2,P2,N2],number_chars(A,E),
(N1>N2->(X21 is X2-X1,Y21 is Y2-Y1,check1(A,[X21,Y21,P2,N2],[P1,N1]));
(X11 is X1-X2,Y11 is Y1-Y2,check1(A,[X11,Y11,P1,N1],[P2,N2]))),
solve(T).
ston([],A,L,LR):-number_chars(N,A),LR0=[N|L],reverse(LR0,LR),!.
ston([H|T],A0,L0,RL):-
r(R),(member(H,R)->(number_chars(N1,A0),L=[H,N1|L0],ston(T,[],L,RL));
append(A0,[H],A),ston(T,A,L0,RL)).
r(['R','L','T','B']).
2017.10.12追加
二つの三角形を一括して回転させる方法を思いつきましたので、
片方を'T'に固定して４分類し、チェック開始位置を限定しました。
最初より数十倍速くなりました。
makem([_,_,_,0],_,C,C):-!.
makem([X,Y,'R',N],[D,H],C,CR):-
XX is X-N+1,YY is Y-N,N2 is N*2-1,make1(RF,F,D,XX,YY,H,N2,C,C1),
((var(RF),C>0)->N1=0;N1 is N-1),makem([X,Y,'R',N1],[D,H],C1,CR).
makem([X,Y,'T',N],[D,H],C,CR):-
YY is Y+N-1,XX is X-N,N2 is N*2-1,make2(RF,F,D,XX,YY,H,N2,C,C1),
((var(RF),C>0)->N1=0;N1 is N-1),makem([X,Y,'T',N1],[D,H],C1,CR).
makem([X,Y,'B',N],[D,H],C,CR):-
YY is Y-N+1,XX is X-N,N2 is N*2-1,make2(RF,F,D,XX,YY,H,N2,C,C1),
((var(RF),C>0)->N1=0;N1 is N-1),makem([X,Y,'B',N1],[D,H],C1,CR).
make1(F,F,_,_,_,_,0,C,C):-!. %F-> 横にはみ出した時のフラグ,makemで縦にも使用
make1(RF,F,D,X,Y,H,N,C,CR):-
YY is Y+N,(cond(D,X,YY,H)->(F1=g,C1 is C+1,N1 is N-1);
(F1=F,C1 =C,(F==g->N1=0;N1 is N-1))), make1(RF,F1,D,X,Y,H,N1,C1,CR).
make2(F,F,_,_,_,_,0,C,C):-!. %変数節約のため1と2にした
make2(RF,F,D,X,Y,H,N,C,CR):-
XX is X+N,(cond(D,XX,Y,H)->(F1=g,C1 is C+1,N1 is N-1);
(F1=F,C1 =C,(F==g->N1=0;N1 is N-1))),
make2(RF,F1,D,X,Y,H,N1,C1,CR).
cond('T',X,Y,N):-Y>=X,Y+X>=0,Y=<N,!.
check1(A,[X2,Y2,'L',H2],[D1,H1]):-X21 is -X2,check1(A,[X21,Y2,'R',H2],[D1,H1]),!.
check1(A,[X2,Y2,D2,H2],[D1,H1]):-range([X2,Y2,D2,H2],[H1],[N]),H11 is H1-1,
makem([X2,Y2,D2,N],[D1,H11],0,C),
(A=:=C->write("yes ");write("no ")),write(C),write("\n"),!.
begin:-str(S),split_string(S,"\s,\n","\s",L0),solve(L0),!.
solve([]):-!.
solve([_,B,C,D,E|T]):-
number_chars(X1,B),split_string(C,"/","",[CH|[CT]]),
string_chars(CH,CH1),ston(CH1,[],[],CR10),
string_chars(D,D1),ston(D1,[],[],CR20),number_chars(X2,CT),
CR10=[Y1,P1,N1],CR20=[Y2,P2,N2],number_chars(A,E),
(N1>N2->(X21 is X2-X1,Y21 is Y2-Y1,
rotate([X21,Y21,P2,N2],[P1],L),check1(A,L,['T',N1]));
(X11 is X1-X2,Y11 is Y1-Y2,
rotate([X11,Y11,P1,N1],[P2],L),check1(A,L,['T',N2]))),
solve(T).
ston([],A,L,LR):-number_chars(N,A),LR0=[N|L],reverse(LR0,LR),!.
ston([H|T],A0,L0,RL):-
r(R),(member(H,R)->(number_chars(N1,A0),L=[H,N1|L0],ston(T,[],L,RL));
append(A0,[H],A),ston(T,A,L0,RL)).
rotate(L,['T'],L):-!.
rotate([X,Y,P1,N],[P2],L):-
X1 is Y,Y1 is -X,rot(P1,P11),rot(P2,P22),rotate([X1,Y1,P11,N],[P22],L).
range([X1,_,'R',N1],[N2],[N]):- %チェック開始位置を限定
(X1-N1+N2>0->(X1-N1+2>N2->N=0;N=N1);(1-N2>X1->N=0;N=X1+N2)).
range([_,Y1,'B',N1],[N2],[N]):-
(Y1>N1-1->(Y1-N1+2>N2->N=0;N=N1);(0>Y1->N=0;N=Y1+1)).
range([_,Y1,'T',N1],[N2],[N]):-
(Y1+N1<N2->(Y1+N1<1->N=0;N=N1);(Y1>N2-1->N=0;N=N2-Y1)).
r(['R','L','T','B']).
rot('R','T').
rot('T','L').
rot('L','B').
rot('B','R').