A Ruth–Aaron pair consists of two consecutive integers (e.g., 714 and 715) for which the sums of the prime divisors of each integer are equal. So called because 714 is Babe Ruth's lifetime home run record; Hank Aaron's 715th home run broke this record and 714 and 715 have the same prime divisor sum.



A Ruth–Aaron triple consists of three consecutive integers with the same properties.



There is a second variant of Ruth–Aaron numbers, one which uses prime factors rather than prime divisors. The difference; divisors are unique, factors may be repeated. The 714, 715 pair appears in both, so the name still fits.



It is common to refer to each Ruth–Aaron group by the first number in it.



Task
 Find and show, here on this page, the first 30 Ruth-Aaron numbers (factors).
 Find and show, here on this page, the first 30 Ruth-Aaron numbers (divisors).


Stretch
 Find and show the first Ruth-Aaron triple (factors).
 Find and show the first Ruth-Aaron triple (divisors).


See also
Wikipedia: Ruth–Aaron pair
OEIS:A006145 - Ruth-Aaron numbers (1): sum of prime divisors of n = sum of prime divisors of n+1
OEIS:A039752 - Ruth-Aaron numbers (2): sum of prime divisors of n = sum of prime divisors of n+1 (both taken with multiplicity)
import qualified Data.Set as S
import Data.List.Split ( chunksOf )
 
divisors :: Int -> [Int]
divisors n = [d | d <- [2 .. n] , mod n d == 0]
 
--for obvious theoretical reasons the smallest divisor of a number bare 1
--must be prime
primeFactors :: Int -> [Int]
primeFactors n = snd $ until ( (== 1) . fst ) step (n , [] )
 where
  step :: (Int , [Int] ) -> (Int , [Int] )
  step (n , li) = ( div n h , li ++ [h] )
   where
    h :: Int
    h = head $ divisors n
 
primeDivisors :: Int -> [Int]
primeDivisors n = S.toList $ S.fromList $ primeFactors n
 
solution :: (Int -> [Int] ) -> [Int]
solution f = snd $ until ( (== 30 ) . length . snd ) step ([2 , 3] , [] )
 where
  step :: ([Int] , [Int] ) -> ([Int] , [Int])
  step ( neighbours , ranums ) =  ( map ( + 1 ) neighbours , if (sum $ f
   $ head neighbours ) == (sum $ f $ last neighbours) then
   ranums ++ [ head neighbours ] else ranums )
 
formatNumber :: Int -> String -> String
formatNumber width num
   |width > l = replicate ( width -l ) ' ' ++ num
   |width == l = num
   |width < l = num
    where
     l = length num
 
main :: IO ( )
main = do
   let ruth_aaron_pairs = solution primeFactors
       maxlen = length $ show $ last ruth_aaron_pairs
       numberlines = chunksOf 8 $ map show ruth_aaron_pairs
       ruth_aaron_divisors = solution primeDivisors
       maxlen2 = length $ show $ last ruth_aaron_divisors
       numberlines2 = chunksOf 8 $ map show ruth_aaron_divisors
       putStrLn "First 30 Ruth-Aaaron numbers ( factors ) :"     
   mapM_ (\nlin -> putStrLn $ foldl1 ( ++ ) $ map (\st -> formatNumber (maxlen + 2) st )
    nlin ) numberlines  
   putStrLn " "
   putStrLn "First 30 Ruth-Aaron numbers( divisors ):"
   mapM_ (\nlin -> putStrLn $ foldl1 ( ++ ) $ map (\st -> formatNumber (maxlen2 + 2) st )
    nlin ) numberlines2