オフラインリアルタイムどう書く過去問(F05),CodeIQ(正六角形ブロックの回転)

今回も＠Nabetaniさんのどう書くとCodeIQの似た問題の解答を投稿します。

まず「ブロックを回す」。
問題はこちら->http://nabetani.sakura.ne.jp/hena/ordf05rotblo/
　
bで回転すると一列左にずれ、aで回転すると一列左にずれたうえ一行下にずれます。
回転してから不可を除外しても良いのですが、a,bの特徴に従い先に除外します。
残りは回転後、すべてのリストの先頭を除き末尾に0を加え、
更に'a'のときは最後のリストを先頭に回します。(先頭に[0,0,0,0,0]を加え最後のリストを削除)

%swi-Prolog  version 7.4.2
%start.

rotate(L,L1):-L=[H|T],maplist([A,B]>>(B=[A]),H,H1),foldl(apall,T,H1,L1).   %90do kaiten
apall([],[],[]).
apall([H1|T1],[H2|T2],R):-apall(T1,T2,R1),H3=[H1|H2],R=[H3|R1].

atos(L,R):-maplist(atomics_to_string,L,L1),atomics_to_string(L1,"/",R).

shape([_|T],R):-append(T,[0],R),!.  %list sentou no 0 wo nozokuki saigo ni 0 wo kuwaeru

solve("a",L,"-"):-reverse(L,[H|_]),member('1',H),!.
solve("a",L,"-"):-maplist(nth1(5),L,H),member('1',H),!.
solve("b",L,"-"):-reverse(L,[H|_]),member('1',H),!.
solve(P,L,R):-rotate(L,L1),solve1(P,L1,L2),(L2==[]->R="-";atos(L2,R)).                  %90 do kaiten

solve1("a",L,L6):-
     maplist(shape,L,L4),reverse(L4,[L0|T2]),reverse(T2,L5),L6=[L0|L5],!.  % saigo no list wo sentou ni mawasu

solve1("b",L,L4):-
     maplist(shape,L,L4).

start:-str(S),split_string(S,"\s\n","\s",L),pre(L),!.

pre([]).
pre([_,B,C|D]):-split_string(B,"/,:","",[H|T]),maplist(atom_chars,T,L),
               solve(H,L,R),disp(R,C),pre(D).

disp(R,C):-(R==C->Str=" pass";Str=" fail"),write(Str),write(" "),writeln(R).


