Ｎｅｅｔ脱出記録

今日は遊んでいる。
フリップ・イット・スターという6望星のパズルがある。
これの7望星版を解いてみた。上図の通りである。
ルールは線分の交点と頂点にコインを全部表にしておき一つの頂点だけコインを取り除く。
コインは線分上を移動しほかのコインを一つ以上飛び越す移動だけが許される。
ただし飛び越すとき曲がることは許されないしコインを重ねることも許されない。
コインは開いてる点への移動だけが許される。
飛び越した時、飛び越されたコインは裏返される。
この操作で全てのコインを裏にせよというパズルです。
私はこの手のパズルを手で解くのは苦手なのでＰｒｏｌｏｇ言語で解いてみました。
Ｐｒｏｌｏｇ言語はリストしかないのでこの手の操作は苦手なのだがまあだましだまし解法。


30秒計算、最短手数は22手となった。
手数の表示、ｂが表でｗが裏、番号は上の図と対応。
遊びなのでプログラムミスがあるかまでは検討してないが暇な人はコンピュータが出した手順を検討してほしい。


[[1,b],[2,0],[3,b],[4,b],[5,b],[6,b],[7,b],[8,b],[9,b],[10,b],[11,b],[12,b],[13,b],[14,b]]
[[1,b],[2,b],[3,b],[4,b],[5,b],[6,b],[7,b],[8,b],[9,b],[10,0],[11,w],[12,b],[13,b],[14,b]]
[[1,b],[2,b],[3,b],[4,b],[5,b],[6,b],[7,0],[8,w],[9,w],[10,b],[11,w],[12,b],[13,b],[14,b]]
[[1,b],[2,b],[3,b],[4,b],[5,b],[6,b],[7,w],[8,b],[9,0],[10,b],[11,w],[12,b],[13,b],[14,b]]
[[1,0],[2,b],[3,b],[4,b],[5,b],[6,b],[7,w],[8,b],[9,b],[10,b],[11,b],[12,b],[13,b],[14,b]]
[[1,b],[2,b],[3,b],[4,b],[5,b],[6,b],[7,w],[8,b],[9,w],[10,b],[11,w],[12,b],[13,b],[14,0]]
[[1,b],[2,b],[3,b],[4,b],[5,b],[6,b],[7,w],[8,b],[9,b],[10,b],[11,0],[12,b],[13,b],[14,w]]
[[1,b],[2,w],[3,b],[4,b],[5,b],[6,b],[7,w],[8,b],[9,b],[10,b],[11,b],[12,0],[13,b],[14,w]]
[[1,b],[2,w],[3,w],[4,b],[5,w],[6,b],[7,w],[8,b],[9,b],[10,b],[11,b],[12,b],[13,0],[14,w]]
[[1,b],[2,w],[3,0],[4,b],[5,b],[6,b],[7,w],[8,b],[9,b],[10,b],[11,b],[12,b],[13,w],[14,w]]
[[1,0],[2,b],[3,b],[4,b],[5,b],[6,b],[7,w],[8,b],[9,b],[10,b],[11,b],[12,b],[13,w],[14,w]]
[[1,b],[2,w],[3,w],[4,0],[5,b],[6,b],[7,w],[8,b],[9,b],[10,b],[11,b],[12,b],[13,w],[14,w]]
[[1,b],[2,0],[3,b],[4,w],[5,b],[6,b],[7,w],[8,b],[9,b],[10,b],[11,b],[12,b],[13,w],[14,w]]
[[1,b],[2,b],[3,b],[4,w],[5,b],[6,b],[7,w],[8,b],[9,b],[10,0],[11,w],[12,b],[13,w],[14,w]]
[[1,b],[2,b],[3,b],[4,w],[5,b],[6,b],[7,0],[8,w],[9,w],[10,w],[11,w],[12,b],[13,w],[14,w]]
[[1,b],[2,b],[3,b],[4,w],[5,b],[6,b],[7,w],[8,b],[9,0],[10,w],[11,w],[12,b],[13,w],[14,w]]
[[1,0],[2,b],[3,b],[4,w],[5,b],[6,b],[7,w],[8,b],[9,b],[10,w],[11,b],[12,b],[13,w],[14,w]]
[[1,w],[2,b],[3,b],[4,w],[5,b],[6,b],[7,w],[8,b],[9,w],[10,w],[11,w],[12,b],[13,w],[14,0]]
[[1,w],[2,b],[3,b],[4,w],[5,b],[6,b],[7,w],[8,b],[9,b],[10,w],[11,0],[12,b],[13,w],[14,w]]
[[1,w],[2,w],[3,b],[4,w],[5,b],[6,b],[7,w],[8,b],[9,b],[10,w],[11,b],[12,0],[13,w],[14,w]]
[[1,w],[2,w],[3,w],[4,w],[5,w],[6,b],[7,w],[8,b],[9,b],[10,w],[11,b],[12,w],[13,0],[14,w]]
[[1,w],[2,w],[3,w],[4,w],[5,w],[6,w],[7,w],[8,w],[9,b],[10,w],[11,b],[12,w],[13,w],[14,0]]
[[1,0],[2,w],[3,w],[4,w],[5,w],[6,w],[7,w],[8,w],[9,w],[10,w],[11,w],[12,w],[13,w],[14,w]]


以下プログラム。

perm([1,2,3,4]).
perm([4,5,6,7]).
perm([7,8,9,10]).
perm([10,11,2,12]).
perm([12,3,5,13]).
perm([13,6,8,14]).
perm([14,9,11,1]).

perm2(Perm,Perm).
perm2(Perm,Perm2):-reverse(Perm,Perm2).

flip_area([0,1,2]).
flip_area([1,2,3]).
flip_area([0,1,2,3]).


flip(w,b).
flip(b,w).


change1(Board,[E],[[E,0]|Board1],Color):-
!,
select([E,Color],Board,Board1).
change1(Board,[E|Es],[[E,C1]|NextBoard],Color):-
select([E,C],Board,Board1),
flip(C,C1),
change1(Board1,Es,NextBoard,Color).


change(Board,Move,[[ETop,Color]|NextBoard]):-
flip_area(Area),
findall(E1,(member(E,Area),nth0(E,Move,E1)),Es),
[ETop|Es1]=Es,
select([ETop,0],Board,Board1),
change1(Board1,Es1,NextBoard,Color).


next_calc(Turn,Nows,[Next1,Turn,Board]):-
member(Board,Nows),
perm(Move),
perm2(Move,Move2),
change(Board,Move2,Next),
sort(Next,Next1).




isBig([],[]):-!,fail.
isBig([[_,A]|Rest],[[_,A]|Rest1]):-!,isBig(Rest,Rest1).
isBig([[_,A]|_],[[_,B]|_]):-sort([A,B],[A,B]),!.
isBig(_,_):-!,fail.

oks([],Nexts,Nexts):-!.
oks(_,[],[]):-!.
oks([A|Rest],[A|Rest1],Result):-!,oks(Rest,Rest1,Result).
oks([A|Rest],[B|Rest1],Result):-
isBig(A,B),
!,
oks(Rest,[B|Rest1],Result).
oks(Olds,[E|Next],[E|Result]):-
!,
oks(Olds,Next,Result).


count([],Sum,Sum):-!.
count([[_,b]|Rest],Sum,Result):-
Sum1 is Sum+1,
count(Rest,Sum1,Result).
count([_|Rest],Sum,Result):-
count(Rest,Sum,Result).




union_dell([E,Turn,B],[],[[E,Turn,B]]):-!.
union_dell([E,Turn,B],[[E,_,_]|Rest],Result):-
!,
union_dell([E,Turn,B],Rest,Result).
union_dell([E,Turn,B],[[E1,Turn1,B1]|Rest],[[E,Turn,B]|Result]):-
!,
union_dell([E1,Turn1,B1],Rest,Result).

getFront([],[]):-!.
getFront([[E,_,_]|Rest],[E|Result]):-getFront(Rest,Result).

chain(_,[],[]):-!.
chain(Chain,Now,[Now|Result]):-
member([Now,_,Back],Chain),
chain(Chain,Back,Result).

myprint([]):-!.
myprint([X|Xs]):-nl,write(X),myprint(Xs).


chain_dell(_,[],[]):-!.
chain_dell([[N,Turn,B]|Rest],[N|Rest1],[[N,Turn,B]|Result]):-
!,
chain_dell(Rest,Rest1,Result).
chain_dell([_|Rest],Nexts,Result):-
!,
chain_dell(Rest,Nexts,Result).

search(_,Nows,Turn,Chain):-
member(E,Nows),
count(E,0,C),
C=:=13,
!,
write(E),
write(Turn),
chain(Chain,E,Ans),
myprint(Ans).

search(Olds,Nows,Turn,Chain):-
!,
findall(E,next_calc(Turn,Nows,E),Datas),
getFront(Datas,Nexts),
sort(Nexts,Nexts1),
Turn1 is Turn+1,
length(Nexts1,Len),
write([Turn,Len]),nl,
append(Nows,Olds,Olds1),
sort(Olds1,Olds2),
oks(Olds2,Nexts1,Nexts2),
sort(Datas,Datas1),
chain_dell(Datas1,Nexts2,Datas2),
append(Chain,Datas2,Chain1),
sort(Chain1,[Top2|Chain2]),
union_dell(Top2,Chain2,Chain3),
search(Olds2,Nexts2,Turn1,Chain3).


main:-
A=[[1,0],[2,w],[3,w],[4,w],[5,w],[6,w],[7,w],[8,w],[9,w],[10,w],[11,w],[12,w],[13,w],[14,w]],
search([],[A],0,[[A,-1,[]]]).