Advertisement
Guest User

Untitled

a guest
Nov 14th, 2013
67
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.14 KB | None | 0 0
  1. import Data.Numbers.Primes
  2. import Data.List
  3. import Data.Function
  4.  
  5. data Expr = Inc Expr
  6. | Mul Expr Expr
  7. | Val Int
  8. deriving(Show)
  9.  
  10. fromList [x] = Val x
  11. fromList (x:xs) = Mul (Val x) (fromList xs)
  12.  
  13. powerset l = delete l (nub (powerset' l))
  14. where powerset' [x] = [[x]]
  15. powerset' (x:xs) = powerset' xs ++ map (x:) (powerset' xs)
  16.  
  17. factors x n = factors' n (primeFactors x)
  18. where factors' _ [] = []
  19. factors' 2 pfacts = map (\(x, y) -> [product x, product y]) pairs
  20. where pairs = map (\x -> (x, pfacts \\ x)) (powerset pfacts)
  21. factors' n pfacts = concatMap (\(x, y) -> let p = product x in map (p:) (factors' (n - 1) y)) factPairs
  22. where factPairs = map (\x -> (x, pfacts \\ x)) (powerset pfacts)
  23.  
  24. enum 0 = [Val 0]
  25. enum 1 = [Val 1]
  26. enum n = map Inc (enum (n - 1))
  27. ++ (map fromList $ concatMap (factors n) [2..n `div` 2])
  28.  
  29. cost (Val n) = n
  30. cost (Inc e) = 1 + cost e
  31. cost (Mul x y) = 6 + cost x + cost y
  32.  
  33. minimumExpression n = minimumBy (compare `on` cost) (enum n)
  34.  
  35. translate (Val n) = take n (repeat '+')
  36. translate (Inc e) = translate e ++ "+"
  37. translate (Mul x y) = translate y ++ "[->" ++ translate x ++ "<]>"
  38.  
  39. minBFExpr = translate . minimumExpression
  40.  
  41. brainfuck cs = brainfuck' cs (repeat 0) (repeat 0) []
  42. where brainfuck' (']':cs) _ _ [] = error "mismatched brakets"
  43. brainfuck' [] _ _ _ = []
  44. brainfuck' (c:cs) (m:ms) (n:ns) r
  45. | c == '+' = '+' : brainfuck' cs ((m + 1) : ms) (n:ns) r
  46. | c == '-' = '-' : brainfuck' cs ((m - 1) : ms) (n:ns) r
  47. | c == '>' = '>' : brainfuck' cs ms (m:n:ns) r
  48. | c == '<' = '<' : brainfuck' cs (n:m:ms) ns r
  49. | c == '.' = '.' : brainfuck' cs (m:ms) (n:ns) r
  50. | c == '[' = '[' : if m /= 0
  51. then brainfuck' cs (m:ms) (n:ns) ((c:cs):r)
  52. else brainfuck' (tail $ dropWhile (/=']') cs) (m:ms) (n:ns) r
  53. | c == ']' = ']' : brainfuck' (head r) (m:ms) (n:ns) (tail r)
  54. | otherwise = brainfuck' cs (m:ms) (n:ns) r
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement