Marc, I got the error message above. I assume I could fix this by recompiling gambit, but beta 17 failed make check (never heard from anyone on that bug report), and I no longer have the sources for beta 15, which is what I'm using. But maybe you can give me a Scheme tip to fix this problem of mine without recompiling. So
I've written a Sudoku solver that's 1500 lines long, and it bombed on a puzzle after calculating for many hours, and here was my error message:
Check for Solved Cells*** ERROR IN #<procedure #2>, "OrChain.scm"@327.23 -- Number of arguments exceeds implementation limit (append '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((2 4)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5) (9 5)) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5) (8 5) (9... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((2 4)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5) (8 5) (9... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... '(((((1 1)) (3 3) ((1 3)) (1 1) ((1 5) (1 6))) (1 4 (3 5)) (((7 5)) (4 4) (... ...)
line 327 is here:
(apply append (filter-map (lambda (or-chain) (let* ([xUyV (OrStatement or-chain)] [x (first xUyV)] [U (second xUyV)] [y (third xUyV)] [V (fourth xUyV)] [mult-block (first or-chain)]) (and (not (number? (first mult-block))) (= (length U) 1) (filter-map (lambda (conj/ALS) (let* ([aPbQ (OrStatement (list conj/ALS))] [a (first aPbQ)] [P (second aPbQ)] [b (third aPbQ)] [Q (fourth aPbQ)]) (and (not (= b x)) (set-equal? Q U) (cons (cons P (cons (list a b) mult-block)) (rest or-chain))))) ConjLoopers)))) or-chains))
my `filter-map' is a combination of map with the HtDP function `filter'. So for some of the elements of the list `or-chains', I produce a list, and then I append the whole collection of lists. So I think what's happening here is that the list `or-chains' is too long.
BTW I've been posting a lot of Mike Mepham's Sudoku newsgroup http://www.sudoku.org.uk/cgi-bin/discus/discus.cgi?pg=topics Mostly I've been trying to teach these Sudoku hotshots the meaning of words like logic & axiom. I'm not having much more success than I had a few years ago on comp.lang.scheme trying to teach the CS profs how one constructs mathematical function between two sets.
Afficher les réponses par date
Bill Richter wrote:
But maybe you can give me a Scheme tip to fix this problem of mine without recompiling.
Instead of using "apply append", which is trying to call append with more arguments than (your version of?) Gambit can handle, do the appending recursively, one list at a time. You can use a fold function to do this, which you can get from SRFI-1, but it's also easy to define your own, e.g.:
(define (fold-right proc nil lst) (if (null? lst) nil (proc (car lst) (fold-right proc nil (cdr lst)))))
Now you can write your program like this:
(fold-right append '() (filter-map (lambda (or-chain) <rest of the code...>)))
BTW I've been posting a lot of Mike Mepham's Sudoku newsgroup http://www.sudoku.org.uk/cgi-bin/discus/discus.cgi?pg=topics Mostly I've been trying to teach these Sudoku hotshots the meaning of words like logic & axiom. I'm not having much more success than I had a few years ago on comp.lang.scheme trying to teach the CS profs how one constructs mathematical function between two sets.
Oh, the humanity. Perhaps someone should refer the sudoku people to: http://www.ccs.neu.edu/home/will/Ephemera/richterFAQ.html
Anton
Thanks, Anton. I thought of something like that myself, not as slick:
(define (my-apply-append lolist) (let loop ([lolist lolist] [accum empty]) (if (empty? lolist) accum (loop (rest lolist) (append (first lolist) accum)))))
And my program's been running now for 5.5 hrs. I haven't been able to compile my program, so it's gsi. I'd send a bug report if I could get the latest beta working.
Oh, the humanity. Perhaps someone should refer the sudoku people to: http://www.ccs.neu.edu/home/will/Ephemera/richterFAQ.html
Someone did, in fact! You weren't one of the CS profs I referred to, but remember the last argument we had about Shriram's book, about free & bound variables? Shriram fixed his book exactly as I recommended.
At 12:13 Uhr -0500 03.09.2006, Bill Richter wrote:
(apply append (filter-map (lambda (or-chain) ...) or-chains))
You can get rid of the intermediate lists and hence the necessity of append'ing altogether by using fold(-right) and functions which take a tail argument instead of always inserting '().
(define (filter-map/tail fn tail lis . morelis) (if (null? morelis) (let recur ((lis lis)) (cond ((null? lis) tail) ((pair? lis) (let ((v (fn (car lis)))) (if v (cons v (recur (cdr lis))) (recur (cdr lis))))) (else (error "improper list:" lis)))) (error "filter-map/tail with more than one input list is not (yet) implemented")))
(fold-right (lambda (v tail) (filter-map/tail (lambda (v) (and (even? v) (+ v 1))) tail v)) '() '((1 2 3 4) (10 20 30 40) (100 200 300 400)))
; => (3 5 11 21 31 41 101 201 301 401)
Christian.
Thanks, Christian. Looks pretty similar to Anton's fix: I need to understand this fold biz. I have before: it's nicely discussed in HtDP. My program ran (using my simpler & less elegant fix) for over 12 hours before dying without any output. I need to improve the code. See if you have a suggestion:
I'm coding up a Sudoku technique that involves chains going from one of the 81 cells to another one, beginning & ending on different numbers. There's thousands, maybe tens of thousands of such chains. OK. There are rules to glue two chains together, and make new ones, which then go on this large list of chains. Etc. What's a good speed implementation for this?
Partly my problem is that I can't compile my program with beta 15. But I don't know if that's a gsc bug, or due to the fact that beta 17 fails `make check'. So I'd like to build beta 15 again, but I don't have the tar file anymore, and I don't know where the old betas are kept. When beta 18 comes out, perhaps this problem will be solved.
At 13:01 Uhr -0500 04.09.2006, Bill Richter wrote:
Thanks, Christian. Looks pretty similar to Anton's fix: I need to understand this fold biz. I have before: it's nicely discussed in HtDP. My program ran (using my simpler & less elegant fix) for over 12 hours before dying without any output. I need to improve the code. See if you have a suggestion:
I'm coding up a Sudoku technique that involves chains going from one of the 81 cells to another one, beginning & ending on different numbers. There's thousands, maybe tens of thousands of such chains. OK. There are rules to glue two chains together, and make new ones, which then go on this large list of chains. Etc. What's a good speed implementation for this?
Well, I don't know Sudoku and don't have the time to learn about it. So I can't follow what programming technique you're using and what you might be missing. It's only a guess when I suspect that you're building too much data at once in memory, and might profit from lazy evaluation (streams). I did suggest that to you in a different occasion once. You seem to think mathematically, so my guess is that you're programming in a rather descriptive way and do not care nor think about how memory is being used during processing; using lazy evaluation in the right places makes memory being used only on demand, without changing the program much.
Christian.
Christian suggested I might have found a real bug, and that I should try stripping off as much fat as possible from my program. So I got it down to 157 lines. Here's the output:
% gsi trymutate.scm % gsc trymutate.scm; gcc -O2 -L. -I. trymutate.c trymutate_.c -lgambc; ./a.out *** ERROR IN intersect -- (Argument 2) LIST expected (member '(9 5 7) '(514 . 1))
Now if I uncomment the declarations (fixnum) & (not safe), I get: *** ERROR IN print-Sudoku -- (Argument 1) LIST expected (length '(514 . 6))
And if I comment out all the declarations, I get another different error: *** ERROR IN intersect -- (Argument 2) LIST expected (member '(9 5 7) '(() . 514))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; trymutate.scm
(declare (standard-bindings) ; (fixnum) ; (not safe) (run-time-bindings) (inline) (inlining-limit 1000) (block))
(define U7 '#(0 #(0 8 0 0 0 0 1 0 4 0) #(0 2 0 6 0 9 0 0 1 0) #(0 0 0 9 0 0 6 0 8 0) #(0 1 2 4 0 0 0 0 0 9) #(0 0 0 0 0 0 0 0 0 0) #(0 9 0 0 0 0 0 8 2 4) #(0 0 5 0 4 0 0 1 0 0) #(0 0 8 0 0 7 0 2 0 5) #(0 0 9 0 5 0 0 0 0 7)))
(define empty '()) (define empty? null?) (define first car) (define rest cdr) (define second cadr) (define (add1 x) (+ x 1)) (define (sub1 x) (- x 1))
;;nlist : N -> (listof N) ;; to construct list (0 1 2 .... n-1) (define (nlist n) (let loop ([n (sub1 n)] [accum empty]) (if (< n 0) accum (loop (sub1 n) (cons n accum)))))
;; build-list : N (N -> X) -> (listof X) ;; to construct (list (f 0) ... (f (- n 1))) (define (build-list n f) (map f (nlist n)))
(define (build-list9 f) (list (f 0) (f 1) (f 2) (f 3) (f 4) (f 5) (f 6) (f 7) (f 8)))
(define (build-list3 f) (list (f 0) (f 1) (f 2)))
; ;; filter : (X -> boolean) (listof X) -> (listof X) ; ;; to construct a list from all those items on aloX for which p holds (define (filter p aloX) (if (empty? aloX) empty (let ([x (first aloX)]) (if (p x) (cons x (filter p (rest aloX))) (filter p (rest aloX))))))
;; remove* : (listof X) (listof X) -> (listof X) ;; to construct a list by removing from `aloX' all instances of the ;; list `items', where an instance is found by comparing `item' to the ;; elements of the list `aloX' items using `equal?'. (define (remove* items aloX) (if (empty? aloX) empty (let ([x (first aloX)]) (if (member x items) (remove* items (rest aloX)) (cons x (remove* items (rest aloX)))))))
;; intersect : (listof X)^2 -> (listof X) ;; to intersect 2 lists A and B. If A is sorted, then (intersect A B) ;; will be sorted too, given transitivity of the less-than? function. (define (intersect A B) (if (empty? A) empty (let ([a (first A)]) (if (member a B) (cons a (intersect (rest A) B)) (intersect (rest A) B)))))
(define (Val Sudoku Point) (vector-ref (vector-ref Sudoku (first Point)) (second Point)))
(define (Val-set! Sudoku Point new-value) (vector-set! (vector-ref Sudoku (first Point)) (second Point) new-value))
(define Grid (apply append (build-list9 (lambda (i) (build-list9 (lambda (j) (list (add1 i) (add1 j))))))))
(define (Rowlist Sudoku i) (filter number? (build-list9 (lambda (j) (Val Sudoku (list i (add1 j)))))))
(define (Columnlist Sudoku j) (filter number? (build-list9 (lambda (i) (Val Sudoku (list (add1 i) j))))))
(define (Boxlist Sudoku i j) (filter number? (let ([qi (* 3 (quotient (sub1 i) 3))] [qj (* 3 (quotient (sub1 j) 3))]) (apply append (build-list 3 (lambda (i) (build-list 3 (lambda (j) (Val Sudoku (list (+ qi i 1) (+ qj j 1)))))))))))
(define (list/num-size entry) (if (number? entry) 1 (length entry)))
(define (print-Sudoku Sudoku) (let* ([print-entry (lambda (i j) (list/num-size (Val Sudoku (list i j))))] [print-ith-row (lambda (i) (print-entry i 1) (print-entry i 2) (print-entry i 3) (print-entry i 4) (print-entry i 5) (print-entry i 6) (print-entry i 7) (print-entry i 8) (print-entry i 9))]) (map print-ith-row (list 1 2 3 4 5 6 7 8 9))))
(define (UnSpace Sudoku) (map (lambda (P) (if (zero? (Val Sudoku P)) (Val-set! Sudoku P (list 1 2 3 4 5 6 7 8 9)))) Grid))
(define (ShowPossibles Sudoku) ;; recalculate candidate lists, to take new numbers into account. (map (lambda (P) (let ([i (first P)] [j (second P)] [our-list (Val Sudoku P)]) (if (list? our-list) (let* ([incoming (append (list (Rowlist Sudoku i) (Columnlist Sudoku j) (Boxlist Sudoku i j)))] [rule-these-out (intersect incoming our-list)]) (if (not (empty? rule-these-out)) (Val-set! Sudoku P (remove* rule-these-out our-list))))))) Grid))
(UnSpace U7) (ShowPossibles U7) (ShowPossibles U7) (print-Sudoku U7)