funds-cvs July 2007

funds-cvs@common-lisp.net

1 participants
65 discussions

[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

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

31 Jul '07

Author: abaine Date: Tue Jul 31 11:20:25 2007 New Revision: 98 Modified: trunk/funds/src/trees/tree-insert.lisp Log: superficial edit. Modified: trunk/funds/src/trees/tree-insert.lisp ============================================================================== --- trunk/funds/src/trees/tree-insert.lisp (original) +++ trunk/funds/src/trees/tree-insert.lisp Tue Jul 31 11:20:25 2007 @@ -64,4 +64,3 @@ (outside (tree-child temp :side side)) (inside (tree-child temp :side (other-side side)))) (balance inside temp outside :heavy-side side)))) -

1 0

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

31 Jul '07

Author: abaine Date: Tue Jul 31 11:06:17 2007 New Revision: 97 Modified: trunk/funds/src/package.lisp Log: superficial edit. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Tue Jul 31 11:06:17 2007 @@ -47,5 +47,3 @@ :stack-push :stack-top :stack-size)) - -

1 0

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

31 Jul '07

Author: abaine Date: Tue Jul 31 10:59:57 2007 New Revision: 96 Modified: trunk/funds/src/trees/constructors.lisp Log: superficial edit. Modified: trunk/funds/src/trees/constructors.lisp ============================================================================== --- trunk/funds/src/trees/constructors.lisp (original) +++ trunk/funds/src/trees/constructors.lisp Tue Jul 31 10:59:57 2007 @@ -44,8 +44,6 @@ :height (parent-height left right)) (make-avl-leaf))) - - (defun make-heap (&key (priority 0 p-p) value (left (make-heap-leaf)) (right (make-heap-leaf))) (if p-p

1 0

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

12 Jul '07

Author: abaine Date: Wed Jul 11 21:37:11 2007 New Revision: 95 Modified: trunk/funds/src/trees/tree-height.lisp Log: Typo. Modified: trunk/funds/src/trees/tree-height.lisp ============================================================================== --- trunk/funds/src/trees/tree-height.lisp (original) +++ trunk/funds/src/trees/tree-height.lisp Wed Jul 11 21:37:11 2007 @@ -30,4 +30,3 @@ (defmethod tree-height ((tree avl-tree)) (avl-height tree)) -

1 0

[funds-cvs] r94 - in trunk/funds/src: . trees/heap
by abaine＠common-lisp.net 12 Jul '07

12 Jul '07

Author: abaine Date: Wed Jul 11 21:28:26 2007 New Revision: 94 Added: trunk/funds/src/trees/heap/heap.lisp Modified: trunk/funds/src/funds.asd trunk/funds/src/trees/heap/heap-insert.lisp trunk/funds/src/trees/heap/heap-remove.lisp Log: Eliminated attach-heap from heap-remove.lisp; moved attach-heap from heap-insert.lisp to heap.lisp; made sure that all calls were consistent. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Wed Jul 11 21:28:26 2007 @@ -42,7 +42,8 @@ (:file "tree-height") (:module heap :serial t - :components ((:file "heap-empty-p") + :components ((:file "heap") + (:file "heap-empty-p") (:file "heap-insert") (:file "heap-remove") (:file "heap-first"))))) Modified: trunk/funds/src/trees/heap/heap-insert.lisp ============================================================================== --- trunk/funds/src/trees/heap/heap-insert.lisp (original) +++ trunk/funds/src/trees/heap/heap-insert.lisp Wed Jul 11 21:28:26 2007 @@ -33,8 +33,8 @@ (if (funcall order (bt-key h1) (bt-key heap)) ; if we need to bubble up (attach-heap h1 side (attach-heap heap - :left (bt-left h1) - :right (bt-right h1)) + :left (bt-left h1) + :right (bt-right h1)) other-side h2) (attach-heap heap side h1 @@ -51,9 +51,3 @@ (if (< (- n (expt 2 lg)) (expt 2 (1- lg))) :left :right))) - -(defun attach-heap (root &key left right) - (make-heap :priority (heap-priority root) - :value (bt-value heap) - :left left - :right right)) Modified: trunk/funds/src/trees/heap/heap-remove.lisp ============================================================================== --- trunk/funds/src/trees/heap/heap-remove.lisp (original) +++ trunk/funds/src/trees/heap/heap-remove.lisp Wed Jul 11 21:28:26 2007 @@ -38,26 +38,20 @@ (or (heap-empty-p right) (in-order-p left right :order order))) (attach-heap left - (bubble-down root + :left (bubble-down root :left (bt-left left) :right (bt-right left) :order order) - right)) + :right right)) ((and (not (heap-empty-p right)) (in-order-p right root :order order)) (attach-heap right - left - (bubble-down root + :left left + :right (bubble-down root :left (bt-left right) :right (bt-right right) :order order))) - (t (attach-heap root left right)))) - -(defun attach-heap (root left right) - (make-heap :priority (heap-priority root) - :value (bt-value root) - :left left - :right right)) + (t (attach-heap root :left left :right right)))) (defun in-order-p (h1 h2 &key order) (funcall order (heap-priority h1) (heap-priority h2))) Added: trunk/funds/src/trees/heap/heap.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/heap/heap.lisp Wed Jul 11 21:28:26 2007 @@ -0,0 +1,8 @@ + +(in-package :funds) + +(defun attach-heap (root &key left right) + (make-heap :priority (heap-priority root) + :value (bt-value root) + :left left + :right right))

