1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2007-2014, University of Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(nb_rbtrees, 36 [ nb_rb_insert/3, % !T0, +Key, +Value 37 nb_rb_get_node/3, % +Tree, +Key, -Node 38 nb_rb_node_value/2, % +Node, -Value 39 nb_rb_set_node_value/2 % +Node, +Value 40 ]). 41 42/** <module> Non-backtrackable operations on red black trees 43 44This library is an extension to rbtrees.pl, implementing Red-black 45trees. This library adds non-backtrackable destructive update to RB 46trees which allows us to fill RB trees in a failure driven loop. 47 48This module builds on top of the rbtrees.pl and used code copied from 49library written by Vitor Santos Costa. 50 51@author Jan Wielemaker 52*/ 53 54 /******************************* 55 * TREE INSERTION * 56 *******************************/ 57 58%! nb_rb_insert(!RBTree, +Key, +Value) 59% 60% Add Key-Value to the tree RBTree using non-backtrackable 61% destructive assignment. 62 63nb_rb_insert(Tree, Key0, Val0) :- 64 duplicate_term(Key0, Key), 65 duplicate_term(Val0, Val), 66 Tree = t(Nil, T), 67 insert(T, Key, Val, Nil, NT, Flag), 68 ( Flag == shared 69 -> true 70 ; nb_linkarg(2, Tree, NT) 71 ). 72 73insert(Tree0,Key,Val,Nil,Tree, Flag) :- 74 insert2(Tree0,Key,Val,Nil,TreeI,Flag), 75 ( Flag == shared 76 -> Tree = Tree0 77 ; fix_root(TreeI,Tree) 78 ). 79 80% 81% make sure the root is always black. 82% 83fix_root(black(L,K,V,R),black(L,K,V,R)). 84fix_root(red(L,K,V,R),black(L,K,V,R)). 85 86 87% 88% Cormen et al present the algorithm as 89% (1) standard tree insertion; 90% (2) from the viewpoint of the newly inserted node: 91% partially fix the tree; 92% move upwards 93% until reaching the root. 94% 95% We do it a little bit different: 96% 97% (1) standard tree insertion; 98% (2) move upwards: 99% when reaching a black node; 100% if the tree below may be broken, fix it. 101% We take advantage of Prolog unification 102% to do several operations in a single go. 103% 104 105 106 107% 108% actual insertion 109% 110insert2(black('',_,_,''), K, V, Nil, T, Status) :- 111 !, 112 T = red(Nil,K,V,Nil), 113 Status = not_done. 114insert2(In, K, V, Nil, NT, Flag) :- 115 In = red(L,K0,V0,R), 116 !, 117 ( K @< K0 118 -> insert2(L, K, V, Nil, NL, Flag), 119 ( Flag == shared 120 -> NT = In 121 ; NT = red(NL,K0,V0,R) 122 ) 123 ; insert2(R, K, V, Nil, NR, Flag), 124 ( Flag == shared 125 -> NT = In 126 ; NT = red(L,K0,V0,NR) 127 ) 128 ). 129insert2(In, K, V, Nil, NT, Flag) :- 130 In = black(L,K0,V0,R), 131 ( K @< K0 132 -> insert2(L, K, V, Nil, IL, Flag0), 133 ( Flag0 == shared 134 -> NT = In 135 ; fix_left(Flag0, black(IL,K0,V0,R), NT0, Flag1), 136 ( Flag1 == share 137 -> nb_linkarg(1, In, IL), 138 Flag = shared, 139 NT = In 140 ; NT = NT0, 141 Flag = Flag1 142 ) 143 ) 144 ; insert2(R, K, V, Nil, IR, Flag0), 145 ( Flag0 == shared 146 -> NT = In 147 ; fix_right(Flag0, black(L,K0,V0,IR), NT0, Flag1), 148 ( Flag1 == share 149 -> nb_linkarg(4, In, IR), 150 Flag = shared, 151 NT = In 152 ; NT = NT0, 153 Flag = Flag1 154 ) 155 ) 156 ). 157 158% 159% How to fix if we have inserted on the left 160% 161fix_left(shared,T,T,shared) :- !. 162fix_left(done,T,T,done) :- !. 163fix_left(not_done,Tmp,Final,Done) :- 164 fix_left(Tmp,Final,Done). 165 166% 167% case 1 of RB: just need to change colors. 168% 169fix_left(black(red(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,red(De,KD,VD,Ep)), 170 red(black(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,black(De,KD,VD,Ep)), 171 not_done) :- !. 172fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,red(De,KD,VD,Ep)), 173 red(black(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,black(De,KD,VD,Ep)), 174 not_done) :- !. 175% 176% case 2 of RB: got a knee so need to do rotations 177% 178fix_left(black(red(Al,KA,VA,red(Be,KB,VB,Ga)),KC,VC,De), 179 black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)), 180 done) :- !. 181% 182% case 3 of RB: got a line 183% 184fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,De), 185 black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)), 186 done) :- !. 187% 188% case 4 of RB: nothig to do 189% 190fix_left(T,T,share). % shared? 191 192% 193% How to fix if we have inserted on the right 194% 195fix_right(shared,T,T,shared) :- !. 196fix_right(done,T,T,done) :- !. 197fix_right(not_done,Tmp,Final,Done) :- 198 fix_right(Tmp,Final,Done). 199 200% 201% case 1 of RB: just need to change colors. 202% 203fix_right(black(red(Ep,KD,VD,De),KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)), 204 red(black(Ep,KD,VD,De),KC,VC,black(red(Ga,KB,VB,Be),KA,VA,Al)), 205 not_done) :- !. 206fix_right(black(red(Ep,KD,VD,De),KC,VC,red(Ga,Ka,Va,red(Be,KB,VB,Al))), 207 red(black(Ep,KD,VD,De),KC,VC,black(Ga,Ka,Va,red(Be,KB,VB,Al))), 208 not_done) :- !. 209% 210% case 2 of RB: got a knee so need to do rotations 211% 212fix_right(black(De,KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)), 213 black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)), 214 done) :- !. 215% 216% case 3 of RB: got a line 217% 218fix_right(black(De,KC,VC,red(Ga,KB,VB,red(Be,KA,VA,Al))), 219 black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)), 220 done) :- !. 221% 222% case 4 of RB: nothing to do. 223% 224fix_right(T,T,share). 225 226 227 /******************************* 228 * UPDATE * 229 *******************************/ 230 231%! nb_rb_get_node(+RBTree, +Key, -Node) is semidet. 232% 233% True if Node is the node in RBTree associated to Key. Fails if 234% Key is not in RBTree. This predicate is intended to be used 235% together with nb_rb_set_node_value/2 to update the associated 236% key destructively. 237 238nb_rb_get_node(t(_Nil, Tree), Key, Node) :- 239 find_node(Key, Tree, Node). 240 241find_node(Key, Tree, Node) :- 242 Tree \== '', 243 arg(2, Tree, K), 244 compare(Diff, Key, K), 245 find_node(Diff, Key, Tree, Node). 246 247find_node(=, _, Node, Node). 248find_node(<, Key, Tree, Node) :- 249 arg(1, Tree, Left), 250 find_node(Key, Left, Node). 251find_node(>, Key, Tree, Node) :- 252 arg(4, Tree, Right), 253 find_node(Key, Right, Node). 254 255%! nb_rb_node_value(+Node, -Value) is det. 256% 257% Value is the value associated to Node. 258 259nb_rb_node_value(Node, Value) :- 260 arg(3, Node, Value). 261 262%! nb_rb_set_node_value(!Node, +Value) is det. 263% 264% Associate Value with Node. 265 266nb_rb_set_node_value(Node, Value) :- 267 nb_setarg(3, Node, Value)