Data commit

Task/Babbage-problem/Haskell/babbage-problem-1.hs

@@ -0,0 +1,12 @@
+--Calculate squares, testing for the last 6 digits
+findBabbageNumber :: Integer
+findBabbageNumber =
+  head (filter ((269696 ==) . flip mod 1000000 . (^ 2)) [1 ..])
+
+main :: IO ()
+main =
+  (putStrLn . unwords)
+    (zipWith
+       (++)
+       (show <$> ([id, (^ 2)] <*> [findBabbageNumber]))
+       [" ^ 2 equals", " !"])

Task/Babbage-problem/Haskell/babbage-problem-2.hs

@@ -0,0 +1,18 @@
+import Data.List (intercalate)
+import Data.Maybe (maybe)
+import Safe (headMay)
+
+maybeBabbage :: Integer -> Maybe Integer
+maybeBabbage upperLimit =
+  headMay
+    (filter ((269696 ==) . flip rem 1000000) ((^ 2) <$> [1 .. upperLimit]))
+
+main :: IO ()
+main = do
+  let upperLimit = 100000
+  putStrLn $
+    maybe
+      (intercalate (show upperLimit) ["No such number found below ", " ..."])
+      (intercalate " ^ 2  ->  " .
+       fmap show . (<*>) [floor . sqrt . fromInteger, id] . pure)
+      (maybeBabbage upperLimit)

Task/Babbage-problem/Haskell/babbage-problem-3.hs

@@ -0,0 +1,25 @@
+import Data.List (intercalate)
+
+
+--------------------- BABBAGE PROBLEM --------------------
+
+babbagePairs :: [[Integer]]
+babbagePairs =
+  [0, 1000000 ..]
+    >>= \x ->                     -- Drawing from a succession of N * 10^6
+      let y = (x + 269696)        -- The next number ending in 269696,
+          r = root y              -- its square root,
+          i = floor r             -- and the integer part of that root.
+       in [ [i, y]                -- Root and square harvested together,
+            | r == fromIntegral i -- only if that root is an integer.
+          ]
+
+root :: Integer -> Double
+root = sqrt. fromIntegral
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main = mapM_ (putStrLn . arrowed) $ take 10 babbagePairs
+
+arrowed :: [Integer] -> String
+arrowed = intercalate " ^ 2 -> " . fmap show

Task/Babbage-problem/Haskell/babbage-problem-4.hs

@@ -0,0 +1,22 @@
+---------------------- BABBAGE PAIRS ---------------------
+
+babbagePairs :: [(Integer, Integer)]
+babbagePairs =
+  [0, 10000 ..]
+    >>= \x ->
+      ( ((,) <*> (^ 2)) . (x +)
+          <$> [264, 5264, 9736, 4736]
+      )
+        >>= \(a, b) ->
+          [ (a, b)
+            | ((269696 ==) . flip rem 1000000) b
+          ]
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main =
+  mapM_
+    putStrLn
+    ( (\(a, b) -> show a <> " ^2 -> " <> show b)
+        <$> take 2000 babbagePairs
+    )