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^{3}, 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^{3}, 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?

## 9 comments:

Your program never generates left-associative structures; the left operand is always in {1,2,3,4} and never one of the operator results. In my Haskell version, this is handled by op2. You could add [ flip / ], [ flip - ], and [ flip ^ ] to the list of operators, perhaps; I'm not sufficiently familiar with Factor to recommend an approach.

If equivalence is the goal, then yours should agree with mine that there are 554 possible results (and about the least and greatest results).

@kpreid: Good point! I added "swapped" versions which should allow both "a b op" and "b a op".

I now see 24,000 formulas, with 677 possible results. Still not sure where the discrepancy is -- it might have to do with float and fraction equivalence (e.g., 0.75 is not considered equal to 3/4). Any other ideas?

Mine does not try formulas which lead to div-zero or fractional exponents (so that all the results are representable as ratios). I assume yours generates floats from fractional exponents.

I think you should leave out the swapped + and *...

Does this include formulas like (4 ^ 4) ^ (4 ^ 4) ? It looks like all your equations will be of the form ((a op b) op c) op d).

I wrote a similar program for a dice game I played with some friends, which is a more interesting problem, in my opinion.

Roll a d10 -- [0, 9]. This is your target number.

Roll a d4, d6, d8, d12, and a d20. Add, subtract, multiply, and divide the numbers to get to your target number. You can not use zero in a multiplication or division, as it makes things too easy. The first person with a solution wins.

Example:

The target is 5, and the other dice are 3, 4, 2, 8, 11.

Solution:

5 = (8-11) + 2/(4-3)

Now, the question:

How many rolls are *impossible* to find a solution for?

The number is surprisingly small-- 0.33% of all rolls, according to my calculations.

Here is one such impossibility:

Get to 0, given 13, 12, 7, 4, 1.

I would be interested in seeing a Factor solution to this, since it is requires a good deal more computational effort to brute-force.

@joop: Good point, we don't need to do the same work twice.

@Scaevolus: You're right, I was missing those kind of operations. I added a comment about one way to implement it, but perhaps stepping back would give a better way. I'll think about the dice project -- might be a fun post to write. Do you have a version I could link to? Perhaps I'll use my ROLL: syntax.

Here's my implementation:

http://mod.ifies.com/f/100907_dice.c

Compiled with -O3, it takes about 14 seconds on my old 2.2GHz Pentium T3400.

It lists 1297 impossibilities-- which I'm somewhat suspicious of, because I have another list that's only 1150, but I can't remember how I generated that.

Post a Comment