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