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 |