問題はこちら->http://nabetani.sakura.ne.jp/hena/orde32rects/
この問題は過去の類題と比べて落とし穴が多く何回も書き直しました。
(できれば局所的な)条件に合うか確認しながら四角形を作る方法と、
すべての四角形を作ってから(しばしば網羅的な)条件に合うものを選ぶ方法とがあり、
前者の方針で挑み惨敗しましたので、後者の方法で書いています。
(Julia等なら二次元配列の辺の部分を1にして0の部分を探索してできるかもしれませんが)
四つの四角形の間にできる四角形がありますので、四角形の組み合わせでは解けません。
そこでcon/3で問題の四角形を辺の線分に分解しますが、
求める四角形は、重複した線分を辺として持つことが有るため、
ext/2で重複した部分を合わせた最長の線分を作ります。
sel/3で縦横の任意の交点で切断されたすべての線分を作ります。(X:Y1:Y2やY:X1:X2で表現)
find/3で縦横二本ずつの線分から、可能なすべての四角形を作ります。
(X1:Y1:Y2->X2:Y1:Y2->Y1:X1:X2,Y2:X1:X2)
judg/4で四角形の中に入り込む線分のないもののみを選びます。
発想の転換や飛躍のないコツコツと地道に解いたコードになっています。
%SWI-Prolog version 7.4.2
%start.
%:-initialization(start). %ideone
con(x,[X1,Y1,X2,Y2],[X1:Y1:Y2,X2:Y1:Y2]).
con(y,[X1,Y1,X2,Y2],[Y1:X1:X2,Y2:X1:X2]).
calc(X1:Y1:X2:Y2,R):-R is (X2-X1)*(Y2-Y1).
ext(XL,R):-
select(X:Y1:Y2,XL,XL1),select(X:Y3:Y4,XL1,XL2),Y1=<Y3,Y3=<Y2,
msort([Y1,Y2,Y3,Y4],[Y5,_,_,Y6]),XL3=[X:Y5:Y6|XL2],ext(XL3,R).
ext(XL,XL).
sel([],R,R).
sel([X:Y1:Y2|T],R1,R):-
findall(L,(member(Y:X1:X2,R1),sel1(X:Y1:Y2,Y:X1:X2,L)),L1),
flatten(L1,L2),append(R1,L2,R2),sel(T,R2,R).
sel1(X:Y1:Y2,Y:X1:X2,R):-(X1<X,X<X2,Y1=<Y,Y=<Y2),R=[Y:X1:X,Y:X:X2].
find(XL,YL,R):-findall(L,find1(XL,YL,L),R).
find1(XL,YL,R):-
nth0(N1,XL,X1:Y1:Y2),nth0(N2,XL,X2:Y1:Y2),N1<N2,
member(Y1:X1:X2,YL),member(Y2:X1:X2,YL),Y1<Y2,R=X1:Y1:X2:Y2.
exc(A:B:C:D,B:A:D:C).
judg(SQ,XL,YL,R):-
judg(SQ,XL,SQ1),maplist(exc,SQ1,SQ2),judg(SQ2,YL,SQ3),maplist(exc,SQ3,R).
judg([],_,[]).
judg([H|T],XY,R):-judg(T,XY,R1),(judg1(H,XY)->R=[H|R1];R=R1).
judg1(_,[]).
judg1(X11:Y11:X12:Y12,[Y:X1:X2|T]):-
judg1(X11:Y11:X12:Y12,T),not((Y11<Y,Y<Y12,X11<X2,X1<X12)).
solve1(XL,YL,R):-
ext(XL,XL1),ext(YL,YL1),sel(XL1,YL1,L1),sel(YL1,XL1,L2),
append(XL1,L2,XL2),append(YL1,L1,YL2),sort(YL2,YL3),sort(XL2,XL3),
find(YL3,XL3,SQ),judg(SQ,XL,YL,R).
solve(L,R):-
maplist(con(x),L,L1),maplist(con(y),L,L2),flatten(L1,XL),flatten(L2,YL),
solve1(XL,YL,L30),sort(L30,L3),maplist(calc,L3,L4),msort(L4,R).
start:-str(S),split_string(S,"\s\n","\s",L),pre(L),!.
pre([]).
pre([_,B,Q|T]):-
atomics_to_string(BL,"/",B),maplist(atom_chars,BL,L),maplist(aton,L,L1),
solve(L1,R),disp(R,Q),pre(T).
aton(L,R):-maplist(cha,L,R).
cha(X,R):-atom_codes(X,N),(N>96->R is N-87;R is N-48).
disp(R,A):-
maplist(number_string,R,L),atomics_to_string(L,",",S),
(S==A->write("pass ");write(" fail ")),writeln(S),!.
str("0 43gw/d7qq/mlop 8,57
1 034a 28
2 06qr/8pnq 15
3 c1th/b2qy 210
4 c8wz/gbsg/i0xd 20
5 97uv/2g5x/eihv 39,51
6 254d/2jvu/mjvu 16,99,220
7 ggiu/ggzu/g5ig 22,28,238
8 jbnc/i7xe/i7je/icje 2,4,5
9 3cey/0fzo 27,33,99,110,189
10 00ab/p0zd/0ofz/87rs 8,12,28
11 1dsy/2d9s/2s9y 21,42,105,399
12 28db/d0lm/d1i8/l0w5 33,35,55
13 3aen/4fir/1lev 2,20,40,48,60
14 j7ou/3rms/m4vs 3,10,16,42,60
15 336a/3rkw/jlor/3akw 6,21,24,85
16 21om/87bv/67cv 9,15,18,27,30,45
17 4hhx/056u/4rvu 6,20,33,39,42,110
18 b0sh/pgxt/88lq/amux 3,20,35,44,90
19 c0hc/h6md/fdmk/4cfj 2,35,49,60,77
20 0liz/ilvz/0lvr/0rvz 78,104,108,144
21 81ib/q1zb/8cir/qczr 90,100,135,150
22 h7t8/t8ye/g8he/hetz 6,12,30,72,252
23 b5qy/o6qc/21tb/qoyu/b5eu 2,10,18,48,57
24 eajn/jkln/j8ua/nkun/u4wy 6,21,22,60,65
25 wwzz/nfuw/nfzz/41vw/l1r2/nfrg 4,6,9,17
26 46rb/t6xb/m7zk/4hrj/thxj 4,8,10,16,20,36
27 olwx/ogul/ogwx/ogux/agux 10,24,30,72,238
28 b7un/c3hv/fiyo/h6xm 2,10,12,13,16,20,52,143
29 d6qa/o4qr/tcur/9bto 2,4,6,8,15,26,39,44,195
30 2lsx/54hf/k3yi/8dhw/bhny 3,12,18,24,33,60,66
31 apcx/a8pv/7uwx/a2c8/c8pu 2,4,9,10,12,13,34,286
32 7yjz/jywz/7ejz/j5wy/bejz/jewy 4,8,13,80,117,160,260
33 d0wk/5dqu/6lqs/77ae/f4mq/56bm 3,4,5,7,14,18,28,35,49,63
34 d4gn/94in/d4rs/94xu/97xn 6,9,12,18,27,32,48,64,70,96,144
35 l5wh/wdxn/60xs/c5fd/jpwx/mgqx 4,9,10,12,15,18,20,24,30,32
36 5178/58xk/uixk/71u8/71uk/71ui/51ui 4,6,14,20,30,46,161,230
37 m8sp/mosp/2imp/i8sp/2isp/i8si/misp/iosp 4,6,24,36,40,60,112
38 34d5/253k/f4m5/m5rk/2o3u/3udy/fumy/moru 6,7,10,15,28,30,40,75
39 2ilw/mbnc/n9wj/9dmy/6qwy/2ekh/9dkh 1,6,11,18,21,33,72,80,90,96
40 j0le/10uo/q6ue/jeqt/jelf/l6xf 2,4,5,27,28,32,35,36,40,54,63,432
41 j4mu/31r5/qeyf/0f5h/r0v5/00qi/j5kf/jlru 3,4,8,9,10,10,20,27,45,52
42 g8kc/dbuv/gbkc/dbgv/evuw/dbui/d8kw 1,4,6,9,10,12,21,24,39,52,70,130
43 apry/a0ry/a0hx/60hp/6xhy/a0hp/a0hy/6phy/6phx 4,7,32,56,90,100,175,250
44 1eok/33by/d0kz/1rnw 10,10,12,12,14,15,16,21,24,35,40,42,48,49,56,88,98
45 0qbs/6cws/l6xj/659q/03lc/bclp/96dj/96wc 10,12,13,14,14,21,24,42,48,66,77
46 q8sr/98yu/clyn/s8yl/9lqr/0rsu/0l9m/0n9u 4,8,9,12,26,27,28,36,42,57,78,221
47 5sjy/jbsy/8dgp/gkvp/gdvh/jhvp/i2vk 3,4,6,8,9,12,15,15,18,27,36,45,81,84,96
48 42va/10nf/23l6/c2uw/3hpo/4ofu/m7sv 3,5,6,8,8,15,18,20,21,24,27,32,48,50,63,70
49 84lj/10j1/wcxd/ljnl/1njx/01xd/00x1/81wq/1c8q 1,1,4,7,11,14,18,21,33,70,78,117,126
50 kfvg/76vq/136d/6gvq/6g7q/137g/7dmz/63m6/m3vz 2,3,9,10,27,45,50,81,81,90,105,135,150
51 4eht/38jt/jeym/htjv/eeyv/eejt/3myv/h1jt/hejm 4,6,7,12,14,14,16,21,22,24,70,80,120,135
52 smuz/04c7/28zc/83ri/cihu/8flm/masw/8ivo 2,4,6,8,10,10,12,16,16,20,22,24,24,30,30,36,39,48
53 7fuu/17fd/6cpg/fghu/ahnt/adww/rhxz/4hxl/0pby 1,2,2,2,3,3,4,4,4,5,8,8,9,10,12,12,12,12,15,15,16,16,20,24,27,30,32,48").
2019.4.15追加
上のプログラムでは、あらゆる長さの線分を作ってから対応する線分で四角形を作りましたが、
類題を解いた時には、元の線分(四角形)のx座標値、y座標値それぞれ4個をソートして、
内側の2個づつを使って四角形を作りましたので、それに準じて書いてみました。
ただ類題より複雑になった分ソートの要素数が6個に増えます。
msort([Y1,Y2,Y11,Y12,Y21,Y22],[,,Y1,Y2,,])は
msort([Y11,Y12,Y21,Y22],[,Y3,Y4,]),Y3=<Y1,Y2=<Y4と同じです。
また四角形ができるごとにチェックをしてみました。
コード量は減りましたが、実行時間は長くなっています。
con(x,[X1,Y1,X2,Y2],[X1:Y1:Y2,X2:Y1:Y2]).
con(y,[X1,Y1,X2,Y2],[Y1:X1:X2,Y2:X1:X2]).
calc(X1:Y1:X2:Y2,R):-R is (X2-X1)*(Y2-Y1).
ext(XL,R):-
select(X:Y1:Y2,XL,XL1),select(X:Y3:Y4,XL1,XL2),Y1=<Y3,Y3=<Y2,
msort([Y1,Y2,Y3,Y4],[Y5,_,_,Y6]),XL3=[X:Y5:Y6|XL2],ext(XL3,R).
ext(XL,XL).
find(XL,YL,R):-findall(L,find1(XL,YL,L),R).
find1(XL,YL,X1:Y1:X2:Y2):-
select(X1:Y11:Y12,XL,XL1),select(X2:Y21:Y22,XL1,XL2),Y21<Y12,Y11<Y22,
select(Y1:X11:X12,YL,YL1),select(Y2:X21:X22,YL1,YL2),X21<X12,X11<X22,
msort([Y1,Y2,Y11,Y12,Y21,Y22],[_,_,Y1,Y2,_,_]),
msort([X1,X2,X11,X12,X21,X22],[_,_,X1,X2,_,_]),
judg(X1:Y1:X2:Y2,XL2,YL2).
exc(A:B:C:D,B:A:D:C).
judg(SQ,XL,YL):-judg(SQ,YL),exc(SQ,SQ1),judg(SQ1,XL).
judg(_,[]).
judg(X11:Y11:X12:Y12,[Y:X1:X2|T]):-
judg(X11:Y11:X12:Y12,T),not((Y11<Y,Y<Y12,X11<X2,X1<X12)).
solve1(XL,YL,R):-
ext(XL,XL1),ext(YL,YL1),sort(YL1,YL2),sort(XL1,XL2),find(YL2,XL2,R).
solve(L,R):-
maplist(con(x),L,L1),maplist(con(y),L,L2),flatten(L1,XL),flatten(L2,YL),
solve1(XL,YL,L3),maplist(calc,L3,L4),msort(L4,R).