Search code examples
haskellsymbolic-mathalgebra

Representing commutative semigroups polynomials in Haskell


I'm trying to represent terms like the following:

a0 <> a1 <> ... <> an-1

Where ai must be element of a commutative Semigroup. For this one can choose a data representation like the following:

newtype SemigroupPolynomial a = SP Map a Integer

where the map contains the different terms of the polynomial and its count.

In this way, we can represent the sum

3 + 3 + 6

as (assuming OverloadedLists):

SP [(3, 2), (6, 1)]

But also we can represent terms like:

3 * 3 * 6

The SemigroupPolynomial could be an instance of Semigroup:

instance ??? a => Semigroup (SemigroupPolynomial a) where
    (MP p0) <> (MP p1) = 
        MP $ Map.filter (0/=) $ Map.unionWith (+) p0 p1

No the question is which constraints do I have to put in ??? so that:

  1. The <> operation is commutative and associative.
  2. It can be used to represent sums and products, as exemplified above.

A similar question on how to represent commutative Monoids was already asked here. However it seems that the constraint (Abelian m, Monoidal m) might be too strong (I don't require a zero element), and it will prevent me to use this to represent products.


Solution

  • As @leftroundabout has commented, you don't need a constraint here. Don't be fooled by the word "constraint". In Haskell, the primary purpose of constraints isn't to constrain the behavior of a particular type or operation in some manner. Rather, it's to constrain the set of types that a function will accept to those types that support a set of operations.

    When I write:

    fmapTwice :: (Functor f) => (a -> a) -> f a -> f a
    fmapTwice f = fmap (f . f)
    

    I'm not really constraining the type f to act like a functor and obey the rules required of functors. Rather, I'm constraining the fmapTwice function to only apply to types f that support the fmap operation.

    Nothing stops some jerk from writing:

    data Foo a = Foo a | NoFoo deriving (Show)
    instance Functor Foo where
        fmap _ _ = NoFoo   -- invalid functor violates:  fmap id = id
    

    and applying my function to this invalid functor:

    > fmapTwice (*2) (Foo 10)
    NoFoo
    >
    

    Haskell relies on programmer discipline to ensure that something declared as having a Functor instance is a well behaved functor.

    In your example, the instance:

    import Data.Semigroup
    import qualified Data.Map as Map
    import Data.Map.Strict (Map)
    
    data SemigroupPolynomial a = SP (Map a Integer) deriving (Show)
    instance (Ord a) => Semigroup (SemigroupPolynomial a) where
        (SP p0) <> (SP p1) = 
            SP $ Map.filter (0/=) $ Map.unionWith (+) p0 p1
    

    doesn't require any constraints other than Ord a, to ensure that a can be used as a Map key.

    Now, it's up to you to make sure you only use your SemigroupPolynomial to represent commutative operations:

    foldSP :: (a -> a -> a) -> SemigroupPolynomial a -> a
    foldSP f (SP m) = foldr1 f $ concatMap (\(a, n) -> replicate (fromIntegral n) a)
                                           (Map.assocs m)
    
    main = do let sp = singleton 3 <> singleton 3 <> singleton 6
              print sp
              print $ foldSP (*) sp
              print $ foldSP (+) sp
              print $ foldSP (-) sp   -- wrong, but it's your own damn fault
    

    If you want to somehow introduce a requirement of commutativity into your data type, one way of doing it (that doesn't involve Haskell "constraints" at all) is to write something like:

    data CommutativeOp a = CO (a -> a -> a)
    foldSP :: CommutativeOp a -> SemigroupPolynomial a -> a
    foldSP (CO f) (SP m) = <same as above>
    

    Now, as long as you realize that when you write:

    plusOp = CO (+)
    timesOp = CO (*)
    

    you are making a declaration that (+) and (*) are commutative operations, this will ensure that foldSP is only applied to such operations:

    main = do let sp = singleton 3 <> singleton 3 <> singleton 6
              print $ foldSP plusOp sp
              print $ foldSP timesOp sp
    

    If you want to somehow introduce a commutativity constraint on the type a to ensure that SemigroupPolynomial a is a valid representation, then you can't do this for a equal to Int, obviously, since it depends on which binary operation Int -> Int -> Int is used for the fold.

    Instead, you need to embed the operation into the type, perhaps using newtypes that represent the operation, like Sum or Product in Data.Semigroup. Then, you can introduce a type class (with no operations) to represent the commutativity constraint:

    class Commutative a
    instance Commutative (Sum a)
    instance Commutative (Product a)
    instance (Ord a, Commutative b) => SemigroupPolynomial b where
        ...definition on (<>) as above...
    

    and now the fold operation would use the operation implicit in the newtype (here, just using the monoid instance):

    foldSP' :: (Monoid a) => SemigroupPolynomial a -> a
    foldSP' (SP m) = mconcat $ concatMap (\(a, n) -> replicate (fromIntegral n) a)
                                         (Map.assocs m)
    

    Maybe this is what you wanted. If so, the full example looks like this:

    import Data.Semigroup
    import qualified Data.Map as Map
    import Data.Map.Strict (Map)
    
    newtype SemigroupPolynomial a = SP (Map a Integer) deriving (Show)
    
    class Commutative a
    instance Commutative (Sum a)
    instance Commutative (Product a)
    instance (Ord a, Commutative a) => Semigroup (SemigroupPolynomial a) where
        (SP p0) <> (SP p1) = 
            SP $ Map.filter (0/=) $ Map.unionWith (+) p0 p1
    
    singleton :: a -> SemigroupPolynomial a
    singleton x = SP $ Map.singleton x 1
    
    foldSP' :: (Monoid a) => SemigroupPolynomial a -> a
    foldSP' (SP m) = mconcat $ concatMap (\(a, n) -> replicate (fromIntegral n) a)
                                         (Map.assocs m)
    
    main = do let sp1 = singleton (Sum 3) <> singleton (Sum 3) <> singleton (Sum 6)
              print sp1
              print (foldSP' sp1)
              let sp2 = singleton (Product 3) <> singleton (Product 3) 
                              <> singleton (Product 6)
              print sp2
              print (foldSP' sp2)