Mfcttrf

I built a function that verifies that all elements of a foldable structure are equal.

Compared to a similar function on the lists, it seems to me that the more general function is disproportionately complex, but I have not been able to simplify it.

Do you have any suggestions?

import Data.Monoid
import Data.Sequence as SQ
import Data.Matrix as MT

allElementsEqualL :: Eq a => [a] -> Bool
allElementsEqualL [] = True
allElementsEqualL (x:ns) = all (== x) ns
-- allElementsEqualL [1,1,1] -> True

allElementsEqualF :: (Foldable t, Eq a) => t a -> Bool
allElementsEqualF xs = case (getFirst . foldMap (First . Just) $ xs) of
 Nothing -> True
 Just x -> all (== x) xs

-- allElementsEqualF [1,1,1] -> True

-- allElementsEqualF $ SQ.fromList [1,1,1] -> True

-- allElementsEqualF $ MT.fromLists [[1,1],[1,1]] -> True

I don't know about less complicated, but I think this is the "cleanest" way to do it. By "clean," I mean it's one traversal over the structure using a single, special Monoid.

data Same a = Vacuous | Fail | Same a
instance Eq a => Semigroup (Same a) where
 Vacuous <> x = x
 Fail <> _ = Fail
 s@(Same l) <> Same r = if l == r then s else Fail
 x <> Vacuous = x
 _ <> Fail = Fail
instance Eq a => Monoid (Same a) where
 mempty = Vacuous

allEq :: (Foldable f, Eq a) => f a -> Bool
allEq xs = case foldMap Same xs of
 Fail -> False
 _ -> True

The convenient thing about your first function that doesn't exist in your second is that we have a convenient way of getting the "head" of a list. Fortunately, we can do the same for a Foldable. Let's write a head' that works on any Foldable (and for the sake of type safety we'll have our head' return a Maybe)

head' :: (Foldable t, Eq a) => t a -> Maybe a
head' = foldr (a _ -> Just a) Nothing

Now we can write basically the same code as the list case for the general one.

allElementsEqualF :: (Foldable t, Eq a) => t a -> Bool
allElementsEqualF f = case head' f of
 Nothing -> True
 Just a -> all (== a) f

Syntactically, it looks different, but it's the exact same thing you did in your list case: check if the structure is empty and, if it's not, then see if every element is equal to the first.

Note that, technically, this is not quite equivalent to the code you posted, as it compares the first element against itself. So if your == operator is for some reason not reflexive, you'll get different results (try running my code and yours on the list [read "NaN" :: Double])

Silvio's answer is syntactically small and easy to understand; however, it may do extra work associated with doing two folds if the Foldable instance can't compute head' cheaply. In this answer I will discuss how to perform the calculation in just one pass whether the underlying Foldable can compute head' cheaply or not.

The basic idea is this: instead of tracking just "are all the elements equal so far", we'll also track what they're all equal to. So:

data AreTheyEqual a
 = Empty
 | Equal a
 | Inequal
 deriving Eq

This is a Monoid, with Empty as the unit and Inequal as an absorbing element.

instance Eq a => Semigroup (AreTheyEqual a) where
 Empty <> x = x
 x <> Empty = x
 Equal a <> Equal b | a == b = Equal a
 _ <> _ = Inequal

instance Eq a => Monoid (AreTheyEqual a) where
 mempty = Empty

Now we can use foldMap to summarize an entire Foldable, like so:

allElementsEqual :: (Eq a, Foldable f) => f a -> Bool
allElementsEqual = (Inequal /=) . foldMap Equal

A rather trivial option, and I would generally prefer one of the other answers, is reusing allElementsEqualL:

allElementsEqualF = allElementsEqualL . toList

or after inlining

allElementsEqualF xs = case toList xs of
 [] -> True
 x:xs' -> all (== x) xs'

It's laziness which makes it reasonable. The all call doesn't demand the entire xs', but only until it finds the first one different from x. So toList will also not demand the entire xs. And at the same time, already examined elements don't need to be kept in memory.

You could write a Foldable instance for which toList is less lazy than necessary, but except for those cases I think it should do exactly as much work as Daniel Wagner's and HTNW's answer (with slight overhead not depending on input size).

I thought also a mixed solution:

allElementsEqualF2 xs | F.null xs = True 
 | otherwise = all (== x) xs 
 where x = head $ F.toList xs 

so if goList is lazy, the test is carried out upon the original type (with all).

This does slightly more work in the non-empty case than Silvio's answer, because F.null duplicates exactly as much of F.toList's work as head' does. So Silvio's code has to get to the first element 2 times (one for head' and another inside all), and yours does it 3 times (null, head $ toList xs and all again).