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

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?

CodePudding user response：

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