1% BEGIN LICENSE BLOCK
2% Version: CMPL 1.1
3%
4% The contents of this file are subject to the Cisco-style Mozilla Public
5% License Version 1.1 (the "License"); you may not use this file except
6% in compliance with the License.  You may obtain a copy of the License
7% at www.eclipse-clp.org/license.
8% 
9% Software distributed under the License is distributed on an "AS IS"
10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11% the License for the specific language governing rights and limitations
12% under the License. 
13% 
14% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
15% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
16% Portions created by the Initial Developer are
17% Copyright (C) 1995 - 2006 Cisco Systems, Inc.  All Rights Reserved.
18% 
19% Contributor(s): Andrew Eremin, IC-Parc
20% 
21% END LICENSE BLOCK
22% ----------------------------------------------------------------------
23%
24% Description:	ECLiPSe binary search tree library
25%
26% System:	ECLiPSe Constraint Logic Programming System
27% Author/s:	Andrew Eremin, IC-Parc
28%
29% ----------------------------------------------------------------------
30
31
32% ----------------------------------------------------------------------
33%
34% this module implements binary search trees, which have certain
35% properties:
36%
37%      o Every tree is Tree either a leaf node with no children or an
38%        internal node with either a lchild LChild or both a lchild
39%        LChild and a rchild RChild,
40%        i.e. children are created left to right
41%      o Every Tree has an associated integer id such that for every
42%        node Parent with id I, the ids of its lchild LChild and
43%        rchild RChild (if any) are 2I and 2I+1
44%      o Every tree has an associated numeric rank Rank and order
45%        relation Rel such that for every node Parent with child Child
46%        \+ (rank(Child) Rel rank(Parent)) is true,
47%        i.e. the search is non-improving
48%      o Every Tree has an associated status as follows:
49%        a Tree that is a leaf may be open or fathomed
50%        a Tree that has one or more children is fathomed if all its
51%        children are fathomed and expanded otherwise
52%
53% ----------------------------------------------------------------------
54:- module(b_trees).
55
56% ----------------------------------------------------------------------
57%
58% (unbalanced, ordered) binary search tree structure
59%
60% ----------------------------------------------------------------------
61
62:- local struct(
63                b_tree(
64                       id,          % integer: node number
65                       depth,       % integer: depth in bfs tree
66                                    %    (for bit-twiddling hack to
67                                    %     determine nodes under a
68                                    %     sub-tree)
69                       order,       % atom (</>): the order for bfs
70                                    %         rank comparison
71                       rank,        % number: node rank for bfs node
72                                    %         selection
73                       status,      % atom: current status of the node
74                                    %        open
75                                    %        expanded
76                                    %        fathomed
77                       parent,      % b_tree struct: parent node
78                                    %    in search tree
79                       lchild,      % b_tree struct: left child
80                                    %    in search tree
81                       rchild,      % b_tree struct: right child
82                                    %    in search tree
83                       bfs_next,    % b_tree struct: best descendant
84                                    %    in bfs order
85                       data         % prolog term: arbitrary data
86                                    %    associated with node
87                      )
88               ).
89
90% ----------------------------------------------------------------------
91%
92% creating a new b_tree structure
93%
94% ----------------------------------------------------------------------
95
96:- mode new_b_tree_struct(-).
97new_b_tree_struct(Tree) :-
98        Tree = b_tree{
99                      status:open,
100                      parent:null,
101                      lchild:null,
102                      rchild:null,
103                      bfs_next:null
104                     }.
105
106% ----------------------------------------------------------------------
107%
108% user level predicates
109%
110% ----------------------------------------------------------------------
111
112% ----------------------------------------------------------------------
113% tree creation
114:- export
115   b_tree/2.
116
117:- mode b_tree(++, -).
118b_tree(Order, Tree) :-
119        new_b_tree_struct(Tree),
120        ( Order == (<) ->
121            Rank = -1.0Inf
122        ; Order == (>) ->
123            Rank = 1.0Inf
124        ),
125        Tree = b_tree{
126                      id:1,
127                      depth:1,
128                      order:Order,
129                      rank:Rank
130                     }.
131
132% ----------------------------------------------------------------------
133% node expansion and fathoming
134:- export
135   b_tree_expand/3,
136   b_tree_fathom/1.
137
138:- mode b_tree_expand(+, ++, -).
139b_tree_expand(Tree, Rank, Child) :-
140        Tree = b_tree{
141                      id:PId,
142                      depth:PDepth,
143                      order:POrder,
144                      status:PStatus
145                     },
146        Depth is PDepth+1,
147        new_b_tree_struct(Child),
148        Child = b_tree{
149                       id:Id,
150                       depth:Depth,
151                       order:POrder,
152                       rank:Rank
153                      },
154        % children in an ordered search tree must not be strictly
155        % better than their parent
156        \+ better_rank(Child, Tree),
157        % add the child
158        ( arg(lchild of b_tree, Tree, null) ->
159            Id is PId << 1,
160            setarg(lchild of b_tree, Tree, Child)
161        ;
162            arg(rchild of b_tree, Tree, null),
163            Id is setbit(PId << 1, 0),
164            setarg(rchild of b_tree, Tree, Child)
165        ),
166        setarg(parent of b_tree, Child, Tree),
167        % update the status of tree
168        ( PStatus == fathomed ->
169            fail
170        ; PStatus == expanded ->
171            % we have an unfathomed subtree rooted at the left child:
172            % check whether bfs_next needs updating
173            next(bfs, Tree, OldNext),
174            ( better_rank(Child, OldNext) ->
175                % Child is better than the best in the left subtree:
176                % update and recurse 
177                set_bfs_next(Tree, Child),
178                expand_ancestors(Tree, OldNext)
179            ;
180                % Child is no better than the best in the left subtree:
181                % we are done
182                true
183            )
184        ; PStatus == open ->
185            % we have a new bfs_next:
186            % set it, update the status to expanded, then check for
187            % updating ancestors' bfs_next
188            setarg(status of b_tree, Tree, expanded),
189            set_bfs_next(Tree, Child),
190            expand_ancestors(Tree, Tree)
191        ).
192
193:- mode set_bfs_next(+, +).
194set_bfs_next(Node, BfsNext) :-
195        ( arg(bfs_next of b_tree, Node, BfsNext) -> true
196        ; setarg(bfs_next of b_tree, Node, BfsNext) ).
197
198:- mode bfs_descendant(+, ?).
199bfs_descendant(Node, Descendant) :-
200        lchild(Node, LChild),
201        ( next(bfs, LChild, LDescendant) ->
202            % LChild has a bfs descendant:
203            % compare with RChild's, if any
204            ( rchild(Node, RChild),
205              next(bfs, RChild, RDescendant),
206              better_rank(RDescendant, LDescendant) ->
207                % RChild's bfs descendant is Node's bfs descendant
208                Descendant = RDescendant
209            ;
210                % LChild's bfs descendant is Node's bfs descendant
211                Descendant = LDescendant
212            )
213        ;
214            % LChild has no bfs descendant:
215            % if RChild has a bfs descendant this is also the bfs
216            % descendant of Node, otherwise it has none
217            rchild(Node, RChild),
218            next(bfs, RChild, Descendant)
219        ).
220
221better_rank(b_tree{order:Order, rank:Rank1}, b_tree{order:Order, rank:Rank2}) :-
222        ( Order == (<) ->
223            Rank1 @< Rank2
224        ; % Order == (>)
225            Rank1 @> Rank2
226        ).
227
228% When expand_ancestors(+Node, +Expanded) is called,
229% Expanded is a b_tree node which has just been expanded, and
230% the bfs_next field of Node has already been updated;
231% we are recursively updating the bfs_next field of its ancestors if
232% necessary.
233:- mode expand_ancestors(+, +).
234expand_ancestors(Node, Expanded) :-
235        ( parent(Node, Parent), next(bfs, Parent, Expanded) ->
236            % Node has a Parent whose bfs_next is Expanded:
237            % update the field and recurse
238            bfs_descendant(Parent, BfsNext),
239            set_bfs_next(Parent, BfsNext),
240            expand_ancestors(Parent, Expanded)
241        ;
242            % Node is either the root node and has no ancestors to
243            % update, or has a Parent with better bfs_next and whose
244            % ancestors must all also have better bfs_next:
245            % we are done
246            true
247        ).
248
249:- mode b_tree_fathom(+).
250b_tree_fathom(Tree) :-
251        Tree = b_tree{
252                      status:Status
253                     },
254        ( Status == open ->
255            % mark the leaf node fathomed
256            setarg(status of b_tree, Tree, fathomed),
257            % and recursively fathom its ancestors or update their
258            % bfs_next fields
259            fathom_ancestors(Tree, Tree)
260        ; Status == expanded ->
261            % cannot explicitly fathom an internal node
262            fail
263        ; % Status == fathomed
264            % already fathomed, silently succeed
265            true
266        ).
267
268% When fathom_ancestors(+Node, +Fathomed) is called,
269% Fathomed is a b_tree leaf which has just been fathomed, and
270% Node has already been updated; we are recursively updating the
271% status and bfs_next fields of its ancestors if necessary.
272:- mode fathom_ancestors(+, +).
273fathom_ancestors(Node, Fathomed) :-
274        %( parent(Node, Parent), next(bfs, Parent, Fathomed) ->
275        ( parent(Node, Parent), next(bfs, Parent, Fathomed0),
276          Fathomed0 = Fathomed ->
277            % Node has a Parent whose bfs_next was Fathomed:
278            % update the fields and recurse
279            ( bfs_descendant(Parent, BfsNext) ->
280                % Parent still has an open descendant:
281                % leave status as expanded and update bfs_next
282                set_bfs_next(Parent, BfsNext)
283            ;
284                % Parent has no more open descendants:
285                % update status to fathomed
286                setarg(status of b_tree, Parent, fathomed)
287            ),
288            fathom_ancestors(Parent, Fathomed)
289        ;
290            % Node is either the root node and has no ancestors to
291            % update, or has a Parent with better bfs_next and whose
292            % ancestors must all also have better bfs_next:
293            % we are done
294            true
295        ).
296
297% ----------------------------------------------------------------------
298% tree access/update
299:- export
300   b_tree_get/3,
301   b_tree_set/3.
302
303:- mode b_tree_get(++, +, ?).
304b_tree_get(id, b_tree{id:Id}, Val) ?- !,
305        Val = Id.
306b_tree_get(depth, b_tree{depth:Depth}, Val) ?- !,
307        Val = Depth.
308b_tree_get(order, b_tree{order:Order}, Val) ?- !,
309        Val = Order.
310b_tree_get(rank, b_tree{rank:Rank}, Val) ?- !,
311        Val = Rank.
312b_tree_get(status, b_tree{status:Status}, Val) ?- !,
313        Val = Status.
314b_tree_get(data, b_tree{data:Data}, Val) ?- !,
315        Val = Data.
316
317:- mode b_tree_set(++, +, ?).
318b_tree_set(data, Tree, Val) ?- !,
319        arg(data of b_tree, Tree, Val0),
320        ( Val0 = Val -> true ; setarg(id of b_tree, Tree, Val) ).
321           
322% ----------------------------------------------------------------------
323% testing
324:- export
325   is_b_tree/1,
326   is_b_tree_root/1,
327   is_b_tree_leaf/1.
328
329:- mode is_b_tree(+).
330is_b_tree(b_tree{}).
331
332:- mode is_b_tree_root(+).
333is_b_tree_root(b_tree{parent:null}).
334
335:- mode is_b_tree_leaf(+).
336is_b_tree_leaf(b_tree{lchild:null,rchild:null}).
337
338% ----------------------------------------------------------------------
339% tree navigation
340:- export
341   parent/2,
342   ancestor/2,
343   lchild/2,
344   rchild/2,
345   child/2,
346   descendant/2,
347   sib/2,
348   next/3.
349
350:- mode parent(+, ?).
351parent(b_tree{parent:Node}, Node) :-
352        ( Node == null -> fail ; true ).
353
354:- mode ancestor(+, ?).
355ancestor(Node, Ancestor) :-
356        parent(Node, Parent),
357        ( Ancestor = Parent ; ancestor(Parent, Ancestor) ).
358
359:- mode lchild(+, ?).
360lchild(b_tree{lchild:Node}, Node) :-
361        ( Node == null -> fail ; true ).
362
363:- mode rchild(+, ?).
364rchild(b_tree{rchild:Node}, Node) :-
365        ( Node == null -> fail ; true ).
366
367:- mode child(+, ?).
368child(Node, Child) :-
369        lchild(Node, Child).
370child(Node, Child) :-
371        rchild(Node, Child).
372
373:- mode descendant(+, ?).
374descendant(Node, Descendant) :-
375        child(Node, Child),
376        ( Descendant = Child ; descendant(Child, Descendant) ).
377
378:- mode sib(+, ?).
379sib(Node, Sib) :-
380        parent(Node, Parent),
381        child(Parent, Sib),
382        Sib \== Node, !.
383
384:- mode get_bfs_next(+, ?).
385get_bfs_next(b_tree{bfs_next:Node}, Node) :-
386        ( Node == null -> fail ; true ).
387
388:- mode tree_get_node(++, +, ?).
389tree_get_node(1, Root, Root) :- !.
390tree_get_node(Id, Root, Node) :-
391        Rel is getbit(Id, 1),
392        Id0 is Id >> 1,
393        tree_get_node(Id0, Root, Node0),
394        ( Rel == 0 ->
395            lchild(Node0, Node)
396        ;
397            rchild(Node0, Node)
398        ).
399
400:- mode next(++, +, ?).
401next(bfs, Node, Next) :-
402        b_tree_get(status, Node, Status),
403        ( Status == open ->
404            % Node has not been expanded yet
405            Next = Node
406        ; Status == fathomed ->
407            % subtree rooted at Node is fathomed
408            fail
409        ; get_bfs_next(Node, Next) ->
410            % next should be the best ranked open b_tree struct in
411            % the subtree rooted at Node; note that this can fail if
412            % we are currently in the process of expanding a node: we
413            % will have updated Status fomr open to expanded but not
414            % changed the bfs_next from null when we call next/3
415            % within b_tee_expand
416            true
417        ).
418next(bfs(Id), Node, Next) ?-
419        tree_get_node(Id, Node, SubTree),
420        next(bfs, SubTree, Next).
421next(dfs, Node, Next) :-
422        b_tree_get(status, Node, Status),
423        ( Status == open ->
424            % Node has not been expanded yet
425            Next = Node
426        ; Status == fathomed ->
427            % subtree rooted at Node is fathomed
428            fail
429        ; child(Node, Child), next(dfs, Child, Next) ->
430            % next should be the first open b_tree struct in
431            % the subtree rooted at Node
432            true
433        ).
434next(dfs(Id), Node, Next) ?-
435        tree_get_node(Id, Node, SubTree),
436        next(dfs, SubTree, Next).
437
438% ----------------------------------------------------------------------
439
440:- comment(categories, ["Algorithms","Constraints"]).
441:- comment(summary, "binary search tree library").
442:- comment(author, "Andrew Eremin").
443:- comment(copyright, "Cisco Systems, INc.").
444:- comment(status, prototype).
445
446:- comment(include, b_trees_comments).
447