Kevin Reid's blog

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

 

new
Name
Kevin Reid
Website
My Website

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

Previous Entry Share Next Entry
new

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.
Powered by LiveJournal.com