funds-cvs

funds-cvs@common-lisp.net

225 discussions

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

20 Aug '07

Author: abaine Date: Mon Aug 20 11:40:20 2007 New Revision: 188 Modified: trunk/funds/src/package.lisp Log: Exported queue-from-list. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Mon Aug 20 11:40:20 2007 @@ -49,6 +49,7 @@ :queue-first :queue-size :queue-as-list + :queue-from-list :map-queue :make-stack

1 0

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

20 Aug '07

Author: abaine Date: Mon Aug 20 11:40:04 2007 New Revision: 187 Modified: trunk/funds/src/queue.lisp Log: Added queue-from-list. Modified: trunk/funds/src/queue.lisp ============================================================================== --- trunk/funds/src/queue.lisp (original) +++ trunk/funds/src/queue.lisp Mon Aug 20 11:40:04 2007 @@ -59,3 +59,10 @@ would be dequeued from the given queue." (mapcar #'cdr (sort (tree-as-alist (queue-heap q)) #'< :key #'car))) + +(defun queue-from-list (list) + "A queue whose elements are in the same order as the given list." + (reduce #'(lambda (q n) + (queue-enqueue q n)) + list + :initial-value (make-queue)))

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 22:20:06 2007 New Revision: 186 Modified: trunk/funds/src/package.lisp Log: Exported queue-as-list. Modified: trunk/funds/src/package.lisp ============================================================================== --- trunk/funds/src/package.lisp (original) +++ trunk/funds/src/package.lisp Sun Aug 19 22:20:06 2007 @@ -48,6 +48,7 @@ :queue-dequeue :queue-first :queue-size + :queue-as-list :map-queue :make-stack

1 0

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

20 Aug '07

Author: abaine Date: Sun Aug 19 22:07:40 2007 New Revision: 185 Modified: trunk/funds/src/queue.lisp Log: Added map-queue and queue-as-list. Modified: trunk/funds/src/queue.lisp ============================================================================== --- trunk/funds/src/queue.lisp (original) +++ trunk/funds/src/queue.lisp Sun Aug 19 22:07:40 2007 @@ -45,3 +45,17 @@ (defun queue-empty-p (q) "Whether the given queue does not contain any items." (tree-empty-p (queue-heap q))) + +(defun map-queue (function q) + "A queue containing items that are the result of applying function to +the items in the given queue." + (make-queue :next-priority (queue-next-priority q) + :heap (map-tree #'(lambda (tree) + (funcall function (bt-value tree))) + (queue-heap q)))) + +(defun queue-as-list (q) + "The elements in the given queue, returned as a list, in the order they +would be dequeued from the given queue." + (mapcar #'cdr (sort (tree-as-alist (queue-heap q)) + #'< :key #'car)))

1 0

[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

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

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

funds-cvs