Алгоритм рефакторинга как вычислительное выражение?

Этот вопрос содержит спойлеры для тех, кто не решил проблему 61 ​​проекта Euler. Я написал ответ на проблему, которая была императивной, поэтому я решил сделать более общий и функциональный ответ. Мне это удалось, но теперь я пытаюсь понять, как реорганизовать его как или с помощью вычислительных выражений, и я безнадежно запутался. Проблема подробно описана ниже, но суть в том, что вы пытаетесь построить цепочку чисел, которые при упорядоченном расположении проявляют свойство для всех соседних пар. Кандидаты в цепочку поступают из разных пулов чисел, а это означает, что алгоритм грубой силы должен быть умным, чтобы избежать поиска всех возможных перестановок.

Я предполагаю, что включение вычисляющих выражений будет состоять в том, чтобы каким-то образом превратить алгоритм поиска в монаду, где он продолжает добавлять к решению или выгружает пустой список. Но я не совсем уверен.

(*
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!

person jks612    schedule 05.11.2017    source источник
comment
Что вы хотите получить, делая это? Ценность вычислительных выражений заключается в том, что они улавливают общий шаблон вычислений и абстрагируются от него. Каков общий шаблон, который вы хотите здесь абстрагировать?   -  person scrwtp    schedule 06.11.2017
comment
Помимо применимости пользовательских вычислительных выражений, вы, безусловно, можете переписать части своей программы в выражения последовательности или даже выражения запроса. Но это не обязательно поможет с читабельностью или эффективностью, в то время как другой выбор структуры данных, например. набор словарей для определения циклических цепочек, возможно, позволит вам сэкономить еще пару миллисекунд.   -  person kaefer    schedule 06.11.2017
comment
В основном я пытаюсь понять, как использовать вычислительные выражения. Я не понимаю их и ищу практику. Общим шаблоном, который, как я думаю, можно было бы абстрагировать, была бы поисковая часть алгоритма, где он продолжается по цепочке возможных решений, пока либо не разрешается ни к чему, либо не находит решение.   -  person jks612    schedule 06.11.2017


Ответы (1)


Хотя поначалу я был настроен скептически, я должен признать, что мысль, стоящая за этим вопросом, довольно разумна, в то время как фактическая реализация кажется довольно труднодостижимой. Из-за необходимости предоставления эквивалентной монадической подписи member Bind : ma:'a list * f:('a -> 'b list) -> 'b list для данной структуры данных вполне естественно придерживаться списка F# и использовать соответствующую функцию более высокого порядка, 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. Очевидно, что фиксированная арность является основным недостатком этого подхода.

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)]
person kaefer    schedule 07.11.2017
comment
Это замечательно. Спасибо. Я надеялся, что фиксированная арность, как вы говорите, может быть удалена. Моя догадка говорит, что функция binding должна быть чем-то вроде reduce или fold по списку/последовательности групп для поиска. Однако мне не повезло написать это. - person jks612; 08.11.2017