Rosetta Code

AVL tree: Difference between revisions

Page Discussion

AVL tree (view source)

Revision as of 09:12, 16 December 2023

16,912 bytes added ,  5 months ago
Add Emacs Lisp
m (→‎{{header|Logtalk}}: Test formatting.)
(Add Emacs Lisp)
 
(3 intermediate revisions by 2 users not shown)
Line 4,379:
(randoms (loop repeat 1000000 collect (random 100.0))))
(loop for key in randoms do (setf (gettree key tree) key))))</syntaxhighlight>
 
=={{header|Component Pascal}}==
{{works with|BlackBox Component Builder}}
 
Two modules are provided - one for implementing and one for using AVL trees
<syntaxhighlight lang="oberon2">
MODULE RosettaAVLTrees;
 
(* An implementation of persistent AVL Trees *)
 
TYPE
Order = ABSTRACT RECORD END;
Tree* = POINTER TO Node;
Node* = ABSTRACT RECORD (Order)
left, right: Tree;
height: INTEGER
END; (* Contains the left and right child nodes and the height of the node *)
 
Out* = ABSTRACT RECORD END; (* Used for output by the `Draw` procedure *)
 
Void = RECORD (Order) END; (* Used by the `Ordered` procedure *)
 
(* The following abstract procedures must be implemented by a user of `Node` *)
(* They must be implemented correctly for the AVL tree to work *)
 
(* Compares one node with another and returns a boolean value based on which is less *)
PROCEDURE (IN n: Order) Less- (IN m: Node): BOOLEAN, NEW, ABSTRACT;
(* Compares one node with another and returns a boolean value based on which is more *)
PROCEDURE (IN n: Order) More- (IN m: Node): BOOLEAN, NEW, ABSTRACT;
(* Creates a new root node *)
PROCEDURE (IN n: Node) Alloc- (): Tree, NEW, ABSTRACT;
 
(* Returns TRUE if n is in the tree t, FALSE otherwise *)
PROCEDURE (IN n: Node) Lookup* (t: Tree): BOOLEAN, NEW;
BEGIN
IF t = NIL THEN RETURN FALSE END;
IF n.Less(t) THEN RETURN n.Lookup(t.left) END;
IF n.More(t) THEN RETURN n.Lookup(t.right) END;
RETURN TRUE
END Lookup;
 
(* Returns the height of the AVL tree t *)
PROCEDURE Height (t: Tree): INTEGER;
BEGIN
IF t = NIL THEN RETURN 0 END;
RETURN t.height
END Height;
 
(* Creates and returns a new Node with the given children *)
PROCEDURE (IN n: Node) New (left, right: Tree): Tree, NEW;
VAR t: Tree;
BEGIN
t := n.Alloc(); (* Create a new root node *)
t.left := left; t.right := right; (* set the children *)
(* set the height of the node based on its children *)
t.height := MAX(Height(left), Height(right)) + 1;
RETURN t
END New;
 
(* Returns the difference in height between the left and right children of a node *)
PROCEDURE Slope (l, r: Tree): INTEGER;
BEGIN RETURN Height(l) - Height(r) END Slope;
 
(* Returns an AVL tree if it is right-heavy *)
PROCEDURE (IN n: Node) BalL (l, r: Tree): Tree, NEW;
BEGIN
IF Slope(l, r) = - 2 THEN
IF Slope(r.left, r.right) = 1 THEN
RETURN r.left.New(n.New(l, r.left.left),
r.New(r.left.right, r.right))
END;
RETURN r.New(n.New(l, r.left), r.right)
END;
RETURN n.New(l, r)
END BalL;
 
(* Returns an AVL tree if it is left-heavy *)
PROCEDURE (IN n: Node) BalR (l, r: Tree): Tree, NEW;
BEGIN
IF Slope(l, r) = 2 THEN
IF Slope(l.left, l.right) = - 1 THEN
RETURN l.right.New(l.New(l.left, l.right.left),
n.New(l.right.right, r))
END;
RETURN l.New(l.left, n.New(l.right, r))
END;
RETURN n.New(l, r)
END BalR;
 
(* Returns the AVL tree t with the node n *)
PROCEDURE (IN n: Node) Insert* (t: Tree): Tree, NEW;
BEGIN
IF t = NIL THEN RETURN n.New(NIL, NIL) END;
IF n.Less(t) THEN RETURN t.BalR(n.Insert(t.left), t.right) END;
IF n.More(t) THEN RETURN t.BalL(t.left, n.Insert(t.right)) END;
RETURN t
END Insert;
 
(* Returns the leftmost node of the non-empty tree t *)
PROCEDURE (t: Tree) Head (): Tree, NEW;
BEGIN
IF t.left = NIL THEN RETURN t END;
RETURN t.left.Head()
END Head;
 
