funds-cvs

funds-cvs@common-lisp.net

225 discussions

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

04 Aug '07

Author: abaine Date: Sat Aug 4 10:18:29 2007 New Revision: 118 Modified: trunk/funds/src/trees/avl.lisp Log: Moved stitch-avl-tree to stitch-tree file. Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Sat Aug 4 10:18:29 2007 @@ -34,7 +34,7 @@ (< -2 (height-difference t1 t2) 2)) (defun balance (key value left right) - (let ((height-difference (- (tree-height left) (tree-height right)))) + (let ((height-difference (height-difference left right))) (if (< -2 height-difference 2) (stitch-avl-tree :key key :value value :left left :right right) (let* ((heavy-side (if (plusp height-difference) :left :right)) @@ -60,9 +60,3 @@ side new-inside (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))) - (make-instance 'avl-tree - :key key :value value - :left left :right right - :height (parent-height left right)))

1 0

[funds-cvs] r117 - in trunk/funds/src/trees: . heap
by abaine＠common-lisp.net 04 Aug '07

04 Aug '07

Author: abaine Date: Sat Aug 4 10:16:11 2007 New Revision: 117 Modified: trunk/funds/src/trees/constructors.lisp trunk/funds/src/trees/heap/heap.lisp Log: Moved heap constructor to heap.lisp. Modified: trunk/funds/src/trees/constructors.lisp ============================================================================== --- trunk/funds/src/trees/constructors.lisp (original) +++ trunk/funds/src/trees/constructors.lisp Sat Aug 4 10:16:11 2007 @@ -36,13 +36,3 @@ (defun make-avl-tree () (make-avl-leaf)) -(defun make-heap (&key (priority 0 p-p) value - (left (make-heap-leaf)) (right (make-heap-leaf))) - (if p-p - (make-instance 'heap - :priority priority - :value value - :left left - :right right - :weight (+ 1 (tree-weight left) (tree-weight right))) - (make-heap-leaf))) Modified: trunk/funds/src/trees/heap/heap.lisp ============================================================================== --- trunk/funds/src/trees/heap/heap.lisp (original) +++ trunk/funds/src/trees/heap/heap.lisp Sat Aug 4 10:16:11 2007 @@ -1,6 +1,17 @@ (in-package :funds) +(defun make-heap (&key (priority 0 p-p) value + (left (make-heap-leaf)) (right (make-heap-leaf))) + (if p-p + (make-instance 'heap + :priority priority + :value value + :left left + :right right + :weight (+ 1 (tree-weight left) (tree-weight right))) + (make-heap-leaf))) + (defun attach-heap (root &key left right) (make-heap :priority (heap-priority root) :value (bt-value root)

1 0

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

04 Aug '07

Author: abaine Date: Sat Aug 4 10:14:03 2007 New Revision: 116 Modified: trunk/funds/src/trees/tree-insert.lisp Log: Changed tree-insert specializer to no longer be a specializer. So leaves are now a special case, and tree insertion proceeds the same for binary trees and avl trees. The difference is that anytime during insertion or removal that a tree is 'stitched' together, stitch-tree balances an avl tree but not a binary tree; also I moved stitch-tree functions to the stitch-tree file. Modified: trunk/funds/src/trees/tree-insert.lisp ============================================================================== --- trunk/funds/src/trees/tree-insert.lisp (original) +++ trunk/funds/src/trees/tree-insert.lisp Sat Aug 4 10:14:03 2007 @@ -27,16 +27,14 @@ (defmethod tree-insert ((tree bt-leaf) key value &key test order) (declare (ignore test order)) - (make-instance 'binary-tree - :key key - :value value)) + (stitch-binary-tree :key key :value value)) (defmethod tree-insert ((tree avl-leaf) key value &key test order) (declare (ignore test order)) - (stitch-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 #'<)) + +(defmethod tree-insert (tree key value &key (test #'eql) (order #'<)) (if (funcall test key (bt-key tree)) (stitch-tree tree :key key :value value :left (bt-left tree) :right (bt-right tree)) (let* ((side (side-to-insert tree key :order order)) @@ -46,15 +44,3 @@ :test test :order order) other-side (tree-child tree :side other-side))))) - -(defmethod stitch-tree ((tree binary-tree) - &key (key (bt-key tree)) (value (bt-value tree)) left right) - (make-instance 'binary-tree - :key key - :value value - :left left - :right right)) - -(defmethod stitch-tree ((tree avl-tree) - &key (key (bt-key tree)) (value (bt-value tree)) left right) - (balance key value left right))

1 0

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

04 Aug '07

Author: abaine Date: Sat Aug 4 10:06:51 2007 New Revision: 115 Modified: trunk/funds/src/trees/tree-remove.lisp Log: Superficial change. Modified: trunk/funds/src/trees/tree-remove.lisp ============================================================================== --- trunk/funds/src/trees/tree-remove.lisp (original) +++ trunk/funds/src/trees/tree-remove.lisp Sat Aug 4 10:06:51 2007 @@ -50,4 +50,5 @@ (let* ((next (next-in-order tree))) (stitch-tree next :left (bt-left tree) - :right (tree-remove (bt-right tree) (bt-key next) :test test :order order)))) + :right (tree-remove (bt-right tree) (bt-key next) + :test test :order order))))

1 0

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

04 Aug '07

Author: abaine Date: Sat Aug 4 10:03:17 2007 New Revision: 114 Added: trunk/funds/src/trees/stitch-tree.lisp Log: Added stitch-tree methods and functions to replace constructors. These are responsible for making sure that the nodes that are stitched together actually satisfy avl properties in the case of avl trees. Added: trunk/funds/src/trees/stitch-tree.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/stitch-tree.lisp Sat Aug 4 10:03:17 2007 @@ -0,0 +1,41 @@ + +;;;; +;;;; Copyright 2007 Andrew Baine +;;;; +;;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;;; you may not use this file except in compliance with the License. +;;;; You may obtain a copy of the License at +;;;; +;;;; http://www.apache.org/licenses/LICENSE-2.0 +;;;; +;;;; Unless required by applicable law or agreed to in writing, software +;;;; distributed under the License is distributed on an "AS IS" BASIS, +;;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;;; See the License for the specific language governing permissions and +;;;; limitations under the License. +;;;; + +(in-package :funds) + +(defmethod stitch-tree ((tree binary-tree) + &key (key (bt-key tree)) (value (bt-value tree)) left right) + (stitch-binary-tree :key key :value value :left left :right right)) + +(defmethod stitch-tree ((tree avl-tree) + &key (key (bt-key tree)) (value (bt-value tree)) left right) + (balance key value left right)) + +(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 + :left left :right right + :height (parent-height left right))) + +(defun stitch-binary-tree (&key root (key (bt-key root)) (value (bt-value root)) + (left (make-binary-tree)) (right (make-binary-tree))) + (make-instance 'binary-tree + :key key + :value value + :left left + :right right))

1 0

[funds-cvs] r113 - trunk/funds/src
by abaine＠common-lisp.net 04 Aug '07

04 Aug '07

Author: abaine Date: Sat Aug 4 10:01:11 2007 New Revision: 113 Modified: trunk/funds/src/funds.asd Log: Added stitch-tree to defsystem form. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Sat Aug 4 10:01:11 2007 @@ -33,6 +33,7 @@ (:file "constructors") (:file "bt") (:file "avl") + (:file "stitch-tree") (:file "tree-as-alist") (:file "tree-empty-p") (:file "tree-insert")

1 0

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

02 Aug '07

Author: abaine Date: Thu Aug 2 15:41:49 2007 New Revision: 112 Modified: trunk/funds/src/trees/tree-insert.lisp Log: Got rid of avl specializer for tree-insert and instead made generic stitch-tree that balances tree as it is created. 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 15:41:49 2007 @@ -36,31 +36,25 @@ (stitch-avl-tree :key key :value value)) -(defmethod tree-insert ((tree binary-tree) key value - &key (test #'eql) (order #'<)) +(defmethod tree-insert ((tree binary-tree) key value &key (test #'eql) (order #'<)) (if (funcall test key (bt-key tree)) - (make-instance 'binary-tree - :key key - :value value - :left (bt-left tree) - :right (bt-right tree)) + (stitch-tree tree :key key :value value :left (bt-left tree) :right (bt-right tree)) (let* ((side (side-to-insert tree key :order order)) (other-side (other-side side))) - (attach-bt tree - side (tree-insert (tree-child tree :side side) key value + (stitch-tree tree + side (tree-insert (tree-child tree :side side) key value :test test :order order) - other-side (tree-child tree :side other-side))))) + other-side (tree-child tree :side other-side))))) -(defmethod tree-insert ((tree avl-tree) key value - &key (test #'eql) (order #'<)) - (if (funcall test key (bt-key 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)) - (inside (tree-child temp :side (other-side side)))) - (balance inside temp outside :heavy-side side)))) +(defmethod stitch-tree ((tree binary-tree) + &key (key (bt-key tree)) (value (bt-value tree)) left right) + (make-instance 'binary-tree + :key key + :value value + :left left + :right right)) + +(defmethod stitch-tree ((tree avl-tree) + &key (key (bt-key tree)) (value (bt-value tree)) left right) + (balance key value left right))

1 0

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

02 Aug '07

Author: abaine Date: Thu Aug 2 15:40:23 2007 New Revision: 111 Modified: trunk/funds/src/trees/avl.lisp Log: Totally changed balance function so that it doesn't require the creation of intermediate nodes. Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Thu Aug 2 15:40:23 2007 @@ -33,24 +33,26 @@ (defun balanced-p (t1 t2) (< -2 (height-difference t1 t2) 2)) -(defun balance (inside root outside &key heavy-side) - (let ((other-side (other-side heavy-side))) - (if (balanced-p inside outside) - (stitch-avl-tree :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) - outside - (tree-child outside :side other-side) - :side heavy-side) - outside) - :side other-side)))) +(defun balance (key value left right) + (let ((height-difference (- (tree-height left) (tree-height right)))) + (if (< -2 height-difference 2) + (stitch-avl-tree :key key :value value :left left :right right) + (let* ((heavy-side (if (plusp height-difference) :left :right)) + (other-side (other-side heavy-side)) + (inside (if (left-p heavy-side) right left)) + (outside (if (left-p heavy-side) left right))) + (rotate inside key value + (if (heavier-p outside :side other-side) + (rotate (tree-child outside :side heavy-side) + (bt-key outside) (bt-value outside) + (tree-child outside :side other-side) + :side heavy-side) + outside) + :side other-side))))) -(defun rotate (inside root outside &key side) +(defun rotate (inside root-key root-value outside &key side) (let* ((t1 (tree-child outside :side side)) - (new-inside (stitch-avl-tree :root root + (new-inside (stitch-avl-tree :key root-key :value root-value side inside (other-side side) t1)) (new-outside (tree-child outside :side (other-side side))))

1 0

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

02 Aug '07

Author: abaine Date: Thu Aug 2 15:38:18 2007 New Revision: 110 Modified: trunk/funds/src/trees/tree-remove.lisp Log: Deleted avl specializer for tree-remove because general bt method works fine; replaced attach-bt forms with stitch-tree. 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 15:38:18 2007 @@ -35,23 +35,11 @@ :left :right)) (other-side (other-side side))) - (attach-bt tree - side (tree-remove (tree-child tree :side side) key + (stitch-tree tree + side (tree-remove (tree-child tree :side side) key :test test :order order) - other-side (tree-child tree :side other-side))))) - -(defmethod tree-remove ((tree avl-tree) key &key (test #'eql) (order #'<)) - (declare (ignore test order)) - (let ((temp (call-next-method))) - (if (tree-empty-p temp) - (make-avl-tree) - (let* ((heavy-side (if (heavier-p temp :side :left) - :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))))) + other-side (tree-child tree :side other-side))))) (defun remove-root (tree &key test order) (cond ((tree-empty-p (bt-left tree)) (bt-right tree)) @@ -60,6 +48,6 @@ (defun remove-root-with-children (tree &key test order) (let* ((next (next-in-order tree))) - (attach-bt next - :left (bt-left tree) - :right (tree-remove (bt-right tree) (bt-key next) :test test :order order)))) + (stitch-tree next + :left (bt-left tree) + :right (tree-remove (bt-right tree) (bt-key next) :test test :order order))))

1 0

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

02 Aug '07

Author: abaine Date: Thu Aug 2 15:35:51 2007 New Revision: 109 Modified: trunk/funds/src/trees/bt.lisp Log: Deleted attach-bt. Modified: trunk/funds/src/trees/bt.lisp ============================================================================== --- trunk/funds/src/trees/bt.lisp (original) +++ trunk/funds/src/trees/bt.lisp Thu Aug 2 15:35:51 2007 @@ -33,13 +33,6 @@ (f (bt-left tree))))) (f (bt-right tree)))) -(defun attach-bt (root &key left right) - (make-instance 'binary-tree - :key (bt-key root) - :value (bt-value root) - :left left - :right right)) - (defun side-to-insert (tree key &key order) (if (funcall order key (bt-key tree)) :left

1 0

← Newer
1
...
8
9
10
11
12
13
14
...
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