[Haskell-cafe] Interesting problem from Bird (4.2.13)

[Bas van Dijk]

2009/3/4 R J <rj248842 at hotmail.com>:
> Could someone provide an elegant solution to Bird problem 4.2.13?
>
> Here are the problem and my inelegant solution:
>
> Problem
> -------
>
> Since concatenation seems such a basic operation on lists, we can try to
> construct a data type that captures
> concatenation as a primitive.
>
> For example,
>
> data (CatList a)       =  CatNil
>                        |  Wrap a
>                        |  Cat (CatList a) (CatList a)
>
> The intention is that CatNil represents [], Wrap x represents [x], and Cat x
> y represents
> x ++ y.
>
> However, since "++" is associative, the expressions "Cat xs (Cat ys zs)" and
> "Cat (Cat xs ys) zs" should be regarded as equal.
>
> Define appropriate instances of "Eq" and "Ord" for "CatList".
>
> Inelegant Solution
> ------------------
>
> The following solution works:
>
> instance (Eq a) => Eq (CatList a) where
>     CatNil      ==  CatNil       =    True
>     CatNil      ==  Wrap   z     =    False
>     CatNil      ==  Cat    z w   =  ( z == CatNil  && w == CatNil )
>
>     Wrap   x    ==  CatNil       =    False
>     Wrap   x    ==  Wrap   z     =    x == z
>     Wrap   x    ==  Cat    z w   =  ( Wrap x == z  && w == CatNil ) ||
>                                     ( Wrap x == w  && z == CatNil )
>
>     Cat    x y  ==  CatNil       =    x == CatNil  && y == CatNil
>     Cat    x y  ==  Wrap   z     =  ( x == Wrap z  && y == CatNil ) ||
>                                     ( x == CatNil  && y == Wrap z )
>     Cat    x y  ==  Cat    z w   =  unwrap (Cat x y) == unwrap (Cat z w)
>
> unwrap                           :: CatList a -> [a]
> unwrap CatNil                    =  []
> unwrap (Wrap x)                  =  [x]
> unwrap (Cat x y)                 =  unwrap x ++ unwrap y
>
> instance (Eq a, Ord a) => Ord (CatList a) where
>     x < y = unwrap x < unwrap y
>
> This solution correctly recognizes the equality of the following, including
> nested lists(represented, for example, by Wrap (Wrap 1), which corresponds
> to [[1]]):
>
> Wrap 1                               == Cat (Wrap 1) CatNil
> Cat (Wrap 1) (Cat (Wrap 2) (Wrap 3)) == Cat (Wrap 1) (Cat (Wrap 2) (Wrap 3))
> Wrap (Wrap 1)                        == Wrap (Cat (Wrap 1) CatNil)
>
> Although this solution works, it's a hack, because unwrap converts CatLists
> to lists.  The question clearly seeks a pure solution that does not rely on
> Haskell's built-in lists.
>
> What's the pure solution that uses cases and recursion on
> CatList, not Haskell's built-in lists, to capture the equality of nested
> CatLists?
>
>
> ________________________________
> Windows Live™ Contacts: Organize your contact list. Check it out.
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>

Here's my solution.

I first "right factor" each catlist by converting a catlist into a
difference catlist[1] and then turning that into a catlist again by
applying it to Nil.

At this point the converted catlist always has a right factored form:
'Cat a (Cat b (Cat c Nil)))'
which also doesn't contain Nils except at the end.

That right factored catlist is easy to compare with 'eq'.

-------------------------------------------------------------------------------

data CatList a = Nil
               | Wrap a
               | Cat (CatList a) (CatList a)
                 deriving Show

type DiffCatList a = CatList a -> CatList a

diff :: CatList a -> DiffCatList a
diff (Cat xs ys) = diff xs . diff ys
diff Nil         = id
diff w           = Cat w

rightFactor :: CatList a -> CatList a
rightFactor xs = diff xs Nil

instance Eq a => Eq (CatList a) where
    xs == ys = rightFactor xs `eq` rightFactor ys
        where
          Nil         `eq` Nil         = True
          Wrap x      `eq` Wrap y      = x == y
          Cat xs1 ys1 `eq` Cat xs2 ys2 = xs1 `eq` xs2 &&
                                         ys1 `eq` ys2
          _           `eq` _           = False

-------------------------------------------------------------------------------

(Right now I'm thinking if it's possible to fuse the 'diff' and the
'eq' somehow so that we don't have to turn the DiffCatList into a
catlist again...)

regards,

Bas

[1] http://haskell.org/haskellwiki/Difference_list