(* Returns the rightmost node of the non-empty tree t *)
PROCEDURE (t: Tree) Last (): Tree, NEW;
BEGIN
IF t.right = NIL THEN RETURN t END;
RETURN t.right.Last()
END Last;
 
(* Returns the AVL tree t without the leftmost node *)
PROCEDURE (IN t: Node) Tail* (): Tree, NEW;
BEGIN
IF t.left = NIL THEN RETURN t.right END;
RETURN t.BalL(t.left.Tail(), t.right)
END Tail;
 
(* Returns the AVL tree t without the rightmost node *)
PROCEDURE (IN t: Node) Init* (): Tree, NEW;
BEGIN
IF t.right = NIL THEN RETURN t.left END;
RETURN t.BalR(t.left, t.right.Init())
END Init;
 
(* Returns the AVL tree t without node n *)
PROCEDURE (IN n: Node) Delete* (t: Tree): Tree, NEW;
BEGIN
IF t = NIL THEN RETURN NIL END;
IF n.Less(t) THEN RETURN t.BalL(n.Delete(t.left), t.right) END;
IF n.More(t) THEN RETURN t.BalR(t.left, n.Delete(t.right)) END;
IF Slope(t.left, t.right) = 1 THEN
RETURN t.left.Last().BalL(t.left.Init(), t.right)
END;
IF t.right = NIL THEN RETURN t.left END;
RETURN t.right.Head().BalR(t.left, t.right.Tail())
END Delete;
 
(* The following procedures are used for debugging *)
 
PROCEDURE (IN n: Void) Less- (IN m: Node): BOOLEAN;
BEGIN RETURN TRUE END Less;
 
PROCEDURE (IN n: Void) More- (IN m: Node): BOOLEAN;
BEGIN RETURN TRUE END More;
 
(* Returns TRUE if the AVL tree t is ordered, FALSE otherwise *)
PROCEDURE Ordered* (t: Tree): BOOLEAN;
VAR void: Void;
 
PROCEDURE Bounded (IN lo, hi: Order; t: Tree): BOOLEAN;
BEGIN
IF t = NIL THEN RETURN TRUE END;
RETURN lo.Less(t) & hi.More(t) &
Bounded(lo, t, t.left) & Bounded(t, hi, t.right)
END Bounded;
 
BEGIN RETURN Bounded(void, void, t) END Ordered;
 
(* The following abstract procedures must be implemented by a user of `Out` *)
 
(* Writes a string *)
PROCEDURE (IN o: Out) Str- (s: ARRAY OF CHAR), NEW, ABSTRACT;
(* Writes an integer *)
PROCEDURE (IN o: Out) Int- (i: INTEGER), NEW, ABSTRACT;
(* Writes a new-line *)
PROCEDURE (IN o: Out) Ln-, NEW, ABSTRACT;
(* Writes a node *)
PROCEDURE (IN o: Out) Node- (IN n: Node), NEW, ABSTRACT;
 
(* Writes a tree (rotated) *)
PROCEDURE (IN o: Out) Draw* (t: Tree), NEW;
 
PROCEDURE Bars (bars, bar: ARRAY OF CHAR);
BEGIN
IF LEN(bars + bar) # 0 THEN o.Str(bars + "+--") END
END Bars;
 
PROCEDURE Do (lBar, rBar, bars: ARRAY OF CHAR; t: Tree);
BEGIN
IF t = NIL THEN Bars(bars, lBar); o.Str("|"); o.Ln
ELSIF (t.left = NIL) & (t.right = NIL) THEN
Bars(bars, lBar); o.Node(t); o.Ln
ELSE
Do("| ", " ", bars + rBar, t.right);
o.Str(bars + rBar + "|"); o.Ln;
Bars(bars, lBar); o.Node(t);
IF Slope(t.left, t.right) # 0 THEN
o.Str(" ["); o.Int(Slope(t.left, t.right)); o.Str("]")
END;
o.Ln;
o.Str(bars + lBar + "|"); o.Ln;
Do(" ", "| ", bars + lBar, t.left)
END
END Do;
 
BEGIN
Do("", "", "", t)
END Draw;
 
END RosettaAVLTrees.
</syntaxhighlight>
Interface extracted from implementation:
<syntaxhighlight lang="oberon2">
DEFINITION RosettaAVLTrees;
 
TYPE
Tree = POINTER TO Node;
Node = ABSTRACT RECORD (Order)
(IN n: Node) Alloc- (): Tree, NEW, ABSTRACT;
(IN n: Node) Delete (t: Tree): Tree, NEW;
(IN t: Node) Init (): Tree, NEW;
(IN n: Node) Insert (t: Tree): Tree, NEW;
(IN n: Node) Lookup (t: Tree): BOOLEAN, NEW;
(IN t: Node) Tail (): Tree, NEW
END;
 
