funds-cvs August 2007

funds-cvs@common-lisp.net

1 participants
113 discussions

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

20 Aug '07

Author: abaine Date: Sun Aug 19 21:50:55 2007 New Revision: 184 Modified: trunk/funds/src/package.lisp Log: Exported map-stack and map-queue. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Sun Aug 19 21:50:55 2007 @@ -48,12 +48,14 @@ :queue-dequeue :queue-first :queue-size + :map-queue :make-stack :stack-empty-p :stack-push :stack-top :stack-size + :map-stack :make-dictionary :dictionary-add

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 21:49:51 2007 New Revision: 183 Modified: trunk/funds/src/stack.lisp Log: Added map-stack. Modified: trunk/funds/src/stack.lisp ============================================================================== --- trunk/funds/src/stack.lisp (original) +++ trunk/funds/src/stack.lisp Sun Aug 19 21:49:51 2007 @@ -44,3 +44,8 @@ accum (f (stack-pop stack) (1+ accum))))) (f stack 0))) + +(defun map-stack (function stack) + "A stack whose elements are those of the given stack when function is applied +to them." + (mapcar function stack)) \ No newline at end of file

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 21:41:18 2007 New Revision: 182 Modified: trunk/funds/src/trees/utilities.lisp Log: Documented map-tree. Modified: trunk/funds/src/trees/utilities.lisp ============================================================================== --- trunk/funds/src/trees/utilities.lisp (original) +++ trunk/funds/src/trees/utilities.lisp Sun Aug 19 21:41:18 2007 @@ -18,6 +18,8 @@ (tree-count-if predicate (bt-right tree) :key key)))) (defun map-tree (function tree) + "A tree each node of which corresponds to the application of +function to one node of the given tree." (if (tree-empty-p tree) tree (stitch-tree tree

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 21:40:08 2007 New Revision: 181 Modified: trunk/funds/src/package.lisp Log: Exported map-tree. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Sun Aug 19 21:40:08 2007 @@ -34,6 +34,7 @@ :tree-as-alist :tree-count :tree-count-if + :map-tree :make-heap :heap-empty-p

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 21:38:24 2007 New Revision: 180 Modified: trunk/funds/src/trees/utilities.lisp Log: Added map-tree. Modified: trunk/funds/src/trees/utilities.lisp ============================================================================== --- trunk/funds/src/trees/utilities.lisp (original) +++ trunk/funds/src/trees/utilities.lisp Sun Aug 19 21:38:24 2007 @@ -16,3 +16,12 @@ 1 0) (tree-count-if predicate (bt-right tree) :key key)))) + +(defun map-tree (function tree) + (if (tree-empty-p tree) + tree + (stitch-tree tree + :value (funcall function tree) + :left (map-tree function (bt-left tree)) + :right (map-tree function (bt-right tree))))) +

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 21:21:46 2007 New Revision: 179 Modified: trunk/funds/src/examples/sudoku.lisp Log: Simplified solver, somehow slowing it down! Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Sun Aug 19 21:21:46 2007 @@ -46,11 +46,8 @@ (round (expt (puzzle-size puzzle) 3)))) (defun puzzle-solved-p (puzzle) - (let ((size (puzzle-size puzzle))) - (iter (for x below size) - (always (iter (for y below size) - (always (iter (for f in x-y-z-functions) - (always (group-solved puzzle f x y))))))))) + (= (round (expt (puzzle-size puzzle) 2)) + (tree-count +true+ (puzzle-tree puzzle) :key #'bt-value :test #'=))) (defun puzzle-solvable-p (puzzle) (let ((size (puzzle-size puzzle))) @@ -129,14 +126,12 @@ ""))))))))) (defun puzzle-solve (puzzle) - (if (puzzle-solvable-p puzzle) - (if (puzzle-complete-p puzzle) - puzzle - (iter (for f in x-y-z-functions) - (for (values x y n) = (best-group puzzle f)) - (finding (list f x y) minimizing n into (best-list min)) - (finally (return (apply #'solve-group puzzle best-list))))) - nil)) + (if (puzzle-complete-p puzzle) + puzzle + (iter (for f in x-y-z-functions) + (for (values x y n) = (best-group puzzle f)) + (finding (list f x y) minimizing n into (best-list min)) + (finally (return (apply #'solve-group puzzle best-list)))))) (defun best-group (puzzle x-y-z-function) (let ((size (puzzle-size puzzle)))

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 21:18:02 2007 New Revision: 178 Modified: trunk/funds/src/package.lisp Log: Exported bt-key and bt-value. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Sun Aug 19 21:18:02 2007 @@ -22,6 +22,9 @@ (:export :make-avl-tree :make-binary-tree + :bt-key + :bt-value + :tree-insert :tree-remove :tree-find

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 21:04:25 2007 New Revision: 177 Modified: trunk/funds/src/examples/sudoku.lisp Log: Removed stupid 'optimization' from solver. Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Sun Aug 19 21:04:25 2007 @@ -135,8 +135,6 @@ (iter (for f in x-y-z-functions) (for (values x y n) = (best-group puzzle f)) (finding (list f x y) minimizing n into (best-list min)) - (when (= min 1) - (return (apply #'solve-group puzzle best-list))) (finally (return (apply #'solve-group puzzle best-list))))) nil)) @@ -147,13 +145,9 @@ (iter (for y below size) (for n = (group-freedom puzzle x-y-z-function x y)) (finding y minimizing n into (best-y min)) - (when (= min 1) - (return (values best-y min))) (finally (return (values best-y min))))) (finding x minimizing n into best-x) (finding y minimizing n into (best-y best-n)) - (when (= best-n 1) - (return (values best-x best-y best-n))) (finally (return (values best-x best-y best-n)))))) (defun group-freedom (puzzle x-y-z-function x y)

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 17:46:09 2007 New Revision: 176 Modified: trunk/funds/src/trees/utilities.lisp Log: Fixed tree-count and tree-count-if. Modified: trunk/funds/src/trees/utilities.lisp ============================================================================== --- trunk/funds/src/trees/utilities.lisp (original) +++ trunk/funds/src/trees/utilities.lisp Sun Aug 19 17:46:09 2007 @@ -1,18 +1,18 @@ (in-package :funds) -(defun tree-count (item tree &key (key #'bt-value) (test #'eql)) +(defun tree-count (item tree &key (key #'identity) (test #'eql)) "The number of sub-trees in the tree that satisfy the test." - (tree-count #'(lambda (x) - (funcall test x item)) - :key key)) + (tree-count-if #'(lambda (x) (funcall test x item)) + tree + :key key)) -(defun tree-count-if (predicate tree &key (key #'bt-value)) +(defun tree-count-if (predicate tree &key (key #'identity)) "The number of sub-trees in the given tree that satisfy the test." (if (tree-empty-p tree) 0 (+ (tree-count-if predicate (bt-left tree) :key key) - (funcall predicate (funcall key tree)) + (if (funcall predicate (funcall key tree)) + 1 + 0) (tree-count-if predicate (bt-right tree) :key key)))) - -

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 17:45:44 2007 New Revision: 175 Modified: trunk/funds/src/package.lisp Log: Exported tree-as-alist, tree-count, and tree-count-if. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Sun Aug 19 17:45:44 2007 @@ -28,6 +28,9 @@ :tree-empty-p :tree-height :tree-weight + :tree-as-alist + :tree-count + :tree-count-if :make-heap :heap-empty-p

1 0

← Newer
1
2
3
4
5
6
7
...
12
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

funds-cvs August 2007