Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- import Data.Numbers.Primes
- import Data.List
- import Data.Function
- --tree for expression trees
- data Expr = Inc Expr
- | Mul Expr Expr
- | Val Int
- deriving(Show)
- --for taking a list of factors and making them a product expression
- fromList [x] = Val x
- fromList (x:xs) = Mul (Val x) (fromList xs)
- --finds the powerset of l sans l and the empty set
- powerset l = delete l (nub (powerset' l))
- where powerset' [x] = [[x]]
- powerset' (x:xs) = powerset' xs ++ map (x:) (powerset' xs)
- --gives all possible groups of 'n' numbers which can be multiplied to get 'x'
- factors x n = factors' n (primeFactors x)
- where factors' _ [] = []
- factors' 2 pfacts = map (\(x, y) -> [product x, product y]) pairs
- where pairs = map (\x -> (x, pfacts \\ x)) (powerset pfacts)
- factors' n pfacts = concatMap (\(x, y) -> let p = product x in map (p:) (factors' (n - 1) y)) factPairs
- where factPairs = map (\x -> (x, pfacts \\ x)) (powerset pfacts)
- --enumerates all possible expressions that result in a given number
- enum 0 = [Val 0]
- enum 1 = [Val 1]
- enum n = map Inc (enum (n - 1))
- ++ (map fromList $ concatMap (factors n) [2..n `div` 2])
- --computes the character cost of a given expression
- cost (Val n) = n
- cost (Inc e) = 1 + cost e
- cost (Mul x y) = 6 + cost x + cost y
- --finds the minimum expression that expresses the number 'n'
- minimumExpression n = minimumBy (compare `on` cost) (enum n)
- --translates an expression tree into brainfuck
- translate (Val n) = take n (repeat '+')
- translate (Inc e) = translate e ++ "+"
- translate (Mul x y) = translate y ++ "[->" ++ translate x ++ "<]>"
- --produces the minimal brainfuck expression(or very close to it) for a given number
- minBFExpr = translate . minimumExpression
- --interprets a brainfuck expression
- brainfuck cs = brainfuck' cs (repeat 0) (repeat 0) []
- where brainfuck' (']':cs) _ _ [] = error "mismatched brakets"
- brainfuck' [] _ _ _ = []
- brainfuck' (c:cs) (m:ms) (n:ns) r
- | c == '+' = '+' : brainfuck' cs ((m + 1) : ms) (n:ns) r
- | c == '-' = '-' : brainfuck' cs ((m - 1) : ms) (n:ns) r
- | c == '>' = '>' : brainfuck' cs ms (m:n:ns) r
- | c == '<' = '<' : brainfuck' cs (n:m:ms) ns r
- | c == '.' = '.' : brainfuck' cs (m:ms) (n:ns) r
- | c == '[' = '[' : if m /= 0
- then brainfuck' cs (m:ms) (n:ns) ((c:cs):r)
- else brainfuck' (tail $ dropWhile (/=']') cs) (m:ms) (n:ns) r
- | c == ']' = ']' : brainfuck' (head r) (m:ms) (n:ns) (tail r)
- | otherwise = brainfuck' cs (m:ms) (n:ns) r
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement