Edit: Title updated to reflect what my question should have been, and hopefully lead other users here when they have the same problem.
Little bit of a mess, but this is a work-in-progress common lisp implementation of anydice that should output some ascii art representing a probability density function for a hash-table representing dice rolls. I've been trying to figure out exactly why, but I keep getting the error *** - SYSTEM::READ-EVAL-READER: variable BAR-CHARS has no value when attempting to run the file in clisp. The error is originating from the output function.
The code is messy and convoluted (but was previously working if the inner most loop of output is replaced with something simpler), but this specific error does not make sense to me. Am I not allowed to access the outer let* variables/bindings/whatever from the inner most loop/cond? Even when I substitute bar-chars for the list form directly, I get another error that char-decimal has no value either. I'm sure there's something about the loop macro interacting with the cond macro I'm missing, or the difference between setf, let*, multiple-value-bind, etc. But I've been trying to debug this specific problem for hours with no luck.
(defun sides-to-sequence (sides)
(check-type sides integer)
(loop for n from 1 below (1+ sides) by 1 collect n))
(defun sequence-to-distribution (sequence)
(check-type sequence list)
(setf distribution (make-hash-table))
(loop for x in sequence
do (setf (gethash x distribution) (1+ (gethash x distribution 0))))
distribution)
(defun distribution-to-sequence (distribution)
(check-type distribution hash-table)
(loop for key being each hash-key of distribution
using (hash-value value) nconc (loop repeat value collect key)))
(defun combinations (&rest lists)
(if (endp lists)
(list nil)
(mapcan (lambda (inner-val)
(mapcar (lambda (outer-val)
(cons outer-val
inner-val))
(car lists)))
(apply #'combinations (cdr lists)))))
(defun mapcar* (func lists) (mapcar (lambda (args) (apply func args)) lists))
(defun dice (left right)
(setf diceprobhash (make-hash-table))
(cond ((integerp right)
(setf right-distribution
(sequence-to-distribution (sides-to-sequence right))))
((listp right)
(setf right-distribution (sequence-to-distribution right)))
((typep right 'hash-table) (setf right-distribution right))
(t (error (make-condition 'type-error :datum right
:expected-type
(list 'integer 'list 'hash-table)))))
(cond ((integerp left)
(sequence-to-distribution
(mapcar* #'+
(apply 'combinations
(loop repeat left collect
(distribution-to-sequence right-distribution))))))
(t (error (make-condition 'type-error :datum left
:expected-type
(list 'integer))))))
(defmacro d (arg1 &optional arg2)
`(dice ,#(if (null arg2) (list 1 arg1) (list arg1 arg2))))
(defun distribution-to-probability (distribution)
(setf probability-distribution (make-hash-table))
(setf total-outcome-count
(loop for value being the hash-values of distribution sum value))
(loop for key being each hash-key of distribution using (hash-value value)
do (setf (gethash key probability-distribution)
(float (/ (gethash key distribution) total-outcome-count))))
probability-distribution)
(defun output (distribution)
(check-type distribution hash-table)
(format t " # %~%")
(let* ((bar-chars (list 9617 9615 9614 9613 9612 9611 9610 9609 9608))
(bar-width 100)
(bar-width-eighths (* bar-width 8))
(probability-distribution (distribution-to-probability distribution)))
(loop for key being each hash-key of
probability-distribution using (hash-value value)
do (format t "~4d ~5,2f ~{~a~}~%" key (* 100 value)
(loop for i from 0 below bar-width
do (setf (values char-column char-decimal)
(truncate (* value bar-width)))
collect
(cond ((< i char-column)
#.(code-char (car (last bar-chars))))
((> i char-column)
#.(code-char (first bar-chars)))
(t
#.(code-char (nth (truncate
(* 8 (- 1 char-decimal)))
bar-chars)))))))))
(output (d 2 (d 2 6)))
This is my first common lisp program I've hacked together, so I don't really want any criticism about formatting/style/performance/design/etc as I know it could all be better. Just curious what little detail I'm missing in the output function that is causing errors. And felt it necessary to include the whole file for debugging purposes.
loops scoping is perfectly conventional. But as jkiiski says, #. causes the following form to be evaluated at read time: bar-chars is not bound then.
Your code is sufficiently confusing that I can't work out whether there's any purpose to read-time evaluation like this. But almost certainly there is not: the uses for it are fairly rare.
The "finding the digits problem" is this:
Find unique decimal digits A, B, C such that
CCC
+ BBB
+ AAA
= CAAB
To solve it using recursion in Common Lisp, I've written this code:
(defun find! ()
(found? 0 ;; initially point to the number 1
'(1 2 3) ;; initial list
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion happens here
lst
(setf occupied (remove j occupied)))))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar
(lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst)
(first lst) (second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
The delivered result (lst) is (9 9 9)
The expected result (lst) is (9 8 1) meaning A=9, B=8, C=1 so that the equation CCC + BBB + AAA = CAAB holds i.e.
111 ; CCC
+ 888 ; BBB
+ 999 ; AAA
= 1998 ; CAAB
Which parts of the code should I change so that it gives the expected result? Can someone fix the code? Note that using recursion is a must. Only one line of recursion is enough i.e. like the line where the ;; recursion happens here comment is.
What is the minimal edit to fix this code?
The minimal edit needed to make your code work is the following three small changes (marked with ;;;; NB in the comments):
You are not allowed to surgically modify the structure of a quoted list, as you do. It must be freshly allocated, for that.
(defun find! ()
(found? 0 ;; initially point to the number 1
(list 1 2 3) ;; initial list ;;;; NB freshly allocated!
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
You must change the structure of the code (moving one closing paren one line up) to always undo the push of j into occupied:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion happens here
lst) ;;;; NB
(setf occupied (remove j occupied)))) ;;;; NB _always_ undo the push
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar
(lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst)
(first lst) (second lst))))))
(if (= lefthnd rghthnd)
(return-from found? lst) ;;;; NB actually return here
'nil))))))
You also must actually return the result, once it is found (seen in the above snippet as well).
If you change the return-from line to print the result instead of returning it, you will get all of them printed.
If you want to get them all in a list instead of being printed, you can surgically append each of the results to some list defined in some outer scope (or cons onto the front and reverse it when it's all done, if you prefer).
Or in general, you can change this code to accept a callback and call it with each result, when it is found, and let this callback to do whatever it does with it -- print it, append it to an external list, whatever.
Remarks: your code follows a general recursive-backtracking approach, creating three nested loops structure through recursion. The actual result is calculated -- and put into lst by surgical manipulation -- at the deepest level of recursion, corresponding to the innermost loop of j from 1 to 9 (while avoiding the duplicates).
There's lots of inconsequential code here. For instance, the if in (if (found? ...) lst) isn't needed at all and can be just replaced with (found? ...). I would also prefer different names -- occupied should really be named used, lst should be res (for "result"), index is canonically named just i, width is just n, etc. etc. (naming is important)... But you did request the smallest change.
This code calculates the result lst gradually, as a side effect on the way in to the innermost level of the nested loops, where it is finally fully set up.
Thus this code follows e.g. an example of Peter Norvig's PAIP Prolog interpreter, which follows the same paradigm. In pseudocode:
let used = []
for a from 1 to 9:
if a not in used:
used += [a]
for b from 1 to 9:
if b not in used:
used += [b]
for c from 1 to 9:
if c not in used and valid(a,b,c):
return [a,b,c] # or:
# print [a,b,c] # or:
# call(callback,[a,b,c]) # etc.
remove b from used
remove a from used
Here's your code re-structured, renamed, and streamlined:
(defun find2 ( &aux (res (list 0 0 0))
(used '()) (n (length res)))
(labels
((f (i)
(do ((d 1 (1+ d))) ; for d from 1 to 9...
((> d 9) 'FAIL) ; FAIL: no solution!
(unless (member d used) ; "d" for "digit"
(setf (nth i res) d) ; res = [A... B... C...]
(cond
((< i (- n 1)) ; outer levels
(setf used (cons d used))
(f (1+ i)) ; recursion! going in...
(setf used (cdr used))) ; and we're out.
(T ; the innermost level!
(let ((left (* 111 (reduce #'+ res)))
(rght (reduce #'+
(mapcar #'* '(1000 100 10 1)
(list (third res) ; C A A B
(first res)
(first res)
(second res))))))
(if (= left rght)
(return-from find2 res))))))))) ; success!
(f 0)))
This is now closely resembling the C++ code you once had in your question, where the working function (here, f) also received just one argument, indicating the depth level of the nested loop -- corresponding to the index of the digit being tried, -- and the rest of the variables were in an outer scope (there, global; here, the auxiliary variables in the containing function find2).
By the way, you aren't trying any 0s for some reason.
You seem to be able to solve the problem using another language, so I won't spend too long talking about the problem/algorithm used (you already know how to do it). However, as it seems that you are learning Common Lisp, I am going to provide a typical StackOverflow answer, and give a lot of advice that you haven't asked for !
Fix your parentheses/indentation, this will make the code clearer for you.
Split your code in more, smaller functions. You are solving a problem using a recursive function, with several parameters, and the function is more than twenty lines long. This makes it really hard to read and to debug.
Use built-in functions: (some (lambda (x) (= x j)) occupied) == (member j occupied :test #'=), and in that case, it still works without specifying the test (this is technically wrong, the two functions do not return the same thing, but you only ever use the result as a boolean so this is effectively the same thing here).
(mapcar (lambda (x y) (* x y)) ...) is just a longer way to write (mapcar #'* ...)
'nil == nil, you don't need to quote it. It is also (arguably) good style to use () instead of nil to represent the empty list (as opposed to a boolean value), but this really is a minor point.
As far as the algorithm is concerned, I will gladly help if you rewrite it using smaller functions. At the moment, it really is unnecessarily hard to read and understand.
EDIT:
I still tried to take the time to rewrite the code and come up with a cleaner solution.
TL;DR: this is the final result, with "minimal" modifications to your code:
(defun find! ()
(found? 0 (list 1 2 3) () 3))
(defun compute-lefthand (list)
(* 111 (reduce #'+ list)))
(defun compute-righthand (list)
(reduce #'+ (mapcar #'*
'(1000 100 10 1)
(list (third list)
(first list)
(first list)
(second list)))))
(defun check-solution (list)
(when (= (compute-lefthand list)
(compute-righthand list))
list))
(defun try-solution (j index list occupied width)
(unless (member j occupied)
(setf (nth index list) j)
(found? (1+ index)
list
(cons j occupied)
width)))
(defun found? (index lst occupied width)
(if (= index width)
(check-solution lst)
(dotimes (j 10)
(when (try-solution j index lst occupied width)
(return lst)))))
Your initial code, on top of style issues already mentioned in my initial answer, had shaky control flow. It was somewhat hard to determine what was really returned by each recursive call, because you do not have smaller functions and so it was not clear what the goal of each part was, how the information was transmitted from the recursive call to the parent, which objects where modified and so on.
Now, my code is not the cleanest, and I would probably not use this strategy to solve the problem, but I tried to stay as close as possible to your initial code. Main differences:
I split things into smaller functions. This makes everything clearer, and above all, easier to test. Each function returns something clear. For example, check-solution returns the list if it represents a proper solution, and nil otherwise; this is made clear by the fact that I use a when instead of an if control structure.
I replace do by dotimes which is also clearer; the variable that is changing, and how it is changing at each step, is now immediately visible.
I do not use the &optional return argument to the do/dotimes macro, and instead use an explicit return. It is then clear to determine what is being returned, and when.
I do not use push/pop to modify my lists. You are using a recursive strategy, and so your "modifications" should take the form of different arguments passed to functions. Once again, it makes reasoning about the program easier, by knowing exactly what each function does to each argument. An even better solution would also be to remove the call to setf and instead use (cons <smtg> lst) as the argument of the recursive call, but it's fine.
The error in your initial program is probably coming from the fact that your function does not return what you think, because you have several consecutive expressions, each invoked under different circumstances, whose return value is itself wrong because they are not in the right order and modify objects and return them at the wrong time using do's optional return value.
TL;DR: split things up; make each function do a single thing.
Your code
(defun find! ()
(found? 0 ;; initially show the number 1
'(1 2 3) ;; initial list
'() ;; initially no numbers found
3 ;; numbers list width is 3
) )
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ;; recursion
lst
(setf occupied (remove j occupied)))))
(do ( (j 1 (1+ j) ) )
( (> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+ (mapcar (lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst) (first lst) (first lst) (second lst))
))))
(if (= lefthnd rghthnd)
lst
'nil))))))
Indentation and comment style: end-of-line comments use a single semicolon,
align non-body arguments, indent bodies by two spaces
(defun find! ()
(found? 0 ; initially show the number 1
'(1 2 3) ; initial list
'() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
lst
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (some (lambda (x) (= x j)) occupied)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar (lambda (x y) (* x y))
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
Use more telling predicates: find or member. Don't wrap * in a lambda doing
nothing else. (I'll leave aside find! hereafter.)
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
lst
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(if (= lefthnd rghthnd)
lst
'nil))))))
The body of a do doesn't return anything. There is a lot of dead code,
which we remove now:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(unless (found? (1+ index) lst occupied width) ; recursion
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)))))
Instead of pushing and then conditionally removing, we can conditionally push:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (found? (1+ index) lst occupied width) ; recursion
(push j occupied))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)))))
While it makes a difference in performance, putting the outer conditional
into the inner body makes it more readable here:
(defun found? (index lst occupied width)
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (and (< index (1- width))
(found? (1+ index) lst occupied width)) ; recursion
(push j occupied)))))
This does nothing except count to 9 a few times, which seems to be congruent
to your findings.
I guess that you wanted to return something from the dead code. You might
want to use return-from for that.
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
(return-from found? lst)
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) lst)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
This returns (1 2 9), which is wrong. The problem seems to be that you
return the list even when you run over 9, but you want to return nil then,
because you didn't find anything.
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) nil) ; <- nothing found
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(push j occupied)
(if (found? (1+ index) lst occupied width) ; recursion
(return-from found? lst)
(setf occupied (remove j occupied)))))
(do ((j 1 (1+ j)))
((> j 9) nil) ; <- nothing found
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
This returns (9 8 1), which is correct. Now that I seem to understand what
you're trying to do, let's refactor a bit more. Instead of pushing and
removing from the occupied list, just create a new list with the new element
in front transiently:
(defun found? (index lst occupied width)
(if (< index (1- width))
(do ((j 1 (1+ j)))
((> j 9) nil)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst))))
(do ((j 1 (1+ j)))
((> j 9) nil)
(unless (find j occupied :test #'=)
(setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst)))))))
I think that using loop instead of do makes this much more readable:
(defun found? (index lst occupied width)
(if (< index (1- width))
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst)))
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst))))))
Since the loop is rather elaborate, I'd want to write and read it only once,
so move the outer condition inside:
(defun found? (index lst occupied width)
(loop :for j :from 1 :to 9
:unless (find j occupied :test #'=)
:do (setf (nth index lst) j)
(if (< index (1- width))
(when (found? (1+ index) ; recursion
lst
(cons j occupied)
width)
(return-from found? lst))
(let ((lefthnd (* 111 (reduce #'+ lst)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third lst)
(first lst)
(first lst)
(second lst))))))
(when (= lefthnd rghthnd)
(return-from found? lst))))))
Did you see that occupied is just the first one or two elements of lst,
reversed? Instead of setting list elements, we can build up lst through the
recursion. We actually need to return the recursive results for that, so
this is better referential transparency.
(defun find! ()
(found? 0 ; initially show the number 1
'() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (index part width)
(loop :for j :from 1 :to 9
:unless (find j part :test #'=)
:do (if (< index (1- width))
(let ((solution (found? (1+ index) ; recursion
(cons j part)
width)))
(when solution
(return-from found? solution)))
(let* ((full (cons j part))
(lefthnd (* 111 (reduce #'+ full)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third full)
(first full)
(first full)
(second full))))))
(when (= lefthnd rghthnd)
(return-from found? full))))))
Index and width are now only used for counting, so we only need one number,
which we can count towards zero. This also makes apparent that we should
probably move the base case out of the looping:
(defun find! ()
(found? '() ; initially no numbers found
3)) ; numbers list width is 3
(defun found? (part count)
(if (zerop count)
(let* ((full part) ; just rename to show that the number is complete
(lefthnd (* 111 (reduce #'+ full)))
(rghthnd (reduce #'+
(mapcar #'*
'(1000 100 10 1)
(list (third full)
(first full)
(first full)
(second full))))))
(when (= lefthnd rghthnd)
(return-from found? full)))
(loop :for j :from 1 :to 9
:unless (find j part :test #'=)
:do (let ((solution (found? (cons j part)
(1- count))))
(when solution
(return-from found? solution))))))
I think this more or less is what you can do if you keep it to a single
function. Now you'd probably want to separate the generation of
permutations from the actual code. There are for example some functions to
deal with such things in the widely used library alexandria.
I'm new to Lisp and I'm trying to solve an 8-puzzle using simple dfs (depth-first search).
But I am getting a program stack overflow.
My code:
(setq used (list))
(defun is_used (state lst)
(cond
((null lst) nil)
((equalp (car lst) state) t)
(t (is_used state (cdr lst)))))
(defun move (lst direction)
(let* ( (zero (find_zero lst))
(row (floor zero 3))
(col (mod zero 3))
(res (copy-list lst)))
(cond
((eq direction 'L)
(if (> col 0)
(rotatef (elt res zero) (elt res (- zero 1)))))
((eq direction 'R)
(if (< col 2)
(rotatef (elt res zero) (elt res (+ zero 1)))))
((eq direction 'U)
(if (> row 0)
(rotatef (elt res zero) (elt res (- zero 3)))))
((eq direction 'D)
(if (< row 2)
(rotatef (elt res zero) (elt res (+ zero 3))))))
(if (equalp res lst)
(return-from move nil))
(return-from move res))
nil)
(defun dfs (cur d prev)
; (write (length used))
; (terpri)
(push cur used)
(let* ((ways '(L R U D)))
(loop for dir in ways
do (if (move cur dir)
(if (not (is_used (move cur dir) used))
(dfs (move cur dir) (+ d 1) cur))))))
state here is a list of 9 atoms.
With uncommented (write (length used)) it prints 723 - number of items in used before the stack overflow occurs.
Now, before solving 8-puzzle, I just want to iterate over all possible states (there are exactly 9! / 2 = 181440 possible states). Sure, it may take some time, but how can I avoid the stack overflow here?
This is a typical problem explained in some AI programming books. If you need to search a large / unbounded amount of states, you should not use recursion. Recursion in CL is limited by the stack depth. Some implementations can optimize tail recursion - but then you need architecture your code, so that it is tail recursive.
Typically a data structure for that will be called an agenda. It keeps the states still to explore. If you look at a state, you push all states to explore from there onto the agenda. Make sure the agenda is in some way sorted (this might determine if it is depths or breadths first). Then take the next state from the agenda and examine it. If the goal is reached, then you are done. If the agenda is empty before the goal is found, then there is no solution. Otherwise loop...
Your code, simplified, is
(setq *used* (list))
(defun move (position direction)
(let* ( (zero (position 0 position))
(row (floor zero 3))
(col (mod zero 3))
(command (find direction `((L ,(> col 0) ,(- zero 1))
(R ,(< col 2) ,(+ zero 1))
(U ,(> row 0) ,(- zero 3))
(D ,(< row 2) ,(+ zero 3)))
:key #'car)))
(if (cadr command)
(let ((res (copy-list position)))
(rotatef (elt res zero) (elt res (caddr command)))
res))))
(defun dfs-rec (cur_pos depth prev_pos)
(write (length *used*)) (write '_) (write depth) (write '--)
; (terpri)
(push cur_pos *used*)
(let* ((dirs '(L R U D)))
(loop for dir in dirs
do (let ((new_pos (move cur_pos dir)))
(if (and new_pos
(not (member new_pos *used* :test #'equalp)))
(dfs-rec new_pos (+ depth 1) cur_pos))))))
(print (dfs-rec '(0 1 2 3 4 5 6 7 8) 0 '()))
Instead of processing the four moves one by one while relying on recursion to keep track of what-to-do-next on each level, just push all the resulting positions at once to a to-do list, then pop and continue with the top one; repeating while the to-do list is not empty (i.e. there is something to do, literally):
(defun new-positions (position)
(let* ( (zero (position 0 position))
(row (floor zero 3))
(col (mod zero 3)) )
(mapcan
#'(lambda (command)
(if (cadr command)
(let ((res (copy-list position)))
(rotatef (elt res zero) (elt res (caddr command)))
(list res))))
`((L ,(> col 0) ,(- zero 1))
(R ,(< col 2) ,(+ zero 1))
(U ,(> row 0) ,(- zero 3))
(D ,(< row 2) ,(+ zero 3))) )))
; non-recursive dfs function skeleton
(defun dfs (start-pos &aux to-do curr new)
(setf to-do (list start-pos))
(loop while to-do
do (progn (setf curr (pop to-do))
(setf new (new-positions curr))
(setf to-do (nconc new to-do)))))
This way there's no more info to keep track of, with recursion -- it's all in the to-do list.
This means the generated positions will be processed in the LIFO order, i.e. the to-do list will be used as a stack, achieving the depth-first search strategy.
If you'd instead append all the new positions on each step at the end of the to-do list, it'd mean it being used as a queue, in a FIFO order, achieving the breadth-first search.
This function results in stack overflow for more than about 2000 steps, is there any way I can easily optimize it to use less memory?
(defun randomwalk (steps state)
(displaystate state)
(if (equal steps 0) nil
(if (solved? state) t
(let ((nrmlstate (normalize state)))
(randomwalk (- steps 1) (applymove nrmlstate (nth (random
(length (getallmoves nrmlstate))) (getallmoves nrmlstate))))
)
)
)
)
It looks like you only call in tail position which means you can easily rewrite it to not recurse at all:
(defun randomwalk (steps state)
(loop :if (= steps 0)
:do (return nil)
:if (solved? state)
:do (return t)
:else
:do (let* ((nrmlstate (normalize state))
(moves (getallmoves nrmlstate))
(random-move (nth (random (length moves)) moves)))
(setf state (applymove nrmlstate random-move))
(decf steps))))
Since I don't have the functions you use I have not been able to test it other than for the base cases.
I'm looking at the LispWorks Hyperspec on dotimes but I don't understand what the third variable [result-form] is doing. The examples are as follows:
(dotimes (temp-one 10 temp-one)) => 10
(setq temp-two 0) => 0
(dotimes (temp-one 10 t) (incf temp-two)) => T
temp-two => 10
The Hyperspec says
...Then result-form is evaluated. At the time result-form is
processed, var is bound to the number of times the body was executed.
Not sure what this is saying. Why is the third variable necessary in these two dotimes examples? I seem to be able to leave it out entirely in the second example and it works. My next example (not sure where I found it),
(defun thing (n)
(let ((s 0))
(dotimes (i n s)
(incf s i))))
Puzzles me as well. What use is s serving?
Since dotimes is a macro, looking at it's macro expansion can make things clearer:
Take your first example and expand it:
(pprint (MACROEXPAND-1 '(dotimes (temp-one 10 temp-one))))
I get the following output: (Yours may vary depending on the CL implementation)
(BLOCK NIL
(LET ((#:G8255 10) (TEMP-ONE 0))
(DECLARE (CCL::UNSETTABLE TEMP-ONE))
(IF (CCL::INT>0-P #:G8255)
(TAGBODY
#:G8254 (LOCALLY (DECLARE (CCL::SETTABLE TEMP-ONE))
(SETQ TEMP-ONE (1+ TEMP-ONE)))
(UNLESS (EQL TEMP-ONE #:G8255) (GO #:G8254))))
TEMP-ONE))
There's a lot going on, but the key thing to look at is that temp-one is bound to the value 0, and is returned as the expression's value (in standard lisp evaluation order).
Take the last example:
(pprint (macroexpand-1 '(dotimes (i n s) (incf s i))))
outputs:
(BLOCK NIL
(LET ((#:G8253 N) (I 0))
(DECLARE (CCL::UNSETTABLE I))
(IF (CCL::INT>0-P #:G8253)
(TAGBODY
#:G8252 (INCF S I)
(LOCALLY (DECLARE (CCL::SETTABLE I))
(SETQ I (1+ I)))
(UNLESS (EQL I #:G8253) (GO #:G8252))))
S))
As you can see S here is treated the same way as temp-one in the example before.
Try one without passing the last variable:
(pprint (macroexpand-1 '(dotimes (i n) (do-something i))))
and you get:
(BLOCK NIL
(LET ((#:G8257 N) (I 0))
(DECLARE (CCL::UNSETTABLE I))
(IF (CCL::INT>0-P #:G8257)
(TAGBODY
#:G8256 (DO-SOMETHING I)
(LOCALLY (DECLARE (CCL::SETTABLE I))
(SETQ I (1+ I)))
(UNLESS (EQL I #:G8257) (GO #:G8256))))
NIL))
Notice how NIL is the return value.