Corecursive fibonacci using recursion schemes

Question

There is an elegant derinition of list of fibonacci numbers:

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

Can it be translated to use recursion-schemes library?

The closest I could get is the following code that uses completely different approach:

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

I can provide the rest of the code if necessary, but essentially I get the Nth fibonacci number by using a histomorphism of Nat = Fix Maybe. Maybe (Cofree Maybe a) turns out to be isomorphic to [a], so refix can be thought just as a sort of toList to make the pattern shorter.

Upd:

I found shorter code but it only stores one value and in a non-generic way:

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

A non-generic way to store full history:

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

score 1 · Answer 1 · answered Mar 10 '17 at 19:51

1

Sure. Your fibs is readily translated into an unfoldr, which is just a slightly different way to spell ana.

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

answered Mar 10 '17 at 19:51

Benjamin Hodgson

42,952
15
108
157

I already figured that myself :) Is there sort of histomorphic anamorphism that provides me with all past values and not just one? – nponeccop Mar 10 '17 at 19:53
8

Ah, but it's not that you have one *past* value. You have one *future* value, but it's easy to express that data structure (the one-value-into-the-future sliding window) because of the peculiar symmetry of numbers: every number has *one* successor. In general, every substructure has lots of possible superstructures. If you want a type of "values computed for stuff before x", that would be *dependent* on x. Twenty years ago, I lost months of my life to trying to generalise sliding-window fibonacci to course-of-values recursion, before I figured out that fibonacci is just a fluke. – pigworker Mar 10 '17 at 21:14

nponeccop · Answer 2 · 2017-03-11T06:15:48.870

Here is (sort of) what I wanted:

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

takes an "old history" as a seed,
produces one level and seeds just like in normal ana,
then the new seeds are appended to the "old history", so the newHistory becomes newSeed :< oldHistory

unlift produces current level from seed and history.

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))

Stream version can also be implemented (Identity and (,) a functors respectively should be used). The binary tree case works too, but it's not clear if it's of any use. Here is a degenerated case I wrote blindly just to satisfy the type checker:

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

It's not clear if we lose anything by replacing Cofree with lists:

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

In this case 'history' becomes just the path to the tree root filled by seeds.

The list version turns out to be easily simplified by using different functor so seeding and filling the level can be accomplished in one place:

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)

The original code with Cofree can be simplified too:

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)

Corecursive fibonacci using recursion schemes

2 Answers2