一次使用通用元组函数实现多个折叠

Question

我该如何编写一个函数，该函数接受一个类型为ai -> b -> ai的函数元组，并返回一个函数，该函数接受一个类型为ai的元素元组、一个类型为b的元素，并将每个元素组合成新的ai元组：

因此，该函数的签名应该如下所示：

f :: (a1 -> b -> a1, a2 -> b -> a2, ... , an -> b -> an) -> 
     (a1, a2, ... , an) -> 
     b -> 
     (a1, a2, ... , an)

这样做的目的是：

f (min, max, (+), (*)) (1,2,3,4) 5 = (1, 5, 8, 20) 

这是为了让我能够写出以下内容：

这样做的目的是为了让我能够写出：

foldlMult' t = foldl' (f t)

然后做类似这样的事情：

foldlMult' (min, max, (+), (*)) (head x, head x, 0, 0) x 

一次性完成多重折叠。GHC扩展是可以的。

- Clinton

---

我认为可以使用Arrow的***和&&&来解决问题，在底层使用像(f，(g，(h，i)))这样的类型而不是(f，g，h，i)，但是我现在离我的笔记本电脑还有几百英里远，所以今天不能尝试了。 - AndrewC

Answer 1

如果我理解您的例子正确，类型应该是ai -> b -> ai，而不是您首先写的ai -> b -> a。让我们将类型重写为a -> ri -> ri，因为这有助于我的思考。

首先要观察的是这个对应关系：

(a -> r1 -> r1, ..., a -> rn -> rn) ~ a -> (r1 -> r1, ..., rn -> rn)

这使您能够编写这两个函数，它们是互为反函数的：

pullArg :: (a -> r1 -> r1, a -> r2 -> r2) -> a -> (r1 -> r1, r2 -> r2)
pullArg (f, g) = \a -> (f a, g a)

pushArg :: (a -> (r1 -> r1, r2 -> r2)) -> (a -> r1 -> r1, a -> r2 -> r2) 
pushArg f = (\a -> fst (f a), \a -> snd (f a))

第二个观察结果：形式为ri -> ri的类型有时被称为自同态，每种类型都有一个单子群，其组合为关联操作，恒等函数为标识符。 Data.Monoid软件包具有此包装器：

newtype Endo a = Endo { appEndo :: a -> a }

instance Monoid (Endo a) where
    mempty = id
    mappend = (.)

这可以让您将早期的pullArg重写为以下内容：

pullArg :: (a -> r1 -> r1, a -> r2 -> r2) -> a -> (Endo r1, Endo r2)
pullArg (f, g) = \a -> (Endo $ f a, Endo $ g a)

第三点观察：两个幺半群的乘积也是一个幺半群，这可以从Data.Monoid中的实例看出：

instance (Monoid a, Monoid b) => Monoid (a, b) where
    mempty = (mempty, mempty)
    (a, b) `mappend` (c, d) = (a `mappend` c, b `mappend d)

同样适用于任何数量参数的元组。

第四个观察点：折叠是由什么构成的？ 答案：折叠是由幺半群构成的！

import Data.Monoid

fold :: Monoid m => (a -> m) -> [a] -> m
fold f = mconcat . map f

这个fold只是来自于Data.Foldable的foldMap的一个特化版本，所以实际上我们不需要定义它，我们可以直接导入更加通用的版本：

foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m

如果你使用 Endo 进行fold，那么这等同于从右侧开始折叠。要从左侧开始折叠，您可以使用 Dual (Endo r) 单子进行折叠：

myfoldl :: (a -> Dual (Endo r)) -> r -> -> [a] -> r
myfoldl f z xs = appEndo (getDual (fold f xs)) z


-- From `Data.Monoid`.  This just flips the order of `mappend`.
newtype Dual m = Dual { getDual :: m }

instance Monoid m => Monoid (Dual m) where
    mempty = Dual mempty
    Dual a `mappend` Dual b = Dual $ b `mappend` a

还记得我们的 pullArg 函数吗？让我们再来复习一下，因为你是从左边折叠的：

pullArg :: (a -> r1 -> r1, a -> r2 -> r2) -> a -> Dual (Endo r1, Endo r2)
pullArg (f, g) = \a -> Dual (Endo $ f a, Endo $ g a)

我认为这是您的f的二元组版本，或者至少与之同构。您可以将折叠函数重构为a -> Endo ri形式，然后执行以下操作:

let (f'1, ..., f'n) = foldMap (pullArgn f1 ... fn) xs
in (f'1 z1, ..., f'n zn) 

值得一提的是：可组合的流式折叠，这是对这些思想的进一步阐述。

- Luis Casillas

Answer 2

如果采用直接的方法，您可以为每个 N（例如 N == 4）明确定义 Control.Arrow 的 ( ***) 和 (&&&) 等效项：

prod4 (f1,f2,f3,f4) (x1,x2,x3,x4) = (f1 x1,f2 x2,f3 x3,f4 x4)   -- cf (***)
call4 (f1,f2,f3,f4)  x            = (f1 x, f2 x, f3 x, f4 x )   -- cf (&&&)
uncurry4    f       (x1,x2,x3,x4) =  f  x1    x2    x3    x4

那么，

foldr4 :: (b -> a1 -> a1, b -> a2 -> a2, 
            b -> a3 -> a3, b -> a4 -> a4)
       -> (a1, a2, a3, a4) -> [b] 
       -> (a1, a2, a3, a4)                        -- (f .: g) x y = f (g x y)
foldr4 t z xs = foldr (prod4 . call4 t) z xs      -- foldr . (prod4 .: call4) 
              -- f x1 (f x2 (... (f xn z) ...))   -- foldr . (($)   .: ($))

因此，元组在foldr4中的函数是你所需的翻转版本。测试：

Prelude> g xs = foldr4 (min, max, (+), (*)) (head xs, head xs, 0, 1) xs
Prelude> g [1..5]
(1,5,15,120)

foldl4'只需要进行一些调整即可。因为

foldr f z xs == foldl (\k x r-> k (f x r)) id xs z
foldl f z xs == foldr (\x k a-> k (f a x)) id xs z

我们有

foldl4, foldl4' :: (t -> a -> t, t1 -> a -> t1,
                    t2 -> a -> t2, t3 -> a -> t3)
                -> (t, t1, t2, t3) -> [a] 
                -> (t, t1, t2, t3)
foldl4 t z xs = foldr (\x k a-> k (call4 (prod4 t a) x)) 
                      (prod4 (id,id,id,id)) xs z
foldl4' t z xs = foldr (\x k a-> k (call4 (prod4' t a) x)) 
                       (prod4 (id,id,id,id)) xs z
prod4' (f1,f2,f3,f4) (x1,x2,x3,x4) = (f1 $! x1,f2 $! x2,f3 $! x3,f4 $! x4)

我们已经按照你的要求为元组函数提供了所需的类型。

foldl4'需要使用prod4的严格版本来提前强制参数。

- Will Ness