此问题包含未完成problem 61 of Project Euler的人的剧透。我写了一个问题的答案，这是必要的，所以我打算做一个更通用，功能性的答案。我成功了，但现在正在试图弄清楚如何将其重构为或使用计算表达式并且无可救药地混淆。下面详细描述了这个问题，但要点是你正在尝试建立一个数字链，当按顺序排列时，它们会在所有相邻对上展现出一个属性。链的候选者各自来自不同的数字池，这意味着蛮力算法必须聪明，以避免需要搜索每个可能的排列。
我对包含计算表达式的猜测是将搜索算法以某种方式变为monad，然后继续添加到解决方案或转储空列表。但我不完全确定。
(*
Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers are
all figurate (polygonal) numbers and are generated by the following formulae:
Triangle P3,n=n(n+1)/2 1, 3, 6, 10, 15, ...
Square P4,n=n2 1, 4, 9, 16, 25, ...
Pentagonal P5,n=n(3n−1)/2 1, 5, 12, 22, 35, ...
Hexagonal P6,n=n(2n−1) 1, 6, 15, 28, 45, ...
Heptagonal P7,n=n(5n−3)/2 1, 7, 18, 34, 55, ...
Octagonal P8,n=n(3n−2) 1, 8, 21, 40, 65, ...
The ordered set of three 4-digit numbers: 8128, 2882, 8281, has three
interesting properties.
The set is cyclic, in that the last two digits of each number is the first two
digits of the next number (including the last number with the first).
Each polygonal type: triangle (P3,127=8128), square (P4,91=8281), and pentagonal
(P5,44=2882), is represented by a different number in the set.
This is the only set of 4-digit numbers with this property.
Find the sum of the only ordered set of six cyclic 4-digit numbers for which
each polygonal type: triangle, square, pentagonal, hexagonal, heptagonal, and
octagonal, is represented by a different number in the set.
*)
let rec distribute e = function
| [] -> [[e]]
| x::xs' as xs -> (e::xs)::[for xs in distribute e xs' -> x::xs]
// Return a list of all permutations of a list
let rec permute = function
| [] -> [[]]
| e::xs -> List.collect (distribute e) (permute xs)
// Return a list rotated until it's minimum element is the head
let canonicalCyclicPermutation (permutationList : 'a list) =
let min = Seq.min permutationList
let rec loop ourList =
match ourList with
| head :: tail when head = min -> ourList
| head :: tail -> loop (tail @ [head])
loop permutationList
// Return a list of all permutations of a list that is rotationally/cylically unique
let permutateCycUniq seedList =
permute seedList
|> List.distinctBy canonicalCyclicPermutation
// Generate a sequence of all s-gonal numbers
let polygonalGenerator s =
Seq.initInfinite (fun idx -> ((pown (idx+1) 2) * (s-2) - (idx+1)*(s-4))/2)
// Generate a sequence of s-gonal numbers relevant for our exercise
let polygonalCandidates s =
s
|> polygonalGenerator
|> Seq.skipWhile (fun x -> x <= 999)
|> Seq.takeWhile (fun x -> x <= 9999)
|> Seq.cache
// Create the polygonal numbers as a list not seq
let polygonalCandidatesL s =
polygonalCandidates s
|> Seq.toList
// Returns true if the last digits of first input are first digits in last input
let sharesDigits xxvv vvyy =
(xxvv / 100) = (vvyy % 100)
// Returns true if a sequence is cyclical
let isCyclical intSeq =
(Seq.append intSeq (Seq.take 1 intSeq))
|> Seq.pairwise
|> Seq.fold (fun acc (num1,num2) -> acc && (sharesDigits num1 num2)) true
// Returns an empty list if the candidate number does not share digits
// with the list head, otherwise returns the list with the candidate at the head
let addCandidateToSolution (solution : int list) (number : int) =
match solution with
| (head::tail) when sharesDigits number head -> number::head::tail
| _ -> []
// Returns a sequence of all valid solutions generated by trying to add
// a sequence of candidates to all solutions in a sequence
let addCandidatesToSolution (solutions : int list seq) (candidates : int seq) =
Seq.collect (fun solution ->
Seq.map (fun candidate ->
addCandidateToSolution solution candidate)
candidates
|> Seq.filter (not << List.isEmpty))
solutions
// Given a list of side lengths, we return a sequence of cyclical solutions
// from the polygonal number families in the order they appear in the list
let generateSolutionsFromPolygonalFamilies (seedList : int list) =
let solutionSeeds =
seedList
|> List.head
|> polygonalCandidates
|> Seq.map (fun x -> [x])
let solutions =
Seq.fold (fun acc elem -> (addCandidatesToSolution acc elem))
solutionSeeds
((List.tail seedList) |> List.map polygonalCandidatesL)
|> Seq.filter isCyclical
solutions
// Find all cyclical sequences from a list of polygonal number families
let FindSolutionsFromFamilies intList =
intList
|> permutateCycUniq
|> Seq.collect generateSolutionsFromPolygonalFamilies
|> Seq.toList
// Given in the problem
let sampleAnswer = FindSolutionsFromFamilies [3;4;5]
// The set of answers that answers the problem
#time
let problemAnswer = FindSolutionsFromFamilies [3 .. 8]
#time // 0.09s wow!
答案 0 :(得分：1)
虽然一开始就持怀疑态度，但我不得不承认这个问题背后的想法非常合理，而实际的实施似乎很难实现。由于必须为给定的数据结构提供member Bind : ma:'a list * f:('a -> 'b list) -> 'b list的等效monadic签名，因此坚持使用F＃list并使用其相应的高阶函数List.collect是很自然的。
type ListBuilder () =
member __.Return x = [x]
member __.Bind(ma, f) = List.collect f ma
let myList a b = ListBuilder () {
let! x = a
let! y = b
return x, y }
myList [1..2] [3..4] // [(1, 3); (1, 4); (2, 3); (2, 4)]
这种最小但光滑的笛卡儿产品并没有让我们走得太远。我们需要使链条的执行成为条件，需要一个额外的成员Zero。显然，固定的arity是这种方法的主要缺点。
type MyListBuilder () =
member __.Zero _ = []
member __.Return x = [x]
member __.Bind(ma, f) = List.collect f ma
let myListXY cmp a b c = MyListBuilder () {
let! r = a
let! s = b
if cmp r s then
let! t = c
if cmp s t then
if cmp t r then
return r, s, t }
let T n k = if n < 2 then 0 else ((n - 2) * k * k - (n - 4) * k) / 2
let figurate s min max =
Seq.initInfinite ((+) 1)
|> Seq.map (T s)
|> Seq.takeWhile (fun n -> n < max)
|> Seq.filter (fun n -> n >= min)
|> Seq.toList
myListXY (fun x y -> x % 100 = y / 100)
(figurate 3 1000 10000)
(figurate 5 1000 10000)
(figurate 4 1000 10000) // [(8128, 2882, 8281)]