# Deciding whether a list of sum types is homogeneous

Posted on

Problem

I ran into a problem recently where I had to decide whether a set of sum types was homogeneous (all the same). In itself, this is a pretty simple problem. However, there were a few complicating factors:

1. There exists a type within the types (call it `Id`) that is ignored in the comparisons.
2. There exists a type (call it `Mix`) that immediately makes the set non-homogeneous, even if all the types are `Mix`.

The extension of this problem was, given a list of types, is there a single type that can be removed that will make the rest of the types homogeneous (excepting, of course, the `Mix` type).

For example, if we define our type as:

``````data Foo = Bar | Baz | Quux | Id | Mix deriving (Eq, Ord, Show)
``````

then `[Bar, Bar, Bar]` is homogeneous, `[Bar, Bar, Baz]` would be homogeneous if `Baz` were removed. Further, `[Bar, Bar, Id]` is homogeneous, and `[Mix, Mix, Mix]` is not. Finally, `[Bar, Bar, Mix]` contains a `Mix` type, and hence would not be homogeneous even if this type were removed.

``````import Data.List as List
import Data.Map as Map

data Foo = Bar | Baz | Quux | Id | Mix deriving (Eq, Ord, Show)

-- Is a list of the above sum types homogeneous?
-- Note that Id is ignored in the comparisons, and Mix immediately
-- makes this False.
homogeneous :: [Foo] -> Bool
homogeneous [] = True
homogeneous [x] = if x == Mix then False else True
homogeneous (x:xs) = all isEqNotMix xs
where isEqNotMix y = ((y == x || y == Id) && y /= Mix)

-- Find a type that would make the set homogeneous if it were removed.
-- Note that if we have an already homogeneous set, then removing the
-- single homoogeneous type from the list will leave it being homogenoeous.
-- The final part of the tuple returns whether it was a homogeneous list or not.
-- Note that in the case of no such type existing, the result is
-- (Mixed, Mixed, False).
homogeneousButOne :: [Foo] -> (Foo, Foo, Bool)
homogeneousButOne xs = case xs of
[] -> (Id, Id, True)
[x] -> (x, x, homogeneous [x])
xs@(x:_) -> if homogeneous xs then (x, x, True)
else (fst mixed, snd mixed, False)
where mixed = mixedCase \$ List.filter (/= Id) xs

-- Deal with the case where the list is not homogeneous in homogeneousButOne.
mixedCase :: [Foo] -> (Foo, Foo)
mixedCase xs
| Mix `elem` keys        = (Mix, Mix)
| Map.size fooMap == 2   = decideTwo fooMap
| otherwise              = (Mix, Mix)
where fooMap = List.foldl (acc x -> Map.insertWith (+) x 1 acc) Map.empty xs
keys = Map.keys fooMap
single = Map.filter (== 1) fooMap
multiple = Map.filter (> 1) fooMap
secondKey = head . tail . Map.keys
-- Only case where we may not have (Mix, Mix) is if there were
-- only two types found, and neither of them was `Mix`.
decideTwo mp = case Map.size single of
-- Both types exist > 1 times
0 -> (Mix, Mix)
-- One type exists once, it is the type that can be removed
1 -> (firstKey multiple , firstKey single)
-- Both types only exist once (e.g. [Bar, Baz])
2 -> (firstKey single, secondKey single)
``````

Any improvements to this code are welcome (excepting the names of the sum types: I realise `Foo`, `Bar`, `Baz` and `Quux` aren’t great, but in the original problem, the names were no more descriptive).

Solution

# homogeneous

In this line

``````homogeneous [x] = if x == Mix then False else True
``````

you have something like `if expr then False else True` which is the same as `not expr`. That is:

``````homogeneous [x] = x /= Mix
``````

In the fact the whole line could be just:

``````homogeneous [Mix] = False
``````

because the line `homogeneous (x:xs) = ...` would do the right thing for the cases that are not covered by `homogeneous [Mix]`.

# homogeneousButOne

A Map is an overkill in this case, since the problem can be solved in linear time looping through the list of Foos. Here’s one possible implementation:

``````homogeneousButOne :: [Foo] -> (Foo, Foo, Bool)
homogeneousButOne foos
| sansId == [] = (Id, Id, True)
| homogeneous sansId = (ref, ref, True)
| elem Mix sansId = (Mix, Mix, False)
| all (== other) others = (ref, other, False)
| otherwise = (Mix, Mix, False)
where
sansId = filter (/= Id) foos
(ref : remaining) = sansId
(other : others) = filter (/= ref) remaining
``````

Note however that in this implementation I valued clarity over efficiency.

`homogeneous` could also be defined using pattern matching, though that would not necessarily be an improvement.

However, `homogeneousButOne` can definitely be simplified using pattern matching, with no need for `Data.Map` or `Data.List`.

``````data Foo = Bar | Baz | Quux | Id | Mix deriving (Eq, Ord, Show)

homogeneous :: [Foo] -> Bool
homogeneous []           = True
homogeneous (Mix : _)    = False
homogeneous (Id  : xs)   = homogeneous xs
homogeneous (x   : [])   = True
homogeneous (a:Id:rest)  = homogeneous (a:rest)
homogeneous (a:b:rest)   = (a == b) && homogeneous (b:rest)

homogeneousButOne :: [Foo] -> (Foo, Foo, Bool)
homogeneousButOne xs
| null nonId           = (Id, Id, True)
| x' == Mix            = (Mix, Mix, False)
| length nonId == 3    = majority2of3 nonId
| homogeneous nonId    = (x', x', True)
| homogeneous xs'      = (head xs', x', False)
| x' == predominant    = (predominant, alt, False)
| otherwise            = (Mix, Mix, False)
where nonId = filter (/= Id) xs
(x':xs') = nonId
majority2of3 (a:b:c:[]) =
if      a == b then (a, c, a == c)
else if a == c then (a, b, a == b)
else if b == c then (b, a, b == a)
else                (Mix, Mix, False)
(predominant, alt, _) = homogeneousButOne xs'
``````