Rosetta Code

Pisano period: Difference between revisions

Page Discussion

Pisano period (view source)

Revision as of 10:26, 8 March 2020

247 bytes added ,  4 years ago
m
→‎{{header|Haskell}}: Applied hlint, hindent.
m (→‎{{header|Haskell}}: Applied hlint, hindent.)
Line 340:
 
main = do
putStrLn $ "PisanoPrime(p,2) for prime p lower than 15"
putStrLn . see 15 . map (flip `pisanoPrime` 2) . filter isPrime $ [1 .. 15]
putStrLn $ "PisanoPrime(p,1) for prime p lower than 180"
putStrLn . see 15 . map (flip `pisanoPrime` 1) . filter isPrime $ [1 .. 180]
let ns = [1 .. 180] :: [Int]
let xs = map pisanoPeriod ns
let ys = map pisano ns
let zs = map pisanoConjecture ns
putStrLn $ "Pisano(m) for m from 1 to 180"
putStrLn . see 15 $ map pisano [1 .. 180]
putStrLn $
putStrLn $ "map pisanoPeriod [1..180] == map pisano [1..180] = " ++ (show $ xs == ys)
putStrLn $ "map pisanoPeriod [1..180] == map pisanoConjecturepisano [1..180] = " ++ (show $ ys(xs == zsys)
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
let (us, vs) = splitAt n xs
in us : bagOf n vs
 
see
see :: Show a => Int -> [a] -> String
:: Show a
see n = unlines.map unwords.bagOf n.map (T.unpack.T.justifyRight 3 ' '.T.pack.show)
=> Int -> [a] -> String
see n =
unlines .
map unwords . bagOf n . map (T.unpack . T.justifyRight 3 ' ' . T.pack . show)
 
fibMod
fibMod :: Integral a => a -> [a]
:: Integral a
=> a -> [a]
fibMod 1 = repeat 0
fibMod n = fib
where
where fib = 0 : 1 : zipWith (\x y -> rem (x+y) n) fib (tail fib)
fib = 0 : 1 : zipWith (\x y -> rem (x + y) n) fib (tail fib)
 
pisanoPeriod :: Integral a => a -> a
:: Integral a
pisanoPeriod m | m <= 0 = 0
=> a -> a
pisanoPeriod m
| m <= 0 = 0
pisanoPeriod 1 = 1
pisanoPeriod m = go 1 (tail $ fibMod m)
where
go t (0:1:_) = t
go t (_:xs) = go (succ t) xs
 
powMod
powMod :: Integral a => a -> a -> a -> a
:: Integral a
powMod _ _ k | k < 0 = error "negative power"
powMod m _=> _a |-> 1a ==-> absa m =-> 0a
powMod _ _ k
powMod m p k | 1 == abs p = if 1 == p || even k then mod 1 m else mod p m
| 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
where
to x y = mod (x * y) m
go _ 0 = 1
go u 1 = mod u m
go u i =
go u i = let w = go u (quot i 2) in if even i then to w w else to u (to w w)
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
:: Integral a
probablyPrime p = if p < 2 || even p then 2 == p else 1 == powMod p 2 (p-1)
=> a -> Bool
probablyPrime p =
if p < 2 || even p
then 2 == p
else 1 == powMod p 2 (p - 1)
 
primes :: Integral a => [a]
:: Integral a
primes = 2:3:5:7:[p | p <- [11,13..], isPrime p]
=> [a]
primes =
2 :
3 :
5 :
7 :
[ p
| p <- [11,13 ..]
, isPrime p ]
 
limitDivisor :: Integral a => a -> a
:: Integral a
limitDivisor = floor.(+0.05).sqrt.fromIntegral
=> a -> a
limitDivisor = floor . (+ 0.05) . sqrt . fromIntegral
 
isPrime :: Integral a => a -> Bool
:: Integral a
isPrime p | not $ probablyPrime p = False
=> a -> Bool
isPrime p
| not $ probablyPrime p = False
isPrime p = go primes
where
stop = limitDivisor p
go (n:_) | stop < n = True
go (n:ns) =| ifstop 0 == rem p< n then False else go= nsTrue
go (n:ns) = (0 /= rem p n) && go ns
go [] = True
 
factor
factor :: Integral a => a -> [(a,a)]
:: Integral a
factor n | n <= 1 = []
factor n => ifa null ans then-> [(na,1 a)] else ans
factor n
where
| n <= 1 = []
factor n =
if null ans
then [(n, 1)]
else ans
where
ans = go n primes
fun x d c = if 0 /= rem x d then (x,c) else fun (quot x d) d (succ c)
go 1 _if 0 /= []rem x d
then (x, c)
else fun (quot x d) d (succ c)
go 1 _ = []
go _ [] = []
go x (d:ds) | 0 /= rem x d = go x $ dropWhile ((0 /=).rem x) ds
go | 0 /= rem x (d:ds) = letgo (u,c)x =$ fundropWhile (quot(0 x d/=) d. 1rem in (d,cx):go u 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
:: Integral a
pisanoPrime p k | p <= 0 || k < 0 = 0
=> a -> a -> a
pisanoPrime p k = pisanoPeriod $ p^k
pisanoPrime p k
| p <= 0 || k < 0 = 0
pisanoPrime p k = pisanoPeriod $ p ^ k
 
pisano
pisano :: Integral a => a -> a
:: Integral a
pisano m | m < 1 = 0
=> a -> a
pisano m
| m < 1 = 0
pisano 1 = 1
pisano m = foldl1 lcm . map (uncurry pisanoPrime) $ factor m
 
pisanoConjecture :: Integral a => a -> a
:: Integral a
pisanoConjecture m | m < 1 = 0
=> a -> a
pisanoConjecture m
| m < 1 = 0
pisanoConjecture 1 = 1
pisanoConjecture m = foldl1 lcm . map (uncurry pisanoPrime') $ factor m
where
where pisanoPrime' p k = (p^(k-1))*(pisanoPeriod p)</lang>
pisanoPrime' p k = (p ^ (k - 1)) * pisanoPeriod p</lang>
{{out}}
<pre>PisanoPrime(p,2) for prime p lower than 15
Hout
9,659

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/298820"