使用递归方案的共同递归fibonacci

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

如果需要，我可以提供代码的其余部分，但本质上，我通过使用Nat = Fix的组织形态获得第N个斐波那契数。事实证明，Maybe (Cofree Maybe a)与[a]同构，因此可以将refix看作是一种缩短模式的toList。

更新：

我发现了更短的代码，但它只存储一个值，而且是以一种非泛型的方式：

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)