Data commit

Task/Farey-sequence/Haskell/farey-sequence.hs

@@ -0,0 +1,41 @@
+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]