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

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.

## Code golfing

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

kpreidFor the record, the old code was:

## Re: Code golfing

## Re: Code golfing

kpreid## You forgot

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

## Same task, but using Factor

Factor(http://www.factorcode.org) programming language:http://re-factor.blogspot.com/2010/09/wh