Skip to content

Instantly share code, notes, and snippets.

@pragdave
Created January 2, 2020 17:23
Show Gist options
  • Save pragdave/0207669683ab18b28caa8e5732ed1f67 to your computer and use it in GitHub Desktop.
Save pragdave/0207669683ab18b28caa8e5732ed1f67 to your computer and use it in GitHub Desktop.
ascending([]).
ascending([_]).
ascending([H | [ S | T ]]) :-
H < S,
ascending([S | T]),
!.
valid([P1, P2, P3]) :-
ascending(P1),
ascending(P2),
ascending(P3),
!.
make_a_move([[H|R], P2, P3], [R, [H|P2], P3], [H,1,2]).
make_a_move([[H|R], P2, P3], [R, P2, [H|P3]], [H,1,3]).
make_a_move([P1, [H|R], P3], [[H|P1], R, P3], [H,2,1]).
make_a_move([P1, [H|R], P3], [P1, R, [H|P3]], [H,2,3]).
make_a_move([P1, P2, [H|R]], [[H|P1], P2, R], [H,3,1]).
make_a_move([P1, P2, [H|R]], [P1, [H|P2], R], [H,3,2]).
hanoi(Goal, Goal, _, []).
hanoi(From, To, AlreadyTried, [ Move | Rest ]) :-
make_a_move(From, Intermediate, Move),
not(member(Intermediate, AlreadyTried)),
valid(Intermediate),
hanoi(Intermediate, To, [ Intermediate | AlreadyTried ], Rest).
h(Stack, Moves) :-
hanoi([Stack, [], []], [[], Stack, []], [ [Stack, [], []] ], Moves).
@UWN
Copy link

UWN commented Jan 4, 2020

First, it seems that you have a very specific idea what declarative means. From what I gathered, you expect from a declarative description/program primarily that it is "algorithm free" and free of any procedural and non-functional concerns like resource consumption and non-termination. In the context of Prolog and logic programming, declarative has a much more restricted meaning: That the meaning of a program is given by a declarative reading ; and that the actual execution will be that meaning too, modulo some procedural issues like time and space consumption. Ensuring that Prolog programs have such a declarative reading is not that obvious since many problematic constructs have entered the language. See [logical-purity] on SO for attempts to regain the territory for purity.

Now for the current problem: Evidently, the search space is quite large, maybe there are loops inside that cannot be found by your loop checker. What about constructing redundant situations and thinking about it? Touching the same disk twice does not make sense (two reasons, loops and a redundant intermediary). But what about cycles of length 3? What is their nature?

By adapting the program minimally:

:- use_module(library(clpq)).
ascending([]).
ascending([H|Hs]) :-
   iascending(Hs, H).

iascending([], _).
iascending([S|_], H) :-
  {H < S}.  % for diagnosis, otherwise H < S

make_a_move([[H|R], P2,    P3],       [R,      [H|P2], P3],     H:(1->2)) :- ascending([H|P2]).
make_a_move([[H|R], P2,    P3],       [R,      P2,     [H|P3]], H:(1->3)) :- ascending([H|P3]).
make_a_move([P1,    [H|R], P3],       [[H|P1], R,      P3],     H:(2->1)) :- ascending([H|P1]).
make_a_move([P1,    [H|R], P3],       [P1,     R,      [H|P3]], H:(2->3)) :- ascending([H|P3]).
make_a_move([P1,    P2,    [H|R]],    [[H|P1], P2,     R],      H:(3->1)) :- ascending([H|P1]).
make_a_move([P1,    P2,    [H|R]],    [P1,     [H|P2], R],      H:(3->2)) :- ascending([H|P2]).
%                                                               ^^^ better readable

(Most important is the < from clpq, which already fails for: {X<Y},X =Y)

| ?- _=[A,B,C], make_a_move(A,B, QuaAB), make_a_move(B,C,QuaBC), make_a_move(C,A,QuaCA).
%  ^^^ to get A,B,C first as answer substitutions.
A = [[_A],[],[]],
B = [[],[_A],[]],
C = [[],[],[_A]],
QuaAB = _A:(1->2),
QuaBC = _A:(2->3),
QuaCA = _A:(3->1) ? ;
...
% most interesting case with all three lists not fixed in length:
A = [[_A,_B|_C],[_D|_E],[_F|_G]],
B = [[_B|_C],[_A,_D|_E],[_F|_G]],
C = [[_B|_C],[_D|_E],[_A,_F|_G]],
QuaAB = _A:(1->2),
QuaBC = _A:(2->3),
QuaCA = _A:(3->1),
{_A-_D<0},
{_A-_F<0},
{_A-_B<0} ? ;

After this it seems that all cases move the same disk _A. Is this really true? Let's ask the opposite:

| ?- _=[A,B,C], make_a_move(A,B, QuaAB), QuaAB=AB:_, make_a_move(B,C,QuaBC), QuaBC=BC:_, dif(AB,BC),
                      make_a_move(C,A,QuaCA), QuaCA=CA:_, dif(BC,CA).
no

Therefore: When the same disk cannot be drawn in the next move, cycles of 3 are impossible.

Where can you come to comparable conclusions so easily?

BTW, with the help of length/2 as indicated by @triska and above optimization, I conclude that:

| ?- N +\ ( length(Hs,N), h([1,2,3,4,5],Hs) ).
N = 31 ? ...
| ?- N+\ ( findall(t,h([1,2,3,4],Hs),Ts),length(Ts,N) ).
N = 1872

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment