funds-cvs August 2007

funds-cvs@common-lisp.net

1 participants
113 discussions

[funds-cvs] r104 - trunk/funds/src/trees
by abaine＠common-lisp.net 02 Aug '07

02 Aug '07

Author: abaine Date: Thu Aug 2 11:37:48 2007 New Revision: 104 Modified: trunk/funds/src/trees/avl.lisp Log: Renamed stitch-avl-tree. Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Thu Aug 2 11:37:48 2007 @@ -36,7 +36,7 @@ (defun balance (inside root outside &key heavy-side) (let ((other-side (other-side heavy-side))) (if (balanced-p inside outside) - (stitch-avl-nodes :root root + (stitch-avl-tree :root root heavy-side outside other-side inside) (rotate inside root @@ -50,15 +50,15 @@ (defun rotate (inside root outside &key side) (let* ((t1 (tree-child outside :side side)) - (new-inside (stitch-avl-nodes :root root + (new-inside (stitch-avl-tree :root root side inside (other-side side) t1)) (new-outside (tree-child outside :side (other-side side)))) - (stitch-avl-nodes :root outside + (stitch-avl-tree :root outside side new-inside (other-side side) new-outside))) -(defun stitch-avl-nodes (&key root (key (bt-key root)) (value (bt-value root)) +(defun stitch-avl-tree (&key root (key (bt-key root)) (value (bt-value root)) (left (make-avl-leaf)) (right make-avl-leaf)) (make-instance 'avl-tree :key key :value value

1 0

[funds-cvs] r103 - trunk/funds/src/trees
by abaine＠common-lisp.net 02 Aug '07

02 Aug '07

Author: abaine Date: Thu Aug 2 11:35:58 2007 New Revision: 103 Modified: trunk/funds/src/trees/avl.lisp trunk/funds/src/trees/tree-insert.lisp Log: Added default left and right keywords in stitch-avl-nodes. Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Thu Aug 2 11:35:58 2007 @@ -59,7 +59,7 @@ (other-side side) new-outside))) (defun stitch-avl-nodes (&key root (key (bt-key root)) (value (bt-value root)) - left right) + (left (make-avl-leaf)) (right make-avl-leaf)) (make-instance 'avl-tree :key key :value value :left left :right right Modified: trunk/funds/src/trees/tree-insert.lisp ============================================================================== --- trunk/funds/src/trees/tree-insert.lisp (original) +++ trunk/funds/src/trees/tree-insert.lisp Thu Aug 2 11:35:58 2007 @@ -33,8 +33,8 @@ (defmethod tree-insert ((tree avl-leaf) key value &key test order) (declare (ignore test order)) - (make-avl-tree :key key - :value value)) + (stitch-avl-tree :key key + :value value)) (defmethod tree-insert ((tree binary-tree) key value &key (test #'eql) (order #'<))

1 0

[funds-cvs] r102 - trunk/funds/src/trees
by abaine＠common-lisp.net 02 Aug '07

02 Aug '07

Author: abaine Date: Thu Aug 2 11:31:15 2007 New Revision: 102 Modified: trunk/funds/src/trees/avl.lisp Log: Added function stitch-avl-nodes to replace attach-avl. Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Thu Aug 2 11:31:15 2007 @@ -36,9 +36,9 @@ (defun balance (inside root outside &key heavy-side) (let ((other-side (other-side heavy-side))) (if (balanced-p inside outside) - (attach-avl root - heavy-side outside - other-side inside) + (stitch-avl-nodes :root root + heavy-side outside + other-side inside) (rotate inside root (if (heavier-p outside :side other-side) (rotate (tree-child outside :side heavy-side) @@ -50,13 +50,20 @@ (defun rotate (inside root outside &key side) (let* ((t1 (tree-child outside :side side)) - (new-inside (attach-avl root - side inside - (other-side side) t1)) + (new-inside (stitch-avl-nodes :root root + side inside + (other-side side) t1)) (new-outside (tree-child outside :side (other-side side)))) - (attach-avl outside - side new-inside - (other-side side) new-outside))) + (stitch-avl-nodes :root outside + side new-inside + (other-side side) new-outside))) + +(defun stitch-avl-nodes (&key root (key (bt-key root)) (value (bt-value root)) + left right) + (make-instance 'avl-tree + :key key :value value + :left left :right right + :height (parent-height left right))) (defun attach-avl (root &key (right (make-avl-tree)) (left (make-avl-tree))) (make-avl-tree :key (bt-key root)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

funds-cvs August 2007