0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

オフラインリアルタイムどう書く(E32)

Last updated at Posted at 2019-04-08

問題はこちら->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).
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?