+
from sympy import floor, lambdify, solve, symbols
from sympy import init_printing
-init_printing()
+init_printing()
%time rank_of(23000000000000) # Compare runtime with rank_and_offset()!
+%time rank_of(23000000000000) # Compare runtime with rank_and_offset()!
%time rank_and_offset(23000000000000)
+%time rank_and_offset(23000000000000)
%time int(F(23000000000000)) # The clear winner.
+%time int(F(23000000000000)) # The clear winner.
%time mrank_of(23000000000000)
+%time mrank_of(23000000000000)
%time aoc20173(23000000000000000000000000) # Fast for large values.
+%time aoc20173(23000000000000000000000000) # Fast for large values.
Consider the x combinator x == dup i:
Consider the x combinator:
[a B] x
-[a B] a B
+x == dup i
-Let B swap the a with the quote and run some function [C] on it.
+We can apply it to a quoted program consisting of some value a and a function B:
-[a B] a B
+[a B] x
+[a B] a B
+
+
Let B function swap the a with the quote and run some function C on it to generate a new value b:
B == swap [C] dip
+
+[a B] a B
[a B] a swap [C] dip
a [a B] [C] dip
a C [a B]
+b [a B]Now discard the quoted a with rest and cons the result of C on a whatever that is:
Now discard the quoted a with rest then cons b:
aC [a B] rest cons
-aC [B] cons
-[aC B]
+b [a B] rest cons
+b [B] cons
+[b B]
-Altogether, this is the definition of B:
Putting it together, this is the definition of B:
B == swap [C] dip rest cons
+B == swap [C] dip rest cons
-We can create a quoted program that generates the Natural numbers (integers 0, 1, 2, ...) by using 0 for a and [dup ++] for [C]:
We can create a quoted program that generates the Natural numbers (0, 1, 2, ...) by using 0 for a and [dup ++] for [C]:
[0 swap [dup ++] dip rest cons]
@@ -11983,16 +12015,19 @@ aC [B] cons
Working in reverse:
[a swap [C] direco] cons
@@ -12005,12 +12040,7 @@ a [C] [direco] cons [swap]
Reading from the bottom up:
G == [direco] cons [swap] swap concat cons
-G == [direco] cons [swap] swoncat cons
-
-
-We can try it out:
-
-0 [dup ++] G
+G == [direco] cons [swap] swoncat consLet's try it out:
+ +V('0 [dup ++] G')
+J('0 [dup ++] G')
V('0 [dup ++] G x')
+J('0 [dup ++] G x x x pop')
J('1 [dup 1 <<] G x x x x x x x x x')
+J('1 [dup 1 <<] G x x x x x x x x x pop')
n [x] times¶If we have one of these quoted programs we can drive it using times with the x combinator.
Let's define a word n_range that takes a starting integer and a count and leaves that many consecutive integers on the stack. For example:
[x] times¶If we have one of these quoted programs we can drive it using times with the x combinator.
J('23 [dup ++] G 5 [x] times pop')
+J('23 [dup ++] G 5 [x] times')
We can use dip to untangle [dup ++] G from the arguments.
J('23 5 [[dup ++] G] dip [x] times pop')
-Now that the givens (arguments) are on the left we have the definition we're looking for:
- -define('n_range == [[dup ++] G] dip [x] times pop')
-J('450 10 n_range')
-This is better just using the times combinator though...
J('450 9 [dup ++] times')
-define('PE1.1 == dup [3 &] dip 2 >>')
@@ -12369,7 +12243,7 @@ G == [direco] cons [swap] swoncat cons
V('14811 PE1.1')
@@ -12419,7 +12293,7 @@ G == [direco] cons [swap] swoncat cons
J('14811 [PE1.1] G')
@@ -12447,37 +12321,6 @@ G == [direco] cons [swap] swoncat cons
J('[14811 swap [PE1.1] direco] x')
-J('[14811 swap [PE1.1] direco] 7 [x] times')
@@ -12530,7 +12373,7 @@ G == [direco] cons [swap] swoncat cons
define('PE1.1.check == dup [pop 14811] [] branch')
@@ -12543,7 +12386,38 @@ G == [direco] cons [swap] swoncat cons
J('14811 [PE1.1.check PE1.1] G')
+J('[14811 swap [PE1.1.check PE1.1] direco] 21 [x] times')
@@ -12571,6 +12445,15 @@ G == [direco] cons [swap] swoncat cons
(It would be more efficient to reset the int every seven cycles but that's a little beyond the scope of this article. This solution does extra work, but not much, and we're not using it "in production" as they say.)
+ +J('7 66 * 4 +')
@@ -12623,10 +12506,10 @@ G == [direco] cons [swap] swoncat cons
J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times')
+J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times')
J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times pop enstacken sum')
+J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times pop enstacken sum')
define('PE1.2 == + dup [+] dip')
@@ -12708,54 +12591,14 @@ G == [direco] cons [swap] swoncat cons
Now we can add PE1.2 to the quoted program given to times.
Now we can add PE1.2 to the quoted program given to G.
J('0 0 [0 swap [PE1.1.check PE1.1] direco] 466 [x [PE1.2] dip] times popop')
-Or using G we can write:
J('0 0 0 [PE1.1.check PE1.1] G 466 [x [PE1.2] dip] times popop')
@@ -12791,73 +12634,135 @@ G == [direco] cons [swap] swoncat cons
A generator for the Fibonacci Sequence.¶
Consider:
[b a F] x
-[b a F] b a F
+[b a F] b a F
-
+The obvious first thing to do is just add b and a:
[b a F] b a +
-[b a F] b+a
+[b a F] b+aFrom here we want to arrive at:
-b [b+a b F]
+b [b+a b F]
-Let's start with swons:
[b a F] b+a swons
-[b+a b a F]
+[b+a b a F]Considering this quote as a stack:
-F a b b+a
+F a b b+a
-We want to get it to:
-F b b+a b
+F b b+a b
-So:
F a b b+a popdd over
-F b b+a b
+F b b+a bAnd therefore:
[b+a b a F] [popdd over] infra
-[b b+a b F]
+[b b+a b F]And lastly:
+But we can just use cons to carry b+a into the quote:
[b a F] b+a [popdd over] cons infra
+[b a F] [b+a popdd over] infra
+[b b+a b F]Lastly:
[b b+a b F] uncons
-b [b+a b F]
+b [b+a b F]Done.
+Putting it all together:
-F == + swons [popdd over] infra uncons
-
-And:
- -fib_gen == [1 1 F]F == + [popdd over] cons infra uncons
+fib_gen == [1 1 F]define('fib == + swons [popdd over] infra uncons')
+define('fib == + [popdd over] cons infra uncons')
define('fib_gen == [1 1 fib]')
@@ -12880,7 +12785,7 @@ b [b+a b F]
J('fib_gen 10 [x] times')
@@ -12914,7 +12819,8 @@ b [b+a b F]
Project Euler Problem Two¶
-By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms.
+By considering the terms in the Fibonacci sequence whose values do not exceed four million,
+find the sum of the even-valued terms.
Now that we have a generator for the Fibonacci sequence, we need a function that adds a term in the sequence to a sum if it is even, and pops it otherwise.
@@ -12924,7 +12830,7 @@ b [b+a b F]
-In [31]:
+In [26]:
define('PE2.1 == dup 2 % [+] [pop] branch')
@@ -12946,7 +12852,7 @@ b [b+a b F]
-In [32]:
+In [27]:
define('>4M == 4000000 >')
@@ -12968,7 +12874,7 @@ b [b+a b F]
-In [33]:
+In [28]:
define('PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec')
@@ -12981,7 +12887,7 @@ b [b+a b F]
-In [34]:
+In [29]:
J('PE2')
@@ -13052,7 +12958,7 @@ o + e = o
-In [35]:
+In [30]:
J('[1 0 fib] x x x') # To start the sequence with 1 1 2 3 instead of 1 2 3.
@@ -13092,7 +12998,7 @@ o + e = o
-In [36]:
+In [31]:
J('[1 0 fib] x x x [popop] dipd')
@@ -13123,7 +13029,7 @@ o + e = o
-In [37]:
+In [32]:
define('PE2.2 == x x x [popop] dipd')
@@ -13136,7 +13042,7 @@ o + e = o
-In [38]:
+In [33]:
J('[1 0 fib] 10 [PE2.2] times')
@@ -13176,7 +13082,7 @@ o + e = o
-In [39]:
+In [34]:
J('0 [1 0 fib] PE2.2 [pop >4M] [popop] [[PE2.1] dip PE2.2] primrec')
@@ -13213,6 +13119,115 @@ o + e = o
+
+
+
+
+
+An Interesting Variation¶
+
+
+
+
+
+In [35]:
+
+
+define('codireco == cons dip rest cons')
+
+
+
+
+
+
+
+
+
+In [36]:
+
+
+V('[0 [dup ++] codireco] x')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [37]:
+
+
+define('G == [codireco] cons cons')
+
+
+
+
+
+
+
+
+
+In [38]:
+
+
+J('230 [dup ++] G 5 [x] times pop')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/docs/Generator Programs.md b/docs/Generator Programs.md
index 51fd247..6190a1b 100644
--- a/docs/Generator Programs.md
+++ b/docs/Generator Programs.md
@@ -8,29 +8,36 @@ Cf. jp-reprod.html
from notebook_preamble import J, V, define
```
-Consider the `x` combinator `x == dup i`:
+Consider the `x` combinator:
+
+ x == dup i
+
+We can apply it to a quoted program consisting of some value `a` and a function `B`:
[a B] x
[a B] a B
-Let `B` `swap` the `a` with the quote and run some function `[C]` on it.
+Let `B` function `swap` the `a` with the quote and run some function `C` on it to generate a new value `b`:
+
+ B == swap [C] dip
[a B] a B
[a B] a swap [C] dip
a [a B] [C] dip
a C [a B]
+ b [a B]
-Now discard the quoted `a` with `rest` and `cons` the result of `C` on `a` whatever that is:
+Now discard the quoted `a` with `rest` then `cons` `b`:
- aC [a B] rest cons
- aC [B] cons
- [aC B]
+ b [a B] rest cons
+ b [B] cons
+ [b B]
-Altogether, this is the definition of `B`:
+Putting it together, this is the definition of `B`:
B == swap [C] dip rest cons
-We can create a quoted program that generates the Natural numbers (integers 0, 1, 2, ...) by using `0` for `a` and `[dup ++]` for `[C]`:
+We can create a quoted program that generates the Natural numbers (0, 1, 2, ...) by using `0` for `a` and `[dup ++]` for `[C]`:
[0 swap [dup ++] dip rest cons]
@@ -92,14 +99,12 @@ V('[0 swap [dup ++] direco] x')
0 [1 swap [dup ++] direco] .
-# Generating Generators
-We want to go from:
+# Making Generators
+We want to define a function that accepts `a` and `[C]` and builds our quoted program:
- a [C] G
-
-to:
-
- [a swap [C] direco]
+ a [C] G
+ -------------------------
+ [a swap [C] direco]
Working in reverse:
@@ -114,118 +119,48 @@ Reading from the bottom up:
G == [direco] cons [swap] swap concat cons
G == [direco] cons [swap] swoncat cons
-We can try it out:
-
- 0 [dup ++] G
-
```python
define('G == [direco] cons [swap] swoncat cons')
```
+Let's try it out:
+
```python
-V('0 [dup ++] G')
+J('0 [dup ++] G')
```
- . 0 [dup ++] G
- 0 . [dup ++] G
- 0 [dup ++] . G
- 0 [dup ++] . [direco] cons [swap] swoncat cons
- 0 [dup ++] [direco] . cons [swap] swoncat cons
- 0 [[dup ++] direco] . [swap] swoncat cons
- 0 [[dup ++] direco] [swap] . swoncat cons
- 0 [[dup ++] direco] [swap] . swap concat cons
- 0 [swap] [[dup ++] direco] . concat cons
- 0 [swap [dup ++] direco] . cons
- [0 swap [dup ++] direco] .
+ [0 swap [dup ++] direco]
```python
-V('0 [dup ++] G x')
+J('0 [dup ++] G x x x pop')
```
- . 0 [dup ++] G x
- 0 . [dup ++] G x
- 0 [dup ++] . G x
- 0 [dup ++] . [direco] cons [swap] swoncat cons x
- 0 [dup ++] [direco] . cons [swap] swoncat cons x
- 0 [[dup ++] direco] . [swap] swoncat cons x
- 0 [[dup ++] direco] [swap] . swoncat cons x
- 0 [[dup ++] direco] [swap] . swap concat cons x
- 0 [swap] [[dup ++] direco] . concat cons x
- 0 [swap [dup ++] direco] . cons x
- [0 swap [dup ++] direco] . x
- [0 swap [dup ++] direco] . 0 swap [dup ++] direco
- [0 swap [dup ++] direco] 0 . swap [dup ++] direco
- 0 [0 swap [dup ++] direco] . [dup ++] direco
- 0 [0 swap [dup ++] direco] [dup ++] . direco
- 0 [0 swap [dup ++] direco] [dup ++] . dip rest cons
- 0 . dup ++ [0 swap [dup ++] direco] rest cons
- 0 0 . ++ [0 swap [dup ++] direco] rest cons
- 0 1 . [0 swap [dup ++] direco] rest cons
- 0 1 [0 swap [dup ++] direco] . rest cons
- 0 1 [swap [dup ++] direco] . cons
- 0 [1 swap [dup ++] direco] .
+ 0 1 2
### Powers of 2
```python
-J('1 [dup 1 <<] G x x x x x x x x x')
+J('1 [dup 1 <<] G x x x x x x x x x pop')
```
- 1 2 4 8 16 32 64 128 256 [512 swap [dup 1 <<] direco]
+ 1 2 4 8 16 32 64 128 256
-# `n [x] times`
+### `[x] times`
If we have one of these quoted programs we can drive it using `times` with the `x` combinator.
-Let's define a word `n_range` that takes a starting integer and a count and leaves that many consecutive integers on the stack. For example:
-
```python
-J('23 [dup ++] G 5 [x] times pop')
+J('23 [dup ++] G 5 [x] times')
```
- 23 24 25 26 27
-
-
-We can use `dip` to untangle `[dup ++] G` from the arguments.
-
-
-```python
-J('23 5 [[dup ++] G] dip [x] times pop')
-```
-
- 23 24 25 26 27
-
-
-Now that the givens (arguments) are on the left we have the definition we're looking for:
-
-
-```python
-define('n_range == [[dup ++] G] dip [x] times pop')
-```
-
-
-```python
-J('450 10 n_range')
-```
-
- 450 451 452 453 454 455 456 457 458 459
-
-
-This is better just using the `times` combinator though...
-
-
-```python
-J('450 9 [dup ++] times')
-```
-
- 450 451 452 453 454 455 456 457 458 459
+ 23 24 25 26 27 [28 swap [dup ++] direco]
# Generating Multiples of Three and Five
@@ -273,14 +208,6 @@ J('14811 [PE1.1] G')
[14811 swap [PE1.1] direco]
-
-```python
-J('[14811 swap [PE1.1] direco] x')
-```
-
- 3 [3702 swap [PE1.1] direco]
-
-
...we get a generator that works for seven cycles before it reaches zero:
@@ -300,6 +227,14 @@ define('PE1.1.check == dup [pop 14811] [] branch')
```
+```python
+J('14811 [PE1.1.check PE1.1] G')
+```
+
+ [14811 swap [PE1.1.check PE1.1] direco]
+
+
+
```python
J('[14811 swap [PE1.1.check PE1.1] direco] 21 [x] times')
```
@@ -307,6 +242,8 @@ J('[14811 swap [PE1.1.check PE1.1] direco] 21 [x] times')
3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 [0 swap [PE1.1.check PE1.1] direco]
+(It would be more efficient to reset the int every seven cycles but that's a little beyond the scope of this article. This solution does extra work, but not much, and we're not using it "in production" as they say.)
+
### Run 466 times
In the PE1 problem we are asked to sum all the multiples of three and five less than 1000. It's worked out that we need to use all seven numbers sixty-six times and then four more.
@@ -322,15 +259,15 @@ If we drive our generator 466 times and sum the stack we get 999.
```python
-J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times')
+J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times')
```
- 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 [57 swap [PE1.1.check PE1.1] dip rest cons]
+ 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 [57 swap [PE1.1.check PE1.1] direco]
```python
-J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times pop enstacken sum')
+J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times pop enstacken sum')
```
999
@@ -343,17 +280,7 @@ J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times pop enstacken su
define('PE1.2 == + dup [+] dip')
```
-Now we can add `PE1.2` to the quoted program given to `times`.
-
-
-```python
-J('0 0 [0 swap [PE1.1.check PE1.1] direco] 466 [x [PE1.2] dip] times popop')
-```
-
- 233168
-
-
-Or using `G` we can write:
+Now we can add `PE1.2` to the quoted program given to `G`.
```python
@@ -401,24 +328,25 @@ And therefore:
[b+a b a F] [popdd over] infra
[b b+a b F]
-And lastly:
+But we can just use `cons` to carry `b+a` into the quote:
+
+ [b a F] b+a [popdd over] cons infra
+ [b a F] [b+a popdd over] infra
+ [b b+a b F]
+
+Lastly:
[b b+a b F] uncons
b [b+a b F]
-Done.
-
Putting it all together:
- F == + swons [popdd over] infra uncons
-
-And:
-
+ F == + [popdd over] cons infra uncons
fib_gen == [1 1 F]
```python
-define('fib == + swons [popdd over] infra uncons')
+define('fib == + [popdd over] cons infra uncons')
```
@@ -435,7 +363,8 @@ J('fib_gen 10 [x] times')
### Project Euler Problem Two
- By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms.
+ By considering the terms in the Fibonacci sequence whose values do not exceed four million,
+ find the sum of the even-valued terms.
Now that we have a generator for the Fibonacci sequence, we need a function that adds a term in the sequence to a sum if it is even, and `pop`s it otherwise.
@@ -536,3 +465,44 @@ J('0 [1 0 fib] PE2.2 [pop >4M] [popop] [[PE2.1] dip PE2.2] primrec')
# How to compile these?
You would probably start with a special version of `G`, and perhaps modifications to the default `x`?
+
+# An Interesting Variation
+
+
+```python
+define('codireco == cons dip rest cons')
+```
+
+
+```python
+V('[0 [dup ++] codireco] x')
+```
+
+ . [0 [dup ++] codireco] x
+ [0 [dup ++] codireco] . x
+ [0 [dup ++] codireco] . 0 [dup ++] codireco
+ [0 [dup ++] codireco] 0 . [dup ++] codireco
+ [0 [dup ++] codireco] 0 [dup ++] . codireco
+ [0 [dup ++] codireco] 0 [dup ++] . cons dip rest cons
+ [0 [dup ++] codireco] [0 dup ++] . dip rest cons
+ . 0 dup ++ [0 [dup ++] codireco] rest cons
+ 0 . dup ++ [0 [dup ++] codireco] rest cons
+ 0 0 . ++ [0 [dup ++] codireco] rest cons
+ 0 1 . [0 [dup ++] codireco] rest cons
+ 0 1 [0 [dup ++] codireco] . rest cons
+ 0 1 [[dup ++] codireco] . cons
+ 0 [1 [dup ++] codireco] .
+
+
+
+```python
+define('G == [codireco] cons cons')
+```
+
+
+```python
+J('230 [dup ++] G 5 [x] times pop')
+```
+
+ 230 231 232 233 234
+
diff --git a/docs/Generator Programs.rst b/docs/Generator Programs.rst
index f1b99a6..4ae0294 100644
--- a/docs/Generator Programs.rst
+++ b/docs/Generator Programs.rst
@@ -8,41 +8,49 @@ Cf. jp-reprod.html
from notebook_preamble import J, V, define
-Consider the ``x`` combinator ``x == dup i``:
+Consider the ``x`` combinator:
+
+::
+
+ x == dup i
+
+We can apply it to a quoted program consisting of some value ``a`` and a
+function ``B``:
::
[a B] x
[a B] a B
-Let ``B`` ``swap`` the ``a`` with the quote and run some function
-``[C]`` on it.
+Let ``B`` function ``swap`` the ``a`` with the quote and run some
+function ``C`` on it to generate a new value ``b``:
::
+ B == swap [C] dip
+
[a B] a B
[a B] a swap [C] dip
a [a B] [C] dip
a C [a B]
+ b [a B]
-Now discard the quoted ``a`` with ``rest`` and ``cons`` the result of
-``C`` on ``a`` whatever that is:
+Now discard the quoted ``a`` with ``rest`` then ``cons`` ``b``:
::
- aC [a B] rest cons
- aC [B] cons
- [aC B]
+ b [a B] rest cons
+ b [B] cons
+ [b B]
-Altogether, this is the definition of ``B``:
+Putting it together, this is the definition of ``B``:
::
B == swap [C] dip rest cons
-We can create a quoted program that generates the Natural numbers
-(integers 0, 1, 2, ...) by using ``0`` for ``a`` and ``[dup ++]`` for
-``[C]``:
+We can create a quoted program that generates the Natural numbers (0, 1,
+2, ...) by using ``0`` for ``a`` and ``[dup ++]`` for ``[C]``:
::
@@ -113,20 +121,17 @@ After one application of ``x`` the quoted program contains ``1`` and
0 [1 swap [dup ++] direco] .
-Generating Generators
-=====================
+Making Generators
+=================
-We want to go from:
+We want to define a function that accepts ``a`` and ``[C]`` and builds
+our quoted program:
::
- a [C] G
-
-to:
-
-::
-
- [a swap [C] direco]
+ a [C] G
+ -------------------------
+ [a swap [C] direco]
Working in reverse:
@@ -145,65 +150,30 @@ Reading from the bottom up:
G == [direco] cons [swap] swap concat cons
G == [direco] cons [swap] swoncat cons
-We can try it out:
-
-::
-
- 0 [dup ++] G
-
.. code:: ipython2
define('G == [direco] cons [swap] swoncat cons')
+Let's try it out:
+
.. code:: ipython2
- V('0 [dup ++] G')
+ J('0 [dup ++] G')
.. parsed-literal::
- . 0 [dup ++] G
- 0 . [dup ++] G
- 0 [dup ++] . G
- 0 [dup ++] . [direco] cons [swap] swoncat cons
- 0 [dup ++] [direco] . cons [swap] swoncat cons
- 0 [[dup ++] direco] . [swap] swoncat cons
- 0 [[dup ++] direco] [swap] . swoncat cons
- 0 [[dup ++] direco] [swap] . swap concat cons
- 0 [swap] [[dup ++] direco] . concat cons
- 0 [swap [dup ++] direco] . cons
- [0 swap [dup ++] direco] .
+ [0 swap [dup ++] direco]
.. code:: ipython2
- V('0 [dup ++] G x')
+ J('0 [dup ++] G x x x pop')
.. parsed-literal::
- . 0 [dup ++] G x
- 0 . [dup ++] G x
- 0 [dup ++] . G x
- 0 [dup ++] . [direco] cons [swap] swoncat cons x
- 0 [dup ++] [direco] . cons [swap] swoncat cons x
- 0 [[dup ++] direco] . [swap] swoncat cons x
- 0 [[dup ++] direco] [swap] . swoncat cons x
- 0 [[dup ++] direco] [swap] . swap concat cons x
- 0 [swap] [[dup ++] direco] . concat cons x
- 0 [swap [dup ++] direco] . cons x
- [0 swap [dup ++] direco] . x
- [0 swap [dup ++] direco] . 0 swap [dup ++] direco
- [0 swap [dup ++] direco] 0 . swap [dup ++] direco
- 0 [0 swap [dup ++] direco] . [dup ++] direco
- 0 [0 swap [dup ++] direco] [dup ++] . direco
- 0 [0 swap [dup ++] direco] [dup ++] . dip rest cons
- 0 . dup ++ [0 swap [dup ++] direco] rest cons
- 0 0 . ++ [0 swap [dup ++] direco] rest cons
- 0 1 . [0 swap [dup ++] direco] rest cons
- 0 1 [0 swap [dup ++] direco] . rest cons
- 0 1 [swap [dup ++] direco] . cons
- 0 [1 swap [dup ++] direco] .
+ 0 1 2
Powers of 2
@@ -211,73 +181,28 @@ Powers of 2
.. code:: ipython2
- J('1 [dup 1 <<] G x x x x x x x x x')
+ J('1 [dup 1 <<] G x x x x x x x x x pop')
.. parsed-literal::
- 1 2 4 8 16 32 64 128 256 [512 swap [dup 1 <<] direco]
+ 1 2 4 8 16 32 64 128 256
-``n [x] times``
-===============
+``[x] times``
+~~~~~~~~~~~~~
If we have one of these quoted programs we can drive it using ``times``
with the ``x`` combinator.
-Let's define a word ``n_range`` that takes a starting integer and a
-count and leaves that many consecutive integers on the stack. For
-example:
-
.. code:: ipython2
- J('23 [dup ++] G 5 [x] times pop')
+ J('23 [dup ++] G 5 [x] times')
.. parsed-literal::
- 23 24 25 26 27
-
-
-We can use ``dip`` to untangle ``[dup ++] G`` from the arguments.
-
-.. code:: ipython2
-
- J('23 5 [[dup ++] G] dip [x] times pop')
-
-
-.. parsed-literal::
-
- 23 24 25 26 27
-
-
-Now that the givens (arguments) are on the left we have the definition
-we're looking for:
-
-.. code:: ipython2
-
- define('n_range == [[dup ++] G] dip [x] times pop')
-
-.. code:: ipython2
-
- J('450 10 n_range')
-
-
-.. parsed-literal::
-
- 450 451 452 453 454 455 456 457 458 459
-
-
-This is better just using the ``times`` combinator though...
-
-.. code:: ipython2
-
- J('450 9 [dup ++] times')
-
-
-.. parsed-literal::
-
- 450 451 452 453 454 455 456 457 458 459
+ 23 24 25 26 27 [28 swap [dup ++] direco]
Generating Multiples of Three and Five
@@ -338,16 +263,6 @@ If we plug ``14811`` and ``[PE1.1]`` into our generator form...
[14811 swap [PE1.1] direco]
-.. code:: ipython2
-
- J('[14811 swap [PE1.1] direco] x')
-
-
-.. parsed-literal::
-
- 3 [3702 swap [PE1.1] direco]
-
-
...we get a generator that works for seven cycles before it reaches
zero:
@@ -371,6 +286,16 @@ if so.
define('PE1.1.check == dup [pop 14811] [] branch')
+.. code:: ipython2
+
+ J('14811 [PE1.1.check PE1.1] G')
+
+
+.. parsed-literal::
+
+ [14811 swap [PE1.1.check PE1.1] direco]
+
+
.. code:: ipython2
J('[14811 swap [PE1.1.check PE1.1] direco] 21 [x] times')
@@ -381,6 +306,11 @@ if so.
3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 [0 swap [PE1.1.check PE1.1] direco]
+(It would be more efficient to reset the int every seven cycles but
+that's a little beyond the scope of this article. This solution does
+extra work, but not much, and we're not using it "in production" as they
+say.)
+
Run 466 times
~~~~~~~~~~~~~
@@ -402,17 +332,17 @@ If we drive our generator 466 times and sum the stack we get 999.
.. code:: ipython2
- J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times')
+ J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times')
.. parsed-literal::
- 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 [57 swap [PE1.1.check PE1.1] dip rest cons]
+ 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 1 2 3 3 2 1 3 [57 swap [PE1.1.check PE1.1] direco]
.. code:: ipython2
- J('[14811 swap [PE1.1.check PE1.1] dip rest cons] 466 [x] times pop enstacken sum')
+ J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times pop enstacken sum')
.. parsed-literal::
@@ -427,19 +357,7 @@ Project Euler Problem One
define('PE1.2 == + dup [+] dip')
-Now we can add ``PE1.2`` to the quoted program given to ``times``.
-
-.. code:: ipython2
-
- J('0 0 [0 swap [PE1.1.check PE1.1] direco] 466 [x [PE1.2] dip] times popop')
-
-
-.. parsed-literal::
-
- 233168
-
-
-Or using ``G`` we can write:
+Now we can add ``PE1.2`` to the quoted program given to ``G``.
.. code:: ipython2
@@ -507,30 +425,31 @@ And therefore:
[b+a b a F] [popdd over] infra
[b b+a b F]
-And lastly:
+But we can just use ``cons`` to carry ``b+a`` into the quote:
+
+::
+
+ [b a F] b+a [popdd over] cons infra
+ [b a F] [b+a popdd over] infra
+ [b b+a b F]
+
+Lastly:
::
[b b+a b F] uncons
b [b+a b F]
-Done.
-
Putting it all together:
::
- F == + swons [popdd over] infra uncons
-
-And:
-
-::
-
+ F == + [popdd over] cons infra uncons
fib_gen == [1 1 F]
.. code:: ipython2
- define('fib == + swons [popdd over] infra uncons')
+ define('fib == + [popdd over] cons infra uncons')
.. code:: ipython2
@@ -551,7 +470,8 @@ Project Euler Problem Two
::
- By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms.
+ By considering the terms in the Fibonacci sequence whose values do not exceed four million,
+ find the sum of the even-valued terms.
Now that we have a generator for the Fibonacci sequence, we need a
function that adds a term in the sequence to a sum if it is even, and
@@ -673,3 +593,47 @@ How to compile these?
You would probably start with a special version of ``G``, and perhaps
modifications to the default ``x``?
+
+An Interesting Variation
+========================
+
+.. code:: ipython2
+
+ define('codireco == cons dip rest cons')
+
+.. code:: ipython2
+
+ V('[0 [dup ++] codireco] x')
+
+
+.. parsed-literal::
+
+ . [0 [dup ++] codireco] x
+ [0 [dup ++] codireco] . x
+ [0 [dup ++] codireco] . 0 [dup ++] codireco
+ [0 [dup ++] codireco] 0 . [dup ++] codireco
+ [0 [dup ++] codireco] 0 [dup ++] . codireco
+ [0 [dup ++] codireco] 0 [dup ++] . cons dip rest cons
+ [0 [dup ++] codireco] [0 dup ++] . dip rest cons
+ . 0 dup ++ [0 [dup ++] codireco] rest cons
+ 0 . dup ++ [0 [dup ++] codireco] rest cons
+ 0 0 . ++ [0 [dup ++] codireco] rest cons
+ 0 1 . [0 [dup ++] codireco] rest cons
+ 0 1 [0 [dup ++] codireco] . rest cons
+ 0 1 [[dup ++] codireco] . cons
+ 0 [1 [dup ++] codireco] .
+
+
+.. code:: ipython2
+
+ define('G == [codireco] cons cons')
+
+.. code:: ipython2
+
+ J('230 [dup ++] G 5 [x] times pop')
+
+
+.. parsed-literal::
+
+ 230 231 232 233 234
+
diff --git a/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.html b/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.html
index 64b9dba..ff494b5 100644
--- a/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.html
+++ b/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.html
@@ -13729,7 +13729,7 @@ tails == [] [not] [rest swons] [rest] paramorphism
A predicate P :: A -> Bool to detect the base case
A base case value c :: B
-Hylo- Ana-, Cata-¶
+Hylo-, Ana-, Cata-¶
w/ G :: A -> (A, B)
H == [P ] [pop c ] [G ] [dip F ] genrec
@@ -13854,7 +13854,7 @@ H == c swap [P] [pop] [ [F] dupdip G] [i] genrec
-4¶
And, last but not least, if you can combine as you go, starting with c, and the combiner needs to work on the current item this is the form:
+4¶
And, last but not least, if you can combine as you go, starting with c, and the combiner needs to work on the current item, this is the form:
W == c swap [P] [pop] [[F] dupdip G] primrec
diff --git a/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.md b/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.md
index c3550cd..dfb43dc 100644
--- a/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.md
+++ b/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.md
@@ -1432,7 +1432,7 @@ Our story so far...
- A base case value `c :: B`
-### Hylo- Ana-, Cata-
+### Hylo-, Ana-, Cata-
w/ G :: A -> (A, B)
@@ -1526,7 +1526,7 @@ If the combiner and the generator both need to work on the current value then `d
... c a'' F a' F a F
### 4
-And, last but not least, if you can combine as you go, starting with c, and the combiner needs to work on the current item this is the form:
+And, last but not least, if you can combine as you go, starting with c, and the combiner needs to work on the current item, this is the form:
W == c swap [P] [pop] [[F] dupdip G] primrec
diff --git a/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.rst b/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.rst
index 0fc09f4..14cbbb7 100644
--- a/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.rst
+++ b/docs/Hylo-, Ana-, Cata-, and Para-morphisms - Recursion Combinators.rst
@@ -1571,8 +1571,8 @@ Our story so far...
- A predicate ``P :: A -> Bool`` to detect the base case
- A base case value ``c :: B``
-Hylo- Ana-, Cata-
-~~~~~~~~~~~~~~~~~
+Hylo-, Ana-, Cata-
+~~~~~~~~~~~~~~~~~~
::
@@ -1706,7 +1706,7 @@ one item instead of two (the b is instead the duplicate of a.)
~
And, last but not least, if you can combine as you go, starting with c,
-and the combiner needs to work on the current item this is the form:
+and the combiner needs to work on the current item, this is the form:
::
diff --git a/docs/Ordered_Binary_Trees.html b/docs/Ordered_Binary_Trees.html
new file mode 100644
index 0000000..221b317
--- /dev/null
+++ b/docs/Ordered_Binary_Trees.html
@@ -0,0 +1,14553 @@
+
+
+
+Ordered_Binary_Trees
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Treating Trees I¶
Although any expression in Joy can be considered to describe a tree with the quotes as compound nodes and the non-quote values as leaf nodes, in this page I want to talk about ordered binary trees and how to make and use them.
+The basic structure, in a crude type notation, is:
+
+Tree :: [] | [key value Tree Tree]
+
+
+That says that a Tree is either the empty quote [] or a quote with four items: a key, a value, and two Trees representing the left and right branches of the tree.
+
+
+
+
+
+
+
+
+We're going to derive some recursive functions to work with such datastructures:
+
+Tree-add
+Tree-delete
+Tree-get
+Tree-iter
+Tree-iter-order
+
+
+Once these functions are defined we have a new "type" to work with, and the Sufficiently Smart Compiler can be modified to use an optimized implementation under the hood. (Where does the "type" come from? It has a contingent existence predicated on the disciplined use of these functions on otherwise undistinguished Joy datastructures.)
+
+
+
+
+
+
+In [1]:
+
+
+from notebook_preamble import D, J, V, define, DefinitionWrapper
+
+
+
+
+
+
+
+
+
+
+
+Adding Nodes to the Tree¶
Let's consider adding nodes to a Tree structure.
+
+ Tree value key Tree-add
+-----------------------------
+ Tree′
+
+
+
+
+
+
+
+
+Adding to an empty node.¶
If the current node is [] then you just return [key value [] []]:
+
+Tree-add == [popop not] [[pop] dipd Tree-new] [R0] [R1] genrec
+
+
+Tree-new¶
Where Tree-new is defined as:
+
+ value key Tree-new
+------------------------
+ [key value [] []]
+
+
+Example:
+
+value key swap [[] []] cons cons
+key value [[] []] cons cons
+key [value [] []] cons
+ [key value [] []]
+
+
+Definition:
+
+Tree-new == swap [[] []] cons cons
+
+
+
+
+
+
+In [2]:
+
+
+define('Tree-new == swap [[] []] cons cons')
+
+
+
+
+
+
+
+
+
+In [3]:
+
+
+J('"v" "k" Tree-new')
+
+
+
+
+
+
+
+
+
+
+
+(As an implementation detail, the [[] []] literal used in the definition of Tree-new will be reused to supply the constant tail for all new nodes produced by it. This is one of those cases where you get amortized storage "for free" by using persistent datastructures. Because the tail, which is ((), ((), ())) in Python, is immutable and embedded in the definition body for Tree-new, all new nodes can reuse it as their own tail without fear that some other code somewhere will change it.)
+
+
+
+
+
+
+
+
+Adding to a non-empty node.¶
We now have to derive R0 and R1, consider:
+
+[key_n value_n left right] value key R0 [Tree-add] R1
+
+
+In this case, there are three possibilites: the key can be greater or less than or equal to the node's key. In two of those cases we will need to apply a copy of Tree-add, so R0 is pretty much out of the picture.
+
+[R0] == []
+
+
+
+
+
+
+
+
+A predicate to compare keys.¶
+[key_n value_n left right] value key [BTree-add] R1
+
+
+The first thing we need to do is compare the the key we're adding to the node key and branch accordingly:
+
+[key_n value_n left right] value key [BTree-add] [P] [T] [E] ifte
+
+
+That would suggest something like:
+
+[key_n value_n left right] value key [BTree-add] P
+[key_n value_n left right] value key [BTree-add] pop roll> pop first >
+[key_n value_n left right] value key roll> pop first >
+key [key_n value_n left right] value roll> pop first >
+key key_n >
+Boolean
+
+
+Let's abstract the predicate just a little to let us specify the comparison operator:
+
+P > == pop roll> pop first >
+P < == pop roll> pop first <
+P == pop roll> pop first
+
+
+
+
+
+
+In [4]:
+
+
+define('P == pop roll> pop first')
+
+
+
+
+
+
+
+
+
+In [5]:
+
+
+J('["old_key" 23 [] []] 17 "new_key" ["..."] P')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+If the key we're adding is greater than the node's key.¶
Here the parentheses are meant to signify that the expression is not literal, the code in the parentheses is meant to have been evaluated:
+
+ [key_n value_n left right] value key [Tree-add] T
+-------------------------------------------------------
+ [key_n value_n left (Tree-add key value right)]
+
+
+
+
+
+
+
+
+So how do we do this? We're going to want to use infra on some function K that has the key and value to work with, as well as the quoted copy of Tree-add to apply somehow. Considering the node as a stack:
+
+ right left value_n key_n value key [Tree-add] K
+-----------------------------------------------------
+ right value key Tree-add left value_n key_n
+
+
+Pretty easy:
+
+right left value_n key_n value key [Tree-add] cons cons dipdd
+right left value_n key_n [value key Tree-add] dipdd
+right value key Tree-add left value_n key_n
+
+
+So:
+
+K == cons cons dipdd
+
+
+Looking at it from the point-of-view of the node as node again:
+
+[key_n value_n left right] [value key [Tree-add] K] infra
+
+
+Expand K and evaluate a little:
+
+[key_n value_n left right] [value key [Tree-add] K] infra
+[key_n value_n left right] [value key [Tree-add] cons cons dipdd] infra
+[key_n value_n left right] [[value key Tree-add] dipdd] infra
+
+
+Then, working backwards:
+
+[key_n value_n left right] [[value key Tree-add] dipdd] infra
+[key_n value_n left right] [value key Tree-add] [dipdd] cons infra
+[key_n value_n left right] value key [Tree-add] cons cons [dipdd] cons infra
+
+
+
+
+
+
+
+
+And so T is just:
+
+T == cons cons [dipdd] cons infra
+
+
+
+
+
+
+In [6]:
+
+
+define('T == cons cons [dipdd] cons infra')
+
+
+
+
+
+
+
+
+
+In [7]:
+
+
+J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] T')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+If the key we're adding is less than the node's key.¶
This is very very similar to the above:
+
+[key_n value_n left right] value key [Tree-add] E
+[key_n value_n left right] value key [Tree-add] [P <] [Te] [Ee] ifte
+
+
+
+
+
+
+In [8]:
+
+
+define('E == [P <] [Te] [Ee] ifte')
+
+
+
+
+
+
+
+
+
+
+
+In this case Te works that same as T but on the left child tree instead of the right, so the only difference is that it must use dipd instead of dipdd:
+
+Te == cons cons [dipd] cons infra
+
+
+
+
+
+
+In [9]:
+
+
+define('Te == cons cons [dipd] cons infra')
+
+
+
+
+
+
+
+
+
+In [10]:
+
+
+J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] Te')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Else the keys must be equal.¶
This means we must find:
+
+ [key old_value left right] new_value key [Tree-add] Ee
+------------------------------------------------------------
+ [key new_value left right]
+
+
+
+
+
+
+
+
+This is another easy one:
+
+Ee == pop swap roll< rest rest cons cons
+
+
+
+
+
+
+
+
+Example:
+
+[key old_value left right] new_value key [Tree-add] pop swap roll< rest rest cons cons
+[key old_value left right] new_value key swap roll< rest rest cons cons
+[key old_value left right] key new_value roll< rest rest cons cons
+key new_value [key old_value left right] rest rest cons cons
+key new_value [ left right] cons cons
+ [key new_value left right]
+
+
+
+
+
+
+In [11]:
+
+
+define('Ee == pop swap roll< rest rest cons cons')
+
+
+
+
+
+
+
+
+
+In [12]:
+
+
+J('["k" "old_value" "left" "right"] "new_value" "k" ["Tree-add"] Ee')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Now we can define Tree-add¶
+Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec
+
+
+Putting it all together:
+
+Tree-new == swap [[] []] cons cons
+P == pop roll> pop first
+T == cons cons [dipdd] cons infra
+Te == cons cons [dipd] cons infra
+Ee == pop swap roll< rest rest cons cons
+E == [P <] [Te] [Ee] ifte
+R == [P >] [T] [E] ifte
+
+Tree-add == [popop not] [[pop] dipd Tree-new] [] [R] genrec
+
+
+
+
+
+
+In [13]:
+
+
+define('Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec')
+
+
+
+
+
+
+
+
+
+
+
+Examples¶
+
+
+
+
+
+In [14]:
+
+
+J('[] 23 "b" Tree-add') # Initial
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [15]:
+
+
+J('["b" 23 [] []] 88 "c" Tree-add') # Greater than
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [16]:
+
+
+J('["b" 23 [] []] 88 "a" Tree-add') # Less than
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [17]:
+
+
+J('["b" 23 [] []] 88 "b" Tree-add') # Equal to
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [18]:
+
+
+J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Series.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [19]:
+
+
+J('[] [[23 "b"] [88 "a"] [44 "c"]] [i Tree-add] step')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Interlude: cmp combinator¶
Instead of mucking about with nested ifte combinators let's just go whole hog and define cmp which takes two values and three quoted programs on the stack and runs one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+------------------------- a < b
+ L
+
+
+
+
+
+
+In [20]:
+
+
+from joy.library import FunctionWrapper
+from joy.utils.stack import pushback
+from notebook_preamble import D
+
+
+@FunctionWrapper
+def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
+ L, (E, (G, (b, (a, stack)))) = stack
+ expression = pushback(G if a > b else L if a < b else E, expression)
+ return stack, expression, dictionary
+
+
+D['cmp'] = cmp_
+
+
+
+
+
+
+
+
+
+In [21]:
+
+
+J("1 0 ['G'] ['E'] ['L'] cmp")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [22]:
+
+
+J("1 1 ['G'] ['E'] ['L'] cmp")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [23]:
+
+
+J("0 1 ['G'] ['E'] ['L'] cmp")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Redefine Tree-add¶
We need a new non-destructive predicate P:
+
+ [node_key node_value left right] value key [Tree-add] P
+------------------------------------------------------------------------
+ [node_key node_value left right] value key [Tree-add] key node_key
+
+
+
+
+
+
+
+
+Let's start with over to get a copy of the key and then apply some function Q with the nullary combinator so it can dig out the node key (by throwing everything else away):
+
+P == over [Q] nullary
+
+[node_key node_value left right] value key [Tree-add] over [Q] nullary
+[node_key node_value left right] value key [Tree-add] key [Q] nullary
+
+
+
+
+
+
+
+
+And Q would be:
+
+Q == popop popop first
+
+[node_key node_value left right] value key [Tree-add] key Q
+[node_key node_value left right] value key [Tree-add] key popop popop first
+[node_key node_value left right] value key popop first
+[node_key node_value left right] first
+ node_key
+
+
+
+
+
+
+
+
+Or just:
+
+P == over [popop popop first] nullary
+
+
+
+
+
+
+In [24]:
+
+
+define('P == over [popop popop first] nullary')
+
+
+
+
+
+
+
+
+
+
+
+Using cmp to simplify our code above at R1:
+
+[node_key node_value left right] value key [Tree-add] R1
+[node_key node_value left right] value key [Tree-add] P [T] [E] [Te] cmp
+
+
+
+
+
+
+
+
+The line above becomes one of the three lines below:
+
+[node_key node_value left right] value key [Tree-add] T
+[node_key node_value left right] value key [Tree-add] E
+[node_key node_value left right] value key [Tree-add] Te
+
+
+
+
+
+
+
+
+The definition is a little longer but, I think, more elegant and easier to understand:
+
+Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec
+
+
+
+
+
+
+In [25]:
+
+
+define('Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec')
+
+
+
+
+
+
+
+
+
+In [26]:
+
+
+J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Still works.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+A Function to Traverse this Structure¶
Let's take a crack at writing a function that can recursively iterate or traverse these trees.
+
+
+
+
+
+
+
+
+Base case []¶
The stopping predicate just has to detect the empty list:
+
+Tree-iter == [not] [E] [R0] [R1] genrec
+
+
+And since there's nothing at this node, we just pop it:
+
+Tree-iter == [not] [pop] [R0] [R1] genrec
+
+
+
+
+
+
+
+
+Node case [key value left right]¶
Now we need to figure out R0 and R1:
+
+Tree-iter == [not] [pop] [R0] [R1] genrec
+ == [not] [pop] [R0 [Tree-iter] R1] ifte
+
+
+Let's look at it in situ:
+
+[key value left right] R0 [Tree-iter] R1
+
+
+
+
+
+
+
+
+Processing the current node.¶
R0 is almost certainly going to use dup to make a copy of the node and then dip on some function to process the copy with it:
+
+[key value left right] [F] dupdip [Tree-iter] R1
+[key value left right] F [key value left right] [Tree-iter] R1
+
+
+For example, if we're getting all the keys F would be first:
+
+R0 == [first] dupdip
+
+[key value left right] [first] dupdip [Tree-iter] R1
+[key value left right] first [key value left right] [Tree-iter] R1
+key [key value left right] [Tree-iter] R1
+
+
+
+
+
+
+
+
+Recur¶
Now R1 needs to apply [Tree-iter] to left and right. If we drop the key and value from the node using rest twice we are left with an interesting situation:
+
+key [key value left right] [Tree-iter] R1
+key [key value left right] [Tree-iter] [rest rest] dip
+key [key value left right] rest rest [Tree-iter]
+key [left right] [Tree-iter]
+
+
+Hmm, will step do?
+
+key [left right] [Tree-iter] step
+key left Tree-iter [right] [Tree-iter] step
+key left-keys [right] [Tree-iter] step
+key left-keys right Tree-iter
+key left-keys right-keys
+
+
+Neat. So:
+
+R1 == [rest rest] dip step
+
+
+
+
+
+
+
+
+Putting it together¶
We have:
+
+Tree-iter == [not] [pop] [[F] dupdip] [[rest rest] dip step] genrec
+
+
+When I was reading this over I realized rest rest could go in R0:
+
+Tree-iter == [not] [pop] [[F] dupdip rest rest] [step] genrec
+
+
+(And [step] genrec is such a cool and suggestive combinator!)
+
+
+
+
+
+
+
+
+Parameterizing the F per-node processing function.¶
+ [F] Tree-iter
+------------------------------------------------------
+ [not] [pop] [[F] dupdip rest rest] [step] genrec
+
+
+Working backward:
+
+[not] [pop] [[F] dupdip rest rest] [step] genrec
+[not] [pop] [F] [dupdip rest rest] cons [step] genrec
+[F] [not] [pop] roll< [dupdip rest rest] cons [step] genrec
+
+
+
+
+
+
+
+
+Tree-iter¶
+Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec
+
+
+
+
+
+
+In [27]:
+
+
+define('Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec')
+
+
+
+
+
+
+
+
+
+
+
+Examples¶
+
+
+
+
+
+In [28]:
+
+
+J('[] [foo] Tree-iter') # It doesn't matter what F is as it won't be used.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [29]:
+
+
+J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [first] Tree-iter")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [30]:
+
+
+J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [second] Tree-iter")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Interlude: A Set-like Datastructure¶
We can use this to make a set-like datastructure by just setting values to e.g. 0 and ignoring them. It's set-like in that duplicate items added to it will only occur once within it, and we can query it in $O(\log_2 N)$ time.
+
+
+
+
+
+
+In [31]:
+
+
+J('[] [3 9 5 2 8 6 7 8 4] [0 swap Tree-add] step')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [32]:
+
+
+define('to_set == [] swap [0 swap Tree-add] step')
+
+
+
+
+
+
+
+
+
+In [33]:
+
+
+J('[3 9 5 2 8 6 7 8 4] to_set')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+And with that we can write a little program unique to remove duplicate items from a list.
+
+
+
+
+
+
+In [34]:
+
+
+define('unique == [to_set [first] Tree-iter] cons run')
+
+
+
+
+
+
+
+
+
+In [35]:
+
+
+J('[3 9 3 5 2 9 8 8 8 6 2 7 8 4 3] unique') # Filter duplicate items.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+A Version of Tree-iter that does In-Order Traversal¶
+
+
+
+
+
+
+
+If you look back to the non-empty case of the Tree-iter function we can design a variant that first processes the left child, then the current node, then the right child. This will allow us to traverse the tree in sort order.
+
+Tree-iter-order == [not] [pop] [R0] [R1] genrec
+
+
+To define R0 and R1 it helps to look at them as they will appear when they run:
+
+[key value left right] R0 [BTree-iter-order] R1
+
+
+
+
+
+
+
+
+Process the left child.¶
Staring at this for a bit suggests dup third to start:
+
+[key value left right] R0 [Tree-iter-order] R1
+[key value left right] dup third [Tree-iter-order] R1
+[key value left right] left [Tree-iter-order] R1
+
+
+
+
+
+
+
+
+Now maybe:
+
+[key value left right] left [Tree-iter-order] [cons dip] dupdip
+[key value left right] left [Tree-iter-order] cons dip [Tree-iter-order]
+[key value left right] [left Tree-iter-order] dip [Tree-iter-order]
+left Tree-iter-order [key value left right] [Tree-iter-order]
+
+
+
+
+
+
+
+
+Process the current node.¶
So far, so good. Now we need to process the current node's values:
+
+left Tree-iter-order [key value left right] [Tree-iter-order] [[F] dupdip] dip
+left Tree-iter-order [key value left right] [F] dupdip [Tree-iter-order]
+left Tree-iter-order [key value left right] F [key value left right] [Tree-iter-order]
+
+
+If F needs items from the stack below the left stuff it should have cons'd them before beginning maybe? For functions like first it works fine as-is.
+
+left Tree-iter-order [key value left right] first [key value left right] [Tree-iter-order]
+left Tree-iter-order key [key value left right] [Tree-iter-order]
+
+
+
+
+
+
+
+
+Process the right child.¶
First ditch the rest of the node and get the right child:
+
+left Tree-iter-order key [key value left right] [Tree-iter-order] [rest rest rest first] dip
+left Tree-iter-order key right [Tree-iter-order]
+
+
+Then, of course, we just need i to run Tree-iter-order on the right side:
+
+left Tree-iter-order key right [Tree-iter-order] i
+left Tree-iter-order key right Tree-iter-order
+
+
+
+
+
+
+
+
+Defining Tree-iter-order¶
The result is a little awkward:
+
+R1 == [cons dip] dupdip [[F] dupdip] dip [rest rest rest first] dip i
+
+
+Let's do a little semantic factoring:
+
+fourth == rest rest rest first
+
+proc_left == [cons dip] dupdip
+proc_current == [[F] dupdip] dip
+proc_right == [fourth] dip i
+
+Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
+
+
+Now we can sort sequences.
+
+
+
+
+
+
+In [36]:
+
+
+#define('Tree-iter-order == [not] [pop] [dup third] [[cons dip] dupdip [[first] dupdip] dip [rest rest rest first] dip i] genrec')
+
+
+DefinitionWrapper.add_definitions('''
+
+fourth == rest rest rest first
+
+proc_left == [cons dip] dupdip
+proc_current == [[first] dupdip] dip
+proc_right == [fourth] dip i
+
+Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
+
+''', D)
+
+
+
+
+
+
+
+
+
+In [37]:
+
+
+J('[3 9 5 2 8 6 7 8 4] to_set Tree-iter-order')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Parameterizing the [F] function is left as an exercise for the reader (for now.)
+
+
+
+
+
+
+
+
+Getting values by key¶
Let's derive a function that accepts a tree and a key and returns the value associated with that key.
+
+ tree key Tree-get
+-----------------------
+ value
+
+
+But what do we do if the key isn't in the tree? In Python we might raise a KeyError but I'd like to avoid exceptions in Joy if possible, and here I think it's possible. (Division by zero is an example of where I think it's probably better to let Python crash Joy. Sometimes the machinery fails and you have to "stop the line", I think.)
+Let's pass the buck to the caller by making the base case a given, you have to decide for yourself what [E] should be.
+
+ tree key [E] Tree-get
+---------------------------- key in tree
+ value
+
+ tree key [E] Tree-get
+---------------------------- key not in tree
+ [] key E
+
+
+
+
+
+
+
+
+The base case []¶
As before, the stopping predicate just has to detect the empty list:
+
+Tree-get == [pop not] [E] [R0] [R1] genrec
+
+
+So we define:
+
+Tree-get == [pop not] swap [R0] [R1] genrec
+
+
+Note that this Tree-get creates a slightly different function than itself and that function does the actual recursion. This kind of higher-level programming is unusual in most languages but natural in Joy.
+
+tree key [E] [pop not] swap [R0] [R1] genrec
+tree key [pop not] [E] [R0] [R1] genrec
+
+
+The anonymous specialized recursive function that will do the real work.
+
+[pop not] [E] [R0] [R1] genrec
+
+
+
+
+
+
+
+
+Node case [key value left right]¶
Now we need to figure out R0 and R1:
+
+[key value left right] key R0 [BTree-get] R1
+
+
+We want to compare the search key with the key in the node, and if they are the same return the value, otherwise recur on one of the child nodes. So it's very similar to the above funtion, with [R0] == [] and R1 == P [T>] [E] [T<] cmp:
+
+[key value left right] key [BTree-get] P [T>] [E] [T<] cmp
+
+
+
+
+
+
+
+
+Predicate:¶
+P == over [get-node-key] nullary
+get-node-key == pop popop first
+
+
+The only difference is that get-node-key does one less pop because there's no value to discard.
+
+
+
+
+
+
+
+
+Branches¶
Now we have to derive the branches:
+
+[key_n value_n left right] key [BTree-get] T>
+[key_n value_n left right] key [BTree-get] E
+[key_n value_n left right] key [BTree-get] T<
+
+
+
+
+
+
+
+
+Greater than and less than¶
The cases of T> and T< are similar to above but instead of using infra we have to discard the rest of the structure:
+
+ [key_n value_n left right] key [BTree-get] T>
+---------------------------------------------------
+ right key BTree-get
+
+
+And:
+
+ [key_n value_n left right] key [BTree-get] T<
+---------------------------------------------------
+ left key BTree-get
+
+
+So:
+
+T> == [fourth] dipd i
+T< == [third] dipd i
+
+
+E.g.:
+
+[key_n value_n left right] key [BTree-get] [fourth] dipd i
+[key_n value_n left right] fourth key [BTree-get] i
+ right key [BTree-get] i
+ right key BTree-get
+
+
+
+
+
+
+
+
+Equal keys¶
Return the node's value:
+
+[key_n value_n left right] key [BTree-get] E == value_n
+
+E == popop second
+
+
+
+
+
+
+
+
+Tree-get¶
So:
+
+fourth == rest rest rest first
+get-node-key == pop popop first
+P == over [get-node-key] nullary
+T> == [fourth] dipd i
+T< == [third] dipd i
+E == popop second
+
+Tree-get == [pop not] swap [] [P [T>] [E] [T<] cmp] genrec
+
+
+
+
+
+
+In [38]:
+
+
+# I don't want to deal with name conflicts with the above so I'm inlining everything here.
+# The original Joy system has "hide" which is a meta-command which allows you to use named
+# definitions that are only in scope for a given definition. I don't want to implement
+# that (yet) so...
+
+
+define('''
+Tree-get == [pop not] swap [] [
+ over [pop popop first] nullary
+ [[fourth] dipd i]
+ [popop second]
+ [[third] dipd i]
+ cmp
+ ] genrec
+''')
+
+
+
+
+
+
+
+
+
+In [39]:
+
+
+J('["gary" 23 [] []] "mike" [popd " not in tree" +] Tree-get')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [40]:
+
+
+J('["gary" 23 [] []] "gary" [popop "err"] Tree-get')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [41]:
+
+
+J('''
+
+ [] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
+
+ 'c' [popop 'not found'] Tree-get
+
+''')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [52]:
+
+
+J('''
+
+ [] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
+
+ 'd' [popop 'not found'] Tree-get
+
+''')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Tree-delete¶
Now let's write a function that can return a tree datastructure with a key, value pair deleted:
+
+ tree key Tree-delete
+---------------------------
+ tree
+
+
+If the key is not in tree it just returns the tree unchanged.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Recur¶
Now we get to figure out the recursive case. We need the node's key to compare and we need to carry the key into recursive branches. Let D be shorthand for Tree-Delete:
+
+D == Tree-Delete == [pop not] [pop] [R0] [R1] genrec
+
+[node_key node_value left right] key R0 [D] R1
+[node_key node_value left right] key over first swap dup [D] cons R1′
+[node_key node_value left right] key [...] first swap dup [D] cons R1′
+[node_key node_value left right] key node_key swap dup [D] cons R1′
+[node_key node_value left right] node_key key dup [D] cons R1′
+[node_key node_value left right] node_key key key [D] cons R1′
+[node_key node_value left right] node_key key [key D] R1′
+
+
+
+
+
+
+
+
+And then:
+
+[node_key node_value left right] node_key key [key D] R1′
+[node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+[node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+[node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+
+
+
+
+
+
+
+So:
+
+R0 == over first swap dup
+R1 == cons roll> [T>] [E] [T<] cmp
+
+
+
+
+
+
+
+
+Compare Keys¶
The last line above:
+
+[node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+
+Then becomes one of these three:
+
+[node_key node_value left right] [key D] T>
+[node_key node_value left right] [key D] E
+[node_key node_value left right] [key D] T<
+
+
+
+
+
+
+
+
+Greater than case and less than case¶
+ [node_key node_value left right] [F] T>
+-------------------------------------------------
+ [node_key node_value (left F) right]
+
+
+ [node_key node_value left right] [F] T<
+-------------------------------------------------
+ [node_key node_value left (right F)]
+
+
+
+
+
+
+
+
+First, treating the node as a stack:
+
+right left node_value node_key [key D] dipd
+right left key D node_value node_key
+right left' node_value node_key
+
+
+
+
+
+
+
+
+Ergo:
+
+[node_key node_value left right] [key D] [dipd] cons infra
+
+
+
+
+
+
+
+
+So:
+
+T> == [dipd] cons infra
+T< == [dipdd] cons infra
+
+
+
+
+
+
+
+
+The else case¶
We have found the node in the tree where key equals node_key. We need to replace the current node with something
+
+ [node_key node_value left right] [key D] E
+------------------------------------------------
+ tree
+
+
+We have to handle three cases, so let's use cond.
+
+
+
+
+
+
+In [42]:
+
+
+from joy.library import FunctionWrapper, S_ifte
+
+
+@FunctionWrapper
+def cond(stack, expression, dictionary):
+ '''
+ like a case statement; works by rewriting into a chain of ifte.
+
+ [..[[Bi] Ti]..[D]] -> ...
+
+
+ [[[B0] T0] [[B1] T1] [D]] cond
+ -----------------------------------------
+ [B0] [T0] [[B1] [T1] [D] ifte] ifte
+
+ '''
+ conditions, stack = stack
+ if conditions:
+ expression = _cond(conditions, expression)
+ try:
+ # Attempt to preload the args to first ifte.
+ (P, (T, (E, expression))) = expression
+ except ValueError:
+ # If, for any reason, the argument to cond should happen to contain
+ # only the default clause then this optimization will fail.
+ pass
+ else:
+ stack = (E, (T, (P, stack)))
+ return stack, expression, dictionary
+
+
+def _cond(conditions, expression):
+ (clause, rest) = conditions
+ if not rest: # clause is [D]
+ return clause
+ P, T = clause
+ return (P, (T, (_cond(rest, ()), (S_ifte, expression))))
+
+
+
+D['cond'] = cond
+
+
+
+
+
+
+
+
+
+
+
+One or more child nodes are []¶
The first two cases are symmetrical: if we only have one non-empty child node return it. If both child nodes are empty return an empty node.
+
+E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [default]
+] cond
+
+
+
+
+
+
+
+
+Both child nodes are non-empty.¶
If both child nodes are non-empty, we find the highest node in our lower sub-tree, take its key and value to replace (delete) our own, then get rid of it by recursively calling delete() on our lower sub-node with our new key.
+(We could also find the lowest node in our higher sub-tree and take its key and value and delete it. I only implemented one of these two symmetrical options. Over a lot of deletions this might make the tree more unbalanced. Oh well.)
+
+
+
+
+
+
+
+
+The initial structure of the default function:
+
+default == [E′] cons infra
+
+[node_key node_value left right] [key D] default
+[node_key node_value left right] [key D] [E′] cons infra
+[node_key node_value left right] [[key D] E′] infra
+
+right left node_value node_key [key D] E′
+
+
+
+
+
+
+
+
+First things first, we no longer need this node's key and value:
+
+right left node_value node_key [key D] roll> popop E″
+right left [key D] node_value node_key popop E″
+right left [key D] E″
+
+
+
+
+
+
+
+
+We have to we find the highest (right-most) node in our lower (left) sub-tree:¶
+right left [key D] E″
+
+
+
+
+
+
+
+
+Ditch the key:
+
+right left [key D] rest E‴
+right left [D] E‴
+
+
+
+
+
+
+
+
+Find the right-most node:
+
+right left [D] [dup W] dip E⁗
+right left dup W [D] E⁗
+right left left W [D] E⁗
+
+
+
+
+
+
+
+
+Consider:
+
+left W
+
+
+
+
+
+
+
+
+We know left is not empty:
+
+[L_key L_value L_left L_right] W
+
+
+
+
+
+
+
+
+We want to keep extracting the right node as long as it is not empty:
+
+W.rightmost == [P] [B] while
+
+left W.rightmost W′
+
+
+
+
+
+
+
+
+The predicate:
+
+[L_key L_value L_left L_right] P
+[L_key L_value L_left L_right] fourth
+ L_right
+
+
+This can run on [] so must be guarded:
+
+?fourth == [] [fourth] [] ifte
+
+
+
+
+
+
+
+
+(
+ if_not_empty == [] swap [] ifte
+ ?fourth == [fourth] if_not_empty
+)
+
+
+
+
+
+
+
+
+The body is just fourth:
+
+left [?fourth] [fourth] while W′
+rightest W′
+
+
+
+
+
+
+
+
+So:
+
+W.rightmost == [?fourth] [fourth] while
+
+
+
+
+
+
+
+
+Found right-most node in our left sub-tree¶
We know rightest is not empty:
+
+[R_key R_value R_left R_right] W′
+[R_key R_value R_left R_right] W′
+[R_key R_value R_left R_right] uncons uncons pop
+R_key [R_value R_left R_right] uncons pop
+R_key R_value [R_left R_right] pop
+R_key R_value
+
+
+
+
+
+
+
+
+So:
+
+W == [?fourth] [fourth] while uncons uncons pop
+
+
+
+
+
+
+
+
+And:
+
+right left left W [D] E⁗
+right left R_key R_value [D] E⁗
+
+
+
+
+
+
+
+
+Replace current node key and value, recursively delete rightmost¶
Final stretch. We want to end up with something like:
+
+right left [R_key D] i R_value R_key
+right left R_key D R_value R_key
+right left′ R_value R_key
+
+
+
+
+
+
+
+
+If we adjust our definition of W to include over at the end:
+
+W == [fourth] [fourth] while uncons uncons pop over
+
+
+
+
+
+
+
+
+That will give us:
+
+right left R_key R_value R_key [D] E⁗
+
+right left R_key R_value R_key [D] cons dipd E⁗′
+right left R_key R_value [R_key D] dipd E⁗′
+right left R_key D R_key R_value E⁗′
+right left′ R_key R_value E⁗′
+right left′ R_key R_value swap
+right left′ R_value R_key
+
+
+
+
+
+
+
+
+So:
+
+E′ == roll> popop E″
+
+E″ == rest E‴
+
+E‴ == [dup W] dip E⁗
+
+E⁗ == cons dipdd swap
+
+
+
+
+
+
+
+
+Substituting:
+
+W == [fourth] [fourth] while uncons uncons pop over
+E′ == roll> popop rest [dup W] dip cons dipd swap
+E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E′] cons infra]
+] cond
+
+
+
+
+
+
+
+
+Minor rearrangement:
+
+W == dup [fourth] [fourth] while uncons uncons pop over
+E′ == roll> popop rest [W] dip cons dipd swap
+E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E′] cons infra]
+] cond
+
+
+
+
+
+
+
+
+Refactoring¶
+W.rightmost == [fourth] [fourth] while
+W.unpack == uncons uncons pop
+E.clear_stuff == roll> popop rest
+E.delete == cons dipd
+W == dup W.rightmost W.unpack over
+E.0 == E.clear_stuff [W] dip E.delete swap
+E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E.0] cons infra]
+] cond
+T> == [dipd] cons infra
+T< == [dipdd] cons infra
+R0 == over first swap dup
+R1 == cons roll> [T>] [E] [T<] cmp
+BTree-Delete == [pop not] swap [R0] [R1] genrec
+
+
+By the standards of the code I've written so far, this is a huge Joy program.
+
+
+
+
+
+
+In [43]:
+
+
+DefinitionWrapper.add_definitions('''
+first_two == uncons uncons pop
+fourth == rest rest rest first
+?fourth == [] [fourth] [] ifte
+W.rightmost == [?fourth] [fourth] while
+E.clear_stuff == roll> popop rest
+E.delete == cons dipd
+W == dup W.rightmost first_two over
+E.0 == E.clear_stuff [W] dip E.delete swap
+E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[E.0] cons infra]] cond
+T> == [dipd] cons infra
+T< == [dipdd] cons infra
+R0 == over first swap dup
+R1 == cons roll> [T>] [E] [T<] cmp
+Tree-Delete == [pop not] [pop] [R0] [R1] genrec''', D)
+
+
+
+
+
+
+
+
+
+In [44]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'c' Tree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [45]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'b' Tree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [46]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'a' Tree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [47]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' Tree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [48]:
+
+
+J('[] [4 2 3 1 6 7 5 ] [0 swap Tree-add] step')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [49]:
+
+
+J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 3 Tree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [50]:
+
+
+J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 4 Tree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Appendix: The source code.¶
+
+
+
+
+
+
+
+
+fourth == rest_two rest first
+?fourth == [] [fourth] [] ifte
+first_two == uncons uncons pop
+ccons == cons cons
+cinf == cons infra
+rest_two == rest rest
+
+_Tree_T> == [dipd] cinf
+_Tree_T< == [dipdd] cinf
+
+_Tree_add_P == over [popop popop first] nullary
+_Tree_add_T> == ccons _Tree_T<
+_Tree_add_T< == ccons _Tree_T>
+_Tree_add_Ee == pop swap roll< rest_two ccons
+_Tree_add_R == _Tree_add_P [_Tree_add_T>] [_Tree_add_Ee] [_Tree_add_T<] cmp
+_Tree_add_E == [pop] dipd Tree-new
+
+_Tree_iter_order_left == [cons dip] dupdip
+_Tree_iter_order_current == [[F] dupdip] dip
+_Tree_iter_order_right == [fourth] dip i
+_Tree_iter_order_R == _Tree_iter_order_left _Tree_iter_order_current _Tree_iter_order_right
+
+_Tree_get_P == over [pop popop first] nullary
+_Tree_get_T> == [fourth] dipd i
+_Tree_get_T< == [third] dipd i
+_Tree_get_E == popop second
+_Tree_get_R == _Tree_get_P [_Tree_get_T>] [_Tree_get_E] [_Tree_get_T<] cmp
+
+_Tree_delete_rightmost == [?fourth] [fourth] while
+_Tree_delete_clear_stuff == roll> popop rest
+_Tree_delete_del == dip cons dipd swap
+_Tree_delete_W == dup _Tree_delete_rightmost first_two over
+_Tree_delete_E.0 == _Tree_delete_clear_stuff [_Tree_delete_W] _Tree_delete_del
+_Tree_delete_E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[_Tree_delete_E.0] cinf]] cond
+_Tree_delete_R0 == over first swap dup
+_Tree_delete_R1 == cons roll> [_Tree_T>] [_Tree_delete_E] [_Tree_T<] cmp
+
+Tree-new == swap [[] []] ccons
+Tree-add == [popop not] [_Tree_add_E] [] [_Tree_add_R] genrec
+Tree-iter == [not] [pop] roll< [dupdip rest_two] cons [step] genrec
+Tree-iter-order == [not] [pop] [dup third] [_Tree_iter_order_R] genrec
+Tree-get == [pop not] swap [] [_Tree_get_R] genrec
+Tree-delete == [pop not] [pop] [_Tree_delete_R0] [_Tree_delete_R1] genrec
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/docs/Ordered_Binary_Trees.md b/docs/Ordered_Binary_Trees.md
new file mode 100644
index 0000000..368c76e
--- /dev/null
+++ b/docs/Ordered_Binary_Trees.md
@@ -0,0 +1,1285 @@
+
+# Treating Trees I
+
+Although any expression in Joy can be considered to describe a [tree](https://en.wikipedia.org/wiki/Tree_structure) with the quotes as compound nodes and the non-quote values as leaf nodes, in this page I want to talk about [ordered binary trees](https://en.wikipedia.org/wiki/Binary_search_tree) and how to make and use them.
+
+The basic structure, in a [crude type notation](https://en.wikipedia.org/wiki/Algebraic_data_type), is:
+
+ Tree :: [] | [key value Tree Tree]
+
+That says that a Tree is either the empty quote `[]` or a quote with four items: a key, a value, and two Trees representing the left and right branches of the tree.
+
+We're going to derive some recursive functions to work with such datastructures:
+
+ Tree-add
+ Tree-delete
+ Tree-get
+ Tree-iter
+ Tree-iter-order
+
+Once these functions are defined we have a new "type" to work with, and the Sufficiently Smart Compiler can be modified to use an optimized implementation under the hood. (Where does the "type" come from? It has a contingent existence predicated on the disciplined use of these functions on otherwise undistinguished Joy datastructures.)
+
+
+```python
+from notebook_preamble import D, J, V, define, DefinitionWrapper
+```
+
+## Adding Nodes to the Tree
+Let's consider adding nodes to a Tree structure.
+
+ Tree value key Tree-add
+ -----------------------------
+ Tree′
+
+### Adding to an empty node.
+If the current node is `[]` then you just return `[key value [] []]`:
+
+ Tree-add == [popop not] [[pop] dipd Tree-new] [R0] [R1] genrec
+
+#### `Tree-new`
+Where `Tree-new` is defined as:
+
+ value key Tree-new
+ ------------------------
+ [key value [] []]
+
+Example:
+
+ value key swap [[] []] cons cons
+ key value [[] []] cons cons
+ key [value [] []] cons
+ [key value [] []]
+
+Definition:
+
+ Tree-new == swap [[] []] cons cons
+
+
+```python
+define('Tree-new == swap [[] []] cons cons')
+```
+
+
+```python
+J('"v" "k" Tree-new')
+```
+
+(As an implementation detail, the `[[] []]` literal used in the definition of `Tree-new` will be reused to supply the *constant* tail for *all* new nodes produced by it. This is one of those cases where you get amortized storage "for free" by using [persistent datastructures](https://en.wikipedia.org/wiki/Persistent_data_structure). Because the tail, which is `((), ((), ()))` in Python, is immutable and embedded in the definition body for `Tree-new`, all new nodes can reuse it as their own tail without fear that some other code somewhere will change it.)
+
+### Adding to a non-empty node.
+
+We now have to derive `R0` and `R1`, consider:
+
+ [key_n value_n left right] value key R0 [Tree-add] R1
+
+In this case, there are three possibilites: the key can be greater or less than or equal to the node's key. In two of those cases we will need to apply a copy of `Tree-add`, so `R0` is pretty much out of the picture.
+
+ [R0] == []
+
+#### A predicate to compare keys.
+
+ [key_n value_n left right] value key [BTree-add] R1
+
+The first thing we need to do is compare the the key we're adding to the node key and `branch` accordingly:
+
+ [key_n value_n left right] value key [BTree-add] [P] [T] [E] ifte
+
+That would suggest something like:
+
+ [key_n value_n left right] value key [BTree-add] P
+ [key_n value_n left right] value key [BTree-add] pop roll> pop first >
+ [key_n value_n left right] value key roll> pop first >
+ key [key_n value_n left right] value roll> pop first >
+ key key_n >
+ Boolean
+
+Let's abstract the predicate just a little to let us specify the comparison operator:
+
+ P > == pop roll> pop first >
+ P < == pop roll> pop first <
+ P == pop roll> pop first
+
+
+```python
+define('P == pop roll> pop first')
+```
+
+
+```python
+J('["old_key" 23 [] []] 17 "new_key" ["..."] P')
+```
+
+ 'new_key' 'old_key'
+
+
+#### If the key we're adding is greater than the node's key.
+
+Here the parentheses are meant to signify that the expression is not literal, the code in the parentheses is meant to have been evaluated:
+
+ [key_n value_n left right] value key [Tree-add] T
+ -------------------------------------------------------
+ [key_n value_n left (Tree-add key value right)]
+
+So how do we do this? We're going to want to use `infra` on some function `K` that has the key and value to work with, as well as the quoted copy of `Tree-add` to apply somehow. Considering the node as a stack:
+
+ right left value_n key_n value key [Tree-add] K
+ -----------------------------------------------------
+ right value key Tree-add left value_n key_n
+
+Pretty easy:
+
+ right left value_n key_n value key [Tree-add] cons cons dipdd
+ right left value_n key_n [value key Tree-add] dipdd
+ right value key Tree-add left value_n key_n
+
+So:
+
+ K == cons cons dipdd
+
+Looking at it from the point-of-view of the node as node again:
+
+ [key_n value_n left right] [value key [Tree-add] K] infra
+
+Expand `K` and evaluate a little:
+
+ [key_n value_n left right] [value key [Tree-add] K] infra
+ [key_n value_n left right] [value key [Tree-add] cons cons dipdd] infra
+ [key_n value_n left right] [[value key Tree-add] dipdd] infra
+
+Then, working backwards:
+
+ [key_n value_n left right] [[value key Tree-add] dipdd] infra
+ [key_n value_n left right] [value key Tree-add] [dipdd] cons infra
+ [key_n value_n left right] value key [Tree-add] cons cons [dipdd] cons infra
+
+
+And so `T` is just:
+
+ T == cons cons [dipdd] cons infra
+
+
+```python
+define('T == cons cons [dipdd] cons infra')
+```
+
+
+```python
+J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] T')
+```
+
+ ['old_k' 'old_value' 'left' 'Tree-add' 'new_key' 'new_value' 'right']
+
+
+#### If the key we're adding is less than the node's key.
+This is very very similar to the above:
+
+ [key_n value_n left right] value key [Tree-add] E
+ [key_n value_n left right] value key [Tree-add] [P <] [Te] [Ee] ifte
+
+
+```python
+define('E == [P <] [Te] [Ee] ifte')
+```
+
+In this case `Te` works that same as `T` but on the left child tree instead of the right, so the only difference is that it must use `dipd` instead of `dipdd`:
+
+ Te == cons cons [dipd] cons infra
+
+
+```python
+define('Te == cons cons [dipd] cons infra')
+```
+
+
+```python
+J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] Te')
+```
+
+ ['old_k' 'old_value' 'Tree-add' 'new_key' 'new_value' 'left' 'right']
+
+
+#### Else the keys must be equal.
+This means we must find:
+
+ [key old_value left right] new_value key [Tree-add] Ee
+ ------------------------------------------------------------
+ [key new_value left right]
+
+This is another easy one:
+
+ Ee == pop swap roll< rest rest cons cons
+
+Example:
+
+ [key old_value left right] new_value key [Tree-add] pop swap roll< rest rest cons cons
+ [key old_value left right] new_value key swap roll< rest rest cons cons
+ [key old_value left right] key new_value roll< rest rest cons cons
+ key new_value [key old_value left right] rest rest cons cons
+ key new_value [ left right] cons cons
+ [key new_value left right]
+
+
+```python
+define('Ee == pop swap roll< rest rest cons cons')
+```
+
+
+```python
+J('["k" "old_value" "left" "right"] "new_value" "k" ["Tree-add"] Ee')
+```
+
+ ['k' 'new_value' 'left' 'right']
+
+
+#### Now we can define `Tree-add`
+ Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec
+
+Putting it all together:
+
+ Tree-new == swap [[] []] cons cons
+ P == pop roll> pop first
+ T == cons cons [dipdd] cons infra
+ Te == cons cons [dipd] cons infra
+ Ee == pop swap roll< rest rest cons cons
+ E == [P <] [Te] [Ee] ifte
+ R == [P >] [T] [E] ifte
+
+ Tree-add == [popop not] [[pop] dipd Tree-new] [] [R] genrec
+
+
+```python
+define('Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec')
+```
+
+#### Examples
+
+
+```python
+J('[] 23 "b" Tree-add') # Initial
+```
+
+ ['b' 23 [] []]
+
+
+
+```python
+J('["b" 23 [] []] 88 "c" Tree-add') # Greater than
+```
+
+ ['b' 23 [] ['c' 88 [] []]]
+
+
+
+```python
+J('["b" 23 [] []] 88 "a" Tree-add') # Less than
+```
+
+ ['b' 23 ['a' 88 [] []] []]
+
+
+
+```python
+J('["b" 23 [] []] 88 "b" Tree-add') # Equal to
+```
+
+ ['b' 88 [] []]
+
+
+
+```python
+J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Series.
+```
+
+ ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
+
+
+
+```python
+J('[] [[23 "b"] [88 "a"] [44 "c"]] [i Tree-add] step')
+```
+
+ ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
+
+
+## Interlude: `cmp` combinator
+Instead of mucking about with nested `ifte` combinators let's just go whole hog and define `cmp` which takes two values and three quoted programs on the stack and runs one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+
+
+```python
+from joy.library import FunctionWrapper
+from joy.utils.stack import pushback
+from notebook_preamble import D
+
+
+@FunctionWrapper
+def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
+ L, (E, (G, (b, (a, stack)))) = stack
+ expression = pushback(G if a > b else L if a < b else E, expression)
+ return stack, expression, dictionary
+
+
+D['cmp'] = cmp_
+```
+
+
+```python
+J("1 0 ['G'] ['E'] ['L'] cmp")
+```
+
+ 'G'
+
+
+
+```python
+J("1 1 ['G'] ['E'] ['L'] cmp")
+```
+
+ 'E'
+
+
+
+```python
+J("0 1 ['G'] ['E'] ['L'] cmp")
+```
+
+ 'L'
+
+
+### Redefine `Tree-add`
+We need a new non-destructive predicate `P`:
+
+ [node_key node_value left right] value key [Tree-add] P
+ ------------------------------------------------------------------------
+ [node_key node_value left right] value key [Tree-add] key node_key
+
+Let's start with `over` to get a copy of the key and then apply some function `Q` with the `nullary` combinator so it can dig out the node key (by throwing everything else away):
+
+ P == over [Q] nullary
+
+ [node_key node_value left right] value key [Tree-add] over [Q] nullary
+ [node_key node_value left right] value key [Tree-add] key [Q] nullary
+
+And `Q` would be:
+
+ Q == popop popop first
+
+ [node_key node_value left right] value key [Tree-add] key Q
+ [node_key node_value left right] value key [Tree-add] key popop popop first
+ [node_key node_value left right] value key popop first
+ [node_key node_value left right] first
+ node_key
+
+Or just:
+
+ P == over [popop popop first] nullary
+
+
+```python
+define('P == over [popop popop first] nullary')
+```
+
+Using `cmp` to simplify [our code above at `R1`](#Adding-to-a-non-empty-node.):
+
+ [node_key node_value left right] value key [Tree-add] R1
+ [node_key node_value left right] value key [Tree-add] P [T] [E] [Te] cmp
+
+The line above becomes one of the three lines below:
+
+ [node_key node_value left right] value key [Tree-add] T
+ [node_key node_value left right] value key [Tree-add] E
+ [node_key node_value left right] value key [Tree-add] Te
+
+The definition is a little longer but, I think, more elegant and easier to understand:
+
+ Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec
+
+
+```python
+define('Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec')
+```
+
+
+```python
+J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Still works.
+```
+
+ ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
+
+
+## A Function to Traverse this Structure
+Let's take a crack at writing a function that can recursively iterate or traverse these trees.
+
+### Base case `[]`
+The stopping predicate just has to detect the empty list:
+
+ Tree-iter == [not] [E] [R0] [R1] genrec
+
+And since there's nothing at this node, we just `pop` it:
+
+ Tree-iter == [not] [pop] [R0] [R1] genrec
+
+### Node case `[key value left right]`
+Now we need to figure out `R0` and `R1`:
+
+ Tree-iter == [not] [pop] [R0] [R1] genrec
+ == [not] [pop] [R0 [Tree-iter] R1] ifte
+
+Let's look at it *in situ*:
+
+ [key value left right] R0 [Tree-iter] R1
+
+### Processing the current node.
+
+`R0` is almost certainly going to use `dup` to make a copy of the node and then `dip` on some function to process the copy with it:
+
+ [key value left right] [F] dupdip [Tree-iter] R1
+ [key value left right] F [key value left right] [Tree-iter] R1
+
+For example, if we're getting all the keys `F` would be `first`:
+
+ R0 == [first] dupdip
+
+ [key value left right] [first] dupdip [Tree-iter] R1
+ [key value left right] first [key value left right] [Tree-iter] R1
+ key [key value left right] [Tree-iter] R1
+
+### Recur
+Now `R1` needs to apply `[Tree-iter]` to `left` and `right`. If we drop the key and value from the node using `rest` twice we are left with an interesting situation:
+
+ key [key value left right] [Tree-iter] R1
+ key [key value left right] [Tree-iter] [rest rest] dip
+ key [key value left right] rest rest [Tree-iter]
+ key [left right] [Tree-iter]
+
+Hmm, will `step` do?
+
+ key [left right] [Tree-iter] step
+ key left Tree-iter [right] [Tree-iter] step
+ key left-keys [right] [Tree-iter] step
+ key left-keys right Tree-iter
+ key left-keys right-keys
+
+Neat. So:
+
+ R1 == [rest rest] dip step
+
+### Putting it together
+We have:
+
+ Tree-iter == [not] [pop] [[F] dupdip] [[rest rest] dip step] genrec
+
+When I was reading this over I realized `rest rest` could go in `R0`:
+
+ Tree-iter == [not] [pop] [[F] dupdip rest rest] [step] genrec
+
+(And `[step] genrec` is such a cool and suggestive combinator!)
+
+### Parameterizing the `F` per-node processing function.
+
+ [F] Tree-iter
+ ------------------------------------------------------
+ [not] [pop] [[F] dupdip rest rest] [step] genrec
+
+Working backward:
+
+ [not] [pop] [[F] dupdip rest rest] [step] genrec
+ [not] [pop] [F] [dupdip rest rest] cons [step] genrec
+ [F] [not] [pop] roll< [dupdip rest rest] cons [step] genrec
+
+## `Tree-iter`
+
+ Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec
+
+
+```python
+define('Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec')
+```
+
+#### Examples
+
+
+```python
+J('[] [foo] Tree-iter') # It doesn't matter what F is as it won't be used.
+```
+
+
+
+
+
+```python
+J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [first] Tree-iter")
+```
+
+ 'b' 'a' 'c'
+
+
+
+```python
+J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [second] Tree-iter")
+```
+
+ 23 88 44
+
+
+## Interlude: A Set-like Datastructure
+We can use this to make a set-like datastructure by just setting values to e.g. 0 and ignoring them. It's set-like in that duplicate items added to it will only occur once within it, and we can query it in [$O(\log_2 N)$](https://en.wikipedia.org/wiki/Binary_search_tree#cite_note-2) time.
+
+
+```python
+J('[] [3 9 5 2 8 6 7 8 4] [0 swap Tree-add] step')
+```
+
+ [3 0 [2 0 [] []] [9 0 [5 0 [4 0 [] []] [8 0 [6 0 [] [7 0 [] []]] []]] []]]
+
+
+
+```python
+define('to_set == [] swap [0 swap Tree-add] step')
+```
+
+
+```python
+J('[3 9 5 2 8 6 7 8 4] to_set')
+```
+
+ [3 0 [2 0 [] []] [9 0 [5 0 [4 0 [] []] [8 0 [6 0 [] [7 0 [] []]] []]] []]]
+
+
+And with that we can write a little program `unique` to remove duplicate items from a list.
+
+
+```python
+define('unique == [to_set [first] Tree-iter] cons run')
+```
+
+
+```python
+J('[3 9 3 5 2 9 8 8 8 6 2 7 8 4 3] unique') # Filter duplicate items.
+```
+
+ [7 6 8 4 5 9 2 3]
+
+
+## A Version of `Tree-iter` that does In-Order Traversal
+
+If you look back to the [non-empty case of the `Tree-iter` function](#Node-case-[key-value-left-right]) we can design a variant that first processes the left child, then the current node, then the right child. This will allow us to traverse the tree in sort order.
+
+ Tree-iter-order == [not] [pop] [R0] [R1] genrec
+
+To define `R0` and `R1` it helps to look at them as they will appear when they run:
+
+ [key value left right] R0 [BTree-iter-order] R1
+
+#### Process the left child.
+Staring at this for a bit suggests `dup third` to start:
+
+ [key value left right] R0 [Tree-iter-order] R1
+ [key value left right] dup third [Tree-iter-order] R1
+ [key value left right] left [Tree-iter-order] R1
+
+Now maybe:
+
+ [key value left right] left [Tree-iter-order] [cons dip] dupdip
+ [key value left right] left [Tree-iter-order] cons dip [Tree-iter-order]
+ [key value left right] [left Tree-iter-order] dip [Tree-iter-order]
+ left Tree-iter-order [key value left right] [Tree-iter-order]
+
+#### Process the current node.
+So far, so good. Now we need to process the current node's values:
+
+ left Tree-iter-order [key value left right] [Tree-iter-order] [[F] dupdip] dip
+ left Tree-iter-order [key value left right] [F] dupdip [Tree-iter-order]
+ left Tree-iter-order [key value left right] F [key value left right] [Tree-iter-order]
+
+If `F` needs items from the stack below the left stuff it should have `cons`'d them before beginning maybe? For functions like `first` it works fine as-is.
+
+ left Tree-iter-order [key value left right] first [key value left right] [Tree-iter-order]
+ left Tree-iter-order key [key value left right] [Tree-iter-order]
+
+#### Process the right child.
+First ditch the rest of the node and get the right child:
+
+ left Tree-iter-order key [key value left right] [Tree-iter-order] [rest rest rest first] dip
+ left Tree-iter-order key right [Tree-iter-order]
+
+Then, of course, we just need `i` to run `Tree-iter-order` on the right side:
+
+ left Tree-iter-order key right [Tree-iter-order] i
+ left Tree-iter-order key right Tree-iter-order
+
+#### Defining `Tree-iter-order`
+The result is a little awkward:
+
+ R1 == [cons dip] dupdip [[F] dupdip] dip [rest rest rest first] dip i
+
+Let's do a little semantic factoring:
+
+ fourth == rest rest rest first
+
+ proc_left == [cons dip] dupdip
+ proc_current == [[F] dupdip] dip
+ proc_right == [fourth] dip i
+
+ Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
+
+Now we can sort sequences.
+
+
+```python
+#define('Tree-iter-order == [not] [pop] [dup third] [[cons dip] dupdip [[first] dupdip] dip [rest rest rest first] dip i] genrec')
+
+
+DefinitionWrapper.add_definitions('''
+
+fourth == rest rest rest first
+
+proc_left == [cons dip] dupdip
+proc_current == [[first] dupdip] dip
+proc_right == [fourth] dip i
+
+Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
+
+''', D)
+
+
+
+```
+
+
+```python
+J('[3 9 5 2 8 6 7 8 4] to_set Tree-iter-order')
+```
+
+ 2 3 4 5 6 7 8 9
+
+
+Parameterizing the `[F]` function is left as an exercise for the reader (for now.)
+
+## Getting values by key
+Let's derive a function that accepts a tree and a key and returns the value associated with that key.
+
+ tree key Tree-get
+ -----------------------
+ value
+
+But what do we do if the key isn't in the tree? In Python we might raise a `KeyError` but I'd like to avoid exceptions in Joy if possible, and here I think it's possible. (Division by zero is an example of where I think it's probably better to let Python crash Joy. Sometimes the machinery fails and you have to "stop the line", I think.)
+
+Let's pass the buck to the caller by making the base case a given, you have to decide for yourself what `[E]` should be.
+
+
+ tree key [E] Tree-get
+ ---------------------------- key in tree
+ value
+
+ tree key [E] Tree-get
+ ---------------------------- key not in tree
+ [] key E
+
+#### The base case `[]`
+As before, the stopping predicate just has to detect the empty list:
+
+ Tree-get == [pop not] [E] [R0] [R1] genrec
+
+So we define:
+
+ Tree-get == [pop not] swap [R0] [R1] genrec
+
+Note that this `Tree-get` creates a slightly different function than itself and *that function* does the actual recursion. This kind of higher-level programming is unusual in most languages but natural in Joy.
+
+ tree key [E] [pop not] swap [R0] [R1] genrec
+ tree key [pop not] [E] [R0] [R1] genrec
+
+The anonymous specialized recursive function that will do the real work.
+
+ [pop not] [E] [R0] [R1] genrec
+
+#### Node case `[key value left right]`
+Now we need to figure out `R0` and `R1`:
+
+ [key value left right] key R0 [BTree-get] R1
+
+We want to compare the search key with the key in the node, and if they are the same return the value, otherwise recur on one of the child nodes. So it's very similar to the above funtion, with `[R0] == []` and `R1 == P [T>] [E] [T<] cmp`:
+
+ [key value left right] key [BTree-get] P [T>] [E] [T<] cmp
+
+#### Predicate:
+
+ P == over [get-node-key] nullary
+ get-node-key == pop popop first
+
+The only difference is that `get-node-key` does one less `pop` because there's no value to discard.
+
+#### Branches
+Now we have to derive the branches:
+
+ [key_n value_n left right] key [BTree-get] T>
+ [key_n value_n left right] key [BTree-get] E
+ [key_n value_n left right] key [BTree-get] T<
+
+#### Greater than and less than
+The cases of `T>` and `T<` are similar to above but instead of using `infra` we have to discard the rest of the structure:
+
+ [key_n value_n left right] key [BTree-get] T>
+ ---------------------------------------------------
+ right key BTree-get
+
+And:
+
+ [key_n value_n left right] key [BTree-get] T<
+ ---------------------------------------------------
+ left key BTree-get
+
+So:
+
+ T> == [fourth] dipd i
+ T< == [third] dipd i
+
+E.g.:
+
+ [key_n value_n left right] key [BTree-get] [fourth] dipd i
+ [key_n value_n left right] fourth key [BTree-get] i
+ right key [BTree-get] i
+ right key BTree-get
+
+#### Equal keys
+Return the node's value:
+
+ [key_n value_n left right] key [BTree-get] E == value_n
+
+ E == popop second
+
+### `Tree-get`
+So:
+
+ fourth == rest rest rest first
+ get-node-key == pop popop first
+ P == over [get-node-key] nullary
+ T> == [fourth] dipd i
+ T< == [third] dipd i
+ E == popop second
+
+ Tree-get == [pop not] swap [] [P [T>] [E] [T<] cmp] genrec
+
+
+```python
+# I don't want to deal with name conflicts with the above so I'm inlining everything here.
+# The original Joy system has "hide" which is a meta-command which allows you to use named
+# definitions that are only in scope for a given definition. I don't want to implement
+# that (yet) so...
+
+
+define('''
+Tree-get == [pop not] swap [] [
+ over [pop popop first] nullary
+ [[fourth] dipd i]
+ [popop second]
+ [[third] dipd i]
+ cmp
+ ] genrec
+''')
+```
+
+
+```python
+J('["gary" 23 [] []] "mike" [popd " not in tree" +] Tree-get')
+```
+
+ 'mike not in tree'
+
+
+
+```python
+J('["gary" 23 [] []] "gary" [popop "err"] Tree-get')
+```
+
+ 23
+
+
+
+```python
+J('''
+
+ [] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
+
+ 'c' [popop 'not found'] Tree-get
+
+''')
+```
+
+ 2
+
+
+
+```python
+J('''
+
+ [] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
+
+ 'd' [popop 'not found'] Tree-get
+
+''')
+```
+
+ 'not found'
+
+
+# Tree-delete
+
+Now let's write a function that can return a tree datastructure with a key, value pair deleted:
+
+ tree key Tree-delete
+ ---------------------------
+ tree
+
+If the key is not in tree it just returns the tree unchanged.
+
+### Base case
+Same as above.
+
+ Tree-Delete == [pop not] [pop] [R0] [R1] genrec
+
+### Recur
+Now we get to figure out the recursive case. We need the node's key to compare and we need to carry the key into recursive branches. Let `D` be shorthand for `Tree-Delete`:
+
+ D == Tree-Delete == [pop not] [pop] [R0] [R1] genrec
+
+ [node_key node_value left right] key R0 [D] R1
+ [node_key node_value left right] key over first swap dup [D] cons R1′
+ [node_key node_value left right] key [...] first swap dup [D] cons R1′
+ [node_key node_value left right] key node_key swap dup [D] cons R1′
+ [node_key node_value left right] node_key key dup [D] cons R1′
+ [node_key node_value left right] node_key key key [D] cons R1′
+ [node_key node_value left right] node_key key [key D] R1′
+
+And then:
+
+ [node_key node_value left right] node_key key [key D] R1′
+ [node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+ [node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+ [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+So:
+
+ R0 == over first swap dup
+ R1 == cons roll> [T>] [E] [T<] cmp
+
+### Compare Keys
+The last line above:
+
+ [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+Then becomes one of these three:
+
+ [node_key node_value left right] [key D] T>
+ [node_key node_value left right] [key D] E
+ [node_key node_value left right] [key D] T<
+
+### Greater than case and less than case
+
+ [node_key node_value left right] [F] T>
+ -------------------------------------------------
+ [node_key node_value (left F) right]
+
+
+ [node_key node_value left right] [F] T<
+ -------------------------------------------------
+ [node_key node_value left (right F)]
+
+First, treating the node as a stack:
+
+ right left node_value node_key [key D] dipd
+ right left key D node_value node_key
+ right left' node_value node_key
+
+Ergo:
+
+ [node_key node_value left right] [key D] [dipd] cons infra
+
+So:
+
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+
+### The else case
+We have found the node in the tree where `key` equals `node_key`. We need to replace the current node with something
+
+ [node_key node_value left right] [key D] E
+ ------------------------------------------------
+ tree
+
+We have to handle three cases, so let's use `cond`.
+
+
+```python
+from joy.library import FunctionWrapper, S_ifte
+
+
+@FunctionWrapper
+def cond(stack, expression, dictionary):
+ '''
+ like a case statement; works by rewriting into a chain of ifte.
+
+ [..[[Bi] Ti]..[D]] -> ...
+
+
+ [[[B0] T0] [[B1] T1] [D]] cond
+ -----------------------------------------
+ [B0] [T0] [[B1] [T1] [D] ifte] ifte
+
+ '''
+ conditions, stack = stack
+ if conditions:
+ expression = _cond(conditions, expression)
+ try:
+ # Attempt to preload the args to first ifte.
+ (P, (T, (E, expression))) = expression
+ except ValueError:
+ # If, for any reason, the argument to cond should happen to contain
+ # only the default clause then this optimization will fail.
+ pass
+ else:
+ stack = (E, (T, (P, stack)))
+ return stack, expression, dictionary
+
+
+def _cond(conditions, expression):
+ (clause, rest) = conditions
+ if not rest: # clause is [D]
+ return clause
+ P, T = clause
+ return (P, (T, (_cond(rest, ()), (S_ifte, expression))))
+
+
+
+D['cond'] = cond
+```
+
+#### One or more child nodes are `[]`
+The first two cases are symmetrical: if we only have one non-empty child node return it. If both child nodes are empty return an empty node.
+
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [default]
+ ] cond
+
+#### Both child nodes are non-empty.
+If both child nodes are non-empty, we find the highest node in our lower sub-tree, take its key and value to replace (delete) our own, then get rid of it by recursively calling delete() on our lower sub-node with our new key.
+
+(We could also find the lowest node in our higher sub-tree and take its key and value and delete it. I only implemented one of these two symmetrical options. Over a lot of deletions this might make the tree more unbalanced. Oh well.)
+
+The initial structure of the default function:
+
+ default == [E′] cons infra
+
+ [node_key node_value left right] [key D] default
+ [node_key node_value left right] [key D] [E′] cons infra
+ [node_key node_value left right] [[key D] E′] infra
+
+ right left node_value node_key [key D] E′
+
+First things first, we no longer need this node's key and value:
+
+ right left node_value node_key [key D] roll> popop E″
+ right left [key D] node_value node_key popop E″
+ right left [key D] E″
+
+#### We have to we find the highest (right-most) node in our lower (left) sub-tree:
+
+ right left [key D] E″
+
+Ditch the key:
+
+ right left [key D] rest E‴
+ right left [D] E‴
+
+Find the right-most node:
+
+ right left [D] [dup W] dip E⁗
+ right left dup W [D] E⁗
+ right left left W [D] E⁗
+
+Consider:
+
+ left W
+
+We know left is not empty:
+
+ [L_key L_value L_left L_right] W
+
+We want to keep extracting the right node as long as it is not empty:
+
+ W.rightmost == [P] [B] while
+
+ left W.rightmost W′
+
+The predicate:
+
+ [L_key L_value L_left L_right] P
+ [L_key L_value L_left L_right] fourth
+ L_right
+
+This can run on `[]` so must be guarded:
+
+ ?fourth == [] [fourth] [] ifte
+
+(
+ if_not_empty == [] swap [] ifte
+ ?fourth == [fourth] if_not_empty
+)
+
+The body is just `fourth`:
+
+ left [?fourth] [fourth] while W′
+ rightest W′
+
+So:
+
+ W.rightmost == [?fourth] [fourth] while
+
+#### Found right-most node in our left sub-tree
+We know rightest is not empty:
+
+ [R_key R_value R_left R_right] W′
+ [R_key R_value R_left R_right] W′
+ [R_key R_value R_left R_right] uncons uncons pop
+ R_key [R_value R_left R_right] uncons pop
+ R_key R_value [R_left R_right] pop
+ R_key R_value
+
+
+So:
+
+ W == [?fourth] [fourth] while uncons uncons pop
+
+And:
+
+ right left left W [D] E⁗
+ right left R_key R_value [D] E⁗
+
+#### Replace current node key and value, recursively delete rightmost
+Final stretch. We want to end up with something like:
+
+ right left [R_key D] i R_value R_key
+ right left R_key D R_value R_key
+ right left′ R_value R_key
+
+If we adjust our definition of `W` to include `over` at the end:
+
+ W == [fourth] [fourth] while uncons uncons pop over
+
+That will give us:
+
+ right left R_key R_value R_key [D] E⁗
+
+ right left R_key R_value R_key [D] cons dipd E⁗′
+ right left R_key R_value [R_key D] dipd E⁗′
+ right left R_key D R_key R_value E⁗′
+ right left′ R_key R_value E⁗′
+ right left′ R_key R_value swap
+ right left′ R_value R_key
+
+So:
+
+ E′ == roll> popop E″
+
+ E″ == rest E‴
+
+ E‴ == [dup W] dip E⁗
+
+ E⁗ == cons dipdd swap
+
+Substituting:
+
+ W == [fourth] [fourth] while uncons uncons pop over
+ E′ == roll> popop rest [dup W] dip cons dipd swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E′] cons infra]
+ ] cond
+
+Minor rearrangement:
+
+ W == dup [fourth] [fourth] while uncons uncons pop over
+ E′ == roll> popop rest [W] dip cons dipd swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E′] cons infra]
+ ] cond
+
+### Refactoring
+
+ W.rightmost == [fourth] [fourth] while
+ W.unpack == uncons uncons pop
+ E.clear_stuff == roll> popop rest
+ E.delete == cons dipd
+ W == dup W.rightmost W.unpack over
+ E.0 == E.clear_stuff [W] dip E.delete swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E.0] cons infra]
+ ] cond
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+ R0 == over first swap dup
+ R1 == cons roll> [T>] [E] [T<] cmp
+ BTree-Delete == [pop not] swap [R0] [R1] genrec
+
+By the standards of the code I've written so far, this is a *huge* Joy program.
+
+
+```python
+DefinitionWrapper.add_definitions('''
+first_two == uncons uncons pop
+fourth == rest rest rest first
+?fourth == [] [fourth] [] ifte
+W.rightmost == [?fourth] [fourth] while
+E.clear_stuff == roll> popop rest
+E.delete == cons dipd
+W == dup W.rightmost first_two over
+E.0 == E.clear_stuff [W] dip E.delete swap
+E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[E.0] cons infra]] cond
+T> == [dipd] cons infra
+T< == [dipdd] cons infra
+R0 == over first swap dup
+R1 == cons roll> [T>] [E] [T<] cmp
+Tree-Delete == [pop not] [pop] [R0] [R1] genrec''', D)
+```
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'c' Tree-Delete ")
+```
+
+ ['a' 23 [] ['b' 88 [] []]]
+
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'b' Tree-Delete ")
+```
+
+ ['a' 23 [] ['c' 44 [] []]]
+
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'a' Tree-Delete ")
+```
+
+ ['b' 88 [] ['c' 44 [] []]]
+
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' Tree-Delete ")
+```
+
+ ['a' 23 [] ['b' 88 [] ['c' 44 [] []]]]
+
+
+
+```python
+J('[] [4 2 3 1 6 7 5 ] [0 swap Tree-add] step')
+```
+
+ [4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]]
+
+
+
+```python
+J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 3 Tree-Delete ")
+```
+
+ [4 0 [2 0 [1 0 [] []] []] [6 0 [5 0 [] []] [7 0 [] []]]]
+
+
+
+```python
+J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 4 Tree-Delete ")
+```
+
+ [3 0 [2 0 [1 0 [] []] []] [6 0 [5 0 [] []] [7 0 [] []]]]
+
+
+## Appendix: The source code.
+
+
+
+
+ fourth == rest_two rest first
+ ?fourth == [] [fourth] [] ifte
+ first_two == uncons uncons pop
+ ccons == cons cons
+ cinf == cons infra
+ rest_two == rest rest
+
+ _Tree_T> == [dipd] cinf
+ _Tree_T< == [dipdd] cinf
+
+ _Tree_add_P == over [popop popop first] nullary
+ _Tree_add_T> == ccons _Tree_T<
+ _Tree_add_T< == ccons _Tree_T>
+ _Tree_add_Ee == pop swap roll< rest_two ccons
+ _Tree_add_R == _Tree_add_P [_Tree_add_T>] [_Tree_add_Ee] [_Tree_add_T<] cmp
+ _Tree_add_E == [pop] dipd Tree-new
+
+ _Tree_iter_order_left == [cons dip] dupdip
+ _Tree_iter_order_current == [[F] dupdip] dip
+ _Tree_iter_order_right == [fourth] dip i
+ _Tree_iter_order_R == _Tree_iter_order_left _Tree_iter_order_current _Tree_iter_order_right
+
+ _Tree_get_P == over [pop popop first] nullary
+ _Tree_get_T> == [fourth] dipd i
+ _Tree_get_T< == [third] dipd i
+ _Tree_get_E == popop second
+ _Tree_get_R == _Tree_get_P [_Tree_get_T>] [_Tree_get_E] [_Tree_get_T<] cmp
+
+ _Tree_delete_rightmost == [?fourth] [fourth] while
+ _Tree_delete_clear_stuff == roll> popop rest
+ _Tree_delete_del == dip cons dipd swap
+ _Tree_delete_W == dup _Tree_delete_rightmost first_two over
+ _Tree_delete_E.0 == _Tree_delete_clear_stuff [_Tree_delete_W] _Tree_delete_del
+ _Tree_delete_E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[_Tree_delete_E.0] cinf]] cond
+ _Tree_delete_R0 == over first swap dup
+ _Tree_delete_R1 == cons roll> [_Tree_T>] [_Tree_delete_E] [_Tree_T<] cmp
+
+ Tree-new == swap [[] []] ccons
+ Tree-add == [popop not] [_Tree_add_E] [] [_Tree_add_R] genrec
+ Tree-iter == [not] [pop] roll< [dupdip rest_two] cons [step] genrec
+ Tree-iter-order == [not] [pop] [dup third] [_Tree_iter_order_R] genrec
+ Tree-get == [pop not] swap [] [_Tree_get_R] genrec
+ Tree-delete == [pop not] [pop] [_Tree_delete_R0] [_Tree_delete_R1] genrec
+
+
diff --git a/docs/Ordered_Binary_Trees.rst b/docs/Ordered_Binary_Trees.rst
new file mode 100644
index 0000000..883d431
--- /dev/null
+++ b/docs/Ordered_Binary_Trees.rst
@@ -0,0 +1,1709 @@
+
+Treating Trees I
+================
+
+Although any expression in Joy can be considered to describe a
+`tree `__ with the quotes
+as compound nodes and the non-quote values as leaf nodes, in this page I
+want to talk about `ordered binary
+trees `__ and how to
+make and use them.
+
+The basic structure, in a `crude type
+notation `__, is:
+
+::
+
+ Tree :: [] | [key value Tree Tree]
+
+That says that a Tree is either the empty quote ``[]`` or a quote with
+four items: a key, a value, and two Trees representing the left and
+right branches of the tree.
+
+We're going to derive some recursive functions to work with such
+datastructures:
+
+::
+
+ Tree-add
+ Tree-delete
+ Tree-get
+ Tree-iter
+ Tree-iter-order
+
+Once these functions are defined we have a new "type" to work with, and
+the Sufficiently Smart Compiler can be modified to use an optimized
+implementation under the hood. (Where does the "type" come from? It has
+a contingent existence predicated on the disciplined use of these
+functions on otherwise undistinguished Joy datastructures.)
+
+.. code:: ipython2
+
+ from notebook_preamble import D, J, V, define, DefinitionWrapper
+
+Adding Nodes to the Tree
+------------------------
+
+Let's consider adding nodes to a Tree structure.
+
+::
+
+ Tree value key Tree-add
+ -----------------------------
+ Tree′
+
+Adding to an empty node.
+~~~~~~~~~~~~~~~~~~~~~~~~
+
+If the current node is ``[]`` then you just return
+``[key value [] []]``:
+
+::
+
+ Tree-add == [popop not] [[pop] dipd Tree-new] [R0] [R1] genrec
+
+``Tree-new``
+^^^^^^^^^^^^
+
+Where ``Tree-new`` is defined as:
+
+::
+
+ value key Tree-new
+ ------------------------
+ [key value [] []]
+
+Example:
+
+::
+
+ value key swap [[] []] cons cons
+ key value [[] []] cons cons
+ key [value [] []] cons
+ [key value [] []]
+
+Definition:
+
+::
+
+ Tree-new == swap [[] []] cons cons
+
+.. code:: ipython2
+
+ define('Tree-new == swap [[] []] cons cons')
+
+.. code:: ipython2
+
+ J('"v" "k" Tree-new')
+
+(As an implementation detail, the ``[[] []]`` literal used in the
+definition of ``Tree-new`` will be reused to supply the *constant* tail
+for *all* new nodes produced by it. This is one of those cases where you
+get amortized storage "for free" by using `persistent
+datastructures `__.
+Because the tail, which is ``((), ((), ()))`` in Python, is immutable
+and embedded in the definition body for ``Tree-new``, all new nodes can
+reuse it as their own tail without fear that some other code somewhere
+will change it.)
+
+Adding to a non-empty node.
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We now have to derive ``R0`` and ``R1``, consider:
+
+::
+
+ [key_n value_n left right] value key R0 [Tree-add] R1
+
+In this case, there are three possibilites: the key can be greater or
+less than or equal to the node's key. In two of those cases we will need
+to apply a copy of ``Tree-add``, so ``R0`` is pretty much out of the
+picture.
+
+::
+
+ [R0] == []
+
+A predicate to compare keys.
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+::
+
+ [key_n value_n left right] value key [BTree-add] R1
+
+The first thing we need to do is compare the the key we're adding to the
+node key and ``branch`` accordingly:
+
+::
+
+ [key_n value_n left right] value key [BTree-add] [P] [T] [E] ifte
+
+That would suggest something like:
+
+::
+
+ [key_n value_n left right] value key [BTree-add] P
+ [key_n value_n left right] value key [BTree-add] pop roll> pop first >
+ [key_n value_n left right] value key roll> pop first >
+ key [key_n value_n left right] value roll> pop first >
+ key key_n >
+ Boolean
+
+Let's abstract the predicate just a little to let us specify the
+comparison operator:
+
+::
+
+ P > == pop roll> pop first >
+ P < == pop roll> pop first <
+ P == pop roll> pop first
+
+.. code:: ipython2
+
+ define('P == pop roll> pop first')
+
+.. code:: ipython2
+
+ J('["old_key" 23 [] []] 17 "new_key" ["..."] P')
+
+
+.. parsed-literal::
+
+ 'new_key' 'old_key'
+
+
+If the key we're adding is greater than the node's key.
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+Here the parentheses are meant to signify that the expression is not
+literal, the code in the parentheses is meant to have been evaluated:
+
+::
+
+ [key_n value_n left right] value key [Tree-add] T
+ -------------------------------------------------------
+ [key_n value_n left (Tree-add key value right)]
+
+So how do we do this? We're going to want to use ``infra`` on some
+function ``K`` that has the key and value to work with, as well as the
+quoted copy of ``Tree-add`` to apply somehow. Considering the node as a
+stack:
+
+::
+
+ right left value_n key_n value key [Tree-add] K
+ -----------------------------------------------------
+ right value key Tree-add left value_n key_n
+
+Pretty easy:
+
+::
+
+ right left value_n key_n value key [Tree-add] cons cons dipdd
+ right left value_n key_n [value key Tree-add] dipdd
+ right value key Tree-add left value_n key_n
+
+So:
+
+::
+
+ K == cons cons dipdd
+
+Looking at it from the point-of-view of the node as node again:
+
+::
+
+ [key_n value_n left right] [value key [Tree-add] K] infra
+
+Expand ``K`` and evaluate a little:
+
+::
+
+ [key_n value_n left right] [value key [Tree-add] K] infra
+ [key_n value_n left right] [value key [Tree-add] cons cons dipdd] infra
+ [key_n value_n left right] [[value key Tree-add] dipdd] infra
+
+Then, working backwards:
+
+::
+
+ [key_n value_n left right] [[value key Tree-add] dipdd] infra
+ [key_n value_n left right] [value key Tree-add] [dipdd] cons infra
+ [key_n value_n left right] value key [Tree-add] cons cons [dipdd] cons infra
+
+And so ``T`` is just:
+
+::
+
+ T == cons cons [dipdd] cons infra
+
+.. code:: ipython2
+
+ define('T == cons cons [dipdd] cons infra')
+
+.. code:: ipython2
+
+ J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] T')
+
+
+.. parsed-literal::
+
+ ['old_k' 'old_value' 'left' 'Tree-add' 'new_key' 'new_value' 'right']
+
+
+If the key we're adding is less than the node's key.
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+This is very very similar to the above:
+
+::
+
+ [key_n value_n left right] value key [Tree-add] E
+ [key_n value_n left right] value key [Tree-add] [P <] [Te] [Ee] ifte
+
+.. code:: ipython2
+
+ define('E == [P <] [Te] [Ee] ifte')
+
+In this case ``Te`` works that same as ``T`` but on the left child tree
+instead of the right, so the only difference is that it must use
+``dipd`` instead of ``dipdd``:
+
+::
+
+ Te == cons cons [dipd] cons infra
+
+.. code:: ipython2
+
+ define('Te == cons cons [dipd] cons infra')
+
+.. code:: ipython2
+
+ J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] Te')
+
+
+.. parsed-literal::
+
+ ['old_k' 'old_value' 'Tree-add' 'new_key' 'new_value' 'left' 'right']
+
+
+Else the keys must be equal.
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+This means we must find:
+
+::
+
+ [key old_value left right] new_value key [Tree-add] Ee
+ ------------------------------------------------------------
+ [key new_value left right]
+
+This is another easy one:
+
+::
+
+ Ee == pop swap roll< rest rest cons cons
+
+Example:
+
+::
+
+ [key old_value left right] new_value key [Tree-add] pop swap roll< rest rest cons cons
+ [key old_value left right] new_value key swap roll< rest rest cons cons
+ [key old_value left right] key new_value roll< rest rest cons cons
+ key new_value [key old_value left right] rest rest cons cons
+ key new_value [ left right] cons cons
+ [key new_value left right]
+
+.. code:: ipython2
+
+ define('Ee == pop swap roll< rest rest cons cons')
+
+.. code:: ipython2
+
+ J('["k" "old_value" "left" "right"] "new_value" "k" ["Tree-add"] Ee')
+
+
+.. parsed-literal::
+
+ ['k' 'new_value' 'left' 'right']
+
+
+Now we can define ``Tree-add``
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+::
+
+ Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec
+
+Putting it all together:
+
+::
+
+ Tree-new == swap [[] []] cons cons
+ P == pop roll> pop first
+ T == cons cons [dipdd] cons infra
+ Te == cons cons [dipd] cons infra
+ Ee == pop swap roll< rest rest cons cons
+ E == [P <] [Te] [Ee] ifte
+ R == [P >] [T] [E] ifte
+
+ Tree-add == [popop not] [[pop] dipd Tree-new] [] [R] genrec
+
+.. code:: ipython2
+
+ define('Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec')
+
+Examples
+^^^^^^^^
+
+.. code:: ipython2
+
+ J('[] 23 "b" Tree-add') # Initial
+
+
+.. parsed-literal::
+
+ ['b' 23 [] []]
+
+
+.. code:: ipython2
+
+ J('["b" 23 [] []] 88 "c" Tree-add') # Greater than
+
+
+.. parsed-literal::
+
+ ['b' 23 [] ['c' 88 [] []]]
+
+
+.. code:: ipython2
+
+ J('["b" 23 [] []] 88 "a" Tree-add') # Less than
+
+
+.. parsed-literal::
+
+ ['b' 23 ['a' 88 [] []] []]
+
+
+.. code:: ipython2
+
+ J('["b" 23 [] []] 88 "b" Tree-add') # Equal to
+
+
+.. parsed-literal::
+
+ ['b' 88 [] []]
+
+
+.. code:: ipython2
+
+ J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Series.
+
+
+.. parsed-literal::
+
+ ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
+
+
+.. code:: ipython2
+
+ J('[] [[23 "b"] [88 "a"] [44 "c"]] [i Tree-add] step')
+
+
+.. parsed-literal::
+
+ ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
+
+
+Interlude: ``cmp`` combinator
+-----------------------------
+
+Instead of mucking about with nested ``ifte`` combinators let's just go
+whole hog and define ``cmp`` which takes two values and three quoted
+programs on the stack and runs one of the three depending on the results
+of comparing the two values:
+
+::
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+
+.. code:: ipython2
+
+ from joy.library import FunctionWrapper
+ from joy.utils.stack import pushback
+ from notebook_preamble import D
+
+
+ @FunctionWrapper
+ def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
+ L, (E, (G, (b, (a, stack)))) = stack
+ expression = pushback(G if a > b else L if a < b else E, expression)
+ return stack, expression, dictionary
+
+
+ D['cmp'] = cmp_
+
+.. code:: ipython2
+
+ J("1 0 ['G'] ['E'] ['L'] cmp")
+
+
+.. parsed-literal::
+
+ 'G'
+
+
+.. code:: ipython2
+
+ J("1 1 ['G'] ['E'] ['L'] cmp")
+
+
+.. parsed-literal::
+
+ 'E'
+
+
+.. code:: ipython2
+
+ J("0 1 ['G'] ['E'] ['L'] cmp")
+
+
+.. parsed-literal::
+
+ 'L'
+
+
+Redefine ``Tree-add``
+~~~~~~~~~~~~~~~~~~~~~
+
+We need a new non-destructive predicate ``P``:
+
+::
+
+ [node_key node_value left right] value key [Tree-add] P
+ ------------------------------------------------------------------------
+ [node_key node_value left right] value key [Tree-add] key node_key
+
+Let's start with ``over`` to get a copy of the key and then apply some
+function ``Q`` with the ``nullary`` combinator so it can dig out the
+node key (by throwing everything else away):
+
+::
+
+ P == over [Q] nullary
+
+ [node_key node_value left right] value key [Tree-add] over [Q] nullary
+ [node_key node_value left right] value key [Tree-add] key [Q] nullary
+
+And ``Q`` would be:
+
+::
+
+ Q == popop popop first
+
+ [node_key node_value left right] value key [Tree-add] key Q
+ [node_key node_value left right] value key [Tree-add] key popop popop first
+ [node_key node_value left right] value key popop first
+ [node_key node_value left right] first
+ node_key
+
+Or just:
+
+::
+
+ P == over [popop popop first] nullary
+
+.. code:: ipython2
+
+ define('P == over [popop popop first] nullary')
+
+Using ``cmp`` to simplify `our code above at
+``R1`` <#Adding-to-a-non-empty-node.>`__:
+
+::
+
+ [node_key node_value left right] value key [Tree-add] R1
+ [node_key node_value left right] value key [Tree-add] P [T] [E] [Te] cmp
+
+The line above becomes one of the three lines below:
+
+::
+
+ [node_key node_value left right] value key [Tree-add] T
+ [node_key node_value left right] value key [Tree-add] E
+ [node_key node_value left right] value key [Tree-add] Te
+
+The definition is a little longer but, I think, more elegant and easier
+to understand:
+
+::
+
+ Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec
+
+.. code:: ipython2
+
+ define('Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec')
+
+.. code:: ipython2
+
+ J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Still works.
+
+
+.. parsed-literal::
+
+ ['b' 23 ['a' 88 [] []] ['c' 44 [] []]]
+
+
+A Function to Traverse this Structure
+-------------------------------------
+
+Let's take a crack at writing a function that can recursively iterate or
+traverse these trees.
+
+Base case ``[]``
+~~~~~~~~~~~~~~~~
+
+The stopping predicate just has to detect the empty list:
+
+::
+
+ Tree-iter == [not] [E] [R0] [R1] genrec
+
+And since there's nothing at this node, we just ``pop`` it:
+
+::
+
+ Tree-iter == [not] [pop] [R0] [R1] genrec
+
+Node case ``[key value left right]``
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Now we need to figure out ``R0`` and ``R1``:
+
+::
+
+ Tree-iter == [not] [pop] [R0] [R1] genrec
+ == [not] [pop] [R0 [Tree-iter] R1] ifte
+
+Let's look at it *in situ*:
+
+::
+
+ [key value left right] R0 [Tree-iter] R1
+
+Processing the current node.
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+``R0`` is almost certainly going to use ``dup`` to make a copy of the
+node and then ``dip`` on some function to process the copy with it:
+
+::
+
+ [key value left right] [F] dupdip [Tree-iter] R1
+ [key value left right] F [key value left right] [Tree-iter] R1
+
+For example, if we're getting all the keys ``F`` would be ``first``:
+
+::
+
+ R0 == [first] dupdip
+
+ [key value left right] [first] dupdip [Tree-iter] R1
+ [key value left right] first [key value left right] [Tree-iter] R1
+ key [key value left right] [Tree-iter] R1
+
+Recur
+~~~~~
+
+Now ``R1`` needs to apply ``[Tree-iter]`` to ``left`` and ``right``. If
+we drop the key and value from the node using ``rest`` twice we are left
+with an interesting situation:
+
+::
+
+ key [key value left right] [Tree-iter] R1
+ key [key value left right] [Tree-iter] [rest rest] dip
+ key [key value left right] rest rest [Tree-iter]
+ key [left right] [Tree-iter]
+
+Hmm, will ``step`` do?
+
+::
+
+ key [left right] [Tree-iter] step
+ key left Tree-iter [right] [Tree-iter] step
+ key left-keys [right] [Tree-iter] step
+ key left-keys right Tree-iter
+ key left-keys right-keys
+
+Neat. So:
+
+::
+
+ R1 == [rest rest] dip step
+
+Putting it together
+~~~~~~~~~~~~~~~~~~~
+
+We have:
+
+::
+
+ Tree-iter == [not] [pop] [[F] dupdip] [[rest rest] dip step] genrec
+
+When I was reading this over I realized ``rest rest`` could go in
+``R0``:
+
+::
+
+ Tree-iter == [not] [pop] [[F] dupdip rest rest] [step] genrec
+
+(And ``[step] genrec`` is such a cool and suggestive combinator!)
+
+Parameterizing the ``F`` per-node processing function.
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+::
+
+ [F] Tree-iter
+ ------------------------------------------------------
+ [not] [pop] [[F] dupdip rest rest] [step] genrec
+
+Working backward:
+
+::
+
+ [not] [pop] [[F] dupdip rest rest] [step] genrec
+ [not] [pop] [F] [dupdip rest rest] cons [step] genrec
+ [F] [not] [pop] roll< [dupdip rest rest] cons [step] genrec
+
+``Tree-iter``
+-------------
+
+::
+
+ Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec
+
+.. code:: ipython2
+
+ define('Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec')
+
+Examples
+^^^^^^^^
+
+.. code:: ipython2
+
+ J('[] [foo] Tree-iter') # It doesn't matter what F is as it won't be used.
+
+
+.. parsed-literal::
+
+
+
+
+.. code:: ipython2
+
+ J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [first] Tree-iter")
+
+
+.. parsed-literal::
+
+ 'b' 'a' 'c'
+
+
+.. code:: ipython2
+
+ J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [second] Tree-iter")
+
+
+.. parsed-literal::
+
+ 23 88 44
+
+
+Interlude: A Set-like Datastructure
+-----------------------------------
+
+We can use this to make a set-like datastructure by just setting values
+to e.g. 0 and ignoring them. It's set-like in that duplicate items added
+to it will only occur once within it, and we can query it in
+`:math:`O(\log_2 N)` `__
+time.
+
+.. code:: ipython2
+
+ J('[] [3 9 5 2 8 6 7 8 4] [0 swap Tree-add] step')
+
+
+.. parsed-literal::
+
+ [3 0 [2 0 [] []] [9 0 [5 0 [4 0 [] []] [8 0 [6 0 [] [7 0 [] []]] []]] []]]
+
+
+.. code:: ipython2
+
+ define('to_set == [] swap [0 swap Tree-add] step')
+
+.. code:: ipython2
+
+ J('[3 9 5 2 8 6 7 8 4] to_set')
+
+
+.. parsed-literal::
+
+ [3 0 [2 0 [] []] [9 0 [5 0 [4 0 [] []] [8 0 [6 0 [] [7 0 [] []]] []]] []]]
+
+
+And with that we can write a little program ``unique`` to remove
+duplicate items from a list.
+
+.. code:: ipython2
+
+ define('unique == [to_set [first] Tree-iter] cons run')
+
+.. code:: ipython2
+
+ J('[3 9 3 5 2 9 8 8 8 6 2 7 8 4 3] unique') # Filter duplicate items.
+
+
+.. parsed-literal::
+
+ [7 6 8 4 5 9 2 3]
+
+
+A Version of ``Tree-iter`` that does In-Order Traversal
+-------------------------------------------------------
+
+If you look back to the `non-empty case of the ``Tree-iter``
+function <#Node-case-%5Bkey-value-left-right%5D>`__ we can design a
+variant that first processes the left child, then the current node, then
+the right child. This will allow us to traverse the tree in sort order.
+
+::
+
+ Tree-iter-order == [not] [pop] [R0] [R1] genrec
+
+To define ``R0`` and ``R1`` it helps to look at them as they will appear
+when they run:
+
+::
+
+ [key value left right] R0 [BTree-iter-order] R1
+
+Process the left child.
+^^^^^^^^^^^^^^^^^^^^^^^
+
+Staring at this for a bit suggests ``dup third`` to start:
+
+::
+
+ [key value left right] R0 [Tree-iter-order] R1
+ [key value left right] dup third [Tree-iter-order] R1
+ [key value left right] left [Tree-iter-order] R1
+
+Now maybe:
+
+::
+
+ [key value left right] left [Tree-iter-order] [cons dip] dupdip
+ [key value left right] left [Tree-iter-order] cons dip [Tree-iter-order]
+ [key value left right] [left Tree-iter-order] dip [Tree-iter-order]
+ left Tree-iter-order [key value left right] [Tree-iter-order]
+
+Process the current node.
+^^^^^^^^^^^^^^^^^^^^^^^^^
+
+So far, so good. Now we need to process the current node's values:
+
+::
+
+ left Tree-iter-order [key value left right] [Tree-iter-order] [[F] dupdip] dip
+ left Tree-iter-order [key value left right] [F] dupdip [Tree-iter-order]
+ left Tree-iter-order [key value left right] F [key value left right] [Tree-iter-order]
+
+If ``F`` needs items from the stack below the left stuff it should have
+``cons``'d them before beginning maybe? For functions like ``first`` it
+works fine as-is.
+
+::
+
+ left Tree-iter-order [key value left right] first [key value left right] [Tree-iter-order]
+ left Tree-iter-order key [key value left right] [Tree-iter-order]
+
+Process the right child.
+^^^^^^^^^^^^^^^^^^^^^^^^
+
+First ditch the rest of the node and get the right child:
+
+::
+
+ left Tree-iter-order key [key value left right] [Tree-iter-order] [rest rest rest first] dip
+ left Tree-iter-order key right [Tree-iter-order]
+
+Then, of course, we just need ``i`` to run ``Tree-iter-order`` on the
+right side:
+
+::
+
+ left Tree-iter-order key right [Tree-iter-order] i
+ left Tree-iter-order key right Tree-iter-order
+
+Defining ``Tree-iter-order``
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+The result is a little awkward:
+
+::
+
+ R1 == [cons dip] dupdip [[F] dupdip] dip [rest rest rest first] dip i
+
+Let's do a little semantic factoring:
+
+::
+
+ fourth == rest rest rest first
+
+ proc_left == [cons dip] dupdip
+ proc_current == [[F] dupdip] dip
+ proc_right == [fourth] dip i
+
+ Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
+
+Now we can sort sequences.
+
+.. code:: ipython2
+
+ #define('Tree-iter-order == [not] [pop] [dup third] [[cons dip] dupdip [[first] dupdip] dip [rest rest rest first] dip i] genrec')
+
+
+ DefinitionWrapper.add_definitions('''
+
+ fourth == rest rest rest first
+
+ proc_left == [cons dip] dupdip
+ proc_current == [[first] dupdip] dip
+ proc_right == [fourth] dip i
+
+ Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
+
+ ''', D)
+
+
+
+
+.. code:: ipython2
+
+ J('[3 9 5 2 8 6 7 8 4] to_set Tree-iter-order')
+
+
+.. parsed-literal::
+
+ 2 3 4 5 6 7 8 9
+
+
+Parameterizing the ``[F]`` function is left as an exercise for the
+reader (for now.)
+
+Getting values by key
+---------------------
+
+Let's derive a function that accepts a tree and a key and returns the
+value associated with that key.
+
+::
+
+ tree key Tree-get
+ -----------------------
+ value
+
+But what do we do if the key isn't in the tree? In Python we might raise
+a ``KeyError`` but I'd like to avoid exceptions in Joy if possible, and
+here I think it's possible. (Division by zero is an example of where I
+think it's probably better to let Python crash Joy. Sometimes the
+machinery fails and you have to "stop the line", I think.)
+
+Let's pass the buck to the caller by making the base case a given, you
+have to decide for yourself what ``[E]`` should be.
+
+::
+
+ tree key [E] Tree-get
+ ---------------------------- key in tree
+ value
+
+ tree key [E] Tree-get
+ ---------------------------- key not in tree
+ [] key E
+
+The base case ``[]``
+^^^^^^^^^^^^^^^^^^^^
+
+As before, the stopping predicate just has to detect the empty list:
+
+::
+
+ Tree-get == [pop not] [E] [R0] [R1] genrec
+
+So we define:
+
+::
+
+ Tree-get == [pop not] swap [R0] [R1] genrec
+
+Note that this ``Tree-get`` creates a slightly different function than
+itself and *that function* does the actual recursion. This kind of
+higher-level programming is unusual in most languages but natural in
+Joy.
+
+::
+
+ tree key [E] [pop not] swap [R0] [R1] genrec
+ tree key [pop not] [E] [R0] [R1] genrec
+
+The anonymous specialized recursive function that will do the real work.
+
+::
+
+ [pop not] [E] [R0] [R1] genrec
+
+Node case ``[key value left right]``
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+Now we need to figure out ``R0`` and ``R1``:
+
+::
+
+ [key value left right] key R0 [BTree-get] R1
+
+We want to compare the search key with the key in the node, and if they
+are the same return the value, otherwise recur on one of the child
+nodes. So it's very similar to the above funtion, with ``[R0] == []``
+and ``R1 == P [T>] [E] [T<] cmp``:
+
+::
+
+ [key value left right] key [BTree-get] P [T>] [E] [T<] cmp
+
+Predicate:
+^^^^^^^^^^
+
+::
+
+ P == over [get-node-key] nullary
+ get-node-key == pop popop first
+
+The only difference is that ``get-node-key`` does one less ``pop``
+because there's no value to discard.
+
+Branches
+^^^^^^^^
+
+Now we have to derive the branches:
+
+::
+
+ [key_n value_n left right] key [BTree-get] T>
+ [key_n value_n left right] key [BTree-get] E
+ [key_n value_n left right] key [BTree-get] T<
+
+Greater than and less than
+^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+The cases of ``T>`` and ``T<`` are similar to above but instead of using
+``infra`` we have to discard the rest of the structure:
+
+::
+
+ [key_n value_n left right] key [BTree-get] T>
+ ---------------------------------------------------
+ right key BTree-get
+
+And:
+
+::
+
+ [key_n value_n left right] key [BTree-get] T<
+ ---------------------------------------------------
+ left key BTree-get
+
+So:
+
+::
+
+ T> == [fourth] dipd i
+ T< == [third] dipd i
+
+E.g.:
+
+::
+
+ [key_n value_n left right] key [BTree-get] [fourth] dipd i
+ [key_n value_n left right] fourth key [BTree-get] i
+ right key [BTree-get] i
+ right key BTree-get
+
+Equal keys
+^^^^^^^^^^
+
+Return the node's value:
+
+::
+
+ [key_n value_n left right] key [BTree-get] E == value_n
+
+ E == popop second
+
+``Tree-get``
+~~~~~~~~~~~~
+
+So:
+
+::
+
+ fourth == rest rest rest first
+ get-node-key == pop popop first
+ P == over [get-node-key] nullary
+ T> == [fourth] dipd i
+ T< == [third] dipd i
+ E == popop second
+
+ Tree-get == [pop not] swap [] [P [T>] [E] [T<] cmp] genrec
+
+.. code:: ipython2
+
+ # I don't want to deal with name conflicts with the above so I'm inlining everything here.
+ # The original Joy system has "hide" which is a meta-command which allows you to use named
+ # definitions that are only in scope for a given definition. I don't want to implement
+ # that (yet) so...
+
+
+ define('''
+ Tree-get == [pop not] swap [] [
+ over [pop popop first] nullary
+ [[fourth] dipd i]
+ [popop second]
+ [[third] dipd i]
+ cmp
+ ] genrec
+ ''')
+
+.. code:: ipython2
+
+ J('["gary" 23 [] []] "mike" [popd " not in tree" +] Tree-get')
+
+
+.. parsed-literal::
+
+ 'mike not in tree'
+
+
+.. code:: ipython2
+
+ J('["gary" 23 [] []] "gary" [popop "err"] Tree-get')
+
+
+.. parsed-literal::
+
+ 23
+
+
+.. code:: ipython2
+
+ J('''
+
+ [] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
+
+ 'c' [popop 'not found'] Tree-get
+
+ ''')
+
+
+.. parsed-literal::
+
+ 2
+
+
+.. code:: ipython2
+
+ J('''
+
+ [] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
+
+ 'd' [popop 'not found'] Tree-get
+
+ ''')
+
+
+.. parsed-literal::
+
+ 'not found'
+
+
+Tree-delete
+===========
+
+Now let's write a function that can return a tree datastructure with a
+key, value pair deleted:
+
+::
+
+ tree key Tree-delete
+ ---------------------------
+ tree
+
+If the key is not in tree it just returns the tree unchanged.
+
+Base case
+~~~~~~~~~
+
+Same as above.
+
+::
+
+ Tree-Delete == [pop not] [pop] [R0] [R1] genrec
+
+Recur
+~~~~~
+
+Now we get to figure out the recursive case. We need the node's key to
+compare and we need to carry the key into recursive branches. Let ``D``
+be shorthand for ``Tree-Delete``:
+
+::
+
+ D == Tree-Delete == [pop not] [pop] [R0] [R1] genrec
+
+ [node_key node_value left right] key R0 [D] R1
+ [node_key node_value left right] key over first swap dup [D] cons R1′
+ [node_key node_value left right] key [...] first swap dup [D] cons R1′
+ [node_key node_value left right] key node_key swap dup [D] cons R1′
+ [node_key node_value left right] node_key key dup [D] cons R1′
+ [node_key node_value left right] node_key key key [D] cons R1′
+ [node_key node_value left right] node_key key [key D] R1′
+
+And then:
+
+::
+
+ [node_key node_value left right] node_key key [key D] R1′
+ [node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+ [node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+ [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+So:
+
+::
+
+ R0 == over first swap dup
+ R1 == cons roll> [T>] [E] [T<] cmp
+
+Compare Keys
+~~~~~~~~~~~~
+
+The last line above:
+
+::
+
+ [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+Then becomes one of these three:
+
+::
+
+ [node_key node_value left right] [key D] T>
+ [node_key node_value left right] [key D] E
+ [node_key node_value left right] [key D] T<
+
+Greater than case and less than case
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+::
+
+ [node_key node_value left right] [F] T>
+ -------------------------------------------------
+ [node_key node_value (left F) right]
+
+
+ [node_key node_value left right] [F] T<
+ -------------------------------------------------
+ [node_key node_value left (right F)]
+
+First, treating the node as a stack:
+
+::
+
+ right left node_value node_key [key D] dipd
+ right left key D node_value node_key
+ right left' node_value node_key
+
+Ergo:
+
+::
+
+ [node_key node_value left right] [key D] [dipd] cons infra
+
+So:
+
+::
+
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+
+The else case
+~~~~~~~~~~~~~
+
+We have found the node in the tree where ``key`` equals ``node_key``. We
+need to replace the current node with something
+
+::
+
+ [node_key node_value left right] [key D] E
+ ------------------------------------------------
+ tree
+
+We have to handle three cases, so let's use ``cond``.
+
+.. code:: ipython2
+
+ from joy.library import FunctionWrapper, S_ifte
+
+
+ @FunctionWrapper
+ def cond(stack, expression, dictionary):
+ '''
+ like a case statement; works by rewriting into a chain of ifte.
+
+ [..[[Bi] Ti]..[D]] -> ...
+
+
+ [[[B0] T0] [[B1] T1] [D]] cond
+ -----------------------------------------
+ [B0] [T0] [[B1] [T1] [D] ifte] ifte
+
+ '''
+ conditions, stack = stack
+ if conditions:
+ expression = _cond(conditions, expression)
+ try:
+ # Attempt to preload the args to first ifte.
+ (P, (T, (E, expression))) = expression
+ except ValueError:
+ # If, for any reason, the argument to cond should happen to contain
+ # only the default clause then this optimization will fail.
+ pass
+ else:
+ stack = (E, (T, (P, stack)))
+ return stack, expression, dictionary
+
+
+ def _cond(conditions, expression):
+ (clause, rest) = conditions
+ if not rest: # clause is [D]
+ return clause
+ P, T = clause
+ return (P, (T, (_cond(rest, ()), (S_ifte, expression))))
+
+
+
+ D['cond'] = cond
+
+One or more child nodes are ``[]``
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+The first two cases are symmetrical: if we only have one non-empty child
+node return it. If both child nodes are empty return an empty node.
+
+::
+
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [default]
+ ] cond
+
+Both child nodes are non-empty.
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+If both child nodes are non-empty, we find the highest node in our lower
+sub-tree, take its key and value to replace (delete) our own, then get
+rid of it by recursively calling delete() on our lower sub-node with our
+new key.
+
+(We could also find the lowest node in our higher sub-tree and take its
+key and value and delete it. I only implemented one of these two
+symmetrical options. Over a lot of deletions this might make the tree
+more unbalanced. Oh well.)
+
+The initial structure of the default function:
+
+::
+
+ default == [E′] cons infra
+
+ [node_key node_value left right] [key D] default
+ [node_key node_value left right] [key D] [E′] cons infra
+ [node_key node_value left right] [[key D] E′] infra
+
+ right left node_value node_key [key D] E′
+
+First things first, we no longer need this node's key and value:
+
+::
+
+ right left node_value node_key [key D] roll> popop E″
+ right left [key D] node_value node_key popop E″
+ right left [key D] E″
+
+We have to we find the highest (right-most) node in our lower (left) sub-tree:
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+::
+
+ right left [key D] E″
+
+Ditch the key:
+
+::
+
+ right left [key D] rest E‴
+ right left [D] E‴
+
+Find the right-most node:
+
+::
+
+ right left [D] [dup W] dip E⁗
+ right left dup W [D] E⁗
+ right left left W [D] E⁗
+
+Consider:
+
+::
+
+ left W
+
+We know left is not empty:
+
+::
+
+ [L_key L_value L_left L_right] W
+
+We want to keep extracting the right node as long as it is not empty:
+
+::
+
+ W.rightmost == [P] [B] while
+
+ left W.rightmost W′
+
+The predicate:
+
+::
+
+ [L_key L_value L_left L_right] P
+ [L_key L_value L_left L_right] fourth
+ L_right
+
+This can run on ``[]`` so must be guarded:
+
+::
+
+ ?fourth == [] [fourth] [] ifte
+
+( if\_not\_empty == [] swap [] ifte ?fourth == [fourth] if\_not\_empty )
+
+The body is just ``fourth``:
+
+::
+
+ left [?fourth] [fourth] while W′
+ rightest W′
+
+So:
+
+::
+
+ W.rightmost == [?fourth] [fourth] while
+
+Found right-most node in our left sub-tree
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+We know rightest is not empty:
+
+::
+
+ [R_key R_value R_left R_right] W′
+ [R_key R_value R_left R_right] W′
+ [R_key R_value R_left R_right] uncons uncons pop
+ R_key [R_value R_left R_right] uncons pop
+ R_key R_value [R_left R_right] pop
+ R_key R_value
+
+So:
+
+::
+
+ W == [?fourth] [fourth] while uncons uncons pop
+
+And:
+
+::
+
+ right left left W [D] E⁗
+ right left R_key R_value [D] E⁗
+
+Replace current node key and value, recursively delete rightmost
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+Final stretch. We want to end up with something like:
+
+::
+
+ right left [R_key D] i R_value R_key
+ right left R_key D R_value R_key
+ right left′ R_value R_key
+
+If we adjust our definition of ``W`` to include ``over`` at the end:
+
+::
+
+ W == [fourth] [fourth] while uncons uncons pop over
+
+That will give us:
+
+::
+
+ right left R_key R_value R_key [D] E⁗
+
+ right left R_key R_value R_key [D] cons dipd E⁗′
+ right left R_key R_value [R_key D] dipd E⁗′
+ right left R_key D R_key R_value E⁗′
+ right left′ R_key R_value E⁗′
+ right left′ R_key R_value swap
+ right left′ R_value R_key
+
+So:
+
+::
+
+ E′ == roll> popop E″
+
+ E″ == rest E‴
+
+ E‴ == [dup W] dip E⁗
+
+ E⁗ == cons dipdd swap
+
+Substituting:
+
+::
+
+ W == [fourth] [fourth] while uncons uncons pop over
+ E′ == roll> popop rest [dup W] dip cons dipd swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E′] cons infra]
+ ] cond
+
+Minor rearrangement:
+
+::
+
+ W == dup [fourth] [fourth] while uncons uncons pop over
+ E′ == roll> popop rest [W] dip cons dipd swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E′] cons infra]
+ ] cond
+
+Refactoring
+~~~~~~~~~~~
+
+::
+
+ W.rightmost == [fourth] [fourth] while
+ W.unpack == uncons uncons pop
+ E.clear_stuff == roll> popop rest
+ E.delete == cons dipd
+ W == dup W.rightmost W.unpack over
+ E.0 == E.clear_stuff [W] dip E.delete swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E.0] cons infra]
+ ] cond
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+ R0 == over first swap dup
+ R1 == cons roll> [T>] [E] [T<] cmp
+ BTree-Delete == [pop not] swap [R0] [R1] genrec
+
+By the standards of the code I've written so far, this is a *huge* Joy
+program.
+
+.. code:: ipython2
+
+ DefinitionWrapper.add_definitions('''
+ first_two == uncons uncons pop
+ fourth == rest rest rest first
+ ?fourth == [] [fourth] [] ifte
+ W.rightmost == [?fourth] [fourth] while
+ E.clear_stuff == roll> popop rest
+ E.delete == cons dipd
+ W == dup W.rightmost first_two over
+ E.0 == E.clear_stuff [W] dip E.delete swap
+ E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[E.0] cons infra]] cond
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+ R0 == over first swap dup
+ R1 == cons roll> [T>] [E] [T<] cmp
+ Tree-Delete == [pop not] [pop] [R0] [R1] genrec''', D)
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'c' Tree-Delete ")
+
+
+.. parsed-literal::
+
+ ['a' 23 [] ['b' 88 [] []]]
+
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'b' Tree-Delete ")
+
+
+.. parsed-literal::
+
+ ['a' 23 [] ['c' 44 [] []]]
+
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'a' Tree-Delete ")
+
+
+.. parsed-literal::
+
+ ['b' 88 [] ['c' 44 [] []]]
+
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' Tree-Delete ")
+
+
+.. parsed-literal::
+
+ ['a' 23 [] ['b' 88 [] ['c' 44 [] []]]]
+
+
+.. code:: ipython2
+
+ J('[] [4 2 3 1 6 7 5 ] [0 swap Tree-add] step')
+
+
+.. parsed-literal::
+
+ [4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]]
+
+
+.. code:: ipython2
+
+ J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 3 Tree-Delete ")
+
+
+.. parsed-literal::
+
+ [4 0 [2 0 [1 0 [] []] []] [6 0 [5 0 [] []] [7 0 [] []]]]
+
+
+.. code:: ipython2
+
+ J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 4 Tree-Delete ")
+
+
+.. parsed-literal::
+
+ [3 0 [2 0 [1 0 [] []] []] [6 0 [5 0 [] []] [7 0 [] []]]]
+
+
+Appendix: The source code.
+--------------------------
+
+::
+
+ fourth == rest_two rest first
+ ?fourth == [] [fourth] [] ifte
+ first_two == uncons uncons pop
+ ccons == cons cons
+ cinf == cons infra
+ rest_two == rest rest
+
+ _Tree_T> == [dipd] cinf
+ _Tree_T< == [dipdd] cinf
+
+ _Tree_add_P == over [popop popop first] nullary
+ _Tree_add_T> == ccons _Tree_T<
+ _Tree_add_T< == ccons _Tree_T>
+ _Tree_add_Ee == pop swap roll< rest_two ccons
+ _Tree_add_R == _Tree_add_P [_Tree_add_T>] [_Tree_add_Ee] [_Tree_add_T<] cmp
+ _Tree_add_E == [pop] dipd Tree-new
+
+ _Tree_iter_order_left == [cons dip] dupdip
+ _Tree_iter_order_current == [[F] dupdip] dip
+ _Tree_iter_order_right == [fourth] dip i
+ _Tree_iter_order_R == _Tree_iter_order_left _Tree_iter_order_current _Tree_iter_order_right
+
+ _Tree_get_P == over [pop popop first] nullary
+ _Tree_get_T> == [fourth] dipd i
+ _Tree_get_T< == [third] dipd i
+ _Tree_get_E == popop second
+ _Tree_get_R == _Tree_get_P [_Tree_get_T>] [_Tree_get_E] [_Tree_get_T<] cmp
+
+ _Tree_delete_rightmost == [?fourth] [fourth] while
+ _Tree_delete_clear_stuff == roll> popop rest
+ _Tree_delete_del == dip cons dipd swap
+ _Tree_delete_W == dup _Tree_delete_rightmost first_two over
+ _Tree_delete_E.0 == _Tree_delete_clear_stuff [_Tree_delete_W] _Tree_delete_del
+ _Tree_delete_E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[_Tree_delete_E.0] cinf]] cond
+ _Tree_delete_R0 == over first swap dup
+ _Tree_delete_R1 == cons roll> [_Tree_T>] [_Tree_delete_E] [_Tree_T<] cmp
+
+ Tree-new == swap [[] []] ccons
+ Tree-add == [popop not] [_Tree_add_E] [] [_Tree_add_R] genrec
+ Tree-iter == [not] [pop] roll< [dupdip rest_two] cons [step] genrec
+ Tree-iter-order == [not] [pop] [dup third] [_Tree_iter_order_R] genrec
+ Tree-get == [pop not] swap [] [_Tree_get_R] genrec
+ Tree-delete == [pop not] [pop] [_Tree_delete_R0] [_Tree_delete_R1] genrec
diff --git a/docs/Trees.html b/docs/Trees.html
index a9614c3..2e6ba94 100644
--- a/docs/Trees.html
+++ b/docs/Trees.html
@@ -11920,10 +11920,10 @@ key left-keys right-keys
-In [1]:
+In [6]:
-from notebook_preamble import J, V, define
+from notebook_preamble import D, J, V, define, DefinitionWrapper
@@ -13008,7 +13008,7 @@ E == pop swap roll< rest rest cons cons
-In [30]:
+In [11]:
from joy.library import FunctionWrapper
@@ -13018,6 +13018,22 @@ E == pop swap roll< rest rest cons cons
@FunctionWrapper
def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
L, (E, (G, (b, (a, stack)))) = stack
expression = pushback(G if a > b else L if a < b else E, expression)
return stack, expression, dictionary
@@ -13030,6 +13046,59 @@ E == pop swap roll< rest rest cons cons
+
+
+
+In [14]:
+
+
+from joy.library import FunctionWrapper, S_ifte
+
+
+@FunctionWrapper
+def cond(stack, expression, dictionary):
+ '''
+ like a case statement; works by rewriting into a chain of ifte.
+
+ [..[[Bi] Ti]..[D]] -> ...
+
+
+ [[[B0] T0] [[B1] T1] [D]] cond
+ -----------------------------------------
+ [B0] [T0] [[B1] [T1] [D] ifte] ifte
+
+ '''
+ conditions, stack = stack
+ if conditions:
+ expression = _cond(conditions, expression)
+ try:
+ # Attempt to preload the args to first ifte.
+ (P, (T, (E, expression))) = expression
+ except ValueError:
+ # If, for any reason, the argument to cond should happen to contain
+ # only the default clause then this optimization will fail.
+ pass
+ else:
+ stack = (E, (T, (P, stack)))
+ return stack, expression, dictionary
+
+
+def _cond(conditions, expression):
+ (clause, rest) = conditions
+ if not rest: # clause is [D]
+ return clause
+ P, T = clause
+ return (P, (T, (_cond(rest, ()), (S_ifte, expression))))
+
+
+
+D['cond'] = cond
+
+
+
+
+
+
@@ -13726,15 +13795,15 @@ BTree-get == [pop not] swap [] [P [T>] [E] [T<] cmp] genrec
-TODO: BTree-delete¶
Then, once we have add, get, and delete we can see about abstracting them.
+BTree-delete¶
Now let's write a function that can return a tree datastructure with a key, value pair deleted:
- tree key [E] BTree-delete
----------------------------- key in tree
+ tree key BTree-delete
+---------------------------
tree
- tree key [E] BTree-delete
----------------------------- key not in tree
- tree key E
+
+
+If the key is not in tree it just returns the tree unchanged.
@@ -13745,18 +13814,7 @@ BTree-get == [pop not] swap [] [P [T>] [E] [T<] cmp] genrec
So:
-BTree-delete == [pop not] [] [R0] [R1] genrec
-
-
-And:
-
-[n_key n_value left right] key R0 [BTree-get] R1
-[n_key n_value left right] key [dup first] dip [BTree-get] R1
-[n_key n_value left right] n_key key [BTree-get] R1
-[n_key n_value left right] n_key key [BTree-get] roll> [T>] [E] [T<] cmp
-[n_key n_value left right] [BTree-get] n_key key [T>] [E] [T<] cmp
-
-BTree-delete == [pop not] swap [[dup first] dip] [roll> [T>] [E] [T<] cmp] genrec
+BTree-Delete == [pop not] swap [R0] [R1] genrec
@@ -13766,9 +13824,9 @@ BTree-delete == [pop not] swap [[dup first] dip] [roll> [T>] [E] [T<] c
-[n_key n_value left right] [BTree-get] T>
-[n_key n_value left right] [BTree-get] E
-[n_key n_value left right] [BTree-get] T<
+ [Er] BTree-delete
+-------------------------------------
+ [pop not] [Er] [R0] [R1] genrec
@@ -13782,6 +13840,633 @@ BTree-delete == [pop not] swap [[dup first] dip] [roll> [T>] [E] [T<] c
[n_key n_value left right] [BTree-get] E
[n_key n_value left right] [BTree-get] T<
+
+
+
+
+
+
+
+Now we get to figure out the recursive case:
+
+w/ D == [pop not] [Er] [R0] [R1] genrec
+
+[node_key node_value left right] key R0 [D] R1
+[node_key node_value left right] key over first swap dup [D] R1
+[node_key node_value left right] node_key key key [D] R1
+
+
+And then:
+
+[node_key node_value left right] node_key key key [D] R1
+[node_key node_value left right] node_key key key [D] cons roll> [T>] [E] [T<] cmp
+[node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+[node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+
+
+
+
+
+
+
+Now this:;
+
+[node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+
+Becomes one of these three:;
+
+[node_key node_value left right] [key D] T>
+[node_key node_value left right] [key D] E
+[node_key node_value left right] [key D] T<
+
+
+
+
+
+
+
+
+Greater than case and less than case¶
+ [node_key node_value left right] [key D] T>
+-------------------------------------------------
+ [node_key node_value left key D right]
+
+
+
+
+
+
+
+
+First:
+
+right left node_value node_key [key D] dipd
+right left key D node_value node_key
+right left' node_value node_key
+
+
+
+
+
+
+
+
+Ergo:
+
+[node_key node_value left right] [key D] [dipd] cons infra
+
+
+
+
+
+
+
+
+So:
+
+T> == [dipd] cons infra
+T< == [dipdd] cons infra
+
+
+
+
+
+
+
+
+The else case¶
+[node_key node_value left right] [key D] E
+
+
+We have to handle three cases, so let's use cond.
+
+
+
+
+
+
+
+
+The first two cases are symmetrical, if we only have one non-empty child node return it.
+
+E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [default]
+] cond
+
+
+
+
+
+
+
+
+(If both child nodes are empty return an empty node.)
+
+
+
+
+
+
+
+
+The initial structure of the default function:
+
+default == [E'] cons infra
+
+[node_key node_value left right] [key D] default
+[node_key node_value left right] [key D] [E'] cons infra
+[node_key node_value left right] [[key D] E'] infra
+
+right left node_value node_key [key D] E'
+
+
+
+
+
+
+
+
+If both child nodes are non-empty, we find the highest node in our lower sub-tree, take its key and value to replace (delete) our own, then get rid of it by recursively calling delete() on our lower sub-node with our new key.
+(We could also find the lowest node in our higher sub-tree and take its key and value and delete it. I only implemented one of these two symmetrical options. Over a lot of deletions this might make the tree more unbalanced. Oh well.)
+
+
+
+
+
+
+
+
+First things first, we no longer need this node's key and value:
+
+right left node_value node_key [key D] roll> popop E''
+right left [key D] node_value node_key popop E''
+right left [key D] E''
+
+
+
+
+
+
+
+
+Then we have to we find the highest (right-most) node in our lower (left) sub-tree:
+
+right left [key D] E''
+
+
+
+
+
+
+
+
+Ditch the key:
+
+right left [key D] rest E'''
+right left [D] E'''
+
+
+
+
+
+
+
+
+Find the right-most node:
+
+right left [D] [dup W] dip E''''
+right left dup W [D] E''''
+right left left W [D] E''''
+
+
+
+
+
+
+
+
+Consider:
+
+left W
+
+
+
+
+
+
+
+
+We know left is not empty:
+
+[L_key L_value L_left L_right] W
+
+
+
+
+
+
+
+
+We want to keep extracting the right node as long as it is not empty:
+
+left [P] [B] while W'
+
+
+
+
+
+
+
+
+The predicate:
+
+[L_key L_value L_left L_right] P
+[L_key L_value L_left L_right] fourth
+ L_right
+
+
+(This has a bug, can run on [] so must be guarded:
+
+if_not_empty == [] swap [] ifte
+?fourth == [fourth] if_not_empty
+W.rightmost == [?fourth] [fourth] while
+
+
+
+
+
+
+
+
+The body is also fourth:
+
+left [fourth] [fourth] while W'
+rightest W'
+
+
+
+
+
+
+
+
+We know rightest is not empty:
+
+[R_key R_value R_left R_right] W'
+[R_key R_value R_left R_right] uncons uncons pop
+R_key [R_value R_left R_right] uncons pop
+R_key R_value [R_left R_right] pop
+R_key R_value
+
+
+
+
+
+
+
+
+So:
+
+W == [fourth] [fourth] while uncons uncons pop
+
+
+
+
+
+
+
+
+And:
+
+right left left W [D] E''''
+right left R_key R_value [D] E''''
+
+
+
+
+
+
+
+
+Final stretch. We want to end up with something like:
+
+right left [R_key D] i R_value R_key
+right left R_key D R_value R_key
+right left' R_value R_key
+
+
+
+
+
+
+
+
+If we adjust our definition of W to include over at the end:
+
+W == [fourth] [fourth] while uncons uncons pop over
+
+
+
+
+
+
+
+
+That will give us:
+
+right left R_key R_value R_key [D] E''''
+
+right left R_key R_value R_key [D] cons dipdd E'''''
+right left R_key R_value [R_key D] dipdd E'''''
+right left R_key D R_key R_value E'''''
+right left' R_key R_value E'''''
+right left' R_key R_value swap
+right left' R_value R_key
+
+
+
+
+
+
+
+
+So:
+
+E' == roll> popop E''
+
+E'' == rest E'''
+
+E''' == [dup W] dip E''''
+
+E'''' == cons dipdd swap
+
+
+
+
+
+
+
+
+Substituting:
+
+W == [fourth] [fourth] while uncons uncons pop over
+E' == roll> popop rest [dup W] dip cons dipdd swap
+E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E'] cons infra]
+] cond
+
+
+
+
+
+
+
+
+Minor rearrangement:
+
+W == dup [fourth] [fourth] while uncons uncons pop over
+E' == roll> popop rest [W] dip cons dipdd swap
+E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E'] cons infra]
+] cond
+
+
+
+
+
+
+
+
+Refactoring¶
+W.rightmost == [fourth] [fourth] while
+W.unpack == uncons uncons pop
+E.clear_stuff == roll> popop rest
+E.delete == cons dipdd
+W == dup W.rightmost W.unpack over
+E.0 == E.clear_stuff [W] dip E.delete swap
+E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E.0] cons infra]
+] cond
+T> == [dipd] cons infra
+T< == [dipdd] cons infra
+R0 == over first swap dup
+R1 == cons roll> [T>] [E] [T<] cmp
+BTree-Delete == [pop not] swap [R0] [R1] genrec
+
+
+By the standards of the code I've written so far, this is a huge Joy program.
+
+
+
+
+
+
+In [20]:
+
+
+DefinitionWrapper.add_definitions('''
+first_two == uncons uncons pop
+fourth == rest rest rest first
+?fourth == [] [fourth] [] ifte
+W.rightmost == [?fourth] [fourth] while
+E.clear_stuff == roll> popop rest
+E.delete == cons dipdd
+W == dup W.rightmost first_two over
+E.0 == E.clear_stuff [W] dip E.delete swap
+E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[E.0] cons infra]] cond
+T> == [dipd] cons infra
+T< == [dipdd] cons infra
+R0 == over first swap dup
+R1 == cons roll> [T>] [E] [T<] cmp
+BTree-Delete == [pop not] swap [R0] [R1] genrec''', D)
+
+
+
+
+
+
+
+
+
+In [23]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'c' ['Er'] BTree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [24]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'b' ['Er'] BTree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [25]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'a' ['Er'] BTree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [26]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' ['Er'] BTree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [30]:
+
+
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' [pop] BTree-Delete ")
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+One bug, I forgot to put not in the first two clauses of the cond.
+The behavior of the [Er] function should maybe be different: either just silently fail, or maybe implement some sort of function that can grab the pending expression up to a sentinel value or something, allowing for a kind of "except"-ish control-flow?
+
+
+
+
+
+
+
+
+Then, once we have add, get, and delete we can see about abstracting them.
+
diff --git a/docs/Trees.md b/docs/Trees.md
index 6afde40..90abf29 100644
--- a/docs/Trees.md
+++ b/docs/Trees.md
@@ -92,7 +92,7 @@ Ergo:
```python
-from notebook_preamble import J, V, define
+from notebook_preamble import D, J, V, define, DefinitionWrapper
```
@@ -590,6 +590,22 @@ from notebook_preamble import D
@FunctionWrapper
def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
L, (E, (G, (b, (a, stack)))) = stack
expression = pushback(G if a > b else L if a < b else E, expression)
return stack, expression, dictionary
@@ -599,6 +615,51 @@ D['cmp'] = cmp_
```
+```python
+from joy.library import FunctionWrapper, S_ifte
+
+
+@FunctionWrapper
+def cond(stack, expression, dictionary):
+ '''
+ like a case statement; works by rewriting into a chain of ifte.
+
+ [..[[Bi] Ti]..[D]] -> ...
+
+
+ [[[B0] T0] [[B1] T1] [D]] cond
+ -----------------------------------------
+ [B0] [T0] [[B1] [T1] [D] ifte] ifte
+
+ '''
+ conditions, stack = stack
+ if conditions:
+ expression = _cond(conditions, expression)
+ try:
+ # Attempt to preload the args to first ifte.
+ (P, (T, (E, expression))) = expression
+ except ValueError:
+ # If, for any reason, the argument to cond should happen to contain
+ # only the default clause then this optimization will fail.
+ pass
+ else:
+ stack = (E, (T, (P, stack)))
+ return stack, expression, dictionary
+
+
+def _cond(conditions, expression):
+ (clause, rest) = conditions
+ if not rest: # clause is [D]
+ return clause
+ P, T = clause
+ return (P, (T, (_cond(rest, ()), (S_ifte, expression))))
+
+
+
+D['cond'] = cond
+```
+
+
```python
J("1 0 ['G'] ['E'] ['L'] cmp")
```
@@ -913,40 +974,311 @@ J('''
2
-# TODO: BTree-delete
+# BTree-delete
-Then, once we have add, get, and delete we can see about abstracting them.
+Now let's write a function that can return a tree datastructure with a key, value pair deleted:
- tree key [E] BTree-delete
- ---------------------------- key in tree
+ tree key BTree-delete
+ ---------------------------
tree
- tree key [E] BTree-delete
- ---------------------------- key not in tree
- tree key E
+
+If the key is not in tree it just returns the tree unchanged.
So:
- BTree-delete == [pop not] [] [R0] [R1] genrec
+ BTree-Delete == [pop not] swap [R0] [R1] genrec
-And:
- [n_key n_value left right] key R0 [BTree-get] R1
- [n_key n_value left right] key [dup first] dip [BTree-get] R1
- [n_key n_value left right] n_key key [BTree-get] R1
- [n_key n_value left right] n_key key [BTree-get] roll> [T>] [E] [T<] cmp
- [n_key n_value left right] [BTree-get] n_key key [T>] [E] [T<] cmp
-
- BTree-delete == [pop not] swap [[dup first] dip] [roll> [T>] [E] [T<] cmp] genrec
-
- [n_key n_value left right] [BTree-get] T>
- [n_key n_value left right] [BTree-get] E
- [n_key n_value left right] [BTree-get] T<
+ [Er] BTree-delete
+ -------------------------------------
+ [pop not] [Er] [R0] [R1] genrec
[n_key n_value left right] [BTree-get]
[n_key n_value left right] [BTree-get] E
[n_key n_value left right] [BTree-get] T<
+Now we get to figure out the recursive case:
+
+ w/ D == [pop not] [Er] [R0] [R1] genrec
+
+ [node_key node_value left right] key R0 [D] R1
+ [node_key node_value left right] key over first swap dup [D] R1
+ [node_key node_value left right] node_key key key [D] R1
+
+And then:
+
+ [node_key node_value left right] node_key key key [D] R1
+ [node_key node_value left right] node_key key key [D] cons roll> [T>] [E] [T<] cmp
+ [node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+ [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+Now this:;
+
+ [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+Becomes one of these three:;
+
+ [node_key node_value left right] [key D] T>
+ [node_key node_value left right] [key D] E
+ [node_key node_value left right] [key D] T<
+
+### Greater than case and less than case
+
+ [node_key node_value left right] [key D] T>
+ -------------------------------------------------
+ [node_key node_value left key D right]
+
+First:
+
+ right left node_value node_key [key D] dipd
+ right left key D node_value node_key
+ right left' node_value node_key
+
+Ergo:
+
+ [node_key node_value left right] [key D] [dipd] cons infra
+
+So:
+
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+
+### The else case
+
+ [node_key node_value left right] [key D] E
+
+We have to handle three cases, so let's use `cond`.
+
+The first two cases are symmetrical, if we only have one non-empty child node return it.
+
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [default]
+ ] cond
+
+(If both child nodes are empty return an empty node.)
+
+The initial structure of the default function:
+
+ default == [E'] cons infra
+
+ [node_key node_value left right] [key D] default
+ [node_key node_value left right] [key D] [E'] cons infra
+ [node_key node_value left right] [[key D] E'] infra
+
+ right left node_value node_key [key D] E'
+
+If both child nodes are non-empty, we find the highest node in our lower sub-tree, take its key and value to replace (delete) our own, then get rid of it by recursively calling delete() on our lower sub-node with our new key.
+
+(We could also find the lowest node in our higher sub-tree and take its key and value and delete it. I only implemented one of these two symmetrical options. Over a lot of deletions this might make the tree more unbalanced. Oh well.)
+
+First things first, we no longer need this node's key and value:
+
+ right left node_value node_key [key D] roll> popop E''
+ right left [key D] node_value node_key popop E''
+ right left [key D] E''
+
+Then we have to we find the highest (right-most) node in our lower (left) sub-tree:
+
+ right left [key D] E''
+
+Ditch the key:
+
+ right left [key D] rest E'''
+ right left [D] E'''
+
+Find the right-most node:
+
+ right left [D] [dup W] dip E''''
+ right left dup W [D] E''''
+ right left left W [D] E''''
+
+Consider:
+
+ left W
+
+We know left is not empty:
+
+ [L_key L_value L_left L_right] W
+
+We want to keep extracting the right node as long as it is not empty:
+
+ left [P] [B] while W'
+
+The predicate:
+
+ [L_key L_value L_left L_right] P
+ [L_key L_value L_left L_right] fourth
+ L_right
+
+(This has a bug, can run on `[]` so must be guarded:
+
+ if_not_empty == [] swap [] ifte
+ ?fourth == [fourth] if_not_empty
+ W.rightmost == [?fourth] [fourth] while
+
+The body is also `fourth`:
+
+ left [fourth] [fourth] while W'
+ rightest W'
+
+We know rightest is not empty:
+
+ [R_key R_value R_left R_right] W'
+ [R_key R_value R_left R_right] uncons uncons pop
+ R_key [R_value R_left R_right] uncons pop
+ R_key R_value [R_left R_right] pop
+ R_key R_value
+
+So:
+
+ W == [fourth] [fourth] while uncons uncons pop
+
+And:
+
+ right left left W [D] E''''
+ right left R_key R_value [D] E''''
+
+Final stretch. We want to end up with something like:
+
+ right left [R_key D] i R_value R_key
+ right left R_key D R_value R_key
+ right left' R_value R_key
+
+If we adjust our definition of `W` to include `over` at the end:
+
+ W == [fourth] [fourth] while uncons uncons pop over
+
+That will give us:
+
+ right left R_key R_value R_key [D] E''''
+
+ right left R_key R_value R_key [D] cons dipdd E'''''
+ right left R_key R_value [R_key D] dipdd E'''''
+ right left R_key D R_key R_value E'''''
+ right left' R_key R_value E'''''
+ right left' R_key R_value swap
+ right left' R_value R_key
+
+So:
+
+ E' == roll> popop E''
+
+ E'' == rest E'''
+
+ E''' == [dup W] dip E''''
+
+ E'''' == cons dipdd swap
+
+Substituting:
+
+ W == [fourth] [fourth] while uncons uncons pop over
+ E' == roll> popop rest [dup W] dip cons dipdd swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E'] cons infra]
+ ] cond
+
+Minor rearrangement:
+
+ W == dup [fourth] [fourth] while uncons uncons pop over
+ E' == roll> popop rest [W] dip cons dipdd swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E'] cons infra]
+ ] cond
+
+### Refactoring
+
+ W.rightmost == [fourth] [fourth] while
+ W.unpack == uncons uncons pop
+ E.clear_stuff == roll> popop rest
+ E.delete == cons dipdd
+ W == dup W.rightmost W.unpack over
+ E.0 == E.clear_stuff [W] dip E.delete swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E.0] cons infra]
+ ] cond
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+ R0 == over first swap dup
+ R1 == cons roll> [T>] [E] [T<] cmp
+ BTree-Delete == [pop not] swap [R0] [R1] genrec
+
+By the standards of the code I've written so far, this is a *huge* Joy program.
+
+
+```python
+DefinitionWrapper.add_definitions('''
+first_two == uncons uncons pop
+fourth == rest rest rest first
+?fourth == [] [fourth] [] ifte
+W.rightmost == [?fourth] [fourth] while
+E.clear_stuff == roll> popop rest
+E.delete == cons dipdd
+W == dup W.rightmost first_two over
+E.0 == E.clear_stuff [W] dip E.delete swap
+E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[E.0] cons infra]] cond
+T> == [dipd] cons infra
+T< == [dipdd] cons infra
+R0 == over first swap dup
+R1 == cons roll> [T>] [E] [T<] cmp
+BTree-Delete == [pop not] swap [R0] [R1] genrec''', D)
+```
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'c' ['Er'] BTree-Delete ")
+```
+
+ ['a' 23 [] ['b' 88 [] []]]
+
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'b' ['Er'] BTree-Delete ")
+```
+
+ ['a' 23 [] ['c' 44 [] []]]
+
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'a' ['Er'] BTree-Delete ")
+```
+
+ ['b' 88 [] ['c' 44 [] []]]
+
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' ['Er'] BTree-Delete ")
+```
+
+ ['a' 23 [] ['b' 88 [] ['c' 44 [] 'Er' 'der' []]]]
+
+
+
+```python
+J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' [pop] BTree-Delete ")
+```
+
+ ['a' 23 [] ['b' 88 [] ['c' 44 [] []]]]
+
+
+One bug, I forgot to put `not` in the first two clauses of the `cond`.
+
+The behavior of the `[Er]` function should maybe be different: either just silently fail, or maybe implement some sort of function that can grab the pending expression up to a sentinel value or something, allowing for a kind of "except"-ish control-flow?
+
+Then, once we have add, get, and delete we can see about abstracting them.
+
+
# Tree with node and list of trees.
Let's consider a tree structure, similar to one described ["Why functional programming matters" by John Hughes](https://www.cs.kent.ac.uk/people/staff/dat/miranda/whyfp90.pdf), that consists of a node value and a sequence of zero or more child trees. (The asterisk is meant to indicate the [Kleene star](https://en.wikipedia.org/wiki/Kleene_star).)
diff --git a/docs/Trees.rst b/docs/Trees.rst
index 06bd719..edd773f 100644
--- a/docs/Trees.rst
+++ b/docs/Trees.rst
@@ -149,7 +149,7 @@ Ergo:
.. code:: ipython2
- from notebook_preamble import J, V, define
+ from notebook_preamble import D, J, V, define, DefinitionWrapper
.. code:: ipython2
@@ -774,6 +774,22 @@ to understand:
@FunctionWrapper
def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
L, (E, (G, (b, (a, stack)))) = stack
expression = pushback(G if a > b else L if a < b else E, expression)
return stack, expression, dictionary
@@ -781,6 +797,50 @@ to understand:
D['cmp'] = cmp_
+.. code:: ipython2
+
+ from joy.library import FunctionWrapper, S_ifte
+
+
+ @FunctionWrapper
+ def cond(stack, expression, dictionary):
+ '''
+ like a case statement; works by rewriting into a chain of ifte.
+
+ [..[[Bi] Ti]..[D]] -> ...
+
+
+ [[[B0] T0] [[B1] T1] [D]] cond
+ -----------------------------------------
+ [B0] [T0] [[B1] [T1] [D] ifte] ifte
+
+ '''
+ conditions, stack = stack
+ if conditions:
+ expression = _cond(conditions, expression)
+ try:
+ # Attempt to preload the args to first ifte.
+ (P, (T, (E, expression))) = expression
+ except ValueError:
+ # If, for any reason, the argument to cond should happen to contain
+ # only the default clause then this optimization will fail.
+ pass
+ else:
+ stack = (E, (T, (P, stack)))
+ return stack, expression, dictionary
+
+
+ def _cond(conditions, expression):
+ (clause, rest) = conditions
+ if not rest: # clause is [D]
+ return clause
+ P, T = clause
+ return (P, (T, (_cond(rest, ()), (S_ifte, expression))))
+
+
+
+ D['cond'] = cond
+
.. code:: ipython2
J("1 0 ['G'] ['E'] ['L'] cmp")
@@ -1207,45 +1267,31 @@ So:
2
-TODO: BTree-delete
-==================
+BTree-delete
+============
-Then, once we have add, get, and delete we can see about abstracting
-them.
+Now let's write a function that can return a tree datastructure with a
+key, value pair deleted:
::
- tree key [E] BTree-delete
- ---------------------------- key in tree
+ tree key BTree-delete
+ ---------------------------
tree
- tree key [E] BTree-delete
- ---------------------------- key not in tree
- tree key E
+If the key is not in tree it just returns the tree unchanged.
So:
::
- BTree-delete == [pop not] [] [R0] [R1] genrec
-
-And:
+ BTree-Delete == [pop not] swap [R0] [R1] genrec
::
- [n_key n_value left right] key R0 [BTree-get] R1
- [n_key n_value left right] key [dup first] dip [BTree-get] R1
- [n_key n_value left right] n_key key [BTree-get] R1
- [n_key n_value left right] n_key key [BTree-get] roll> [T>] [E] [T<] cmp
- [n_key n_value left right] [BTree-get] n_key key [T>] [E] [T<] cmp
-
- BTree-delete == [pop not] swap [[dup first] dip] [roll> [T>] [E] [T<] cmp] genrec
-
-::
-
- [n_key n_value left right] [BTree-get] T>
- [n_key n_value left right] [BTree-get] E
- [n_key n_value left right] [BTree-get] T<
+ [Er] BTree-delete
+ -------------------------------------
+ [pop not] [Er] [R0] [R1] genrec
::
@@ -1253,6 +1299,375 @@ And:
[n_key n_value left right] [BTree-get] E
[n_key n_value left right] [BTree-get] T<
+Now we get to figure out the recursive case:
+
+::
+
+ w/ D == [pop not] [Er] [R0] [R1] genrec
+
+ [node_key node_value left right] key R0 [D] R1
+ [node_key node_value left right] key over first swap dup [D] R1
+ [node_key node_value left right] node_key key key [D] R1
+
+And then:
+
+::
+
+ [node_key node_value left right] node_key key key [D] R1
+ [node_key node_value left right] node_key key key [D] cons roll> [T>] [E] [T<] cmp
+ [node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
+ [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+Now this:;
+
+::
+
+ [node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
+
+Becomes one of these three:;
+
+::
+
+ [node_key node_value left right] [key D] T>
+ [node_key node_value left right] [key D] E
+ [node_key node_value left right] [key D] T<
+
+Greater than case and less than case
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+::
+
+ [node_key node_value left right] [key D] T>
+ -------------------------------------------------
+ [node_key node_value left key D right]
+
+First:
+
+::
+
+ right left node_value node_key [key D] dipd
+ right left key D node_value node_key
+ right left' node_value node_key
+
+Ergo:
+
+::
+
+ [node_key node_value left right] [key D] [dipd] cons infra
+
+So:
+
+::
+
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+
+The else case
+~~~~~~~~~~~~~
+
+::
+
+ [node_key node_value left right] [key D] E
+
+We have to handle three cases, so let's use ``cond``.
+
+The first two cases are symmetrical, if we only have one non-empty child
+node return it.
+
+::
+
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [default]
+ ] cond
+
+(If both child nodes are empty return an empty node.)
+
+The initial structure of the default function:
+
+::
+
+ default == [E'] cons infra
+
+ [node_key node_value left right] [key D] default
+ [node_key node_value left right] [key D] [E'] cons infra
+ [node_key node_value left right] [[key D] E'] infra
+
+ right left node_value node_key [key D] E'
+
+If both child nodes are non-empty, we find the highest node in our lower
+sub-tree, take its key and value to replace (delete) our own, then get
+rid of it by recursively calling delete() on our lower sub-node with our
+new key.
+
+(We could also find the lowest node in our higher sub-tree and take its
+key and value and delete it. I only implemented one of these two
+symmetrical options. Over a lot of deletions this might make the tree
+more unbalanced. Oh well.)
+
+First things first, we no longer need this node's key and value:
+
+::
+
+ right left node_value node_key [key D] roll> popop E''
+ right left [key D] node_value node_key popop E''
+ right left [key D] E''
+
+Then we have to we find the highest (right-most) node in our lower
+(left) sub-tree:
+
+::
+
+ right left [key D] E''
+
+Ditch the key:
+
+::
+
+ right left [key D] rest E'''
+ right left [D] E'''
+
+Find the right-most node:
+
+::
+
+ right left [D] [dup W] dip E''''
+ right left dup W [D] E''''
+ right left left W [D] E''''
+
+Consider:
+
+::
+
+ left W
+
+We know left is not empty:
+
+::
+
+ [L_key L_value L_left L_right] W
+
+We want to keep extracting the right node as long as it is not empty:
+
+::
+
+ left [P] [B] while W'
+
+The predicate:
+
+::
+
+ [L_key L_value L_left L_right] P
+ [L_key L_value L_left L_right] fourth
+ L_right
+
+
+(This has a bug, can run on ``[]`` so must be guarded:
+
+::
+
+ if_not_empty == [] swap [] ifte
+ ?fourth == [fourth] if_not_empty
+ W.rightmost == [?fourth] [fourth] while
+
+The body is also ``fourth``:
+
+::
+
+ left [fourth] [fourth] while W'
+ rightest W'
+
+We know rightest is not empty:
+
+::
+
+ [R_key R_value R_left R_right] W'
+ [R_key R_value R_left R_right] uncons uncons pop
+ R_key [R_value R_left R_right] uncons pop
+ R_key R_value [R_left R_right] pop
+ R_key R_value
+
+So:
+
+::
+
+ W == [fourth] [fourth] while uncons uncons pop
+
+And:
+
+::
+
+ right left left W [D] E''''
+ right left R_key R_value [D] E''''
+
+Final stretch. We want to end up with something like:
+
+::
+
+ right left [R_key D] i R_value R_key
+ right left R_key D R_value R_key
+ right left' R_value R_key
+
+If we adjust our definition of ``W`` to include ``over`` at the end:
+
+::
+
+ W == [fourth] [fourth] while uncons uncons pop over
+
+That will give us:
+
+::
+
+ right left R_key R_value R_key [D] E''''
+
+ right left R_key R_value R_key [D] cons dipdd E'''''
+ right left R_key R_value [R_key D] dipdd E'''''
+ right left R_key D R_key R_value E'''''
+ right left' R_key R_value E'''''
+ right left' R_key R_value swap
+ right left' R_value R_key
+
+So:
+
+::
+
+ E' == roll> popop E''
+
+ E'' == rest E'''
+
+ E''' == [dup W] dip E''''
+
+ E'''' == cons dipdd swap
+
+Substituting:
+
+::
+
+ W == [fourth] [fourth] while uncons uncons pop over
+ E' == roll> popop rest [dup W] dip cons dipdd swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E'] cons infra]
+ ] cond
+
+Minor rearrangement:
+
+::
+
+ W == dup [fourth] [fourth] while uncons uncons pop over
+ E' == roll> popop rest [W] dip cons dipdd swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E'] cons infra]
+ ] cond
+
+Refactoring
+~~~~~~~~~~~
+
+::
+
+ W.rightmost == [fourth] [fourth] while
+ W.unpack == uncons uncons pop
+ E.clear_stuff == roll> popop rest
+ E.delete == cons dipdd
+ W == dup W.rightmost W.unpack over
+ E.0 == E.clear_stuff [W] dip E.delete swap
+ E == [
+ [[pop third not] pop fourth]
+ [[pop fourth not] pop third]
+ [[E.0] cons infra]
+ ] cond
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+ R0 == over first swap dup
+ R1 == cons roll> [T>] [E] [T<] cmp
+ BTree-Delete == [pop not] swap [R0] [R1] genrec
+
+By the standards of the code I've written so far, this is a *huge* Joy
+program.
+
+.. code:: ipython2
+
+ DefinitionWrapper.add_definitions('''
+ first_two == uncons uncons pop
+ fourth == rest rest rest first
+ ?fourth == [] [fourth] [] ifte
+ W.rightmost == [?fourth] [fourth] while
+ E.clear_stuff == roll> popop rest
+ E.delete == cons dipdd
+ W == dup W.rightmost first_two over
+ E.0 == E.clear_stuff [W] dip E.delete swap
+ E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[E.0] cons infra]] cond
+ T> == [dipd] cons infra
+ T< == [dipdd] cons infra
+ R0 == over first swap dup
+ R1 == cons roll> [T>] [E] [T<] cmp
+ BTree-Delete == [pop not] swap [R0] [R1] genrec''', D)
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'c' ['Er'] BTree-Delete ")
+
+
+.. parsed-literal::
+
+ ['a' 23 [] ['b' 88 [] []]]
+
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'b' ['Er'] BTree-Delete ")
+
+
+.. parsed-literal::
+
+ ['a' 23 [] ['c' 44 [] []]]
+
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'a' ['Er'] BTree-Delete ")
+
+
+.. parsed-literal::
+
+ ['b' 88 [] ['c' 44 [] []]]
+
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' ['Er'] BTree-Delete ")
+
+
+.. parsed-literal::
+
+ ['a' 23 [] ['b' 88 [] ['c' 44 [] 'Er' 'der' []]]]
+
+
+.. code:: ipython2
+
+ J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' [pop] BTree-Delete ")
+
+
+.. parsed-literal::
+
+ ['a' 23 [] ['b' 88 [] ['c' 44 [] []]]]
+
+
+One bug, I forgot to put ``not`` in the first two clauses of the
+``cond``.
+
+The behavior of the ``[Er]`` function should maybe be different: either
+just silently fail, or maybe implement some sort of function that can
+grab the pending expression up to a sentinel value or something,
+allowing for a kind of "except"-ish control-flow?
+
+Then, once we have add, get, and delete we can see about abstracting
+them.
+
Tree with node and list of trees.
=================================
diff --git a/docs/Treestep.html b/docs/Treestep.html
new file mode 100644
index 0000000..94e8180
--- /dev/null
+++ b/docs/Treestep.html
@@ -0,0 +1,13048 @@
+
+
+
+Treestep
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Treating Trees II¶
Let's consider a tree structure, similar to one described "Why functional programming matters" by John Hughes, that consists of a node value followed by a sequence of zero or more child trees. (The asterisk is meant to indicate the Kleene star.)
+
+tree = [] | [node tree*]
+
+
+
+
+
+
+
+
+treestep¶
In the spirit of step we are going to define a combinator treestep which expects a tree and three additional items: a base-case function [B], and two quoted programs [N] and [C].
+
+tree [B] [N] [C] treestep
+
+
+
+
+
+
+
+
+If the current tree node is empty then just execute B:
+
+ [] [B] [N] [C] treestep
+---------------------------
+ [] B
+
+
+
+
+
+
+
+
+Otherwise, evaluate N on the node value, map the whole function (abbreviated here as K) over the child trees recursively, and then combine the result with C.
+
+ [node tree*] [B] [N] [C] treestep
+--------------------------------------- w/ K == [B] [N] [C] treestep
+ node N [tree*] [K] map C
+
+
+(Later on we'll experiment with making map part of C so you can use other combinators.)
+
+
+
+
+
+
+
+
+Derive the recursive function.¶
We can begin to derive it by finding the ifte stage that genrec will produce.
+
+K == [not] [B] [R0] [R1] genrec
+ == [not] [B] [R0 [K] R1] ifte
+
+
+So we just have to derive J:
+
+J == R0 [K] R1
+
+
+
+
+
+
+
+
+The behavior of J is to accept a (non-empty) tree node and arrive at the desired outcome.
+
+ [node tree*] J
+------------------------------
+ node N [tree*] [K] map C
+
+
+
+
+
+
+
+
+So J will have some form like:
+
+J == ... [N] ... [K] ... [C] ...
+
+
+
+
+
+
+
+
+Let's dive in. First, unquote the node and dip N.
+
+[node tree*] uncons [N] dip
+node [tree*] [N] dip
+node N [tree*]
+
+
+
+
+
+
+
+
+Next, map K over the child trees and combine with C.
+
+node N [tree*] [K] map C
+node N [tree*] [K] map C
+node N [K.tree*] C
+
+
+
+
+
+
+
+
+So:
+
+J == uncons [N] dip [K] map C
+
+
+
+
+
+
+
+
+Plug it in and convert to genrec:
+
+K == [not] [B] [J ] ifte
+ == [not] [B] [uncons [N] dip [K] map C] ifte
+ == [not] [B] [uncons [N] dip] [map C] genrec
+
+
+
+
+
+
+
+
+Extract the givens to parameterize the program.¶
Working backwards:
+
+[not] [B] [uncons [N] dip] [map C] genrec
+[B] [not] swap [uncons [N] dip] [map C] genrec
+[B] [uncons [N] dip] [[not] swap] dip [map C] genrec
+ ^^^^^^^^^^^^^^^^
+[B] [[N] dip] [uncons] swoncat [[not] swap] dip [map C] genrec
+[B] [N] [dip] cons [uncons] swoncat [[not] swap] dip [map C] genrec
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+
+
+
+
+
+
+
+Extract a couple of auxiliary definitions:
+
+TS.0 == [[not] swap] dip
+TS.1 == [dip] cons [uncons] swoncat
+
+
+
+
+
+
+
+
+
+[B] [N] TS.1 TS.0 [map C] genrec
+[B] [N] [map C] [TS.1 TS.0] dip genrec
+[B] [N] [C] [map] swoncat [TS.1 TS.0] dip genrec
+
+
+The givens are all to the left so we have our definition.
+
+
+
+
+
+
+
+
+(alternate) Extract the givens to parameterize the program.¶
Working backwards:
+
+[not] [B] [uncons [N] dip] [map C] genrec
+[not] [B] [N] [dip] cons [uncons] swoncat [map C] genrec
+[B] [N] [not] roll> [dip] cons [uncons] swoncat [map C] genrec
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+
+
+
+
+
+
+
+Define treestep¶
+
+
+
+
+
+In [1]:
+
+
+from notebook_preamble import D, J, V, define, DefinitionWrapper
+
+
+
+
+
+
+
+
+
+In [2]:
+
+
+DefinitionWrapper.add_definitions('''
+
+ _treestep_0 == [[not] swap] dip
+ _treestep_1 == [dip] cons [uncons] swoncat
+ treegrind == [_treestep_1 _treestep_0] dip genrec
+ treestep == [map] swoncat treegrind
+
+''', D)
+
+
+
+
+
+
+
+
+
+
+
+Examples¶
Consider trees, the nodes of which are integers. We can find the sum of all nodes in a tree with this function:
+
+sumtree == [pop 0] [] [sum +] treestep
+
+
+
+
+
+
+In [3]:
+
+
+define('sumtree == [pop 0] [] [sum +] treestep')
+
+
+
+
+
+
+
+
+
+
+
+Running this function on an empty tree value gives zero:
+
+ [] [pop 0] [] [sum +] treestep
+------------------------------------
+ 0
+
+
+
+
+
+
+In [4]:
+
+
+J('[] sumtree') # Empty tree.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Running it on a non-empty node:
+
+[n tree*] [pop 0] [] [sum +] treestep
+n [tree*] [[pop 0] [] [sum +] treestep] map sum +
+n [ ... ] sum +
+n m +
+n+m
+
+
+
+
+
+
+In [5]:
+
+
+J('[23] sumtree') # No child trees.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [6]:
+
+
+J('[23 []] sumtree') # Child tree, empty.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [7]:
+
+
+J('[23 [2 [4]] [3]] sumtree') # Non-empty child trees.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [8]:
+
+
+J('[23 [2 [8] [9]] [3] [4 []]] sumtree') # Etc...
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [9]:
+
+
+J('[23 [2 [8] [9]] [3] [4 []]] [pop 0] [] [cons sum] treestep') # Alternate "spelling".
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [10]:
+
+
+J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 23] [cons] treestep') # Replace each node.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [11]:
+
+
+J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 1] [cons] treestep')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [12]:
+
+
+J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 1] [cons] treestep sumtree')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [13]:
+
+
+J('[23 [2 [8] [9]] [3] [4 []]] [pop 0] [pop 1] [sum +] treestep') # Combine replace and sum into one function.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [14]:
+
+
+J('[4 [3 [] [7]]] [pop 0] [pop 1] [sum +] treestep') # Combine replace and sum into one function.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Redefining the Ordered Binary Tree in terms of treestep.¶
+Tree = [] | [[key value] left right]
+
+
+
+
+
+
+
+
+What kind of functions can we write for this with our treestep?
+The pattern for processing a non-empty node is:
+
+node N [tree*] [K] map C
+
+
+Plugging in our BTree structure:
+
+[key value] N [left right] [K] map C
+
+
+
+
+
+
+
+
+Traversal¶
+[key value] first [left right] [K] map i
+key [value] [left right] [K] map i
+key [left right] [K] map i
+key [lkey rkey ] i
+key lkey rkey
+
+
+
+
+
+
+
+
+This doesn't quite work:
+
+
+
+
+
+
+In [15]:
+
+
+J('[[3 0] [[2 0] [][]] [[9 0] [[5 0] [[4 0] [][]] [[8 0] [[6 0] [] [[7 0] [][]]][]]][]]] ["B"] [first] [i] treestep')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Doesn't work because map extracts the first item of whatever its mapped function produces. We have to return a list, rather than depositing our results directly on the stack.
+
+[key value] N [left right] [K] map C
+
+[key value] first [left right] [K] map flatten cons
+key [left right] [K] map flatten cons
+key [[lk] [rk] ] flatten cons
+key [ lk rk ] cons
+ [key lk rk ]
+
+
+So:
+
+[] [first] [flatten cons] treestep
+
+
+
+
+
+
+In [16]:
+
+
+J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [first] [flatten cons] treestep')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+There we go.
+
+
+
+
+
+
+
+
+In-order traversal¶
From here:
+
+key [[lk] [rk]] C
+key [[lk] [rk]] i
+key [lk] [rk] roll<
+[lk] [rk] key swons concat
+[lk] [key rk] concat
+[lk key rk]
+
+
+So:
+
+[] [i roll< swons concat] [first] treestep
+
+
+
+
+
+
+In [17]:
+
+
+J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [uncons pop] [i roll< swons concat] treestep')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+With treegrind?¶
The treegrind function doesn't include the map combinator, so the [C] function must arrange to use some combinator on the quoted recursive copy [K]. With this function, the pattern for processing a non-empty node is:
+
+node N [tree*] [K] C
+
+
+Plugging in our BTree structure:
+
+[key value] N [left right] [K] C
+
+
+
+
+
+
+In [18]:
+
+
+J('[["key" "value"] ["left"] ["right"] ] ["B"] ["N"] ["C"] treegrind')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+treegrind with step¶
+
+
+
+
+
+
+
+Iteration through the nodes
+
+
+
+
+
+
+In [19]:
+
+
+J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [pop] ["N"] [step] treegrind')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Sum the nodes' keys.
+
+
+
+
+
+
+In [20]:
+
+
+J('0 [[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [pop] [first +] [step] treegrind')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Rebuild the tree using map (imitating treestep.)
+
+
+
+
+
+
+In [21]:
+
+
+J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [[100 +] infra] [map cons] treegrind')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+We'll start by saying that the base-case (the key is not in the tree) is user defined, and the per-node function is just the query key literal:
+
+[B] [query_key] [C] treegrind
+
+
+
+
+
+
+
+
+This means we just have to define C from:
+
+[key value] query_key [left right] [K] C
+
+
+
+
+
+
+
+
+Let's try cmp:
+
+C == P [T>] [E] [T<] cmp
+
+[key value] query_key [left right] [K] P [T>] [E] [T<] cmp
+
+
+
+
+
+
+
+
+The predicate P¶
Seems pretty easy (we must preserve the value in case the keys are equal):
+
+[key value] query_key [left right] [K] P
+[key value] query_key [left right] [K] roll<
+[key value] [left right] [K] query_key [roll< uncons swap] dip
+
+[key value] [left right] [K] roll< uncons swap query_key
+[left right] [K] [key value] uncons swap query_key
+[left right] [K] key [value] swap query_key
+[left right] [K] [value] key query_key
+
+P == roll< [roll< uncons swap] dip
+
+
+(Possibly with a swap at the end? Or just swap T< and T>.)
+
+
+
+
+
+
+
+
+So now:
+
+[left right] [K] [value] key query_key [T>] [E] [T<] cmp
+
+
+Becomes one of these three:
+
+[left right] [K] [value] T>
+[left right] [K] [value] E
+[left right] [K] [value] T<
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+T< and T>¶
+T< == pop [first] dip i
+T> == pop [second] dip i
+
+
+
+
+
+
+
+
+Putting it together¶
+T> == pop [first] dip i
+T< == pop [second] dip i
+E == roll> popop first
+P == roll< [roll< uncons swap] dip
+
+Tree-get == [P [T>] [E] [T<] cmp] treegrind
+
+
+To me, that seems simpler than the genrec version.
+
+
+
+
+
+
+In [22]:
+
+
+DefinitionWrapper.add_definitions('''
+
+ T> == pop [first] dip i
+ T< == pop [second] dip i
+ E == roll> popop first
+ P == roll< [roll< uncons swap] dip
+
+ Tree-get == [P [T>] [E] [T<] cmp] treegrind
+
+''', D)
+
+
+
+
+
+
+
+
+
+In [23]:
+
+
+from joy.library import FunctionWrapper
+from joy.utils.stack import pushback
+
+
+@FunctionWrapper
+def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
+ L, (E, (G, (b, (a, stack)))) = stack
+ expression = pushback(G if a > b else L if a < b else E, expression)
+ return stack, expression, dictionary
+
+
+D['cmp'] = cmp_
+
+
+
+
+
+
+
+
+
+In [24]:
+
+
+J('''\
+
+[[3 13] [[2 12] [] []] [[9 19] [[5 15] [[4 14] [] []] [[8 18] [[6 16] [] [[7 17] [] []]] []]] []]]
+
+[] [5] Tree-get
+
+''')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In [25]:
+
+
+J('''\
+
+[[3 13] [[2 12] [] []] [[9 19] [[5 15] [[4 14] [] []] [[8 18] [[6 16] [] [[7 17] [] []]] []]] []]]
+
+[pop "nope"] [25] Tree-get
+
+''')
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/docs/Treestep.md b/docs/Treestep.md
new file mode 100644
index 0000000..60a0573
--- /dev/null
+++ b/docs/Treestep.md
@@ -0,0 +1,499 @@
+
+# Treating Trees II
+Let's consider a tree structure, similar to one described ["Why functional programming matters" by John Hughes](https://www.cs.kent.ac.uk/people/staff/dat/miranda/whyfp90.pdf), that consists of a node value followed by a sequence of zero or more child trees. (The asterisk is meant to indicate the [Kleene star](https://en.wikipedia.org/wiki/Kleene_star).)
+
+ tree = [] | [node tree*]
+
+## `treestep`
+In the spirit of `step` we are going to define a combinator `treestep` which expects a tree and three additional items: a base-case function `[B]`, and two quoted programs `[N]` and `[C]`.
+
+ tree [B] [N] [C] treestep
+
+If the current tree node is empty then just execute `B`:
+
+ [] [B] [N] [C] treestep
+ ---------------------------
+ [] B
+
+Otherwise, evaluate `N` on the node value, `map` the whole function (abbreviated here as `K`) over the child trees recursively, and then combine the result with `C`.
+
+ [node tree*] [B] [N] [C] treestep
+ --------------------------------------- w/ K == [B] [N] [C] treestep
+ node N [tree*] [K] map C
+
+(Later on we'll experiment with making `map` part of `C` so you can use other combinators.)
+
+## Derive the recursive function.
+We can begin to derive it by finding the `ifte` stage that `genrec` will produce.
+
+ K == [not] [B] [R0] [R1] genrec
+ == [not] [B] [R0 [K] R1] ifte
+
+So we just have to derive `J`:
+
+ J == R0 [K] R1
+
+The behavior of `J` is to accept a (non-empty) tree node and arrive at the desired outcome.
+
+ [node tree*] J
+ ------------------------------
+ node N [tree*] [K] map C
+
+So `J` will have some form like:
+
+ J == ... [N] ... [K] ... [C] ...
+
+Let's dive in. First, unquote the node and `dip` `N`.
+
+ [node tree*] uncons [N] dip
+ node [tree*] [N] dip
+ node N [tree*]
+
+Next, `map` `K` over the child trees and combine with `C`.
+
+ node N [tree*] [K] map C
+ node N [tree*] [K] map C
+ node N [K.tree*] C
+
+So:
+
+ J == uncons [N] dip [K] map C
+
+Plug it in and convert to `genrec`:
+
+ K == [not] [B] [J ] ifte
+ == [not] [B] [uncons [N] dip [K] map C] ifte
+ == [not] [B] [uncons [N] dip] [map C] genrec
+
+## Extract the givens to parameterize the program.
+Working backwards:
+
+ [not] [B] [uncons [N] dip] [map C] genrec
+ [B] [not] swap [uncons [N] dip] [map C] genrec
+ [B] [uncons [N] dip] [[not] swap] dip [map C] genrec
+ ^^^^^^^^^^^^^^^^
+ [B] [[N] dip] [uncons] swoncat [[not] swap] dip [map C] genrec
+ [B] [N] [dip] cons [uncons] swoncat [[not] swap] dip [map C] genrec
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+Extract a couple of auxiliary definitions:
+
+ TS.0 == [[not] swap] dip
+ TS.1 == [dip] cons [uncons] swoncat
+
+ [B] [N] TS.1 TS.0 [map C] genrec
+ [B] [N] [map C] [TS.1 TS.0] dip genrec
+ [B] [N] [C] [map] swoncat [TS.1 TS.0] dip genrec
+
+The givens are all to the left so we have our definition.
+
+### (alternate) Extract the givens to parameterize the program.
+Working backwards:
+
+ [not] [B] [uncons [N] dip] [map C] genrec
+ [not] [B] [N] [dip] cons [uncons] swoncat [map C] genrec
+ [B] [N] [not] roll> [dip] cons [uncons] swoncat [map C] genrec
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+## Define `treestep`
+
+
+```python
+from notebook_preamble import D, J, V, define, DefinitionWrapper
+```
+
+
+```python
+DefinitionWrapper.add_definitions('''
+
+ _treestep_0 == [[not] swap] dip
+ _treestep_1 == [dip] cons [uncons] swoncat
+ treegrind == [_treestep_1 _treestep_0] dip genrec
+ treestep == [map] swoncat treegrind
+
+''', D)
+```
+
+## Examples
+Consider trees, the nodes of which are integers. We can find the sum of all nodes in a tree with this function:
+
+ sumtree == [pop 0] [] [sum +] treestep
+
+
+```python
+define('sumtree == [pop 0] [] [sum +] treestep')
+```
+
+Running this function on an empty tree value gives zero:
+
+ [] [pop 0] [] [sum +] treestep
+ ------------------------------------
+ 0
+
+
+```python
+J('[] sumtree') # Empty tree.
+```
+
+ 0
+
+
+Running it on a non-empty node:
+
+ [n tree*] [pop 0] [] [sum +] treestep
+ n [tree*] [[pop 0] [] [sum +] treestep] map sum +
+ n [ ... ] sum +
+ n m +
+ n+m
+
+
+
+```python
+J('[23] sumtree') # No child trees.
+```
+
+ 23
+
+
+
+```python
+J('[23 []] sumtree') # Child tree, empty.
+```
+
+ 23
+
+
+
+```python
+J('[23 [2 [4]] [3]] sumtree') # Non-empty child trees.
+```
+
+ 32
+
+
+
+```python
+J('[23 [2 [8] [9]] [3] [4 []]] sumtree') # Etc...
+```
+
+ 49
+
+
+
+```python
+J('[23 [2 [8] [9]] [3] [4 []]] [pop 0] [] [cons sum] treestep') # Alternate "spelling".
+```
+
+ 49
+
+
+
+```python
+J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 23] [cons] treestep') # Replace each node.
+```
+
+ [23 [23 [23] [23]] [23] [23 []]]
+
+
+
+```python
+J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 1] [cons] treestep')
+```
+
+ [1 [1 [1] [1]] [1] [1 []]]
+
+
+
+```python
+J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 1] [cons] treestep sumtree')
+```
+
+ 6
+
+
+
+```python
+J('[23 [2 [8] [9]] [3] [4 []]] [pop 0] [pop 1] [sum +] treestep') # Combine replace and sum into one function.
+```
+
+ 6
+
+
+
+```python
+J('[4 [3 [] [7]]] [pop 0] [pop 1] [sum +] treestep') # Combine replace and sum into one function.
+```
+
+ 3
+
+
+## Redefining the Ordered Binary Tree in terms of `treestep`.
+
+ Tree = [] | [[key value] left right]
+
+What kind of functions can we write for this with our `treestep`?
+
+The pattern for processing a non-empty node is:
+
+ node N [tree*] [K] map C
+
+Plugging in our BTree structure:
+
+ [key value] N [left right] [K] map C
+
+### Traversal
+ [key value] first [left right] [K] map i
+ key [value] [left right] [K] map i
+ key [left right] [K] map i
+ key [lkey rkey ] i
+ key lkey rkey
+
+This doesn't quite work:
+
+
+```python
+J('[[3 0] [[2 0] [][]] [[9 0] [[5 0] [[4 0] [][]] [[8 0] [[6 0] [] [[7 0] [][]]][]]][]]] ["B"] [first] [i] treestep')
+```
+
+ 3 'B' 'B'
+
+
+Doesn't work because `map` extracts the `first` item of whatever its mapped function produces. We have to return a list, rather than depositing our results directly on the stack.
+
+
+ [key value] N [left right] [K] map C
+
+ [key value] first [left right] [K] map flatten cons
+ key [left right] [K] map flatten cons
+ key [[lk] [rk] ] flatten cons
+ key [ lk rk ] cons
+ [key lk rk ]
+
+So:
+
+ [] [first] [flatten cons] treestep
+
+
+```python
+J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [first] [flatten cons] treestep')
+```
+
+ [3 2 9 5 4 8 6 7]
+
+
+There we go.
+
+### In-order traversal
+
+From here:
+
+ key [[lk] [rk]] C
+ key [[lk] [rk]] i
+ key [lk] [rk] roll<
+ [lk] [rk] key swons concat
+ [lk] [key rk] concat
+ [lk key rk]
+
+So:
+
+ [] [i roll< swons concat] [first] treestep
+
+
+```python
+J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [uncons pop] [i roll< swons concat] treestep')
+```
+
+ [2 3 4 5 6 7 8 9]
+
+
+## With `treegrind`?
+The `treegrind` function doesn't include the `map` combinator, so the `[C]` function must arrange to use some combinator on the quoted recursive copy `[K]`. With this function, the pattern for processing a non-empty node is:
+
+ node N [tree*] [K] C
+
+Plugging in our BTree structure:
+
+ [key value] N [left right] [K] C
+
+
+```python
+J('[["key" "value"] ["left"] ["right"] ] ["B"] ["N"] ["C"] treegrind')
+```
+
+ ['key' 'value'] 'N' [['left'] ['right']] [[not] ['B'] [uncons ['N'] dip] ['C'] genrec] 'C'
+
+
+## `treegrind` with `step`
+
+Iteration through the nodes
+
+
+```python
+J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [pop] ["N"] [step] treegrind')
+```
+
+ [3 0] 'N' [2 0] 'N' [9 0] 'N' [5 0] 'N' [4 0] 'N' [8 0] 'N' [6 0] 'N' [7 0] 'N'
+
+
+Sum the nodes' keys.
+
+
+```python
+J('0 [[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [pop] [first +] [step] treegrind')
+```
+
+ 44
+
+
+Rebuild the tree using `map` (imitating `treestep`.)
+
+
+```python
+J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [[100 +] infra] [map cons] treegrind')
+```
+
+ [[103 0] [[102 0] [] []] [[109 0] [[105 0] [[104 0] [] []] [[108 0] [[106 0] [] [[107 0] [] []]] []]] []]]
+
+
+## Do we have the flexibility to reimplement `Tree-get`?
+I think we do:
+
+ [B] [N] [C] treegrind
+
+We'll start by saying that the base-case (the key is not in the tree) is user defined, and the per-node function is just the query key literal:
+
+ [B] [query_key] [C] treegrind
+
+This means we just have to define `C` from:
+
+ [key value] query_key [left right] [K] C
+
+
+Let's try `cmp`:
+
+ C == P [T>] [E] [T<] cmp
+
+ [key value] query_key [left right] [K] P [T>] [E] [T<] cmp
+
+### The predicate `P`
+Seems pretty easy (we must preserve the value in case the keys are equal):
+
+ [key value] query_key [left right] [K] P
+ [key value] query_key [left right] [K] roll<
+ [key value] [left right] [K] query_key [roll< uncons swap] dip
+
+ [key value] [left right] [K] roll< uncons swap query_key
+ [left right] [K] [key value] uncons swap query_key
+ [left right] [K] key [value] swap query_key
+ [left right] [K] [value] key query_key
+
+ P == roll< [roll< uncons swap] dip
+
+(Possibly with a swap at the end? Or just swap `T<` and `T>`.)
+
+So now:
+
+ [left right] [K] [value] key query_key [T>] [E] [T<] cmp
+
+Becomes one of these three:
+
+ [left right] [K] [value] T>
+ [left right] [K] [value] E
+ [left right] [K] [value] T<
+
+
+### `E`
+Easy.
+
+ E == roll> popop first
+
+### `T<` and `T>`
+
+ T< == pop [first] dip i
+ T> == pop [second] dip i
+
+## Putting it together
+
+
+ T> == pop [first] dip i
+ T< == pop [second] dip i
+ E == roll> popop first
+ P == roll< [roll< uncons swap] dip
+
+ Tree-get == [P [T>] [E] [T<] cmp] treegrind
+
+To me, that seems simpler than the `genrec` version.
+
+
+```python
+DefinitionWrapper.add_definitions('''
+
+ T> == pop [first] dip i
+ T< == pop [second] dip i
+ E == roll> popop first
+ P == roll< [roll< uncons swap] dip
+
+ Tree-get == [P [T>] [E] [T<] cmp] treegrind
+
+''', D)
+```
+
+
+```python
+from joy.library import FunctionWrapper
+from joy.utils.stack import pushback
+
+
+@FunctionWrapper
+def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
+ L, (E, (G, (b, (a, stack)))) = stack
+ expression = pushback(G if a > b else L if a < b else E, expression)
+ return stack, expression, dictionary
+
+
+D['cmp'] = cmp_
+```
+
+
+```python
+J('''\
+
+[[3 13] [[2 12] [] []] [[9 19] [[5 15] [[4 14] [] []] [[8 18] [[6 16] [] [[7 17] [] []]] []]] []]]
+
+[] [5] Tree-get
+
+''')
+```
+
+ 15
+
+
+
+```python
+J('''\
+
+[[3 13] [[2 12] [] []] [[9 19] [[5 15] [[4 14] [] []] [[8 18] [[6 16] [] [[7 17] [] []]] []]] []]]
+
+[pop "nope"] [25] Tree-get
+
+''')
+```
+
+ 'nope'
+
diff --git a/docs/Treestep.rst b/docs/Treestep.rst
new file mode 100644
index 0000000..8e2721c
--- /dev/null
+++ b/docs/Treestep.rst
@@ -0,0 +1,655 @@
+
+Treating Trees II
+=================
+
+Let's consider a tree structure, similar to one described `"Why
+functional programming matters" by John
+Hughes `__,
+that consists of a node value followed by a sequence of zero or more
+child trees. (The asterisk is meant to indicate the `Kleene
+star `__.)
+
+::
+
+ tree = [] | [node tree*]
+
+``treestep``
+------------
+
+In the spirit of ``step`` we are going to define a combinator
+``treestep`` which expects a tree and three additional items: a
+base-case function ``[B]``, and two quoted programs ``[N]`` and ``[C]``.
+
+::
+
+ tree [B] [N] [C] treestep
+
+If the current tree node is empty then just execute ``B``:
+
+::
+
+ [] [B] [N] [C] treestep
+ ---------------------------
+ [] B
+
+Otherwise, evaluate ``N`` on the node value, ``map`` the whole function
+(abbreviated here as ``K``) over the child trees recursively, and then
+combine the result with ``C``.
+
+::
+
+ [node tree*] [B] [N] [C] treestep
+ --------------------------------------- w/ K == [B] [N] [C] treestep
+ node N [tree*] [K] map C
+
+(Later on we'll experiment with making ``map`` part of ``C`` so you can
+use other combinators.)
+
+Derive the recursive function.
+------------------------------
+
+We can begin to derive it by finding the ``ifte`` stage that ``genrec``
+will produce.
+
+::
+
+ K == [not] [B] [R0] [R1] genrec
+ == [not] [B] [R0 [K] R1] ifte
+
+So we just have to derive ``J``:
+
+::
+
+ J == R0 [K] R1
+
+The behavior of ``J`` is to accept a (non-empty) tree node and arrive at
+the desired outcome.
+
+::
+
+ [node tree*] J
+ ------------------------------
+ node N [tree*] [K] map C
+
+So ``J`` will have some form like:
+
+::
+
+ J == ... [N] ... [K] ... [C] ...
+
+Let's dive in. First, unquote the node and ``dip`` ``N``.
+
+::
+
+ [node tree*] uncons [N] dip
+ node [tree*] [N] dip
+ node N [tree*]
+
+Next, ``map`` ``K`` over the child trees and combine with ``C``.
+
+::
+
+ node N [tree*] [K] map C
+ node N [tree*] [K] map C
+ node N [K.tree*] C
+
+So:
+
+::
+
+ J == uncons [N] dip [K] map C
+
+Plug it in and convert to ``genrec``:
+
+::
+
+ K == [not] [B] [J ] ifte
+ == [not] [B] [uncons [N] dip [K] map C] ifte
+ == [not] [B] [uncons [N] dip] [map C] genrec
+
+Extract the givens to parameterize the program.
+-----------------------------------------------
+
+Working backwards:
+
+::
+
+ [not] [B] [uncons [N] dip] [map C] genrec
+ [B] [not] swap [uncons [N] dip] [map C] genrec
+ [B] [uncons [N] dip] [[not] swap] dip [map C] genrec
+ ^^^^^^^^^^^^^^^^
+ [B] [[N] dip] [uncons] swoncat [[not] swap] dip [map C] genrec
+ [B] [N] [dip] cons [uncons] swoncat [[not] swap] dip [map C] genrec
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+Extract a couple of auxiliary definitions:
+
+::
+
+ TS.0 == [[not] swap] dip
+ TS.1 == [dip] cons [uncons] swoncat
+
+::
+
+ [B] [N] TS.1 TS.0 [map C] genrec
+ [B] [N] [map C] [TS.1 TS.0] dip genrec
+ [B] [N] [C] [map] swoncat [TS.1 TS.0] dip genrec
+
+The givens are all to the left so we have our definition.
+
+(alternate) Extract the givens to parameterize the program.
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Working backwards:
+
+::
+
+ [not] [B] [uncons [N] dip] [map C] genrec
+ [not] [B] [N] [dip] cons [uncons] swoncat [map C] genrec
+ [B] [N] [not] roll> [dip] cons [uncons] swoncat [map C] genrec
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+Define ``treestep``
+-------------------
+
+.. code:: ipython2
+
+ from notebook_preamble import D, J, V, define, DefinitionWrapper
+
+.. code:: ipython2
+
+ DefinitionWrapper.add_definitions('''
+
+ _treestep_0 == [[not] swap] dip
+ _treestep_1 == [dip] cons [uncons] swoncat
+ treegrind == [_treestep_1 _treestep_0] dip genrec
+ treestep == [map] swoncat treegrind
+
+ ''', D)
+
+Examples
+--------
+
+Consider trees, the nodes of which are integers. We can find the sum of
+all nodes in a tree with this function:
+
+::
+
+ sumtree == [pop 0] [] [sum +] treestep
+
+.. code:: ipython2
+
+ define('sumtree == [pop 0] [] [sum +] treestep')
+
+Running this function on an empty tree value gives zero:
+
+::
+
+ [] [pop 0] [] [sum +] treestep
+ ------------------------------------
+ 0
+
+.. code:: ipython2
+
+ J('[] sumtree') # Empty tree.
+
+
+.. parsed-literal::
+
+ 0
+
+
+Running it on a non-empty node:
+
+::
+
+ [n tree*] [pop 0] [] [sum +] treestep
+ n [tree*] [[pop 0] [] [sum +] treestep] map sum +
+ n [ ... ] sum +
+ n m +
+ n+m
+
+.. code:: ipython2
+
+ J('[23] sumtree') # No child trees.
+
+
+.. parsed-literal::
+
+ 23
+
+
+.. code:: ipython2
+
+ J('[23 []] sumtree') # Child tree, empty.
+
+
+.. parsed-literal::
+
+ 23
+
+
+.. code:: ipython2
+
+ J('[23 [2 [4]] [3]] sumtree') # Non-empty child trees.
+
+
+.. parsed-literal::
+
+ 32
+
+
+.. code:: ipython2
+
+ J('[23 [2 [8] [9]] [3] [4 []]] sumtree') # Etc...
+
+
+.. parsed-literal::
+
+ 49
+
+
+.. code:: ipython2
+
+ J('[23 [2 [8] [9]] [3] [4 []]] [pop 0] [] [cons sum] treestep') # Alternate "spelling".
+
+
+.. parsed-literal::
+
+ 49
+
+
+.. code:: ipython2
+
+ J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 23] [cons] treestep') # Replace each node.
+
+
+.. parsed-literal::
+
+ [23 [23 [23] [23]] [23] [23 []]]
+
+
+.. code:: ipython2
+
+ J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 1] [cons] treestep')
+
+
+.. parsed-literal::
+
+ [1 [1 [1] [1]] [1] [1 []]]
+
+
+.. code:: ipython2
+
+ J('[23 [2 [8] [9]] [3] [4 []]] [] [pop 1] [cons] treestep sumtree')
+
+
+.. parsed-literal::
+
+ 6
+
+
+.. code:: ipython2
+
+ J('[23 [2 [8] [9]] [3] [4 []]] [pop 0] [pop 1] [sum +] treestep') # Combine replace and sum into one function.
+
+
+.. parsed-literal::
+
+ 6
+
+
+.. code:: ipython2
+
+ J('[4 [3 [] [7]]] [pop 0] [pop 1] [sum +] treestep') # Combine replace and sum into one function.
+
+
+.. parsed-literal::
+
+ 3
+
+
+Redefining the Ordered Binary Tree in terms of ``treestep``.
+------------------------------------------------------------
+
+::
+
+ Tree = [] | [[key value] left right]
+
+What kind of functions can we write for this with our ``treestep``?
+
+The pattern for processing a non-empty node is:
+
+::
+
+ node N [tree*] [K] map C
+
+Plugging in our BTree structure:
+
+::
+
+ [key value] N [left right] [K] map C
+
+Traversal
+~~~~~~~~~
+
+::
+
+ [key value] first [left right] [K] map i
+ key [value] [left right] [K] map i
+ key [left right] [K] map i
+ key [lkey rkey ] i
+ key lkey rkey
+
+This doesn't quite work:
+
+.. code:: ipython2
+
+ J('[[3 0] [[2 0] [][]] [[9 0] [[5 0] [[4 0] [][]] [[8 0] [[6 0] [] [[7 0] [][]]][]]][]]] ["B"] [first] [i] treestep')
+
+
+.. parsed-literal::
+
+ 3 'B' 'B'
+
+
+Doesn't work because ``map`` extracts the ``first`` item of whatever its
+mapped function produces. We have to return a list, rather than
+depositing our results directly on the stack.
+
+::
+
+ [key value] N [left right] [K] map C
+
+ [key value] first [left right] [K] map flatten cons
+ key [left right] [K] map flatten cons
+ key [[lk] [rk] ] flatten cons
+ key [ lk rk ] cons
+ [key lk rk ]
+
+So:
+
+::
+
+ [] [first] [flatten cons] treestep
+
+.. code:: ipython2
+
+ J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [first] [flatten cons] treestep')
+
+
+.. parsed-literal::
+
+ [3 2 9 5 4 8 6 7]
+
+
+There we go.
+
+In-order traversal
+~~~~~~~~~~~~~~~~~~
+
+From here:
+
+::
+
+ key [[lk] [rk]] C
+ key [[lk] [rk]] i
+ key [lk] [rk] roll<
+ [lk] [rk] key swons concat
+ [lk] [key rk] concat
+ [lk key rk]
+
+So:
+
+::
+
+ [] [i roll< swons concat] [first] treestep
+
+.. code:: ipython2
+
+ J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [uncons pop] [i roll< swons concat] treestep')
+
+
+.. parsed-literal::
+
+ [2 3 4 5 6 7 8 9]
+
+
+With ``treegrind``?
+-------------------
+
+The ``treegrind`` function doesn't include the ``map`` combinator, so
+the ``[C]`` function must arrange to use some combinator on the quoted
+recursive copy ``[K]``. With this function, the pattern for processing a
+non-empty node is:
+
+::
+
+ node N [tree*] [K] C
+
+Plugging in our BTree structure:
+
+::
+
+ [key value] N [left right] [K] C
+
+.. code:: ipython2
+
+ J('[["key" "value"] ["left"] ["right"] ] ["B"] ["N"] ["C"] treegrind')
+
+
+.. parsed-literal::
+
+ ['key' 'value'] 'N' [['left'] ['right']] [[not] ['B'] [uncons ['N'] dip] ['C'] genrec] 'C'
+
+
+``treegrind`` with ``step``
+---------------------------
+
+Iteration through the nodes
+
+.. code:: ipython2
+
+ J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [pop] ["N"] [step] treegrind')
+
+
+.. parsed-literal::
+
+ [3 0] 'N' [2 0] 'N' [9 0] 'N' [5 0] 'N' [4 0] 'N' [8 0] 'N' [6 0] 'N' [7 0] 'N'
+
+
+Sum the nodes' keys.
+
+.. code:: ipython2
+
+ J('0 [[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [pop] [first +] [step] treegrind')
+
+
+.. parsed-literal::
+
+ 44
+
+
+Rebuild the tree using ``map`` (imitating ``treestep``.)
+
+.. code:: ipython2
+
+ J('[[3 0] [[2 0] [] []] [[9 0] [[5 0] [[4 0] [] []] [[8 0] [[6 0] [] [[7 0] [] []]] []]] []]] [] [[100 +] infra] [map cons] treegrind')
+
+
+.. parsed-literal::
+
+ [[103 0] [[102 0] [] []] [[109 0] [[105 0] [[104 0] [] []] [[108 0] [[106 0] [] [[107 0] [] []]] []]] []]]
+
+
+Do we have the flexibility to reimplement ``Tree-get``?
+-------------------------------------------------------
+
+I think we do:
+
+::
+
+ [B] [N] [C] treegrind
+
+We'll start by saying that the base-case (the key is not in the tree) is
+user defined, and the per-node function is just the query key literal:
+
+::
+
+ [B] [query_key] [C] treegrind
+
+This means we just have to define ``C`` from:
+
+::
+
+ [key value] query_key [left right] [K] C
+
+Let's try ``cmp``:
+
+::
+
+ C == P [T>] [E] [T<] cmp
+
+ [key value] query_key [left right] [K] P [T>] [E] [T<] cmp
+
+The predicate ``P``
+~~~~~~~~~~~~~~~~~~~
+
+Seems pretty easy (we must preserve the value in case the keys are
+equal):
+
+::
+
+ [key value] query_key [left right] [K] P
+ [key value] query_key [left right] [K] roll<
+ [key value] [left right] [K] query_key [roll< uncons swap] dip
+
+ [key value] [left right] [K] roll< uncons swap query_key
+ [left right] [K] [key value] uncons swap query_key
+ [left right] [K] key [value] swap query_key
+ [left right] [K] [value] key query_key
+
+ P == roll< [roll< uncons swap] dip
+
+(Possibly with a swap at the end? Or just swap ``T<`` and ``T>``.)
+
+So now:
+
+::
+
+ [left right] [K] [value] key query_key [T>] [E] [T<] cmp
+
+Becomes one of these three:
+
+::
+
+ [left right] [K] [value] T>
+ [left right] [K] [value] E
+ [left right] [K] [value] T<
+
+``E``
+~~~~~
+
+Easy.
+
+::
+
+ E == roll> popop first
+
+``T<`` and ``T>``
+~~~~~~~~~~~~~~~~~
+
+::
+
+ T< == pop [first] dip i
+ T> == pop [second] dip i
+
+Putting it together
+-------------------
+
+::
+
+ T> == pop [first] dip i
+ T< == pop [second] dip i
+ E == roll> popop first
+ P == roll< [roll< uncons swap] dip
+
+ Tree-get == [P [T>] [E] [T<] cmp] treegrind
+
+To me, that seems simpler than the ``genrec`` version.
+
+.. code:: ipython2
+
+ DefinitionWrapper.add_definitions('''
+
+ T> == pop [first] dip i
+ T< == pop [second] dip i
+ E == roll> popop first
+ P == roll< [roll< uncons swap] dip
+
+ Tree-get == [P [T>] [E] [T<] cmp] treegrind
+
+ ''', D)
+
+.. code:: ipython2
+
+ from joy.library import FunctionWrapper
+ from joy.utils.stack import pushback
+
+
+ @FunctionWrapper
+ def cmp_(stack, expression, dictionary):
+ '''
+ cmp takes two values and three quoted programs on the stack and runs
+ one of the three depending on the results of comparing the two values:
+
+ a b [G] [E] [L] cmp
+ ------------------------- a > b
+ G
+
+ a b [G] [E] [L] cmp
+ ------------------------- a = b
+ E
+
+ a b [G] [E] [L] cmp
+ ------------------------- a < b
+ L
+ '''
+ L, (E, (G, (b, (a, stack)))) = stack
+ expression = pushback(G if a > b else L if a < b else E, expression)
+ return stack, expression, dictionary
+
+
+ D['cmp'] = cmp_
+
+.. code:: ipython2
+
+ J('''\
+
+ [[3 13] [[2 12] [] []] [[9 19] [[5 15] [[4 14] [] []] [[8 18] [[6 16] [] [[7 17] [] []]] []]] []]]
+
+ [] [5] Tree-get
+
+ ''')
+
+
+.. parsed-literal::
+
+ 15
+
+
+.. code:: ipython2
+
+ J('''\
+
+ [[3 13] [[2 12] [] []] [[9 19] [[5 15] [[4 14] [] []] [[8 18] [[6 16] [] [[7 17] [] []]] []]] []]]
+
+ [pop "nope"] [25] Tree-get
+
+ ''')
+
+
+.. parsed-literal::
+
+ 'nope'
+
diff --git a/docs/notebook_preamble.pyc b/docs/notebook_preamble.pyc
new file mode 100644
index 0000000..32b6331
Binary files /dev/null and b/docs/notebook_preamble.pyc differ