A Haskell program: what you can get from 1, 2, 3, 4, +, -, *, /, and ^

[kpreid]

I forget why I wrote this Haskell program, but it's cluttering up my do-something-with-this folder, so I’ll just publish it.

-- This program calculates all the ways to combine [1,2,3,4] using + - * / and ^
-- to produce *rational* numbers (i.e. no fractional exponents). (It could be so
-- extended given a data type for algebraic numbers (or by using floats instead
-- of exact rationals, but that would be boring).)
--
-- Written September 7, 2009.
-- Revised August 25, 2010 to show the expressions which produce the numbers.
-- Revised August 26, 2010 to use Data.List.permutations and a fold in combine.
-- 
-- In the unlikely event you actually wants to reuse this code, here's a license
-- statement:
-- Copyright 2009-2010 Kevin Reid, under the terms of the MIT X license
-- found at http://www.opensource.org/licenses/mit-license.html

import Data.Ratio (Ratio, numerator, denominator)
import Data.List (nubBy, sortBy)

--------------------------------------------------------------------------------
-- We want to "show our work", tracking the expression which produces a given 
-- number; this data type does that. Not to be confused with Show/show from the
-- Prelude.

data Shown a = Shown { value :: a,
                       expr :: String }

-- Apply a binary operator to Shown values.
-- We could be more general, and wrap functions in Shown and define a 
-- Shown-application operator, but that would be overcomplicated for this job.
explain name func a b = 
  Shown   (     value a         `func`          value b    )
        ("(" ++ expr a ++ " " ++ name ++ " " ++ expr b ++ ")")

-- comparison disregarding the expression
eqShown      (Shown x _) (Shown y _) = x == y
compareShown (Shown x _) (Shown y _) = compare x y

shownToString :: (a -> String) -> Shown a -> String
shownToString f (Shown v e) = e ++ " = " ++ f v

--------------------------------------------------------------------------------
-- Rational number formatting

-- Convert a rational number to Shown
shownRatio :: Integral i => Ratio i -> Shown (Ratio i)
shownRatio x = Shown x (niceRatio x)

-- Format rational numbers in a more normal way than Show Ratio does.
niceRatio :: Integral i => Ratio i -> String
niceRatio r = if denominator r == 1
                then show (numerator r)                                                                                       
                else show (numerator r) ++ "/" ++ show (denominator r)                                                             

--------------------------------------------------------------------------------
-- Tools for the problem

infixl 5 `op`, `op2`

-- Generate a list of all valid binary operations (a X b), where X is one of + - * / ^
op :: Shown (Ratio Integer) -> Shown (Ratio Integer) -> [Shown (Ratio Integer)]
op a b = concat [[explain "+" (+) a b],
                 [explain "-" (-) a b],
                 [explain "*" (*) a b],
                 if denominator (value b) == 1
                   then [explain "^" (^^) a (Shown (numerator (value b)) (expr b))] 
                   else [],
                 if (value b) == 0
                   then [] 
                   else [explain "/" (/) a b]]

-- Same as op but with commutation, a X b and b X a
op2 :: Shown (Ratio Integer) -> Shown (Ratio Integer) -> [Shown (Ratio Integer)]
op2 a b = op a b ++ op b a

-- foldl1 + foldM = fold1M
fold1M :: Monad m => (a -> a -> m a) -> [a] -> m a
--fold1M f (x:y:xs) = do r <- f x y; fold1M f (r:xs)
fold1M f (x:y:xs) = f x y >>= (fold1M f . (:xs))
fold1M _ [x]      = return x
fold1M _ []       = error "fold1M with empty list"

--------------------------------------------------------------------------------
-- The problem

-- Return the list of all possible combinations of [1,2,3,4].
combine :: [Shown (Ratio Integer)]
combine = fold1M op2 =<< permutations (map shownRatio [1,2,3,4])

-- Unique and sorted results
uniqueCombine = nubBy eqShown . sortBy compareShown $ combine

report = concatMap ((++ "\n") . shownToString niceRatio) uniqueCombine
      ++ "Tried " ++ show (length combine) ++ " formulas, got "
      ++ show (length uniqueCombine) ++ " unique results.\n"

