{-# LANGUAGE BangPatterns #-}
module Math.NumberTheory.Recurrences.Linear
( factorial
, factorialFactors
, fibonacci
, fibonacciPair
, lucas
, lucasPair
, generalLucas
) where
import Data.Bits
import Numeric.Natural
import Math.NumberTheory.Primes
factorial :: (Num a, Enum a) => [a]
factorial :: forall a. (Num a, Enum a) => [a]
factorial = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(*) a
1 [a
1..]
{-# SPECIALIZE factorial :: [Int] #-}
{-# SPECIALIZE factorial :: [Word] #-}
{-# SPECIALIZE factorial :: [Integer] #-}
{-# SPECIALIZE factorial :: [Natural] #-}
factorialFactors :: Word -> [(Prime Word, Word)]
factorialFactors :: Word -> [(Prime Word, Word)]
factorialFactors Word
n
| Word
n forall a. Ord a => a -> a -> Bool
< Word
2
= []
| Bool
otherwise
= forall a b. (a -> b) -> [a] -> [b]
map (\Prime Word
p -> (Prime Word
p, Word -> Word
mult (forall a. Prime a -> a
unPrime Prime Word
p))) [forall a. Bounded a => a
minBound .. forall a.
(Bits a, Integral a, UniqueFactorisation a) =>
a -> Prime a
precPrime Word
n]
where
mult :: Word -> Word
mult :: Word -> Word
mult Word
p = Word -> Word -> Word
go Word
np Word
np
where
np :: Word
np = Word
n forall a. Integral a => a -> a -> a
`quot` Word
p
go :: Word -> Word -> Word
go !Word
acc !Word
x
| Word
x forall a. Ord a => a -> a -> Bool
>= Word
p = let xp :: Word
xp = Word
x forall a. Integral a => a -> a -> a
`quot` Word
p in Word -> Word -> Word
go (Word
acc forall a. Num a => a -> a -> a
+ Word
xp) Word
xp
| Bool
otherwise = Word
acc
fibonacci :: Num a => Int -> a
fibonacci :: forall a. Num a => Int -> a
fibonacci = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Int -> (a, a)
fibonacciPair
{-# SPECIALIZE fibonacci :: Int -> Int #-}
{-# SPECIALIZE fibonacci :: Int -> Word #-}
{-# SPECIALIZE fibonacci :: Int -> Integer #-}
{-# SPECIALIZE fibonacci :: Int -> Natural #-}
fibonacciPair :: Num a => Int -> (a, a)
fibonacciPair :: forall a. Num a => Int -> (a, a)
fibonacciPair Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = let (a
f,a
g) = forall a. Num a => Int -> (a, a)
fibonacciPair (-(Int
nforall a. Num a => a -> a -> a
+Int
1)) in if forall a. Bits a => a -> Int -> Bool
testBit Int
n Int
0 then (a
g, -a
f) else (-a
g, a
f)
| Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = (a
0, a
1)
| Bool
otherwise = forall a. Num a => Int -> (a, a)
look (forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) forall a. Num a => a -> a -> a
- Int
2)
where
look :: Int -> (t, t)
look Int
k
| forall a. Bits a => a -> Int -> Bool
testBit Int
n Int
k = forall {t}. Num t => Int -> t -> t -> (t, t)
go (Int
kforall a. Num a => a -> a -> a
-Int
1) t
0 t
1
| Bool
otherwise = Int -> (t, t)
look (Int
kforall a. Num a => a -> a -> a
-Int
1)
go :: Int -> t -> t -> (t, t)
go Int
k t
g t
f
| Int
k forall a. Ord a => a -> a -> Bool
< Int
0 = (t
f, t
fforall a. Num a => a -> a -> a
+t
g)
| forall a. Bits a => a -> Int -> Bool
testBit Int
n Int
k = Int -> t -> t -> (t, t)
go (Int
kforall a. Num a => a -> a -> a
-Int
1) (t
fforall a. Num a => a -> a -> a
*(t
fforall a. Num a => a -> a -> a
+forall a. Num a => a -> a
shiftL1 t
g)) ((t
fforall a. Num a => a -> a -> a
+t
g)forall a. Num a => a -> a -> a
*forall a. Num a => a -> a
shiftL1 t
f forall a. Num a => a -> a -> a
+ t
gforall a. Num a => a -> a -> a
*t
g)
| Bool
otherwise = Int -> t -> t -> (t, t)
go (Int
kforall a. Num a => a -> a -> a
-Int
1) (t
fforall a. Num a => a -> a -> a
*t
fforall a. Num a => a -> a -> a
+t
gforall a. Num a => a -> a -> a
*t
g) (t
fforall a. Num a => a -> a -> a
*(t
fforall a. Num a => a -> a -> a
+forall a. Num a => a -> a
shiftL1 t
g))
{-# SPECIALIZE fibonacciPair :: Int -> (Int, Int) #-}
{-# SPECIALIZE fibonacciPair :: Int -> (Word, Word) #-}
{-# SPECIALIZE fibonacciPair :: Int -> (Integer, Integer) #-}
{-# SPECIALIZE fibonacciPair :: Int -> (Natural, Natural) #-}
lucas :: Num a => Int -> a
lucas :: forall a. Num a => Int -> a
lucas = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Int -> (a, a)
lucasPair
{-# SPECIALIZE lucas :: Int -> Int #-}
{-# SPECIALIZE lucas :: Int -> Word #-}
{-# SPECIALIZE lucas :: Int -> Integer #-}
{-# SPECIALIZE lucas :: Int -> Natural #-}
lucasPair :: Num a => Int -> (a, a)
lucasPair :: forall a. Num a => Int -> (a, a)
lucasPair Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = let (a
f,a
g) = forall a. Num a => Int -> (a, a)
lucasPair (-(Int
nforall a. Num a => a -> a -> a
+Int
1)) in if forall a. Bits a => a -> Int -> Bool
testBit Int
n Int
0 then (-a
g, a
f) else (a
g, -a
f)
| Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = (a
2, a
1)
| Bool
otherwise = forall a. Num a => Int -> (a, a)
look (forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) forall a. Num a => a -> a -> a
- Int
2)
where
look :: Int -> (t, t)
look Int
k
| forall a. Bits a => a -> Int -> Bool
testBit Int
n Int
k = forall {t}. Num t => Int -> t -> t -> (t, t)
go (Int
kforall a. Num a => a -> a -> a
-Int
1) t
0 t
1
| Bool
otherwise = Int -> (t, t)
look (Int
kforall a. Num a => a -> a -> a
-Int
1)
go :: Int -> t -> t -> (t, t)
go Int
k t
g t
f
| Int
k forall a. Ord a => a -> a -> Bool
< Int
0 = (forall a. Num a => a -> a
shiftL1 t
g forall a. Num a => a -> a -> a
+ t
f,t
gforall a. Num a => a -> a -> a
+t
3forall a. Num a => a -> a -> a
*t
f)
| Bool
otherwise = Int -> t -> t -> (t, t)
go (Int
kforall a. Num a => a -> a -> a
-Int
1) t
g' t
f'
where
(t
f',t
g')
| forall a. Bits a => a -> Int -> Bool
testBit Int
n Int
k = (forall a. Num a => a -> a
shiftL1 (t
fforall a. Num a => a -> a -> a
*(t
fforall a. Num a => a -> a -> a
+t
g)) forall a. Num a => a -> a -> a
+ t
gforall a. Num a => a -> a -> a
*t
g,t
fforall a. Num a => a -> a -> a
*(forall a. Num a => a -> a
shiftL1 t
g forall a. Num a => a -> a -> a
+ t
f))
| Bool
otherwise = (t
fforall a. Num a => a -> a -> a
*(forall a. Num a => a -> a
shiftL1 t
g forall a. Num a => a -> a -> a
+ t
f),t
fforall a. Num a => a -> a -> a
*t
fforall a. Num a => a -> a -> a
+t
gforall a. Num a => a -> a -> a
*t
g)
{-# SPECIALIZE lucasPair :: Int -> (Int, Int) #-}
{-# SPECIALIZE lucasPair :: Int -> (Word, Word) #-}
{-# SPECIALIZE lucasPair :: Int -> (Integer, Integer) #-}
{-# SPECIALIZE lucasPair :: Int -> (Natural, Natural) #-}
generalLucas :: Num a => a -> a -> Int -> (a, a, a, a)
generalLucas :: forall a. Num a => a -> a -> Int -> (a, a, a, a)
generalLucas a
p a
q Int
k
| Int
k forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"generalLucas: negative index"
| Int
k forall a. Eq a => a -> a -> Bool
== Int
0 = (a
0,a
1,a
2,a
p)
| Bool
otherwise = Int -> (a, a, a, a)
look (forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) forall a. Num a => a -> a -> a
- Int
2)
where
look :: Int -> (a, a, a, a)
look Int
i
| forall a. Bits a => a -> Int -> Bool
testBit Int
k Int
i = Int -> a -> a -> a -> a -> (a, a, a, a)
go (Int
iforall a. Num a => a -> a -> a
-Int
1) a
1 a
p a
p a
q
| Bool
otherwise = Int -> (a, a, a, a)
look (Int
iforall a. Num a => a -> a -> a
-Int
1)
go :: Int -> a -> a -> a -> a -> (a, a, a, a)
go Int
i a
un a
un1 a
vn a
qn
| Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = (a
un, a
un1, a
vn, a
pforall a. Num a => a -> a -> a
*a
un1 forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
shiftL1 (a
qforall a. Num a => a -> a -> a
*a
un))
| forall a. Bits a => a -> Int -> Bool
testBit Int
k Int
i = Int -> a -> a -> a -> a -> (a, a, a, a)
go (Int
iforall a. Num a => a -> a -> a
-Int
1) (a
un1forall a. Num a => a -> a -> a
*a
vnforall a. Num a => a -> a -> a
-a
qn) ((a
pforall a. Num a => a -> a -> a
*a
un1forall a. Num a => a -> a -> a
-a
qforall a. Num a => a -> a -> a
*a
un)forall a. Num a => a -> a -> a
*a
vn forall a. Num a => a -> a -> a
- a
pforall a. Num a => a -> a -> a
*a
qn) ((a
pforall a. Num a => a -> a -> a
*a
un1 forall a. Num a => a -> a -> a
- (a
2forall a. Num a => a -> a -> a
*a
q)forall a. Num a => a -> a -> a
*a
un)forall a. Num a => a -> a -> a
*a
vn forall a. Num a => a -> a -> a
- a
pforall a. Num a => a -> a -> a
*a
qn) (a
qnforall a. Num a => a -> a -> a
*a
qnforall a. Num a => a -> a -> a
*a
q)
| Bool
otherwise = Int -> a -> a -> a -> a -> (a, a, a, a)
go (Int
iforall a. Num a => a -> a -> a
-Int
1) (a
unforall a. Num a => a -> a -> a
*a
vn) (a
un1forall a. Num a => a -> a -> a
*a
vnforall a. Num a => a -> a -> a
-a
qn) (a
vnforall a. Num a => a -> a -> a
*a
vn forall a. Num a => a -> a -> a
- a
2forall a. Num a => a -> a -> a
*a
qn) (a
qnforall a. Num a => a -> a -> a
*a
qn)
{-# SPECIALIZE generalLucas :: Int -> Int -> Int -> (Int, Int, Int, Int) #-}
{-# SPECIALIZE generalLucas :: Word -> Word -> Int -> (Word, Word, Word, Word) #-}
{-# SPECIALIZE generalLucas :: Integer -> Integer -> Int -> (Integer, Integer, Integer, Integer) #-}
{-# SPECIALIZE generalLucas :: Natural -> Natural -> Int -> (Natural, Natural, Natural, Natural) #-}
shiftL1 :: Num a => a -> a
shiftL1 :: forall a. Num a => a -> a
shiftL1 a
n = a
n forall a. Num a => a -> a -> a
+ a
n