让我们假设我们有一个列表xs（可能是一个非常大的列表），我们想检查它的所有元素是否相同。
我想出了各种各样的想法：
检查tail xs中的所有元素是否等于head xs：
allTheSame :: (Eq a) => [a] -> Bool
allTheSame xs = and $ map (== head xs) (tail xs)
检查length xs是否等于xs中的元素等于head xs
allTheSame' :: (Eq a) => [a] -> Bool
allTheSame' xs = (length xs) == (length $ takeWhile (== head xs) xs)
递归解决方案：allTheSame如果True的前两个元素相等，xs返回allTheSame，则会返回True xs }
allTheSame'' :: (Eq a) => [a] -> Bool
allTheSame'' xs
| n == 0 = False
| n == 1 = True
| n == 2 = xs !! 0 == xs !! 1
| otherwise = (xs !! 0 == xs !! 1) && (allTheSame'' $ snd $ splitAt 2 xs)
where n = length xs
allTheSame''' :: (Eq a) => [a] -> Bool
allTheSame''' xs
| n == 0 = False
| n == 1 = True
| n == 2 = xs !! 0 == xs !! 1
| n == 3 = xs !! 0 == xs !! 1 && xs !! 1 == xs !! 2
| otherwise = allTheSame''' (fst split) && allTheSame''' (snd split)
where n = length xs
split = splitAt (n `div` 2) xs
我在写这个问题的时候就想到了这个：
allTheSame'''' :: (Eq a) => [a] -> Bool
allTheSame'''' xs = all (== head xs) (tail xs)
我认为解决方案0效率不高，至少在内存方面，因为map会在将and应用于其元素之前构建另一个列表。我是对的吗？
解决方案1仍然不是很有效，至少在内存方面，因为takeWhile将再次构建一个额外的列表。我是对的吗？
解决方案2是尾递归（对吗？），它应该非常高效，因为只要False为False，它就会返回(xs !! 0 == xs !! 1)。我是对的吗？
解决方案3应该是最好的，因为它的复杂性应该是O（log n）
解决方案4对我来说看起来很Haskellish（是吗？），但它可能与解决方案0相同，因为all p = and . map p（来自Prelude.hs）。我是对的吗？
还有其他更好的写作方式allTheSame吗？现在，我希望有人会回答这个问题，告诉我有一个内置函数可以做到这一点：我用hoogle搜索过，但我还没有找到它。无论如何，既然我正在学习Haskell，我相信这对我来说是一个很好的练习：）
欢迎任何其他评论。谢谢！
答案 0 :(得分：28)
gatoatigrado的回答为衡量各种解决方案的性能提供了一些很好的建议。这是一个更具象征性的答案。
我认为解决方案0（或者，完全等效，解决方案4）将是最快的。请记住，Haskell是 lazy ，因此map在应用and之前不必构建整个列表。建立直觉的好方法是玩无限。例如：
ghci> and $ map (< 1000) [1..]
False
询问是否所有数字都小于1,000。如果map在应用and之前构建了整个列表，则无法回答此问题。即使你给列表一个非常大的右端点（即Haskell没有做任何“魔术”，取决于列表是否是无限的），表达式仍然会快速回答。
开始我的例子，让我们使用这些定义：
and [] = True
and (x:xs) = x && and xs
map f [] = []
map f (x:xs) = f x : map f xs
True && x = x
False && x = False
以下是allTheSame [7,7,7,7,8,7,7,7]的评估顺序。写下来会有额外的分享，这太痛苦了。我还会比简洁性更早地评估head表达式（无论如何它都会被评估，所以它几乎没有差别。）
allTheSame [7,7,7,7,8,7,7,7]
allTheSame (7:7:7:7:8:7:7:7:[])
and $ map (== head (7:7:7:7:8:7:7:7:[])) (tail (7:7:7:7:8:7:7:7:[]))
and $ map (== 7) (tail (7:7:7:7:8:7:7:7:[]))
and $ map (== 7) (7:7:7:8:7:7:7:[])
and $ (== 7) 7 : map (== 7) (7:7:8:7:7:7:[])
(== 7) 7 && and (map (== 7) (7:7:8:7:7:7:[]))
True && and (map (== 7) (7:7:8:7:7:7:[]))
and (map (== 7) (7:7:8:7:7:7:[]))
(== 7) 7 && and (map (== 7) (7:8:7:7:7:[]))
True && and (map (== 7) (7:8:7:7:7:[]))
and (map (== 7) (7:8:7:7:7:[]))
(== 7) 7 && and (map (== 7) (8:7:7:7:[]))
True && and (map (== 7) (8:7:7:7:[]))
and (map (== 7) (8:7:7:7:[]))
(== 7) 8 && and (map (== 7) (7:7:7:[]))
False && and (map (== 7) (7:7:7:[]))
False
看看我们甚至不必查看过去的3 7？这是一个懒惰的评估，使列表更像循环。所有其他解决方案都使用昂贵的函数，例如length（它们必须一直走到列表的末尾才能给出答案），因此它们的效率会降低，而且它们也无法在无限列表上运行。在无限列表上工作并且有效率通常在Haskell中一起使用。
答案 1 :(得分：21)
首先，我认为您不想使用列表。很多算法都依赖于计算长度，这很糟糕。您可能需要考虑vector包，它将为O（1）提供长度，而O（n）则为列表。向量也具有更高的内存效率，特别是如果您可以使用Unboxed或Storable变种。
话虽如此，您确实需要考虑代码中的遍历和使用模式。 Haskell的列表非常有效，如果它们可以按需生成并消耗一次。这意味着您不应该继续引用列表。像这样：
average xs = sum xs / length xs
要求将整个列表保留在内存中（通过sum或length），直到两次遍历完成。如果您可以一步完成列表遍历，那么效率会更高。
当然，您可能还需要保留列表，例如检查所有元素是否相等，如果不相同，请对数据执行其他操作。在这种情况下，对于任何大小的列表，您可能更适合使用更紧凑的数据结构（例如矢量）。
现在这已经不在了，现在看看这些功能。在我展示核心的地方，它是用ghc-7.0.3 -O -ddump-simpl生成的。此外，在使用-O0编译时，不要打扰判断Haskell代码性能。使用实际用于生产代码的标志进行编译，通常至少为-O，也可能是其他选项。
解决方案0
allTheSame :: (Eq a) => [a] -> Bool
allTheSame xs = and $ map (== head xs) (tail xs)
GHC产生这个核心：
Test.allTheSame
:: forall a_abG. GHC.Classes.Eq a_abG => [a_abG] -> GHC.Bool.Bool
[GblId,
Arity=2,
Str=DmdType LS,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=2, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [3 3] 16 0}]
Test.allTheSame =
\ (@ a_awM)
($dEq_awN :: GHC.Classes.Eq a_awM)
(xs_abH :: [a_awM]) ->
case xs_abH of _ {
[] ->
GHC.List.tail1
`cast` (CoUnsafe (forall a1_axH. [a1_axH]) GHC.Bool.Bool
:: (forall a1_axH. [a1_axH]) ~ GHC.Bool.Bool);
: ds1_axJ xs1_axK ->
letrec {
go_sDv [Occ=LoopBreaker] :: [a_awM] -> GHC.Bool.Bool
[LclId, Arity=1, Str=DmdType S]
go_sDv =
\ (ds_azk :: [a_awM]) ->
case ds_azk of _ {
[] -> GHC.Bool.True;
: y_azp ys_azq ->
case GHC.Classes.== @ a_awM $dEq_awN y_azp ds1_axJ of _ {
GHC.Bool.False -> GHC.Bool.False; GHC.Bool.True -> go_sDv ys_azq
}
}; } in
go_sDv xs1_axK
}
实际上这看起来很不错。它会产生一个带有空列表的错误，但这很容易修复。这是case xs_abH of _ { [] ->。在GHC执行worker / wrapper转换之后，递归worker函数是letrec { go_sDv绑定。工人检查其论点。如果[]，则它到达列表的末尾并返回True。否则，它会将剩余的头部与第一个元素进行比较，并返回False或检查列表的其余部分。
其他三个功能。
map完全融合了
并且不分配临时的
列表。Cheap=True声明。
这意味着GHC认为
功能“便宜”，因此一个
内联候选人。在电话里
site，如果是具体的参数类型
可以确定，GHC可能会
内联allTheSame并生成一个
非常紧密的内环，完全
绕过Eq字典
查找。结论：非常有力的竞争者。
解决方案1
allTheSame' :: (Eq a) => [a] -> Bool
allTheSame' xs = (length xs) == (length $ takeWhile (== head xs) xs)
即使不看核心我也知道这不会那么好。该列表不止一次遍历，首先是length xs，然后是length $ takeWhile。您不仅有多次遍历的额外开销，这意味着列表必须在第一次遍历后保留在内存中，并且不能进行GC。对于一个大清单，这是一个严重的问题。
Test.allTheSame'
:: forall a_abF. GHC.Classes.Eq a_abF => [a_abF] -> GHC.Bool.Bool
[GblId,
Arity=2,
Str=DmdType LS,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=2, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [3 3] 20 0}]
Test.allTheSame' =
\ (@ a_awF)
($dEq_awG :: GHC.Classes.Eq a_awF)
(xs_abI :: [a_awF]) ->
case GHC.List.$wlen @ a_awF xs_abI 0 of ww_aC6 { __DEFAULT ->
case GHC.List.$wlen
@ a_awF
(GHC.List.takeWhile
@ a_awF
(let {
ds_sDq :: a_awF
[LclId, Str=DmdType]
ds_sDq =
case xs_abI of _ {
[] -> GHC.List.badHead @ a_awF; : x_axk ds1_axl -> x_axk
} } in
\ (ds1_dxa :: a_awF) ->
GHC.Classes.== @ a_awF $dEq_awG ds1_dxa ds_sDq)
xs_abI)
0
of ww1_XCn { __DEFAULT ->
GHC.Prim.==# ww_aC6 ww1_XCn
}
}
看看核心并没有说明这一点。但请注意以下几行：
case GHC.List.$wlen @ a_awF xs_abI 0 of ww_aC6 { __DEFAULT ->
case GHC.List.$wlen
这是列表遍历发生的地方。第一个获取外部列表的长度并将其绑定到ww_aC6。第二个获取内部列表的长度，但绑定不会发生在底部附近，
of ww1_XCn { __DEFAULT ->
GHC.Prim.==# ww_aC6 ww1_XCn
长度（两个Int s）可以取消装箱并通过primop进行比较，但这是在引入开销之后的一个小安慰。
结论：不好。
解决方案2
allTheSame'' :: (Eq a) => [a] -> Bool
allTheSame'' xs
| n == 0 = False
| n == 1 = True
| n == 2 = xs !! 0 == xs !! 1
| otherwise = (xs !! 0 == xs !! 1) && (allTheSame'' $ snd $ splitAt 2 xs)
where n = length xs
这与解决方案1有同样的问题。列表被遍历多次，并且不能进行GC。但这里更糟糕，因为现在计算每个子列表的长度。我希望这在任何重要大小的列表上都具有最差的性能。另外，当你期望列表很大时，为什么你特别为1和2元素的套管列表？
判决：甚至不要考虑它。
解决方案3
allTheSame''' :: (Eq a) => [a] -> Bool
allTheSame''' xs
| n == 0 = False
| n == 1 = True
| n == 2 = xs !! 0 == xs !! 1
| n == 3 = xs !! 0 == xs !! 1 && xs !! 1 == xs !! 2
| otherwise = allTheSame''' (fst split) && allTheSame''' (snd split)
where n = length xs
split = splitAt (n `div` 2) xs
这与解决方案2存在同样的问题。即，length遍历列表多次。我不确定分而治之的方法对于这个问题是一个很好的选择，它可能比简单的扫描花费更长的时间。这取决于数据，值得测试。
结论：也许，如果你使用了不同的数据结构。
解决方案4
allTheSame'''' :: (Eq a) => [a] -> Bool
allTheSame'''' xs = all (== head xs) (tail xs)
这基本上是我的第一个想法。让我们再次检查核心。
Test.allTheSame''''
:: forall a_abC. GHC.Classes.Eq a_abC => [a_abC] -> GHC.Bool.Bool
[GblId,
Arity=2,
Str=DmdType LS,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=2, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [3 3] 10 0}]
Test.allTheSame'''' =
\ (@ a_am5)
($dEq_am6 :: GHC.Classes.Eq a_am5)
(xs_alK :: [a_am5]) ->
case xs_alK of _ {
[] ->
GHC.List.tail1
`cast` (CoUnsafe (forall a1_axH. [a1_axH]) GHC.Bool.Bool
:: (forall a1_axH. [a1_axH]) ~ GHC.Bool.Bool);
: ds1_axJ xs1_axK ->
GHC.List.all
@ a_am5
(\ (ds_dwU :: a_am5) ->
GHC.Classes.== @ a_am5 $dEq_am6 ds_dwU ds1_axJ)
xs1_axK
}
好的，也不错。与解决方案1一样，这将在空列表上出错。列表遍历隐藏在GHC.List.all中，但它可能会扩展为呼叫站点的良好代码。
判决：另一个强有力的竞争者。
因此，在所有这些之间，我希望解决方案0和4是唯一值得使用的，并且它们几乎相同。在某些情况下，我可能会考虑选项3。
编辑：在这两种情况下，空列表中的错误都可以像@ augustss的答案一样修复。
下一步是使用criterion进行一些时间分析。
答案 2 :(得分：12)
使用连续对的解决方案：
allTheSame xs = and $ zipWith (==) xs (tail xs)
答案 3 :(得分：6)
Q1 - 是的，我认为你的简单解决方案很好，没有内存泄漏。 Q4 - 解决方案3不是log（n），通过非常简单的参数，您需要查看所有列表元素以确定它们是否相同，并且查看1个元素需要1个时间步。 Q5 - 是的。 Q6，见下文。
解决这个问题的方法是输入并运行它
main = do
print $ allTheSame (replicate 100000000 1)
然后运行ghc -O3 -optc-O3 --make Main.hs && time ./Main。我最喜欢上一个解决方案（你也可以使用模式匹配来清理它），
allTheSame (x:xs) = all (==x) xs
打开ghci并在这些事情上运行“：step fcn”。它将教你很多关于懒惰评估正在扩展的内容。通常，当您匹配构造函数时，例如“x：xs”，这是恒定的时间。当你调用“length”时，Haskell需要计算列表中的所有元素（虽然它们的值仍然是“待计算”），因此解决方案1和2都是错误的。
很抱歉，如果我之前的回答有点浅薄。似乎手动扩展的东西确实有点帮助（虽然与其他选项相比，这是一个微不足道的改进），
{-# LANGUAGE BangPatterns #-}
allTheSame [] = True
allTheSame ((!x):xs) = go x xs where
go !x [] = True
go !x (!y:ys) = (x == y) && (go x ys)
似乎ghc已经专门化了这个功能，但你也可以查看specialize pragma，以防它对你的代码[link]不起作用。
答案 4 :(得分：4)
这是另一个版本（如果某些内容不匹配，则不需要遍历整个列表）：
allTheSame [] = True
allTheSame (x:xs) = isNothing $ find (x /= ) xs
这可能在语法上不正确，但我希望你有这个想法。
答案 5 :(得分：4)
这是另一种有趣的方式：
{-# INLINABLE allSame #-}
allSame :: Eq a => [a] -> Bool
allSame xs = foldr go (`seq` True) xs Nothing where
go x r Nothing = r (Just x)
go x r (Just prev) = x == prev && r (Just x)
通过跟踪前一个元素而不是第一个元素，可以轻松更改此实现以实现increasing或decreasing。要针对第一个检查所有内容，您可以将prev重命名为first，并将Just x替换为Just first。
如何优化？我还没有详细检查，但我会根据我对GHC优化的一些了解来讲一个好故事。
首先假设列表融合没有发生。然后将foldr内联，提供类似
allSame xs = allSame' xs Nothing where
allSame' [] = (`seq` True)
allSame' (x : xs) = go x (allSame' xs)
Eta扩张然后产生
allSame' [] acc = acc `seq` True
allSame' (x : xs) acc = go x (allSame' xs) acc
内联go，
allSame' [] acc = acc `seq` True
allSame' (x : xs) Nothing = allSame' xs (Just x)
allSame' (x : xs) (Just prev) =
x == prev && allSame' xs (Just x)
现在GHC可以识别递归调用的Maybe值总是Just，并使用worker-wrapper转换来利用这个：
allSame' [] acc = acc `seq` True
allSame' (x : xs) Nothing = allSame'' xs x
allSame' (x : xs) (Just prev) = x == prev && allSame'' xs x
allSame'' [] prev = True
allSame'' (x : xs) prev = x == prev && allSame'' xs x
现在请记住
allSame xs = allSame' xs Nothing
且allSame'不再是递归的，因此可以降低beta：
allSame [] = True
allSame (x : xs) = allSame'' xs x
allSame'' [] _ = True
allSame'' (x : xs) prev = x == prev && allSame'' xs x
因此，高阶代码已经变成了有效的递归代码而没有额外的分配。
使用allSame编译定义-O2 -ddump-simpl -dsuppress-all -dno-suppress-type-signatures的模块会产生以下结果（我已经清理了一下）：
allSame :: forall a. Eq a => [a] -> Bool
allSame =
\ (@ a) ($dEq_a :: Eq a) (xs0 :: [a]) ->
let {
equal :: a -> a -> Bool
equal = == $dEq_a } in
letrec {
go :: [a] -> a -> Bool
go =
\ (xs :: [a]) (prev :: a) ->
case xs of _ {
[] -> True;
: y ys ->
case equal y prev of _ {
False -> False;
True -> go ys y
}
}; } in
case xs0 of _ {
[] -> True;
: x xs -> go xs x
}
如您所见，这与我描述的结果基本相同。 equal = == $dEq_a位是从Eq字典中提取相等方法并保存在变量中的位置，因此只需要提取一次。
如果列表融合 会发生什么？这里提醒了这个定义：
allSame xs = foldr go (`seq` True) xs Nothing where
go x r Nothing = r (Just x)
go x r (Just prev) = x == prev && r (Just x)
如果我们致电allSame (build g)，foldr将根据规则build与foldr c n (build g) = g c n融合，产生
allSame (build g) = g go (`seq` True) Nothing
除非g已知，否则我们无处可去。所以，让我们选择一些简单的东西：
replicate k0 a = build $ \c n ->
let
rep 0 = n
rep k = a `c` rep (k - 1)
in rep k0
因此，如果h = allSame (replicate k0 a)，h成为
let
rep 0 = (`seq` True)
rep k = go a (rep (k - 1))
in rep k0 Nothing
Eta扩张，
let
rep 0 acc = acc `seq` True
rep k acc = go a (rep (k - 1)) acc
in rep k0 Nothing
内联go，
let
rep 0 acc = acc `seq` True
rep k Nothing = rep (k - 1) (Just a)
rep k (Just prev) = a == prev && rep (k - 1) (Just a)
in rep k0 Nothing
同样，GHC可以看到递归调用总是Just，所以
let
rep 0 acc = acc `seq` True
rep k Nothing = rep' (k - 1) a
rep k (Just prev) = a == prev && rep' (k - 1) a
rep' 0 _ = True
rep' k prev = a == prev && rep' (k - 1) a
in rep k0 Nothing
由于rep不再递归，GHC可以减少它：
let
rep' 0 _ = True
rep' k prev = a == prev && rep' (k - 1) a
in
case k0 of
0 -> True
_ -> rep' (k - 1) a
正如您所看到的，这可以在没有任何分配的情况下运行！显然，这是一个愚蠢的例子，但在许多更有趣的案例中会发生类似的事情。例如，如果您编写导入AllSameTest函数并定义
allSame模块
foo :: Int -> Bool
foo n = allSame [0..n]
如上所述进行编译，您将获得以下内容（未清理）。
$wfoo :: Int# -> Bool
$wfoo =
\ (ww_s1bY :: Int#) ->
case tagToEnum# (># 0 ww_s1bY) of _ {
False ->
letrec {
$sgo_s1db :: Int# -> Int# -> Bool
$sgo_s1db =
\ (sc_s1d9 :: Int#) (sc1_s1da :: Int#) ->
case tagToEnum# (==# sc_s1d9 sc1_s1da) of _ {
False -> False;
True ->
case tagToEnum# (==# sc_s1d9 ww_s1bY) of _ {
False -> $sgo_s1db (+# sc_s1d9 1) sc_s1d9;
True -> True
}
}; } in
case ww_s1bY of _ {
__DEFAULT -> $sgo_s1db 1 0;
0 -> True
};
True -> True
}
foo :: Int -> Bool
foo =
\ (w_s1bV :: Int) ->
case w_s1bV of _ { I# ww1_s1bY -> $wfoo ww1_s1bY }
这可能看起来很恶心，但是你会注意到在任何地方都没有:个构造函数，并且Int都是未装箱的，因此该函数可以在零分配的情况下运行。 / p>
答案 6 :(得分：0)
我想我可能只是在实施find并重做this。不过，我认为看到它的内脏是有启发性的。 （注意解决方案如何依赖于相等性是可传递的，尽管还要注意问题如何要求相等性是可传递的连贯性。）
sameElement x:y:xs = if x /= y then Nothing else sameElement y:xs
sameElement [x] = Just x
allEqual [] = True
allEqual xs = isJust $ sameElement xs
我喜欢sameElement如何查看列表的第一个O（1）元素，然后返回结果或递归列表的某些后缀，特别是尾部。我对这个结构没什么好说的，我只是喜欢它： - ）
我认为我做了与this相同的比较。如果我用sameElement x:xs递归，我会将输入列表的头部与解决方案0中的每个元素进行比较。
Tangent：如果需要的话，可以通过将Nothing替换为Left (x, y)并将Just x替换为Right x并isJust替换either (const False) (const True)来报告两个不匹配的元素{1}}。
答案 7 :(得分：0)
虽然效率不高（即使前两个元素不匹配，它也会遍历整个列表），这是一个厚颜无耻的解决方案：
import Data.List (group)
allTheSame :: (Eq a) => [a] -> Bool
allTheSame = (== 1) . length . group
只是为了好玩。
答案 8 :(得分：0)
这种实施方式更胜一筹。
allSame [ ] = True
allSame (h:t) = aux h t
aux x1 [ ] = True
aux x1 (x2:xs) | x1==x2 = aux x2 xs
| otherwise = False
考虑到（==）运算符的传递性，假设如果你想确保表达式链的相等性，例如a = b = c = d，则假设Eq的实例得到很好的实现，你只需要保证a = b，b = c，c = d，并且d = a，而不是上面提供的技术，例如a = b，a = c，a = d，b = c，b = d，c = d 。
我提出的解决方案与您希望测试的元素数量线性增长，后者是二次方，即使您引入常数因素以期提高效率。
它也优于使用组的解决方案，因为您最终不必使用长度。
你也可以用逐点的方式写出来，但我不会厌烦你这么琐碎的细节。