Out = ABSTRACT RECORD
(IN o: Out) Draw (t: Tree), NEW;
(IN o: Out) Int- (i: INTEGER), NEW, ABSTRACT;
(IN o: Out) Ln-, NEW, ABSTRACT;
(IN o: Out) Node- (IN n: Node), NEW, ABSTRACT;
(IN o: Out) Str- (s: ARRAY OF CHAR), NEW, ABSTRACT
END;
 
PROCEDURE Ordered (t: Tree): BOOLEAN;
 
END RosettaAVLTrees.
</syntaxhighlight>
Module that uses previous module:
<syntaxhighlight lang="oberon2">
MODULE RosettaAVLTreesUse;
 
IMPORT Set := RosettaAVLTrees, Log := StdLog;
 
TYPE
Height = RECORD (Set.Node) height: INTEGER END;
(* Note that Set.Node already contains an integer field `height`. *)
(* It does not cause a duplicate field error as it is hidden from this module *)
 
Out = RECORD (Set.Out) END; (* Used for output by the `Draw` procedure *)
 
(* The following three procedures are implemented here for use by Set.Node *)
 
(* Compares one node with another and returns a boolean value based on which is less *)
PROCEDURE (IN h: Height) Less- (IN n: Set.Node): BOOLEAN;
BEGIN RETURN h.height < n(Height).height END Less;
 
(* Compares one node with another and returns a boolean value based on which is more *)
PROCEDURE (IN h: Height) More- (IN n: Set.Node): BOOLEAN;
BEGIN RETURN h.height > n(Height).height END More;
 
(* Creates a new root node *)
PROCEDURE (IN h: Height) Alloc- (): Set.Tree;
VAR r: POINTER TO Height;
BEGIN NEW(r); r.height := h.height; RETURN r END Alloc;
 
(* The following four procedures are implemented here for use by Set.Out *)
 
(* Writes a string *)
PROCEDURE (IN o: Out) Str- (s: ARRAY OF CHAR);
BEGIN Log.String(s) END Str;
 
(* Writes an integer *)
PROCEDURE (IN o: Out) Int- (i: INTEGER);
BEGIN Log.IntForm(i, Log.decimal, 0, ' ', Log.hideBase) END Int;
 
(* Writes a new-line *)
PROCEDURE (IN o: Out) Ln-; BEGIN Log.Ln END Ln;
 
(* Writes a node *)
PROCEDURE (IN o: Out) Node- (IN n: Set.Node);
BEGIN
Log.IntForm(n(Height).height, Log.decimal, 0, ' ', Log.hideBase)
END Node;
 
PROCEDURE Use*;
TYPE BAD = POINTER TO Height;
VAR h: Height; hs, save: Set.Tree; i: INTEGER; o: Out;
BEGIN
h.height := 10; hs := h.Insert(hs);
FOR i := 0 TO 9 DO h.height := i; hs := h.Insert(hs) END;
o.Draw(hs); Log.Ln; Log.Ln;
save := hs;
FOR i := 0 TO 9 DO h.height := i; hs := h.Delete(hs) END;
o.Draw(hs); Log.Ln; Log.Ln;
o.Draw(save); Log.Ln; Log.Ln; (* Tree demonstrates persistence *)
ASSERT(Set.Ordered(save)); (* This ASSERT succeeds *)
save(BAD).height := 11; (* UNSAFE STATEMENT *)
o.Draw(save);
ASSERT(Set.Ordered(save)) (* This ASSERT fails *)
END Use;
 
END RosettaAVLTreesUse.
</syntaxhighlight>
Execute: ^Q RosettaAVLTreesUse.Use
{{out}}
<pre>
+--10
|
+--9
| |
| +--8
|
+--7
| |
| | +--6
| | |
| +--5
| |
| +--4
|
3 [-1]
|
| +--2
| |
+--1
|
+--0
 
 
10
 
 
+--10
|
+--9
| |
| +--8
|
+--7
| |
| | +--6
| | |
| +--5
| |
| +--4
|
3 [-1]
|
| +--2
| |
+--1
|
+--0
 
 
+--10
|
+--9
| |
| +--8
|
+--7
| |
| | +--6
| | |
| +--5
| |
| +--4
|
11 [-1]
|
| +--2
| |
+--1
|
+--0
</pre>
 
=={{header|D}}==
Line 4,580 ⟶ 4,950:
<pre>Inserting values 1 to 10
Printing balance: 0 0 0 1 0 0 0 0 1 0 </pre>
 
=={{header|Emacs Lisp}}==
{{trans|Java}}
<syntaxhighlight lang="lisp">
 
(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) " ")))
</syntaxhighlight>
 
{{out}}
<pre>
Inserting values 1 to 10
Printing balance: 0 0 0 1 0 1 0 0 0 0
</pre>
 
=={{header|Fortran}}==
Line 14,062 ⟶ 14,656:
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="ecmascriptwren">class Node {
construct new(key, parent) {
_key = key
Yong
59

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/342943...352103"