Pisano period: Difference between revisions
m
→{{header|Haskell}}: Applied hlint, hindent.
m (→{{header|Haskell}}: Applied hlint, hindent.) |
|||
Line 340:
main = do
putStrLn $
putStrLn $
"map pisanoPeriod [1..180] == map pisanoConjecture [1..180] = " ++
show (ys == zs)
bagOf :: Int -> [a] -> [[a]]
bagOf _ [] = []
bagOf n xs =
let (us, vs) = splitAt n xs
in us : bagOf n vs
see
:: Show a
=> Int -> [a] -> String
see n =
unlines .
map unwords . bagOf n . map (T.unpack . T.justifyRight 3 ' ' . T.pack . show)
fibMod
:: Integral a
=> a -> [a]
fibMod 1 = repeat 0
fibMod n = fib
where
fib = 0 : 1 : zipWith (\x y -> rem (x + y) n) fib (tail fib)
pisanoPeriod
:: Integral a
=> a -> a
pisanoPeriod m
| m <= 0 = 0
pisanoPeriod 1 = 1
pisanoPeriod m = go 1 (tail $ fibMod m)
go t (0:1:_) = t
go t (_:xs)
powMod
:: Integral a
powMod _ _ k
| k < 0 = error "negative power"
powMod m _ _
| 1 == abs m = 0
powMod m p k
| 1 == abs p =
if 1 == p || even k
then mod 1 m
else mod p m
powMod m p k = go p k
to x y = mod (x * y) m
go _ 0 = 1
go u 1 = mod u m
go u i =
let w = go u (quot i 2)
in if even i
then to w w
else to u (to w w)
-- Fermat primality test
probablyPrime
:: Integral a
=> a -> Bool
probablyPrime p =
if p < 2 || even p
then 2 == p
else 1 == powMod p 2 (p - 1)
primes
:: Integral a
=> [a]
primes =
2 :
3 :
5 :
7 :
[ p
| p <- [11,13 ..]
, isPrime p ]
limitDivisor
:: Integral a
=> a -> a
limitDivisor = floor . (+ 0.05) . sqrt . fromIntegral
isPrime
:: Integral a
=> a -> Bool
isPrime p
| not $ probablyPrime p = False
isPrime p = go primes
stop = limitDivisor p
go (n:_)
go (n:ns) = (0 /= rem p n) && go ns
go [] = True
factor
:: Integral a
factor n
| n <= 1 = []
factor n =
if null ans
then [(n, 1)]
else ans
where
ans = go n primes
fun x d c =
then (x, c)
else fun (quot x d) d (succ c)
go 1 _ = []
go _ [] = []
go x (d:ds)
go x (d:ds) =
let (u, c) = fun (quot x d) d 1
in (d, c) : go u ds
pisanoPrime
:: Integral a
=> a -> a -> a
pisanoPrime p k
| p <= 0 || k < 0 = 0
pisanoPrime p k = pisanoPeriod $ p ^ k
pisano
:: Integral a
=> a -> a
pisano m
| m < 1 = 0
pisano 1 = 1
pisano m = foldl1 lcm . map (uncurry pisanoPrime) $ factor m
pisanoConjecture
:: Integral a
=> a -> a
pisanoConjecture m
| m < 1 = 0
pisanoConjecture 1 = 1
pisanoConjecture m = foldl1 lcm . map (uncurry pisanoPrime') $ factor m
where
pisanoPrime' p k = (p ^ (k - 1)) * pisanoPeriod p</lang>
{{out}}
<pre>PisanoPrime(p,2) for prime p lower than 15
|