3

斐波那契数列有一个优雅的定义：

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 Maybe 的组织同态得到第 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)
4

2 回答 2

1

当然。你fibs很容易被翻译成一个unfoldr，这只是一种稍微不同的拼写方式ana。

fibs = unfoldr (\(a, b) -> Just (a, (b, a + b))) (1,1)
于 2017-03-10T19:51:06.423 回答
1

这是（某种）我想要的：

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)
于 2017-03-11T04:09:18.830 回答