View difference between Paste ID: k48YweQu and 5yuxz2Pe
SHOW: | | - or go back to the newest paste.
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