Skip to main content
edited body
Source Link
gallais
  • 781
  • 4
  • 12
squashMulId :: (Ring a, Eq a) => RingExpr a -> RingExpr a
squashMulId = fold Lit AddId AddInv MulId Add squashing
  where
    squashing a b
      | a == Lit mulId || a == MulId = ab
      | b == Lit mulId || b == MulId = ba
      | otherwise                    = Mul a b
squashMulId :: (Ring a, Eq a) => RingExpr a -> RingExpr a
squashMulId = fold Lit AddId AddInv MulId Add squashing
  where
    squashing a b
      | a == Lit mulId || a == MulId = a
      | b == Lit mulId || b == MulId = b
      | otherwise                    = Mul a b
squashMulId :: (Ring a, Eq a) => RingExpr a -> RingExpr a
squashMulId = fold Lit AddId AddInv MulId Add squashing
  where
    squashing a b
      | a == Lit mulId || a == MulId = b
      | b == Lit mulId || b == MulId = a
      | otherwise                    = Mul a b
Source Link
gallais
  • 781
  • 4
  • 12

You are doing both too much work and not enough.

  • You are doing too much work because you don't need to repeatedly squash units in case the first pass has returned a modified expression.

  • You are not doing enough work because you are not squashing the units coming from MulId rather than Lit mulId

Here is a solution which one could argue is more idiomatic as well as dealing with the two shortcomings I pointed out earlier:

We start by implementing the recursion pattern first; it is a quite common thing to do in Haskell as it helps make it easier to understand from first sight how a function works (what does this function do? Oh! It goes by recursion on the structure! Let's see what the different cases are...).

To do that, you define a function fold taking one argument per constructor of the datatype and having a given return type (here b). The arguments are functions taking the same arguments as the constructors they correspond to except that the recursive occurences of RingExpr a have been replaced by the return type b (i.e. we assume we already know the result for the recursive subcomputations!)

fold :: (a -> b)      -> -- Lit    :: a -> RingExpr a
        b             -> -- AddId  :: RingExpr a
        (b -> b)      -> -- AddInv :: RingExpr a -> RingExpr a
        b             -> -- MulId  :: RingExpr a
        (b -> b -> b) -> -- Add    :: RingExpr a -> RingExpr a -> RingExpr a
        (b -> b -> b) -> -- Mul    :: RingExpr a -> RingExpr a -> RingExpr a
        RingExpr a -> b
fold litb addIdb addInvb mulIdb addb mulb = go
  where go (Lit a)    = litb a
        go AddId      = addIdb
        go (AddInv e) = addInvb $ go e
        go MulId      = mulIdb
        go (Add e f)  = go e `addb` go f
        go (Mul e f)  = go e `mulb` go f

The function you are looking to define is now a simple instance of the recursion pattern we just described: for the cases which are not Mul, we simply use the corresponding constructor but in the case of Mul we do the squashing:

squashMulId :: (Ring a, Eq a) => RingExpr a -> RingExpr a
squashMulId = fold Lit AddId AddInv MulId Add squashing
  where
    squashing a b
      | a == Lit mulId || a == MulId = a
      | b == Lit mulId || b == MulId = b
      | otherwise                    = Mul a b