main = putStr report

I'd include the output here, but that would spam several aggregators, so I'll just show some highlights. The results are listed in increasing numerical order, and only one of the expressions giving each distinct result is shown.

(1 - (2 ^ (3 ^ 4))) = -2417851639229258349412351
(1 - (2 ^ (4 ^ 3))) = -18446744073709551615
(1 - (3 ^ (2 ^ 4))) = -43046720
(1 - (4 ^ (3 ^ 2))) = -262143
(1 - (4 ^ (2 ^ 3))) = -65535
...all integers...
((1 - (2 ^ 4)) * 3) = -45
(((1 / 2) - 4) ^ 3) = -343/8
((1 - (3 ^ 4)) / 2) = -40
(1 - ((3 ^ 4) / 2)) = -79/2
(1 - ((3 ^ 2) * 4)) = -35
...various short fractions...
(1 / (2 - (3 ^ 4))) = -1/79
(((1 + 2) - 3) * 4) = 0
(1 / (2 ^ (3 ^ 4))) = 1/2417851639229258349412352
(2 ^ (1 - (3 ^ 4))) = 1/1208925819614629174706176
(1 / (2 ^ (4 ^ 3))) = 1/18446744073709551616
(2 ^ (1 - (4 ^ 3))) = 1/9223372036854775808
(2 ^ ((1 - 4) ^ 3)) = 1/134217728
...various short fractions...
(((3 ^ 2) + 1) ^ 4) = 10000      (the longest string of zeros produced)
...all integers...
(2 ^ (3 ^ (1 + 4))) = 14134776518227074636666380005943348126619871175004951664972849610340958208
(2 ^ ((1 + 3) ^ 4)) = 115792089237316195423570985008687907853269984665640564039457584007913129639936
Tried 23090 formulas, got 554 unique results.

Comments

Code golfing

[(Anonymous)]

Fun little program!

Here's one way to make the code a little shorter: the combine function up to the comment can be written as "do [a,b,c,d] <- permutations (map shownRatio [1,2,3,4])" provided you import permutations from Data.List earlier on.

I'm pretty sure that with some tweaking (esp. op2's type) and a strategic fold it would be possible to avoid naming the elements individually...

Re: Code golfing

[kpreid.livejournal.com]

Thanks for the ideas; I've updated the code to use them. I had to write a fold, though, because I needed a monadic fold1.

For the record, the old code was:

combine = do let n1 = map shownRatio [1,2,3,4]
             (a,n2) <- pick n1
             (b,n3) <- pick n2
             (c,n4) <- pick n3
             (d,[]) <- pick n4
             -- Since op2 tries both orders, we don't need to vary the associativity.
             ab <- a `op2` b
             abc <- ab `op2` c
             abcd <- abc `op2` d
             return abcd

Re: Code golfing

[(Anonymous)]

The "map shownRatio" is ugly. You could make Shown a Num instance, which would read the numeric literals directly, and maybe simplify the other arithmetic too.

Re: Code golfing

[kpreid.livejournal.com]

That requires me to define all four operators in terms of Shown, and give Shown Eq and Show instances, though.

You forgot

[(Anonymous)]

...to do unary - .

[atheorist.livejournal.com]

Do you think this could be expanded to create a database of short formulas useful for "recognizing" a number? Something like the encyclopedia of integer sequences or the inverse symbolic calculator? What about S, K, I combinators (or another base) and normalized combinators on the right hand side?

[kpreid.livejournal.com]

What do you see it doing that ISC doesn't do already? Just generating 'ideas' for an ISCishe system to have in its database?

[atheorist.livejournal.com]

Well, I don't understand the ISC algorithms and codebase - and I don't understand yours, but yours are comparatively short, so potentially comprehensible.

It would be awesome to have a one-page "comprehensible and hackable ISC".

Same task, but using Factor

[(Anonymous)]

I wrote an example of doing this using the Factor (http://www.factorcode.org) programming language:

http://re-factor.blogspot.com/2010/09/what-can-you-get-from-1-2-3-4-and.html