This implementation is meant as a tool for exploring the programming model and method of Joy. Python seems like a great implementation language for Joy for several reasons.
-We can lean on the Python immutable types for our basic semantics and types: ints, floats, strings, and tuples, which enforces functional purity. We get garbage collection for free. Compilation via Cython. Glue language with loads of libraries.
- -The main way to interact with the Joy interpreter is through a simple REPL that you start by running the package:
- -$ python -m joy
-Joypy - Copyright © 2017 Simon Forman
-This program comes with ABSOLUTELY NO WARRANTY; for details type "warranty".
-This is free software, and you are welcome to redistribute it
-under certain conditions; type "sharing" for details.
-Type "words" to see a list of all words, and "[<name>] help" to print the
-docs for a word.
-
-
- <-top
-
-joy? _
-
-The <-top marker points to the top of the (initially empty) stack. You can enter Joy notation at the prompt and a trace of evaluation will be printed followed by the stack and prompt again:
joy? 23 sqr 18 +
- . 23 sqr 18 +
- 23 . sqr 18 +
- 23 . dup mul 18 +
- 23 23 . mul 18 +
- 529 . 18 +
-529 18 . +
- 547 .
-
-547 <-top
-
-joy? In Joy, in addition to the types Boolean, integer, float, and string, there is a single sequence type represented by enclosing a sequence of terms in brackets [...]. This sequence type is used to represent both the stack and the expression. It is a cons list made from Python tuples.
import inspect
-import joy.utils.stack
-
-
-print inspect.getdoc(joy.utils.stack)
-The 0th item in the list will be on the top of the stack and vise versa.
- -joy.utils.stack.list_to_stack([1, 2, 3])
-list(joy.utils.stack.iter_stack((1, (2, (3, ())))))
-This requires reversing the sequence (or iterating backwards) otherwise:
- -stack = ()
-
-for n in [1, 2, 3]:
- stack = n, stack
-
-print stack
-print list(joy.utils.stack.iter_stack(stack))
-Because Joy lists are made out of Python tuples they are immutable, so all Joy datastructures are purely functional.
- -joy() function.¶The joy() function is extrememly simple. It accepts a stack, an expression, and a dictionary, and it iterates through the expression putting values onto the stack and delegating execution to functions it looks up in the dictionary.
Each function is passed the stack, expression, and dictionary and returns them. Whatever the function returns becomes the new stack, expression, and dictionary. (The dictionary is passed to enable e.g. writing words that let you enter new words into the dictionary at runtime, which nothing does yet and may be a bad idea, and the help command.)
import joy.joy
-
-print inspect.getsource(joy.joy.joy)
-The joy() function accepts a "viewer" function which it calls on each iteration passing the current stack and expression just before evaluation. This can be used for tracing, breakpoints, retrying after exceptions, or interrupting an evaluation and saving to disk or sending over the network to resume later. The stack and expression together contain all the state of the computation at each step.
TracePrinter.¶A viewer records each step of the evaluation of a Joy program. The TracePrinter has a facility for printing out a trace of the evaluation, one line per step. Each step is aligned to the current interpreter position, signified by a period separating the stack on the left from the pending expression ("continuation") on the right.
One day I thought, What happens if you rewrite Joy to use CSP? I made all the functions accept and return the expression as well as the stack and found that all the combinators could be rewritten to work by modifying the expression rather than making recursive calls to the joy() function.
import joy.parser
-
-print inspect.getdoc(joy.parser)
-The parser is extremely simple, the undocumented re.Scanner class does most of the tokenizing work and then you just build the tuple structure out of the tokens. There's no Abstract Syntax Tree or anything like that.
print inspect.getsource(joy.parser._parse)
-That's pretty much all there is to it.
- -joy.parser.text_to_expression('1 2 3 4 5') # A simple sequence.
-joy.parser.text_to_expression('[1 2 3] 4 5') # Three items, the first is a list with three items
-joy.parser.text_to_expression('1 23 ["four" [-5.0] cons] 8888') # A mixed bag. cons is
- # a Symbol, no lookup at
- # parse-time. Haiku docs.
-joy.parser.text_to_expression('[][][][][]') # Five empty lists.
-joy.parser.text_to_expression('[[[[[]]]]]') # Five nested lists.
-The Joy library of functions (aka commands, or "words" after Forth usage) encapsulates all the actual functionality (no pun intended) of the Joy system. There are simple functions such as addition add (or +, the library module supports aliases), and combinators which provide control-flow and higher-order operations.
import joy.library
-
-print ' '.join(sorted(joy.library.initialize()))
-Many of the functions are defined in Python, like dip:
print inspect.getsource(joy.library.dip)
-Some functions are defined in equations in terms of other functions. When the interpreter executes a definition function that function just pushes its body expression onto the pending expression (the continuation) and returns control to the interpreter.
- -print joy.library.definitions
-Currently, there's no function to add new definitions to the dictionary from "within" Joy code itself. Adding new definitions remains a meta-interpreter action. You have to do it yourself, in Python, and wash your hands afterward.
-It would be simple enough to define one, but it would open the door to name binding and break the idea that all state is captured in the stack and expression. There's an implicit standard dictionary that defines the actual semantics of the syntactic stack and expression datastructures (which only contain symbols, not the actual functions. Pickle some and see for yourself.)
-Which brings me to talking about one of my hopes and dreams for this notation: "There should be only one." What I mean is that there should be one universal standard dictionary of commands, and all bespoke work done in a UI for purposes takes place by direct interaction and macros. There would be a Grand Refactoring biannually (two years, not six months, that's semi-annually) where any new definitions factored out of the usage and macros of the previous time, along with new algorithms and such, were entered into the dictionary and posted to e.g. IPFS.
-Code should not burgeon wildly, as it does today. The variety of code should map more-or-less to the well-factored variety of human computably-solvable problems. There shouldn't be dozens of chat apps, JS frameworks, programming languages. It's a waste of time, a fractal "thundering herd" attack on human mentality.
-If you read over the other notebooks you'll see that developing code in Joy is a lot like doing simple mathematics, and the descriptions of the code resemble math papers. The code also works the first time, no bugs. If you have any experience programming at all, you are probably skeptical, as I was, but it seems to work: deriving code mathematically seems to lead to fewer errors.
-But my point now is that this great ratio of textual explanation to wind up with code that consists of a few equations and could fit on an index card is highly desirable. Less code has fewer errors. The structure of Joy engenders a kind of thinking that seems to be very effective for developing structured processes.
-There seems to be an elegance and power to the notation.
- -
-First, import what we need.
- -from joy.joy import run
-from joy.library import initialize
-from joy.utils.stack import stack_to_string
-from joy.utils.pretty_print import TracePrinter
-Define a dictionary, an initial stack, and two helper functions to run Joy code and print results for us.
- -D = initialize()
-S = ()
-
-
-def J(text):
- print stack_to_string(run(text, S, D)[0])
-
-
-def V(text):
- tp = TracePrinter()
- run(text, S, D, tp.viewer)
- tp.print_()
-J('23 18 +')
-J('45 30 gcd')
-A viewer records each step of the evaluation of a Joy program. The TracePrinter has a facility for printing out a trace of the evaluation, one line per step. Each step is aligned to the current interpreter position, signified by a period separating the stack on the left from the pending expression ("continuation") on the right. I find these traces beautiful, like a kind of art.
V('23 18 +')
-V('45 30 gcd')
-Here's a longer trace.
- -V('96 27 gcd')
-from notebook_preamble import J, V
-This is what I like to call the functions that just rearrange things on the stack. (One thing I want to mention is that during a hypothetical compilation phase these "stack chatter" words effectively disappear, because we can map the logical stack locations to registers that remain static for the duration of the computation. This remains to be done but it's "off the shelf" technology.)
- -clear¶J('1 2 3 clear')
-dup dupd¶J('1 2 3 dup')
-J('1 2 3 dupd')
-enstacken disenstacken stack unstack¶(I may have these paired up wrong. I.e. disenstacken should be unstack and vice versa.)
J('1 2 3 enstacken') # Replace the stack with a quote of itself.
-J('4 5 6 [3 2 1] disenstacken') # Unpack a list onto the stack.
-J('1 2 3 stack') # Get the stack on the stack.
-J('1 2 3 [4 5 6] unstack') # Replace the stack with the list on top.
- # The items appear reversed but they are not,
- # 4 is on the top of both the list and the stack.
-pop popd popop¶J('1 2 3 pop')
-J('1 2 3 popd')
-J('1 2 3 popop')
-roll< rolldown roll> rollup¶The "down" and "up" refer to the movement of two of the top three items (displacing the third.)
- -J('1 2 3 roll<')
-J('1 2 3 roll>')
-swap¶J('1 2 3 swap')
-tuck over¶J('1 2 3 tuck')
-J('1 2 3 over')
-unit quoted unquoted¶J('1 2 3 unit')
-J('1 2 3 quoted')
-J('1 [2] 3 unquoted')
-V('1 [dup] 3 unquoted') # Unquoting evaluates. Be aware.
-concat swoncat shunt¶J('[1 2 3] [4 5 6] concat')
-J('[1 2 3] [4 5 6] swoncat')
-J('[1 2 3] [4 5 6] shunt')
-cons swons uncons¶J('1 [2 3] cons')
-J('[2 3] 1 swons')
-J('[1 2 3] uncons')
-first second third rest¶J('[1 2 3 4] first')
-J('[1 2 3 4] second')
-J('[1 2 3 4] third')
-J('[1 2 3 4] rest')
-flatten¶J('[[1] [2 [3] 4] [5 6]] flatten')
-getitem at of drop take¶at and getitem are the same function. of == swap at
J('[10 11 12 13 14] 2 getitem')
-J('[1 2 3 4] 0 at')
-J('2 [1 2 3 4] of')
-J('[1 2 3 4] 2 drop')
-J('[1 2 3 4] 2 take') # reverses the order
-reverse could be defines as reverse == dup size take
remove¶J('[1 2 3 1 4] 1 remove')
-reverse¶J('[1 2 3 4] reverse')
-size¶J('[1 1 1 1] size')
-swaack¶"Swap stack" swap the list on the top of the stack for the stack, and put the old stack on top of the new one. Think of it as a context switch. Niether of the lists/stacks change their order.
- -J('1 2 3 [4 5 6] swaack')
-choice select¶J('23 9 1 choice')
-J('23 9 0 choice')
-J('[23 9 7] 1 select') # select is basically getitem, should retire it?
-J('[23 9 7] 0 select')
-zip¶J('[1 2 3] [6 5 4] zip')
-J('[1 2 3] [6 5 4] zip [sum] map')
-+ add¶J('23 9 +')
-- sub¶J('23 9 -')
-* mul¶J('23 9 *')
-/ div floordiv truediv¶J('23 9 /')
-J('23 -9 truediv')
-J('23 9 div')
-J('23 9 floordiv')
-J('23 -9 div')
-J('23 -9 floordiv')
-% mod modulus rem remainder¶J('23 9 %')
-neg¶J('23 neg -5 neg')
-J('2 10 pow')
-sqr sqrt¶J('23 sqr')
-J('23 sqrt')
-++ succ -- pred¶J('1 ++')
-J('1 --')
-<< lshift >> rshift¶J('8 1 <<')
-J('8 1 >>')
-average¶J('[1 2 3 5] average')
-range range_to_zero down_to_zero¶J('5 range')
-J('5 range_to_zero')
-J('5 down_to_zero')
-product¶J('[1 2 3 5] product')
-sum¶J('[1 2 3 5] sum')
-min¶J('[1 2 3 5] min')
-gcd¶J('45 30 gcd')
-least_fraction¶If we represent fractions as a quoted pair of integers [q d] this word reduces them to their ... least common factors or whatever.
- -J('[45 30] least_fraction')
-J('[23 12] least_fraction')
-? truthy¶Get the Boolean value of the item on the top of the stack.
- -J('23 truthy')
-J('[] truthy') # Python semantics.
-J('0 truthy')
-? == dup truthyV('23 ?')
-J('[] ?')
-J('0 ?')
-& and¶J('23 9 &')
-!= <> ne¶J('23 9 !=')
-The usual suspects:
-< lt<= le = eq> gt>= genotor^ xor¶J('1 1 ^')
-J('1 0 ^')
-help¶J('[help] help')
-parse¶J('[parse] help')
-J('1 "2 [3] dup" parse')
-run¶Evaluate a quoted Joy sequence.
- -J('[1 2 dup + +] run')
-app1 app2 app3¶J('[app1] help')
-J('10 4 [sqr *] app1')
-J('10 3 4 [sqr *] app2')
-J('[app2] help')
-J('10 2 3 4 [sqr *] app3')
-anamorphism¶Given an initial value, a predicate function [P], and a generator function [G], the anamorphism combinator creates a sequence.
n [P] [G] anamorphism
----------------------------
- [...]
-
-Example, range:
range == [0 <=] [1 - dup] anamorphismJ('3 [0 <=] [1 - dup] anamorphism')
-branch¶J('3 4 1 [+] [*] branch')
-J('3 4 0 [+] [*] branch')
-cleave¶... x [P] [Q] cleave
-
-From the original Joy docs: "The cleave combinator expects two quotations, and below that an item x
-It first executes [P], with x on top, and saves the top result element.
-Then it executes [Q], again with x, and saves the top result.
-Finally it restores the stack to what it was below x and pushes the two
-results P(X) and Q(X)."
Note that P and Q can use items from the stack freely, since the stack (below x) is restored. cleave is a kind of parallel primitive, and it would make sense to create a version that uses, e.g. Python threads or something, to actually run P and Q concurrently. The current implementation of cleave is a definition in terms of app2:
cleave == [i] app2 [popd] dipJ('10 2 [+] [-] cleave')
-dip dipd dipdd¶J('1 2 3 4 5 [+] dip')
-J('1 2 3 4 5 [+] dipd')
-J('1 2 3 4 5 [+] dipdd')
-dupdip¶Expects a quoted program [Q] on the stack and some item under it, dup the item and dip the quoted program under it.
n [Q] dupdip == n Q nV('23 [++] dupdip *') # N(N + 1)
-genrec primrec¶J('[genrec] help')
-J('3 [1 <=] [] [dup --] [i *] genrec')
-i¶V('1 2 3 [+ +] i')
-ifte¶[predicate] [then] [else] ifteJ('1 2 [1] [+] [*] ifte')
-J('1 2 [0] [+] [*] ifte')
-infra¶V('1 2 3 [4 5 6] [* +] infra')
-loop¶J('[loop] help')
-V('3 dup [1 - dup] loop')
-map pam¶J('10 [1 2 3] [*] map')
-J('10 5 [[*][/][+][-]] pam')
-J('1 2 3 4 5 [+] nullary')
-J('1 2 3 4 5 [+] unary')
-J('1 2 3 4 5 [+] binary') # + has arity 2 so this is technically pointless...
-J('1 2 3 4 5 [+] ternary')
-step¶J('[step] help')
-V('0 [1 2 3] [+] step')
-times¶V('3 2 1 2 [+] times')
-b¶J('[b] help')
-V('1 2 [3] [4] b')
-while¶[predicate] [body] whileJ('3 [0 >] [dup --] while')
-x¶J('[x] help')
-V('1 [2] [i 3] x') # Kind of a pointless example.
-void¶Implements Laws of Form arithmetic over quote-only datastructures (that is, datastructures that consist soley of containers, without strings or numbers or anything else.)
- -J('[] void')
-J('[[]] void')
-J('[[][[]]] void')
-J('[[[]][[][]]] void')
-If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6 and 9. The sum of these multiples is 23.
-
-Find the sum of all the multiples of 3 or 5 below 1000.from notebook_preamble import J, V, define
-Let's create a predicate that returns True if a number is a multiple of 3 or 5 and False otherwise.
define('P == [3 % not] dupdip 5 % not or')
-V('80 P')
-Given the predicate function P a suitable program is:
PE1 == 1000 range [P] filter sum
-
-This function generates a list of the integers from 0 to 999, filters
-that list by P, and then sums the result.
Logically this is fine, but pragmatically we are doing more work than we -should be; we generate one thousand integers but actually use less than -half of them. A better solution would be to generate just the multiples -we want to sum, and to add them as we go rather than storing them and -adding summing them at the end.
-At first I had the idea to use two counters and increase them by three -and five, respectively. This way we only generate the terms that we -actually want to sum. We have to proceed by incrementing the counter -that is lower, or if they are equal, the three counter, and we have to -take care not to double add numbers like 15 that are multiples of both -three and five.
-This seemed a little clunky, so I tried a different approach.
-Consider the first few terms in the series:
- -3 5 6 9 10 12 15 18 20 21 ...
-
-Subtract each number from the one after it (subtracting 0 from 3):
- -3 5 6 9 10 12 15 18 20 21 24 25 27 30 ...
-0 3 5 6 9 10 12 15 18 20 21 24 25 27 ...
--------------------------------------------
-3 2 1 3 1 2 3 3 2 1 3 1 2 3 ...
-
-You get this lovely repeating palindromic sequence:
- -3 2 1 3 1 2 3
-
-To make a counter that increments by factors of 3 and 5 you just add -these differences to the counter one-by-one in a loop.
-To make use of this sequence to increment a counter and sum terms as we -go we need a function that will accept the sum, the counter, and the next -term to add, and that adds the term to the counter and a copy of the -counter to the running sum. This function will do that:
- -PE1.1 == + [+] dupdipdefine('PE1.1 == + [+] dupdip')
-V('0 0 3 PE1.1')
-V('0 0 [3 2 1 3 1 2 3] [PE1.1] step')
-So one step through all seven terms brings the counter to 15 and the total to 60.
1000 / 15
-66 * 15
-1000 - 990
-We only want the terms less than 1000.
- -999 - 990
-That means we want to run the full list of numbers sixty-six times to get to 990 and then the first four numbers 3 2 1 3 to get to 999.
- -define('PE1 == 0 0 66 [[3 2 1 3 1 2 3] [PE1.1] step] times [3 2 1 3] [PE1.1] step pop')
-J('PE1')
-This form uses no extra storage and produces no unused summands. It's -good but there's one more trick we can apply. The list of seven terms -takes up at least seven bytes. But notice that all of the terms are less -than four, and so each can fit in just two bits. We could store all -seven terms in just fourteen bits and use masking and shifts to pick out -each term as we go. This will use less space and save time loading whole -integer terms from the list.
- - 3 2 1 3 1 2 3
-0b 11 10 01 11 01 10 11 == 148110b11100111011011
-define('PE1.2 == [3 & PE1.1] dupdip 2 >>')
-V('0 0 14811 PE1.2')
-V('3 3 3702 PE1.2')
-V('0 0 14811 7 [PE1.2] times pop')
-And so we have at last:
- -define('PE1 == 0 0 66 [14811 7 [PE1.2] times pop] times 14811 4 [PE1.2] times popop')
-J('PE1')
-Let's refactor.
- - 14811 7 [PE1.2] times pop
- 14811 4 [PE1.2] times pop
- 14811 n [PE1.2] times pop
-n 14811 swap [PE1.2] times popdefine('PE1.3 == 14811 swap [PE1.2] times pop')
-Now we can simplify the definition above:
- -define('PE1 == 0 0 66 [7 PE1.3] times 4 PE1.3 pop')
-J('PE1')
-Here's our joy program all in one place. It doesn't make so much sense, but if you have read through the above description of how it was derived I hope it's clear.
- -PE1.1 == + [+] dupdip
-PE1.2 == [3 & PE1.1] dupdip 2 >>
-PE1.3 == 14811 swap [PE1.2] times pop
-PE1 == 0 0 66 [7 PE1.3] times 4 PE1.3 popIt's a little clunky iterating sixty-six times though the seven numbers then four more. In the Generator Programs notebook we derive a generator that can be repeatedly driven by the x combinator to produce a stream of the seven numbers repeating over and over again.
define('PE1.terms == [0 swap [dup [pop 14811] [] branch [3 &] dupdip 2 >>] dip rest cons]')
-J('PE1.terms 21 [x] times')
-We know from above that we need sixty-six times seven then four more terms to reach up to but not over one thousand.
- -J('7 66 * 4 +')
-J('PE1.terms 466 [x] times pop')
-J('[PE1.terms 466 [x] times pop] run sum')
-Now we can use PE1.1 to accumulate the terms as we go, and then pop the generator and the counter from the stack when we're done, leaving just the sum.
J('0 0 PE1.terms 466 [x [PE1.1] dip] times popop')
-Consider finding the sum of the positive integers less than or equal to ten.
- -J('[10 9 8 7 6 5 4 3 2 1] sum')
-Instead of summing them, observe:
- -
10 9 8 7 6
-+ 1 2 3 4 5
----- -- -- -- --
- 11 11 11 11 11
-
- 11 * 5 = 55
-
-From the above example we can deduce that the sum of the first N positive integers is:
- -(N + 1) * N / 2
-
-(The formula also works for odd values of N, I'll leave that to you if you want to work it out or you can take my word for it.)
- -define('F == dup ++ * 2 floordiv')
-V('10 F')
-We can apply the same reasoning to the PE1 problem.
-Between 0 and 990 inclusive there are sixty-six "blocks" of seven terms each, starting with:
- -[3 5 6 9 10 12 15]
-
-And ending with:
- -[978 980 981 984 985 987 990]
-
-If we reverse one of these two blocks and sum pairs...
- -J('[3 5 6 9 10 12 15] reverse [978 980 981 984 985 987 990] zip')
-J('[3 5 6 9 10 12 15] reverse [978 980 981 984 985 987 990] zip [sum] map')
-(Interesting that the sequence of seven numbers appears again in the rightmost digit of each term.)
- -J('[ 3 5 6 9 10 12 15] reverse [978 980 981 984 985 987 990] zip [sum] map sum')
-Since there are sixty-six blocks and we are pairing them up, there must be thirty-three pairs, each of which sums to 6945. We also have these additional unpaired terms between 990 and 1000:
- -993 995 996 999
-
-So we can give the "sum of all the multiples of 3 or 5 below 1000" like so:
- -J('6945 33 * [993 995 996 999] cons sum')
-It's worth noting, I think, that this same reasoning holds for any two numbers $n$ and $m$ the multiples of which we hope to sum. The multiples would have a cycle of differences of length $k$ and so we could compute the sum of $Nk$ multiples as above.
-The sequence of differences will always be a palidrome. Consider an interval spanning the least common multiple of $n$ and $m$:
- -| | | | | | | |
-| | | | |
-
-Here we have 4 and 7, and you can read off the sequence of differences directly from the diagram: 4 3 1 4 2 2 4 1 3 4.
-Geometrically, the actual values of $n$ and $m$ and their lcm don't matter, the pattern they make will always be symmetrical around its midpoint. The same reasoning holds for multiples of more than two numbers.
- -Of course, the simplest joy program for the first Project Euler problem is just:
- -PE1 == 233168
-
-Fin.
- -[Given] a sequence of digits (your puzzle input) and find the sum of all digits that match the next digit in the list. The list is circular, so the digit after the last digit is the first digit in the list.
-For example:
-from notebook_preamble import J, V, define
-I'll assume the input is a Joy sequence of integers (as opposed to a string or something else.)
-We might proceed by creating a word that makes a copy of the sequence with the first item moved to the last, and zips it with the original to make a list of pairs, and a another word that adds (one of) each pair to a total if the pair matches.
- -AoC2017.1 == pair_up total_matches
-
-Let's derive pair_up:
[a b c] pair_up
--------------------------
- [[a b] [b c] [c a]]Straightforward (although the order of each pair is reversed, due to the way zip works, but it doesn't matter for this program):
[a b c] dup
-[a b c] [a b c] uncons swap
-[a b c] [b c] a unit concat
-[a b c] [b c a] zip
-[[b a] [c b] [a c]]define('pair_up == dup uncons swap unit concat zip')
-J('[1 2 3] pair_up')
-J('[1 2 2 3] pair_up')
-Now we need to derive total_matches. It will be a step function:
total_matches == 0 swap [F] step
-
-Where F will have the pair to work with, and it will basically be a branch or ifte.
total [n m] F
-
-It will probably be easier to write if we dequote the pair:
- - total [n m] i F′
-----------------------
- total n m F′
-
-Now F′ becomes just:
total n m [=] [pop +] [popop] ifte
-
-So:
- -F == i [=] [pop +] [popop] ifte
-
-And thus:
- -total_matches == 0 swap [i [=] [pop +] [popop] ifte] stepdefine('total_matches == 0 swap [i [=] [pop +] [popop] ifte] step')
-J('[1 2 3] pair_up total_matches')
-J('[1 2 2 3] pair_up total_matches')
-Now we can define our main program and evaluate it on the examples.
- -define('AoC2017.1 == pair_up total_matches')
-J('[1 1 2 2] AoC2017.1')
-J('[1 1 1 1] AoC2017.1')
-J('[1 2 3 4] AoC2017.1')
-J('[9 1 2 1 2 1 2 9] AoC2017.1')
-J('[9 1 2 1 2 1 2 9] AoC2017.1')
- pair_up == dup uncons swap unit concat zip
-total_matches == 0 swap [i [=] [pop +] [popop] ifte] step
-
- AoC2017.1 == pair_up total_matchesNow the paired digit is "halfway" round.
- -[a b c d] dup size 2 / [drop] [take reverse] cleave concat zipJ('[1 2 3 4] dup size 2 / [drop] [take reverse] cleave concat zip')
-I realized that each pair is repeated...
- -J('[1 2 3 4] dup size 2 / [drop] [take reverse] cleave zip')
-define('AoC2017.1.extra == dup size 2 / [drop] [take reverse] cleave zip swap pop total_matches 2 *')
-J('[1 2 1 2] AoC2017.1.extra')
-J('[1 2 2 1] AoC2017.1.extra')
-J('[1 2 3 4 2 5] AoC2017.1.extra')
-With Joy a great deal of the heuristics from Forth programming carry over nicely. For example, refactoring into small, well-scoped commands with mnemonic names...
- - rotate_seq == uncons swap unit concat
- pair_up == dup rotate_seq zip
- add_if_match == [=] [pop +] [popop] ifte
- total_matches == [i add_if_match] step_zero
-
- AoC2017.1 == pair_up total_matches
-
- half_of_size == dup size 2 /
- split_at == [drop] [take reverse] cleave
- pair_up.extra == half_of_size split_at zip swap pop
-
- AoC2017.1.extra == pair_up.extra total_matches 2 *For each row, determine the difference between the largest value and the smallest value; the checksum is the sum of all of these differences.
-For example, given the following spreadsheet:
- -5 1 9 5
-7 5 3
-2 4 6 8
-
-In this example, the spreadsheet's checksum would be 8 + 4 + 6 = 18.
- -from notebook_preamble import J, V, define
-I'll assume the input is a Joy sequence of sequences of integers.
- -[[5 1 9 5]
- [7 5 3]
- [2 4 6 8]]
-
-So, obviously, the initial form will be a step function:
AoC2017.2 == 0 swap [F +] stepThis function F must get the max and min of a row of numbers and subtract. We can define a helper function maxmin which does this:
define('maxmin == [max] [min] cleave')
-J('[1 2 3] maxmin')
-Then F just does that then subtracts the min from the max:
F == maxmin -
-
-So:
- -define('AoC2017.2 == [maxmin - +] step_zero')
-J('''
-
-[[5 1 9 5]
- [7 5 3]
- [2 4 6 8]] AoC2017.2
-
-''')
-...find the only two numbers in each row where one evenly divides the other - that is, where the result of the division operation is a whole number. They would like you to find those numbers on each line, divide them, and add up each line's result.
-For example, given the following spreadsheet:
- -5 9 2 8
-9 4 7 3
-3 8 6 5
-
-In this example, the sum of the results would be 4 + 3 + 2 = 9.
-What is the sum of each row's result in your puzzle input?
- -J('[5 9 2 8] sort reverse')
-J('[9 8 5 2] uncons [swap [divmod] cons] dupdip')
-[9 8 5 2] uncons [swap [divmod] cons F] dupdip G
- [8 5 2] [9 divmod] F [8 5 2] GV('[8 5 2] [9 divmod] [uncons swap] dip dup [i not] dip')
-Let's think.
-Given a sorted sequence (from highest to lowest) we want to
-loop I think¶[a b c d] True [Q] loop
-[a b c d] Q [Q] loop
-
-Q should either leave the result and False, or the rest and True.
[a b c d] Q
------------------
- result 0
-
- [a b c d] Q
------------------
- [b c d] 1This suggests that Q should start with:
[a b c d] uncons dup roll<
-[b c d] [b c d] a
-
-Now we just have to pop it if we don't need it.
[b c d] [b c d] a [P] [T] [cons] app2 popdd [E] primrec
-[b c d] [b c d] [a P] [a T] [E] primrec
-
-w/ Q == [% not] [T] [F] primrec
-
- [a b c d] uncons
- a [b c d] tuck
-[b c d] a [b c d] uncons
-[b c d] a b [c d] roll>
-[b c d] [c d] a b Q
-[b c d] [c d] a b [% not] [T] [F] primrec
-
-[b c d] [c d] a b T
-[b c d] [c d] a b / roll> popop 0
-
-[b c d] [c d] a b F Q
-[b c d] [c d] a b pop swap uncons ... Q
-[b c d] [c d] a swap uncons ... Q
-[b c d] a [c d] uncons ... Q
-[b c d] a c [d] roll> Q
-[b c d] [d] a c Q
-
-Q == [% not] [/ roll> popop 0] [pop swap uncons roll>] primrec
-
-uncons tuck uncons roll> QJ('[8 5 3 2] 9 [swap] [% not] [cons] app2 popdd')
- [a b c d] uncons
- a [b c d] tuck
-[b c d] a [b c d] [not] [popop 1] [Q] ifte
-
-[b c d] a [] popop 1
-[b c d] 1
-
-[b c d] a [b c d] Q
-
-
- a [...] Q
----------------
- result 0
-
- a [...] Q
----------------
- 1
-
-
-w/ Q == [first % not] [first / 0] [rest [not] [popop 1]] [ifte]
-
-
-
-a [b c d] [first % not] [first / 0] [rest [not] [popop 1]] [ifte]
-a [b c d] first % not
-a b % not
-a%b not
-bool(a%b)
-
-a [b c d] [first % not] [first / 0] [rest [not] [popop 1]] [ifte]
-a [b c d] first / 0
-a b / 0
-a/b 0
-
-a [b c d] [first % not] [first / 0] [rest [not] [popop 1]] [ifte]
-a [b c d] rest [not] [popop 1] [Q] ifte
-a [c d] [not] [popop 1] [Q] ifte
-a [c d] [not] [popop 1] [Q] ifte
-
-a [c d] [not] [popop 1] [Q] ifte
-a [c d] not
-
-a [] popop 1
-1
-
-a [c d] Q
-
-
-uncons tuck [first % not] [first / 0] [rest [not] [popop 1]] [ifte]First, I made a function G that expects a number and a sequence of candidates and return the result or zero:
n [...] G
----------------
- result
-
- n [...] G
----------------
- 0
-
-It's a recursive function that conditionally executes the recursive part of its recursive branch
- -[Pg] [E] [R1 [Pi] [T]] [ifte] genrec
-
-The recursive branch is the else-part of the inner ifte:
G == [Pg] [E] [R1 [Pi] [T]] [ifte] genrec
- == [Pg] [E] [R1 [Pi] [T] [G] ifte] ifte
-
-But this is in hindsight. Going forward I derived:
- -G == [first % not]
- [first /]
- [rest [not] [popop 0]]
- [ifte] genrec
-
-The predicate detects if the n can be evenly divided by the first item in the list. If so, the then-part returns the result. Otherwise, we have:
n [m ...] rest [not] [popop 0] [G] ifte
-n [...] [not] [popop 0] [G] ifte
-
-This ifte guards against empty sequences and returns zero in that case, otherwise it executes G.
define('G == [first % not] [first /] [rest [not] [popop 0]] [ifte] genrec')
-Now we need a word that uses G on each (head, tail) pair of a sequence until it finds a (non-zero) result. It's going to be designed to work on a stack that has some candidate n, a sequence of possible divisors, and a result that is zero to signal to continue (a non-zero value implies that it is the discovered result):
n [...] p find-result
----------------------------
- result
-
-It applies G using nullary because if it fails with one candidate it needs the list to get the next one (the list is otherwise consumed by G.)
find-result == [0 >] [roll> popop] [roll< popop uncons [G] nullary] primrec
-
-n [...] p [0 >] [roll> popop] [roll< popop uncons [G] nullary] primrec
-
-The base-case is trivial, return the (non-zero) result. The recursive branch...
- -n [...] p roll< popop uncons [G] nullary find-result
-[...] p n popop uncons [G] nullary find-result
-[...] uncons [G] nullary find-result
-m [..] [G] nullary find-result
-m [..] p find-result
-
-The puzzle states that the input is well-formed, meaning that we can expect a result before the row sequence empties and so do not need to guard the uncons.
define('find-result == [0 >] [roll> popop] [roll< popop uncons [G] nullary] primrec')
-J('[11 9 8 7 3 2] 0 tuck find-result')
-In order to get the thing started, we need to sort the list in descending order, then prime the find-result function with a dummy candidate value and zero ("continue") flag.
define('prep-row == sort reverse 0 tuck')
-Now we can define our program.
- -define('AoC20017.2.extra == [prep-row find-result +] step_zero')
-J('''
-
-[[5 9 2 8]
- [9 4 7 3]
- [3 8 6 5]] AoC20017.2.extra
-
-''')
-You come across an experimental new kind of memory stored on an infinite two-dimensional grid.
-Each square on the grid is allocated in a spiral pattern starting at a location marked 1 and then counting up while spiraling outward. For example, the first few squares are allocated like this:
- -17 16 15 14 13
-18 5 4 3 12
-19 6 1 2 11
-20 7 8 9 10
-21 22 23---> ...
-
-While this is very space-efficient (no squares are skipped), requested data must be carried back to square 1 (the location of the only access port for this memory system) by programs that can only move up, down, left, or right. They always take the shortest path: the Manhattan Distance between the location of the data and square 1.
-For example:
-How many steps are required to carry the data from the square identified in your puzzle input all the way to the access port?
- -I freely admit that I worked out the program I wanted to write using graph paper and some Python doodles. There's no point in trying to write a Joy program until I'm sure I understand the problem well enough.
-The first thing I did was to write a column of numbers from 1 to n (32 as it happens) and next to them the desired output number, to look for patterns directly:
- -1 0
-2 1
-3 2
-4 1
-5 2
-6 1
-7 2
-8 1
-9 2
-10 3
-11 2
-12 3
-13 4
-14 3
-15 2
-16 3
-17 4
-18 3
-19 2
-20 3
-21 4
-22 3
-23 2
-24 3
-25 4
-26 5
-27 4
-28 3
-29 4
-30 5
-31 6
-32 5There are four groups repeating for a given "rank", then the pattern enlarges and four groups repeat again, etc.
- - 1 2
- 3 2 3 4
- 5 4 3 4 5 6
- 7 6 5 4 5 6 7 8
-9 8 7 6 5 6 7 8 9 10
-
-Four of this pyramid interlock to tile the plane extending from the initial "1" square.
- - 2 3 | 4 5 | 6 7 | 8 9
- 10 11 12 13|14 15 16 17|18 19 20 21|22 23 24 25
-
-And so on.
- -We can figure out the pattern for a row of the pyramid at a given "rank" $k$:
-$2k - 1, 2k - 2, ..., k, k + 1, k + 2, ..., 2k$
-or
-$k + (k - 1), k + (k - 2), ..., k, k + 1, k + 2, ..., k + k$
-This shows that the series consists at each place of $k$ plus some number that begins at $k - 1$, decreases to zero, then increases to $k$. Each row has $2k$ members.
- -Let's figure out how, given an index into a row, we can calculate the value there. The index will be from 0 to $k - 1$.
-Let's look at an example, with $k = 4$:
- -0 1 2 3 4 5 6 7
-7 6 5 4 5 6 7 8k = 4
-Subtract $k$ from the index and take the absolute value:
- -for n in range(2 * k):
- print abs(n - k),
-Not quite. Subtract $k - 1$ from the index and take the absolute value:
- -for n in range(2 * k):
- print abs(n - (k - 1)),
-Great, now add $k$...
- -for n in range(2 * k):
- print abs(n - (k - 1)) + k,
-So to write a function that can give us the value of a row at a given index:
- -def row_value(k, i):
- i %= (2 * k) # wrap the index at the row boundary.
- return abs(i - (k - 1)) + k
-k = 5
-for i in range(2 * k):
- print row_value(k, i),
-(I'm leaving out details of how I figured this all out and just giving the relevent bits. It took a little while to zero in of the aspects of the pattern that were important for the task.)
- -Now that we can compute the desired output value for a given rank and the offset (index) into that rank, we need to determine how to find the rank and offset of a number.
-The rank is easy to find by iteratively stripping off the amount already covered by previous ranks until you find the one that brackets the target number. Because each row is $2k$ places and there are $4$ per rank each rank contains $8k$ places. Counting the initial square we have:
-$corner_k = 1 + \sum_{n=1}^k 8n$
-I'm not mathematically sophisticated enough to turn this directly into a formula (but Sympy is, see below.) I'm going to write a simple Python function to iterate and search:
- -def rank_and_offset(n):
- assert n >= 2 # Guard the domain.
- n -= 2 # Subtract two,
- # one for the initial square,
- # and one because we are counting from 1 instead of 0.
- k = 1
- while True:
- m = 8 * k # The number of places total in this rank, 4(2k).
- if n < m:
- return k, n % (2 * k)
- n -= m # Remove this rank's worth.
- k += 1
-for n in range(2, 51):
- print n, rank_and_offset(n)
-for n in range(2, 51):
- k, i = rank_and_offset(n)
- print n, row_value(k, i)
-def row_value(k, i):
- return abs(i - (k - 1)) + k
-
-
-def rank_and_offset(n):
- n -= 2 # Subtract two,
- # one for the initial square,
- # and one because we are counting from 1 instead of 0.
- k = 1
- while True:
- m = 8 * k # The number of places total in this rank, 4(2k).
- if n < m:
- return k, n % (2 * k)
- n -= m # Remove this rank's worth.
- k += 1
-
-
-def aoc20173(n):
- if n <= 1:
- return 0
- k, i = rank_and_offset(n)
- return row_value(k, i)
-aoc20173(23)
-aoc20173(23000)
-aoc20173(23000000000000)
-from sympy import floor, lambdify, solve, symbols
-from sympy import init_printing
-init_printing()
-k = symbols('k')
-Since
-$1 + 2 + 3 + ... + N = \frac{N(N + 1)}{2}$
-and
-$\sum_{n=1}^k 8n = 8(\sum_{n=1}^k n) = 8\frac{k(k + 1)}{2}$
-We want:
- -E = 2 + 8 * k * (k + 1) / 2 # For the reason for adding 2 see above.
-
-E
-We can write a function to solve for $k$ given some $n$...
- -def rank_of(n):
- return floor(max(solve(E - n, k))) + 1
-First solve() for $E - n = 0$ which has two solutions (because the equation is quadratic so it has two roots) and since we only care about the larger one we use max() to select it. It will generally not be a nice integer (unless $n$ is the number of an end-corner of a rank) so we take the floor() and add 1 to get the integer rank of $n$. (Taking the ceiling() gives off-by-one errors on the rank boundaries. I don't know why. I'm basically like a monkey doing math here.) =-D
It gives correct answers:
- -for n in (9, 10, 25, 26, 49, 50):
- print n, rank_of(n)
-And it runs much faster (at least for large numbers):
- -%time rank_of(23000000000000) # Compare runtime with rank_and_offset()!
-%time rank_and_offset(23000000000000)
-After finding the rank you would still have to find the actual value of the rank's first corner and subtract it (plus 2) from the number and compute the offset as above and then the final output, but this overhead is partially shared by the other method, and overshadowed by the time it (the other iterative method) would take for really big inputs.
-The fun thing to do here would be to graph the actual runtime of both methods against each other to find the trade-off point.
- -Sympy is a symbolic math library, and it supports symbolic manipulation of equations. I can put in $y$ (instead of a value) and ask it to solve for $k$.
- -y = symbols('y')
-g, f = solve(E - y, k)
-The equation is quadratic so there are two roots, we are interested in the greater one...
- -g
-f
-Now we can take the floor(), add 1, and lambdify() the equation to get a Python function that calculates the rank directly.
floor(f) + 1
-F = lambdify(y, floor(f) + 1)
-for n in (9, 10, 25, 26, 49, 50):
- print n, int(F(n))
-It's pretty fast.
- -%time int(F(23000000000000)) # The clear winner.
-Knowing the equation we could write our own function manually, but the speed is no better.
- -from math import floor as mfloor, sqrt
-
-def mrank_of(n):
- return int(mfloor(sqrt(23000000000000 - 1) / 2 - 0.5) + 1)
-%time mrank_of(23000000000000)
-Now that we have a fast way to get the rank, we still need to use it to compute the offset into a pyramid row.
- -def offset_of(n, k):
- return (n - 2 + 4 * k * (k - 1)) % (2 * k)
-(Note the sneaky way the sign changes from $k(k + 1)$ to $k(k - 1)$. This is because we want to subract the $(k - 1)$th rank's total places (its own and those of lesser rank) from our $n$ of rank $k$. Substituting $k - 1$ for $k$ in $k(k + 1)$ gives $(k - 1)(k - 1 + 1)$, which of course simplifies to $k(k - 1)$.)
- -offset_of(23000000000000, 2397916)
-So, we can compute the rank, then the offset, then the row value.
- -def rank_of(n):
- return int(mfloor(sqrt(n - 1) / 2 - 0.5) + 1)
-
-
-def offset_of(n, k):
- return (n - 2 + 4 * k * (k - 1)) % (2 * k)
-
-
-def row_value(k, i):
- return abs(i - (k - 1)) + k
-
-
-def aoc20173(n):
- k = rank_of(n)
- i = offset_of(n, k)
- return row_value(k, i)
-aoc20173(23)
-aoc20173(23000)
-aoc20173(23000000000000)
-%time aoc20173(23000000000000000000000000) # Fast for large values.
-At this point I feel confident that I can implement a concise version of this code in Joy. ;-)
- -from notebook_preamble import J, V, define
-rank_of¶ n rank_of
----------------
- k
-
-The translation is straightforward.
- -int(floor(sqrt(n - 1) / 2 - 0.5) + 1)
-
-rank_of == -- sqrt 2 / 0.5 - floor ++define('rank_of == -- sqrt 2 / 0.5 - floor ++')
-offset_of¶ n k offset_of
--------------------
- i
-
-(n - 2 + 4 * k * (k - 1)) % (2 * k)
-
-A little tricky...
- -n k dup 2 *
-n k k 2 *
-n k k*2 [Q] dip %
-n k Q k*2 %
-
-n k dup --
-n k k --
-n k k-1 4 * * 2 + -
-n k*k-1*4 2 + -
-n k*k-1*4+2 -
-n-k*k-1*4+2
-
-n-k*k-1*4+2 k*2 %
-n-k*k-1*4+2%k*2
-
-Ergo:
- -offset_of == dup 2 * [dup -- 4 * * 2 + -] dip %define('offset_of == dup 2 * [dup -- 4 * * 2 + -] dip %')
-row_value¶ k i row_value
--------------------
- n
-
-abs(i - (k - 1)) + k
-
-k i over -- - abs +
-k i k -- - abs +
-k i k-1 - abs +
-k i-k-1 abs +
-k |i-k-1| +
-k+|i-k-1|define('row_value == over -- - abs +')
-aoc2017.3¶ n aoc2017.3
------------------
- m
-
-n dup rank_of
-n k [offset_of] dupdip
-n k offset_of k
-i k swap row_value
-k i row_value
-mdefine('aoc2017.3 == dup rank_of [offset_of] dupdip swap row_value')
-J('23 aoc2017.3')
-J('23000 aoc2017.3')
-V('23000000000000 aoc2017.3')
- rank_of == -- sqrt 2 / 0.5 - floor ++
-offset_of == dup 2 * [dup -- 4 * * 2 + -] dip %
-row_value == over -- - abs +
-
-aoc2017.3 == dup rank_of [offset_of] dupdip swap row_valueTo ensure security, a valid passphrase must contain no duplicate words.
-For example:
-The system's full passphrase list is available as your puzzle input. How many passphrases are valid?
- -from notebook_preamble import J, V, define
-I'll assume the input is a Joy sequence of sequences of integers.
- -[[5 1 9 5]
- [7 5 4 3]
- [2 4 6 8]]
-
-So, obviously, the initial form will be a step function:
AoC2017.4 == 0 swap [F +] stepF == [size] [unique size] cleave =The step_zero combinator includes the 0 swap that would normally open one of these definitions:
J('[step_zero] help')
-AoC2017.4 == [F +] step_zerodefine('AoC2017.4 == [[size] [unique size] cleave = +] step_zero')
-J('''
-
-[[5 1 9 5]
- [7 5 4 3]
- [2 4 6 8]] AoC2017.4
-
-''')
-...a list of the offsets for each jump. Jumps are relative: -1 moves to the previous instruction, and 2 skips the next one. Start at the first instruction in the list. The goal is to follow the jumps until one leads outside the list.
-In addition, these instructions are a little strange; after each jump, the offset of that instruction increases by 1. So, if you come across an offset of 3, you would move three instructions forward, but change it to a 4 for the next time it is encountered.
-For example, consider the following list of jump offsets:
- -0
-3
-0
-1
--3
-
-Positive jumps ("forward") move downward; negative jumps move upward. For legibility in this example, these offset values will be written all on one line, with the current instruction marked in parentheses. The following steps would be taken before an exit is found:
-In this example, the exit is reached in 5 steps.
-How many steps does it take to reach the exit?
- -For now, I'm going to assume a starting state with the size of the sequence pre-computed. We need it to define the exit condition and it is a trivial preamble to generate it. We then need and index and a step-count, which are both initially zero. Then we have the sequence itself, and some recursive function F that does the work.
size index step-count [...] F
------------------------------------
- step-count
-
-F == [P] [T] [R1] [R2] genrec
-
-Later on I was thinking about it and the Forth heuristic came to mind, to wit: four things on the stack are kind of much. Immediately I realized that the size properly belongs in the predicate of F! D'oh!
index step-count [...] F
-------------------------------
- step-countSo, let's start by nailing down the predicate:
- -F == [P] [T] [R1] [R2] genrec
- == [P] [T] [R1 [F] R2] ifte
-
-0 0 [0 3 0 1 -3] popop 5 >=
-
-P == popop 5 >=Now we need the else-part:
- -index step-count [0 3 0 1 -3] roll< popop
-
-E == roll< popopLast but not least, the recursive branch
- -0 0 [0 3 0 1 -3] R1 [F] R2
-
-The R1 function has a big job:
R1 == get the value at index
- increment the value at the index
- add the value gotten to the index
- increment the step count
-
-The only tricky thing there is incrementing an integer in the sequence. Joy sequences are not particularly good for random access. We could encode the list of jump offsets in a big integer and use math to do the processing for a good speed-up, but it still wouldn't beat the performance of e.g. a mutable array. This is just one of those places where "plain vanilla" Joypy doesn't shine (in default performance. The legendary Sufficiently-Smart Compiler would of course rewrite this function to use an array "under the hood".)
-In the meantime, I'm going to write a primitive function that just does what we need.
- -from notebook_preamble import D, J, V, define
-from joy.library import SimpleFunctionWrapper
-from joy.utils.stack import list_to_stack
-
-
-@SimpleFunctionWrapper
-def incr_at(stack):
- '''Given a index and a sequence of integers, increment the integer at the index.
-
- E.g.:
-
- 3 [0 1 2 3 4 5] incr_at
- -----------------------------
- [0 1 2 4 4 5]
-
- '''
- sequence, (i, stack) = stack
- mem = []
- while i >= 0:
- term, sequence = sequence
- mem.append(term)
- i -= 1
- mem[-1] += 1
- return list_to_stack(mem, sequence), stack
-
-
-D['incr_at'] = incr_at
-J('3 [0 1 2 3 4 5] incr_at')
-3 0 [0 1 2 3 4] [roll< at] nullary
-3 0 [0 1 2 n 4] n3 0 [0 1 2 n 4] n [Q] dip
-3 0 [0 1 2 n 4] Q n
-3 0 [0 1 2 n 4] [popd incr_at] unary n
-3 0 [0 1 2 n+1 4] n3 0 [0 1 2 n+1 4] n [+] cons dipd
-3 0 [0 1 2 n+1 4] [n +] dipd
-3 n + 0 [0 1 2 n+1 4]
-3+n 0 [0 1 2 n+1 4]3+n 0 [0 1 2 n+1 4] [++] dip
-3+n 1 [0 1 2 n+1 4]get_value == [roll< at] nullary
-incr_value == [[popd incr_at] unary] dip
-add_value == [+] cons dipd
-incr_step_count == [++] dip
-
-R1 == get_value incr_value add_value incr_step_count
-
-F == [P] [T] [R1] primrec
-
-F == [popop !size! >=] [roll< pop] [get_value incr_value add_value incr_step_count] primrecfrom joy.library import DefinitionWrapper
-
-
-DefinitionWrapper.add_definitions('''
-
- get_value == [roll< at] nullary
- incr_value == [[popd incr_at] unary] dip
- add_value == [+] cons dipd
-incr_step_count == [++] dip
-
- AoC2017.5.0 == get_value incr_value add_value incr_step_count
-
-''', D)
-define('F == [popop 5 >=] [roll< popop] [AoC2017.5.0] primrec')
-J('0 0 [0 3 0 1 -3] F')
-index, and step-count¶We want to go from this to this:
- - [...] AoC2017.5.preamble
-------------------------------
- 0 0 [...] [popop n >=]
-
-Where n is the size of the sequence.
The first part is obviously 0 0 roll<, then dup size:
[...] 0 0 roll< dup size
-0 0 [...] n
-
-Then:
- -0 0 [...] n [>=] cons [popop] swoncat
-
-So:
- -init-index-and-step-count == 0 0 roll<
-prepare-predicate == dup size [>=] cons [popop] swoncat
-
-AoC2017.5.preamble == init-index-and-step-count prepare-predicateDefinitionWrapper.add_definitions('''
-
-init-index-and-step-count == 0 0 roll<
- prepare-predicate == dup size [>=] cons [popop] swoncat
-
- AoC2017.5.preamble == init-index-and-step-count prepare-predicate
-
- AoC2017.5 == AoC2017.5.preamble [roll< popop] [AoC2017.5.0] primrec
-
-''', D)
-J('[0 3 0 1 -3] AoC2017.5')
- AoC2017.5 == AoC2017.5.preamble [roll< popop] [AoC2017.5.0] primrec
-
- AoC2017.5.0 == get_value incr_value add_value incr_step_count
- AoC2017.5.preamble == init-index-and-step-count prepare-predicate
-
- get_value == [roll< at] nullary
- incr_value == [[popd incr_at] unary] dip
- add_value == [+] cons dipd
- incr_step_count == [++] dip
-
-init-index-and-step-count == 0 0 roll<
- prepare-predicate == dup size [>=] cons [popop] swoncatThis is by far the largest program I have yet written in Joy. Even with the incr_at function it is still a bear. There may be an arrangement of the parameters that would permit more elegant definitions, but it still wouldn't be as efficient as something written in assembly, C, or even Python.
from notebook_preamble import D, J, V, define
-J('[0 2 7 0] dup max')
-from joy.library import SimpleFunctionWrapper
-from joy.utils.stack import list_to_stack
-
-
-@SimpleFunctionWrapper
-def index_of(stack):
- '''Given a sequence and a item, return the index of the item, or -1 if not found.
-
- E.g.:
-
- [a b c] a index_of
- ------------------------
- 0
-
- [a b c] d index_of
- ------------------------
- -1
-
- '''
- item, (sequence, stack) = stack
- i = 0
- while sequence:
- term, sequence = sequence
- if term == item:
- break
- i += 1
- else:
- i = -1
- return i, stack
-
-
-D['index_of'] = index_of
-J('[0 2 7 0] 7 index_of')
-J('[0 2 7 0] 23 index_of')
-Starting at index distribute count "blocks" to the "banks" in the sequence.
[...] count index distribute
-----------------------------
- [...]
-
-This seems like it would be a PITA to implement in Joypy...
- -from joy.utils.stack import iter_stack, list_to_stack
-
-
-@SimpleFunctionWrapper
-def distribute(stack):
- '''Starting at index+1 distribute count "blocks" to the "banks" in the sequence.
-
- [...] count index distribute
- ----------------------------
- [...]
-
- '''
- index, (count, (sequence, stack)) = stack
- assert count >= 0
- cheat = list(iter_stack(sequence))
- n = len(cheat)
- assert index < n
- cheat[index] = 0
- while count:
- index += 1
- index %= n
- cheat[index] += 1
- count -= 1
- return list_to_stack(cheat), stack
-
-
-D['distribute'] = distribute
-J('[0 2 7 0] dup max [index_of] nullary distribute')
-J('[2 4 1 2] dup max [index_of] nullary distribute')
-J('[3 1 2 3] dup max [index_of] nullary distribute')
-J('[0 2 3 4] dup max [index_of] nullary distribute')
-J('[1 3 4 1] dup max [index_of] nullary distribute')
-[a F] x
-[a F] a F
-
-[a F] a swap [C] dip rest cons
-a [a F] [C] dip rest cons
-a C [a F] rest cons
-a C [F] cons
-
-w/ C == dup G
-
-a dup G [F] cons
-a a G [F] cons
-
-w/ G == dup max [index_of] nullary distributedefine('direco == dip rest cons')
-define('G == [direco] cons [swap] swoncat cons')
-define('make_distributor == [dup dup max [index_of] nullary distribute] G')
-J('[0 2 7 0] make_distributor 6 [x] times pop')
-First draft:
- -[] [GEN] x [pop index_of 0 >=] [pop size --] [[swons] dip x] primrec
-
-(?)
- -[] [GEN] x [pop index_of 0 >=] [pop size --] [[swons] dip x] primrec
-[] [...] [GEN] [pop index_of 0 >=] [pop size --] [[swons] dip x] primrec
-[] [...] [GEN] pop index_of 0 >=
-[] [...] index_of 0 >=
- -1 0 >=
- False
-
-Base case
- -[] [...] [GEN] [pop index_of 0 >=] [pop size --] [[swons] dip x] primrec
-[] [...] [GEN] pop size --
-[] [...] size --
-[] [...] size --
-
-A mistake, popop and no need for --
[] [...] [GEN] popop size
-[] size
-n
-
-Recursive case
- -[] [...] [GEN] [pop index_of 0 >=] [popop size] [[swons] dip x] primrec
-[] [...] [GEN] [swons] dip x F
-[] [...] swons [GEN] x F
-[[...]] [GEN] x F
-[[...]] [...] [GEN] F
-
-[[...]] [...] [GEN] F
-
-What have we learned?
- -F == [pop index_of 0 >=] [popop size] [[swons] dip x] primrecdefine('count_states == [] swap x [pop index_of 0 >=] [popop size] [[swons] dip x] primrec')
-define('AoC2017.6 == make_distributor count_states')
-J('[0 2 7 0] AoC2017.6')
-J('[1 1 1] AoC2017.6')
-J('[8 0 0 0 0 0] AoC2017.6')
-x to Generate Values¶Cf. jp-reprod.html
- -from notebook_preamble import J, V, define
-Consider the x combinator:
x == dup iWe can apply it to a quoted program consisting of some value a and some function B:
[a B] x
-[a B] a BLet 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 then cons b:
b [a B] rest cons
-b [B] cons
-[b B]Altogether, this is the definition of B:
B == swap [C] dip rest consWe can make a generator for the Natural numbers (0, 1, 2, ...) by using 0 for a and [dup ++] for [C]:
[0 swap [dup ++] dip rest cons]
-
-Let's try it:
- -V('[0 swap [dup ++] dip rest cons] x')
-After one application of x the quoted program contains 1 and 0 is below it on the stack.
J('[0 swap [dup ++] dip rest cons] x x x x x pop')
-direco¶define('direco == dip rest cons')
-V('[0 swap [dup ++] direco] x')
-We want to define a function that accepts a and [C] and builds our quoted program:
a [C] G
--------------------------
- [a swap [C] direco]Working in reverse:
- -[a swap [C] direco] cons
-a [swap [C] direco] concat
-a [swap] [[C] direco] swap
-a [[C] direco] [swap]
-a [C] [direco] cons [swap]
-
-Reading from the bottom up:
- -G == [direco] cons [swap] swap concat cons
-G == [direco] cons [swap] swoncat consdefine('G == [direco] cons [swap] swoncat cons')
-Let's try it out:
- -J('0 [dup ++] G')
-J('0 [dup ++] G x x x pop')
-J('1 [dup 1 <<] G x x x x x x x x x pop')
-[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')
-Look at the treatment of the Project Euler Problem One in the "Developing a Program" notebook and you'll see that we might be interested in generating an endless cycle of:
- -3 2 1 3 1 2 3
-
-To do this we want to encode the numbers as pairs of bits in a single int:
- - 3 2 1 3 1 2 3
-0b 11 10 01 11 01 10 11 == 14811
-
-And pick them off by masking with 3 (binary 11) and then shifting the int right two bits.
- -define('PE1.1 == dup [3 &] dip 2 >>')
-V('14811 PE1.1')
-If we plug 14811 and [PE1.1] into our generator form...
J('14811 [PE1.1] G')
-...we get a generator that works for seven cycles before it reaches zero:
- -J('[14811 swap [PE1.1] direco] 7 [x] times')
-We need a function that checks if the int has reached zero and resets it if so.
- -define('PE1.1.check == dup [pop 14811] [] branch')
-J('14811 [PE1.1.check PE1.1] G')
-J('[14811 swap [PE1.1.check PE1.1] direco] 21 [x] times')
-(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.)
- -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.
- -J('7 66 * 4 +')
-If we drive our generator 466 times and sum the stack we get 999.
- -J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times')
-J('[14811 swap [PE1.1.check PE1.1] direco] 466 [x] times pop enstacken sum')
-define('PE1.2 == + dup [+] dip')
-Now we can add PE1.2 to the quoted program given to G.
J('0 0 0 [PE1.1.check PE1.1] G 466 [x [PE1.2] dip] times popop')
-The obvious first thing to do is just add b and a:
[b a F] b a +
-[b a F] b+aFrom here we want to arrive at:
- -b [b+a b F]Let's start with swons:
[b a F] b+a swons
-[b+a b a F]Considering this quote as a stack:
- -F a b b+aWe want to get it to:
- -F b b+a bSo:
- -F a b b+a popdd over
-F b b+a bAnd therefore:
- -[b+a b a F] [popdd over] infra
-[b b+a b F]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]Putting it all together:
- -F == + [popdd over] cons infra uncons
-fib_gen == [1 1 F]define('fib == + [popdd over] cons infra uncons')
-define('fib_gen == [1 1 fib]')
-J('fib_gen 10 [x] times')
-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.
define('PE2.1 == dup 2 % [+] [pop] branch')
-And a predicate function that detects when the terms in the series "exceed four million".
- -define('>4M == 4000000 >')
-Now it's straightforward to define PE2 as a recursive function that generates terms in the Fibonacci sequence until they exceed four million and sums the even ones.
define('PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec')
-J('PE2')
-Here's the collected program definitions:
- -fib == + swons [popdd over] infra uncons
-fib_gen == [1 1 fib]
-
-even == dup 2 %
->4M == 4000000 >
-
-PE2.1 == even [+] [pop] branch
-PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrecUsing o for odd and e for even:
o + o = e
-e + e = e
-o + e = o
-
-So the Fibonacci sequence considered in terms of just parity would be:
- -o o e o o e o o e o o e o o e o o e
-1 1 2 3 5 8 . . .
-
-Every third term is even.
- -J('[1 0 fib] x x x') # To start the sequence with 1 1 2 3 instead of 1 2 3.
-Drive the generator three times and popop the two odd terms.
J('[1 0 fib] x x x [popop] dipd')
-define('PE2.2 == x x x [popop] dipd')
-J('[1 0 fib] 10 [PE2.2] times')
-Replace x with our new driver function PE2.2 and start our fib generator at 1 0.
J('0 [1 0 fib] PE2.2 [pop >4M] [popop] [[PE2.1] dip PE2.2] primrec')
-You would probably start with a special version of G, and perhaps modifications to the default x?
define('codireco == cons dip rest cons')
-V('[0 [dup ++] codireco] x')
-define('G == [codireco] cons cons')
-J('230 [dup ++] G 5 [x] times pop')
-A hylomorphism H :: A -> B converts a value of type A into a value of type B by means of:
G :: A -> (A, B)F :: (B, B) -> BP :: A -> Bool to detect the base casec :: BIt may be helpful to see this function implemented in imperative Python code.
- -def hylomorphism(c, F, P, G):
- '''Return a hylomorphism function H.'''
-
- def H(a):
- if P(a):
- result = c
- else:
- b, aa = G(a)
- result = F(b, H(aa))
- return result
-
- return H
-As a concrete example let's use a function that, given a positive integer, returns the sum of all positive integers less than that one. (In this case the types A and B are both int.)
range() and sum()¶r = range(10)
-r
-sum(r)
-range_sum = lambda n: sum(range(n))
-range_sum(10)
-G = lambda n: (n - 1, n - 1)
-F = lambda a, b: a + b
-P = lambda n: n <= 1
-
-H = hylomorphism(0, F, P, G)
-H(10)
-If you were to run the above code in a debugger and check out the call stack you would find that the variable b in each call to H() is storing the intermediate values as H() recurses. This is what was meant by "call stack in the form of a cons list".
from notebook_preamble import D, DefinitionWrapper, J, V, define
-We can define a combinator hylomorphism that will make a hylomorphism combinator H from constituent parts.
H == c [F] [P] [G] hylomorphism
-
-The function H is recursive, so we start with ifte and set the else-part to
-some function J that will contain a quoted copy of H. (The then-part just
-discards the leftover a and replaces it with the base case value c.)
H == [P] [pop c] [J] ifte
-
-The else-part J gets just the argument a on the stack.
a J
-a G The first thing to do is use the generator G
-aa b which produces b and a new aa
-aa b [H] dip we recur with H on the new aa
-aa H b F and run F on the result.
-
-This gives us a definition for J.
J == G [H] dip F
-
-Plug it in and convert to genrec.
- -H == [P] [pop c] [G [H] dip F] ifte
-H == [P] [pop c] [G] [dip F] genrec
-
-This is the form of a hylomorphism in Joy, which nicely illustrates that -it is a simple specialization of the general recursion combinator.
- -H == [P] [pop c] [G] [dip F] genrechylomorphism¶Now we just need to derive a definition that builds the genrec arguments
-out of the pieces given to the hylomorphism combinator.
H == [P] [pop c] [G] [dip F] genrec
- [P] [c] [pop] swoncat [G] [F] [dip] swoncat genrec
- [P] c unit [pop] swoncat [G] [F] [dip] swoncat genrec
- [P] c [G] [F] [unit [pop] swoncat] dipd [dip] swoncat genrec
-
-Working in reverse:
-swoncat twice to decouple [c] and [F].unit to dequote c.dipd to untangle [unit [pop] swoncat] from the givens.At this point all of the arguments (givens) to the hylomorphism are to the left so we have
-a definition for hylomorphism:
hylomorphism == [unit [pop] swoncat] dipd [dip] swoncat genrec
-
-The order of parameters is different than the one we started with but -that hardly matters, you can rearrange them or just supply them in the -expected order.
- -[P] c [G] [F] hylomorphism == Hdefine('hylomorphism == [unit [pop] swoncat] dipd [dip] swoncat genrec')
-Demonstrate summing a range of integers from 0 to n-1.
-[P] is [0 <=]c is 0[G] is [1 - dup][F] is [+]So to sum the positive integers less than five we can do this.
- -V('5 [0 <=] 0 [1 - dup] [+] hylomorphism')
-An anamorphism can be defined as a hylomorphism that uses [] for c and
-swons for F.
[P] [G] anamorphism == [P] [] [G] [swons] hylomorphism == A
-
-This allows us to define an anamorphism combinator in terms of -the hylomorphism combinator.
- -[] swap [swons] hylomorphism == anamorphism
-
-Partial evaluation gives us a "pre-cooked" form.
- -[P] [G] . anamorphism
-[P] [G] . [] swap [swons] hylomorphism
-[P] [G] [] . swap [swons] hylomorphism
-[P] [] [G] . [swons] hylomorphism
-[P] [] [G] [swons] . hylomorphism
-[P] [] [G] [swons] . [unit [pop] swoncat] dipd [dip] swoncat genrec
-[P] [] [G] [swons] [unit [pop] swoncat] . dipd [dip] swoncat genrec
-[P] [] . unit [pop] swoncat [G] [swons] [dip] swoncat genrec
-[P] [[]] [pop] . swoncat [G] [swons] [dip] swoncat genrec
-[P] [pop []] [G] [swons] [dip] . swoncat genrec
-
-[P] [pop []] [G] [dip swons] genrec
-
-(We could also have just substituted for c and F in the definition of H.)
H == [P] [pop c ] [G] [dip F ] genrec
-A == [P] [pop []] [G] [dip swons] genrec
-
-The partial evaluation is overkill in this case but it serves as a -reminder that this sort of program specialization can, in many cases, be -carried out automatically.)
-Untangle [G] from [pop []] using swap.
[P] [G] [pop []] swap [dip swons] genrec
-
-All of the arguments to anamorphism are to the left, so we have a definition for it.
anamorphism == [pop []] swap [dip swons] genrec
-
-An example of an anamorphism is the range function.
- -range == [0 <=] [1 - dup] anamorphismA catamorphism can be defined as a hylomorphism that uses [uncons swap] for [G]
-and [[] =] for the predicate [P].
c [F] catamorphism == [[] =] c [uncons swap] [F] hylomorphism == C
-
-This allows us to define a catamorphism combinator in terms of
-the hylomorphism combinator.
[[] =] roll> [uncons swap] swap hylomorphism == catamorphism
-
-Partial evaluation doesn't help much.
- -c [F] . catamorphism
-c [F] . [[] =] roll> [uncons swap] swap hylomorphism
-c [F] [[] =] . roll> [uncons swap] swap hylomorphism
-[[] =] c [F] [uncons swap] . swap hylomorphism
-[[] =] c [uncons swap] [F] . hylomorphism
-[[] =] c [uncons swap] [F] [unit [pop] swoncat] . dipd [dip] swoncat genrec
-[[] =] c . unit [pop] swoncat [uncons swap] [F] [dip] swoncat genrec
-[[] =] [c] [pop] . swoncat [uncons swap] [F] [dip] swoncat genrec
-[[] =] [pop c] [uncons swap] [F] [dip] . swoncat genrec
-[[] =] [pop c] [uncons swap] [dip F] genrec
-
-Because the arguments to catamorphism have to be prepared (unlike the arguments -to anamorphism, which only need to be rearranged slightly) there isn't much point -to "pre-cooking" the definition.
- -catamorphism == [[] =] roll> [uncons swap] swap hylomorphism
-
-An example of a catamorphism is the sum function.
- -sum == 0 [+] catamorphismI'm not sure exactly how to translate the "Fusion Law" for catamorphisms into Joy.
-I know that a map composed with a cata can be expressed as a new cata:
[F] map b [B] cata == b [F B] cata
-
-But this isn't the one described in "Bananas...". That's more like:
-A cata composed with some function can be expressed as some other cata:
- -b [B] catamorphism F == c [C] catamorphism
-
-Given:
- -b F == c
-
-...
-
-B F == [F] dip C
-
-...
-
-b[B]cata F == c[C]cata
-
-F(B(head, tail)) == C(head, F(tail))
-
-1 [2 3] B F 1 [2 3] F C
-
-
-b F == c
-B F == F C
-
-b [B] catamorphism F == c [C] catamorphism
-b [B] catamorphism F == b F [C] catamorphism
-
-...
-
-Or maybe,
- -[F] map b [B] cata == c [C] cata ???
-
-[F] map b [B] cata == b [F B] cata I think this is generally true, unless F consumes stack items
- instead of just transforming TOS. Of course, there's always [F] unary.
-b [F] unary [[F] unary B] cata
-
-[10 *] map 0 swap [+] step == 0 swap [10 * +] step
-
-
-For example:
- -F == 10 *
-b == 0
-B == +
-c == 0
-C == F +
-
-b F == c
-0 10 * == 0
-
-B F == [F] dip C
-+ 10 * == [10 *] dip F +
-+ 10 * == [10 *] dip 10 * +
-
-n m + 10 * == 10(n+m)
-
-n m [10 *] dip 10 * +
-n 10 * m 10 * +
-10n m 10 * +
-10n 10m +
-10n+10m
-
-10n+10m = 10(n+m)
-
-Ergo:
- -0 [+] catamorphism 10 * == 0 [10 * +] catamorphismstep combinator will usually be better to use than catamorphism.¶sum == 0 swap [+] step
-sum == 0 [+] catamorphismHere is (part of) the payoff.
-An anamorphism followed by (composed with) a -catamorphism is a hylomorphism, with the advantage that the hylomorphism -does not create the intermediate list structure. The values are stored in -either the call stack, for those implementations that use one, or in the pending -expression ("continuation") for the Joypy interpreter. They still have to -be somewhere, converting from an anamorphism and catamorphism to a hylomorphism -just prevents using additional storage and doing additional processing.
- - range == [0 <=] [1 - dup] anamorphism
- sum == 0 [+] catamorphism
-
-range sum == [0 <=] [1 - dup] anamorphism 0 [+] catamorphism
- == [0 <=] 0 [1 - dup] [+] hylomorphism
-
-We can let the hylomorphism combinator build range_sum for us or just
-substitute ourselves.
H == [P] [pop c] [G] [dip F] genrec
-range_sum == [0 <=] [pop 0] [1 - dup] [dip +] genrecdefs = '''
-anamorphism == [pop []] swap [dip swons] genrec
-hylomorphism == [unit [pop] swoncat] dipd [dip] swoncat genrec
-catamorphism == [[] =] roll> [uncons swap] swap hylomorphism
-range == [0 <=] [1 - dup] anamorphism
-sum == 0 [+] catamorphism
-range_sum == [0 <=] 0 [1 - dup] [+] hylomorphism
-'''
-
-DefinitionWrapper.add_definitions(defs, D)
-J('10 range')
-J('[9 8 7 6 5 4 3 2 1 0] sum')
-V('10 range sum')
-V('10 range_sum')
-A paramorphism P :: B -> A is a recursion combinator that uses dup on intermediate values.
n swap [P] [pop] [[F] dupdip G] primrec
-
-With
-n :: A is the "identity" for F (like 1 for multiplication, 0 for addition)F :: (A, B) -> AG :: B -> B generates the next B value.P :: B -> Bool detects the end of the series.For Factorial function (types A and B are both integer):
n == 1
-F == *
-G == --
-P == 1 <=define('factorial == 1 swap [1 <=] [pop] [[*] dupdip --] primrec')
-Try it with input 3 (omitting evaluation of predicate):
- -3 1 swap [1 <=] [pop] [[*] dupdip --] primrec
-1 3 [1 <=] [pop] [[*] dupdip --] primrec
-
-1 3 [*] dupdip --
-1 3 * 3 --
-3 3 --
-3 2
-
-3 2 [*] dupdip --
-3 2 * 2 --
-6 2 --
-6 1
-
-6 1 [1 <=] [pop] [[*] dupdip --] primrec
-
-6 1 pop
-6J('3 factorial')
-paramorphism from the form above.¶n swap [P] [pop] [[F] dupdip G] primrec
-
-n swap [P] [pop] [[F] dupdip G] primrec
-n [P] [swap] dip [pop] [[F] dupdip G] primrec
-n [P] [[F] dupdip G] [[swap] dip [pop]] dip primrec
-n [P] [F] [dupdip G] cons [[swap] dip [pop]] dip primrec
-n [P] [F] [G] [dupdip] swoncat cons [[swap] dip [pop]] dip primrec
-
-paramorphism == [dupdip] swoncat cons [[swap] dip [pop]] dip primrecdefine('paramorphism == [dupdip] swoncat cons [[swap] dip [pop]] dip primrec')
-define('factorial == 1 [1 <=] [*] [--] paramorphism')
-J('3 factorial')
-tails¶An example of a paramorphism for lists given in the "Bananas..." paper is tails which returns the list of "tails" of a list.
[1 2 3] tails == [[] [3] [2 3]]
-
-Using paramorphism we would write:
n == []
-F == rest swons
-G == rest
-P == not
-
-tails == [] [not] [rest swons] [rest] paramorphismdefine('tails == [] [not] [rest swons] [rest] paramorphism')
-J('[1 2 3] tails')
-J('25 range tails [popop] infra [sum] map')
-J('25 range [range_sum] map')
-rest¶Right before the recursion begins we have:
- -[] [1 2 3] [not] [pop] [[rest swons] dupdip rest] primrec
-
-But we might prefer to factor rest in the quote:
[] [1 2 3] [not] [pop] [rest [swons] dupdip] primrec
-
-There's no way to do that with the paramorphism combinator as defined. We would have to write and use a slightly different recursion combinator that accepted an additional "preprocessor" function [H] and built:
n swap [P] [pop] [H [F] dupdip G] primrec
-
-Or just write it out manually. This is yet another place where the sufficiently smart compiler will one day automatically refactor the code. We could write a paramorphism combinator that checked [F] and [G] for common prefix and extracted it.
Our story so far...
-F :: (B, B) -> BP :: A -> Bool to detect the base casec :: Bw/ G :: A -> (A, B)
-
-H == [P ] [pop c ] [G ] [dip F ] genrec
-A == [P ] [pop []] [G ] [dip swons] genrec
-C == [[] =] [pop c ] [uncons swap] [dip F ] genrec
-
-w/ G :: B -> B
-
-P == c swap [P ] [pop] [[F ] dupdip G ] primrec
-? == [] swap [P ] [pop] [[swons] dupdip G ] primrec
-? == c swap [[] =] [pop] [[F ] dupdip uncons swap] primrecThere are at least four kinds of recursive combinator, depending on two choices. The first choice is whether the combiner function should be evaluated during the recursion or pushed into the pending expression to be "collapsed" at the end. The second choice is whether the combiner needs to operate on the current value of the datastructure or the generator's output.
- -H == [P] [pop c] [G ] [dip F] genrec
-H == c swap [P] [pop] [G [F] dip ] [i] genrec
-H == [P] [pop c] [ [G] dupdip ] [dip F] genrec
-H == c swap [P] [pop] [ [F] dupdip G] [i] genrec
-
-Consider:
- -... a G [H] dip F w/ a G == a' b
-... c a G [F] dip H a G == b a'
-... a [G] dupdip [H] dip F a G == a'
-... c a [F] dupdip G H a G == a'H == [P] [pop c] [G] [dip F] genrec
-
-Iterate n times.
- -... a [P] [pop c] [G] [dip F] genrec
-... a G [H] dip F
-... a' b [H] dip F
-... a' H b F
-... a' G [H] dip F b F
-... a'' b [H] dip F b F
-... a'' H b F b F
-... a'' G [H] dip F b F b F
-... a''' b [H] dip F b F b F
-... a''' H b F b F b F
-... a''' pop c b F b F b F
-... c b F b F b F
-
-This form builds up a continuation that contains the intermediate results along with the pending combiner functions. When the base case is reached the last term is replaced by the identity value c and the continuation "collapses" into the final result.
- -When you can start with the identity value c on the stack and the combiner can operate as you go, using the intermediate results immediately rather than queuing them up, use this form. An important difference is that the generator function must return its results in the reverse order.
- -H == c swap [P] [pop] [G [F] dip] primrec
-
-... c a G [F] dip H
-... c b a' [F] dip H
-... c b F a' H
-... c b F a' G [F] dip H
-... c b F b a'' [F] dip H
-... c b F b F a'' H
-... c b F b F a'' G [F] dip H
-... c b F b F b a''' [F] dip H
-... c b F b F b F a''' H
-... c b F b F b F a''' pop
-... c b F b F b F
-
-The end line here is the same as for above, but only because we didn't evaluate F when it normally would have been.
If the combiner and the generator both need to work on the current value then dup must be used at some point, and the generator must produce one item instead of two (the b is instead the duplicate of a.)
H == [P] [pop c] [[G] dupdip] [dip F] genrec
-
-... a [G] dupdip [H] dip F
-... a G a [H] dip F
-... a' a [H] dip F
-... a' H a F
-... a' [G] dupdip [H] dip F a F
-... a' G a' [H] dip F a F
-... a'' a' [H] dip F a F
-... a'' H a' F a F
-... a'' [G] dupdip [H] dip F a' F a F
-... a'' G a'' [H] dip F a' F a F
-... a''' a'' [H] dip F a' F a F
-... a''' H a'' F a' F a F
-... a''' pop c a'' F a' F a F
-... c a'' F a' F a FAnd, 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
-
-... a c swap [P] [pop] [[F] dupdip G] primrec
-... c a [P] [pop] [[F] dupdip G] primrec
-... c a [F] dupdip G W
-... c a F a G W
-... c a F a' W
-... c a F a' [F] dupdip G W
-... c a F a' F a' G W
-... c a F a' F a'' W
-... c a F a' F a'' [F] dupdip G W
-... c a F a' F a'' F a'' G W
-... c a F a' F a'' F a''' W
-... c a F a' F a'' F a''' pop
-... c a F a' F a'' FEach of the four variations above can be specialized to ana- and catamorphic forms.
- -def WTFmorphism(c, F, P, G):
- '''Return a hylomorphism function H.'''
-
- def H(a, d=c):
- if P(a):
- result = d
- else:
- a, b = G(a)
- result = H(a, F(d, b))
- return result
-
- return H
-F = lambda a, b: a + b
-P = lambda n: n <= 1
-G = lambda n: (n - 1, n - 1)
-
-wtf = WTFmorphism(0, F, P, G)
-
-print wtf(5)
-H == [P ] [pop c ] [G ] [dip F ] genrecDefinitionWrapper.add_definitions('''
-P == 1 <=
-Ga == -- dup
-Gb == --
-c == 0
-F == +
-''', D)
-V('[1 2 3] [[] =] [pop []] [uncons swap] [dip swons] genrec')
-V('3 [P] [pop c] [Ga] [dip F] genrec')
-V('3 [P] [pop []] [Ga] [dip swons] genrec')
-V('[2 1] [[] =] [pop c ] [uncons swap] [dip F] genrec')
-|[ (c, F), (G, P) ]| == (|c, F|) • [(G, P)]
-
-"Bananas, Lenses, & Barbed Wire"
- -(|...|) [(...)] [<...>]
-
-I think they are having slightly too much fun with the symbols.
-"Too much is always better than not enough."
- -tree = [] | [node [tree*]]treestep¶tree z [C] [N] treestep
-
-
- [] z [C] [N] treestep
----------------------------
- z
-
-
- [node [tree*]] z [C] [N] treestep
---------------------------------------- w/ K == z [C] [N] treestep
- node N [tree*] [K] map CK == [not] [pop z] [J] ifte
-
-
- [node [tree*]] J
-------------------------------
- node N [tree*] [K] map C
-
-
-J == .. [N] .. [K] .. [C] ..
-
-[node [tree*]] uncons [N] dip
-node [[tree*]] [N] dip
-node N [[tree*]]
-
-node N [[tree*]] i [K] map
-node N [tree*] [K] map
-node N [K.tree*]
-
-J == uncons [N] dip i [K] map [C] i
-
-K == [not] [pop z] [uncons [N] dip i [K] map [C] i] ifte
-K == [not] [pop z] [uncons [N] dip i] [map [C] i] genrec[not] [pop z] [uncons [N] dip unquote] [map [C] i] genrec
-[not] [z] [pop] swoncat [uncons [N] dip unquote] [map [C] i] genrec
-[not] z unit [pop] swoncat [uncons [N] dip unquote] [map [C] i] genrec
-z [not] swap unit [pop] swoncat [uncons [N] dip unquote] [map [C] i] genrec
- \............TS0............/
-z TS0 [uncons [N] dip unquote] [map [C] i] genrec
-z [uncons [N] dip unquote] [TS0] dip [map [C] i] genrec
-z [[N] dip unquote] [uncons] swoncat [TS0] dip [map [C] i] genrec
-z [N] [dip unquote] cons [uncons] swoncat [TS0] dip [map [C] i] genrec
- \...........TS1.................../
-z [N] TS1 [TS0] dip [map [C] i] genrec
-z [N] [map [C] i] [TS1 [TS0] dip] dip genrec
-z [N] [map C ] [TS1 [TS0] dip] dip genrec
-z [N] [C] [map] swoncat [TS1 [TS0] dip] dip genrec
-z [C] [N] swap [map] swoncat [TS1 [TS0] dip] dip genrec TS0 == [not] swap unit [pop] swoncat
- TS1 == [dip i] cons [uncons] swoncat
-treestep == swap [map] swoncat [TS1 [TS0] dip] dip genrec [] 0 [C] [N] treestep
----------------------------
- 0
-
-
- [n [tree*]] 0 [sum +] [] treestep
- --------------------------------------------------
- n [tree*] [0 [sum +] [] treestep] map sum +DefinitionWrapper.add_definitions('''
-
- TS0 == [not] swap unit [pop] swoncat
- TS1 == [dip i] cons [uncons] swoncat
-treestep == swap [map] swoncat [TS1 [TS0] dip] dip genrec
-
-''', D)
-V('[] 0 [sum +] [] treestep')
-V('[23 []] 0 [sum +] [] treestep')
-V('[23 [[2 []] [3 []]]] 0 [sum +] [] treestep')
-J('[23 [[2 [[23 [[2 []] [3 []]]][23 [[2 []] [3 []]]]]] [3 [[23 [[2 []] [3 []]]][23 [[2 []] [3 []]]]]]]] 0 [sum +] [] treestep')
-J('[] [] [unit cons] [23 +] treestep')
-J('[23 []] [] [unit cons] [23 +] treestep')
-J('[23 [[2 []] [3 []]]] [] [unit cons] [23 +] treestep')
-define('treemap == [] [unit cons] roll< treestep')
-J('[23 [[2 []] [3 []]]] [23 +] treemap')
-