Project Euler 49

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

重複組合せで数字を出して、題意を満たすか調べます。

open Arithmetic

let rec digits n = if n = 0 then [] else (digits (n / 10)) @ [ n % 10 ]
let to_number a = List.fold (fun x y -> x * 10 + y) 0 a

let rec repeated_combination a n = seq {
   if n = 0 then
      yield []
   else if a <> [] then
      for b in repeated_combination a (n - 1) do
         yield (List.head a) :: b
      for b in repeated_combination (List.tail a) n do
         yield b
}

let rec remove_by_index a k =
   if k = 0 then List.tail a
   else (List.head a) :: (remove_by_index (List.tail a) (k - 1))

let rec permutations = function
   | [] -> seq [ [] ]
   | a  -> seq {
            let L = List.length a
            for k in 0..L-1 do
               for b in permutations (remove_by_index a k) do
                  yield a.[k] :: b
   }

let rec combinations a n =
   if n = 0 then
      [[]]
   else
      match a with
         | [] -> []
         | head :: tail ->
            if List.length a < n then
               []
            else
               [ for b in combinations tail (n - 1) -> head :: b ]
                                             @ (combinations tail n)

let rec index a v =
   match a with
      | [] -> -1
      | head :: tail ->
         if head = v then 0
         else
            let p = index tail v
            if p = -1 then -1 else p + 1

let N = 4
let M = pown 10 (N - 1)

let perm_prime n =
   let a = Seq.toList
            (Seq.filter (fun m -> m >= M && Primes.is_prime m)
               (Set.ofSeq (Seq.map to_number
                                       (permutations (digits n)))))
   let is_valid (x : int list) = index a (x.[1] * 2 - x.[0]) <> -1
   let rec f (x : int list) = ((int64 x.[0]) * 10000L
                              + (int64 x.[1])) * 10000L
                              + (int64 x.[1]) * 2L - (int64 x.[0])
   List.map f (List.filter is_valid (combinations a 2))

for a in Seq.map perm_prime
            (Seq.map to_number
               (repeated_combination [0..9] 4)) do
   for n in a do
      printfn "%d" n