 # Untitled

a guest
Nov 14th, 2013
60
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. import Data.Numbers.Primes
2. import Data.List
3. import Data.Function
4.
5. --tree for expression trees
6. data Expr = Inc Expr
7. | Mul Expr Expr
8. | Val Int
9. deriving(Show)
10.
11. --for taking a list of factors and making them a product expression
12. fromList [x] = Val x
13. fromList (x:xs) = Mul (Val x) (fromList xs)
14.
15. --finds the powerset of l sans l and the empty set
16. powerset l = delete l (nub (powerset' l))
17. where powerset' [x] = [[x]]
18. powerset' (x:xs) = powerset' xs ++ map (x:) (powerset' xs)
19.
20. --gives all possible groups of 'n' numbers which can be multiplied to get 'x'
21. factors x n = factors' n (primeFactors x)
22. where factors' _ [] = []
23. factors' 2 pfacts = map (\(x, y) -> [product x, product y]) pairs
24. where pairs = map (\x -> (x, pfacts \\ x)) (powerset pfacts)
25. factors' n pfacts = concatMap (\(x, y) -> let p = product x in map (p:) (factors' (n - 1) y)) factPairs
26. where factPairs = map (\x -> (x, pfacts \\ x)) (powerset pfacts)
27.
28. --enumerates all possible expressions that result in a given number
29. enum 0 = [Val 0]
30. enum 1 = [Val 1]
31. enum n = map Inc (enum (n - 1))
32. ++ (map fromList \$ concatMap (factors n) [2..n `div` 2])
33.
34. --computes the character cost of a given expression
35. cost (Val n) = n
36. cost (Inc e) = 1 + cost e
37. cost (Mul x y) = 6 + cost x + cost y
38.
39. --finds the minimum expression that expresses the number 'n'
40. minimumExpression n = minimumBy (compare `on` cost) (enum n)
41.
42. --translates an expression tree into brainfuck
43. translate (Val n) = take n (repeat '+')
44. translate (Inc e) = translate e ++ "+"
45. translate (Mul x y) = translate y ++ "[->" ++ translate x ++ "<]>"
46.
47. --produces the minimal brainfuck expression(or very close to it) for a given number
48. minBFExpr = translate . minimumExpression
49.
50. --interprets a brainfuck expression
51. brainfuck cs = brainfuck' cs (repeat 0) (repeat 0) []
52. where brainfuck' (']':cs) _ _ [] = error "mismatched brakets"
53. brainfuck' [] _ _ _ = []
54. brainfuck' (c:cs) (m:ms) (n:ns) r
55. | c == '+' = '+' : brainfuck' cs ((m + 1) : ms) (n:ns) r
56. | c == '-' = '-' : brainfuck' cs ((m - 1) : ms) (n:ns) r
57. | c == '>' = '>' : brainfuck' cs ms (m:n:ns) r
58. | c == '<' = '<' : brainfuck' cs (n:m:ms) ns r
59. | c == '.' = '.' : brainfuck' cs (m:ms) (n:ns) r
60. | c == '[' = '[' : if m /= 0
61. then brainfuck' cs (m:ms) (n:ns) ((c:cs):r)
62. else brainfuck' (tail \$ dropWhile (/=']') cs) (m:ms) (n:ns) r
63. | c == ']' = ']' : brainfuck' (head r) (m:ms) (n:ns) (tail r)
64. | otherwise = brainfuck' cs (m:ms) (n:ns) r
RAW Paste Data