Катаморфизм, позволяющий взглянуть на часть окончательного результата - PullRequest
Новая
       136

Катаморфизм, позволяющий взглянуть на часть окончательного результата

6 голосов
/ 14 мая 2019

Существует ли название для схемы рекурсии, которая похожа на катаморфизм, но которая позволяет заглянуть в конечный результат, пока он еще работает? Вот слегка надуманный пример: 

toPercents :: Floating a => [a] -> [a]
toPercents xs = result
  where
  (total, result) = foldr go (0, []) xs
  go x ~(t, r) = (x + t, 100*x/total:r)

{-
>>> toPercents [1,2,3]
[16.666666666666668,33.333333333333336,50.0]
-}

В этом примере используется total на каждом шаге сгиба, хотя его значение неизвестно до конца. (Очевидно, это зависит от лени, чтобы работать.)

Ответы [ 3 ]

3 голосов
/ 14 мая 2019

Хотя это не обязательно то, что вы искали, мы можем закодировать уловку лени с помощью hylomorphism: 

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}

import Data.Functor.Foldable
import Data.Functor.Foldable.TH

data CappedList c a = Cap c | CCons a (CappedList c a)
    deriving (Eq, Show, Ord, Functor, Foldable, Traversable)
makeBaseFunctor ''CappedList

-- The seq here has no counterpart in the implementation in the question.
-- It improves performance quite noticeably. Other seqs might be added for
-- some of the other "s", as well as for the percentage; the returns, however,
-- are diminishing.
toPercents :: Floating a => [a] -> [a]
toPercents = snd . hylo percAlg sumCal . (0,)
    where
    sumCal = \case
        (s, []) -> CapF s
        (s, a : as) -> s `seq` CConsF a (s + a, as)
    percAlg = \case
        CapF s -> (s, [])
        CConsF a (s, as) -> (s, (a * 100 / s) : as)

Это соответствует уловке лени, потому что, благодаря hylo fusion, промежуточный CappedList фактически никогда не создается, и toPercents использует список ввода за один проход.Смысл использования CappedList заключается в том, что , как MoonGoose помещает его , помещая сумму в конец (виртуальной) промежуточной структуры, так что восстановление списка, выполняемое с помощью percAlg, может иметь к нему доступ.с самого начала.

(Возможно, стоит отметить, что, несмотря на то, что это делается за один проход, кажется, трудно получить хорошее и постоянное использование памяти из этого трюка, будь то с моей версией илис вашими. Предложения на этом фронте приветствуются.)

2 голосов
/ 15 мая 2019

Я не думаю, что есть явная схема, позволяющая функции 1 просматривать каждый шаг в конечном результате функции 2. Хотя это кажется странным.Я думаю, что в итоге все сводится к 1) запуску функции 2, затем к запуску функции 1 с известным результатом функции 2 (т. Е. Двух проходов, которые, я думаю, является единственным способом получить постоянную память в вашемпример) или 2) запускать их рядом, создавая функцию thunk (или полагаясь на лень), чтобы объединить их в конце.

Ленивая foldr версия, которую вы дали, конечно, естественным образом превращается в катаморфизм.Вот версия функционализированного катаморфизма: 

{-# LANGUAGE LambdaCase -#}

import Data.Functor.Foldable    

toPercents :: Floating a => [a] -> [a]
toPercents = uncurry ($) . cata alg
  where
    alg = \case
        Nil -> (const [], 0)
        Cons x (f,s) ->  (\t -> 100*x / t : f t, s + x)

Стилистически нехорошо иметь возможность вручную распараллеливать два катаморфизма, тем более что тогда он не кодирует тот факт, что ни поэтапно, ни полагается наДругой.Hoogle находит bicotraverse , но он излишне общий, поэтому давайте напишем наш оператор распараллеливания алгебры (&&&&), 

import Control.Arrow

(&&&&) :: Functor f => (f a -> c) -> (f b -> d) -> f (a,b) -> (c,d)
f1 &&&& f2 = (f1 . fmap fst &&& f2 . fmap snd)

toPercents' :: Floating a => [a] -> [a]
toPercents' = uncurry ($) . cata (algList &&&& algSum)

algSum :: (Num a) => ListF a a -> a
algSum = \case
    Nil -> fromInteger 0
    Cons x !s -> s + x

algList :: (Fractional a) => ListF a (a -> [a]) -> (a -> [a])   
algList = \case
    Nil -> const []
    Cons x s -> (\t -> 100*x / t : s t)
0 голосов
/ 14 мая 2019

Просто безумный эксперимент.Я думаю, что мы можем объединить что-то.

Также fix = hylo (\(Cons f a) -> f a) (join Cons), и мы можем заменить на fix

toPercents :: Floating a => [a] -> [a]
toPercents xs = result
  where
    (_, result) = hylo (\(Cons f a) -> f a) (join Cons) $ \(~(total, _)) -> 
      let
        alg Nil = (0, [])
        alg (Cons x (a, as)) = (x + a, 100 * x / total: as)
      in
        cata alg xs
...