F # PurelyFunctionalDataStructures WeightBiasedLeftistHeap ex 3.4

Я работаю над функциональными структурами данных Okasaki Purely и пытаюсь построить реализацию F # вещей. Я также выполняю упражнения, перечисленные в книге (некоторые из них довольно сложны). Ну, я застрял в упражнении 3.4, который требует модификации функции слияния WeightBiasedLeftistHeap таким образом, что он выполняется за один проход в отличие от исходной реализации с двумя проходами.

Я еще не мог понять, как это сделать, и надеялся на некоторые предложения. Был еще один пост здесь, на SO, где парень делает это в SML, в значительной степени вставляя функцию makeT. Я начал идти по этому маршруту (в комментариях к разделу 3.4 "Первая попытка", но отказался от этого подхода, потому что я думал, что это действительно не выполняется за один проход (он все еще идет "до тех пор, пока не дойдет до листа, а затем разматывает и восстанавливает дерево" ). Я ошибаюсь в интерпретации того, что все еще происходит слияние двух проходов?

Вот ссылка на мою полную реализацию WeightBiasedLeftistHeap.

Вот мои неудачные попытки сделать это в F #:

type Heap<'a> =
| E
| T of int * 'a * Heap<'a> * Heap<'a> 

module WeightBiasedLeftistHeap =
    exception EmptyException

    let weight h =
        match h with
        | E -> 0
        | T(w, _,_,_) -> w

    let makeT x a b =
        let weightA = weight a
        let weightB = weight b
        if weightA >= weightB then
            T(weightA + weightB + 1, x, a, b)
        else
            T(weightA + weightB + 1, x, b, a)

    // excercise 3.4 first try
    //    let rec merge3_4 l r =
    //        match l,r with
    //        | l,E -> l
    //        | E,r -> r
    //        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
    //            if lx <= rx then
    //                let right = merge3_4 lb rh
    //                let weightA = weight la
    //                let weightB = weight right
    //
    //                if weightA >= weightB then
    //                    T(weightA + weightB + 1, lx, la, right)
    //                else
    //                    T(weightA + weightB + 1, lx, right, la)
    //            else
    //                let right = merge3_4 lh rb
    //                let weightA = weight ra
    //                let weightB = weight right
    //
    //                if weightA >= weightB then 
    //                    T(weightA + weightB + 1, rx, ra, right)
    //                else
    //                    T(weightA + weightB + 1, rx, right, ra)

    // excercise 3.4 second try (fail!)
    // this doesn't work, I couldn't figure out how to do this in a single pass
    let merge3_4 l r =
        let rec merge' l r value leftChild  =
            match l,r with
            | l,E -> makeT value leftChild l
            | E,r -> makeT value leftChild r
            | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
                if lx <= rx then
                    merge' lb rh lx la   //(fun h -> makeT(lx, la, h))
                else
                    merge' lh rb rx ra   //(fun h -> makeT(rx, ra, h))

        match l, r with
        | l, E -> l
        | E, r -> r
        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
            let lf = fun h -> makeT(lx, la, h)
            if lx <= rx then
                merge' lb rh lx la // (fun h -> makeT(lx, la, h))
            else
                merge' lh rb rx ra // (fun h -> makeT(rx, ra, h))

    let rec merge l r =
        match l,r with
        | l,E -> l
        | E,r -> r
        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
            if lx <= rx then
                makeT lx la (merge lb rh)
            else
                makeT rx ra (merge lh rb)

    let insert3_4 x h =
        merge3_4 (T(1,x,E,E)) h

Ответ 1

Первый вопрос: что представляет собой "однопроходный" алгоритм? Что-то, что можно было бы естественным образом реализовать в виде единого нисходящего цикла, было бы приемлемым. Напротив, рекурсия - обобщенная наивно - обычно имеет два прохода, один на пути вниз и один на обратном пути. Рекурсия хвоста может быть легко скомпилирована в цикл и обычно находится в функциональных языках. Рекурсия хвоста по модулю против - это аналогичная, хотя и менее распространенная, оптимизация. Но даже если ваш компилятор не поддерживает хвостовую рекурсию по модулю минус, вы можете легко преобразовать такую реализацию в цикл вручную.

Рекурсия хвоста по модулю минус похожа на обычную хвостовую рекурсию, за исключением того, что хвостовой вызов завернут в конструктор, который может быть выделен и частично заполнен перед рекурсивным вызовом. В этом случае вам нужно, чтобы возвращаемые выражения были чем-то вроде T (1+size(a)+size(b)+size(c),x,a,merge(b,c)). Ключевое понимание, требуемое здесь (как упоминалось в правлении в другом потоке SO), заключается в том, что вам не нужно выполнять слияние, чтобы узнать, насколько велика его результат и, следовательно, на какой стороне нового дерева оно должно продолжаться. Это связано с тем, что размер merge(b,c) всегда будет size(b)+size(c), который может быть вычислен за пределами слияния.

Обратите внимание, что исходная функция rank для обычных левых кучек не разделяет это свойство и поэтому не может быть оптимизирована таким образом.

По существу, тогда вы встраиваете два вызова makeT, а также конвертируете вызовы формы size(merge(b,c)) в size(b)+size(c).

Как только вы сделаете это изменение, результирующая функция будет значительно более лёгкой, чем оригинал, потому что она может вернуть корень результата перед оценкой рекурсивного слияния.

Аналогично, в параллельной среде, включающей блокировки и мутацию, новая реализация может поддерживать значительно больше concurrency путем приобретения и освобождения блокировок для каждого node по пути, а не для блокировки всего дерева. (Конечно, это будет иметь смысл только для очень легких замков.)

Ответ 2

Я не совсем уверен, правильно ли понял вопрос, но вот моя попытка - в настоящее время операция merge выполняет рекурсивный вызов merge (это первый проход) и когда он достигает конца куча (первые два случая в match), она возвращает вновь построенную кучу обратно вызывающему и вызывает makeT пару раз (это второй проход).

Я не думаю, что просто вложение mMakeT - это то, что нас просят сделать (если да, просто добавьте inline в makeT, и это будет сделано, не делая код менее читаемым: -)).

Однако можно изменить функцию merge, чтобы использовать стиль продолжения-прохода, где "остальная часть работы" передается как функция рекурсивному вызову (поэтому нет ожидающей работы над стек, который будет выполнен после завершения первого прохода). Это можно сделать следующим образом:

let rec merge' l r cont =
    match l,r with
    | l,E -> cont l // Return result by calling  the continuation
    | E,r -> cont r // (same here)
    | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
        if lx <= rx then
            // Perform recursive call and give it 'makeT' as a continuation
            merge' lb rh (makeT lx la)
        else
            // (same here)
            merge' lh rb (makeT rx ra)

// Using 'id' as a continuation, we just return the 
// resulting heap after it is constructed
let merge l r = merge' l r id

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