問題はこちら->http://nabetani.sakura.ne.jp/hena/ord17foldcut/
問題が動画で珍しく、かつ難しそうなので挑戦してみました。かなり苦労しました。
配列を使いましたので、まずはPrologでなくJuliaで書いてみました。
後で見ましたら
https://qiita.com/pazworld/items/8ba64dcf900e0548f402
に数理的な解説と簡潔なプログラムが載っていましたが、
当然ながら私にはそのような解析はできませんので、
逐次実行して変化を追う方法でプログラミングしました。
その際の基本的な事項は、
① 切ってできる穴は（「穴」と表現）は、辺の背と直角に折ってできた角に、その背の数だけできる。
②「穴」は角が移動しても変化しないので、折り目と反対側の角の「穴」は、
もとからの「穴」と折って重なった角の「穴」の合計になる。
③折った部分の辺は背になり、その数は、折る前の背の数の二倍と端の数を足したもの。
その隣接する辺は元の状態の重なりとなり、対辺は元の対辺同士を合わせた状態となる。
hen[1, ]は端の数、hen[2, ]は背の数、kakは「穴」の数。
str="""0 RRTRB-bl 6
1 R-tr 0
2 L-br 0
3 T-tl 0
4 B-tl 0
5 BL-br 0
6 LB-tl 0
7 RL-tl 0
8 BL-tl 0
9 TL-bl 0
10 RT-tr 1
11 TRB-tl 0
12 TRL-bl 0
13 TRB-br 2
14 LLB-bl 2
15 RTL-tr 1
16 LBB-tr 0
17 TLL-tl 2
18 RLRR-tr 0
19 BBTL-tl 4
20 TBBT-tr 0
21 LLBR-tl 0
22 LBRT-tl 2
23 RLBL-bl 4
24 BRRL-br 3
25 TBBTL-tl 8
26 TLBBT-br 0
27 LRBLL-br 7
28 TRRTT-br 6
29 BBBLB-br 0
30 RTTTR-tl 4
31 BBLLL-br 6
32 RRLLTR-tr 16
33 TTRBLB-br 8
34 LRBRBR-bl 14
35 RBBLRL-tl 8
36 RTRLTB-tl 12
37 LBLRTR-tl 14
38 RRLTRL-tl 16
39 TBLTRR-br 12
40 TTTRLTT-bl 30
41 TBBRTBL-tr 15
42 TRTRTLL-tr 28
43 TLLRTRB-tr 24
44 RLLBRLB-tr 15
45 LTLRRBT-tr 32
46 RBBRBLT-br 21
47 LLRLRLR-tr 0"""
function fold(input,hen,kak)
#lt->1,rt->2,top->3,bottom->4
if input=='R'
#tl->1,tr->2,bl->3,br->4
t,f,r,le,fr,tr,fl,tl=1,2,3,4,2,1,4,3
elseif input== 'L'
t,f,le,r,fr,tr,fl,tl=2,1,3,4,3,4,1,2
elseif input=='T'
t,f,r,le,fr,tr,fl,tl=4,3,1,2,1,3,2,4
else #if input== Char('B')
t,f,le,r,fr,tr,fl,tl=3,4,1,2,4,2,3,1
end
kak[tr]=kak[tr]+kak[fr]
kak[tl]=kak[tl]+kak[fl]
kak[fr]=hen[2,r]
kak[fl]=hen[2,le]
for i in 1:2
hen[i,t]=hen[i,t]+hen[i,f]
hen[i,r]=hen[i,r]*2
hen[i,le]=hen[i,le]*2
end
hen[2,f]=hen[2,f]*2+hen[1,f]
hen[1,f]=0
end
function cut(c,kak)
if c== "tl"
p=1
elseif c== "tr"
p=2
elseif c== "bl"
p=3
elseif c== "br"
p=4
end
return kak[p]
end
function solve(str1,str2,hen,kak)
for i in 1:4
hen[1,i]=1
kak[i]=0
hen[2,i]=0
end
for s in str1
fold(s,hen,kak)
end
return cut(str2,kak)
end
function main(str)
hen=Array(Int,2,4)
kak=Array(Int,4)
str1=split(str,"\n")
for s in str1
s1=split(s," ")
s2=split(s1[2],"-")
ans=solve(strip(s2[1]),s2[2],hen,kak) #strip 前後の空白削除
if parse(s1[3])==ans
sel="pass"
else
sel="fail"
end
print(sel," ",s1[3]," ",ans,"\n")
end
end
main(str)
上のをPrologに移植してみました。
今回はfunctorではなくlistとnth/3を用いました。
nth/3は効率が悪いようですが、このくらいの問題なら大丈夫です。
in('R',2,1,3,4,2,1,4,3).
in('L',1,2,4,3,3,4,1,2).
in('T',3,4,1,2,1,3,2,4).
in('B',4,3,2,1,4,2,3,1).
fold([],_,K,K):-!.
fold([H|ST],HEN,KAK,RK):-in(H,F,T,R,L,FR,TR,FL,TL),length(K1,4),
nth1(TR,KAK,Z1),nth1(FR,KAK,Z2),Z3 is Z1+Z2,nth1(TR,K1,Z3),
nth1(TL,KAK,Z4),nth1(FL,KAK,Z5),Z6 is Z4+Z5,nth1(TL,K1,Z6),
nth1(R,HEN,(X1,Y1)),nth1(FR,K1,Y1),nth1(L,HEN,(X2,Y2)),nth1(FL,K1,Y2),
length(H1,4),nth1(T,HEN,(X3,Y3)),nth1(F,HEN,(X4,Y4)),
X5 is X3+X4,Y5 is Y3+Y4,nth1(T,H1,(X5,Y5)),
X6 is X1*2,Y6 is Y1*2,nth1(R,H1,(X6,Y6)),
X7 is X2*2,Y7 is Y2*2,nth1(L,H1,(X7,Y7)),
Y8 is Y4*2+X4,nth1(F,H1,(0,Y8)),
fold(ST,H1,K1,RK).
cut(C,KAK,N):-L=["tl","tr","bl","br"],nth1(M,L,C),nth1(M,KAK,N),!.
solve(S,C,N):-
length(HEN,4),maplist(=((1,0)),HEN),KAK=[0,0,0,0],fold(S,HEN,KAK,RK),cut(C,RK,N),!.
disp(N,Q):-atom_number(Q,NQ),(N==NQ->Str=" pass ";Str=" fail "),write(Str),writeln(N),!.
start:-str(S),split_string(S,"\s,\n","\s",L0),pre(L0),!.
pre([]):-!.
pre([_,P,Q|T]):-
split_string(P,"-","",[S,C]),atom_chars(S,S1),solve(S1,C,N),disp(N,Q),pre(T).
str("0 RRTRB-bl 6
1 R-tr 0
2 L-br 0
3 T-tl 0
4 B-tl 0
5 BL-br 0
6 LB-tl 0
7 RL-tl 0
8 BL-tl 0
9 TL-bl 0
10 RT-tr 1
11 TRB-tl 0
12 TRL-bl 0
13 TRB-br 2
14 LLB-bl 2
15 RTL-tr 1
16 LBB-tr 0
17 TLL-tl 2
18 RLRR-tr 0
19 BBTL-tl 4
20 TBBT-tr 0
21 LLBR-tl 0
22 LBRT-tl 2
23 RLBL-bl 4
24 BRRL-br 3
25 TBBTL-tl 8
26 TLBBT-br 0
27 LRBLL-br 7
28 TRRTT-br 6
29 BBBLB-br 0
30 RTTTR-tl 4
31 BBLLL-br 6
32 RRLLTR-tr 16
33 TTRBLB-br 8
34 LRBRBR-bl 14
35 RBBLRL-tl 8
36 RTRLTB-tl 12
37 LBLRTR-tl 14
38 RRLTRL-tl 16
39 TBLTRR-br 12
40 TTTRLTT-bl 30
41 TBBRTBL-tr 15
42 TRTRTLL-tr 28
43 TLLRTRB-tr 24
44 RLLBRLB-tr 15
45 LTLRRBT-tr 32
46 RBBRBLT-br 21
47 LLRLRLR-tr 0").
2018.12.2追加。
折り終わったところから逆方向に開いていく方法は難しいという先入観があったのですが、
最近このシリーズの"山折り谷折り"という問題を解いた時に試してみて好感触を得ましたので、
この問題でも挑戦してみました。
別解での経験が生きたか思いのほかスムーズに解けました。
穴の数を直接追えますので、理屈もわかりやすく、コードもすっきりしました。
別解では計算が多かったので、変数を操作して計算のコードの重複を防ぎましたが、
今回は普通に書きました。
開いた後の穴の数は、開く前の穴の数の二倍と背の切り込みの数の和です。
変数はC:穴の数、他はすべて切込みの数で、Le:左辺,Ri:右辺,U:上辺,B:下辺,TL:左上角,
TR:右上角,BR:右下角,BL左下角です。
cut("bl",[0,0,0,0,0,0,0,0,1]).
cut("br",[0,0,0,0,0,0,0,1,0]).
cut("tl",[0,0,0,0,0,1,0,0,0]).
cut("tr",[0,0,0,0,0,0,1,0,0]).
expa('R',[C,Le,Ri,U,B,TL,TR,BR,BL],[C1,Le,Le,U1,B1,TL,TL,BL,BL]):-
U1 is U*2+TR,B1 is B*2+BR,C1 is C*2+Ri.
expa('L',[C,Le,Ri,U,B,TL,TR,BR,BL],[C1,Ri,Ri,U1,B1,TR,TR,BR,BR]):-
U1 is U*2+TL,B1 is B*2+BL,C1 is C*2+Le.
expa('T',[C,Le,Ri,U,B,TL,TR,BR,BL],[C1,Le1,Ri1,B,B,BL,BR,BR,BL]):-
Le1 is Le*2+TL,Ri1 is Ri*2+TR,C1 is C*2+U.
expa('B',[C,Le,Ri,U,B,TL,TR,BR,BL],[C1,Le1,Ri1,U,U,TL,TR,TR,TL]):-
Le1 is Le*2+BL,Ri1 is Ri*2+BR,C1 is C*2+B.
solve(L,C,R):-reverse(L,L1),cut(C,L0),foldl(expa,L1,L0,[R|_]).
start:-str(S),split_string(S,"\s,\n","\s",L0),pre(L0),!.
pre([]):-!.
pre([_,P,Q|T]):-
split_string(P,"-","",[S,C]),atom_chars(S,S1),solve(S1,C,N),disp(N,Q),pre(T).
disp(N,Q):-
atom_number(Q,NQ),(N==NQ->Str=" pass ";Str=" fail "),write(Str),writeln(N)