1 Treating Trees I: Ordered Binary Trees
2 ======================================
4 Although any expression in Joy can be considered to describe a
5 `tree <https://en.wikipedia.org/wiki/Tree_structure>`__ with the quotes
6 as compound nodes and the non-quote values as leaf nodes, in this page I
7 want to talk about `ordered binary
8 trees <https://en.wikipedia.org/wiki/Binary_search_tree>`__ and how to
11 The basic structure, in a `crude type
12 notation <https://en.wikipedia.org/wiki/Algebraic_data_type>`__, is:
16 Tree :: [] | [key value Tree Tree]
18 That says that a Tree is either the empty quote ``[]`` or a quote with
19 four items: a key, a value, and two Trees representing the left and
20 right branches of the tree.
22 We’re going to derive some recursive functions to work with such
33 Once these functions are defined we have a new “type” to work with, and
34 the Sufficiently Smart Compiler can be modified to use an optimized
35 implementation under the hood. (Where does the “type” come from? It has
36 a contingent existence predicated on the disciplined use of these
37 functions on otherwise undistinguished Joy datastructures.)
41 from notebook_preamble import D, J, V, define, DefinitionWrapper
43 Adding Nodes to the Tree
44 ------------------------
46 Let’s consider adding nodes to a Tree structure.
50 Tree value key Tree-add
51 -----------------------------
54 Adding to an empty node.
55 ~~~~~~~~~~~~~~~~~~~~~~~~
57 If the current node is ``[]`` then you just return
58 ``[key value [] []]``:
62 Tree-add == [popop not] [[pop] dipd Tree-new] [R0] [R1] genrec
67 Where ``Tree-new`` is defined as:
72 ------------------------
79 value key swap [[] []] cons cons
80 key value [[] []] cons cons
81 key [value [] []] cons
88 Tree-new == swap [[] []] cons cons
92 define('Tree-new == swap [[] []] cons cons')
104 (As an implementation detail, the ``[[] []]`` literal used in the
105 definition of ``Tree-new`` will be reused to supply the *constant* tail
106 for *all* new nodes produced by it. This is one of those cases where you
107 get amortized storage “for free” by using `persistent
108 datastructures <https://en.wikipedia.org/wiki/Persistent_data_structure>`__.
109 Because the tail, which is ``((), ((), ()))`` in Python, is immutable
110 and embedded in the definition body for ``Tree-new``, all new nodes can
111 reuse it as their own tail without fear that some other code somewhere
114 Adding to a non-empty node.
115 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
117 We now have to derive ``R0`` and ``R1``, consider:
121 [key_n value_n left right] value key R0 [Tree-add] R1
123 In this case, there are three possibilites: the key can be greater or
124 less than or equal to the node’s key. In two of those cases we will need
125 to apply a copy of ``Tree-add``, so ``R0`` is pretty much out of the
132 A predicate to compare keys.
133 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
137 [key_n value_n left right] value key [BTree-add] R1
139 The first thing we need to do is compare the the key we’re adding to the
140 node key and ``branch`` accordingly:
144 [key_n value_n left right] value key [BTree-add] [P] [T] [E] ifte
146 That would suggest something like:
150 [key_n value_n left right] value key [BTree-add] P
151 [key_n value_n left right] value key [BTree-add] pop roll> pop first >
152 [key_n value_n left right] value key roll> pop first >
153 key [key_n value_n left right] value roll> pop first >
157 Let’s abstract the predicate just a little to let us specify the
162 P > == pop roll> pop first >
163 P < == pop roll> pop first <
164 P == pop roll> pop first
168 define('P == pop roll> pop first')
172 J('["old_key" 23 [] []] 17 "new_key" ["..."] P')
180 If the key we’re adding is greater than the node’s key.
181 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
183 Here the parentheses are meant to signify that the expression is not
184 literal, the code in the parentheses is meant to have been evaluated:
188 [key_n value_n left right] value key [Tree-add] T
189 -------------------------------------------------------
190 [key_n value_n left (Tree-add key value right)]
192 So how do we do this? We’re going to want to use ``infra`` on some
193 function ``K`` that has the key and value to work with, as well as the
194 quoted copy of ``Tree-add`` to apply somehow. Considering the node as a
199 right left value_n key_n value key [Tree-add] K
200 -----------------------------------------------------
201 right value key Tree-add left value_n key_n
207 right left value_n key_n value key [Tree-add] cons cons dipdd
208 right left value_n key_n [value key Tree-add] dipdd
209 right value key Tree-add left value_n key_n
217 Looking at it from the point-of-view of the node as node again:
221 [key_n value_n left right] [value key [Tree-add] K] infra
223 Expand ``K`` and evaluate a little:
227 [key_n value_n left right] [value key [Tree-add] K] infra
228 [key_n value_n left right] [value key [Tree-add] cons cons dipdd] infra
229 [key_n value_n left right] [[value key Tree-add] dipdd] infra
231 Then, working backwards:
235 [key_n value_n left right] [[value key Tree-add] dipdd] infra
236 [key_n value_n left right] [value key Tree-add] [dipdd] cons infra
237 [key_n value_n left right] value key [Tree-add] cons cons [dipdd] cons infra
239 And so ``T`` is just:
243 T == cons cons [dipdd] cons infra
247 define('T == cons cons [dipdd] cons infra')
251 J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] T')
256 ['old_k' 'old_value' 'left' 'Tree-add' 'new_key' 'new_value' 'right']
259 If the key we’re adding is less than the node’s key.
260 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
262 This is very very similar to the above:
266 [key_n value_n left right] value key [Tree-add] E
267 [key_n value_n left right] value key [Tree-add] [P <] [Te] [Ee] ifte
271 define('E == [P <] [Te] [Ee] ifte')
273 In this case ``Te`` works that same as ``T`` but on the left child tree
274 instead of the right, so the only difference is that it must use
275 ``dipd`` instead of ``dipdd``:
279 Te == cons cons [dipd] cons infra
283 define('Te == cons cons [dipd] cons infra')
287 J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] Te')
292 ['old_k' 'old_value' 'Tree-add' 'new_key' 'new_value' 'left' 'right']
295 Else the keys must be equal.
296 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
298 This means we must find:
302 [key old_value left right] new_value key [Tree-add] Ee
303 ------------------------------------------------------------
304 [key new_value left right]
306 This is another easy one:
310 Ee == pop swap roll< rest rest cons cons
316 [key old_value left right] new_value key [Tree-add] pop swap roll< rest rest cons cons
317 [key old_value left right] new_value key swap roll< rest rest cons cons
318 [key old_value left right] key new_value roll< rest rest cons cons
319 key new_value [key old_value left right] rest rest cons cons
320 key new_value [ left right] cons cons
321 [key new_value left right]
325 define('Ee == pop swap roll< rest rest cons cons')
329 J('["k" "old_value" "left" "right"] "new_value" "k" ["Tree-add"] Ee')
334 ['k' 'new_value' 'left' 'right']
337 Now we can define ``Tree-add``
338 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
342 Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec
344 Putting it all together:
348 Tree-new == swap [[] []] cons cons
349 P == pop roll> pop first
350 T == cons cons [dipdd] cons infra
351 Te == cons cons [dipd] cons infra
352 Ee == pop swap roll< rest rest cons cons
353 E == [P <] [Te] [Ee] ifte
354 R == [P >] [T] [E] ifte
356 Tree-add == [popop not] [[pop] dipd Tree-new] [] [R] genrec
360 define('Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec')
367 J('[] 23 "b" Tree-add') # Initial
377 J('["b" 23 [] []] 88 "c" Tree-add') # Greater than
382 ['b' 23 [] ['c' 88 [] []]]
387 J('["b" 23 [] []] 88 "a" Tree-add') # Less than
392 ['b' 23 ['a' 88 [] []] []]
397 J('["b" 23 [] []] 88 "b" Tree-add') # Equal to
407 J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Series.
412 ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
417 J('[] [[23 "b"] [88 "a"] [44 "c"]] [i Tree-add] step')
422 ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
425 Interlude: ``cmp`` combinator
426 -----------------------------
428 Instead of mucking about with nested ``ifte`` combinators let’s use
429 ``cmp`` which takes two values and three quoted programs on the stack
430 and runs one of the three depending on the results of comparing the two
436 ------------------------- a > b
440 ------------------------- a = b
444 ------------------------- a < b
449 J("1 0 ['G'] ['E'] ['L'] cmp")
459 J("1 1 ['G'] ['E'] ['L'] cmp")
469 J("0 1 ['G'] ['E'] ['L'] cmp")
477 Redefine ``Tree-add``
478 ~~~~~~~~~~~~~~~~~~~~~
480 We need a new non-destructive predicate ``P``:
484 [node_key node_value left right] value key [Tree-add] P
485 ------------------------------------------------------------------------
486 [node_key node_value left right] value key [Tree-add] key node_key
488 Let’s start with ``over`` to get a copy of the key and then apply some
489 function ``Q`` with the ``nullary`` combinator so it can dig out the
490 node key (by throwing everything else away):
494 P == over [Q] nullary
496 [node_key node_value left right] value key [Tree-add] over [Q] nullary
497 [node_key node_value left right] value key [Tree-add] key [Q] nullary
503 Q == popop popop first
505 [node_key node_value left right] value key [Tree-add] key Q
506 [node_key node_value left right] value key [Tree-add] key popop popop first
507 [node_key node_value left right] value key popop first
508 [node_key node_value left right] first
515 P == over [popop popop first] nullary
519 define('P == over [popop popop first] nullary')
521 Using ``cmp`` to simplify `our code above at
522 ``R1`` <#Adding-to-a-non-empty-node.>`__:
526 [node_key node_value left right] value key [Tree-add] R1
527 [node_key node_value left right] value key [Tree-add] P [T] [E] [Te] cmp
529 The line above becomes one of the three lines below:
533 [node_key node_value left right] value key [Tree-add] T
534 [node_key node_value left right] value key [Tree-add] E
535 [node_key node_value left right] value key [Tree-add] Te
537 The definition is a little longer but, I think, more elegant and easier
542 Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec
546 define('Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec')
550 J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Still works.
555 ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
558 A Function to Traverse this Structure
559 -------------------------------------
561 Let’s take a crack at writing a function that can recursively iterate or
562 traverse these trees.
567 The stopping predicate just has to detect the empty list:
571 Tree-iter == [not] [E] [R0] [R1] genrec
573 And since there’s nothing at this node, we just ``pop`` it:
577 Tree-iter == [not] [pop] [R0] [R1] genrec
579 Node case ``[key value left right]``
580 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
582 Now we need to figure out ``R0`` and ``R1``:
586 Tree-iter == [not] [pop] [R0] [R1] genrec
587 == [not] [pop] [R0 [Tree-iter] R1] ifte
589 Let’s look at it *in situ*:
593 [key value left right] R0 [Tree-iter] R1
595 Processing the current node.
596 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
598 ``R0`` is almost certainly going to use ``dup`` to make a copy of the
599 node and then ``dip`` on some function to process the copy with it:
603 [key value left right] [F] dupdip [Tree-iter] R1
604 [key value left right] F [key value left right] [Tree-iter] R1
606 For example, if we’re getting all the keys ``F`` would be ``first``:
612 [key value left right] [first] dupdip [Tree-iter] R1
613 [key value left right] first [key value left right] [Tree-iter] R1
614 key [key value left right] [Tree-iter] R1
619 Now ``R1`` needs to apply ``[Tree-iter]`` to ``left`` and ``right``. If
620 we drop the key and value from the node using ``rest`` twice we are left
621 with an interesting situation:
625 key [key value left right] [Tree-iter] R1
626 key [key value left right] [Tree-iter] [rest rest] dip
627 key [key value left right] rest rest [Tree-iter]
628 key [left right] [Tree-iter]
630 Hmm, will ``step`` do?
634 key [left right] [Tree-iter] step
635 key left Tree-iter [right] [Tree-iter] step
636 key left-keys [right] [Tree-iter] step
637 key left-keys right Tree-iter
638 key left-keys right-keys
644 R1 == [rest rest] dip step
653 Tree-iter == [not] [pop] [[F] dupdip] [[rest rest] dip step] genrec
655 When I was reading this over I realized ``rest rest`` could go in
660 Tree-iter == [not] [pop] [[F] dupdip rest rest] [step] genrec
662 (And ``[step] genrec`` is such a cool and suggestive combinator!)
664 Parameterizing the ``F`` per-node processing function.
665 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
670 ------------------------------------------------------
671 [not] [pop] [[F] dupdip rest rest] [step] genrec
677 [not] [pop] [[F] dupdip rest rest] [step] genrec
678 [not] [pop] [F] [dupdip rest rest] cons [step] genrec
679 [F] [not] [pop] roll< [dupdip rest rest] cons [step] genrec
686 Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec
690 define('Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec')
697 J('[] [foo] Tree-iter') # It doesn't matter what F is as it won't be used.
707 J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [first] Tree-iter")
717 J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [second] Tree-iter")
725 Interlude: A Set-like Datastructure
726 -----------------------------------
728 We can use this to make a set-like datastructure by just setting values
729 to e.g. 0 and ignoring them. It’s set-like in that duplicate items added
730 to it will only occur once within it, and we can query it in
731 `:math:`O(\log_2 N)` <https://en.wikipedia.org/wiki/Binary_search_tree#cite_note-2>`__
736 J('[] [3 9 5 2 8 6 7 8 4] [0 swap Tree-add] step')
741 [3 0 [2 0 [] []] [9 0 [5 0 [4 0 [] []] [8 0 [6 0 [] [7 0 [] []]] []]] []]]
746 define('to_set == [] swap [0 swap Tree-add] step')
750 J('[3 9 5 2 8 6 7 8 4] to_set')
755 [3 0 [2 0 [] []] [9 0 [5 0 [4 0 [] []] [8 0 [6 0 [] [7 0 [] []]] []]] []]]
758 And with that we can write a little program ``unique`` to remove
759 duplicate items from a list.
763 define('unique == [to_set [first] Tree-iter] cons run')
767 J('[3 9 3 5 2 9 8 8 8 6 2 7 8 4 3] unique') # Filter duplicate items.
775 A Version of ``Tree-iter`` that does In-Order Traversal
776 -------------------------------------------------------
778 If you look back to the `non-empty case of the ``Tree-iter``
779 function <#Node-case-%5Bkey-value-left-right%5D>`__ we can design a
780 variant that first processes the left child, then the current node, then
781 the right child. This will allow us to traverse the tree in sort order.
785 Tree-iter-order == [not] [pop] [R0] [R1] genrec
787 To define ``R0`` and ``R1`` it helps to look at them as they will appear
792 [key value left right] R0 [BTree-iter-order] R1
794 Process the left child.
795 ~~~~~~~~~~~~~~~~~~~~~~~
797 Staring at this for a bit suggests ``dup third`` to start:
801 [key value left right] R0 [Tree-iter-order] R1
802 [key value left right] dup third [Tree-iter-order] R1
803 [key value left right] left [Tree-iter-order] R1
809 [key value left right] left [Tree-iter-order] [cons dip] dupdip
810 [key value left right] left [Tree-iter-order] cons dip [Tree-iter-order]
811 [key value left right] [left Tree-iter-order] dip [Tree-iter-order]
812 left Tree-iter-order [key value left right] [Tree-iter-order]
814 Process the current node.
815 ~~~~~~~~~~~~~~~~~~~~~~~~~
817 So far, so good. Now we need to process the current node’s values:
821 left Tree-iter-order [key value left right] [Tree-iter-order] [[F] dupdip] dip
822 left Tree-iter-order [key value left right] [F] dupdip [Tree-iter-order]
823 left Tree-iter-order [key value left right] F [key value left right] [Tree-iter-order]
825 If ``F`` needs items from the stack below the left stuff it should have
826 ``cons``\ ’d them before beginning maybe? For functions like ``first``
831 left Tree-iter-order [key value left right] first [key value left right] [Tree-iter-order]
832 left Tree-iter-order key [key value left right] [Tree-iter-order]
834 Process the right child.
835 ~~~~~~~~~~~~~~~~~~~~~~~~
837 First ditch the rest of the node and get the right child:
841 left Tree-iter-order key [key value left right] [Tree-iter-order] [rest rest rest first] dip
842 left Tree-iter-order key right [Tree-iter-order]
844 Then, of course, we just need ``i`` to run ``Tree-iter-order`` on the
849 left Tree-iter-order key right [Tree-iter-order] i
850 left Tree-iter-order key right Tree-iter-order
852 Defining ``Tree-iter-order``
853 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
855 The result is a little awkward:
859 R1 == [cons dip] dupdip [[F] dupdip] dip [rest rest rest first] dip i
861 Let’s do a little semantic factoring:
865 fourth == rest rest rest first
867 proc_left == [cons dip] dupdip
868 proc_current == [[F] dupdip] dip
869 proc_right == [fourth] dip i
871 Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
873 Now we can sort sequences.
877 #define('Tree-iter-order == [not] [pop] [dup third] [[cons dip] dupdip [[first] dupdip] dip [rest rest rest first] dip i] genrec')
880 DefinitionWrapper.add_definitions('''
882 fourth == rest rest rest first
884 proc_left == [cons dip] dupdip
885 proc_current == [[first] dupdip] dip
886 proc_right == [fourth] dip i
888 Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
897 J('[3 9 5 2 8 6 7 8 4] to_set Tree-iter-order')
905 Parameterizing the ``[F]`` function is left as an exercise for the
908 Getting values by key
909 ---------------------
911 Let’s derive a function that accepts a tree and a key and returns the
912 value associated with that key.
917 -----------------------
920 But what do we do if the key isn’t in the tree? In Python we might raise
921 a ``KeyError`` but I’d like to avoid exceptions in Joy if possible, and
922 here I think it’s possible. (Division by zero is an example of where I
923 think it’s probably better to let Python crash Joy. Sometimes the
924 machinery fails and you have to “stop the line”, I think.)
926 Let’s pass the buck to the caller by making the base case a given, you
927 have to decide for yourself what ``[E]`` should be.
931 tree key [E] Tree-get
932 ---------------------------- key in tree
935 tree key [E] Tree-get
936 ---------------------------- key not in tree
942 As before, the stopping predicate just has to detect the empty list:
946 Tree-get == [pop not] [E] [R0] [R1] genrec
952 Tree-get == [pop not] swap [R0] [R1] genrec
954 Note that this ``Tree-get`` creates a slightly different function than
955 itself and *that function* does the actual recursion. This kind of
956 higher-level programming is unusual in most languages but natural in
961 tree key [E] [pop not] swap [R0] [R1] genrec
962 tree key [pop not] [E] [R0] [R1] genrec
964 The anonymous specialized recursive function that will do the real work.
968 [pop not] [E] [R0] [R1] genrec
970 Node case ``[key value left right]``
971 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
973 Now we need to figure out ``R0`` and ``R1``:
977 [key value left right] key R0 [BTree-get] R1
979 We want to compare the search key with the key in the node, and if they
980 are the same return the value, otherwise recur on one of the child
981 nodes. So it’s very similar to the above funtion, with ``[R0] == []``
982 and ``R1 == P [T>] [E] [T<] cmp``:
986 [key value left right] key [BTree-get] P [T>] [E] [T<] cmp
993 P == over [get-node-key] nullary
994 get-node-key == pop popop first
996 The only difference is that ``get-node-key`` does one less ``pop``
997 because there’s no value to discard.
1002 Now we have to derive the branches:
1006 [key_n value_n left right] key [BTree-get] T>
1007 [key_n value_n left right] key [BTree-get] E
1008 [key_n value_n left right] key [BTree-get] T<
1010 Greater than and less than
1011 ^^^^^^^^^^^^^^^^^^^^^^^^^^
1013 The cases of ``T>`` and ``T<`` are similar to above but instead of using
1014 ``infra`` we have to discard the rest of the structure:
1018 [key_n value_n left right] key [BTree-get] T>
1019 ---------------------------------------------------
1026 [key_n value_n left right] key [BTree-get] T<
1027 ---------------------------------------------------
1034 T> == [fourth] dipd i
1035 T< == [third] dipd i
1041 [key_n value_n left right] key [BTree-get] [fourth] dipd i
1042 [key_n value_n left right] fourth key [BTree-get] i
1043 right key [BTree-get] i
1049 Return the node’s value:
1053 [key_n value_n left right] key [BTree-get] E == value_n
1064 fourth == rest rest rest first
1065 get-node-key == pop popop first
1066 P == over [get-node-key] nullary
1067 T> == [fourth] dipd i
1068 T< == [third] dipd i
1071 Tree-get == [pop not] swap [] [P [T>] [E] [T<] cmp] genrec
1075 # I don't want to deal with name conflicts with the above so I'm inlining everything here.
1076 # The original Joy system has "hide" which is a meta-command which allows you to use named
1077 # definitions that are only in scope for a given definition. I don't want to implement
1082 Tree-get == [pop not] swap [] [
1083 over [pop popop first] nullary
1093 J('["gary" 23 [] []] "mike" [popd " not in tree" +] Tree-get')
1103 J('["gary" 23 [] []] "gary" [popop "err"] Tree-get')
1115 [] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
1117 'c' [popop 'not found'] Tree-get
1131 [] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
1133 'd' [popop 'not found'] Tree-get
1146 Now let’s write a function that can return a tree datastructure with a
1147 key, value pair deleted:
1151 tree key Tree-delete
1152 ---------------------------
1155 If the key is not in tree it just returns the tree unchanged.
1164 Tree-Delete == [pop not] [pop] [R0] [R1] genrec
1169 Now we get to figure out the recursive case. We need the node’s key to
1170 compare and we need to carry the key into recursive branches. Let ``D``
1171 be shorthand for ``Tree-Delete``:
1175 D == Tree-Delete == [pop not] [pop] [R0] [R1] genrec
1177 [node_key node_value left right] key R0 [D] R1
1178 [node_key node_value left right] key over first swap dup [D] cons R1′
1179 [node_key node_value left right] key [...] first swap dup [D] cons R1′
1180 [node_key node_value left right] key node_key swap dup [D] cons R1′
1181 [node_key node_value left right] node_key key dup [D] cons R1′
1182 [node_key node_value left right] node_key key key [D] cons R1′
1183 [node_key node_value left right] node_key key [key D] R1′
1189 [node_key node_value left right] node_key key [key D] R1′
1190 [node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
1191 [node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
1192 [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
1198 R0 == over first swap dup
1199 R1 == cons roll> [T>] [E] [T<] cmp
1204 The last line above:
1208 [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
1210 Then becomes one of these three:
1214 [node_key node_value left right] [key D] T>
1215 [node_key node_value left right] [key D] E
1216 [node_key node_value left right] [key D] T<
1218 Greater than case and less than case
1219 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1223 [node_key node_value left right] [F] T>
1224 -------------------------------------------------
1225 [node_key node_value (left F) right]
1228 [node_key node_value left right] [F] T<
1229 -------------------------------------------------
1230 [node_key node_value left (right F)]
1232 First, treating the node as a stack:
1236 right left node_value node_key [key D] dipd
1237 right left key D node_value node_key
1238 right left' node_value node_key
1244 [node_key node_value left right] [key D] [dipd] cons infra
1250 T> == [dipd] cons infra
1251 T< == [dipdd] cons infra
1256 We have found the node in the tree where ``key`` equals ``node_key``. We
1257 need to replace the current node with something
1261 [node_key node_value left right] [key D] E
1262 ------------------------------------------------
1265 We have to handle three cases, so let’s use ``cond``.
1267 One or more child nodes are ``[]``
1268 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1270 The first two cases are symmetrical: if we only have one non-empty child
1271 node return it. If both child nodes are empty return an empty node.
1276 [[pop third not] pop fourth]
1277 [[pop fourth not] pop third]
1281 Both child nodes are non-empty.
1282 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1284 If both child nodes are non-empty, we find the highest node in our lower
1285 sub-tree, take its key and value to replace (delete) our own, then get
1286 rid of it by recursively calling delete() on our lower sub-node with our
1289 (We could also find the lowest node in our higher sub-tree and take its
1290 key and value and delete it. I only implemented one of these two
1291 symmetrical options. Over a lot of deletions this might make the tree
1292 more unbalanced. Oh well.)
1294 The initial structure of the default function:
1298 default == [E′] cons infra
1300 [node_key node_value left right] [key D] default
1301 [node_key node_value left right] [key D] [E′] cons infra
1302 [node_key node_value left right] [[key D] E′] infra
1304 right left node_value node_key [key D] E′
1306 First things first, we no longer need this node’s key and value:
1310 right left node_value node_key [key D] roll> popop E″
1311 right left [key D] node_value node_key popop E″
1312 right left [key D] E″
1314 We have to we find the highest (right-most) node in our lower (left) sub-tree:
1315 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1319 right left [key D] E″
1325 right left [key D] rest E‴
1328 Find the right-most node:
1332 right left [D] [dup W] dip E⁗
1333 right left dup W [D] E⁗
1334 right left left W [D] E⁗
1342 We know left is not empty:
1346 [L_key L_value L_left L_right] W
1348 We want to keep extracting the right node as long as it is not empty:
1352 W.rightmost == [P] [B] while
1360 [L_key L_value L_left L_right] P
1361 [L_key L_value L_left L_right] fourth
1364 This can run on ``[]`` so must be guarded:
1368 ?fourth == [] [fourth] [] ifte
1370 ( if_not_empty == [] swap [] ifte ?fourth == [fourth] if_not_empty )
1372 The body is just ``fourth``:
1376 left [?fourth] [fourth] while W′
1383 W.rightmost == [?fourth] [fourth] while
1385 Found right-most node in our left sub-tree
1386 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1388 We know rightest is not empty:
1392 [R_key R_value R_left R_right] W′
1393 [R_key R_value R_left R_right] W′
1394 [R_key R_value R_left R_right] uncons uncons pop
1395 R_key [R_value R_left R_right] uncons pop
1396 R_key R_value [R_left R_right] pop
1403 W == [?fourth] [fourth] while uncons uncons pop
1409 right left left W [D] E⁗
1410 right left R_key R_value [D] E⁗
1412 Replace current node key and value, recursively delete rightmost
1413 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1415 Final stretch. We want to end up with something like:
1419 right left [R_key D] i R_value R_key
1420 right left R_key D R_value R_key
1421 right left′ R_value R_key
1423 If we adjust our definition of ``W`` to include ``over`` at the end:
1427 W == [fourth] [fourth] while uncons uncons pop over
1433 right left R_key R_value R_key [D] E⁗
1435 right left R_key R_value R_key [D] cons dipd E⁗′
1436 right left R_key R_value [R_key D] dipd E⁗′
1437 right left R_key D R_key R_value E⁗′
1438 right left′ R_key R_value E⁗′
1439 right left′ R_key R_value swap
1440 right left′ R_value R_key
1446 E′ == roll> popop E″
1450 E‴ == [dup W] dip E⁗
1452 E⁗ == cons dipdd swap
1458 W == [fourth] [fourth] while uncons uncons pop over
1459 E′ == roll> popop rest [dup W] dip cons dipd swap
1461 [[pop third not] pop fourth]
1462 [[pop fourth not] pop third]
1466 Minor rearrangement, move ``dup`` into ``W``:
1470 W == dup [fourth] [fourth] while uncons uncons pop over
1471 E′ == roll> popop rest [W] dip cons dipd swap
1473 [[pop third not] pop fourth]
1474 [[pop fourth not] pop third]
1483 W.rightmost == [fourth] [fourth] while
1484 W.unpack == uncons uncons pop
1485 W == dup W.rightmost W.unpack over
1486 E.clear_stuff == roll> popop rest
1487 E.delete == cons dipd
1488 E.0 == E.clear_stuff [W] dip E.delete swap
1490 [[pop third not] pop fourth]
1491 [[pop fourth not] pop third]
1494 T> == [dipd] cons infra
1495 T< == [dipdd] cons infra
1496 R0 == over first swap dup
1497 R1 == cons roll> [T>] [E] [T<] cmp
1498 BTree-Delete == [pop not] swap [R0] [R1] genrec
1500 By the standards of the code I’ve written so far, this is a *huge* Joy
1505 DefinitionWrapper.add_definitions('''
1506 first_two == uncons uncons pop
1507 fourth == rest rest rest first
1508 ?fourth == [] [fourth] [] ifte
1509 W.rightmost == [?fourth] [fourth] while
1510 E.clear_stuff == roll> popop rest
1511 E.delete == cons dipd
1512 W == dup W.rightmost first_two over
1513 E.0 == E.clear_stuff [W] dip E.delete swap
1514 E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[E.0] cons infra]] cond
1515 T> == [dipd] cons infra
1516 T< == [dipdd] cons infra
1517 R0 == over first swap dup
1518 R1 == cons roll> [T>] [E] [T<] cmp
1519 Tree-Delete == [pop not] [pop] [R0] [R1] genrec
1524 J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'c' Tree-Delete ")
1529 ['a' 23 [] ['b' 88 [] []]]
1534 J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'b' Tree-Delete ")
1539 ['a' 23 [] ['c' 44 [] []]]
1544 J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'a' Tree-Delete ")
1549 ['b' 88 [] ['c' 44 [] []]]
1554 J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' Tree-Delete ")
1559 ['a' 23 [] ['b' 88 [] ['c' 44 [] []]]]
1564 J('[] [4 2 3 1 6 7 5 ] [0 swap Tree-add] step')
1569 [4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]]
1574 J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 3 Tree-Delete ")
1579 [4 0 [2 0 [1 0 [] []] []] [6 0 [5 0 [] []] [7 0 [] []]]]
1584 J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 4 Tree-Delete ")
1589 [3 0 [2 0 [1 0 [] []] []] [6 0 [5 0 [] []] [7 0 [] []]]]
1592 Appendix: The source code.
1593 --------------------------
1597 fourth == rest_two rest first
1598 ?fourth == [] [fourth] [] ifte
1599 first_two == uncons uncons pop
1602 rest_two == rest rest
1604 _Tree_T> == [dipd] cinf
1605 _Tree_T< == [dipdd] cinf
1607 _Tree_add_P == over [popop popop first] nullary
1608 _Tree_add_T> == ccons _Tree_T<
1609 _Tree_add_T< == ccons _Tree_T>
1610 _Tree_add_Ee == pop swap roll< rest_two ccons
1611 _Tree_add_R == _Tree_add_P [_Tree_add_T>] [_Tree_add_Ee] [_Tree_add_T<] cmp
1612 _Tree_add_E == [pop] dipd Tree-new
1614 _Tree_iter_order_left == [cons dip] dupdip
1615 _Tree_iter_order_current == [[F] dupdip] dip
1616 _Tree_iter_order_right == [fourth] dip i
1617 _Tree_iter_order_R == _Tree_iter_order_left _Tree_iter_order_current _Tree_iter_order_right
1619 _Tree_get_P == over [pop popop first] nullary
1620 _Tree_get_T> == [fourth] dipd i
1621 _Tree_get_T< == [third] dipd i
1622 _Tree_get_E == popop second
1623 _Tree_get_R == _Tree_get_P [_Tree_get_T>] [_Tree_get_E] [_Tree_get_T<] cmp
1625 _Tree_delete_rightmost == [?fourth] [fourth] while
1626 _Tree_delete_clear_stuff == roll> popop rest
1627 _Tree_delete_del == dip cons dipd swap
1628 _Tree_delete_W == dup _Tree_delete_rightmost first_two over
1629 _Tree_delete_E.0 == _Tree_delete_clear_stuff [_Tree_delete_W] _Tree_delete_del
1630 _Tree_delete_E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[_Tree_delete_E.0] cinf]] cond
1631 _Tree_delete_R0 == over first swap dup
1632 _Tree_delete_R1 == cons roll> [_Tree_T>] [_Tree_delete_E] [_Tree_T<] cmp
1634 Tree-new == swap [[] []] ccons
1635 Tree-add == [popop not] [_Tree_add_E] [] [_Tree_add_R] genrec
1636 Tree-iter == [not] [pop] roll< [dupdip rest_two] cons [step] genrec
1637 Tree-iter-order == [not] [pop] [dup third] [_Tree_iter_order_R] genrec
1638 Tree-get == [pop not] swap [] [_Tree_get_R] genrec
1639 Tree-delete == [pop not] [pop] [_Tree_delete_R0] [_Tree_delete_R1] genrec