Построение бинарного дерева из списка (предзаказ)

Мысли, выраженные в схеме rsr5

Мои первоначальные мысли связаны с бесконечным деревом, узлами которого являются функции, которые принимают значение и дерево и вставляют это значение в это дерево в том же месте, где находится функция. Затем вы можете выполнить рекурсию fold2 по списку и пересечение дерева функций на уровне порядка, применяя последовательную функцию к последовательным элементам списка для накопления двоичного дерева. (Хотя работает только с ленивым вычислением)

Это показалось немного громоздким, поэтому я пересмотрел идею дерева данных, которое можно было бы передать функции вроде ('l' r 'l) или чему-то, что могло бы сказать, куда вставлять и индексировать.

(define (insert-new ls-and-rs tree)
  (cond ((or (empty-tree?) (null? ls-and-rs))
         (if (and (empty-tree?) (null? ls-and-rs))
             (make-tree x emptyTree emptyTree)
             (error "insert-new can only insert at emptyree")))
        ((sybol=? (car ls-and-rs) 'l)
         (make-tree (node tree) 
                    (insert-new (cdr ls-and-rs) 
                                (left-tree tree)) 
                    (right-tree tree)))
        ((sybol=? (car ls-and-rs) 'r)
         (make-tree (node tree) 
                    (left-tree tree) 
                    (insert-new (cdr ls-and-rs) 
                                (right-tree tree))))
        (else (error "insert-new expected 'l or 'r, recieved " 
                     (car ls-and-rs)))))) 

Затем я увидел, что это можно построить из самого индекса. Индекс, если 1 - это голова дерева. В противном случае, если это нечетно, это правая ветвь узла. Если хоть ветка левая. Индекс его родителя всегда равен полу дочернего элемента, разделенному на два. На основе этих знаний вы можете создать средство вставки или средства доступа просто с помощью индекса.

(define (branch-order i)
  (let loop ((i i) (accum '()))
    (cond ((i = 1) accum)
          ((odd? i) (loop (quotient i 2) (cons 'r accum)))
          (else     (loop (quotient i 2) (cons 'l accum))))))

Отсюда простая рекурсия

 (define (list->tree list)
   (let loop ((list list) (i 1) (tree emptyTree))
     (cond ((null? list) tree)
           (else (loop (cdr list)
                       (+ i 1)
                       (insert-new (branch-order i) tree))))))

Конечно, самый простой способ - принять двоичное дерево минимальной глубины. В дереве глубины помимо узлов и ветвей указывается минимальная глубина. Затем вставка будет вставлена ​​в левое поддерево, если минимальная глубина правого поддерева не будет меньше, чем у левого.

(define (list->d-tree list)
  (fold-left (flip balanced-insert) emptyTree list))

(define (balanced-insert x d-tree)
  (cond ((= 0 (d-d-tree d-tree)) 
        (mk-d-tree x emptyTree emptyTree)
       ((= 1 (- (d-d-tree d-tree) (d-d-tree (l-d-tree d-tree))))
        (mk-d-tree (n-d-tree d-tree)
                   (balanced-insert x (l-d-tree d-tree))
                   (r-d-tree d-dtree)))
      (else 
       (mk-d-tree (n-d-tree d-tree)
                  (l-d-tree d-tree)
                  (balanced-insert x (r-d-tree d-dtree))))))

(define (mk-d-tree n l r)
 (let ((d-l (d-d-tree l))
       (d-r (d-d-tree r)))
 (list n l r (+ 1 (min d-l d-r)))))
(define (n-d-tree d-tree)
 (car d-tree))
(define (l-d-tree d-tree)
 (cadr d-tree))
(define (r-d-tree d-tree)
 (caddr d-tree))
(define (d-d-tree d-tree)
 (if emptyTree? d-tree)
     0
     (cadddr d-tree)))
(define (emptyTree? tree)
       (null? tree))
(define emptyTree '())

(define (flip f)
 (lambda (a b)
   (f b a)))

TLdr; используйте дерево минимальной глубины и вставьте до крайнего левого края минимальной глубины.