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:

- There exists a type within the types (call it
`Id`

) that is ignored in the comparisons. - 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
firstKey = head . Map.keys
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'
```