new file mode 100644

@@ -0,0 +1,70 @@

+(defpackage :fwoar.binary-tree

+  (:use :cl )

+  (:export ))

+(in-package :fwoar.binary-tree)

+

+(fw.lu:defclass+ bt ()

+  ((left :initarg :left :accessor left)

+   (value :initarg :value :accessor value)

+   (right :initarg :right :accessor right)))

+(defmethod print-object ((o bt) s)

+  (format s "[~s < ~s > ~s]"

+          (left o)

+          (value o)

+          (right o)))

+

+(defgeneric visit (client tree))

+(defun visit-in-order (client tree)

+  (let ((left (left tree))

+        (right (right tree)))

+    (when left

+      (visit-in-order client (left tree)))

+    (visit client tree)

+    (when right

+      (visit-in-order client (right tree))))

+  tree)

+

+(fw.lu:defclass+ counter ()

+  ((value :initform 0 :accessor value)))

+(defmethod visit ((client counter) tree)

+  (setf (value tree)

+        (value client))

+  (incf (value client)))

+

+(fw.lu:defclass+ stragglers ()

+  ((elts :initarg :elts :accessor elts)))

+(defmethod visit ((client stragglers) tree)

+  (declare (optimize (debug 3)))

+  (fw.lu:with-accessors* (elts) client

+    (when (and elts (null (left tree)))

+      (let ((n-l (pop elts))

+            (n-r (pop elts)))

+        (setf (left tree) (bt nil n-l nil))

+        (when n-r

+          (setf (right tree) (bt nil n-r nil)))))))

+

+(defmethod visit ((client (eql :print)) tree)

+  (fresh-line)

+  (prin1 (value tree))

+  (princ #\tab)

+  (prin1 tree)

+  (terpri))

+

+(defun dense-tree (levels cur)

+  (if (null cur)

+      (let ((layer (loop repeat (expt 2 (1- levels)) collect (bt nil nil nil))))

+        (dense-tree (1- levels)

+                    layer))

+      (if (> levels 0)

+          (dense-tree (1- levels)

+                      (loop for (l r) on cur by #'cddr

+                            collect (bt l nil r)))

+          (car cur))))

+

+(defun complete-bt-of-size (n)

+  (let* ((l2_n (log n 2))

+         (height (ceiling l2_n))

+         (max-node-count (1- (expt 2 height)))

+         (full-bt-size (1- (expt 2 (1- height))))

+         (leftovers (- n full-bt-size)))

+    (values height max-node-count full-bt-size leftovers)))