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

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.