August 2007 - funds-cvs@common-lisp.net - mailman3.common-lisp.net

[funds-cvs] r134 - trunk/funds/src/examples
by abaine＠common-lisp.net 11 Aug '07

11 Aug '07

Author: abaine Date: Fri Aug 10 20:12:23 2007 New Revision: 134 Added: trunk/funds/src/examples/ trunk/funds/src/examples/sudoku.lisp Log: Added sudoku example file. Added: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/examples/sudoku.lisp Fri Aug 10 20:12:23 2007 @@ -0,0 +1,16 @@ + +(in-package :funds) + +(defun puzzle-from-list (list-rep) + (let ((size (length list-rep))) + (make-f-array (expt size 3) + :initial-contents (mapcan #'(lambda (row) + (mapcan #'(lambda (elt) + (loop for i below size + collect (= i (1- elt)))) + row)) + list-rep)))) + + + +

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 18:33:42 2007 New Revision: 133 Modified: trunk/funds/src/package.lisp Log: Exported f-array-size. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Fri Aug 10 18:33:42 2007 @@ -55,4 +55,5 @@ :make-f-array :f-array-elt - :f-array-replace)) + :f-array-replace + :f-array-size))

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 18:32:46 2007 New Revision: 132 Modified: trunk/funds/src/f-array.lisp Log: Fixed f-array-size. Modified: trunk/funds/src/f-array.lisp ============================================================================== --- trunk/funds/src/f-array.lisp (original) +++ trunk/funds/src/f-array.lisp Fri Aug 10 18:32:46 2007 @@ -25,5 +25,5 @@ (labels ((f (tree amount) (if (tree-empty-p tree) amount - (f (bt-right tree) (bt-key tree))))) + (f (bt-right tree) (1+ (bt-key tree)))))) (f array 0)))

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 18:26:43 2007 New Revision: 131 Modified: trunk/funds/src/f-array.lisp Log: Implemented f-array-elt, f-array-replace, and f-array-size. Modified: trunk/funds/src/f-array.lisp ============================================================================== --- trunk/funds/src/f-array.lisp (original) +++ trunk/funds/src/f-array.lisp Fri Aug 10 18:26:43 2007 @@ -16,7 +16,14 @@ (f 0 size)))) (defun f-array-elt (array index) - ) + (tree-find array index :test #'=)) (defun f-array-replace (array index item) - ) + (tree-insert array index item :test #'=)) + +(defun f-array-size (array) + (labels ((f (tree amount) + (if (tree-empty-p tree) + amount + (f (bt-right tree) (bt-key tree))))) + (f array 0)))

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 18:15:27 2007 New Revision: 130 Modified: trunk/funds/src/f-array.lisp Log: Implemented make-f-array. Modified: trunk/funds/src/f-array.lisp ============================================================================== --- trunk/funds/src/f-array.lisp (original) +++ trunk/funds/src/f-array.lisp Fri Aug 10 18:15:27 2007 @@ -2,7 +2,18 @@ (in-package :funds) (defun make-f-array (size &key (initial-contents nil)) - ) + (let ((length (length initial-contents))) + (labels ((f (start end) + (if (= start end) + (make-binary-tree) + (let ((midpoint (floor (+ end start) 2))) + (make-instance 'binary-tree + :key midpoint :value (if (< start length) + (elt initial-contents midpoint) + nil) + :left (f start midpoint) + :right (f (1+ midpoint) end)))))) + (f 0 size)))) (defun f-array-elt (array index) )

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 18:14:53 2007 New Revision: 129 Modified: trunk/funds/src/trees/tree-find.lisp Log: Corrected problem with tree-find algorithm. Modified: trunk/funds/src/trees/tree-find.lisp ============================================================================== --- trunk/funds/src/trees/tree-find.lisp (original) +++ trunk/funds/src/trees/tree-find.lisp Fri Aug 10 18:14:53 2007 @@ -39,4 +39,4 @@ (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)))) + (t (tree-find (bt-right tree) key :test test :order order))))

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 18:14:09 2007 New Revision: 128 Modified: trunk/funds/src/funds.asd Log: Renamed array file to f-array. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Fri Aug 10 18:14:09 2007 @@ -48,7 +48,7 @@ (:file "heap-insert") (:file "heap-remove") (:file "heap-first"))))) - (:file "array") + (:file "f-array") (:file "dictionary") (:file "queue")))

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 17:09:14 2007 New Revision: 127 Modified: trunk/funds/src/f-array.lisp Log: Added f-array stubs. Modified: trunk/funds/src/f-array.lisp ============================================================================== --- trunk/funds/src/f-array.lisp (original) +++ trunk/funds/src/f-array.lisp Fri Aug 10 17:09:14 2007 @@ -1,2 +1,11 @@ (in-package :funds) + +(defun make-f-array (size &key (initial-contents nil)) + ) + +(defun f-array-elt (array index) + ) + +(defun f-array-replace (array index item) + )

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 17:02:29 2007 New Revision: 126 Added: trunk/funds/src/f-array.lisp Log: Added f-array.lisp. Added: trunk/funds/src/f-array.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/f-array.lisp Fri Aug 10 17:02:29 2007 @@ -0,0 +1,2 @@ + +(in-package :funds)

1 0

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

10 Aug '07

Author: abaine Date: Fri Aug 10 16:58:12 2007 New Revision: 125 Modified: trunk/funds/src/funds.asd Log: Added array file to defsystem form. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Fri Aug 10 16:58:12 2007 @@ -48,6 +48,7 @@ (:file "heap-insert") (:file "heap-remove") (:file "heap-first"))))) + (:file "array") (:file "dictionary") (:file "queue")))

1 0