组装表达式

组装表达式

问题

给定正整数集合 S 和正整数 n, 二元运算 +-*/, 不重复抽取 S, 可重复使用二元运算, 组成表达式, 要求结果等于 n 且计算中间结果全为正整数

思路

定义类型

data Op = Add | Sub | Mul | Div
data Expr = Val Int | App Op Expr Expr 

Show 实例

instance Show Op where
instance Show Expr where

expr :: Expr
expr = App Add (App Mul (App Sub (Val 5) (Val 3)) (App Div (Val 4) (Val 2))) (Val 5)

> ((5-3)*(4/2))+5

单次计算

valid :: Op -> Int -> Int -> Bool
valid Add x y = x <= y
valid Sub x y = x > y
valid Mul x y = x <= y && x /= 1 && y /= 1
valid Div x y = x `mod` y == 0 && y /= 1

apply :: Op -> Int -> Int -> Int
apply Add x y = x + y
apply Sub x y = x - y
apply Mul x y = x * y
apply Div x y = x `div` y

挑选数字

graph LR A(序列) --subseqs--> B(子序列) --perms--> C(全排列子序列)

subseqs :: [a] -> [[a]]
subseqs [] = [[]]
subseqs (x:xs) = yss ++ map (x:) yss
            where yss = subseqs xs

interleave :: a -> [a] -> [[a]]
interleave x [] = [[x]]
interleave x (y:ys) = (x:y:ys) : map (y:) (interleave x ys)

perms :: [a] -> [[a]]
perms = foldr (concatMap . interleave) [[]]

choices = concatMap perms . subseqs

choices [1,2,3]
> [[],[3],[2],[2,3],[3,2],[1],[1,3],[3,1],[1,2],[2,1],[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]

组装表达式

graph LR A(序列) --split--> B(二划分序列) --exprs--> D(二表达式) --combine--> C(表达式)

split :: [a] -> [([a],[a])]
split [] = []
split [_] = []
split (x:xs) = ([x],xs) : [(x:ls,rs) | (ls,rs) <- split xs]

combine :: Expr -> Expr -> [Expr]
combine l r = [ App o l r | o <- ops]

ops :: [Op]
ops = [Add, Sub, Mul, Div]

exprs :: [Int] -> [Expr]
exprs [] = []
exprs [x] = [Val x]
exprs xs = [e | (ls,rs) <- split xs, l <- exprs ls, r <- exprs rs, e <- combine l r]

exprs [1,2]
> [1+2,1-2,1*2,1/2]

解决问题

graph LR A(序列) --choices--> B(选择的序列) --exprs--> C(表达式) --eval--> D(计算结果)

eval :: Expr -> [Int]
eval (Val x) = [x | x > 0]
eval (App o l r) = [apply o x y | x <- eval l, y <- eval r, valid o x y]

solutions :: [Int] -> Int -> [Expr]
solutions xs n = [e | c <- choices xs, e <- exprs c, x <- eval e, x == n]

main :: IO ()
main = print (solutions' [1, 3, 7, 10, 25, 50] 765)

优化性能

组装表达式递归中剪枝

组装表达式提供表达式结果额外信息 (Expr,Int)

进而在组装表达式时, 通过表达式结果进行剪枝

graph LR A(两表达式) --> B{valid ?} B --Yes-->C(继续组装) B --No-->D(整体剪掉)

type Result = (Expr,Int)

-- [1,2] -> [(1+2,3),(1-2,-1),(1*2,2),(1/2,0.5)] filter [(1+2,3)]
exprs' :: [Int] -> [Result]
exprs' [] = []
exprs' [x] = [(Val x, x) | x > 0]
exprs' xs = [res | (ls,rs) <- split xs, lx <- exprs' ls, ry <- exprs' rs, res <- combine' lx ry]

combine' :: Result -> Result -> [Result]
combine' (l,x) (r,y) = [(App o l r, apply o x y) | o <- ops, valid o x y]

solutions' :: [Int] -> Int -> [Expr]
solutions' xs n = [e | c <- choices xs, (e, m) <- exprs' c, m == n]

实现

data Op = Add | Sub | Mul | Div
data Expr = Val Int | App Op Expr Expr 

-- show
instance Show Op where
    show Add = "+"
    show Sub = "-"
    show Mul = "*"
    show Div = "/"

instance Show Expr where
    show (Val n) = show n
    show (App o l r) = bracket l ++ show o ++ bracket r
                    where 
                        bracket :: Expr -> String
                        bracket (Val n) = show n
                        bracket e = "(" ++ show e ++ ")"
expr :: Expr
expr = App Add (App Mul (App Sub (Val 5) (Val 3)) (App Div (Val 4) (Val 2))) (Val 5)

-- 单次计算
valid :: Op -> Int -> Int -> Bool
valid Add x y = x <= y
valid Sub x y = x > y
valid Mul x y = x <= y && x /= 1 && y /= 1
valid Div x y = x `mod` y == 0 && y /= 1

apply :: Op -> Int -> Int -> Int
apply Add x y = x + y
apply Sub x y = x - y
apply Mul x y = x * y
apply Div x y = x `div` y

-- 挑选数字
subseqs :: [a] -> [[a]]
subseqs [] = [[]]
subseqs (x:xs) = yss ++ map (x:) yss
            where yss = subseqs xs

interleave :: a -> [a] -> [[a]]
interleave x [] = [[x]]
interleave x (y:ys) = (x:y:ys) : map (y:) (interleave x ys)

perms :: [a] -> [[a]]
perms = foldr (concatMap . interleave) [[]]

-- [1, 2, 3] -> [[], [1], [2], [3], [1, 2], [2, 1], [1, 3], [3, 1], [2, 3], [3, 2], [1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
choices :: [a] -> [[a]]
choices = concatMap perms . subseqs

-- 组装表达式
split :: [a] -> [([a],[a])]
split [] = []
split [_] = []
split (x:xs) = ([x],xs) : [(x:ls,rs) | (ls,rs) <- split xs]

combine :: Expr -> Expr -> [Expr]
combine l r = [ App o l r | o <- ops]

ops :: [Op]
ops = [Add, Sub, Mul, Div]

-- [1,2] -> [1+2,1-2,1*2,1/2]
exprs :: [Int] -> [Expr]
exprs [] = []
exprs [x] = [Val x]
exprs xs = [e | (ls,rs) <- split xs, l <- exprs ls, r <- exprs rs, e <- combine l r]

-- 解决问题
eval :: Expr -> [Int]
eval (Val x) = [x | x > 0]
eval (App o l r) = [apply o x y | x <- eval l, y <- eval r, valid o x y]

solutions :: [Int] -> Int -> [Expr]
solutions xs n = [e | c <- choices xs, e <- exprs c, x <- eval e, x == n]

main :: IO ()
main = print (solutions' [1, 3, 7, 10, 25, 50] 765)

-- 性能优化
type Result = (Expr,Int)

-- [1,2] -> [(1+2,3),(1-2,-1),(1*2,2),(1/2,0.5)] filter: [(1+2,3)]
exprs' :: [Int] -> [Result]
exprs' [] = []
exprs' [x] = [(Val x, x) | x > 0]
exprs' xs = [res | (ls,rs) <- split xs, lx <- exprs' ls, ry <- exprs' rs, res <- combine' lx ry]

combine' :: Result -> Result -> [Result]
combine' (l,x) (r,y) = [(App o l r, apply o x y) | o <- ops, valid o x y]

solutions' :: [Int] -> Int -> [Expr]
solutions' xs n = [e | c <- choices xs, (e, m) <- exprs' c, m == n]

参考: Programming in Haskell ch9