Haskell groupBy取决于累加器值

Question

我有一个视图对列表，它表示内容标签的列表及其宽度，我想将其分组成行(如果下一个内容标签不适合行，则将其放入另一行)。所以我们有：viewList = [(View1, 45), (View2, 223.5), (View3, 14) (View4, 42)]。

我想编写一个函数groupViews :: [a] -> [[a]]，将该列表分组为子列表列表，其中每个子列表将只包含宽度总和小于指定最大宽度的视图(比如250)。因此，对于已排序的viewList，此函数将返回：[[(View3, 14), (View4, 42), (View1, 45)],[(View2, 223.5)]]

它看起来类似于groupBy。然而，groupBy不维护累加器。我尝试使用scanl+takeWhile(<250)组合，但在这种情况下，我只能收到第一个有效的子列表。也许以某种方式使用iterate+scanl+takeWhile？但这看起来很麻烦，根本不起作用。任何帮助都将不胜感激。

Answer 1

我将从这样的递归定义开始：

groupViews :: Double -> (a -> Double) -> [a] -> [[a]]
groupViews maxWidth width = go (0, [[]])
where
go (current, acc : accs) (view : views)
| current + width view <= maxWidth
= go (current + width view, (view : acc) : accs) views
| otherwise = go (width view, [view] : acc : accs) views
go (_, accs) []
= reverse $ map reverse accs

像groupViews 250 snd (sortOn snd viewList)一样调用。我注意到的第一件事是，它可以表示为左折叠：

groupViews' maxWidth width
= reverse . map reverse . snd . foldl' go (0, [[]])
where
go (current, acc : accs) view
| current + width view <= maxWidth
= (current + width view, (view : acc) : accs)
| otherwise
= (width view, [view] : acc : accs)

我认为这很好，但如果你愿意，你可以进一步考虑，一次扫描以最大宽度为模来累积宽度，另一次扫描将元素分组为升序。例如，这里有一个适用于整数宽度的版本：

groupViews'' maxWidth width views
= map fst
$ groupBy ((<) `on` snd)
$ zip views
$ drop 1
$ scanl ( current view -> (current + width view) `mod` maxWidth) 0 views

当然，您可以在这些定义中包含排序，而不是从外部传递排序列表。

Answer 2

我不知道如何通过组合标准库中的函数来实现这一点，但我确实认为您可以做得比从头开始实现它更好。

这个问题属于我以前见过的一类问题："以某种方式从这个列表中批量处理项目，并根据一些组合规则和一些决定批次过大的规则将其项目组合成批次"。几年前，当我写Clojure时，我构建了一个函数，它抽象出了批处理组合的概念，只要求您指定批处理的规则，并且能够在数量惊人的地方使用它。

以下是我认为它可能在Haskell:中被重新构想的方式

glue :: Monoid a => (a -> Bool) -> [a] -> [a]
glue tooBig = go mempty
where go current [] = [current]
go current (x:xs) | tooBig x' = current : go x xs
| otherwise = go x' xs
where x' = current `mappend` x

如果您已经有了这样的glue函数，那么您可以使用适当的Monoid实例(对象及其累积和的列表)构建一个简单的数据类型，然后让glue来完成繁重的工作：

import Data.Monoid (Sum(..))
data ViewGroup contents size = ViewGroup {totalSize :: size,
elements :: [(contents, size)]}
instance Monoid b => Monoid (ViewGroup a b) where
mempty = ViewGroup mempty []
mappend (ViewGroup lSize lElts) (ViewGroup rSize rElts) = 
ViewGroup (lSize `mappend` rSize) 
(lElts ++ rElts)
viewGroups = let views = [("a", 14), ("b", 42), ("c", 45), ("d", 223.5)]
in glue ((> 250) . totalSize) [ViewGroup (Sum width) [(x, Sum width)] 
| (x, width) <- views]
main = print (viewGroups :: [ViewGroup String (Sum Double)])
[ViewGroup {totalSize = Sum {getSum = 101.0}, 
elements = [("a",Sum {getSum = 14.0}),
("b",Sum {getSum = 42.0}),
("c",Sum {getSum = 45.0})]},
ViewGroup {totalSize = Sum {getSum = 223.5}, 
elements = [("d",Sum {getSum = 223.5})]}]

一方面，对于一个简单的函数来说，这看起来需要做很多工作，但另一方面，有一个描述您正在进行的累积求和的类型是很好的，而且Monoid实例无论如何都很好。。。在定义了类型和Monoid实例之后，调用CCD_ 17本身几乎没有什么工作要做了。

嗯，我不知道，也许这仍然是太多的工作，特别是如果你不相信你可以重用那种类型。但我确实认为，认识到这是一个更普遍问题的具体案例，并尝试解决更普遍的问题是有用的。

Answer 3

假设groupBy和span本身是由手动递归函数定义的，我们修改后的函数将使用相同的机制。

让我们首先定义一个通用函数groupAcc，它取累加器的初始值，然后定义一个函数，它取列表中的一个元素，即当前累加器状态，并可能产生一个新的累加值(Nothing表示该元素不被接受)：

{-# LANGUAGE LambdaCase #-}
import Data.List (sortOn)
import Control.Arrow (first, second)
spanAcc :: z -> (a -> z -> Maybe z) -> [a] -> ((z, [a]), [a])
spanAcc z0 p = case
xs@[]      -> ((z0, xs), xs)
xs@(x:xs') -> case p x z0 of
Nothing  -> ((z0, []), xs)
Just z1  -> first ((z2, xt) -> (if null xt then z1 else z2, x : xt)) $
spanAcc z1 p xs'
groupAcc :: z -> (a -> z -> Maybe z) -> [a] -> [(z, [a])]
groupAcc z p = case
[] -> [] ;
xs -> uncurry (:) $ second (groupAcc z p) $ spanAcc z p xs

对于我们的具体问题，我们定义：

threshold :: (Num a, Ord a) => a -> a -> a -> Maybe a
threshold max a z0 = let z1 = a + z0 in if z1 < max then Just z1 else Nothing
groupViews :: (Ord z, Num z) => [(lab, z)] -> [[(lab, z)]]
groupViews = fmap snd . groupAcc 0 (threshold 250 . snd)

这最终给了我们：

groupFinal :: (Num a, Ord a) => [(lab, a)] -> [[(lab, a)]]
groupFinal = groupViews . sortOn snd

ghci给了我们：

> groupFinal [("a", 45), ("b", 223.5), ("c", 14), ("d", 42)]
[[("c",14.0),("d",42.0),("a",45.0)],[("b",223.5)]]

如果我们愿意，我们可以通过假设z是Monoid来简化groupAcc，因此可以使用mempty，使得：

groupAcc2 :: Monoid z => (a -> z -> Maybe z) -> [a] -> [(z, [a])]
groupAcc2 p = case
[] -> [] ;
xs -> let z = mempty in
uncurry (:) $ second (groupAcc z p) $ spanAcc z p xs