module Main where
import Data.List (find)
main = print $ pair
where pair = find ((500 <) . fst) $ map (factors `pd` id) $ (triToStream . tri) initial
pd f g = \n -> (f n, g n)
-- smallest tri num larger than
tri :: Int -> Int
tri p = ceiling $ (sqrt (fromIntegral $ p * 8 + 1) - 1) / 2
triToStream :: Int -> [Int]
triToStream n = (a : aux a n)
where a = (n * (n + 1)) `div` 2
aux a n = (a + n + 1 : aux (a + n + 1) (n + 1))
factors :: Int -> Int
factors n = 2 * (aux mid 0) - if n `div` mid == mid then 1 else 0
where mid = ((floor . sqrt) (fromIntegral n))
aux 1 acc = acc + 1
aux a acc = aux (a - 1) (acc + if mod n a == 0 then 1 else 0)
initial :: Int
initial = 9699690
(define (factors n)
(let* ([mid (floor (sqrt n))]
[half (let loop ((a mid)
(acc 1))
(if (= a 1)
acc
(loop (1- a) (+ acc (if (= (mod n a) 0)
1
0)))))])
(+ (* 2 half)
(if (= n (* mid mid))
1
0))))
(define (problem12 n)
(let loop ((x (/ (* (+ n 1) n) 2))
(n (1+ n)))
(if (< 500 (factors x))
x
(loop (+ x n) (1+ n)))))
> (time (problem12 1393))
(time (problem12 1393))
811 collections
1.646439303s elapsed cpu time, including 0.012281831s collecting
1.647140000s elapsed real time, including 0.013833000s collecting
6842787616 bytes allocated, including 6842210896 bytes reclaimed