Корекурсивные фибоначчи с использованием рекурсивных схем

Question

Существует элегантное определение списка чисел Фибоначчи:

fibs :: [Integer]
fibs = fib 1 1 where
  fib a b = a : fib b (a + b)

Можно ли перевести на использование? recursion-schemes библиотека?

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

fibN' :: Nat -> Integer
fibN' = histo $ \case
  (refix -> x:y:_) -> x + y
  _ -> 1

Я могу предоставить остальную часть кода, если необходимо, но, по сути, я получаю N-е число Фибоначчи, используя гистоморфизм Nat = Fix Maybe. Maybe (Cofree Maybe a) оказывается изоморфным [a], так refix можно думать как своего рода toList сделать шаблон короче.

Upd:

Я нашел более короткий код, но он хранит только одно значение и не универсальным образом:

fib' :: (Integer, Integer) -> [Integer]
fib' = ana $ \(x, y) -> Cons x (y, x+y)

Неуниверсальный способ хранения полной истории:

fib'' :: [Integer] -> [Integer]
fib'' = ana $ \l@(x:y:_) -> Cons x (x + y : l)

Answer 1

Конечно. Ваш fibs легко переводится на unfoldr Это немного другой способ написания ana,

fibs = unfoldr (\(a, b) -> Just (a, (b, a + b))) (1,1)

Answer 2

Вот (вроде) то, что я хотел:

type L f a = f (Cofree f a)

histAna
  :: (Functor f, Corecursive t) =>
     (f (Cofree g a) -> Base t (L g a))
     -> (L g a -> f a)
     -> L g a -> t
histAna unlift psi = ana (unlift . lift) where
    lift oldHist = (:< oldHist) <$> psi oldHist

psi

• берет "старую историю" в качестве семени,
• производит один уровень и семена, как в обычном ana,
• затем новые семена добавляются к "старой истории", поэтому newHistory становится newSeed :< oldHistory

unlift производит текущий уровень из семян и истории.

fibsListAna :: Num a => L Maybe a -> [a]
fibsListAna = histAna unlift psi where
    psi (Just (x :< Just (y :< _))) = Just $ x + y
    unlift x = case x of
        Nothing -> Nil
        h@(Just (v :< _)) -> Cons v h

r1 :: [Integer]
r1 = take 10 $ toList $ fibsListAna $ Just (0 :< Just (1 :< Nothing))

Потоковая версия также может быть реализована (Identity а также (,) a соответственно следует использовать функторы). Случай с бинарным деревом тоже работает, но неясно, полезен ли он. Вот вырожденный случай, который я написал вслепую только для того, чтобы удовлетворить проверку типов:

fibsTreeAna :: Num a => L Fork a -> Tree a
fibsTreeAna = histAna unlift psi where
    psi (Fork (a :< _) (b :< _)) = Fork a b
    unlift x = case x of
        h@(Fork (a :< _) (b :< _)) -> NodeF (a + b) h h

Пока не ясно, потеряем ли мы что-нибудь, заменив Cofree со списками:

histAna
    :: (Functor f, Corecursive t) =>
       (f [a] -> Base t [a])
        -> ([a] -> f a)
        -> [a] -> t
  histAna unlift psi = ana (unlift . lift) where
      lift oldHist = (: oldHist) <$> psi oldHist

В этом случае "история" становится просто путем к корню дерева, заполненному семенами.

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

histAna psi = ana lift where
      lift oldHist = (: oldHist) <$> psi oldHist

fibsListAna :: Num a => [a]
fibsListAna = histAna psi [0,1] where
    psi (x : y : _) = Cons (x + y) (x + y)

Оригинальный код с Cofree тоже можно упростить:

histAna :: (Functor f, Corecursive t) => (L f a -> Base t (f a)) -> L f a -> t
histAna psi = ana $ \oldHist -> fmap (:< oldHist) <$> psi oldHist

fibsListAna :: Num a => L Maybe a -> [a]
fibsListAna = histAna $ \case
    Just (x :< Just (y :< _)) -> Cons (x + y) (Just (x + y))

fibsStreamAna :: Num a => L Identity a -> Stream a
fibsStreamAna = histAna $ \case
    Identity (x :< Identity (y :< _)) -> (x + y, Identity $ x + y)

fibsTreeAna :: Num a => L Fork a -> Tree a
fibsTreeAna = histAna $ \case
    Fork (a :< _) (b :< _) -> NodeF (a + b) (Fork a a) (Fork b b)