1 0

[funds-cvs] r93 - trunk/funds/src/trees/heap
by abaine＠common-lisp.net 12 Jul '07

12 Jul '07

Author: abaine Date: Wed Jul 11 21:05:43 2007 New Revision: 93 Modified: trunk/funds/src/trees/heap/heap-insert.lisp Log: Factored out attach-heap method. Modified: trunk/funds/src/trees/heap/heap-insert.lisp ============================================================================== --- trunk/funds/src/trees/heap/heap-insert.lisp (original) +++ trunk/funds/src/trees/heap/heap-insert.lisp Wed Jul 11 21:05:43 2007 @@ -31,19 +31,14 @@ :order order)) (h2 (tree-child heap :side other-side))) (if (funcall order (bt-key h1) (bt-key heap)) ; if we need to bubble up - (make-heap :priority (heap-priority h1) - :value (bt-value h1) - side (make-heap :priority (heap-priority heap) - - :value (bt-value heap) + (attach-heap h1 + side (attach-heap heap :left (bt-left h1) :right (bt-right h1)) - other-side h2) - (make-heap :priority (heap-priority heap) - :value (bt-value heap) - side h1 - other-side h2)))) - + other-side h2) + (attach-heap heap + side h1 + other-side h2)))) (defun next-direction (heap) (path-direction (1+ (heap-weight heap)))) @@ -56,3 +51,9 @@ (if (< (- n (expt 2 lg)) (expt 2 (1- lg))) :left :right))) + +(defun attach-heap (root &key left right) + (make-heap :priority (heap-priority root) + :value (bt-value heap) + :left left + :right right))

1 0

[funds-cvs] r92 - trunk/funds/tests/trees
by abaine＠common-lisp.net 12 Jul '07

12 Jul '07

Author: abaine Date: Wed Jul 11 20:56:20 2007 New Revision: 92 Modified: trunk/funds/tests/trees/avl-tree-test.lisp Log: Made test-tree-insert much more rigorous. Modified: trunk/funds/tests/trees/avl-tree-test.lisp ============================================================================== --- trunk/funds/tests/trees/avl-tree-test.lisp (original) +++ trunk/funds/tests/trees/avl-tree-test.lisp Wed Jul 11 20:56:20 2007 @@ -34,8 +34,13 @@ (assert-avl-valid (make-avl-tree))) (define-test test-tree-insert - (let ((tree (random-tree))) - (assert-avl-valid tree))) + (loop with tree = (make-avl-tree) + with elements = '() + repeat 1000 + do (let ((next (random 500))) + (assert-avl-valid (setf tree (tree-insert tree next (random 1000)))) + (assert-equal (length (setf elements (remove-duplicates (cons next elements)))) + (tree-weight tree))))) (define-test test-tree-remove (loop with tree = (random-tree)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

funds-cvs July 2007