Проверьте, все ли элементы Foldable одинаковы

Я построил функцию, которая проверяет, что все элементы складной структуры равны.

По сравнению с аналогичной функцией в списках, мне кажется, что более общая функция непропорционально сложна, но я не смог ее упростить.

У вас есть какие-нибудь предложения?

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

Ответ 1

Я не знаю о менее сложных, но я думаю, что это самый "чистый" способ сделать это. Под "чистым" я подразумеваю один проход по структуре с использованием одного специального Monoid.

data Same a = Vacuous | Fail | Same a
instance Eq a => Semigroup (Same a) where
    Vacuous    <> x       = x
    Fail       <> _       = Fail
    [email protected](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

Ответ 2

Удобная вещь в вашей первой функции, которой нет в вашей второй, состоит в том, что у нас есть удобный способ получить "голову" списка. К счастью, мы можем сделать то же самое для Foldable. Давайте напишем head' которая работает на любом Foldable (и ради безопасности типов мы будем иметь нашу 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])

Ответ 3

Ответ Сильвио синтаксически мал и прост для понимания; однако, это может сделать дополнительную работу, связанную с выполнением двух сгибов, если экземпляр 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

Ответ 4

Довольно тривиальный вариант, и я бы предпочел один из других ответов, это повторно использовать allElementsEqualL:

allElementsEqualF = allElementsEqualL . toList

или после встраивания

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

Это лень, которая делает это разумным. Вызов all не требует полного xs', но только до тех пор, пока не найдет первый, отличный от x. Таким образом, toList также не будет требовать всю xs. И в то же время уже проверенные элементы не нужно хранить в памяти.

Вы можете написать Foldable экземпляр, для которого toList меньше ленивый, чем это необходимо, но за исключением тех случаев, я думаю, что он должен делать ровно столько работы, как Даниэль Вагнер и HTNW ответ (с небольшими накладными не в зависимости от размера входных данных).

Я думал также смешанное решение:
allElementsEqualF2 xs | F.null xs = True 
                      | otherwise = all (== x) xs 
    where x = head $ F.toList xs 
так что если goList ленив, тест выполняется по оригинальному типу (со всеми).

Это немного больше работы в F.null случае, чем ответ Сильвио, потому что F.null дублирует столько же работы F.toList сколько и head'. Таким образом, код Silvio должен добраться до первого элемента 2 раза (один для head' и другой внутри all), а ваш делает это 3 раза (null, head $ toList xs и all снова).