funds-cvs

funds-cvs@common-lisp.net

225 discussions

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

02 Aug '07

Author: abaine Date: Thu Aug 2 12:14:58 2007 New Revision: 108 Modified: trunk/funds/src/trees/tree-insert.lisp Log: Corrected make-avl-tree to stitch-avl-tree. 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 12:14:58 2007 @@ -55,10 +55,10 @@ (defmethod tree-insert ((tree avl-tree) key value &key (test #'eql) (order #'<)) (if (funcall test key (bt-key tree)) - (make-avl-tree :key key - :value value - :left (bt-left tree) - :right (bt-right tree)) + (stitch-avl-tree :key key + :value value + :left (bt-left tree) + :right (bt-right tree)) (let* ((temp (call-next-method)) (side (side-to-insert tree key :order order)) (outside (tree-child temp :side side))

1 0

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

02 Aug '07

Author: abaine Date: Thu Aug 2 12:14:20 2007 New Revision: 107 Modified: trunk/funds/src/trees/avl.lisp Log: Corrected nesting problem. Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Thu Aug 2 12:14:20 2007 @@ -59,7 +59,7 @@ (other-side side) new-outside))) (defun stitch-avl-tree (&key root (key (bt-key root)) (value (bt-value root)) - (left (make-avl-leaf)) (right make-avl-leaf)) + (left (make-avl-leaf)) (right (make-avl-leaf))) (make-instance 'avl-tree :key key :value value :left left :right right

1 0

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

02 Aug '07

Author: abaine Date: Thu Aug 2 11:41:43 2007 New Revision: 106 Modified: trunk/funds/src/trees/tree-remove.lisp Log: Cosmetic. Modified: trunk/funds/src/trees/tree-remove.lisp ============================================================================== --- trunk/funds/src/trees/tree-remove.lisp (original) +++ trunk/funds/src/trees/tree-remove.lisp Thu Aug 2 11:41:43 2007 @@ -47,8 +47,8 @@ (if (tree-empty-p temp) (make-avl-tree) (let* ((heavy-side (if (heavier-p temp :side :left) - :left - :right)) + :left + :right)) (inside (tree-child temp :side (other-side heavy-side))) (outside (tree-child temp :side heavy-side))) (balance inside temp outside :heavy-side heavy-side)))))

1 0

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

02 Aug '07

Author: abaine Date: Thu Aug 2 11:39:01 2007 New Revision: 105 Modified: trunk/funds/src/trees/avl.lisp Log: Deleted attach-avl and make-avl-node, which are obviated by 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:39:01 2007 @@ -64,17 +64,3 @@ :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) - :value (bt-key root) - :right right - :left left)) - -(defun make-avl-node (&key key value (left make-avl-tree) (right make-avl-tree)) - (make-instance 'avl-tree - :key key - :value value - :left left - :right right - :height (parent-height left right)))

1 0

[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

[funds-cvs] r101 - trunk/funds/src/trees
by abaine＠common-lisp.net 31 Jul '07

31 Jul '07

Author: abaine Date: Tue Jul 31 11:54:33 2007 New Revision: 101 Modified: trunk/funds/src/trees/avl.lisp Log: Added &key arguments to make-avl-node. Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Tue Jul 31 11:54:33 2007 @@ -64,7 +64,7 @@ :right right :left left)) -(defun make-avl-node (key value left right) +(defun make-avl-node (&key key value (left make-avl-tree) (right make-avl-tree)) (make-instance 'avl-tree :key key :value value

1 0

[funds-cvs] r100 - trunk/funds/src/trees
by abaine＠common-lisp.net 31 Jul '07

31 Jul '07

Author: abaine Date: Tue Jul 31 11:49:46 2007 New Revision: 100 Modified: trunk/funds/src/trees/constructors.lisp Log: Hid functionality of constructor by simplifying make-avl-tree. Modified: trunk/funds/src/trees/constructors.lisp ============================================================================== --- trunk/funds/src/trees/constructors.lisp (original) +++ trunk/funds/src/trees/constructors.lisp Tue Jul 31 11:49:46 2007 @@ -33,16 +33,8 @@ (defun make-binary-tree () (make-bt-leaf)) -(defun make-avl-tree (&key (key nil k-p) (value nil) - (left (make-avl-leaf)) (right (make-avl-leaf))) - (if k-p - (make-instance 'avl-tree - :key key - :value value - :left left - :right right - :height (parent-height left right)) - (make-avl-leaf))) +(defun make-avl-tree () + (make-avl-leaf)) (defun make-heap (&key (priority 0 p-p) value (left (make-heap-leaf)) (right (make-heap-leaf)))

1 0

[funds-cvs] r99 - trunk/funds/src/trees
by abaine＠common-lisp.net 31 Jul '07

31 Jul '07

Author: abaine Date: Tue Jul 31 11:47:57 2007 New Revision: 99 Modified: trunk/funds/src/trees/avl.lisp Log: Added make-avl-node function. Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Tue Jul 31 11:47:57 2007 @@ -63,3 +63,11 @@ :value (bt-key root) :right right :left left)) + +(defun make-avl-node (key value left right) + (make-instance 'avl-tree + :key key + :value value + :left left + :right right + :height (parent-height left right)))

1 0

← Newer
1
...
9
10
11
12
13
14
15
...
23
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

funds-cvs