Skip to main content
2 of 4
rearranged text - Q remains exactly the same
j-a
  • 591
  • 4
  • 12

squashing multiplication identity in an expression

I'm learning Haskell, and one exercise was to implement squashing of identity-multiplications.

Here is my implementation.

squashMulId :: (Ring a, Eq a) => RingExpr a -> RingExpr a
squashMulId (Mul x y)
    | x == (Lit (mulId))    = squashMulId y
    | y == (Lit (mulId))    = squashMulId x
    | otherwise             = if sqX == x && sqY == y then (Mul sqX sqY) else squashMulId (Mul sqX sqY)
                              where sqX = squashMulId x
                                    sqY = squashMulId y
squashMulId (AddInv x)      = (AddInv (squashMulId x))
squashMulId (Add x y)       = (Add (squashMulId x) (squashMulId y))
squashMulId x               = x

squashMulIdInt :: RingExpr Integer -> RingExpr Integer
squashMulIdInt = squashMulId

tests_squash = test [
                      "right" ~: (Add (Lit 5) (Lit 2)) ~=? squashMulIdInt (Add (Lit 5) (Mul (Lit 2) (Lit 1)) )
                     ,"left" ~: (Add (Lit 5) (Lit 2)) ~=? squashMulIdInt (Add (Lit 5) (Mul (Lit 1) (Lit 2)) )
                     ,"recursive" ~: (Add (Lit 5) (Lit 2)) ~=? squashMulIdInt (Add (Lit 5) (Mul (Lit 1) (Mul (Lit 2) (Mul (Lit 1) (Lit 1)))))
                    ]

How can I improve on this implementation? Is it idiomatic? Can it be written in a more succinct way?

The following code/definitions were given:

{-# OPTIONS_GHC -Wall #-}
module SQMULID where

import Data.Char
import Data.List
import Data.Maybe
import Test.HUnit
import Test.QuickCheck
import Test.QuickCheck.Gen


class Ring a where
  addId  :: a            -- additive identity
  addInv :: a -> a       -- additive inverse
  mulId  :: a            -- multiplicative identity

  add :: a -> a -> a     -- addition
  mul :: a -> a -> a     -- multiplication

-- | A datatype for storing and manipulating ring expressions.
data RingExpr a = Lit a
                | AddId
                | AddInv (RingExpr a)
                | MulId
                | Add (RingExpr a) (RingExpr a)
                | Mul (RingExpr a) (RingExpr a)
  deriving (Show, Eq)

instance Ring (RingExpr a) where
  addId  = AddId
  addInv = AddInv
  mulId  = MulId

  add = Add
  mul = Mul

-- The canonical instance for integers:
instance Ring Integer where
  addId  = 0
  addInv = negate
  mulId  = 1

  add = (+)
  mul = (*)
j-a
  • 591
  • 4
  • 12