Step by Step solution about How to resolve the algorithm Babbage problem step by step in the Haskell programming language

Source Code Explanation

Version 1:

Purpose: Find the first number whose square ends in 269696, known as the Babbage number.

Code:

findBabbageNumber :: Integer
findBabbageNumber =
 head (filter ((269696 ==) . flip mod 1000000 . (^ 2)) [1 ..])

main :: IO ()
main =
 (putStrLn . unwords)
   (zipWith
      (++)
      (show <$> ([id, (^ 2)] <*> [findBabbageNumber]))
      [" ^ 2 equals", " !"])

Explanation:

• findBabbageNumber uses filter to find the first number whose square's last 6 digits match 269696.
• main displays the found number and its square.

Version 2:

Purpose: Find the Babbage number below a specified upper limit.

Code:

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)

Explanation:

• maybeBabbage uses headMay to find the first Babbage number below a given upper limit.
• main sets the upper limit to 100,000 and displays the result if found.

Version 3:

Purpose: Generate pairs of numbers whose squares end in 269696, known as Babbage pairs.

Code:

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.
         ]

Explanation:

• babbagePairs generates pairs of numbers whose squares end in 269696.
• It starts with a series of 1 million intervals and applies a series of transformations to find the pairs.
• If the square root of the transformed number is an integer, the number and its square are added to the list of pairs.

Version 4:

Purpose: Generate Babbage pairs using a different approach.

Code:

babbagePairs :: [(Integer, Integer)]
babbagePairs =
 [0, 10000 ..]
   >>= \x ->
     ( ((,) <*> (^ 2)) . (x +)
         <$> [264, 5264, 9736, 4736]
     )
       >>= \(a, b) ->
         [ (a, b)
           | ((269696 ==) . flip rem 1000000) b
         ]

Explanation:

• This version uses a different approach to generate Babbage pairs.
• It starts with a series of 1 million intervals and applies a series of transformations to find the pairs.
• It adds a specific set of offsets to each interval and squares the result.
• If the resulting square ends in 269696, the pair is added to the list.

--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", " !"])


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)


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


---------------------- 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
    )