haskell中foldl(多级foldl)的问题

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

foldr 版本比 foldl 版本快:

文件夹版本:

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 

进程cartProdN9 [[1,2]| i <- [1 .. 1000]]正常。但是cartProdN11 [[1,2]| i <- [1 .. 1000]]不行。

严格版fold'还是不行:

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

甚至使用 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)

listlist = strictMap list $! strictEnum 1 100 仍然太慢无法计算。

所以我的问题是:如何使 foldl 版本的计算速度与 foldr 版本一样快?有可能吗?

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

我真的很怀疑,因为生成的列表将包含 2^1000 个元素,所以您可能没有正确进行基准测试。

这是我整理的一个小基准,表明简单严格版本实际上更快:

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]
  ]

结果:

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

mkBench函数中的nf很重要,如果你使用whnf那么你会得到非常不同的结果:

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