42 lines
1.3 KiB
Haskell
42 lines
1.3 KiB
Haskell
import Data.List (unfoldr, mapAccumR)
|
|
import Data.Ratio ((%), denominator, numerator)
|
|
import Text.Printf (PrintfArg, printf)
|
|
|
|
-- The n'th order Farey sequence.
|
|
farey :: Integer -> [Rational]
|
|
farey n = 0 : unfoldr step (0, 1, 1, n)
|
|
where
|
|
step (a, b, c, d)
|
|
| c > n = Nothing
|
|
| otherwise =
|
|
let k = (n + b) `quot` d
|
|
in Just (c %d, (c, d, k * c - a, k * d - b))
|
|
|
|
-- A list of pairs, (n, fn n), where fn is a function applied to the n'th order
|
|
-- Farey sequence. We assume the list of orders is increasing. Only the
|
|
-- highest order Farey sequence is evaluated; the remainder are generated by
|
|
-- successively pruning this sequence.
|
|
fareys :: ([Rational] -> a) -> [Integer] -> [(Integer, a)]
|
|
fareys fn ns = snd $ mapAccumR prune (farey $ last ns) ns
|
|
where
|
|
prune rs n =
|
|
let rs'' = filter ((<= n) . denominator) rs
|
|
in (rs'', (n, fn rs''))
|
|
|
|
fprint
|
|
:: (PrintfArg b)
|
|
=> String -> [(Integer, b)] -> IO ()
|
|
fprint fmt = mapM_ (uncurry $ printf fmt)
|
|
|
|
showFracs :: [Rational] -> String
|
|
showFracs =
|
|
unwords .
|
|
map (concat . (<*>) [show . numerator, const "/", show . denominator] . pure)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Farey Sequences\n"
|
|
fprint "%2d %s\n" $ fareys showFracs [1 .. 11]
|
|
putStrLn "\nSequence Lengths\n"
|
|
fprint "%4d %d\n" $ fareys length [100,200 .. 1000]
|