Anonymous user
Farey sequence: Difference between revisions
Haskell version.
m (→{{header|Tcl}}: Better efficiency) |
(Haskell version.) |
||
Line 232:
</pre>
=={{header|Haskell}}==
Generating an n'th order Farey sequence follows the algorithm described in Wikipedia. However, for fun, to generate a list of Farey sequences we generate only the highest order sequence, creating the rest by successively pruning the original.
<lang Haskell>import Data.List
import Data.Ratio
import Text.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 showFrac
where showFrac r = show (numerator r) ++ "/" ++ show (denominator r)
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]</lang>
Output:
<pre>Farey Sequences
1 0/1 1/1
2 0/1 1/2 1/1
3 0/1 1/3 1/2 2/3 1/1
4 0/1 1/4 1/3 1/2 2/3 3/4 1/1
5 0/1 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 1/1
6 0/1 1/6 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 5/6 1/1
7 0/1 1/7 1/6 1/5 1/4 2/7 1/3 2/5 3/7 1/2 4/7 3/5 2/3 5/7 3/4 4/5 5/6 6/7 1/1
8 0/1 1/8 1/7 1/6 1/5 1/4 2/7 1/3 3/8 2/5 3/7 1/2 4/7 3/5 5/8 2/3 5/7 3/4 4/5 5/6 6/7 7/8 1/1
9 0/1 1/9 1/8 1/7 1/6 1/5 2/9 1/4 2/7 1/3 3/8 2/5 3/7 4/9 1/2 5/9 4/7 3/5 5/8 2/3 5/7 3/4 7/9 4/5 5/6 6/7 7/8 8/9 1/1
10 0/1 1/10 1/9 1/8 1/7 1/6 1/5 2/9 1/4 2/7 3/10 1/3 3/8 2/5 3/7 4/9 1/2 5/9 4/7 3/5 5/8 2/3 7/10 5/7 3/4 7/9 4/5 5/6 6/7 7/8 8/9 9/10 1/1
11 0/1 1/11 1/10 1/9 1/8 1/7 1/6 2/11 1/5 2/9 1/4 3/11 2/7 3/10 1/3 4/11 3/8 2/5 3/7 4/9 5/11 1/2 6/11 5/9 4/7 3/5 5/8 7/11 2/3 7/10 5/7 8/11 3/4 7/9 4/5 9/11 5/6 6/7 7/8 8/9 9/10 10/11 1/1
Sequence Lengths
100 3045
200 12233
300 27399
400 48679
500 76117
600 109501
700 149019
800 194751
900 246327
1000 304193</pre>
=={{header|J}}==
| |||