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