Haskell能否实现类似Racket的多列表fold-left函数？

你想要在Haskell中实现类似Racket里处理多列表的fold-left函数，以下是你给出的Racket示例代码：

#lang racket
(define (fold-left f i as . bss)
  (if (or (null? as)
          (ormap null? bss))
      i
      (apply fold-left
             f
             (apply f i (car as) (map car bss))
             (cdr as)
             (map cdr bss))))
 
(fold-left + 0 (list 1 2 3 4) (list 5 6 7 8))
(fold-left + 0 (list 1 2 3) (list 2 3 4) (list 3 4 5) (list 4 5 6))
(fold-left (λ (i v n s) (string-append i (vector-ref v n) s))
           ""
           (list (vector "A cat" "A dog" "A mouse")
                 (vector "tuna" "steak" "cheese"))
           (list 0 2)
           (list " does not eat " "."))

上述代码的计算结果分别为36、42和"A cat does not eat cheese."，你暂时没找到实现方法，想知道是否有可行的技巧。

实现方案 #

Haskell是静态类型语言，不像Racket那样支持动态可变参数，但可以通过类型类或列表打包两种方式实现类似的多列表折叠逻辑。

1. 按列表数量定义专用函数 #

这种方式最直观，针对不同数量的列表编写对应版本的折叠函数，和Racket的调用风格完全一致：

-- 处理1个列表（与标准foldl等价）
multiFoldl1 :: (a -> b -> a) -> a -> [b] -> a
multiFoldl1 _ acc [] = acc
multiFoldl1 f acc (x:xs) = multiFoldl1 f (f acc x) xs

-- 处理2个列表
multiFoldl2 :: (a -> b -> c -> a) -> a -> [b] -> [c] -> a
multiFoldl2 _ acc [] _ = acc
multiFoldl2 _ acc _ [] = acc
multiFoldl2 f acc (x:xs) (y:ys) = multiFoldl2 f (f acc x y) xs ys

-- 处理3个列表
multiFoldl3 :: (a -> b -> c -> d -> a) -> a -> [b] -> [c] -> [d] -> a
multiFoldl3 _ acc [] _ _ = acc
multiFoldl3 _ acc _ [] _ = acc
multiFoldl3 _ acc _ _ [] = acc
multiFoldl3 f acc (x:xs) (y:ys) (z:zs) = multiFoldl3 f (f acc x y z) xs ys zs

-- 处理4个列表
multiFoldl4 :: (a -> b -> c -> d -> e -> a) -> a -> [b] -> [c] -> [d] -> [e] -> a
multiFoldl4 _ acc [] _ _ _ = acc
multiFoldl4 _ acc _ [] _ _ = acc
multiFoldl4 _ acc _ _ [] _ = acc
multiFoldl4 _ acc _ _ _ [] = acc
multiFoldl4 f acc (x:xs) (y:ys) (z:zs) (w:ws) = multiFoldl4 f (f acc x y z w) xs ys zs ws

测试示例

对应你给出的三个测试用例：

-- 结果：36
test1 = multiFoldl2 (+) 0 [1,2,3,4] [5,6,7,8]

-- 结果：42
test2 = multiFoldl4 (\acc a b c d -> acc + a + b + c + d) 0 [1,2,3] [2,3,4] [3,4,5] [4,5,6]

-- 结果："A cat does not eat cheese."
test3 = multiFoldl3 (\acc v n s -> acc ++ (v !! n) ++ s) "" 
          [["A cat", "A dog", "A mouse"], ["tuna", "steak", "cheese"]] 
          [0,2] 
          [" does not eat ", "."]

2. 通用列表打包实现 #

这种方式更贴近Racket的底层逻辑，将所有输入列表打包成一个列表的列表，每次迭代取各子列表的首元素传给折叠函数：

multiFoldl :: (a -> [b] -> a) -> a -> [[b]] -> a
multiFoldl _ acc [] = acc
multiFoldl f acc lists
  | any null lists = acc
  | otherwise = multiFoldl f (f acc (map head lists)) (map tail lists)

测试示例

调用时需要把所有列表放进一个大列表：

-- 结果：36
test1' = multiFoldl (\acc [x,y] -> acc + x + y) 0 [[1,2,3,4], [5,6,7,8]]

-- 结果：42
test2' = multiFoldl (\acc vals -> acc + sum vals) 0 [[1,2,3], [2,3,4], [3,4,5], [4,5,6]]

-- 结果："A cat does not eat cheese."
test3' = multiFoldl (\acc [v,n,s] -> acc ++ (v !! n) ++ s) "" 
           [[["A cat", "A dog", "A mouse"], ["tuna", "steak", "cheese"]], [0,2], [" does not eat ", "."]]

3. 类型类实现（自动支持多参数） #

通过类型类可以避免手动编写不同数量的列表函数，利用Haskell的类型推导自动适配参数数量：

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}

class FoldMany input acc | input -> acc where
  foldMany :: (acc -> input) -> acc -> [input] -> acc

-- 基础实例：单个元素
instance FoldMany x x where
  foldMany f acc [x] = f acc x

-- 递归实例：扩展参数数量
instance FoldMany (x, y) acc => FoldMany x (y -> acc) where
  foldMany f acc xs = \y -> foldMany (\acc' (x, y') -> f acc' x y') acc (zip xs [y])

这种方式的调用风格略有不同，需要柯里化传入列表参数：

-- 结果：36
test1'' = foldMany (\acc x y -> acc + x + y) 0 [1,2,3,4] [5,6,7,8]

内容的提问来源于stack exchange，提问作者otstalyi