Libraries: queues and heaps

Hi, so there is the '83 version of the code in the queues.pl you have shared; and the '90 version of the code in Scryer Prolog. The Scryer Prolog version as here is indeed copied verbatim from “The Craft of Prolog” pp 50-51.

The other libraries don’t come with source code or rather, I couldn’t find it easily.

Is there any particular criteria by which you’d like to evaluate the options? Specifically, do you have some (performance?) test cases outside of the very minimal correctness tests I have put in my proposal above?

Finally, the naming of predicates is all over the place (personal opinion), but sticking to something that exists already is probably better.


The s(N) trick replaces testing for Back \== Back before removing from the queue. I suspect that this is one possible source of difference in cpu and memory efficiency. There is some other insignificant difference between the Scryer/textbook code and my code that might or might not have a measurable effect.

This afternoon I worked on the Manhattan distance (which is another heuristic function that is used to solve such problems). Below I share the code. It seems to work. I’m somewhat happy with it because it was somewhat more complicated to figure out how to proceed, it took some effort. In the end I had to use a dictionary (with which I’m not so confident) but it was the best way to search a value stored under a certain key whose position you may not know in advance. It should probably perform better than the hamming distance because the estimate is more accurate but I didn’t test it:

% Manhattan heuristic function
manhattan(Board, Goal, Estimate) :-
    board_to_manhattan(Board, PairsList1),
    board_to_manhattan(Goal, PairsList2),
    dict_create(GoalDict, goal, PairsList2),
    manhattan_calc(PairsList1, GoalDict, 0, Estimate),
    !.

board_to_manhattan(board(X1, X2, X3, X4, X5, X6, X7, X8, X9), [X1-(1, 1), X2-(1, 2), X3-(1, 3), X4-(2, 1), X5-(2, 2), X6-(2, 3), X7-(3, 1), X8-(3, 2), X9-(3, 3)]).

manhattan_calc([], _, Estimate, Estimate).
manhattan_calc([(*)-_|Tail1], Goal, Acc, Manhattan) :-
    manhattan_calc(Tail1, Goal, Acc, Manhattan).
manhattan_calc([Val1-(X1, Y1)|Tail1], Goal, Acc, Manhattan) :-
    get_dict(Val1, Goal, (X2, Y2)),
    Manhattan_d is abs(X1 - X2) + abs(Y1 - Y2),
    NewAcc is Acc + Manhattan_d,
    manhattan_calc(Tail1, Goal, NewAcc, Manhattan).

I would first look at the SICStus docs for the names. The SICStus version is derived from Quintus newqueues, which is derived from Quintus queues, which is derived from the DEC10 library, contributed by Richard. The SICStus code is proprietary, so we cannot reuse that. I am not sure whether we want the whole interface. I’d be happy with the commonly seen part as we can always add what we need.

As for the s(N), it we can easily avoid it, I think that is to be preferred.

The ECLiPSe code is attached. It is claimed to be public domain and derived from the DEC10 code
queues.pl (8.0 KB)

You are right. I was pretty sure that the manhattan estimate would score better than the hamming, but indeed (at least in the only test case I used, so possibly more cases are needed) while hamming solved the puzzle configuration of the previous days in 110 moves manhattan did it in 366…so :man_shrugging:t2:

Still there is a little difference in how the estimate is computed by the two predicates hamming/manhattan, so first I want to make sure that it’s not that difference that affects the results. Answer to this last question: no, the difference doesn’t affect the result of the hamming estimate which in both cases is 110

The “queues” library is so basic that it never even got librarized :slight_smile: it is really only good as a FIFO queue and that’s it. Even if you had a predicate for selecting from somewhere within it (instead of popping the head) it will still be a linear search. You can append two queues in constant time but I don’t even know any algorithm that needs that? Do you?

Not for SWI-Prolog. As we have seen, many implementations have a queue library. It is not rocket science and possibly the main reason for having one is to allow users to find it :slight_smile: I do not recall anyone ever asking for one. That may mean several things :slight_smile: Several of the “classical” (e.g., DEC10) libraries have been added on user initiative though.

Doesn’t sound difficult: Reddit

Here is an old codes of mine for solving n-puzzle, which is still in the directory util of pack library pac.
The codes produces long redundant series of basic moves for even parity permutations, and I have still no idea on how to find minimum (minimal ?) solutions. I have checked that the codes, which was written 30 years ago, still works for cgi.

:- module(npuzzle,[]).
% N-puzzle program    K. Mukai SFC Keio
% 1995.6.26 20:22  
% 
%   unsolvable case   
% | ?- npuzzle([[15,14,13,12],[11,10,9,8],[7,6,5,4],[3,2,1,0]],X).
%
%   solvable case
% | ?- npuzzle([[14,15,13,12],[11,10,9,8],[7,6,5,4],[3,2,1,0]],X).
% | ?- npuzzle([[24,23,22,21,20],[19,18,17,16,15],[14,13,12,11,10],
%      [9,8,7,6,5],[4,3,2,1,0]],P).
% :- use_module(library(lists)).

non_member(X,Y):- member(X,Y),!,fail.
non_member(_,_).

% for generating benchmark tests
makepuzzle(N,X):-J is N*N-1, matrix(N,N,X),setnpuzzle(J,X).

matrix(1,N,[X]):-!,length(X,N).
matrix(K,N,[T|R]):- J is K-1, length(T,N), matrix(J,N,R).

setnpuzzle(_,[]):-!.
setnpuzzle(X,[[]|Y]):-!,setnpuzzle(X,Y).
setnpuzzle(X,[[X|Y]|Z]):-!,U is X-1, setnpuzzle(U,[Y|Z]).

test(N,X,L):- 
	makepuzzle(N,A),
        npuzzle(A,P),
	flatten(P,Pf),
	length(Pf,L),
        reverse2(A,[],Ar),
        opposite(P,Po),
        apply(Po,Ar,B),
        reverse2(B,[],X).

% | ?- test(5,X,_).
%
% X = [[ 1, 2, 3, 4, 5],
%      [ 6, 7, 8, 9,10],
%      [11,12,13,14,15],
%      [16,17,18,19,20],
%      [21,22,23,24, 0]] 
%

% main predicate

npuzzle_web(X, 'Result' = Y) :- npuzzle(X,Y).

npuzzle(X,Y):-
	reverse2(X,[],Xr),     % reverse rows and columns
	makelinear(Xr,[_|Z]),  % see as a list of integers
	bubblesort(Z,_,G),     % lists of switches (i,j)
	length(G,N),
	0 =:= N mod 2,         % even permutation means being solvable.
	!,
	switch2cycle(G,L),     % even permutaions to 3-cyclic permutaions.
	cycle2path(L,Xr,_,Y1),
	opposite(Y1,Y2),
	flatten(Y2,Y).			% left-right, up-down  reverse
npuzzle(_,'unsolvable: odd permutation').

cycle2path([],X,X,[]).
cycle2path([X|Y],Z,U,[P,Q]):-
	cycle(X,Z,Z1,P),
	cycle2path(Y,Z1,U,Q).

makelinear([],[]).
makelinear([X|Y],Z):-
	makelinear(Y,Z1),
	append(X,Z1,Z).

bubblesort([],[],[]).
bubblesort([X|Y],Z,U):-
	bubblesort(Y,V,W),
	insert(X,V,Z,P),
	append(W,P,U).

insert(X,[],[X],[]):-!.
insert(X,[Y|Z],[X,Y|Z],[]):-X>Y,!.
insert(X,[Y|Z],[Y|U],[[Y,X]|V]):-insert(X,Z,U,V).

% product of two 2-cyclic permutations is a product of 
% 3-cyclic permutations.
makecyclic([X,Y],[Z,U],[]):-member(X,[Z,U]),member(Y,[Z,U]),!.
makecyclic([X,Y],[X,U],[[X,Y,U]]):-!.
makecyclic([X,Y],[U,X],[[X,Y,U]]):-!.
makecyclic([Y,X],[U,X],[[X,Y,U]]):-!.
makecyclic([Y,X],[X,U],[[X,Y,U]]):-!.
makecyclic([X,U],[Y,Z],[[X,Y,Z],[X,Y,U]]).

switch2cycle([],[]).
switch2cycle([X,Y|Z],U):-
	makecyclic(X,Y,C),
	switch2cycle(Z,U1),
	append(C,U1,U).

cycle(A,[X,Y|Z],[X1,Y1|Z],P):-
	contain(A,[X,Y]),!,
        cycle2n(A,[X,Y],[X1,Y1],P).
cycle(A,X,Y,P):-
	X=[[_,_]|_],!,  % two columns matrix
	zip(X,X1), % for reducing to two rows matrix.
	cycle(A,X1,Y1,P1),
	zip(Y1,Y),
	zip_path(P1,P).
cycle(A,[[0|X],Y|Z],[R1,R2|Z2],[P,d,Q,u,Pi]):-
	cleartop(A,[[0|X],Y],[[0|X1],[U|Y1]],P),
	inverse(P,Pi),
	cycle(A,[[0|Y1]|Z],[[0|Y2]|Z2],Q),
	apply([u,Pi],[[U|X1],[0|Y2]],[R1,R2]).

cleartop(A,[[0,X|R],[Z,U|S]|W],[R1,R2|W],[P,Q]):-
	cleartop1(A,[[0,X],[Z,U]],[[0,X1],[Z1,U1]],P),
	cleartop2(A,[[0,X1|R],[Z1,U1|S]],[R1,R2],Q).

cleartop1(A,[[0,X],[Z,U]],[[0,X],[Z,U]],[]):-non_member(Z,A),!.
cleartop1(A,[[0,X],[Z,U]],V,P):-non_member(X,A),!,
	triple2path([Z,X,U],[[0,X],[Z,U]],V,P).
cleartop1(_,[[0,X],[Z,U]],V,P):-
	triple2path([Z,U,X],[[0,X],[Z,U]],V,P).

cleartop2(A,[[0,X|R],[Y,Z|S]],D,[P,Q]):-
	member(U,A),
	member(U,[X|R]),!,
	cleartop3(U,A,[[0,X|R],[Y,Z|S]],T,P),
	cleartop2(A,T,D,Q).
cleartop2(_,X,X,[]).

cleartop3(N,A,[X,[Y,Z,U|S]],T,P):-member(Z,A),!,
	cycle2n([Z,N,U],[X,[Y,Z,U|S]],T,P).
cleartop3(N,_,[X,[Y,Z,U|S]],T,P):-
	cycle2n([N,Z,U],[X,[Y,Z,U|S]],T,P).

% | ?- cycle2n([1,2,3],[[0,1,4],[2,5,3]],X,P).
% P = [r,[[l,d,r,u],[[r,d,l,u],[[l,d,r,u],[]]]],[r,d,l,u],
%         [[[[],[d,l,u,r]],[d,r,u,l]],[d,l,u,r]],l]
% X = [[0,2,4],[3,5,1]] ? 
cycle2n([A,B,C],[[0,X|R],[Y,Z|S]],[[0,X1|R],[Y1,Z1|S]],Q):-
	member(X,[A,B,C]),
	member(Y,[A,B,C]),
	member(Z,[A,B,C]),!,
	triple2path([A,B,C],[[0,X],[Y,Z]],[[0,X1],[Y1,Z1]],Q).
cycle2n(P,[[0,X,U|R],[Y,Z,V|S]],
       [[0,X3,U3|R2],[Y3,Z3,V3|S2]],
	 [r,H,G,Hi,l]):-
 clearleft(P,[[X,0,U],[Y,Z,V]],[[X1,0,U1],[Y1,Z1,V1]],H),
 inverse(H,Hi),
 cycle2n(P,[[0,U1|R],[Z1,V1|S]],[[0,U2|R2],[Z2,V2|S2]],G),
 apply(Hi,[[X1,0,U2],[Y1,Z2,V2]],[[X3,0,U3],[Y3,Z3,V3]]).

equalcycperm([A,B,C],[A,B,C]).
equalcycperm([B,C,A],[A,B,C]).
equalcycperm([C,A,B],[A,B,C]).

move1(r,[[0,X],Y],[[X,0],Y]).  
move1(d,[[X,0],[Y,Z]],[[X,Z],[Y,0]]).
move1(l,[X,[Z,0]],[X,[0,Z]]).
move1(u,[[X,Y],[0,Z]],[[0,Y],[X,Z]]).
move1(r,[Y,[0,X]],[Y,[X,0]]).
move1(u,[[X,Y],[Z,0]],[[X,0],[Z,Y]]).
move1(l,[[X,0],Y],[[0,X],Y]).
move1(d,[[0,X],[Y,Z]],[[Y,X],[0,Z]]).

turn(Z,[[A,B|X1],[C,D|X2]|X],[[E,F|X1],[G,H|X2]|X]):-
	turn1(Z,[[A,B],[C,D]],[[E,F],[G,H]]).

turn1([d,r,u,l],[[0,A],[B,C]],[[0,B],[C,A]]).
turn1([r,d,l,u],[[0,A],[B,C]],[[0,C],[A,B]]).
turn1([l,d,r,u],[[A,0],[B,C]],[[B,0],[C,A]]).
turn1([d,l,u,r],[[A,0],[B,C]],[[C,0],[A,B]]).
turn1([l,u,r,d],[[A,B],[C,0]],[[B,C],[A,0]]).
turn1([u,l,d,r],[[A,B],[C,0]],[[C,A],[B,0]]).
turn1([r,u,l,d],[[A,B],[0,C]],[[C,A],[0,B]]).
turn1([u,r,d,l],[[A,B],[0,C]],[[B,C],[0,A]]).
         
% | ?- apply([r,d,r,u],[[0,1,2],[3,4,5]],X).
% X = [[1,4,0],[3,5,2]] ? 

apply(X,Y,Z):-apply(X,[],[],Y,M,N,U),restore(M,N,U,Z).

apply([],M,N,X,M,N,X).
apply([A,B,C,D|W],M,N,X,M1,N1,X1):-
	turn([A,B,C,D],X,X2),!,
	apply(W,M,N,X2,M1,N1,X1).
apply([A|W],M,N,X,M1,N1,X1):-!,
	apply(A,M,N,X,M2,N2,X2),
	apply(W,M2,N2,X2,M1,N1,X1).
apply(A,M,N,[[X,Y|R],[U,V|S]|T],M,N,[[X1,Y1|R],[U1,V1|S]|T]):-
	move1(A,[[X,Y],[U,V]],[[X1,Y1],[U1,V1]]),!.
apply(u,M,[R|Rs],X,M1,N1,X1):-apply(u,M,Rs,[R|X],M1,N1,X1).
apply(d,M,N,[X|Y],M1,N1,X1):-apply(d,M,[X|N],Y,M1,N1,X1).
apply(l,[C|M],N,X,M1,N1,X1):-!,
	revmulticons(C,N,N2,C2),
	multicons(C2,X,X3),
	apply(l,M,N2,X3,M1,N1,X1).
apply(r,M,N,X,M1,N1,X1):-
	firstcolumn(N,Cn,N2),
	firstcolumn(X,Cx,X2),
	reverse(Cn,Cx,C),
	apply(r,[C|M],N2,X2,M1,N1,X1).

triple2path(T,[[0,X],[Z,Y]],[[0,Y],[X,Z]],[r,d,l,u]):-
	equalcycperm(T,[X,Y,Z]),!.
triple2path(T,[[Z,0],[Y,X]],[[X,0],[Z,Y]],[d,l,u,r]):-
	equalcycperm(T,[X,Y,Z]),!.
triple2path(T,[[Y,Z],[X,0]],[[Z,X],[Y,0]],[l,u,r,d]):-
	equalcycperm(T,[X,Y,Z]),!.
triple2path(T,[[X,Y],[0,Z]],[[Y,Z],[0,X]],[u,r,d,l]):-
	equalcycperm(T,[X,Y,Z]),!.
triple2path(_,[[0,X],[Z,Y]],[[0,Z],[Y,X]],[d,r,u,l]):-!.
triple2path(_,[[Z,0],[Y,X]],[[Y,0],[X,Z]],[l,d,r,u]):-!.
triple2path(_,[[Y,Z],[X,0]],[[X,Y],[Z,0]],[u,l,d,r]):-!.
triple2path(_,[[X,Y],[0,Z]],[[Z,X],[0,Y]],[r,u,l,d]).

% | ?- clearleft([1,2,3],[[1,0,4],[2,5,3]],R,P).
% P = [[l,d,r,u],[[r,d,l,u],[[l,d,r,u],[]]]],
% R = [[5,0,3],[4,2,1]] ? 
clearleft(C,[[X,0,Y],[Z,U,V]],[[X,0,Y],[Z,U,V]],[]):-
	non_member(X,C),
	non_member(Z,C),!.
clearleft(C,[[X,0,Y],[Z,U,V]],R,[P,Q]):-
	member(U,C),!,
	out(A,[Y,V],C),
	remove(A,[Y,V],[B]),
	triple2path([U,A,B],[[0,Y],[U,V]],[M,N],P),
	clearleft(C,[[X|M],[Z|N]],R,Q).
clearleft(C,[[X,0,Y],[Z,U,V]],R,[P,Q]):-
	member(X,C),!,
	triple2path([U,X,Z],[[X,0],[Z,U]],[[X1,0],[Z1,U1]],P),
	clearleft(C,[[X1,0,Y],[Z1,U1,V]],R,Q).
clearleft(C,[[X,0,Y],[Z,U,V]],R,[P,Q]):-
	triple2path([U,Z,X],[[X,0],[Z,U]],[[X1,0],[Z1,U1]],P),
	clearleft(C,[[X1,0,Y],[Z1,U1,V]],R,Q).

%
% member(X,[X|_]).
% member(X,[_|Y]):-member(X,Y).

