🚀 go-pugleaf

This is all getting a rather pointless, but who can resist a bit of
hacking....

One of the limitations of other people's code is that you can get from
one record in the data structure to another record, but you can't go on
from there to other parts of the data structure (eg, children of that
node.  The following code allows this more complex navigation.  One
consequence of the extra generality is that the basic data structure has
to be set up completely before adding the extra "pointers".  Dynamic
update does not seem feasible without destructive assignment (it would
be nice if someone could prove this wrong).  Another feature of the code
is that it is pure (unlike the other postings, which contain cut and
nonvar).  The declarative semantics is straightforward if you allow
rational trees.  The code actually works on systems such as NU-Prolog
which don't support infinite terms properly.

	lee

% Implementation of binary search tree with "pointers"
% from one tree node to another.  Nodes can point to each other
% or higher in the tree (so the data structure can be infinite)
% Note that it could just as easily be an arbitrary binary tree,
% or even a set of binary trees linked together, but insertion
% and retrieval code would have to be changed.
%
% Due to the logical nature of things (no destructive update), updating
% the tree will not change "pointers" to the old version of the tree.
% Thus the tree should be constructed first, then all the pointers
% added.
%
% Each internal node is of the form pt(Key, LTree, RTree, PTree)
% For generality, there should be a data field as well as key
%
% All the code is "pure"; there has been no attempt to remove excess
% choice points or avoid creating unnecessary heap structures.

	% Check something is a "pointer tree"
	% Doesn't check pointers (can this be done
	% without looping, even in languages like Prolog-III?)
ptree(nil).
ptree(pt(_K, LT, RT, _PT)) :-
	% key(K),	% could check type of key
	ptree(LT),
	ptree(RT).
	% pt(PT).	% this could cause loops -> don't check!

	% insert key (+ no data) plus pointer into ptree
	% (generally best to leave pointer uninstantiated here)
ptree_insert(nil, K, PT, pt(K, nil, nil, PT)).
ptree_insert(pt(K0, LT0, RT0, PT0), K, PT, pt(K0, LT, RT0, PT0)) :-
	K0 @> K,
	ptree_insert(LT0, K, PT, LT).
ptree_insert(pt(K0, LT0, RT0, PT0), K, PT, pt(K0, LT0, RT, PT0)) :-
	K0 @=< K,		% = case rather dubious for BST
	ptree_insert(RT0, K, PT, RT).

	% retrieve subtree with given key at root
ptree_find(pt(K0, LT0, RT0, PT0), K0, pt(K0, LT0, RT0, PT0)).
ptree_find(pt(K0, LT0, RT0, PT0), K, T) :-
	K0 @> K,
	ptree_find(LT0, K, T).
ptree_find(pt(K0, LT0, RT0, PT0), K, T) :-
	K0 @< K,
	ptree_find(RT0, K, T).

	% given tree with particular key in the root,
	% follow the pointer
ptree_ptr(pt(_, _, _, PT), PT).

	% convert list of pairs+singletons into ptree with pointers
	% between members of each pair
list_to_ptree(L, T) :-
	build_ptree_a(L, nil, T),
	add_ptrs_l(L, T).

	% as above with accumulator
	% ignore pointers for pairs
build_ptree_a([], T, T).
build_ptree_a(single(A).As, T0, T) :-
	ptree_insert(T0, A, nil, T1),	% single -> pointer = nil
	build_ptree_a(As, T1, T).
build_ptree_a(pair(A, B).As, T0, T) :-	
	ptree_insert(T0, A, _, T1),
	ptree_insert(T1, B, _, T2),
	build_ptree_a(As, T2, T).

	% add pointers for each pair
add_ptrs_l([], _).
add_ptrs_l(single(_).As, T) :-
	add_ptrs_l(As, T).
add_ptrs_l(pair(A, B).As, T) :-
	add_ptrs(T, A, B),
	add_ptrs_l(As, T).

	% as above, but for single pair
add_ptrs(T, A, B) :-
	ptree_find(T, A, TA),
	ptree_find(T, B, TB),
	ptree_ptr(TA, TB),
	ptree_ptr(TB, TA).	% may create infinite term!

	% beware of printing infinite terms when testing!
test(Baz) :-
	list_to_ptree([single(mid), pair(black,white), pair(foo,baz)], T),
	ptree_find(T, foo, TF),
	ptree_ptr(TF, pt(Baz, _, _, _)).