CODEWITHSUNDEEP
haskellrecursion-schemes
nponeccop
nponeccop

Reputation: 13677

Corecursive fibonacci using recursion schemes

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)

Upvotes: 3

Views: 515

Answers (2)

nponeccop
nponeccop

Reputation: 13677

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)

Upvotes: 1

Benjamin Hodgson
Benjamin Hodgson

Reputation: 44603

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)

Upvotes: 1

Related Questions