Tuesday, 6 June 2023

Prolog でハノイの塔

twitter で、そんな話題が。で、ちょっと書いてみました。いや、たぶん、期待されていたものとは違うんだけど。

もともと、こんな感じで

  変数は1文字
  リストは [a,b,c] または [X|H]

とかで、はっきりいって

  ほとんど読めない

しかも、差分リストが普通で「プログラムの意味」とかとも関係ない。そんな残念な感じでな。

さらに、Concurrent Prolog / KL/1 / GHC / Xtal と、さらにまったく違う言語に。A'um とかもあった。

はまっていた頃は楽しかったんですけどね。

この読めない感じが良い。ちゃんと全部表示させるにはスタックを可視化しないとだめなんだが、さぼってます。

あと、入力が正しい(降順なListの三つの分割)を見ないと正しく動かないな。ま、fail するだけですが。

move10, move12 とか六種類あるわけだが、一つにまとめることも可能。でも、

  六種類を生成する Prolog program を作って、それを動かす

ことも可能。このあたりが Prolog の醍醐味だったが...

move02(([A,B|X],Y,Z),(X2,Y2,[A|Z2])) :- A =:= B + 1,
write(([A,B|X],Y,Z)),nl,
move01(([B|X],Y,Z),(X1,Y1,Z1)), % move upper to 1
move12((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 2, move upper from 1 to 2
move02(([A|X],[B|Y],Z),(X2,Y2,[A|Z2])) :- A =:= B + 1,
write((([A|X],[B|Y],Z),Y,Z)),nl,
move12((X,[B|Y],Z),(X2,Y2,Z2)). % put A to 2, then move upper from 1 to 2
move02(([A|X],Y,[B|Z]),(X2,Y2,[A|Z2])) :- A =:= B + 1,
write(([A|X],Y,[B|Z])),nl,
move21((X,Y,[B|Z]),(X1,Y1,Z1)), % move upper to 1
move12((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 2, then move upper from 1 to 2
move02(([1],[],[]),([],[],[1])).
move01(([A,B|X],Y,Z),(X2,[A|Y2],Z2)) :- A =:= B + 1,
write(([A,B|X],Y,Z)),nl,
move02(([B|X],Y,Z),(X1,Y1,Z1)), % move upper to 2
move21((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 1, then move upper from 2 to 1
move01(([A|X],[B|Y],Z),(X2,[A|Y2],Z2)) :- A =:= B + 1,
write(([A|X],[B|Y],Z)),nl,
move12((X,[B|Y],Z),(X1,Y1,Z1)), % move upper to 2
move21((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 1, then move upper from 2 to 1
move01(([A|X],Y,[B|Z]),(X2,[A|Y2],Z2)) :- A =:= B + 1,
write(([A|X],Y,[B|Z])),nl,
move21((X,Y,Z),(X2,Y2,Z2)). % put A to 1, then move upper from 2 to 1
move01(([1],[],[]),([],[1],[])).
move21((X,Y,[A,B|Z]),(X2,[A|Y2],Z2)) :- A =:= B + 1,
write((X,Y,[A,B|Z])),nl,
move20((X,Y,[B|Z]),(X1,Y1,Z1)), % move upper to 0
move01((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 1, then move upper from 0 to 1
move21((X,[B|Y],[A|Z]),(X2,[A|Y2],Z2)) :- A =:= B + 1,
write((X,[B|Y],[A|Z])),nl,
move10((X,[B|Y],Z),(X1,Y1,Z1)), % move upper to 0
move01((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 1, then move upper from 0 to 1
move21(([B|X],Y,[A|Z]),(X2,[A|Y2],Z2)) :- A =:= B + 1,
write(([B|X],Y,Z)),nl,
move01(([B|X],Y,Z),(X2,Y2,Z2)). % put A to 1, then move upper from 0 to 1
move21(([],[],[1]),([],[1],[])).
move12(([B|X],[A|Y],Z),(X2,Y2,[A|Z2])) :- A =:= B + 1,
write(([B|X],[A|Y],Z)),nl,
move02(([B|X],Y,Z),(X2,Y2,Z2)). % put A to 2, move upper from 0 to 2
move12((X,[A,B|Y],Z),(X2,Y2,[A|Z2])) :- A =:= B + 1,
write((X,[A,B|Y],Z)),nl,
move10((X,[B|Y],Z),(X1,Y1,Z1)), % move upper to 0
move02((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 2, then move upper from 0 to 2
move12((X,[A|Y],[B|Z]),(X2,Y2,[A|Z2])) :- A =:= B + 1,
write((X,[A|Y],[B|Z])),nl,
move20((X,Y,[B|Z]),(X1,Y1,Z1)), % move upper to 1
move02((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 2, then move upper from 0 to 2
move12(([],[1],[]),([],[],[1])).
move10(([B|X],[A|Y],Z),([A|X2],Y2,Z2)) :- A =:= B + 1,
write(([B|X],[A|Y],Z)),nl,
move02(([B|X],Y,Z),(X1,Y1,Z1)), % move upper to 2
move20((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 0, move upper from 2 to 1
move10((X,[A,B|Y],Z),([A|X2],Y2,Z2)) :- A =:= B + 1,
write((X,[A,B|Y],Z)),nl,
move12((X,[B|Y],Z),(X1,Y1,Z1)), % move upper to 2
move20((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 0, then move upper from 2 to 1
move10((X,[A|Y],[B|Z]),([A|X2],Y2,Z2)) :- A =:= B + 1,
write((X,[A|Y],[B|Z])),nl,
move20((X,Y,[B|Z]),(X2,Y2,Z2)). % put A to 2, then move upper from 0 to 2
move10(([],[1],[]),([1],[],[])).
move20(([B|X],Y,[A|Z]),([A|X2],Y2,Z2)) :- A =:= B + 1,
write(([B|X],Y,[A|Z])),nl,
move01(([B|X],Y,Z),(X1,Y1,Z1)), % move upper to 1
move10((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 0, move upper from 1 to 0
move20((X,[B|Y],[A|Z]),([A|X2],Y2,Z2)) :- A =:= B + 1,
write((X,[B|Y],[A|Z])),nl,
move10((X,[B|Y],Z),(X2,Y2,Z2)). % put A to 0, then move upper from 1 to 0
move20((X,Y,[A,B|Z]),([A|X2],Y2,Z2)) :- A =:= B + 1,
write((X,Y,[A,B|Z])),nl,
move21((X,Y,[B|Z]),(X1,Y1,Z1)), % move upper to 1
move10((X1,Y1,Z1),(X2,Y2,Z2)). % put A to 0, then move upper from 1 to 0
move20(([],[],[1]),([1],[],[])).
hanoi :- move02(([4,3,2,1],[],[]),_).
view raw hanoi.pl hosted with ❤ by GitHub

No comments: