[Haskell-cafe] a sort of chunk

Viktor Dukhovni ietf-dane at dukhovni.org
Fri Jan 17 22:41:12 UTC 2020


On Fri, Jan 17, 2020 at 03:57:18PM +0000, PICCA Frederic-Emmanuel wrote:

> chunkLen :: Chunk -> Int
> chunkLen (Chunk _ f t) = t - f
> 
> chunks :: Int -> [Chunk] -> [[Chunk]]
> chunks n cs = reverse $ map reverse $ go cs [[]] 0
>   where
>     go :: [Chunk] -> [[Chunk]] -> Int -> [[Chunk]]
>     go [] _ _ = []
>     go [x@(Chunk fn f t)] (c:cs') acc =
>       if acc + chunkLen x < n
>       then (x : c) : cs'
>       else go [(Chunk fn (f + n - acc) t)] ([] : ((Chunk fn f (f + n - acc)) : c) : cs') 0
>     go (x@(Chunk fn f t):xs) (c:cs') acc =
>         if acc + chunkLen x < n
>         then go xs ((x : c) : cs') (acc + chunkLen x)
>         else go ((Chunk fn (f + n - acc) t) : xs) ([] : ((Chunk fn f (f + n - acc)) : c) : cs') 0

To your specific question I would refactor this a bit:

    -- | Split a list after the first element that reaches a target cumulative weight
    --
    splitWeight :: Int -> (a -> Int) -> [a] -> ([a], [a])
    splitWeight target weight xs =
        (,) <$> reverse . fst <*> snd $ go 0 xs []
      where 
        go _ [] acc = (acc, [])
        go n (h:ts) acc
            | let w = n + weight h
            , w < target    = go w ts $ h : acc
            | otherwise     = (h : acc, ts)

    -- | Partition a list into chunks, with each non-final chunk having
    -- a weight at least equal to the target.
    --
    chunks :: Int -> (a -> Int) -> [a] -> [[a]]
    chunks target weight = unfoldr gen
        gen [] = Nothing
        gen xs = Just $ splitWeight target weight xs

  Example:
    λ> chunks 42 id [1..25]
    [[1,2,3,4,5,6,7,8,9],[10,11,12,13],[14,15,16],[17,18,19],[20,21,22],[23,24],[25]]

  Your weight function would be:

>   chunkLen :: Chunk -> Int
>   chunkLen (Chunk _ f t) = t - f

That said, it feels like perhaps you're asking the wrong question.  If
you want parallelize monadic list reduction over multiple cores, perhaps
something out of https://hackage.haskell.org/package/monad-par would
meet your needs?

You might find

    https://www.oreilly.com/library/view/parallel-and-concurrent/9781449335939/

a good resource.

-- 
    Viktor.


More information about the Haskell-Cafe mailing list