Project Euler 23

http://projecteuler.net/index.php?section=problems&id=22

必要な範囲の過剰数を全て求めて、それをひっくり返したものと比較しながら和があるかを調べます。

let rec pow n e = if e = 0 then 1 else n * (pow n (e - 1))

let rec calc_exp n p =
   if n % p <> 0 then
      (0, n)
   else
      let e, m = calc_exp (n / p) p
      (e + 1, m)

let sieve max_n =
   let a = [| 0..max_n |]
   let d = Array.create (max_n + 1) 1
   for p in Seq.takeWhile (fun n -> n * n <= max_n)
               (Seq.filter (fun n -> d.[n] = 1) (seq { 2..max_n })) do
      for n in seq { p..p..max_n } do
         let e, m = calc_exp a.[n] p
         a.[n] <- m
         d.[n] <- d.[n] * (((pow p (e + 1)) - 1) / (p - 1))
   
   for n in Seq.filter (fun n -> a.[n] <> 1) (seq { 2..max_n }) do
      d.[n] <- d.[n] * (a.[n] + 1)
   
   List.filter (fun n -> d.[n] > n * 2) [2..max_n]

let rec is_matched n (a : int List) (b : int List) =
   if List.isEmpty a || List.isEmpty b then
      false
   else
      let m = a.Head + b.Head
      if m = n then true
      else if m < n then is_matched n a.Tail b
      else               is_matched n a b.Tail

let L = 28123
let a = sieve L
let b = List.rev a
printfn "%d" (List.sum (List.filter
               (fun n -> not (is_matched n a b)) [1..L]))