funds-cvs August 2007

funds-cvs@common-lisp.net

1 participants
113 discussions

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

10 Aug '07

Author: abaine Date: Fri Aug 10 16:57:51 2007 New Revision: 124 Modified: trunk/funds/src/package.lisp Log: Added f-array interface. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Fri Aug 10 16:57:51 2007 @@ -51,4 +51,8 @@ :make-dictionary :dictionary-add :dictionary-remove - :dictionary-lookup)) + :dictionary-lookup + + :make-f-array + :f-array-elt + :f-array-replace))

1 0

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

08 Aug '07

Author: abaine Date: Tue Aug 7 22:34:25 2007 New Revision: 123 Modified: trunk/funds/src/dictionary.lisp Log: Implimented dictionary functionality. Modified: trunk/funds/src/dictionary.lisp ============================================================================== --- trunk/funds/src/dictionary.lisp (original) +++ trunk/funds/src/dictionary.lisp Tue Aug 7 22:34:25 2007 @@ -2,14 +2,38 @@ (in-package :funds) (defstruct dict - hash-function - test-function + hash + test tree) -(defun make-dictionary (&key hash-function test)) +(defun make-dictionary (&key (hash #'sxhash) (test #'eql)) + (make-dict :hash hash :test test :tree (make-avl-tree))) -(defun dictionary-add (dictionary key value)) +(defun dictionary-add (d k v) + (let* ((h (funcall (dict-hash d) k)) + (old-alist (tree-find (dict-tree d) h)) + (new-alist (acons k v (remove (assoc k old-alist :test (dict-test d)) + old-alist)))) + (make-dict :hash (dict-hash d) + :test (dict-test d) + :tree (tree-insert (dict-tree d) h new-alist)))) -(defun dictionary-remove (dictionary key)) +(defun dictionary-remove (d k) + (let* ((h (funcall (dict-hash d) k)) + (old-alist (tree-find (dict-tree d) h)) + (new-alist (remove (assoc k old-alist :test (dict-test d)) + old-alist))) + (make-dict :hash (dict-hash d) + :test (dict-test d) + :tree (if (null new-alist) + (tree-remove (dict-tree d) h) + (tree-insert (dict-tree d) h new-alist))))) + +(defun dictionary-lookup (d k) + (let ((pair (assoc k + (tree-find (dict-tree d) (funcall (dict-hash d) k)) + :test (dict-test d)))) + (if (null pair) + (values nil nil) + (values (cdr pair) t)))) -(defun dictionary-lookup (dictionary key))

1 0

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

08 Aug '07

Author: abaine Date: Tue Aug 7 20:58:03 2007 New Revision: 122 Modified: trunk/funds/src/dictionary.lisp Log: Added stubs for dictionary interface. Modified: trunk/funds/src/dictionary.lisp ============================================================================== --- trunk/funds/src/dictionary.lisp (original) +++ trunk/funds/src/dictionary.lisp Tue Aug 7 20:58:03 2007 @@ -1,3 +1,15 @@ (in-package :funds) +(defstruct dict + hash-function + test-function + tree) + +(defun make-dictionary (&key hash-function test)) + +(defun dictionary-add (dictionary key value)) + +(defun dictionary-remove (dictionary key)) + +(defun dictionary-lookup (dictionary key))

1 0

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

08 Aug '07

Author: abaine Date: Tue Aug 7 20:49:44 2007 New Revision: 121 Added: trunk/funds/src/dictionary.lisp Log: Added dictionary.lisp. Added: trunk/funds/src/dictionary.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/dictionary.lisp Tue Aug 7 20:49:44 2007 @@ -0,0 +1,3 @@ + +(in-package :funds) +

1 0

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

08 Aug '07

Author: abaine Date: Tue Aug 7 20:41:15 2007 New Revision: 120 Modified: trunk/funds/src/funds.asd Log: Added dictionary to defsystem. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Tue Aug 7 20:41:15 2007 @@ -48,4 +48,6 @@ (:file "heap-insert") (:file "heap-remove") (:file "heap-first"))))) + (:file "dictionary") (:file "queue"))) +

1 0

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

08 Aug '07

Author: abaine Date: Tue Aug 7 20:32:00 2007 New Revision: 119 Modified: trunk/funds/src/package.lisp Log: Added dictionary interface to exported symbols. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Tue Aug 7 20:32:00 2007 @@ -46,4 +46,9 @@ :stack-empty-p :stack-push :stack-top - :stack-size)) + :stack-size + + :make-dictionary + :dictionary-add + :dictionary-remove + :dictionary-lookup))

1 0

[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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

funds-cvs August 2007