Data commit

Task/Bernoulli-numbers/Haskell/bernoulli-numbers-1.hs

@@ -0,0 +1,23 @@
+import Data.Ratio
+import System.Environment
+
+main = getArgs >>= printM . defaultArg
+  where
+    defaultArg as =
+      if null as
+        then 60
+        else read (head as)
+
+printM m =
+  mapM_ (putStrLn . printP) .
+  takeWhile ((<= m) . fst) . filter (\(_, b) -> b /= 0 % 1) . zip [0 ..] $
+  bernoullis
+
+printP (i, r) =
+  "B(" ++ show i ++ ") = " ++ show (numerator r) ++ "/" ++ show (denominator r)
+
+bernoullis = map head . iterate (ulli 1) . map berno $ enumFrom 0
+  where
+    berno i = 1 % (i + 1)
+    ulli _ [_] = []
+    ulli i (x:y:xs) = (i % 1) * (x - y) : ulli (i + 1) (y : xs)

Task/Bernoulli-numbers/Haskell/bernoulli-numbers-2.hs

@@ -0,0 +1,56 @@
+import Data.Bool (bool)
+import Data.Ratio (Ratio, denominator, numerator, (%))
+
+-------------------- BERNOULLI NUMBERS -------------------
+
+bernouillis :: Integer -> [Rational]
+bernouillis =
+  fmap head
+    . tail
+    . scanl faulhaber []
+    . enumFromTo 0
+
+faulhaber :: [Ratio Integer] -> Integer -> [Ratio Integer]
+faulhaber rs n =
+  (:) =<< (-) 1 . sum $
+    zipWith ((*) . (n %)) [2 ..] rs
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main = do
+  let xs = bernouillis 60
+      w = length $ show (numerator (last xs))
+  putStrLn $
+    fTable
+      "Bernouillis from Faulhaber triangle:\n"
+      (show . fst)
+      (showRatio w . snd)
+      id
+      (filter ((0 /=) . snd) $ zip [0 ..] xs)
+
+------------------------ FORMATTING ----------------------
+fTable ::
+  String ->
+  (a -> String) ->
+  (b -> String) ->
+  (a -> b) ->
+  [a] ->
+  String
+fTable s xShow fxShow f xs =
+  let w = maximum (length . xShow <$> xs)
+   in unlines $
+        s :
+        fmap
+          ( ((<>) . rjust w ' ' . xShow)
+              <*> ((" -> " <>) . fxShow . f)
+          )
+          xs
+
+showRatio :: Int -> Rational -> String
+showRatio w r =
+  let d = denominator r
+   in rjust w ' ' $ show (numerator r)
+        <> bool [] (" / " <> show d) (1 /= d)
+
+rjust :: Int -> a -> [a] -> [a]
+rjust n c = drop . length <*> (replicate n c <>)