Question

我有以下代码，我想优化。我特别不满意：

deep (Op o x) = [f (Op o x)] ++ map (\y->(Op o y)) (sf x)
deep x = [x]

sf [x] = [[f x]]
sf (x:xs) = map (\y->(y:xs)) (deep x) ++ map (x:) (sf xs)

eqlst l
    | l == ll = l
    | otherwise = eqlst ll
    where ll = nub $ l ++ (concat $ map deep l)

为了充分理解这一点，我提供了所有代码，但不是很长：

module Nat ( Nat, Operator(Add, Mul), Exp(Const, Name, Op), toNat, fromNat) where
import Data.List(nub)

newtype Nat = Nat Integer deriving (Eq, Show, Ord)
toNat :: Integer -> Nat
toNat x | x <= 0    = error "Natural numbers should be positive."
        | otherwise = Nat x
fromNat :: Nat -> Integer
fromNat (Nat n) = n
instance Num Nat where
    fromInteger = toNat
    x + y = toNat (fromNat x + fromNat y)
    x - y = toNat (fromNat x - fromNat y)
    x * y = toNat (fromNat x * fromNat y)
    abs x = x
    signum x = 1

data Operator = Add | Sub | Mul
    deriving (Eq, Show, Ord)

data Exp = Const Nat | Name { name::String } | Op{ op::Operator, kids::[Exp] }
    deriving (Eq, Ord)

precedence :: Exp -> Integer
precedence (Const x) = 10
precedence (Name x) = 10
precedence (Op Add x) = 6
precedence (Op Sub x) = 6
precedence (Op Mul x) = 7

instance Show Exp where
    show Op { op = Add, kids = [x, y] } =
        let left = if precedence x <= 6 then "(" ++ show x ++ ")" else show x in
        let right = if precedence y <= 6 then "(" ++ show y ++ ")" else show y in
        left ++ "+" ++ right
    show Op { op = Sub, kids = [x, y] } =
        let left = if precedence x <= 6 then "(" ++ show x ++ ")" else show x in
        let right = if precedence y <= 6 then "(" ++ show y ++ ")" else show y in
        left ++ "-" ++ right
    show Op { op = Mul, kids = [x, y] } =
        let left = if precedence x <= 7 then "(" ++ show x ++ ")" else show x in
        let right = if precedence y <= 7 then "(" ++ show y ++ ")" else show y in
        left ++ "∙" ++ right
    show (Const (Nat x)) = show x
    show (Name x) = x
    show x = "wat"

instance Num Exp where
    fromInteger = Const . toNat
    (Const x) + (Const y) = Const (x+y)
    x + y = simplify $ Op { op = Add, kids = [x, y] }
    (Const x) - (Const y) = Const (x-y)
    x - y = simplify $ Op { op = Sub, kids = [x, y] }
    (Const x) * (Const y) = Const (x*y)
    x * y = simplify $ Op { op = Mul, kids = [x, y] }
    abs x = x
    signum x = 1

simplify :: Exp -> Exp
simplify (Op Mul [x,1]) = x
simplify (Op Mul [1,x]) = x
simplify (Op Sub [x,y])
    | x == y = 0
    | otherwise = (Op Sub [x,y])
simplify x = x

f (Op Add [x,y]) = y+x
f (Op Sub [x,y]) = y-x
f (Op Mul [x,y]) = y*x
f x = x

deep (Op o x) = [f (Op o x)] ++ map (\y->(Op o y)) (sf x)
deep x = [x]

sf [x] = [[f x]]
sf (x:xs) = map (\y->(y:xs)) (deep x) ++ map (x:) (sf xs)

eqlst l
    | l == ll = l
    | otherwise = eqlst ll
    where ll = nub $ l ++ (concat $ map deep l)

eq x = eqlst [x]

main = do
    let x = Name "x";y = Name "x";z = Name "z";w = Name "w";q = Name "q"
    let g = (x+y+(z+w)+q)+(x+y+(z+w)+q)+(x+y+(z+w)+q)+(x+y+(z+w)+q)
    putStr $ unlines $ map show $ eq g

我还有一个侧面问题，关于函数deep和使用f :: Exp-＆gt; Exp的sf。最后，f应该是f :: [Exp] - ＆gt; [Exp]。现在，f只执行一种转换。最后，我希望它能够执行多种转换，例如： a + b-> b + a，（a + b）+ c-> a +（b + c）等

Answer 1

函数nub效率很低，因为它只使用Eq约束，因此必须比较每个非丢弃元素对。使用基于排序树内部的更高效Data.Set，应该改进：

import qualified Data.Set as S

eqset s
    | s == ss = s
    | otherwise = eqset ss
    where ss = S.unions $ s : map (S.fromList . deep) (S.toList s)

eqlst = S.toList . eqset . S.fromList

如何优化传递闭包？

1 个答案: