测试 Foldable 的所有元素是否相同

Question

我构建了一个函数来验证可折叠结构的所有元素是否相等。

与列表中的类似功能相比，在我看来，更通用的功能异常复杂，但我无法简化它。

你有什么建议吗？

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

Answer 1

我不知道不太复杂，但我认为这是“最干净”的方式。 “干净”是指使用单个特殊的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

Answer 2

第一个函数在第二个函数中不存在的方便之处在于，我们有一种方便的方法来获取列表的“头部”。幸运的是，我们可以为Foldable 做同样的事情。让我们编写一个适用于任何Foldable 的head'（为了类型安全，我们将让我们的head' 返回一个Maybe）

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

现在我们可以编写与一般的列表案例基本相同的代码了。

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

从语法上看，它看起来不同，但它与您在列表案例中所做的完全相同：检查结构是否为空，如果不是，则查看每个元素是否等于第一个元素。

请注意，从技术上讲，这与您发布的代码完全等效，因为它将第一个元素与自身进行比较。因此，如果您的 == 运算符由于某种原因不是自反的，您将得到不同的结果（尝试在列表中运行我的代码和您的代码 [read "NaN" :: Double]）

Answer 3

Silvio 的答案在语法上很小且易于理解；但是，如果Foldable 实例不能廉价地计算head'，它可能会做与两次折叠相关的额外工作。在这个答案中，我将讨论如何一次性执行计算底层Foldable 是否可以便宜地计算head'。

基本思想是这样的：除了跟踪“到目前为止所有元素是否相等”之外，我们还将跟踪它们都相等。所以：

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

这是一个Monoid，以Empty为单位，Inequal为吸收元素。

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

现在我们可以使用foldMap 来概括整个Foldable，如下所示：

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

Answer 4

一个相当微不足道的选择，我通常更喜欢其他答案之一，即重用allElementsEqualL：

allElementsEqualF = allElementsEqualL . toList

或在内联之后

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

懒惰使它变得合理。 all 调用不需要整个xs'，但只需要找到与x 不同的第一个。所以toList 也不会要求整个xs。同时，已经检查过的元素不需要保存在内存中。

您可以编写一个 Foldable 实例，其中 toList 没有必要那么懒惰，但除了这些情况，我认为它应该做的工作与 Daniel Wagner 和 HTNW 的答案一样多（有轻微的开销，不取决于输入大小）。

我也想到了一个混合解决方案：

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

所以如果 goList 是惰性的，则在原始类型（全部）上进行测试。

这在非空情况下的工作比 Silvio 的答案稍微多一些，因为 F.null 与 head' 的工作完全相同。因此，Silvio 的代码必须到达第一个元素 2 次（一个用于 head'，另一个用于 all），而您的代码需要执行 3 次（null、head $ toList xs 和 all 再次）。