
(defvar avl-all-nodes (make-vector 100 nil))
(defvar avl-root-node nil "root node")

(defun avl-create-node (key parent)
  (copy-tree `((:key . ,key) (:balance . nil) (:height . nil)
	       (:left . nil) (:right . nil) (:parent . ,parent))))

(defun avl-node (pos)
  (if (or (null pos) (> pos (1- (length avl-all-nodes))))
      nil
    (aref avl-all-nodes pos)))

(defun avl-node-prop (noderef &rest props)
  (if (null noderef)
      nil
    (progn
      ;;(when (integerp noderef) (setq node (avl-node node)))
      (let ((val noderef))
        (dolist (prop props)
          (if (null (avl-node val))
	      (setq val nil)
	    (progn
	      (setq val (alist-get prop (avl-node val))))))
        val)
      )
    )
  )


(defun avl-set-prop (node &rest props-and-value)
  (when (integerp node) (setq node (avl-node node)))
  (when (< (length props-and-value) 2)
    (error "Both property name and value must be given."))
  (let (noderef (props (seq-take props-and-value (1- (length props-and-value))))
                (value (seq-elt props-and-value (1- (length props-and-value)))))
    (when (> (length props) 0)
      (dolist (prop (seq-take props (1- (length props))))
	(if (null node)
	    (progn (setq noderef nil) (setq node nil))
	  (progn
	    (setq noderef (alist-get prop node))
	    (setq node (avl-node noderef))))))
    
    (if (or (null (last props)) (null node))
	nil
      (setcdr (assoc (car (last props)) node) value))))


(defun avl-height (noderef)
  (or (avl-node-prop noderef :height) -1))

(defun avl-reheight (noderef)
  (if (null noderef)
      nil
    (avl-set-prop noderef :height
                  (1+ (max (avl-height (avl-node-prop noderef :left))
		           (avl-height (avl-node-prop noderef :right)))))))

(defun avl-setbalance (noderef)
  ;;(when (integerp node) (setq node (avl-node node)))
  (avl-reheight noderef)
  (avl-set-prop noderef :balance
		(- (avl-height (avl-node-prop noderef :right))
		   (avl-height (avl-node-prop noderef :left)))))

(defun avl-add-node (key parent)
  (let (result (idx 0))
    (cl-loop for idx from 0 to (1- (seq-length avl-all-nodes))
             while (null result) do
             (when (null (aref avl-all-nodes idx))
	       (aset avl-all-nodes idx (avl-create-node key parent))
	       (setq result idx)))
    result))

(defun avl-insert (key)
  (if (null avl-root-node)
      (progn (setq avl-root-node (avl-add-node key nil)) avl-root-node)
    (progn
      (let ((n avl-root-node) (end-loop nil) parent go-left result)
	(while (not end-loop)
	  (if (equal key (avl-node-prop n :key))
	      (setq end-loop 't)
	    (progn
	      (setq parent n)
	      (setq go-left (> (avl-node-prop n :key) key))
	      (setq n (if go-left
                          (avl-node-prop n :left)
                        (avl-node-prop n :right)))
	      
	      (when (null n)
                (setq result (avl-add-node key parent))
		(if go-left
		    (progn
		      (avl-set-prop parent :left result))
		  (progn
		    (avl-set-prop parent :right result)))
		(avl-rebalance parent) ;;rebalance
		(setq end-loop 't)))))
	result))))


(defun avl-rotate-left (noderef)
  (when (not (integerp noderef)) (error "parameter must be an integer"))
  (let ((a noderef) b)
    (setq b (avl-node-prop a :right))
    (avl-set-prop b :parent (avl-node-prop a :parent))

    (avl-set-prop a :right (avl-node-prop b :left))

    (when (avl-node-prop a :right) (avl-set-prop a :right :parent a))

    (avl-set-prop b :left a)
    (avl-set-prop a :parent b)

    (when (not (null (avl-node-prop b :parent)))
      (if (equal (avl-node-prop b :parent :right) a)
          (avl-set-prop b :parent :right b)
        (avl-set-prop b :parent :left b)))

    (avl-setbalance a)
    (avl-setbalance b)
    b))



(defun avl-rotate-right (node-idx)
  (when (not (integerp node-idx)) (error "parameter must be an integer"))
  (let ((a node-idx) b)
    (setq b (avl-node-prop a :left))
    (avl-set-prop b :parent (avl-node-prop a :parent))

    (avl-set-prop a :left (avl-node-prop b :right))

    (when (avl-node-prop a :right) (avl-set-prop a :right :parent a))

    (avl-set-prop b :left a)
    (avl-set-prop a :parent b)

    (when (not (null (avl-node-prop b :parent)))
      (if (equal (avl-node-prop b :parent :right) a)
          (avl-set-prop b :parent :right b)
        (avl-set-prop b :parent :left b)))

    (avl-setbalance a)
    (avl-setbalance b)
    b))

(defun avl-rotate-left-then-right (noderef)
  (avl-set-prop noderef :left (avl-rotate-left (avl-node-prop noderef :left)))
  (avl-rotate-right noderef))

(defun avl-rotate-right-then-left (noderef)
  (avl-set-prop noderef :right (avl-rotate-left (avl-node-prop noderef :right)))
  (avl-rotate-left noderef))

(defun avl-rebalance (noderef)
  (avl-setbalance noderef)
  (cond
   ((equal -2 (avl-node-prop noderef :balance))
    (if (>= (avl-height (avl-node-prop noderef :left :left))
	    (avl-height (avl-node-prop noderef :left :right)))
	(setq noderef (avl-rotate-right noderef))
      (setq noderef (avl-rotate-left-then-right noderef)))
    )
   ((equal 2 (avl-node-prop noderef :balance))
    (if (>= (avl-height (avl-node-prop noderef :right :right))
	    (avl-height (avl-node-prop noderef :right :left)))
	(setq noderef (avl-rotate-left noderef))
      (setq noderef (avl-rotate-right-then-left noderef)))))
  
  (if (not (null (avl-node-prop noderef :parent)))
      (avl-rebalance (avl-node-prop noderef :parent))
    (setq avl-root-node noderef)))


(defun avl-delete (noderef)
  (when noderef
    (when (and (null (avl-node-prop noderef :left))
               (null (avl-node-prop noderef :right)))
      (if (null (avl-node-prop noderef :parent))
          (setq avl-root-node nil)
        (let ((parent (avl-node-prop noderef :parent)))
          (if (equal noderef (avl-node-prop parent :left))
              (avl-set-prop parent :left nil)
            (avl-set-prop parent :right nil))
          (avl-rebalance parent))))

    (if (not (null (avl-node-prop noderef :left)))
        (let ((child (avl-node-prop noderef :left)))
          (while (not (null (avl-node-prop child :right)))
            (setq child (avl-node-prop child :right)))
          (avl-set-prop noderef :key (avl-node-prop child :key))
          (avl-delete child))
      (let ((child (avl-node-prop noderef :right)))
        (while (not (null (avl-node-prop child :left)))
          (setq child (avl-node-prop child :left)))
        (avl-set-prop noderef :key (avl-node-prop child :key))
        (avl-delete child)))))

;; Main procedure
(let ((cnt 10) balances)
  (fillarray avl-all-nodes nil)
  (setq avl-root-node nil)

  (dotimes (val cnt)
    (avl-insert (1+ val)))

  (setq balances (seq-map (lambda (x) (or (avl-node-prop x :balance) 0))
			  (number-sequence 0 (1- cnt))))

  (message "Inserting values 1 to %d" cnt)
  (message "Printing balance: %s" (string-join (seq-map (lambda (x) (format "%S" x)) balances) " ")))

;; Output:
;; Inserting values 1 to 10
;; Printing balance: 0 0 0 1 0 1 0 0 0 0

