What can you get from 1, 2, 3, 4, +, -, *, /, and ^?

Recently, a Haskell program was posted that computed all possible combinations of the numbers "1, 2, 3, and 4" and the operators "+, -, *, /, and ^" (allowing the operators to be repeated, but not the numbers). It's a fun little problem, and I thought it might be a good example for iterative development in Factor using the listener.

First, some vocabularies that we'll be using.

( scratchpad ) USING: arrays continuations kernel math 
               math.combinatorics math.statistics sequences ;

We can calculate all-permutations of the numbers (for a total of 4!, or 24):

( scratchpad ) { 1 2 3 4 } all-permutations

And, similarly, we can find all possible selections of three operations (for a total of 5³, or 125):

( scratchpad ) { + - * / ^ } 3 selections

Now, we can compute the cartesian-product to produce all possible pairings of the two sequences (for a total of 24 × 125, or 3000):

( scratchpad ) cartesian-product concat

You can inspect the list by clicking on it in the listener, printing it out (e.g., "dup .", or showing what the first result looks like:

( scratchpad ) dup first .
{ { 1 2 3 4 } { + + + } }

Use concat-as to make all the entries quotations (so they can be called).

( scratchpad ) [ [ ] concat-as ] map

We can then try calling the first element to make sure it produces the right result:

( scratchpad ) dup first dup . call .
[ 1 2 3 4 + + + ]
10

Let's call each quotation, creating an association list where the key is the quotation and the value is the result:

( scratchpad ) [ dup call 2array ] map
Division by zero
x 2

Whoops, some of the formulas produce division-by-zero errors. We can use continuations to recover (storing a f result when there is an error) and continue:

( scratchpad ) [ [ dup call ] [ drop f ] recover 2array ] map

Each element of the resulting sequence is a pairing of a quotation and a result:

( scratchpad ) dup first .
{ [ 1 2 3 4 + + + ] 10 }

We can see how many unique results (including f) are found:

( scratchpad ) dup values unique assoc-size .
430

You could calculate the 10 most common results using sorted-histogram. It turns out "1" is the most common result:

( scratchpad ) dup values sorted-histogram reverse 10 head .
{
    { 1 200 }
    { 4 116 }
    { 2 116 }
    { 3 96 }
    { 6 82 }
    { 9 65 }
    { 5 60 }
    { -2 57 }
    { 24 56 }
    { 1+1/2 53 }
}

Some other things you might try:

• Count how many "divide-by-zero" errors are produced, perhaps using assoc-filter to examine the "bad" formulas.
• Create an association between each unique value and the list of all quotations that produced it.
• Print each quotation and result out, sorted by numerical result.
• Define a word that, given a sequence of numbers and a sequence of operations, produces all the result pairings (using call( to make it compile properly).
• Find the most positive and most negative result, and output the quotations that produced them.

Update: it was pointed out by Kevin Reid (the author of the Haskell version) that I'm missing left-associative operators. I think the only modification that is required is to add "swapped" versions of the operators to the possible choices:

( scratchpad ) USE: quotations

( scratchpad ) { + - * / ^ } [ 1quotation ] map

( scratchpad ) dup [ [ swap ] prepend ] map append dup .
{
    [ + ]
    [ - ]
    [ * ]
    [ / ]
    [ ^ ]
    [ swap + ]
    [ swap - ]
    [ swap * ]
    [ swap / ]
    [ swap ^ ]
}

( scratchpad ) 3 selections [ concat ] map

This produces 10³, or 1,000, possible operations. When combined with the original 24 permutations of { 1 2 3 4 }, that makes 24,000 possible formulas. Running through the logic above makes 677 unique results. Still not sure why this is close, but doesn't quite match, the original results in Haskell.

Update 2: it was pointed out by joop that addition and multiplication don't need "swapped" versions.

Update 3: it was pointed out by Scaevolus that I am missing (4 ^ 4) ^ (4 ^ 4). In Factor, that could be represented by [ 4 4 ^ 4 4 ^ ^ ] or [ 4 4 4 4 ^ [ ^ ] dip ^ ]. One fix would be to include the "dipped" operators in the first two positions:

( scratchpad ) {
                   [ + ] [ - ] [ * ] [ / ] [ ^ ]
                   [ swap - ] [ swap / ] [ swap ^ ]
                   [ [ - ] dip ] [ [ swap - ] dip ]
                   [ [ / ] dip ] [ [ swap / ] dip ]
                   [ [ ^ ] dip ] [ [ swap ^ ] dip ]
               } 2 selections

( scratchpad ) {
                   [ + ] [ - ] [ * ] [ / ] [ ^ ]
                   [ swap - ] [ swap / ] [ swap ^ ]
               } 1 selections

( scratchpad ) cartesian-product concat [ concat [ ] concat-as ] map

This gives us 14 × 14 × 8, or 1,568 possible formulas. But, it feels a bit like a kludge. What would be the proper way to include these?