1 Using ``x`` to Generate Values
2 ==============================
8 from notebook_preamble import J, V, define
10 Consider the ``x`` combinator:
16 We can apply it to a quoted program consisting of some value ``a`` and
24 Let ``B`` function ``swap`` the ``a`` with the quote and run some
25 function ``C`` on it to generate a new value ``b``:
37 Now discard the quoted ``a`` with ``rest`` then ``cons`` ``b``:
45 Altogether, this is the definition of ``B``:
49 B == swap [C] dip rest cons
51 We can make a generator for the Natural numbers (0, 1, 2, …) by using
52 ``0`` for ``a`` and ``[dup ++]`` for ``[C]``:
56 [0 swap [dup ++] dip rest cons]
62 V('[0 swap [dup ++] dip rest cons] x')
67 . [0 swap [dup ++] dip rest cons] x
68 [0 swap [dup ++] dip rest cons] . x
69 [0 swap [dup ++] dip rest cons] . 0 swap [dup ++] dip rest cons
70 [0 swap [dup ++] dip rest cons] 0 . swap [dup ++] dip rest cons
71 0 [0 swap [dup ++] dip rest cons] . [dup ++] dip rest cons
72 0 [0 swap [dup ++] dip rest cons] [dup ++] . dip rest cons
73 0 . dup ++ [0 swap [dup ++] dip rest cons] rest cons
74 0 0 . ++ [0 swap [dup ++] dip rest cons] rest cons
75 0 1 . [0 swap [dup ++] dip rest cons] rest cons
76 0 1 [0 swap [dup ++] dip rest cons] . rest cons
77 0 1 [swap [dup ++] dip rest cons] . cons
78 0 [1 swap [dup ++] dip rest cons] .
81 After one application of ``x`` the quoted program contains ``1`` and
82 ``0`` is below it on the stack.
86 J('[0 swap [dup ++] dip rest cons] x x x x x pop')
99 define('direco == dip rest cons')
103 V('[0 swap [dup ++] direco] x')
108 . [0 swap [dup ++] direco] x
109 [0 swap [dup ++] direco] . x
110 [0 swap [dup ++] direco] . 0 swap [dup ++] direco
111 [0 swap [dup ++] direco] 0 . swap [dup ++] direco
112 0 [0 swap [dup ++] direco] . [dup ++] direco
113 0 [0 swap [dup ++] direco] [dup ++] . direco
114 0 [0 swap [dup ++] direco] [dup ++] . dip rest cons
115 0 . dup ++ [0 swap [dup ++] direco] rest cons
116 0 0 . ++ [0 swap [dup ++] direco] rest cons
117 0 1 . [0 swap [dup ++] direco] rest cons
118 0 1 [0 swap [dup ++] direco] . rest cons
119 0 1 [swap [dup ++] direco] . cons
120 0 [1 swap [dup ++] direco] .
126 We want to define a function that accepts ``a`` and ``[C]`` and builds
132 -------------------------
139 [a swap [C] direco] cons
140 a [swap [C] direco] concat
141 a [swap] [[C] direco] swap
142 a [[C] direco] [swap]
143 a [C] [direco] cons [swap]
145 Reading from the bottom up:
149 G == [direco] cons [swap] swap concat cons
150 G == [direco] cons [swap] swoncat cons
154 define('G == [direco] cons [swap] swoncat cons')
165 [0 swap [dup ++] direco]
170 J('0 [dup ++] G x x x pop')
183 J('1 [dup 1 <<] G x x x x x x x x x pop')
188 1 2 4 8 16 32 64 128 256
194 If we have one of these quoted programs we can drive it using ``times``
195 with the ``x`` combinator.
199 J('23 [dup ++] G 5 [x] times')
204 23 24 25 26 27 [28 swap [dup ++] direco]
207 Generating Multiples of Three and Five
208 --------------------------------------
210 Look at the treatment of the Project Euler Problem One in the
211 “Developing a Program” notebook and you’ll see that we might be
212 interested in generating an endless cycle of:
218 To do this we want to encode the numbers as pairs of bits in a single
224 0b 11 10 01 11 01 10 11 == 14811
226 And pick them off by masking with 3 (binary 11) and then shifting the
231 define('PE1.1 == dup [3 &] dip 2 >>')
242 14811 . dup [3 &] dip 2 >>
243 14811 14811 . [3 &] dip 2 >>
244 14811 14811 [3 &] . dip 2 >>
245 14811 . 3 & 14811 2 >>
246 14811 3 . & 14811 2 >>
253 If we plug ``14811`` and ``[PE1.1]`` into our generator form…
262 [14811 swap [PE1.1] direco]
265 …we get a generator that works for seven cycles before it reaches zero:
269 J('[14811 swap [PE1.1] direco] 7 [x] times')
274 3 2 1 3 1 2 3 [0 swap [PE1.1] direco]
280 We need a function that checks if the int has reached zero and resets it
285 define('PE1.1.check == dup [pop 14811] [] branch')
289 J('14811 [PE1.1.check PE1.1] G')
294 [14811 swap [PE1.1.check PE1.1] direco]
299 J('[14811 swap [PE1.1.check PE1.1] direco] 21 [x] times')
304 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]
307 (It would be more efficient to reset the int every seven cycles but
308 that’s a little beyond the scope of this article. This solution does
309 extra work, but not much, and we’re not using it “in production” as they
315 In the PE1 problem we are asked to sum all the multiples of three and
316 five less than 1000. It’s worked out that we need to use all seven
317 numbers sixty-six times and then four more.
329 If we drive our generator 466 times and sum the stack we get 999.
333 J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times')
338 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]
343 J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times pop enstacken sum')
351 Project Euler Problem One
352 -------------------------
356 define('PE1.2 == + dup [+] dip')
358 Now we can add ``PE1.2`` to the quoted program given to ``G``.
362 J('0 0 0 [PE1.1.check PE1.1] G 466 [x [PE1.2] dip] times popop')
370 A generator for the Fibonacci Sequence.
371 ---------------------------------------
380 The obvious first thing to do is just add ``b`` and ``a``:
387 From here we want to arrive at:
393 Let’s start with ``swons``:
400 Considering this quote as a stack:
406 We want to get it to:
423 [b+a b a F] [popdd over] infra
426 But we can just use ``cons`` to carry ``b+a`` into the quote:
430 [b a F] b+a [popdd over] cons infra
431 [b a F] [b+a popdd over] infra
441 Putting it all together:
445 F == + [popdd over] cons infra uncons
450 define('fib == + [popdd over] cons infra uncons')
454 define('fib_gen == [1 1 fib]')
458 J('fib_gen 10 [x] times')
463 1 2 3 5 8 13 21 34 55 89 [144 89 fib]
466 Project Euler Problem Two
467 -------------------------
469 By considering the terms in the Fibonacci sequence whose values do
470 not exceed four million, find the sum of the even-valued terms.
472 Now that we have a generator for the Fibonacci sequence, we need a
473 function that adds a term in the sequence to a sum if it is even, and
474 ``pop``\ s it otherwise.
478 define('PE2.1 == dup 2 % [+] [pop] branch')
480 And a predicate function that detects when the terms in the series
481 “exceed four million”.
485 define('>4M == 4000000 >')
487 Now it’s straightforward to define ``PE2`` as a recursive function that
488 generates terms in the Fibonacci sequence until they exceed four million
489 and sums the even ones.
493 define('PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec')
505 Here’s the collected program definitions:
509 fib == + swons [popdd over] infra uncons
515 PE2.1 == even [+] [pop] branch
516 PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec
518 Even-valued Fibonacci Terms
519 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
521 Using ``o`` for odd and ``e`` for even:
529 So the Fibonacci sequence considered in terms of just parity would be:
533 o o e o o e o o e o o e o o e o o e
536 Every third term is even.
540 J('[1 0 fib] x x x') # To start the sequence with 1 1 2 3 instead of 1 2 3.
548 Drive the generator three times and ``popop`` the two odd terms.
552 J('[1 0 fib] x x x [popop] dipd')
562 define('PE2.2 == x x x [popop] dipd')
566 J('[1 0 fib] 10 [PE2.2] times')
571 2 8 34 144 610 2584 10946 46368 196418 832040 [1346269 832040 fib]
574 Replace ``x`` with our new driver function ``PE2.2`` and start our
575 ``fib`` generator at ``1 0``.
579 J('0 [1 0 fib] PE2.2 [pop >4M] [popop] [[PE2.1] dip PE2.2] primrec')
587 How to compile these?
588 ---------------------
590 You would probably start with a special version of ``G``, and perhaps
591 modifications to the default ``x``?
593 An Interesting Variation
594 ------------------------
598 define('codireco == cons dip rest cons')
602 V('[0 [dup ++] codireco] x')
607 . [0 [dup ++] codireco] x
608 [0 [dup ++] codireco] . x
609 [0 [dup ++] codireco] . 0 [dup ++] codireco
610 [0 [dup ++] codireco] 0 . [dup ++] codireco
611 [0 [dup ++] codireco] 0 [dup ++] . codireco
612 [0 [dup ++] codireco] 0 [dup ++] . cons dip rest cons
613 [0 [dup ++] codireco] [0 dup ++] . dip rest cons
614 . 0 dup ++ [0 [dup ++] codireco] rest cons
615 0 . dup ++ [0 [dup ++] codireco] rest cons
616 0 0 . ++ [0 [dup ++] codireco] rest cons
617 0 1 . [0 [dup ++] codireco] rest cons
618 0 1 [0 [dup ++] codireco] . rest cons
619 0 1 [[dup ++] codireco] . cons
620 0 [1 [dup ++] codireco] .
625 define('G == [codireco] cons cons')
629 J('230 [dup ++] G 5 [x] times pop')