OCaml глубина бинарного дерева, без переполнения стека

Question

У меня есть следующие реализации для бинарного дерева и функции глубины, чтобы вычислить его глубину:

type 'a btree = 
| Empty 
| Node of 'a * 'a btree * 'a btree;; 

let rec depth t = match t with 
| Empty -> 0 
| Node (_, t1, t2) -> 1 + Int.max (depth t1) (depth t2) 

Проблема здесь состоит в том, что «глубина» является рекурсивной и может вызвать переполнение стека, когда дерево слишком велико.

Я прочитал о рекурсии хвоста и о том, как его можно оптимизировать в цикле while компилятором, чтобы удалить вызов стека.

Как бы вы сделали эту функцию хвостом рекурсивной или вместо этого использовали цикл while/for?

Answer 1

type 'a btree = 
| Empty 
| Node of 'a * 'a btree * 'a btree;; 

let max x y = if x > y then x else y 

let depth t = 
    let rec dep m = function (* d records current level, m records max depth so far *) 
    | [] -> m 
    | (Empty,d)::tl -> dep (max m d) tl 
    | (Node (_,l,r),d)::tl -> dep (max m d) ((l,d+1)::(r,d+1)::tl) 
    in 
    dep 0 [(t,0)] 

В принципе, вам нужно 3 вещи:

1. список (стек) для хранения узлов вдоль путей
2. индикатор для записи текущей глубины
3. текущую глубину макс до сих пор

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

Для хвостовой рекурсии вам необходимо найти способ явного хранения временных данных, сгенерированных на каждом этапе рекурсии.

Для явного стека помните, что рекурсия может работать, потому что внутри она использует стек с ограниченным размером. Если мы проанализируем логику и сделаем этот стек явным, нам больше не понадобится этот внутренний стек.

Answer 2

В прагматических случаях решение заключается в использовании сбалансированного дерева, которое ограничивает глубину до нескольких кратных log (n). Даже для очень большого n log (n) достаточно мал, чтобы вы не выходили из пространства стека.

В противном случае см. Страницу SO, связанную с Kadaku. У этого есть смехотворно хорошие ответы на вопрос.

Answer 3

Я уже ответил на аналогичный вопрос один раз. Перепроведение решения:

Там в чистый виде и общее решение с использованием fold_tree и КП - непрерывное прохождение стиль:

let fold_tree tree f acc = 
    let loop t cont = 
    match tree with 
    | Leaf -> cont acc 
    | Node (x, left, right) -> 
     loop left (fun lacc -> 
     loop right (fun racc -> 
      cont @@ f x lacc racc)) 
    in loop tree (fun x -> x) 

let depth tree = fold_tree tree (fun x dl dr -> 1 + (max dl dr)) 0