How to optimize a transitive closure?

Question

I have the following code, which I would like to optimize. I'm particularly unhappy with nub :

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)

For a full understanding of this, I provide all my code, which is not so long:

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

I also have a side question, about the function deep and sf that are using f::Exp->Exp. In the end, f should probably be f::[Exp]->[Exp]. Right now, f only performs one kind of transformation. In the end, I would like it to perform many kinds of transformations, for example : a+b->b+a, (a+b)+c->a+(b+c), etc.

A suggestion: you should add a comment about what the code is supposed to do. Many readers will probably not try to infer it from the code itself. The code is not so huge indeed, but is uncommented and long enough to drive people off. — chi, Jun 19 '14 at 21:51
This question appears to be off-topic because it is about improving already working code. It would be better suited for http://codereview.stackexchange.com. — jwodder, Jun 19 '14 at 23:26
This question as it stands feels too broad - I think it would be reasonable if it was confined to a single specific question like how to avoid or speed up the `nub`, and was cut down to a small reproducible example that's easy to understand without all the extra code. — Ganesh Sittampalam, Jun 20 '14 at 05:55

score 1 · Answer 1 · answered Jun 19 '14 at 22:45

The function nub is inefficient since it only uses an Eq constraint and therefore has to compare every nondiscarded pair of elements. Using the more efficient Data.Set, which is based internally on sorted trees, should improve on this:

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

How to optimize a transitive closure?

1 Answers1