funds-cvs August 2007

funds-cvs@common-lisp.net

1 participants
113 discussions

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

19 Aug '07

Author: abaine Date: Sun Aug 19 11:50:29 2007 New Revision: 154 Modified: trunk/funds/src/trees/tree-insert.lisp Log: superficiale Modified: trunk/funds/src/trees/tree-insert.lisp ============================================================================== --- trunk/funds/src/trees/tree-insert.lisp (original) +++ trunk/funds/src/trees/tree-insert.lisp Sun Aug 19 11:50:29 2007 @@ -33,7 +33,6 @@ (declare (ignore test order)) (stitch-avl-tree :key key :value value)) - (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))

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 11:37:55 2007 New Revision: 153 Modified: trunk/funds/src/heap/heap.lisp trunk/funds/src/trees/classes.lisp Log: Moved heap classes from trees/classes.lisp to heap/heap.lisp. Modified: trunk/funds/src/heap/heap.lisp ============================================================================== --- trunk/funds/src/heap/heap.lisp (original) +++ trunk/funds/src/heap/heap.lisp Sun Aug 19 11:37:55 2007 @@ -1,6 +1,16 @@ (in-package :funds) +(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))) + (defun make-heap (&key (priority 0 p-p) value (left (make-heap-leaf)) (right (make-heap-leaf))) (if p-p Modified: trunk/funds/src/trees/classes.lisp ============================================================================== --- trunk/funds/src/trees/classes.lisp (original) +++ trunk/funds/src/trees/classes.lisp Sun Aug 19 11:37:55 2007 @@ -45,13 +45,3 @@ (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)))

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 11:30:24 2007 New Revision: 152 Modified: trunk/funds/src/trees/classes.lisp Log: Cosmetic changes. Modified: trunk/funds/src/trees/classes.lisp ============================================================================== --- trunk/funds/src/trees/classes.lisp (original) +++ trunk/funds/src/trees/classes.lisp Sun Aug 19 11:30:24 2007 @@ -55,7 +55,3 @@ (left :initform (make-heap)) (right :initform (make-heap)) (weight :initarg :weight :initform 1 :reader heap-weight))) - - - -

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 11:28:00 2007 New Revision: 151 Modified: trunk/funds/src/funds.asd Log: Moved heap module in defsystem. Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Sun Aug 19 11:28:00 2007 @@ -40,14 +40,14 @@ (:file "tree-remove") (:file "tree-find") (:file "tree-weight") - (:file "tree-height") - (:module heap - :serial t - :components ((:file "heap") - (:file "heap-empty-p") - (:file "heap-insert") - (:file "heap-remove") - (:file "heap-first"))))) + (:file "tree-height"))) + (:module heap + :serial t + :components ((:file "heap") + (:file "heap-empty-p") + (:file "heap-insert") + (:file "heap-remove") + (:file "heap-first"))) (:file "f-array") (:file "dictionary") (:file "queue")))

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 11:25:39 2007 New Revision: 150 Added: trunk/funds/src/heap/ - copied from r149, trunk/funds/src/trees/heap/ Removed: trunk/funds/src/trees/heap/ Log: Moved heap to top directory.

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 11:07:40 2007 New Revision: 149 Modified: trunk/funds/src/examples/sudoku.lisp Log: Renamed solve do puzzle-solve and added (solve list). Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Sun Aug 19 11:07:40 2007 @@ -4,6 +4,9 @@ (defconstant +false+ 0) (defconstant +true+ 1) +(defun solve (list) + (list-from-puzzle (puzzle-solve (puzzle-from-list list)))) + (defstruct puzzle size tree) @@ -125,7 +128,7 @@ (collect (or (puzzle-elt puzzle i j k) ""))))))))) -(defun solve (puzzle) +(defun puzzle-solve (puzzle) (if (puzzle-solvable-p puzzle) (if (puzzle-complete-p puzzle) puzzle @@ -174,7 +177,7 @@ (funcall x-y-z-function x y z size) (if (puzzle-elt puzzle i j k) (f (1+ z)) - (or (solve (fill-true puzzle i j k)) + (or (puzzle-solve (fill-true puzzle i j k)) (f (1+ z)))))))) (f 0))))

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 11:03:31 2007 New Revision: 148 Added: trunk/funds/src/examples/puzzles.lisp Log: Added puzzles. Added: trunk/funds/src/examples/puzzles.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/examples/puzzles.lisp Sun Aug 19 11:03:31 2007 @@ -0,0 +1,22 @@ + +(in-package :funds-examples) + +(defconstant p1 '((7 0 0 1 0 8 0 0 0) + (0 9 0 0 0 0 0 3 2) + (0 0 0 0 0 5 0 0 0) + (0 0 0 0 0 0 1 0 0) + (9 6 0 0 2 0 0 0 0) + (0 0 0 0 0 0 8 0 0) + (0 0 0 0 0 0 0 0 0) + (0 0 5 0 0 1 0 0 0) + (3 2 0 0 0 0 0 0 6))) + +(defconstant p2 '((0 8 2 0 1 0 0 0 0) + (7 0 0 0 0 0 0 3 0) + (0 0 0 0 0 6 0 0 5) + (0 0 0 0 0 0 0 8 0) + (3 0 0 7 0 0 0 0 0) + (0 0 0 0 0 0 1 0 4) + (4 0 1 0 0 0 0 0 6) + (0 0 0 0 5 0 0 0 0) + (0 0 0 8 0 0 0 0 0)))

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 11:03:03 2007 New Revision: 147 Modified: trunk/funds/src/examples/funds-examples.asd Log: Added puzzles to defsystem. Modified: trunk/funds/src/examples/funds-examples.asd ============================================================================== --- trunk/funds/src/examples/funds-examples.asd (original) +++ trunk/funds/src/examples/funds-examples.asd Sun Aug 19 11:03:03 2007 @@ -11,5 +11,6 @@ (defsystem funds-examples :serial t :components ((:file "package") - (:file "sudoku")) + (:file "sudoku") + (:file "puzzles")) :depends-on (:iterate :funds))

1 0

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

19 Aug '07

Author: abaine Date: Sun Aug 19 10:58:45 2007 New Revision: 146 Modified: trunk/funds/src/examples/package.lisp Log: Exported solve from example. Modified: trunk/funds/src/examples/package.lisp ============================================================================== --- trunk/funds/src/examples/package.lisp (original) +++ trunk/funds/src/examples/package.lisp Sun Aug 19 10:58:45 2007 @@ -2,4 +2,6 @@ (in-package :cl-user) (defpackage :funds-examples - (:use :cl :funds :iterate)) \ No newline at end of file + (:use :cl :funds :iterate) + (:export :solve + :p1 :p2)) \ No newline at end of file

1 0

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

19 Aug '07

Author: abaine Date: Sat Aug 18 21:02:29 2007 New Revision: 145 Modified: trunk/funds/src/examples/sudoku.lisp Log: Good solver. Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Sat Aug 18 21:02:29 2007 @@ -8,18 +8,8 @@ size tree) -(defun puzzle-find (puzzle i j k) - (multiple-value-bind (v found) - (tree-find (puzzle-tree puzzle) (index i j k (puzzle-size puzzle))) - (values v found))) - -(defun puzzle-elt-solved (puzzle i j k) - (multiple-value-bind (v found) - (puzzle-find puzzle i j k) - found)) - (defun puzzle-elt (puzzle i j k) - (puzzle-find puzzle i j k)) + (tree-find (puzzle-tree puzzle) (index i j k (puzzle-size puzzle)))) (defun elt-true-p (elt) (and elt (= elt +true+))) @@ -48,6 +38,24 @@ (return (1+ k))) (finally (return 0))))))))) +(defun puzzle-complete-p (puzzle) + (= (tree-weight (puzzle-tree puzzle)) + (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))))))))) + +(defun puzzle-solvable-p (puzzle) + (let ((size (puzzle-size puzzle))) + (iter (for f in x-y-z-functions) + (always (iter (for x below size) + (always (iter (for y below size) + (always (group-solvable puzzle f x y))))))))) + (defun fill-true (puzzle i j k) (fill-falses (set-to-true puzzle i j k) i j k)) @@ -118,16 +126,16 @@ ""))))))))) (defun solve (puzzle) - (if (complete-p puzzle) - (if (solved-p puzzle) + (if (puzzle-solvable-p puzzle) + (if (puzzle-complete-p puzzle) puzzle - nil) - (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)))))) + (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)) (defun best-group (puzzle x-y-z-function) (let ((size (puzzle-size puzzle))) @@ -164,24 +172,12 @@ (if (= z size) nil (multiple-value-bind (i j k) (funcall x-y-z-function x y z size) - (if (puzzle-elt-solved puzzle i j k) + (if (puzzle-elt puzzle i j k) (f (1+ z)) (or (solve (fill-true puzzle i j k)) (f (1+ z)))))))) - (f 0)))) -(defun complete-p (puzzle) - (= (tree-weight (puzzle-tree puzzle)) - (round (expt (puzzle-size puzzle) 3)))) - -(defun 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))))))))) - (defun i-j-k-coordinates (i j k size) (declare (ignore size)) (values i j k)) @@ -209,13 +205,6 @@ #'puzzle-elt puzzle (funcall x-y-z-function x y z size)))))))) -(defun puzzle-solvable (puzzle) - (let ((size (puzzle-size puzzle))) - (iter (for f in x-y-z-functions) - (always (iter (for x below size) - (always (iter (for y below size) - (always (group-solvable puzzle f x y))))))))) - (defun group-solvable (puzzle x-y-z-function x y) (let ((size (puzzle-size puzzle))) (iter (for z below size)

1 0

← Newer
1
...
4
5
6
7
8
9
10
11
12
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

funds-cvs August 2007