funds-cvs August 2007

funds-cvs@common-lisp.net

1 participants
113 discussions

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

28 Aug '07

Author: abaine Date: Mon Aug 27 21:04:23 2007 New Revision: 214 Modified: trunk/funds/src/dictionary.lisp Log: Fixed faulty dictionary-from-alist. Modified: trunk/funds/src/dictionary.lisp ============================================================================== --- trunk/funds/src/dictionary.lisp (original) +++ trunk/funds/src/dictionary.lisp Mon Aug 27 21:04:23 2007 @@ -57,8 +57,8 @@ (f (bt-right tree)))))) (f (dict-tree d)))) -(defun dictionary-from-alist (alist) +(defun dictionary-from-alist (alist &key (test #'eql) (hash #'sxhash)) (reduce #'(lambda (d pair) (dictionary-add d (car pair) (cdr pair))) alist - :initial-value (make-dictionary))) \ No newline at end of file + :initial-value (make-dictionary :test test :hash hash))) \ No newline at end of file

1 0

[funds-cvs] r213 - trunk/funds/examples
by abaine＠common-lisp.net 21 Aug '07

21 Aug '07

Author: abaine Date: Tue Aug 21 13:30:41 2007 New Revision: 213 Modified: trunk/funds/examples/sudoku.lisp Log: Eliminated un-needed functions from solver. Modified: trunk/funds/examples/sudoku.lisp ============================================================================== --- trunk/funds/examples/sudoku.lisp (original) +++ trunk/funds/examples/sudoku.lisp Tue Aug 21 13:30:41 2007 @@ -46,15 +46,10 @@ (round (expt (puzzle-size puzzle) 3)))) (defun puzzle-solved-p (puzzle) - (= (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))) - (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))))))))) + (= (round (expt size 2)) + (tree-count +true+ (puzzle-tree + puzzle) :key #'bt-value :test #'=)))) (defun fill-true (puzzle i j k) (fill-falses (set-to-true puzzle i j k) i j k)) @@ -190,21 +185,6 @@ (mod x order)) k))) -(defun group-solved (puzzle x-y-z-function x y) - (let ((size (puzzle-size puzzle))) - (= 1 (iter (for z below size) - (count (elt-true-p (multiple-value-call - #'puzzle-elt puzzle - (funcall x-y-z-function x y z size)))))))) - -(defun group-solvable (puzzle x-y-z-function x y) - (let ((size (puzzle-size puzzle))) - (iter (for z below size) - (for elt = (multiple-value-call #'puzzle-elt - puzzle (funcall x-y-z-function x y z size))) - (thereis (or (elt-unknown-p elt) - (elt-true-p elt)))))) - (defvar x-y-z-functions (list #'i-j-k-coordinates #'i-k-j-coordinates #'j-k-i-coordinates

1 0

[funds-cvs] r212 - trunk/funds/examples
by abaine＠common-lisp.net 21 Aug '07

21 Aug '07

Author: abaine Date: Tue Aug 21 08:32:48 2007 New Revision: 212 Modified: trunk/funds/examples/sudoku.lisp Log: Fixed solver (!) and made pretty printer. Modified: trunk/funds/examples/sudoku.lisp ============================================================================== --- trunk/funds/examples/sudoku.lisp (original) +++ trunk/funds/examples/sudoku.lisp Tue Aug 21 08:32:48 2007 @@ -126,7 +126,7 @@ ""))))))))) (defun puzzle-solve (puzzle) - (if (puzzle-complete-p puzzle) + (if (puzzle-solved-p puzzle) puzzle (iter (for f in x-y-z-functions) (for (values x y n) = (best-group puzzle f)) @@ -209,3 +209,49 @@ #'i-k-j-coordinates #'j-k-i-coordinates #'b-k-x-coordinates)) + +(defun print-sudoku (list) + (let* ((size (length list)) + (order (order size))) + (labels ((f (result list i) + (if (null list) + result + (f (concatenate 'string result + (if (zerop (mod i order)) + (filler-string size) + "") + (row-as-string (first list))) + (rest list) + (1+ i))))) + (concatenate 'string (f (format nil "~%") list 0) + (filler-string size))))) + +(defun row-as-string (row) + (let* ((size (length row)) + (order (order size))) + (labels ((f (result list i) + (if (null list) + result + (f (concatenate 'string result + (if (zerop (mod i order)) + "| " + "") + (format nil "~2A" (if (zerop (first list)) + "" + (first list)))) + (rest list) + (1+ i))))) + (concatenate 'string (format nil "~%") (f "" row 0) "|")))) + +(defun filler-string (size) + (let ((order (order size))) + (labels ((f (result i) + (if (= i size) + result + (f (concatenate 'string result + (if (zerop (mod i order)) + "+-" + "") + "--") + (1+ i))))) + (concatenate 'string (format nil "~%") (f "" 0) "+"))))

1 0

[funds-cvs] r211 - tags/funds-gsoc-snapshot
by abaine＠common-lisp.net 20 Aug '07

20 Aug '07

Author: abaine Date: Mon Aug 20 14:41:54 2007 New Revision: 211 Added: tags/funds-gsoc-snapshot/ - copied from r210, trunk/funds/ Log: Tagging the google summer of code release.

1 0

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

20 Aug '07

Author: abaine Date: Mon Aug 20 14:34:51 2007 New Revision: 210 Added: public_html/ - copied from r209, trunk/public_html/ Removed: trunk/public_html/ Log: Moved web-page to top-level of repository; there was no reason for it to be included in trunk.

1 0

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

20 Aug '07

Author: abaine Date: Mon Aug 20 14:30:57 2007 New Revision: 209 Modified: trunk/public_html/index.html Log: Updated homepage to include gsoc snapshot. Modified: trunk/public_html/index.html ============================================================================== --- trunk/public_html/index.html (original) +++ trunk/public_html/index.html Mon Aug 20 14:30:57 2007 @@ -36,12 +36,12 @@ <h3>Download</h3> - <p>This project has not released any files. It is under active - development as a <a + <p>Funds is under active development as a <a href="http://code.google.com/soc/lispnyc/appinfo.html?csaid=F098323F679401F6"> - Google Summer of Code Project</a>, and a release is planned for - August 20, 2007. In the meantime, the sources are available from - subversion repository. + Google Summer of Code Project</a>. The current release is the google summer of +code submission: <a href="funds-gsoc-snapshot.tar.gz"> funds-gsoc-snapshot.tar.gz</a> +. Further releases can be expected before the end of the summer. In the meantime, +more recent sources are available from the subversion repository. </p>

1 0

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

20 Aug '07

Author: abaine Date: Mon Aug 20 14:08:14 2007 New Revision: 208 Modified: trunk/funds/README Log: Superficial. Modified: trunk/funds/README ============================================================================== --- trunk/funds/README (original) +++ trunk/funds/README Mon Aug 20 14:08:14 2007 @@ -25,4 +25,4 @@ Make a symbolic link to the file funds/examples/funds-examples.asd visible to asdf. Type (asdf:operate 'asdf:load-op 'funds-examples). Now try -(solve p1) to see a functional sudoku solver at work. \ No newline at end of file +(solve p1) to see a functional sudoku solver at work.

1 0

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

20 Aug '07

Author: abaine Date: Mon Aug 20 14:06:04 2007 New Revision: 207 Modified: trunk/funds/README Log: Added instructions for the solver. Modified: trunk/funds/README ============================================================================== --- trunk/funds/README (original) +++ trunk/funds/README Mon Aug 20 14:06:04 2007 @@ -20,3 +20,9 @@ To see the publicly exported symbols in package "FUNDS," look at the file funds/src/package.lisp. + +SEEING THE EXAMPLES + +Make a symbolic link to the file funds/examples/funds-examples.asd visible +to asdf. Type (asdf:operate 'asdf:load-op 'funds-examples). Now try +(solve p1) to see a functional sudoku solver at work. \ No newline at end of file

1 0

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

20 Aug '07

Author: abaine Date: Mon Aug 20 14:04:09 2007 New Revision: 206 Added: trunk/funds/examples/ - copied from r205, trunk/funds/src/examples/ Removed: trunk/funds/src/examples/ Log: Moved examples to top-level directory.

1 0

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

20 Aug '07

Author: abaine Date: Mon Aug 20 14:01:17 2007 New Revision: 205 Removed: trunk/funds/doc/ Log: Deleted doc directory.

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

funds-cvs August 2007