binary.clj

(ns binary-tree.mutable)

;; --- Selector Functions ---

(defn kv-of    [bt] (first @bt))
(defn key-of   [bt] (first (first @bt)))
(defn val-of   [bt] (second (first @bt)))
(defn left-of  [bt] (nth @bt 1))
(defn right-of [bt] (nth @bt 2))

;; New empty binary tree node/wrapper
(defn bt-new [] (atom nil))

;; --- Navigation & Search ---

;; Find minimum key-val pair
(defn bt-min [bt default-kv]
  (if @bt
    (recur (left-of bt) (kv-of bt))
    default-kv))

;; Find maximum key-val pair
(defn bt-max [bt default-kv]
  (if @bt
    (recur (right-of bt) (kv-of bt))
    default-kv))

;; Find the value of a key
(defn bt-find [bt key]
  (if @bt
    (cond
      (< key (key-of bt)) (recur (left-of bt) key)
      (< (key-of bt) key) (recur (right-of bt) key)
      :else               (val-of bt))
    nil))

;; --- Destructive Insertion ---

;; Insert key with val in the binary tree
(defn bt-ins [bt key val]
  (if @bt
    (cond
      (< key (key-of bt)) (bt-ins (left-of bt) key val)
      (< (key-of bt) key) (bt-ins (right-of bt) key val)
      :else               ;; In-place mutation equivalent to set-cdr! on the kv pair
                          (let [[k _] (kv-of bt)
                                l     (left-of bt)
                                r     (right-of bt)]
                            (reset! bt [[k val] l r])))
    ;; Base case: equivalent to set-car! on an empty parent reference slot
    (reset! bt [[key val] (atom nil) (atom nil)])))

;; --- Destructive Deletion ---

;; Delete key from the binary tree, return its original value
(defn bt-del [bt key]
  (if @bt
    (cond
      (< key (key-of bt)) (bt-del (left-of bt) key)
      (< (key-of bt) key) (bt-del (right-of bt) key)
      :else
      (let [old-val (val-of bt)]
        (if @(left-of bt)
          (if @(right-of bt)
            ;; Case: Node has two children. Replace with successor min and delete min.
            (let [min-kv (bt-min (right-of bt) (kv-of bt))
                  l      (left-of bt)
                  r      (right-of bt)]
              (reset! bt [min-kv l r])
              (bt-del (right-of bt) (first min-kv)))
            ;; Case: Only left child exists. Splice it up (set-car! equivalent)
            (reset! bt @(left-of bt)))
          ;; Case: Only right child or no children exist
          (reset! bt @(right-of bt)))
        old-val))
    nil))

;; --- Utility and Iteration ---

;; Apply function f to each [key val] pair (In-order traversal)
(defn bt-walk [bt f]
  (when @bt
    (bt-walk (left-of bt) f)
    (f (kv-of bt))
    (bt-walk (right-of bt) f)))

;; Add a sequence of [key val] vectors to a binary tree
(defn env->bt [bt env]
  (doseq [[k v] env]
    (bt-ins bt k v)))

;; Extract all [key val] pairs from a binary tree, preserving the structure
(defn bt->env [bt]
  (letfn [(ex [node acc]
            (if @node
              (ex (left-of node) (cons (kv-of node) (ex (right-of node) acc)))
              acc))]
    (ex bt '())))