str("0         a:00000/00110/00100/00100/00000    00000/00000/00000/11100/00100
1       b:00000/00000/00000/00011/00011         -
2       a:00000/00000/00000/00011/00011         -
3       b:00000/00000/00100/00000/00000         00000/00000/01000/00000/00000
4       a:00000/00000/00100/00000/00000         00000/00000/00000/01000/00000
5       b:00000/00110/00100/00100/00000         00000/00000/11100/00100/00000
6       b:00000/00000/00011/00011/00000         00000/00000/00000/11000/11000
7       a:00000/00000/00011/00011/00000         -
8       a:01110/00100/00000/00000/00000         00000/00000/00010/00110/00010
9       b:01110/00100/00000/00000/00000         00000/00010/00110/00010/00000
10      a:00000/11110/00000/00000/00000         00000/00100/00100/00100/00100
11      b:00000/11110/00000/00000/00000         00100/00100/00100/00100/00000
12      a:00000/00011/00110/00000/00000         -
13      b:00000/00011/00110/00000/00000         00000/00000/01000/01100/00100
14      a:00000/11100/11100/11100/00000         00000/11100/11100/11100/00000
15      b:00000/11100/11100/11100/00000         11100/11100/11100/00000/00000
16      a:01000/00000/00101/10010/10001         -
17      b:01000/00000/00101/10010/10001         -
18      b:10000/00000/10010/00000/00000         01010/00000/00000/01000/00000
19      a:10000/00000/10010/00000/00000         00000/01010/00000/00000/01000
20      a:00000/10101/11010/11010/01000         -
21      b:00000/10101/11010/11010/01000         -
22      b:01101/00011/01101/00000/00000         00000/01010/01010/00100/01110
23      a:01101/00011/01101/00000/00000         -
24      a:00001/00000/00000/00100/00010         -
25      b:00001/00000/00000/00100/00010         -
26      b:00100/00000/00100/01000/00000         00000/10000/01010/00000/00000
27      a:00100/00000/00100/01000/00000         00000/00000/10000/01010/00000
28      a:00010/00100/00000/10000/00000         00000/10000/00000/00100/00010
29      b:00010/00100/00000/10000/00000         10000/00000/00100/00010/00000
30      b:11010/00011/10101/00001/00001         -").

次にCodeIQの「正六角形ブロックの回転」です。
http://nabetani.hatenablog.com/
https://blog.goo.ne.jp/r-de-r/e/116074e5de592083784034b1f6eb6b24
テストケースは上記より拝借しました。

x軸を左から右へ横向きに、y軸を右上から左下にとり、左上の座標を(1,1)とします。
左側が平行四辺形になるようにy>3のときx座標をx+(y-3)とします。
aを中心に回転
　ブロックのベクトルをa(x0,y0)を原点とするx軸に平行なベクトル(x-x0,0)と
　y軸に平行なベクトル(0,y-y0)の合成とし、回転後のブロックのベクトルは、
　回転後の二つのベクトル(0,x-x0),(-(y-y0),-(y-y0))の合成と考えます。(rota/4)
bを中心に回転
　中央のx軸に平行な直線上の点を(x,3)とすると、ブロック(x,y)へのベクトルは(0,y-3)となり、
　回転により(x,3)がy軸に平行な対角線上の(3,x-1)に移り、
　ベクトル(0,y-3)が(-(y-3),-(y-3))に変わりますので、
　新しいブロックの座標は(3-(y-3),(x-1)-(y-3))となります。(rotb/4)
out/2で六角形をはみ出したものを除外します。

%swi-Prolog  version 7.4.2
%start.
%:-initialization(start).   %ideone

rotab(C,X,Y,[XR,YR]):-C=="a"->rota(X,Y,XR,YR);rotb(X,Y,XR,YR).
rota(X,Y,RX,RY):-
     X0=2,Y0=3,X1 is X0+Y0-Y,Y1 is Y0+(X-X0)+(Y0-Y),
     (out(X1,Y1)->(RX=X1,RY=Y1);(RX=0,RY=0)),!.
rotb(X,Y,RX,RY):-X1 is 3-(Y-3),Y1 is X-1-(Y-3),
     (out(X1,Y1)->(RX=X1,RY=Y1);(RX=0,RY=0)),!.

out(X,Y):-(0<Y,Y<4,0<X,X<3+Y);(3<Y,Y<6,Y-3<X,X<10-Y).

makes(0,_,"").
makes(N,L,R):-
     N1 is N-1,makes(N1,L,R1),(N>3->M is 8-N;M is N+2),makes1(N,M,L,R2),
     string_concat(R1,"/",R3),string_concat(R3,R2,R).
makes1(N,0,_,"").
makes1(N,M,L,R):-
     M1 is M-1,makes1(N,M1,L,R1),(N>3->M2 is M+(N-3);M2=M),
     (member([M2,N],L)->string_concat(R1,"1",R);string_concat(R1,"0",R)).

solve(C,L,R):-
     findall(R1,(between(1,5,Y),nth1(Y,L,L1),length(L1,N),between(1,N,X),nth1(X,L1,'1'),
     (Y>3->X1 is X+(Y-3);X1=X),rotab(C,X1,Y,R1)),R2),
     (member([0,0],R2)->R="-";
     (makes(5,R2,R3),string_length(R3,M),M1 is M-1,sub_string(R3,1,M1,_,R))),!.

start:-f68(S),split_string(S,"\s","\s",[C,D,A]),atomics_to_string(L,"/",D),
     maplist(atom_chars,L,L1),solve(C,L1,R),disp(R,A),fail.
start.

disp(R,A):-(R==A->write("pass ");write(" fail ")),writeln(R),!.

f68("a 110/1010/11100/1100/000 000/1100/11100/1010/110").
f68("b 000/0011/01101/0001/010 101/0010/01010/0110/000").
f68("a 000/0100/01100/0000/000 000/0000/01000/1100/000").
f68("b 000/0011/00111/0011/010 100/0110/01110/0110/000").
f68("a 100/0100/10100/0100/000 000/0100/10000/1110/000").
f68("b 000/0100/00110/0000/011 100/1011/00100/0000/000").
f68("a 000/1100/01100/0000/000 000/0000/01100/1100/000").
f68("b 000/0011/00000/0010/010 100/0100/00010/0010/000").
f68("a 010/0111/11000/0000/101 -").
f68("b 110/0000/10000/0110/010 -").
f68("a 110/1101/01001/1010/000 -").
f68("b 011/1111/10000/0110/111 -").