From abaine at common-lisp.net Mon Jul 2 22:39:22 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 18:39:22 -0400 (EDT) Subject: [funds-cvs] r37 - trunk/funds/src/stack Message-ID: <20070702223922.C523632027@common-lisp.net> Author: abaine Date: Mon Jul 2 18:39:22 2007 New Revision: 37 Added: trunk/funds/src/stack/ trunk/funds/src/stack/stack.lisp Log: Initial version of stack. Added: trunk/funds/src/stack/stack.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/stack/stack.lisp Mon Jul 2 18:39:22 2007 @@ -0,0 +1,30 @@ + +(in-package :funds) + +(defun make-stack () + "An empty stack." + nil) + +(defun stack-push (item stack) + "The stack that results when the given item is pushed onto the given stack." + (cons item stack)) + +(defun stack-pop (stack) + "The stack that results when the top item is popped off the given stack." + (cdr stack)) + +(defun stack-top (stack) + "The top item on the given stack." + (car stack)) + +(defun stack-empty-p (stack) + "Whether the given stack is empty." + (null stack)) + +(defun stack-length (stack) + "The number of items on this stack; note that this is an O(n) operation." + (labels ((f (stack accum) + (if (stack-empty-p stack) + accum + (f (stack-pop stack) (1+ accum))))) + (f stack 0))) From abaine at common-lisp.net Mon Jul 2 22:39:54 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 18:39:54 -0400 (EDT) Subject: [funds-cvs] r38 - trunk/funds/src Message-ID: <20070702223954.D85A532027@common-lisp.net> Author: abaine Date: Mon Jul 2 18:39:54 2007 New Revision: 38 Modified: trunk/funds/src/package.lisp Log: Added stack functions to funds public API. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Mon Jul 2 18:39:54 2007 @@ -2,4 +2,9 @@ (in-package :cl-user) (defpackage :funds - (:use :common-lisp)) + (:use :common-lisp) + (:export :make-stack + :stack-length + :stack-push + :stack-pop + :stack-empty-p)) From abaine at common-lisp.net Mon Jul 2 22:40:44 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 18:40:44 -0400 (EDT) Subject: [funds-cvs] r39 - trunk/funds/src Message-ID: <20070702224044.85D0034052@common-lisp.net> Author: abaine Date: Mon Jul 2 18:40:44 2007 New Revision: 39 Modified: trunk/funds/src/funds.asd Log: Added stack module to system definition. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Mon Jul 2 18:40:44 2007 @@ -13,5 +13,8 @@ :components ((:module trees :serial t :components ((:file "package") - (:file "avl-tree"))) + (:file "avl-tree"))) + (:module stack + :serial t + :components ((:file "stack"))) (:file "package"))) From abaine at common-lisp.net Mon Jul 2 22:58:55 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 18:58:55 -0400 (EDT) Subject: [funds-cvs] r40 - trunk/funds/src Message-ID: <20070702225855.6C2323E053@common-lisp.net> Author: abaine Date: Mon Jul 2 18:58:55 2007 New Revision: 40 Modified: trunk/funds/src/funds.asd Log: Rearranged modules in funds.asd. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Mon Jul 2 18:58:55 2007 @@ -10,11 +10,11 @@ (defsystem funds :serial t - :components ((:module trees + :components ((:file "package") + (:module trees :serial t :components ((:file "package") (:file "avl-tree"))) (:module stack :serial t - :components ((:file "stack"))) - (:file "package"))) + :components ((:file "stack"))))) From abaine at common-lisp.net Mon Jul 2 22:59:43 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 18:59:43 -0400 (EDT) Subject: [funds-cvs] r41 - trunk/funds/src/stack Message-ID: <20070702225943.9BF5A3E053@common-lisp.net> Author: abaine Date: Mon Jul 2 18:59:43 2007 New Revision: 41 Modified: trunk/funds/src/stack/stack.lisp Log: Switched the order of stack-push arguments. Modified: trunk/funds/src/stack/stack.lisp ============================================================================== --- trunk/funds/src/stack/stack.lisp (original) +++ trunk/funds/src/stack/stack.lisp Mon Jul 2 18:59:43 2007 @@ -5,7 +5,7 @@ "An empty stack." nil) -(defun stack-push (item stack) +(defun stack-push (stack item) "The stack that results when the given item is pushed onto the given stack." (cons item stack)) From abaine at common-lisp.net Mon Jul 2 23:02:16 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 19:02:16 -0400 (EDT) Subject: [funds-cvs] r42 - trunk/funds Message-ID: <20070702230216.1EF10431BF@common-lisp.net> Author: abaine Date: Mon Jul 2 19:02:15 2007 New Revision: 42 Added: trunk/funds/license.txt Log: Added MIT License. Added: trunk/funds/license.txt ============================================================================== --- (empty file) +++ trunk/funds/license.txt Mon Jul 2 19:02:15 2007 @@ -0,0 +1,22 @@ + +The MIT License + +Copyright [c] 2007 Andrew Baine + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files [the "Software"], to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. From abaine at common-lisp.net Tue Jul 3 01:00:05 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 21:00:05 -0400 (EDT) Subject: [funds-cvs] r43 - trunk/funds Message-ID: <20070703010005.46CEC5D0EE@common-lisp.net> Author: abaine Date: Mon Jul 2 21:00:04 2007 New Revision: 43 Modified: trunk/funds/license.txt Log: Changed brackets to parens. Modified: trunk/funds/license.txt ============================================================================== --- trunk/funds/license.txt (original) +++ trunk/funds/license.txt Mon Jul 2 21:00:04 2007 @@ -1,10 +1,10 @@ The MIT License -Copyright [c] 2007 Andrew Baine +Copyright (c) 2007 Andrew Baine Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files [the "Software"], to deal +of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is From abaine at common-lisp.net Tue Jul 3 01:00:51 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 21:00:51 -0400 (EDT) Subject: [funds-cvs] r44 - trunk/funds/tests/trees Message-ID: <20070703010051.00671650D1@common-lisp.net> Author: abaine Date: Mon Jul 2 21:00:51 2007 New Revision: 44 Modified: trunk/funds/tests/trees/avl-tree-test.lisp Log: Removed print statement from random tree generation. 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 Mon Jul 2 21:00:51 2007 @@ -2,10 +2,10 @@ (in-package :funds.tests.trees) (defun random-tree (&key (test #'eql) (order #'<)) - (print (reduce #'(lambda (tr v) - (avl-insert tr v v :test test :order order)) + (reduce #'(lambda (tr v) + (avl-insert tr v v :test test :order order)) (loop for i below 40 collect (random 20)) - :initial-value (empty-avl-tree)))) + :initial-value (empty-avl-tree))) (defconstant +never-equal+ #'(lambda (a b) (declare (ignore a b)) nil)) From abaine at common-lisp.net Tue Jul 3 01:02:08 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Mon, 2 Jul 2007 21:02:08 -0400 (EDT) Subject: [funds-cvs] r45 - trunk/funds/src/trees Message-ID: <20070703010208.3E079650D1@common-lisp.net> Author: abaine Date: Mon Jul 2 21:02:07 2007 New Revision: 45 Modified: trunk/funds/src/trees/avl-tree.lisp Log: Began to refactor side-symmetric code left-rotate and right-rotate. Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Mon Jul 2 21:02:07 2007 @@ -67,12 +67,12 @@ (right (avl-right tree))) (if (imbalanced left right) (if (left-heavy left) - (right-rotate left tree right) - (right-rotate (left-rotate (avl-left left) - left - (avl-right left)) + (right-rotate right tree left) + (right-rotate right tree - right)) + (left-rotate (avl-left left) + left + (avl-right left)))) (make-avl :ht (parent-height left right) :key (avl-key tree) :value (avl-value tree) @@ -90,9 +90,9 @@ (left-rotate left tree right) (left-rotate left tree - (right-rotate (avl-left right) + (right-rotate (avl-right right) right - (avl-right right)))) + (avl-left right)))) (make-avl :ht (parent-height left right) :key (avl-key tree) :value (avl-value tree) @@ -114,7 +114,7 @@ :left new-a :right c))) -(defun right-rotate (b c t3) +(defun right-rotate (t3 c b) (let ((a (avl-left b)) (new-c (make-avl :ht (1- (avl-ht c)); re-calculate? :key (avl-key c) @@ -127,6 +127,32 @@ :left a :right new-c))) +(defun rotate (inside root outside &key direction) + (let* ((left-p (eq direction :left)) + (outside-accessor (if left-p + #'avl-right + #'avl-left)) + (inside-accessor (if left-p + #'avl-left + #'avl-right)) + (inside-init-key (if left-p + :left + :right)) + (outside-init-key (if left-p + :right + :left)) + (new-outside (funcall outside-accessor outside)) + (new-inside (make-avl :ht (1- (avl-height root)) + :key (avl-key root) + :value (avl-value root) + inside-init-key inside + outside-init-key (funcall inside-accessor outside)))) + (make-avl :ht (1+ (avl-height new-outside)) + :key (avl-key outside) + :value (avl-value outside) + inside-init-key new-inside + outside-init-key new-outside))) + ;;;; AVL Tree utility functions (defun imbalanced (left right) From abaine at common-lisp.net Tue Jul 3 18:57:05 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Tue, 3 Jul 2007 14:57:05 -0400 (EDT) Subject: [funds-cvs] r46 - trunk/funds/src/trees Message-ID: <20070703185705.3E4D87208F@common-lisp.net> Author: abaine Date: Tue Jul 3 14:57:04 2007 New Revision: 46 Modified: trunk/funds/src/trees/avl-tree.lisp Log: Refactored left and right rotate. Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Tue Jul 3 14:57:04 2007 @@ -102,45 +102,17 @@ ;;;; Rotation Functions (defun left-rotate (t0 a b) - (let ((c (avl-right b)) - (new-a (make-avl :ht (1- (avl-ht a)) ; re-calculate? - :key (avl-key a) - :value (avl-value a) - :left t0 - :right (avl-left b)))) - (make-avl :ht (1+ (avl-ht new-a)) - :key (avl-key b) - :value (avl-value b) - :left new-a - :right c))) + (rotate t0 a b :direction :left)) (defun right-rotate (t3 c b) - (let ((a (avl-left b)) - (new-c (make-avl :ht (1- (avl-ht c)); re-calculate? - :key (avl-key c) - :value (avl-value c) - :left (avl-right b) - :right t3))) - (make-avl :ht (1+ (avl-ht new-c)) ; re-calculate? - :key (avl-key b) - :value (avl-value b) - :left a - :right new-c))) + (rotate t3 c b :direction :right)) (defun rotate (inside root outside &key direction) (let* ((left-p (eq direction :left)) - (outside-accessor (if left-p - #'avl-right - #'avl-left)) - (inside-accessor (if left-p - #'avl-left - #'avl-right)) - (inside-init-key (if left-p - :left - :right)) - (outside-init-key (if left-p - :right - :left)) + (outside-accessor (if left-p #'avl-right #'avl-left)) + (inside-accessor (if left-p #'avl-left #'avl-right)) + (inside-init-key (if left-p :left :right)) + (outside-init-key (if left-p :right :left)) (new-outside (funcall outside-accessor outside)) (new-inside (make-avl :ht (1- (avl-height root)) :key (avl-key root) From abaine at common-lisp.net Tue Jul 3 20:18:23 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Tue, 3 Jul 2007 16:18:23 -0400 (EDT) Subject: [funds-cvs] r47 - trunk/funds/src/trees Message-ID: <20070703201823.D3A4E56008@common-lisp.net> Author: abaine Date: Tue Jul 3 16:18:23 2007 New Revision: 47 Modified: trunk/funds/src/trees/avl-tree.lisp Log: Refactored left and right-insert out of program. Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Tue Jul 3 16:18:23 2007 @@ -3,7 +3,6 @@ ;;;; Public Interface - (defun empty-avl-tree () "An empty AVL Tree." nil) @@ -30,8 +29,12 @@ :value value :left (avl-left tree) :right (avl-right tree))) - ((funcall order key (avl-key tree)) (left-insert tree key value test order)) - (t (right-insert tree key value test order)))) +; ((funcall order key (avl-key tree)) (left-insert tree key value test order)) +; (t (right-insert tree key value test order)) + (t (funcall (if (funcall order key (avl-key tree)) + #'left-insert + #'right-insert) + tree key value test order)))) (defun avl-find-value (tree key &key (order #'<) (test #'eql)) "The value associated with the given key in the given AVL Tree. The function @@ -63,44 +66,90 @@ "The AVL tree that results when the given key-value pair is inserted into left sub-tree of the given AVL tree. Only non-empty avl-trees should be supplied as arguments." - (let ((left (avl-insert (avl-left tree) key value :test test :order order)) - (right (avl-right tree))) - (if (imbalanced left right) - (if (left-heavy left) - (right-rotate right tree left) - (right-rotate right - tree - (left-rotate (avl-left left) - left - (avl-right left)))) - (make-avl :ht (parent-height left right) - :key (avl-key tree) - :value (avl-value tree) - :left left - :right right)))) +;; (let ((left (avl-insert (avl-left tree) key value :test test :order order)) +;; (right (avl-right tree))) +;; (if (imbalanced left right) +;; (if (left-heavy left) +;; (right-rotate right tree left) +;; (right-rotate right +;; tree +;; (left-rotate (avl-left left) +;; left +;; (avl-right left)))) +;; (make-avl :ht (parent-height left right) +;; :key (avl-key tree) +;; :value (avl-value tree) +;; :left left +;; :right right))) + (side-insert tree key value test order :side :left)) (defun right-insert (tree key value test order) "The AVL tree that results when the given key-value pair is inserted into the right sub-tree of the given AVL tree. Only non-empty avl-trees should be supplied as the tree argument." - (let ((right (avl-insert (avl-right tree) key value :test test :order order)) - (left (avl-left tree))) - (if (imbalanced left right) - (if (right-heavy right) - (left-rotate left tree right) - (left-rotate left - tree - (right-rotate (avl-right right) - right - (avl-left right)))) - (make-avl :ht (parent-height left right) - :key (avl-key tree) - :value (avl-value tree) - :left left - :right right)))) +;; (let ((right (avl-insert (avl-right tree) key value :test test :order order)) +;; (left (avl-left tree))) +;; (if (imbalanced left right) +;; (if (right-heavy right) +;; (left-rotate left tree right) +;; (left-rotate left +;; tree +;; (right-rotate (avl-right right) +;; right +;; (avl-left right)))) +;; (make-avl :ht (parent-height left right) +;; :key (avl-key tree) +;; :value (avl-value tree) +;; :left left +;; :right right))) + (side-insert tree key value test order :side :right) +) + +(defun side-insert (tree key value test order &key side) + (let ((out (avl-insert (funcall (side-accessor side) tree) key value :test test :order order)) + (in (funcall (other-side-accessor side) tree))) + (if (balanced out in) + (make-avl :ht (parent-height out in) + :key (avl-key tree) + :value (avl-value tree) + side out + (other-side side) in) + (funcall (other-side-rotator side) + in + tree + (if (funcall (side-heavy-predicate side) out) + out + (funcall (side-rotator side) + (funcall (side-accessor side) out) + out + (funcall (other-side-accessor side) out))))))) + + ;;;; Rotation Functions +(defun left-p (side) + (eq side :left)) + +(defun other-side (side) + (if (left-p side) :right :left)) + +(defun side-accessor (side) + (if (left-p side) #'avl-left #'avl-right)) + +(defun other-side-accessor (side) + (side-accessor (other-side side))) + +(defun side-rotator (side) + (if (left-p side) #'left-rotate #'right-rotate)) + +(defun other-side-rotator (side) + (side-rotator (other-side side))) + +(defun side-heavy-predicate (side) + (if (left-p side) #'left-heavy #'right-heavy)) + + (defun left-rotate (t0 a b) (rotate t0 a b :direction :left)) @@ -108,11 +157,10 @@ (rotate t3 c b :direction :right)) (defun rotate (inside root outside &key direction) - (let* ((left-p (eq direction :left)) - (outside-accessor (if left-p #'avl-right #'avl-left)) - (inside-accessor (if left-p #'avl-left #'avl-right)) - (inside-init-key (if left-p :left :right)) - (outside-init-key (if left-p :right :left)) + (let* ((outside-accessor (other-side-accessor direction)) + (inside-accessor (side-accessor direction)) + (inside-init-key direction) + (outside-init-key (other-side direction)) (new-outside (funcall outside-accessor outside)) (new-inside (make-avl :ht (1- (avl-height root)) :key (avl-key root) @@ -127,6 +175,9 @@ ;;;; AVL Tree utility functions +(defun avl-balanced-p (tree) + (< -2 (balance-factor tree) 2)) + (defun imbalanced (left right) "Whether the heights of the given sub-trees differ, in their absolute values, by more than one." From abaine at common-lisp.net Tue Jul 3 20:35:36 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Tue, 3 Jul 2007 16:35:36 -0400 (EDT) Subject: [funds-cvs] r48 - trunk/funds/src/trees Message-ID: <20070703203536.2F5636B0FA@common-lisp.net> Author: abaine Date: Tue Jul 3 16:35:35 2007 New Revision: 48 Modified: trunk/funds/src/trees/avl-tree.lisp Log: Refactoring of insert complete. Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Tue Jul 3 16:35:35 2007 @@ -24,17 +24,14 @@ :value value :left (empty-avl-tree) :right (empty-avl-tree))) + ;; Duplicate keys are not allowed: ((funcall test key (avl-key tree)) (make-avl :ht (avl-ht tree) :key key :value value :left (avl-left tree) :right (avl-right tree))) -; ((funcall order key (avl-key tree)) (left-insert tree key value test order)) -; (t (right-insert tree key value test order)) - (t (funcall (if (funcall order key (avl-key tree)) - #'left-insert - #'right-insert) - tree key value test order)))) + (t (side-insert tree key value test order + :side (if (funcall order key (avl-key tree)) :left :right))))) (defun avl-find-value (tree key &key (order #'<) (test #'eql)) "The value associated with the given key in the given AVL Tree. The function @@ -62,49 +59,6 @@ ;;;; Insertion Helpers -(defun left-insert (tree key value test order) - "The AVL tree that results when the given key-value pair is inserted -into left sub-tree of the given AVL tree. Only non-empty avl-trees -should be supplied as arguments." -;; (let ((left (avl-insert (avl-left tree) key value :test test :order order)) -;; (right (avl-right tree))) -;; (if (imbalanced left right) -;; (if (left-heavy left) -;; (right-rotate right tree left) -;; (right-rotate right -;; tree -;; (left-rotate (avl-left left) -;; left -;; (avl-right left)))) -;; (make-avl :ht (parent-height left right) -;; :key (avl-key tree) -;; :value (avl-value tree) -;; :left left -;; :right right))) - (side-insert tree key value test order :side :left)) - -(defun right-insert (tree key value test order) - "The AVL tree that results when the given key-value pair is inserted -into the right sub-tree of the given AVL tree. Only non-empty avl-trees -should be supplied as the tree argument." -;; (let ((right (avl-insert (avl-right tree) key value :test test :order order)) -;; (left (avl-left tree))) -;; (if (imbalanced left right) -;; (if (right-heavy right) -;; (left-rotate left tree right) -;; (left-rotate left -;; tree -;; (right-rotate (avl-right right) -;; right -;; (avl-left right)))) -;; (make-avl :ht (parent-height left right) -;; :key (avl-key tree) -;; :value (avl-value tree) -;; :left left -;; :right right))) - (side-insert tree key value test order :side :right) -) - (defun side-insert (tree key value test order &key side) (let ((out (avl-insert (funcall (side-accessor side) tree) key value :test test :order order)) (in (funcall (other-side-accessor side) tree))) @@ -128,28 +82,6 @@ ;;;; Rotation Functions -(defun left-p (side) - (eq side :left)) - -(defun other-side (side) - (if (left-p side) :right :left)) - -(defun side-accessor (side) - (if (left-p side) #'avl-left #'avl-right)) - -(defun other-side-accessor (side) - (side-accessor (other-side side))) - -(defun side-rotator (side) - (if (left-p side) #'left-rotate #'right-rotate)) - -(defun other-side-rotator (side) - (side-rotator (other-side side))) - -(defun side-heavy-predicate (side) - (if (left-p side) #'left-heavy #'right-heavy)) - - (defun left-rotate (t0 a b) (rotate t0 a b :direction :left)) @@ -175,9 +107,6 @@ ;;;; AVL Tree utility functions -(defun avl-balanced-p (tree) - (< -2 (balance-factor tree) 2)) - (defun imbalanced (left right) "Whether the heights of the given sub-trees differ, in their absolute values, by more than one." @@ -192,12 +121,12 @@ "The difference in heights of the given sub-trees." (- (avl-height a) (avl-height b))) -(defun left-heavy (tree) +(defun left-heavy-p (tree) "Whether the given imbalanced AVL Tree has a left sub-tree taller than its right sub-tree." (minusp (balance-factor tree))) -(defun right-heavy (tree) +(defun right-heavy-p (tree) "Whether the given imbalanced AVL Tree has a right sub-tree taller than its left sub-tree." (plusp (balance-factor tree))) @@ -213,3 +142,26 @@ (let ((a (avl-height left)) (b (avl-height right))) (1+ (if (> a b) a b)))) + +;;; Functions that return side-appropriate functions + +(defun left-p (side) + (eq side :left)) + +(defun other-side (side) + (if (left-p side) :right :left)) + +(defun side-accessor (side) + (if (left-p side) #'avl-left #'avl-right)) + +(defun other-side-accessor (side) + (side-accessor (other-side side))) + +(defun side-rotator (side) + (if (left-p side) #'left-rotate #'right-rotate)) + +(defun other-side-rotator (side) + (side-rotator (other-side side))) + +(defun side-heavy-predicate (side) + (if (left-p side) #'left-heavy-p #'right-heavy-p)) From abaine at common-lisp.net Wed Jul 4 17:39:42 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Wed, 4 Jul 2007 13:39:42 -0400 (EDT) Subject: [funds-cvs] r49 - trunk/funds/src/trees Message-ID: <20070704173942.B53BB431BF@common-lisp.net> Author: abaine Date: Wed Jul 4 13:39:42 2007 New Revision: 49 Modified: trunk/funds/src/trees/avl-tree.lisp Log: avl-remove method added. Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Wed Jul 4 13:39:42 2007 @@ -33,6 +33,14 @@ (t (side-insert tree key value test order :side (if (funcall order key (avl-key tree)) :left :right))))) +(defun avl-remove (tree key &key (test #'eql) (order #'<)) + "The AVL Tree that results when the given key and its associated value are +removed from the given tree." + (cond ((avl-empty-p tree) tree) + ((funcall test key (avl-key tree)) ()) + (t (side-remove tree key test order + :side (if (funcall order key (avl-key tree)) :left :right))))) + (defun avl-find-value (tree key &key (order #'<) (test #'eql)) "The value associated with the given key in the given AVL Tree. The function returns nil if the key is not found in the given tree; a second value is returned From abaine at common-lisp.net Wed Jul 4 18:31:42 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Wed, 4 Jul 2007 14:31:42 -0400 (EDT) Subject: [funds-cvs] r50 - trunk/funds/src/trees Message-ID: <20070704183142.DE45D60035@common-lisp.net> Author: abaine Date: Wed Jul 4 14:31:42 2007 New Revision: 50 Modified: trunk/funds/src/trees/avl-tree.lisp Log: Changed package to funds. Modified: trunk/funds/src/trees/avl-tree.lisp ============================================================================== --- trunk/funds/src/trees/avl-tree.lisp (original) +++ trunk/funds/src/trees/avl-tree.lisp Wed Jul 4 14:31:42 2007 @@ -1,5 +1,5 @@ -(in-package :funds.trees) +(in-package :funds) ;;;; Public Interface From abaine at common-lisp.net Wed Jul 4 18:32:35 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Wed, 4 Jul 2007 14:32:35 -0400 (EDT) Subject: [funds-cvs] r51 - trunk/funds/src Message-ID: <20070704183235.33AEE60035@common-lisp.net> Author: abaine Date: Wed Jul 4 14:32:32 2007 New Revision: 51 Modified: trunk/funds/src/package.lisp Log: Added avl API to exports of funds package. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Wed Jul 4 14:32:32 2007 @@ -7,4 +7,15 @@ :stack-length :stack-push :stack-pop - :stack-empty-p)) + :stack-empty-p + + :empty-avl-tree + :avl-empty-p + :avl-insert + :avl-remove + :avl-find-value + :avl-key + :avl-value + :avl-height + :avl-left + :avl-right)) From abaine at common-lisp.net Wed Jul 4 18:33:34 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Wed, 4 Jul 2007 14:33:34 -0400 (EDT) Subject: [funds-cvs] r52 - trunk/funds/tests/trees Message-ID: <20070704183334.5EA8C60035@common-lisp.net> Author: abaine Date: Wed Jul 4 14:33:33 2007 New Revision: 52 Modified: trunk/funds/tests/trees/package.lisp Log: Changed package name to funds-tests. Modified: trunk/funds/tests/trees/package.lisp ============================================================================== --- trunk/funds/tests/trees/package.lisp (original) +++ trunk/funds/tests/trees/package.lisp Wed Jul 4 14:33:33 2007 @@ -1,7 +1,7 @@ (in-package :cl-user) -(defpackage funds.tests.trees +(defpackage funds-tests (:use :cl - :funds.trees + :funds :lisp-unit)) From abaine at common-lisp.net Wed Jul 4 18:34:20 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Wed, 4 Jul 2007 14:34:20 -0400 (EDT) Subject: [funds-cvs] r53 - in trunk/funds/tests: . trees Message-ID: <20070704183420.C48D160035@common-lisp.net> Author: abaine Date: Wed Jul 4 14:34:20 2007 New Revision: 53 Added: trunk/funds/tests/package.lisp - copied unchanged from r52, trunk/funds/tests/trees/package.lisp Removed: trunk/funds/tests/trees/package.lisp Log: Moved tests/package.lisp to the correct directory. From abaine at common-lisp.net Wed Jul 4 19:08:37 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Wed, 4 Jul 2007 15:08:37 -0400 (EDT) Subject: [funds-cvs] r54 - trunk/funds/tests Message-ID: <20070704190837.848BA58333@common-lisp.net> Author: abaine Date: Wed Jul 4 15:08:37 2007 New Revision: 54 Modified: trunk/funds/tests/funds-tests.asd Log: Changed funds-tests.asd to reflect change in package structure. Modified: trunk/funds/tests/funds-tests.asd ============================================================================== --- trunk/funds/tests/funds-tests.asd (original) +++ trunk/funds/tests/funds-tests.asd Wed Jul 4 15:08:37 2007 @@ -10,9 +10,9 @@ (defsystem funds-tests :serial t - :components ((:module trees + :components ((:file "package") + (:module trees :serial t - :components ((:file "package") - (:file "avl-tree-test")))) + :components ((:file "avl-tree-test")))) :depends-on (:funds :lisp-unit)) From abaine at common-lisp.net Wed Jul 4 19:09:06 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Wed, 4 Jul 2007 15:09:06 -0400 (EDT) Subject: [funds-cvs] r55 - trunk/funds/src Message-ID: <20070704190906.E9ACE58333@common-lisp.net> Author: abaine Date: Wed Jul 4 15:09:05 2007 New Revision: 55 Modified: trunk/funds/src/funds.asd Log: Added binary tree. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Wed Jul 4 15:09:05 2007 @@ -13,8 +13,8 @@ :components ((:file "package") (:module trees :serial t - :components ((:file "package") - (:file "avl-tree"))) + :components ((:file "avl-tree") + (:file "binary-tree"))) (:module stack :serial t :components ((:file "stack"))))) From abaine at common-lisp.net Thu Jul 5 02:59:25 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Wed, 4 Jul 2007 22:59:25 -0400 (EDT) Subject: [funds-cvs] r56 - trunk/funds/src/trees Message-ID: <20070705025925.EDFD768297@common-lisp.net> Author: abaine Date: Wed Jul 4 22:59:25 2007 New Revision: 56 Added: trunk/funds/src/trees/binary-tree.lisp Log: Added binary-tree.lisp. Added: trunk/funds/src/trees/binary-tree.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/binary-tree.lisp Wed Jul 4 22:59:25 2007 @@ -0,0 +1,83 @@ + +(in-package :funds) + +(defstruct bt + key + value + left + right) + +(defun make-empty-bt () + nil) + +(defun bt-empty-p (tree) + (null tree)) + +(defun bt-insert (tree key value &key (order #'<) (test #'eql)) + (cond ((bt-empty-p tree) (make-bt :key key + :value value + :left (make-empty-bt) + :right (make-empty-bt))) + ((funcall test key (bt-key tree)) (make-bt :key key + :value value + :left (bt-left tree) + :right (bt-right tree))) + + ((funcall order key (bt-key tree)) + (make-bt :key (bt-key tree) + :value (bt-value tree) + :left (bt-insert (bt-left tree) key value :order order :test test) + :right (bt-right tree))) + (t (make-bt :key (bt-key tree) + :value (bt-value tree) + :left (bt-left tree) + :right (bt-insert (bt-right tree)key value :order order :test test))))) + +(defun bt-find (tree key &key (order #'<) (test #'eql)) + (cond ((bt-empty-p tree) (values nil nil)) + ((funcall test key (bt-key tree)) (values (bt-value tree) t)) + ((funcall order key (bt-key tree)) (bt-find (bt-left tree) key + :order order + :test test)) + (t (bt-find (bt-right tree) key + :order order + :test test)))) + +(defun bt-remove (tree key &key (order #'<) (test #'eql)) + (cond ((bt-empty-p tree) tree) + ((funcall test key (bt-key tree)) (remove-root tree :order order :test test)) + ((funcall order key (bt-key tree)) (make-bt :key (bt-key tree) + :value (bt-value tree) + :left (bt-remove (bt-left tree) key + :order order + :test test) + :right (bt-right tree))) + (t (make-bt :key (bt-key tree) + :value (bt-value tree) + :left (bt-left tree) + :right (bt-remove (bt-right tree) key + :order order + :test test))))) + +(defun remove-root (tree &key order test) + (cond ((bt-empty-p (bt-left tree)) (bt-right tree)) + ((bt-empty-p (bt-right tree)) (bt-left tree)) + (t (let* ((next (next-in-order (bt-right tree) order)) + (k (bt-key next))) + (make-bt :key k + :value (bt-value next) + :left (bt-left tree) + :right (bt-remove (bt-right tree) k + :order order + :test test)))))) + +(defun bt->alist (tree) + (if (bt-empty-p tree) nil + (append (bt->alist (bt-left tree)) + (cons (cons (bt-key tree) (bt-value tree)) + (bt->alist (bt-right tree)))))) + +(defun next-in-order (tree order) + (if (bt-empty-p (bt-left tree)) + tree + (next-in-order (bt-left tree) order))) \ No newline at end of file From abaine at common-lisp.net Sat Jul 7 13:15:48 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sat, 7 Jul 2007 09:15:48 -0400 (EDT) Subject: [funds-cvs] r57 - trunk/public_html Message-ID: <20070707131548.5F3BB140B1@common-lisp.net> Author: abaine Date: Sat Jul 7 09:15:47 2007 New Revision: 57 Modified: trunk/public_html/index.html Log: Changed release date. Modified: trunk/public_html/index.html ============================================================================== --- trunk/public_html/index.html (original) +++ trunk/public_html/index.html Sat Jul 7 09:15:47 2007 @@ -40,7 +40,7 @@ development as a Google Summer of Code Project, and a release is planned for - July 6, 2007. + July 13, 2007.

From abaine at common-lisp.net Sat Jul 7 20:45:17 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sat, 7 Jul 2007 16:45:17 -0400 (EDT) Subject: [funds-cvs] r58 - trunk/funds/src/stack Message-ID: <20070707204517.D9FED4E00F@common-lisp.net> Author: abaine Date: Sat Jul 7 16:45:17 2007 New Revision: 58 Modified: trunk/funds/src/stack/stack.lisp Log: Changed name of stack-length to stack-size. Modified: trunk/funds/src/stack/stack.lisp ============================================================================== --- trunk/funds/src/stack/stack.lisp (original) +++ trunk/funds/src/stack/stack.lisp Sat Jul 7 16:45:17 2007 @@ -21,7 +21,7 @@ "Whether the given stack is empty." (null stack)) -(defun stack-length (stack) +(defun stack-size (stack) "The number of items on this stack; note that this is an O(n) operation." (labels ((f (stack accum) (if (stack-empty-p stack) From abaine at common-lisp.net Sun Jul 8 02:52:18 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sat, 7 Jul 2007 22:52:18 -0400 (EDT) Subject: [funds-cvs] r59 - in trunk/funds/src: . stack trees trees/heap Message-ID: <20070708025218.68F3E5F04A@common-lisp.net> Author: abaine Date: Sat Jul 7 22:52:17 2007 New Revision: 59 Added: trunk/funds/src/funds-clos.asd trunk/funds/src/queue.lisp trunk/funds/src/stack/ trunk/funds/src/stack.lisp trunk/funds/src/trees/avl.lisp trunk/funds/src/trees/bt.lisp trunk/funds/src/trees/classes.lisp trunk/funds/src/trees/constructors.lisp trunk/funds/src/trees/heap/ trunk/funds/src/trees/heap/heap-empty-p.lisp trunk/funds/src/trees/heap/heap-first.lisp trunk/funds/src/trees/heap/heap-insert.lisp trunk/funds/src/trees/heap/heap-remove.lisp trunk/funds/src/trees/tree-as-alist.lisp trunk/funds/src/trees/tree-empty-p.lisp trunk/funds/src/trees/tree-find.lisp trunk/funds/src/trees/tree-height.lisp trunk/funds/src/trees/tree-insert.lisp trunk/funds/src/trees/tree-remove.lisp trunk/funds/src/trees/tree-weight.lisp Removed: trunk/funds/src/trees/avl-tree.lisp trunk/funds/src/trees/binary-tree.lisp trunk/funds/src/trees/package.lisp Modified: trunk/funds/src/package.lisp Log: Total rewrite using CLOS. Added: trunk/funds/src/funds-clos.asd ============================================================================== --- (empty file) +++ trunk/funds/src/funds-clos.asd Sat Jul 7 22:52:17 2007 @@ -0,0 +1,35 @@ + +; -*- Lisp -*- + +(in-package :cl-user) +(defpackage #:funds-clos-asd + (:use :cl :asdf)) + +(in-package :funds-clos-asd) + +(defsystem funds-clos + :serial t + :components ((:file "package") + (:file "stack") + (:module trees + :serial t + :components ((:file "classes") + (:file "constructors") + (:file "bt") + (:file "avl") + (:file "tree-as-alist") + (:file "tree-empty-p") + (:file "tree-insert") + (:file "tree-remove") + (:file "tree-find") + (:file "tree-weight") + (:file "tree-height") + (:module heap + :serial t + :components ((:file "heap-empty-p") + (:file "heap-insert") + (:file "heap-remove") + (:file "heap-first"))))) + (:file "queue"))) + + Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Sat Jul 7 22:52:17 2007 @@ -1,21 +1,35 @@ (in-package :cl-user) -(defpackage :funds - (:use :common-lisp) - (:export :make-stack - :stack-length - :stack-push - :stack-pop +(defpackage :funds-clos + (:use :cl) + (:export :make-avl-tree + :make-binary-tree + + :tree-insert + :tree-remove + :tree-find + :tree-empty-p + :tree-height + :tree-weight + + :make-heap + :heap-empty-p + :heap-first + :heap-insert + :heap-remove + + :make-queue + :queue-empty-p + :queue-enqueue + :queue-dequeue + :queue-first + :queue-size + + :make-stack :stack-empty-p + :stack-push + :stack-top + :stack-size)) + - :empty-avl-tree - :avl-empty-p - :avl-insert - :avl-remove - :avl-find-value - :avl-key - :avl-value - :avl-height - :avl-left - :avl-right)) Added: trunk/funds/src/queue.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/queue.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,25 @@ + +(in-package :funds-clos) + +(defstruct queue + (next-priority 0) + (heap (make-heap))) + +(defun queue-first (q) + (heap-first (queue-heap q))) + +(defun queue-enqueue (q item) + (make-queue :next-priority (1+ (queue-next-priority q)) + :heap (heap-insert (queue-heap q) item (queue-next-priority q)))) + +(defun queue-dequeue (q) + (if (queue-empty-p q) + q + (make-queue :next-priority (1- (queue-next-priority q)) + :heap (heap-remove (queue-heap q))))) + +(defun queue-size (q) + (tree-weight (queue-heap q))) + +(defun queue-empty-p (q) + (tree-empty-p (queue-heap q))) Added: trunk/funds/src/stack.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/stack.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,30 @@ + +(in-package :funds-clos) + +(defun make-stack () + "An empty stack." + nil) + +(defun stack-push (stack item) + "The stack that results when the given item is pushed onto the given stack." + (cons item stack)) + +(defun stack-pop (stack) + "The stack that results when the top item is popped off the given stack." + (cdr stack)) + +(defun stack-top (stack) + "The top item on the given stack." + (car stack)) + +(defun stack-empty-p (stack) + "Whether the given stack is empty." + (null stack)) + +(defun stack-size (stack) + "The number of items on this stack; note that this is an O(n) operation." + (labels ((f (stack accum) + (if (stack-empty-p stack) + accum + (f (stack-pop stack) (1+ accum))))) + (f stack 0))) Added: trunk/funds/src/trees/avl.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/avl.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,31 @@ + +(in-package :funds-clos) + +(defun balance (inside root outside &key heavy-side) + (let ((other-side (other-side heavy-side))) + (if (balanced-p inside outside) + (make-avl-tree :key (bt-key root) + :value (bt-value 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 rotate (inside root outside &key side) + (let* ((t1 (tree-child outside :side side)) + (new-inside (make-avl-tree :key (bt-key root) + :value (bt-value root) + side inside + (other-side side) t1)) + (new-outside (tree-child outside :side (other-side side)))) + (make-avl-tree + :key (bt-key outside) + :value (bt-key outside) + side new-inside + (other-side side) new-outside))) Added: trunk/funds/src/trees/bt.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/bt.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,36 @@ + +(in-package :funds-clos) + +(defun left-p (side) + (eq side :left)) + +(defun other-side (side) + (if (left-p side) :right :left)) + +(defun tree-child (tree &key side) + (funcall (if (left-p side) #'bt-left #'bt-right) tree)) + +(defun next-in-order (tree) + (labels ((f (tree) + (if (tree-empty-p (bt-left tree)) + tree + (f (bt-left tree))))) + (f (bt-right tree)))) + +(defun parent-height (t1 t2) + (let ((h1 (tree-height t1)) + (h2 (tree-height t2))) + (1+ (if (> h1 h2) h1 h2)))) + +(defun balanced-p (t1 t2) + (< -2 (height-difference t1 t2) 2)) + +(defun height-difference (t1 t2) + (- (tree-height t1) (tree-height t2))) + +(defun heavier-p (tree &key side) + (funcall (if (left-p side) #'plusp #'minusp) + (height-difference (bt-left tree) + (bt-right tree)))) + + Added: trunk/funds/src/trees/classes.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/classes.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,45 @@ + +(in-package :funds-clos) + +(defclass tree () + () + (:documentation "The foundation of all trees.")) + +(defclass leaf (tree) + () + (:documentation "A leaf with no data or children.")) + +(defclass avl-leaf (leaf) + () + (:documentation "A leaf node of an AVL tree.")) + +(defclass bt-leaf (leaf) + () + (:documentation "A leaf node of an AVL tree.")) + +(defclass binary-tree (tree) + ((key :initarg :key :reader bt-key) + (value :initarg :value :reader bt-value) + (left :initarg :left :reader bt-left :initform (make-binary-tree)) + (right :initarg :right :reader bt-right :initform (make-binary-tree))) + (:documentation "A binary tree that holds a key-value pair in its root.")) + +(defclass avl-tree (binary-tree) + ((height :initarg :height :reader avl-height) + (left :initform (make-avl-tree)) + (right :initform (make-avl-tree))) + (:documentation "A height-balanced binary tree.")) + +(defclass heap-leaf (leaf) + () + (:documentation "A leaf node of a heap.")) + +(defclass heap (binary-tree) + ((key :initarg :priority :reader heap-priority) + (left :initform (make-heap)) + (right :initform (make-heap)) + (weight :initarg :weight :initform 1 :reader heap-weight))) + + + + Added: trunk/funds/src/trees/constructors.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/constructors.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,36 @@ + +(in-package :funds-clos) + +(defun make-bt-leaf () + (make-instance 'bt-leaf)) + +(defun make-avl-leaf () + (make-instance 'avl-leaf)) + +(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-heap-leaf () + (make-instance 'heap-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))) Added: trunk/funds/src/trees/heap/heap-empty-p.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/heap/heap-empty-p.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,5 @@ + +(in-package :funds-clos) + +(defun heap-empty-p (heap) + (tree-empty-p heap)) \ No newline at end of file Added: trunk/funds/src/trees/heap/heap-first.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/heap/heap-first.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,5 @@ + +(in-package :funds-clos) + +(defun heap-first (heap) + (bt-value heap)) Added: trunk/funds/src/trees/heap/heap-insert.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/heap/heap-insert.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,42 @@ + +(in-package :funds-clos) + +(defgeneric heap-insert (heap value priority &key order)) + +(defmethod heap-insert ((heap heap-leaf) value priority &key order) + (declare (ignore order)) + (make-heap :priority priority + :value value)) + +(defmethod heap-insert (heap value priority &key (order #'<)) + (let* ((side (next-direction heap)) + (other-side (other-side side)) + (h1 (heap-insert (tree-child heap :side side) value priority + :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) + :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)))) + + +(defun next-direction (heap) + (path-direction (1+ (heap-weight heap)))) + +(defun last-direction (heap) + (path-direction (heap-weight heap))) + +(defun path-direction (n) + (let ((lg (floor (log n 2)))) + (if (< (- n (expt 2 lg)) (expt 2 (1- lg))) + :left + :right))) Added: trunk/funds/src/trees/heap/heap-remove.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/heap/heap-remove.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,66 @@ + +(in-package :funds-clos) + +(defmethod heap-remove ((heap heap-leaf) &key order) + (declare (ignore order)) + heap) + +(defmethod heap-remove (heap &key (order #'<)) + (let ((last-node (last-node heap))) + (if (eq last-node heap) + (make-heap) + (let* ((side (last-direction heap)) + (other-side (other-side side))) + (bubble-down last-node + side (clip-last (tree-child heap :side side)) + other-side (tree-child heap :side other-side) + :order order))))) + +(defun bubble-down (root &key left right order) + (cond ((and (not (heap-empty-p left)) + (in-order-p left root :order order) + (or (heap-empty-p right) + (in-order-p left right :order order))) + (attach-heap left + (bubble-down root + :left (bt-left left) + :right (bt-right left) + :order order) + right)) + ((and (not (heap-empty-p right)) + (in-order-p right root :order order)) + (attach-heap right + left + (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)) + +(defun in-order-p (h1 h2 &key order) + (funcall order (heap-priority h1) (heap-priority h2))) + +(defun clip-last (heap) + "The heap that results when the last node is removed." + (if (no-children-p heap) + (make-heap) + (let ((side (last-direction heap))) + (make-heap side (clip-last (tree-child heap :side side)) + (other-side side) (tree-child heap :side (other-side side)) + :priority (heap-priority heap) + :value (bt-value heap))))) + +(defun no-children-p (heap) + (and (heap-empty-p (bt-left heap)) + (heap-empty-p (bt-right heap)))) + +(defun last-node (heap) + (if (no-children-p heap) + heap + (last-node (tree-child heap :side (last-direction heap))))) Added: trunk/funds/src/trees/tree-as-alist.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/tree-as-alist.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,22 @@ + +(in-package :funds-clos) + +(defgeneric tree-as-alist (tree) + (:documentation + "An association list containing the key-value pairs in the given tree.")) + +(defmethod tree-as-alist ((tree leaf)) + nil) + +(defmethod tree-as-alist ((tree binary-tree)) + (append (tree-as-alist (bt-left tree)) + (cons (cons (bt-key tree) (bt-value tree)) + (tree-as-alist (bt-right tree))))) + +(defmethod tree-as-pre-order-alist ((tree leaf)) + nil) + +(defmethod tree-as-pre-order-alist ((tree binary-tree)) + (cons (cons (bt-key tree) (bt-value tree)) + (append (tree-as-pre-order-alist (bt-left tree)) + (tree-as-pre-order-alist (bt-right tree))))) Added: trunk/funds/src/trees/tree-empty-p.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/tree-empty-p.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,12 @@ + +(in-package :funds-clos) + +(defgeneric tree-empty-p (tree) + (:documentation +"Whether this tree has any key-value pairs.")) + +(defmethod tree-empty-p ((tree t)) + nil) + +(defmethod tree-empty-p ((tree leaf)) + t) \ No newline at end of file Added: trunk/funds/src/trees/tree-find.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/tree-find.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,26 @@ + +(in-package :funds-clos) + +(defgeneric tree-find (tree key &key test order) + (:documentation +"The value to which the given key is mapped, or nil if this tree contains no +such key. The second value returned indicates whether the tree contained the +key. So + + (find t k) -> nil t + +if k maps to nil. But + + (find t k) -> nil nil + +if there is no mapping for k in the tree.")) + +(defmethod tree-find ((tree leaf) key &key test order) + (declare (ignore key test order)) + (values nil nil)) + +(defmethod tree-find (tree key &key (test #'eql) (order #'<)) + (cond ((funcall test key (bt-key tree)) (values (bt-value tree) t)) + ((funcall order key (bt-key tree)) (tree-find (bt-left tree) key + :test test :order order)) + (t (tree-find (bt-left tree) key :test test :order order)))) Added: trunk/funds/src/trees/tree-height.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/tree-height.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,17 @@ + +(in-package :funds-clos) + +(defgeneric tree-height (tree) + (:documentation "The height of the given tree.")) + +(defmethod tree-height ((tree leaf)) + 0) + +(defmethod tree-height ((tree binary-tree)) + (let ((a (tree-height (bt-left tree))) + (b (tree-height (bt-right tree)))) + (1+ (if (> a b) a b)))) + +(defmethod tree-height ((tree avl-tree)) + (avl-height tree)) + Added: trunk/funds/src/trees/tree-insert.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/tree-insert.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,52 @@ + +(in-package :funds-clos) + +(defgeneric tree-insert (tree key value &key test order) + (:documentation +"A new tree similar to the given tree except that the given key and value +are now associated with one another. If the given key is already contained +in the tree, according to the test function, then the old value is replaced +by the specified value. The order function specifies whether the given +key-value pair should be inserted to the left or right of the given tree.")) + +(defmethod tree-insert ((tree bt-leaf) key value &key test order) + (declare (ignore test order)) + (make-instance 'binary-tree + :key key + :value value)) + +(defmethod tree-insert ((tree avl-leaf) key value &key test order) + (declare (ignore test order)) + (make-avl-tree :key key + :value value)) + +(defmethod tree-insert ((tree binary-tree) key value + &key (test #'eql) (order #'<)) + (cond ((funcall test key (bt-key tree)) + (make-instance 'binary-tree + :key key + :value value + :left (bt-left tree) + :right (bt-right tree))) + ((funcall order key (bt-key tree)) + (insert tree key value + :test test :order order :side :left)) + (t (insert tree key value + :test test :order order :side :right)))) + +(defmethod insert ((tree binary-tree) key value &key test order side) + (make-instance 'binary-tree + :key (bt-key tree) + :value (bt-value tree) + side (tree-insert (tree-child tree :side side) + key value + :test test + :order order) + (other-side side) (tree-child tree :side (other-side side)))) + +(defmethod insert ((tree avl-tree) key value &key test order side) + (declare (ignore test order)) + (let* ((temp (call-next-method)) ; the temp object will be a bt, not an avl tree. + (outside (tree-child temp :side side)) + (inside (tree-child temp :side (other-side side)))) + (balance inside temp outside :heavy-side side))) Added: trunk/funds/src/trees/tree-remove.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/tree-remove.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,61 @@ + +(in-package :funds-clos) + +(defgeneric tree-remove (tree key &key test order) + (:documentation +"A new tree with the given key removed. The test function is used to compare +the tree's key to the given key. The order function is used to determine +whether the key can be found to the left or right if it is not found at the +root.")) + +(defmethod tree-remove ((tree leaf) key &key test order) + (declare (ignore test order key)) + tree) + +(defmethod tree-remove ((tree binary-tree) key &key (test #'eql) (order #'<)) + (cond ((funcall test key (bt-key tree)) + (remove-root tree :order order :test test)) + ((funcall order key (bt-key tree)) + (remove-side tree key :test test :order order :side :left)) + (t (remove-side tree key :test test :order order :side :right)))) + +(defmethod tree-remove ((tree avl-tree) key &key (test #'eql) (order #'<)) + (let* ((temp (call-next-method)) + (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))) + + +(defmethod remove-root ((tree binary-tree) &key test order) + (cond ((tree-empty-p (bt-left tree)) (bt-right tree)) + ((tree-empty-p (bt-right tree)) (bt-left tree)) + (t (remove-root-with-children tree :test test :order order)))) + +(defmethod remove-side ((tree binary-tree) key &key test order side) + (make-instance 'binary-tree + :key (bt-key tree) + :value (bt-value tree) + side (tree-remove (tree-child tree :side side) key + :test test :order order) + (other-side side) (tree-child tree :side (other-side side)))) + +(defmethod remove-root-with-children ((tree binary-tree) &key test order) + (let* ((next (next-in-order tree)) + (k (bt-key next))) + (make-instance 'binary-tree + :key k + :value (bt-value next) + :left (bt-left tree) + :right (tree-remove (bt-right tree) k :test test :order order)))) + +(defmethod remove-root-with-children ((tree avl-tree) &key test order) + (let* ((next (next-in-order tree)) + (k (bt-key next))) + (make-avl-tree :key k + :value (bt-value next) + :left (bt-left tree) + :right (tree-remove (bt-right tree) k :test test :order order)))) + Added: trunk/funds/src/trees/tree-weight.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/trees/tree-weight.lisp Sat Jul 7 22:52:17 2007 @@ -0,0 +1,16 @@ + +(in-package :funds-clos) + +(defgeneric tree-weight (tree) + (:documentation +"The number of nodes in the given tree.")) + +(defmethod tree-weight ((tree leaf)) + 0) + +(defmethod tree-weight ((tree binary-tree)) + (+ 1 (tree-weight (bt-left tree)) + (tree-weight (bt-right tree)))) + +(defmethod tree-weight ((tree heap)) + (heap-weight tree)) From abaine at common-lisp.net Sun Jul 8 03:06:09 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sat, 7 Jul 2007 23:06:09 -0400 (EDT) Subject: [funds-cvs] r60 - trunk/funds/src Message-ID: <20070708030609.567175060@common-lisp.net> Author: abaine Date: Sat Jul 7 23:06:09 2007 New Revision: 60 Removed: trunk/funds/src/funds-clos.asd Modified: trunk/funds/src/funds.asd Log: Changed system name from funds-clos to funds. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Sat Jul 7 23:06:09 2007 @@ -1,20 +1,33 @@ -;;;; -*- Lisp -*- +; -*- Lisp -*- (in-package :cl-user) - -(defpackage #:funds-asd +(defpackage #:funds-clos-asd (:use :cl :asdf)) -(in-package :funds-asd) +(in-package :funds-clos-asd) -(defsystem funds +(defsystem funds-clos :serial t :components ((:file "package") + (:file "stack") (:module trees :serial t - :components ((:file "avl-tree") - (:file "binary-tree"))) - (:module stack - :serial t - :components ((:file "stack"))))) + :components ((:file "classes") + (:file "constructors") + (:file "bt") + (:file "avl") + (:file "tree-as-alist") + (:file "tree-empty-p") + (:file "tree-insert") + (:file "tree-remove") + (:file "tree-find") + (:file "tree-weight") + (:file "tree-height") + (:module heap + :serial t + :components ((:file "heap-empty-p") + (:file "heap-insert") + (:file "heap-remove") + (:file "heap-first"))))) + (:file "queue"))) From abaine at common-lisp.net Sun Jul 8 03:14:20 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sat, 7 Jul 2007 23:14:20 -0400 (EDT) Subject: [funds-cvs] r61 - trunk/funds/src Message-ID: <20070708031420.90A7C13025@common-lisp.net> Author: abaine Date: Sat Jul 7 23:14:20 2007 New Revision: 61 Modified: trunk/funds/src/funds.asd Log: Changed funds-clos defsystem form to funds. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Sat Jul 7 23:14:20 2007 @@ -2,12 +2,13 @@ ; -*- Lisp -*- (in-package :cl-user) -(defpackage #:funds-clos-asd + +(defpackage #:funds-asd (:use :cl :asdf)) -(in-package :funds-clos-asd) +(in-package :funds-asd) -(defsystem funds-clos +(defsystem funds :serial t :components ((:file "package") (:file "stack") From abaine at common-lisp.net Sun Jul 8 03:23:18 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sat, 7 Jul 2007 23:23:18 -0400 (EDT) Subject: [funds-cvs] r62 - in trunk/funds/src: . trees trees/heap Message-ID: <20070708032318.BBED833080@common-lisp.net> Author: abaine Date: Sat Jul 7 23:23:18 2007 New Revision: 62 Modified: trunk/funds/src/queue.lisp trunk/funds/src/stack.lisp trunk/funds/src/trees/avl.lisp trunk/funds/src/trees/bt.lisp trunk/funds/src/trees/classes.lisp trunk/funds/src/trees/constructors.lisp trunk/funds/src/trees/heap/heap-empty-p.lisp trunk/funds/src/trees/heap/heap-first.lisp trunk/funds/src/trees/heap/heap-insert.lisp trunk/funds/src/trees/heap/heap-remove.lisp trunk/funds/src/trees/tree-as-alist.lisp trunk/funds/src/trees/tree-empty-p.lisp trunk/funds/src/trees/tree-find.lisp trunk/funds/src/trees/tree-height.lisp trunk/funds/src/trees/tree-insert.lisp trunk/funds/src/trees/tree-remove.lisp trunk/funds/src/trees/tree-weight.lisp Log: Changed all in-package forms to use funds rather than funds-clos. Modified: trunk/funds/src/queue.lisp ============================================================================== --- trunk/funds/src/queue.lisp (original) +++ trunk/funds/src/queue.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defstruct queue (next-priority 0) Modified: trunk/funds/src/stack.lisp ============================================================================== --- trunk/funds/src/stack.lisp (original) +++ trunk/funds/src/stack.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defun make-stack () "An empty stack." Modified: trunk/funds/src/trees/avl.lisp ============================================================================== --- trunk/funds/src/trees/avl.lisp (original) +++ trunk/funds/src/trees/avl.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defun balance (inside root outside &key heavy-side) (let ((other-side (other-side heavy-side))) Modified: trunk/funds/src/trees/bt.lisp ============================================================================== --- trunk/funds/src/trees/bt.lisp (original) +++ trunk/funds/src/trees/bt.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defun left-p (side) (eq side :left)) Modified: trunk/funds/src/trees/classes.lisp ============================================================================== --- trunk/funds/src/trees/classes.lisp (original) +++ trunk/funds/src/trees/classes.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defclass tree () () Modified: trunk/funds/src/trees/constructors.lisp ============================================================================== --- trunk/funds/src/trees/constructors.lisp (original) +++ trunk/funds/src/trees/constructors.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defun make-bt-leaf () (make-instance 'bt-leaf)) Modified: trunk/funds/src/trees/heap/heap-empty-p.lisp ============================================================================== --- trunk/funds/src/trees/heap/heap-empty-p.lisp (original) +++ trunk/funds/src/trees/heap/heap-empty-p.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defun heap-empty-p (heap) (tree-empty-p heap)) \ No newline at end of file Modified: trunk/funds/src/trees/heap/heap-first.lisp ============================================================================== --- trunk/funds/src/trees/heap/heap-first.lisp (original) +++ trunk/funds/src/trees/heap/heap-first.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defun heap-first (heap) (bt-value heap)) 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 Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defgeneric heap-insert (heap value priority &key order)) 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 Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defmethod heap-remove ((heap heap-leaf) &key order) (declare (ignore order)) Modified: trunk/funds/src/trees/tree-as-alist.lisp ============================================================================== --- trunk/funds/src/trees/tree-as-alist.lisp (original) +++ trunk/funds/src/trees/tree-as-alist.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defgeneric tree-as-alist (tree) (:documentation Modified: trunk/funds/src/trees/tree-empty-p.lisp ============================================================================== --- trunk/funds/src/trees/tree-empty-p.lisp (original) +++ trunk/funds/src/trees/tree-empty-p.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defgeneric tree-empty-p (tree) (:documentation Modified: trunk/funds/src/trees/tree-find.lisp ============================================================================== --- trunk/funds/src/trees/tree-find.lisp (original) +++ trunk/funds/src/trees/tree-find.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defgeneric tree-find (tree key &key test order) (:documentation Modified: trunk/funds/src/trees/tree-height.lisp ============================================================================== --- trunk/funds/src/trees/tree-height.lisp (original) +++ trunk/funds/src/trees/tree-height.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defgeneric tree-height (tree) (:documentation "The height of the given tree.")) Modified: trunk/funds/src/trees/tree-insert.lisp ============================================================================== --- trunk/funds/src/trees/tree-insert.lisp (original) +++ trunk/funds/src/trees/tree-insert.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defgeneric tree-insert (tree key value &key test order) (:documentation Modified: trunk/funds/src/trees/tree-remove.lisp ============================================================================== --- trunk/funds/src/trees/tree-remove.lisp (original) +++ trunk/funds/src/trees/tree-remove.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defgeneric tree-remove (tree key &key test order) (:documentation Modified: trunk/funds/src/trees/tree-weight.lisp ============================================================================== --- trunk/funds/src/trees/tree-weight.lisp (original) +++ trunk/funds/src/trees/tree-weight.lisp Sat Jul 7 23:23:18 2007 @@ -1,5 +1,5 @@ -(in-package :funds-clos) +(in-package :funds) (defgeneric tree-weight (tree) (:documentation From abaine at common-lisp.net Sun Jul 8 03:25:10 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sat, 7 Jul 2007 23:25:10 -0400 (EDT) Subject: [funds-cvs] r63 - trunk/funds/src Message-ID: <20070708032510.DD2343E05B@common-lisp.net> Author: abaine Date: Sat Jul 7 23:25:10 2007 New Revision: 63 Modified: trunk/funds/src/package.lisp Log: Changed defpackage form to funds. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Sat Jul 7 23:25:10 2007 @@ -1,7 +1,7 @@ (in-package :cl-user) -(defpackage :funds-clos +(defpackage :funds (:use :cl) (:export :make-avl-tree :make-binary-tree From abaine at common-lisp.net Sun Jul 8 03:29:15 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sat, 7 Jul 2007 23:29:15 -0400 (EDT) Subject: [funds-cvs] r64 - trunk/funds/src/trees Message-ID: <20070708032915.A9BD55D00B@common-lisp.net> Author: abaine Date: Sat Jul 7 23:29:15 2007 New Revision: 64 Modified: trunk/funds/src/trees/tree-remove.lisp Log: Added declaration to avoid compiler warnings. Modified: trunk/funds/src/trees/tree-remove.lisp ============================================================================== --- trunk/funds/src/trees/tree-remove.lisp (original) +++ trunk/funds/src/trees/tree-remove.lisp Sat Jul 7 23:29:15 2007 @@ -20,6 +20,7 @@ (t (remove-side tree key :test test :order order :side :right)))) (defmethod tree-remove ((tree avl-tree) key &key (test #'eql) (order #'<)) + (declare (ignore test order)) (let* ((temp (call-next-method)) (heavy-side (if (heavier-p temp :side :left) :left From abaine at common-lisp.net Sun Jul 8 04:34:52 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sun, 8 Jul 2007 00:34:52 -0400 (EDT) Subject: [funds-cvs] r65 - trunk/funds Message-ID: <20070708043452.AC32413026@common-lisp.net> Author: abaine Date: Sun Jul 8 00:34:52 2007 New Revision: 65 Added: trunk/funds/issues.txt Log: issues.txt has some things that have been bugging me. Added: trunk/funds/issues.txt ============================================================================== --- (empty file) +++ trunk/funds/issues.txt Sun Jul 8 00:34:52 2007 @@ -0,0 +1,13 @@ + +1. Test suite has to be updated to test avl-tree and heap. + +2. What is the implication of removing from an empty tree. Probably +just returning the same empty tree. But perhaps it should +signal an error? + +3. Build dictionary on top of avl tree. Build functional array on top +of binary tree. + +4. Documentation -- sparse in some files, nonexistent in others. + + From abaine at common-lisp.net Sun Jul 8 04:35:18 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sun, 8 Jul 2007 00:35:18 -0400 (EDT) Subject: [funds-cvs] r66 - trunk/funds Message-ID: <20070708043518.599FB1B000@common-lisp.net> Author: abaine Date: Sun Jul 8 00:35:18 2007 New Revision: 66 Added: trunk/funds/README Log: Added terse instructions. Added: trunk/funds/README ============================================================================== --- (empty file) +++ trunk/funds/README Sun Jul 8 00:35:18 2007 @@ -0,0 +1,10 @@ + +Funds is designed to be loaded with asdf, available from +http://cclan.cvs.sourceforge.net/*checkout*/cclan/asdf/asdf.lisp. + +To load the system, type at a lisp prompt: + + > (asdf-operate 'asdf:load-op 'funds) + +To see the publicly exported symbols in package "FUNDS," look at +the file funds/src/package.lisp. \ No newline at end of file From abaine at common-lisp.net Sun Jul 8 04:36:03 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Sun, 8 Jul 2007 00:36:03 -0400 (EDT) Subject: [funds-cvs] r67 - trunk/funds Message-ID: <20070708043603.91FFD1B000@common-lisp.net> Author: abaine Date: Sun Jul 8 00:36:03 2007 New Revision: 67 Modified: trunk/funds/issues.txt Log: Found another issue. Modified: trunk/funds/issues.txt ============================================================================== --- trunk/funds/issues.txt (original) +++ trunk/funds/issues.txt Sun Jul 8 00:36:03 2007 @@ -10,4 +10,3 @@ 4. Documentation -- sparse in some files, nonexistent in others. - From abaine at common-lisp.net Tue Jul 10 11:36:57 2007 From: abaine at common-lisp.net (abaine at common-lisp.net) Date: Tue, 10 Jul 2007 07:36:57 -0400 (EDT) Subject: [funds-cvs] r68 - trunk/public_html Message-ID: <20070710113657.7442A1703B@common-lisp.net> Author: abaine Date: Tue Jul 10 07:36:55 2007 New Revision: 68 Modified: trunk/public_html/index.html Log: Switched to apache license. Modified: trunk/public_html/index.html ============================================================================== --- trunk/public_html/index.html (original) +++ trunk/public_html/index.html Tue Jul 10 07:36:55 2007 @@ -16,8 +16,8 @@

The goal of the Funds project is to provide portable, purely functional, efficient data structures written in Common Lisp. Funds is open source software released under the - - MIT License + + Apache License .

Mailing Lists

@@ -40,9 +40,10 @@ development as a Google Summer of Code Project, and a release is planned for - July 13, 2007. + August 20, 2007. In the meantime, the sources are available from + subversion repository. -

+

Project members