Search code examples
haskellrecursionlazy-evaluationfoldfoldleft

The problem of foldl (with multi level foldl) in haskell


The foldr version was fast than the foldl version:

the foldr version:

cartProdN9 :: [[a]] -> [[a]]
cartProdN9 xss = 
 foldr h1 [[]] xss where 
  h1 xs yss = foldr g [] xs where
     g x zss = foldr f zss yss where 
         f xs yss = (x:xs):yss 

The foldl version

cartProdN11 :: [[a]] -> [[a]]
cartProdN11 xss = 
 foldl h1 [[]] xss where 
  h1 yss xs = foldl g [] xs where
     g zss x = foldl f zss yss where 
         f yss xs = (x:xs):yss 

The process cartProdN9 [[1,2]| i <- [1 .. 1000]] is ok . But cartProdN11 [[1,2]| i <- [1 .. 1000]] not ok.

The strict version fold' is still no ok:

foldl' f z []     = z
foldl' f z (x:xs) = let z' = z `f` x 
                       in  z' `seq` foldl' f z' xs

Even using the tech in https://www.fpcomplete.com/haskell/tutorial/all-about-strictness/

{-# LANGUAGE BangPatterns #-}

module D where   
data StrictList a = Cons !a !(StrictList a) | Nil

strictMap :: (a -> b) -> StrictList a -> StrictList b
strictMap _ Nil = Nil
strictMap f (Cons a list) =
  let !b = f a
      !list' = strictMap f list
   in b `seq` list' `seq` Cons b list'

strictEnum :: Int -> Int -> StrictList Int
strictEnum low high =
  go low
  where
    go !x
      | x == high = Cons x Nil
      | otherwise = Cons x (go $! x + 1)

list  :: Int -> StrictList Int
list !x = Cons x (Cons x Nil)

foldlS = \f z l ->
  case l of
    Nil -> z
    Cons !x !xs -> let !z' = z `f` x
                       in  z' `seq` foldlS f z' xs  

listlist :: StrictList (StrictList Int)
listlist = strictMap list $! strictEnum 1 10

cartProdN12 :: StrictList (StrictList a) -> StrictList (StrictList a)
cartProdN12 xss =
 foldlS h1 (Cons Nil Nil) xss where
  h1 !yss !xs = foldlS g Nil xs where
     g !zss !x = foldlS f zss yss where
       f !yss !xs = Cons (Cons x xs ) yss

myhead  :: StrictList a ->  a
myhead =  \l ->
  case l of
    Cons x xs -> x
         
r = cartProdN12 listlist
hr :: Int
hr =  myhead( myhead r)

the listlist = strictMap list $! strictEnum 1 100 still too slow to compute.

So my problem: how to make foldl version compute as faster as the foldr version? It is possible?


Solution

  • The process cartProdN9 [[1,2]| i <- [1 .. 1000]] is ok .

    I sincerely doubt that, because the resulting list will have 2^1000 elements, so you're probably not benchmarking correctly.

    Here's a little benchmark I threw together that shows that the simple strict version is actually faster:

    module Main where
    
    import Test.Tasty.Bench
    
    cartProdN9 :: [[a]] -> [[a]]
    cartProdN9 xss = 
     foldr h1 [[]] xss where 
      h1 xs yss = foldr g [] xs where
         g x zss = foldr f zss yss where 
             f xs yss = (x:xs):yss 
    
    cartProdN11 :: [[a]] -> [[a]]
    cartProdN11 xss = 
     foldl h1 [[]] xss where 
      h1 yss xs = foldl g [] xs where
         g zss x = foldl f zss yss where 
             f yss xs = (x:xs):yss 
    
    mkBench :: ([[Int]] -> [[Int]]) -> Int -> Benchmark
    mkBench f n = bench (show n) $ nf f (replicate n [1, 2])
    
    main :: IO ()
    main = defaultMain
      [ bgroup "cartProdN9"  $ map (mkBench cartProdN9) [10,15,20]
      , bgroup "cartProdN11" $ map (mkBench cartProdN11) [10,15,20]
      ]
    

    Results:

    All
      cartProdN9
        10: OK (0.16s)
          36.7 μs ± 3.0 μs
        15: OK (0.29s)
          4.48 ms ± 273 μs
        20: OK (5.75s)
          378  ms ±  28 ms
      cartProdN11
        10: OK (0.28s)
          33.1 μs ± 2.2 μs
        15: OK (0.98s)
          3.76 ms ± 292 μs
        20: OK (5.22s)
          337  ms ±  12 ms
    

    The nf in the mkBench function is very important, if you use whnf then you get very different results:

    All
      cartProdN9
        10: OK (0.14s)
          122  ns ±  11 ns
        15: OK (0.19s)
          189  ns ±  11 ns
        20: OK (0.27s)
          257  ns ±  11 ns
      cartProdN11
        10: OK (0.18s)
          10.7 μs ± 683 ns
        15: OK (0.30s)
          2.41 ms ± 150 μs
        20: OK (0.56s)
          188  ms ± 4.2 ms