Data commit

Task/Fibonacci-n-step-number-sequences/Haskell/fibonacci-n-step-number-sequences-1.hs

@@ -0,0 +1,22 @@
+import Control.Monad (zipWithM_)
+import Data.List (tails)
+
+fiblike :: [Integer] -> [Integer]
+fiblike st = xs
+  where
+    xs = st <> map (sum . take n) (tails xs)
+    n = length st
+
+nstep :: Int -> [Integer]
+nstep n = fiblike $ take n $ 1 : iterate (2 *) 1
+
+main :: IO ()
+main = do
+  mapM_ (print . take 10 . fiblike) [[1, 1], [2, 1]]
+  zipWithM_
+    ( \n name -> do
+        putStr (name <> "nacci -> ")
+        print $ take 15 $ nstep n
+    )
+    [2 ..]
+    (words "fibo tribo tetra penta hexa hepta octo nona deca")

Task/Fibonacci-n-step-number-sequences/Haskell/fibonacci-n-step-number-sequences-2.hs

@@ -0,0 +1,33 @@
+------------ FIBONACCI N-STEP NUMBER SEQUENCES -----------
+
+nStepFibonacci :: Int -> [Int]
+nStepFibonacci =
+  nFibs
+    . (1 :)
+    . fmap (2 ^)
+    . enumFromTo 0
+    . subtract 2
+
+nFibs :: [Int] -> [Int]
+nFibs ys@(z : zs) = z : nFibs (zs <> [sum ys])
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main = do
+  putStrLn $
+    justifyLeft 12 ' ' "Lucas" <> "-> "
+      <> show (take 15 (nFibs [2, 1]))
+  (putStrLn . unlines)
+    ( zipWith
+        ( \s n ->
+            justifyLeft 12 ' ' (s <> "naccci")
+              <> ("-> " <> show (take 15 (nStepFibonacci n)))
+        )
+        ( words
+            "fibo tribo tetra penta hexa hepta octo nona deca"
+        )
+        [2 ..]
+    )
+
+justifyLeft :: Int -> Char -> String -> String
+justifyLeft n c s = take n (s <> replicate n c)

Task/Fibonacci-n-step-number-sequences/Haskell/fibonacci-n-step-number-sequences-3.hs

@@ -0,0 +1,58 @@
+import Data.Bifunctor (second)
+import Data.List (transpose, uncons, unfoldr)
+
+------------ FIBONACCI N-STEP NUMBER SEQUENCES -----------
+
+a000032 :: [Int]
+a000032 = unfoldr (recurrence 2) [2, 1]
+
+nStepFibonacci :: Int -> [Int]
+nStepFibonacci =
+  unfoldr <$> recurrence
+    <*> (($ 1 : fmap (2 ^) [0 ..]) . take)
+
+recurrence :: Int -> [Int] -> Maybe (Int, [Int])
+recurrence n =
+  ( fmap
+      . second
+      . flip (<>)
+      . pure
+      . sum
+      . take n
+  )
+    <*> uncons
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main =
+  putStrLn $
+    "Recurrence relation sequences:\n\n"
+      <> spacedTable
+        justifyRight
+        ( ("lucas:" : fmap show (take 15 a000032)) :
+          zipWith
+            ( \k n ->
+                (k <> "nacci:") :
+                fmap
+                  show
+                  (take 15 $ nStepFibonacci n)
+            )
+            (words "fibo tribo tetra penta hexa hepta octo nona deca")
+            [2 ..]
+        )
+
+------------------------ FORMATTING ----------------------
+spacedTable ::
+  (Int -> Char -> String -> String) -> [[String]] -> String
+spacedTable aligned rows =
+  let columnWidths =
+        fmap
+          (maximum . fmap length)
+          (transpose rows)
+   in unlines $
+        fmap
+          (unwords . zipWith (`aligned` ' ') columnWidths)
+          rows
+
+justifyRight :: Int -> Char -> String -> String
+justifyRight n c = (drop . length) <*> (replicate n c <>)