Несколько сгибов за один проход с использованием общей функции кортежа

Как я могу написать функцию, которая берет кортеж функций типа 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 в порядке.

ОТВЕТЫ

Ответ 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 является просто специализацией foldMap из Data.Foldable, поэтому на самом деле нам не нужно его определять, мы можем просто импортировать его более общую версию:

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

Если вы fold с Endo, это то же самое, что и сгибание справа. Чтобы свернуть слева, вы хотите сбросить с помощью моноида 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)

И это, я утверждаю, является 2-кортежной версией вашего f или, по крайней мере, изоморфной ей. Вы можете реорганизовать свои функции сгиба в форму a -> Endo ri, а затем выполните:

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

Также стоит посмотреть: Композитные потоковые складки, что является дальнейшей разработкой этих идей.

Ответ 2

Для прямого подхода вы можете просто явно определить эквиваленты Control.Arrow (***) и (&&&) для каждого N (например, N == 4):

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
Прелюдия > 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)

У нас даже есть типы, которые вам нужны, для функций кортежа.

Более строгая версия prod4 должна была использоваться для форсирования аргументов в начале foldl4'.