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.
Related
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 following code snippet compiles under SBCL 2.2.3 (using Emacs/SLIME, C-c C-k), and the .fasl is loaded without errors.
On a subsequent call to test-sets in the REPL, the value of *evens* is set to *all*. Reading the documentation I could find, I cannot figure out why this happens and why calling test-sets would result in nil. Thank you in advance to everyone reading and/or responding.
(defun get-n (n)
"Return a list of integers from 0 up to n-1"
(do ((i (1- n) (1- i))
(res nil (cons i res)))
((< i 0) res)))
(defun get-odd-n (n)
"Returns a list of odd integers from 1 up to n-1"
(do ((i (1- n) (1- i))
(res nil (if (oddp i)
(cons i res) res)))
((< i 0) res)))
(defun get-even-n (n)
"Returns a list of even integers from 0 up to n-1"
(do ((i (1- n) (1- i))
(res nil (if (evenp i)
(cons i res) res)))
((< i 0) res)))
(defconstant +n+ 10)
(defparameter *all* (get-n +n+))
(defparameter *odds* (get-odd-n +n+))
(defparameter *evens* (get-even-n +n+))
(defun test-sets ()
"After compiling and loading .fasl,
why is *evens* altered after calling test-sets?"
(and (equal (sort (intersection *evens* *all*) #'<) *evens*)
(equal (sort (intersection *odds* *all*) #'<) *odds*)
(equal (sort (union *odds* *evens*) #'<) *all*)
(equal (sort (set-difference *all* *odds* :test #'eql) #'<) *evens*)
(equal (sort (set-difference *all* *evens* :test #'eql) #'<) *odds*)))
The UNION result shares list structure with its inputs.
SORT is destructive.
->
SORT changes the list structure, incl. the list structure *evens* points to.
Solution:
Either: define a non-destructive SORT
Or: or copy the list which is the argument to SORT
(sort (copy-list ...) ...)
I am simply trying to make this average function to be tail recursive. I have managed to get my function to work and that took some considerable effort. Afterwards I went to ask my professor if my work was satisfactory and he informed me that
my avg function was not tail recursive
avg did not produce the correct output for lists with more than one element
I have been playing around with this code for the past 2 hours and have hit a bit of a wall. Can anyone help me to identify what I am not understanding here.
Spoke to my professor he was != helpful
(defun avg (aList)
(defun sumup (aList)
(if (equal aList nil) 0
; if aList equals nil nothing to sum
(+ (car aList) (sumup (cdr aList)) )
)
)
(if
(equal aList nil) 0
; if aList equals nil length dosent matter
(/ (sumup aList) (list-length aList) )
)
)
(print (avg '(2 4 6 8 19))) ;39/5
my expected results for my test are commented right after it 39/5
So this is what I have now
(defun avg (aList &optional (sum 0) (length 0))
(if aList
(avg (cdr aList) (+ sum (car aList))
(+ length 1))
(/ sum length)))
(print (avg '(2 4 6 8 19))) ;39/5
(defun avg (list &optional (sum 0) (n 0))
(cond ((null list) (/ sum n))
(t (avg (cdr list)
(+ sum (car list))
(+ 1 n)))))
which is the same like:
(defun avg (list &optional (sum 0) (n 0))
(if (null list)
(/ sum n)
(avg (cdr list)
(+ sum (car list))
(+ 1 n))))
or more similar for your writing:
(defun avg (list &optional (sum 0) (n 0))
(if list
(avg (cdr list)
(+ sum (car list))
(+ 1 n))
(/ sum n)))
(defun avg (lst &optional (sum 0) (len 0))
(if (null lst)
(/ sum len)
(avg (cdr lst) (incf sum (car lst)) (1+ len))))
You could improve your indentation here by putting the entire if-then/if-else statement on the same line, because in your code when you call the avg function recursively the indentation bleeds into the next line. In the first function you could say that if the list if null (which is the base case of the recursive function) you can divide the sum by the length of the list. If it is not null, you can obviously pass the cdr of the list, the sum so far by incrementing it by the car of the list, and then increment the length of the list by one. Normally it would not be wise to use the incf or 1+ functions because they are destructive, but in this case they will only have a localized effect because they only impact the optional sum and len parameters for this particular function, and not the structure of the original list (or else I would have passed a copy of the list).
Another option would be to use a recursive local function, and avoid the optional parameters and not have to compute the length of the list on each recursive call. In your original code it looks like you were attempting to use a local function within the context of your avg function, but you should use the "labels" Special operator to do that, and not "defun":
(defun avg (lst)
(if (null lst)
0
(labels ((find-avg (lst sum len)
(if (null lst)
(/ sum len)
(find-avg (cdr lst) (incf sum (car lst)) len))))
(find-avg lst 0 (length lst))))
I'm not 100% sure if your professor would want the local function to be tail-recursive or if he was referring to the global function (avg), but that is how you could also make the local function tail-recursive if that is an acceptable remedy as well. It's actually more efficient in some ways, although it requires more lines of code. In this case a lambda expression could also work, BUT since they do not have a name tail-recursion is not possibly, which makes the labels Special operator is useful for local functions if tail-recursion is mandatory.
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.
I am totally new to Lisp.
How to find the difference between elements in an arithmetic progression series?
e.g.
(counted-by-N '(20 10 0))
Return -10
(counted-by-N '(20 10 5))
(counted-by-N '(2))
(counted-by-N '())
Returns Nil
In Python/C and other languages, it is very straightforward... Kinda stuck here in Lisp.
My pseudo algorithm would be something like this:
function counted-by-N(L):
if len(L) <= 1:
return Nil
else:
diff = L[second] - L[first]
for (i = second; i < len(L) - 1; i++):
if L[i+1] - L[i] != diff
return Nil
return diff
Current work:
(defun count-by-N (L)
(if (<= (length L) 1) Nil
(
(defvar diff (- (second L) (first L)))
; How to do the loop part?
))
)
(flet ((by-n (list &aux
(e1 (first list))
(e2 (second list))
(difference (and e1 e2 (- e2 e1))))
(and difference
(loop for (one two) on list
while (and one two)
when (/= (- two one) difference)
do (return-from by-n nil)))
difference))
(by-n '(20 10 0)))
or
(flet ((by-n (list &aux
(e1 (first list))
(e2 (second list))
(difference (and e1 e2 (- e2 e1))))
(when difference
(loop for (one two) on list
while (and one two)
when (/= (- two one) difference)
do (return-from by-n nil))
difference)))
(by-n '(20 10 0)))
As far as you said on the second answer the best choice you have to do this example is implement it recursively.
Example Using List Processing (good manners)
That way, you have some ways to do this example on the recursively and simple way:
(defun count-by-N-1 (lst)
(if (equal NIL lst)
NIL
(- (car (cdr lst)) (car lst))
)
(count-by-N-1 (cdr lst))
)
On this first approach of the function count-by-N-1 I am using the simple car and cdr instructions to simplify the basics of Common Lisp List transformations.
Example Using List Processing Shortcuts (best implementation)
However you can resume by using some shortcuts of the car and cdr instructions like when you want to do a a car of a cdr, like I did on this example:
(defun count-by-N-2 (lst)
(if (equal NIL lst)
NIL
(- (cadr lst) (car lst))
)
(count-by-N-2 (cdr lst))
)
If you have some problems to understand this kind of questions using basic instructions of Common Lisp List transformation as well as car and cdr, you still can choose the first, second and rest approach. However I recommend you to see some of this basic instructions first:
http://www.gigamonkeys.com/book/they-called-it-lisp-for-a-reason-list-processing.html
Example Using Accessors (best for understand)
(defun count-by-N-3 (lst)
(if (equal NIL lst)
NIL
(- (first (rest lst)) (first lst))
)
(count-by-N-3 (rest lst))
)
This last one, the one that I will explain more clearly since it is the most understandable, you will do a recursion list manipulation (as in the others examples), and like the others, until the list is not NIL it will get the first element of the rest of the list and subtract the first element of the same list. The program will do this for every element till the list is "clean". And at last returns the list with the subtracted values.
That way if you read and study the similarities between using first, second and rest approach against using car and cdr, you easily will understand the both two first examples that I did put here.
Here is my final answer of this question which uses recursion:
(defun diff (N)
(- (second N) (first N))
)
(defun count-by-N (L)
(cond
((null L) nil)
((= (length L) 1) nil)
((= (length L) 2) (diff L))
((= (diff L) (diff (rest L))) (count-by-N (rest L)))
(T nil)
)
)