%flatten(X,Y):-flatten(X,Y,[]).
%flatten([],X,X):-!.
%flatten(X,[X|Z],Z):-atomic(X),!.
%flatten([X|Y],Z,U):-flatten(X,Z,V),flatten(Y,V,U).

remove(_,[],[]).
remove(X,[X|Y],Y).
remove(X,[U|Y],[U|Z]):-X\==U,remove(X,Y,Z).

out(A,X,Y):-member(A,X),non_member(A,Y).

reverse([],X,X).
reverse([X|Y],Z,U):-reverse(Y,[X|Z],U).

reverse2([],X,X).
reverse2([X|Y],Z,U):-reverse(X,[],Xr), reverse2(Y,[Xr|Z],U).

restore(X,Y,Z,U):-reverse(Y,Z,Z1),restorecol(X,Z1,U).

restorecol([],X,X).
restorecol([X|Y],Z,U):-multicons(X,Z,Z1),restorecol(Y,Z1,U).

multicons([],[],[]).
multicons([X|Y],[Z|U],[[X|Z]|V]):-multicons(Y,U,V).

revmulticons(A,[],[],A).
revmulticons(A,[X|Y],[[D|X]|Y1],B):-revmulticons(A,Y,Y1,[D|B]).

contain([],_).
contain([X|Y],Z):-contain1(X,Z),contain(Y,Z).

contain1(X,[Y|_]):-member(X,Y),!.
contain1(X,[_|R]):-contain1(X,R).

firstcolumn([],[],[]).
firstcolumn([[X|X1]|R],[X|Y],[X1|S]):-firstcolumn(R,Y,S).

zip_path([],[]).
zip_path([X|Y],[Xt|Yt]):-
	zip_path(X,Xt),
	zip_path(Y,Yt).
zip_path(X,Y):-zip_path1(X,Y).

zip_path1(d,r).
zip_path1(r,d).
zip_path1(u,l).
zip_path1(l,u).

opposite(u,d).
opposite(d,u).
opposite(l,r).
opposite(r,l).

opposite([],[]).
opposite([X|Y],[Xo|Yo]):-opposite(X,Xo), opposite(Y,Yo).

inverse([],[]).
inverse(r,l).
inverse(l,r).
inverse(d,u).
inverse(u,d).
inverse([X|Y],Z):-inverse([X|Y],[],Z).

inverse([],X,X).
inverse([X|Y],Z,U):-inverse(X,Xi), inverse(Y,[Xi|Z],U).

Wir brauchen schlaue Menschen wie Du

Of course this policy has its drawbacks…as soon as your schoolmates knew that you were cheating :sweat_smile: but sure…algorithms are not that human

One of the positive outcomes was to learn not to overestimate northern european ethics, whose importance of course as a southern european one might tend as a cultural stereotype to overestimate

Good luck then. I worked on O’Keefe’s chapter two and now i’m making some retrocomputing i think it’ called. Reinventing the wheel if you please, but after a possibly excessive mental effort with THE BOOK and serious stuff i need to breathe simpler things. You’ll know as soon as I restart working with TCOP

Just to understand if I got it right: the practical outcome of the debate is that a library(queues) will be added to Swi-Prolog? Thanks

I think the outcome is that there is sufficient existing practice to justify a new library that fits as good as we can to this existing practice (derived from Richard O’Keefe’s version for the DEC10 library). There is a start by @Boris, but no final writeup.

As far as I’m concerned, this is not on my critical path. If someone wants to go through the various incarnations, assemble a reasonable version and document it inline using PlDoc, I’m happy to merge that.

1 Like

Thanks Jan. I appreciate your cryptic and somewhat (I think) playfully baroque language

Hard to tell. The code I pasted is in a module, documented with PlDoc, with unit tests and so on. The differences between APIs and implementations need some criteria to be evaluated, beyond “it is documented in a module”. If the goal is to be consistent there are free source libraries that can be taken as is.

Isn’t from/by me :grinning:

1 Like

I agree that multiple responses in a row is distinct from monologue. This also reminds me of Gandalf:

“In one thing you have not changed, dear friend,” said Aragorn: “you still speak in riddles.”
“What? In riddles?” said Gandalf. “No! For I was talking aloud to myself. A habit of the old: they choose the wisest person present to speak to; the long explanations needed by the young are wearying.”

I knew about this book, but what I had placed on my wishlist was actually his former “Paradigms of AI Programming. Case studies in Common Lisp”. I must have some kind of strange preference for old stuff :rofl: