Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
911 views
in Technique[技术] by (71.8m points)

haskell - Test if all elements of a Foldable are the same

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
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...