いろいろあります
-- | Fibonacci numbers
fib :: Num a => [a]
fib = 0 : 1 : zipWith (+) fib (tail fib)
-- or
fib@(_:tl) = 0 : 1 : zipWith (+) fib tl
-- | fix - alert slow
import Data.Function (fix)
fib = fix (\f -> \n -> if n < 2 then n else f (n-1) + f (n-2))
fib :: (Applicative f, Num a, Eq a) => a -> f a
fib 0 = pure 0
fib 1 = pure 1
fib n = (+) <$> fib (n-1) <*> fib (n-2)
-- | Fast Fib
fib :: Integer -> Integer
fib = fst . rec (0,1)
where
rec pq@(p,q) n
| n==0 = (0,1)
| odd n = tpq pq $ rec pq (n-1)
| otherwise = rec (p^2+q^2,2*p*q+q^2) (n `div` 2)
tpq (p,q) (a,b) = (p*a+q*b,q*a+(p+q)* b)
-- or
fib 0 = (0,1)
fib n = if even n then (c,d) else (d,c+d)
where
(a,b) = fib (div n 2)
c = a*(b*2-a)
d = a*a+b*b
-- | Matrix Fib by SemiGroup
import qualified Data.Semigroup as Semigroup
data Matrix2x2 =
Matrix {x00 :: Integer, x01 :: Integer, x10 :: Integer, x11 :: Integer}
instance Monoid Matrix2x2 where
mempty = Matrix {x00 = 1, x01 = 0, x10 = 0, x11 = 1}
instance Semigroup Matrix2x2 where
Matrix l00 l01 l10 l11 <> Matrix r00 r01 r10 r11 = Matrix {
x00 = l00*r00 + l01*r10, x01 = l00*r01 + l01*r11,
x10 = l10*r00 + l11*r10, x11 = l10*r01 + l11*r11}
fib :: Integer -> Integer
fib n = x01 (Semigroup.mtimesDefault n matrix)
where
matrix = Matrix {x00 = 0, x01 = 1, x10 = 1, x11 = 1}
-- | memoize by list
import Data.Function (fix)
fib1 :: Int -> Integer
fib1 = fix (memoize . fib)
memoize :: (Num t, Enum t) => (t -> a) -> Int -> a
memoize f = (map f [0..] !!)
fib :: (Num t, Eq t, Num a) => (t -> a) -> t -> a
fib f 0 = 1
fib f 1 = 1
fib f n = f (n-1) + f (n-2)
-- | memoize by array
fib2 n = memo (0,n) fib n
where
fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)
memo bnds gen = (dp!)
where
dp = listArray bnds . fmap gen $ range bnds
-- | memoize by listArray
import Data.Array
memo = listArray bnds $ f <$> range bnds
f 0 = 1
f 1 = 1
f i = memo!(i-1) + memo!(i-2)
-- | memo by array in the definition
{-# LANGUAGE LambdaCase #-}
import Data.Array
tabulate :: Ix i => (i,i) -> (i -> a) -> Array i a
tabulate bnds f = listArray bnds (map f $ range bnds)
memo :: Ix i => (i,i) -> (i -> a) -> (i -> a)
memo bnds = (!) . tabulate bnds
fib = memo (0,1000) $ \case
0 -> 0
1 -> 1
n -> fib (n-1) + fib (n-2)
-- | locally defined fix (warning: slow)
import Data.Function
fibs = fix (scanl (+) 0 . (1:))
-- | representable functor as memoization and a natural isomorphism
-- Stream a ≃ Natural -> a -- non-std lib
import Data.Natural
import Data.Functor.Rep
class Functor f => Representable f where
type Key f :: Type
tabulate :: (Key f -> a) -> f a
index :: f a -> (Key f -> a)
memoize :: forall f a. Representable f => ((Key f -> a) -> (Key f -> a)) -> (Key f -> a)
memoize g = fix (index @f . tabulate . g)
fibs :: Num a => Natural -> a
fibs = memoize @((->) Natural) fib
-- | representable functor as memoization and and a natural isomorphism
-- Tree a ≃ Natural -> a
data Tree a = Node a (Tree a) (Tree a)
deriving Functor
fibs :: Num a => Natural -> a
fibs = memoize @Tree fib
instance Representable Tree where
type Key Tree = Natural
tabulate f = fmap f nats where
nats = Node 0 (fmap ((+1) . (2*)) nats) (fmap ((+2) . (2*)) nats)
index (Node a _ _) 0 = a
index (Node _ l r) n = if odd n
then index l (div n 2)
else index r (div n 2 - 1)
-- | fibs by mfix
import Control.Monad.State.Strict
fibs = fst . flip runState [] . mfix
$ \a -> scanl (+) 0 . (1:) <$> (put a >> return a)
-- | MonadMemo -- non-std lib
import Control.Monad.Memo
fib :: MonadMemo Int Integer m => Int -> m Integer
fib 0 = return 1
fib 1 = return 1
fib n = (+) <$> memo fib (n-1) <*> memo fib (n-2)
evalFib :: Integer -> Integer
evalFib = startEvalMemo . fib
fib :: (Monad m) => (Int -> m Integer) -> (Int -> m Integer)
fib _ 0 = return 0
fib _ 1 = return 1
fib f n = (+) <$> f (n-1) <*> f (n-2)
memoize :: (MonadState (IntMap v) m) => (Int -> m v) -> Int -> m v
memoize f x = do
v <- gets (lookup x)
case v of
Just y -> return y
_ -> do
y <- f x
modify $ insert x y
return y
memoFib :: Int -> Integer
memoFib n = evalState (fix (memoize . fib) n) empty
-- MemoCombinators
import qualified Data.MemoCombinators as Memo
fib = Memo.integral fib'
where
fib' 0 = 0
fib' 1 = 1
fib' x = fib (x-1) + fib (x-2)