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