I am creating a heuristic function and it returns what it is supposed to but also there is a stack overflow problem and I can't understand where is the problem. Here is the code of the functions i created:
(defun nextPositions (position)
(let*((listaPosAdjacentes)
(positionFinal position)
(listaFinal NIL))
(setf listaPosAdjacentes (possible-actions2))
(dolist (posAdjacente listaPosAdjacentes)
(setf positionFinal position)
(setf positionFinal (list (+ (nth 0 positionFinal) (nth 0 posAdjacente))
(+ (nth 1 positionFinal) (nth 1 posAdjacente))))
(push positionFinal listaFinal))
listaFinal))
(defun push-unique (element lista)
(let ((auxlist lista))
(dolist (i lista)
(if (and (equal (nth 0 i) (nth 0 element)) (equal (nth 1 i) (nth 1 element)))
(return-from push-unique auxlist)))
(push element auxlist)
auxlist))
(defun recursive (track1 positionslist distance track)
(let ((NextValidPositions NIL))
(dolist (position positionslist)
(if (equal (track-startpos track) position)
(return-from recursive track1)
(progn (dolist (i (nextPositions position))
(if (equal (nth (nth 1 i) (nth (nth 0 i) track1)) T)
(progn
(setf NextValidPositions (push-unique i NextValidPositions))
(setf (nth (nth 1 i) (nth (nth 0 i) track1)) (+ 1 distance))))))))
(recursive track1 NextValidPositions (+ 1 distance) track)))
(defun compute-heuristic(st)
(let* ((track (state-track st))
(distance 0)
(track1Final nil)
(track1heuristica (track-env track)))
(dolist (position (track-endpositions track))
(setf (nth (nth 1 position) (nth (nth 0 position) track1heuristica)) distance))
(setf track1Final (recursive track1heuristica (track-endpositions track) distance track))
(print track1Final)
(return-from compute-heuristic track1Final)))
The result is the following:
The list it returns is what it is supposed to return but I can't understand the stack overflow problem.
The code is called like this:
(format t "~&Exercise 3.1 - Heuristic~&")
(with-open-file (str "out3.1.txt"
:direction :input)
(format t "~% Solution is correct? ~a~&" (equal (list (compute-heuristic (initial-state *t1*)) (compute-heuristic (make-state :pos '(1 6) :track track)) (compute-heuristic (make-state :pos '(2 8) :track track))) (read str))))
It is a local test and this code was provided by our professor to test our code and that's why I think the problem is not there.
Any ideas what the problem might be?
Thanks.
About style:
Generally the code is not well written, since it uses too many control structures and variables which are not really needed.
Example:
(defun push-unique (element lista)
(let ((auxlist lista))
(dolist (i lista)
(if (and (equal (nth 0 i)
(nth 0 element))
(equal (nth 1 i)
(nth 1 element)))
(return-from push-unique auxlist)))
(push element auxlist)
auxlist))
unnecessary variable auxlist
no dolist needed, use member
no return-from needed, just return the value. In many case the use of return-from is a code smell, indicating too complicated code.
no push needed, just return the result of cons
Better:
(defun push-unique (element list)
(if (member element list
:test (lambda (a b)
(and (equal (first a) (first b))
(equal (second a) (second b)))))
list
(cons element list)))
The functionality exists already
The function push-unique exists already in standard Common Lisp. It is called adjoin:
CL-USER 34 > (adjoin 1 '(2 3 4 1 3))
(2 3 4 1 3)
CL-USER 35 > (adjoin 1 '(2 3 4 3))
(1 2 3 4 3)
Just pass the right test function for your purpose...
(defun push-unique (element list)
(adjoin element list
:test (lambda (a b)
(and (equal (first a) (first b))
(equal (second a) (second b))))))
Comments & documentation
Probably it's also a good idea to write comments and documentation.
Otherwise one has to guess/infer what the purpose of these functions is.
Related
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.
So, I am trying to do this hw problem: write a function that takes two arguments, a list and a number, and the function returns the index of the leftmost occurrence of the number in the list. For example:
If '(1 2 3 3 4) and num = 3, then it returns 2
If '(3 2 3 3 4) and num = 3, then it returns 0
I was able to do that part but what if the number was never found? What if I want to return false when num is not found in the list? How do I do that?
Please remember, I am trying to do this in proper recursion, not tail recursion.
Here's my code.
(define (first_elt_occ lst num)
(cond
((null? lst) #f)
((eq? (car lst) num) 0)
(else
(+ 1 (first_elt_occ (cdr lst) num)))))
(first_elt_occ '(1 2 3 3 4) 3) ;2
(first_elt_occ '(3 2 3 3 4) 3) ;0
(first_elt_occ '(1 2 5 4 3) 3) ;4
(first_elt_occ '(1 2 5 4 3) 6) ;Error
;(makes sense because you can't add boolean expression)
Another question I have is, how would I approach this problem, if I was asked to return the index of the rightmost occurrence of the number in a list (proper recursion). For example: '(3 4 5 4 3 7 ), num = 3 returns 4.
Thank you!
As suggested in the comments, this will be easier if we implement the procedure using tail recursion - by the way, tail recursion is "proper recursion", what makes you think otherwise?
By defining a helper procedure called loop and passing the accumulated result in a parameter, we can return either #f or the index of the element:
(define (first_elt_occ lst num)
(let loop ((lst lst) (acc 0))
(cond
((null? lst) #f)
((equal? (car lst) num) acc)
(else (loop (cdr lst) (add1 acc))))))
If, for some bizarre requirement you can't use tail recursion in your solution, it's possible to rewrite you original solution to account for the case when the answer is #f - but this isn't as elegant or efficient:
(define (first_elt_occ lst num)
(cond
((null? lst) #f)
((equal? (car lst) num) 0)
(else
(let ((result (first_elt_occ (cdr lst) num)))
(if (not result) #f (add1 result))))))
Either way, it works as expected:
(first_elt_occ '(1 2 3 3 4) 3) ; 2
(first_elt_occ '(3 2 3 3 4) 3) ; 0
(first_elt_occ '(1 2 5 4 3) 3) ; 4
(first_elt_occ '(1 2 5 4 3) 6) ; #f
I don't recommend actually taking this approach because a normal tail-recursive implementation is a lot more efficient, simpler, and easier to understand, but you can use a continuation to short-circuit unwinding the call stack in the failure case:
(define (first_elt_occ lst num)
(call/cc
(lambda (return)
(letrec ((loop (lambda (lst)
(cond
((null? lst) (return #f))
((= (car lst) num) 0)
(else (+ 1 (loop (cdr lst))))))))
(loop lst)))))
The basic find first occurrence "skeleton" function is
(define (first_elt_occ lst num)
(and (not (null? lst))
(or (equal (car lst) num)
(first_elt_occ (cdr lst) num))))
This does not return index though. How to add it in?
(define (first_elt_occ lst num)
(and (not (null? lst))
(or (and (equal (car lst) num) 0)
(+ 1 (first_elt_occ (cdr lst) num)))))
Does it work? Not if the element isn't there! It'll cause an error then. How to fix that? Change the +, that's how!
(define (first_elt_occ lst num)
(let ((+ (lambda (a b) (if b (+ a b) b))))
(and (not (null? lst))
(or (and (= (car lst) num) 0)
(+ 1 (first_elt_occ (cdr lst) num))))))
And now it works as expected:
> (first_elt_occ '(1 2 3 3 4) 3)
2
> (first_elt_occ '(3 2 3 3 4) 3)
0
> (first_elt_occ '(3 2 3 3 4) 5)
#f
And to get your second desired function, we restructure it a little bit, into
(define (first_elt_occ lst num)
(let ((+ (lambda (a b) ...... )))
(and (not (null? lst))
(+ (and (= (car lst) num) 0)
(first_elt_occ (cdr lst) num)))))
Now, what should that new + be? Can you finish this up? It's straightforward!
It's unclear why you are opposed to tail recursion. You talk about "proper recursion", which is not a technical term anyone uses, but I assume you mean non-tail recursion: a recursive process rather than an iterative one, in SICP terms. Rest assured that tail recursion is quite proper, and in general is preferable to non-tail recursion, provided one does not have to make other tradeoffs to enable tail recursion.
As Óscar López says, this problem really is easier to solve with tail recursion. But if you insist, it is certainly possible to solve it the hard way. You have to avoid blindly adding 1 to the result: instead, inspect it, adding 1 to it if it's a number, or returning it unchanged if it's false. For example, see the number? predicate.
I'm trying to write a recursive function to check if the elements of a list are increasing consecutively.
(defun test (lst)
(if (null lst)
1
(if (= (car lst) (1- (test (cdr lst))))
1
0)))
(setq consecutive '(1 2 3 4))
(setq non-consecutive '(2 5 3 6))
The results are:
CL-USER> (test non-consecutive)
0
CL-USER> (test consecutive)
0
(test consecutive) should return 1. How can I write this function correctly?
To check that the numbers in the sequence are consecutive, i.e.,
increasing with step 1, you need this:
(defun list-consecutive-p (list)
(or (null (cdr list))
(and (= 1 (- (second list) (first list)))
(list-consecutive-p (rest list)))))
Then
(list-consecutive-p '(1 2 3 4))
==> T
(list-consecutive-p '(1 4))
==> NIL
(list-consecutive-p '(4 1))
==> NIL
NB. Numbers are a poor substitute for booleans.
PS. I wonder if this is related to How to check if all numbers in a list are steadily increasing?...
I'm baffled. I'm playing around with the tic-tac-toe game found in Ch 10 of COMMON LISP:
A Gentle Introduction to Symbolic Computation https://www.cs.cmu.edu/~dst/LispBook/book.pdf . I worked everything up in the IDE, saved it and then compiled+loaded it. I ran several games with no problem. So, I copied the known-working file and started tweaking. Again, no problems -- everything was working fine. Now, however, when I run (play-one-game) I get the following error:
Error: Attempt to take the value of the unbound variable '*OPPONENT**'
I get the error in both the original and the copy. I closed the AllegroCL and restarted my computer, but the problem persisted after reboot. I then updated the program and ran ./update.sh in it's app directory.
Finally, I decided to then copy the example right from the PDF in a brand-new file in a different directory, and I get the same problem. I don't know what changed, but it's got me plussed to say the least.
(defun make-board ()
(list 'board 0 0 0 0 0 0 0 0 0))
(defun convert-to-letter (v)
(cond ((equal v 1) "O")
((equal v 10) "X")
(t " ")))
(defun print-row (x y z)
(format t "~& ~A | ~A | ~A"
(convert-to-letter x)
(convert-to-letter y)
(convert-to-letter z)))
(defun print-board (board)
(format t "~%")
(print-row
(nth 1 board) (nth 2 board) (nth 3 board))
(format t "~& -----------")
(print-row
(nth 4 board) (nth 5 board) (nth 6 board))
(format t "~& -----------")
(print-row
(nth 7 board) (nth 8 board) (nth 9 board))
(format t "~%~%"))
(defun make-move (player pos board)
(setf (nth pos board) player)
board)
(setf *triplets*
'((1 2 3) (4 5 6) (7 8 9) ;Horizontal triplets.
(1 4 7) (2 5 8) (3 6 9) ;Vertical triplets.
(1 5 9) (3 5 7))) ;Diagonal triplets.
(defun sum-triplet (board triplet)
(+ (nth (first triplet) board)
(nth (second triplet) board)
(nth (third triplet) board)))
(defun compute-sums (board)
(mapcar #'(lambda (triplet)
(sum-triplet board triplet))
*triplets*))
(defun winner-p (board)
(let ((sums (compute-sums board)))
(or (member (* 3 *computer*) sums)
(member (* 3 *opponent*) sums))))
(defun play-one-game ()
(if (y-or-n-p "Would you like to go first? ")
(opponent-move (make-board))
(computer-move (make-board))))
(defun opponent-move (board)
(let* ((pos (read-a-legal-move board))
(new-board (make-move
*opponent*
pos
board)))
(print-board new-board)
(cond ((winner-p new-board)
(format t "~&You win!"))
((board-full-p new-board)
(format t "~&Tie game."))
(t (computer-move new-board)))))
(defun read-a-legal-move (board)
(format t "~&Your move: ")
(let ((pos (read)))
(cond ((not (and (integerp pos)
(<= 1 pos 9)))
(format t "~&Invalid input.")
(read-a-legal-move board))
((not (zerop (nth pos board)))
(format t
"~&That space is already occupied.")
(read-a-legal-move board))
(t pos))))
(defun board-full-p (board)
(not (member 0 board)))
(defun computer-move (board)
(let* ((best-move (choose-best-move board))
(pos (first best-move))
(strategy (second best-move))
(new-board (make-move
*computer* pos board)))
(format t "~&My move: ~S" pos)
(format t "~&My strategy: ~A~%" strategy)
(print-board new-board)
(cond ((winner-p new-board)
(format t "~&I win!"))
((board-full-p new-board)
(format t "~&Tie game."))
(t (opponent-move new-board)))))
(defun random-move-strategy (board)
(list (pick-random-empty-position board)
"random move"))
(defun pick-random-empty-position (board)
(let ((pos (+ 1 (random 9))))
(if (zerop (nth pos board))
pos
(pick-random-empty-position board))))
(defun make-three-in-a-row (board)
(let ((pos (win-or-block board
(* 2 *computer*))))
(and pos (list pos "make three in a row"))))
(defun block-opponent-win (board)
(let ((pos (win-or-block board
(* 2 *opponent*))))
(and pos (list pos "block opponent"))))
(defun win-or-block (board target-sum)
(let ((triplet (find-if
#'(lambda (trip)
(equal (sum-triplet board
trip)
target-sum))
*triplets*)))
(when triplet
(find-empty-position board triplet))))
(defun find-empty-position (board squares)
(find-if #'(lambda (pos)
(zerop (nth pos board)))
squares))
(defun choose-best-move (board) ;Second version.
(or (make-three-in-a-row board)
(block-opponent-win board)
(random-move-strategy board)))
If you're following the instructions it the book, it tells you to invoke
(setf *computer* 10)
(setf *opponent* 1)
Apparently you didn't include that in your code listing.
In general -- if you get an error that something is unbound, the obvious thing to do is to look for the code that should be binding it to a value.
Using LISP, i need to create a function that splits a list into two lists. The first list consists of 1st, 3rd, 5th, 7th, etc elements and the second list consists of 2nd, 4th, 6th, etc elements.
Output Examples:
(SPLIT-LIST ( )) => (NIL NIL)
(SPLIT-LIST '(A B C D 1 2 3 4 5)) => ((A C 1 3 5) (B D 2 4))
(SPLIT-LIST '(B C D 1 2 3 4 5)) => ((B D 2 4) (C 1 3 5))
(SPLIT-LIST '(A)) => ((A) NIL)
The function need to be recursive.
This is my code so far.
(defun SPLIT-LIST (L)
(cond
((null L) NIL)
((= 1 (length L)) (list (car L)))
(t (cons (cons (car L) (SPLIT-LIST (cddr L))) (cadr L)))))
);cond
);defun
i'm going to try to use flatten later on so that i end up w/ two lists, but for now, i just can't seem to get the sequence correctly.
MY CODE:
> (SPLIT-LIST '(1 2 3 4))
((1 (3) . 4) . 2)
I just can't seem to make the code print 1 3 2 4 instead of 1 3 4 2.
> (SPLIT-LIST '(1 2 3 4 5 6))
((1 (3 (5) . 6) . 4) . 2)
I can't make the second half of the expected output to print in the correct sequence.
Your code
We typically read Lisp code by indentation, and don't write in all-caps. Since we read by indentation, we don't need to put closing parens (or any parens, really) on their own line. Your code, properly formatted, then, is:
(defun split-list (l)
(cond
((null l) '())
((= 1 (length l)) (list (car l)))
(t (cons (cons (car l)
(split-list (cddr l)))
(cadr l)))))
Getting the base cases right
Split-list is always supposed to return a list of two lists. We should cover those base cases first. When l is empty, then there's nothing in the left list or the right, so we can simply return '(() ()). Then first condition then becomes:
((null l) '(() ())) ; or ((endp l) '(() ()))
Judging by your second case, I gather that you want the second and third cases to be: (i) if there's only one element left, it must be an odd-numbered one, and belongs in the left result; (ii) otherwise, there are at least two elements left, and we can add one to each. Then the second condition should be
((= 1 (length l)) (list (car l) '()))
It's actually kind of expensive to check the length of l at each step. You only care whether there is only one element left. You already know that l isn't empty (from the first case), so you can just check whether the rest oflis the empty list. I find it more readable to usefirstandrest` when working with cons cells as lists, so I'd write the second clause as:
((endp (rest l)) (list (list (first l)) '()))
Handling the recursive case
Now, your final case is where there are at least two elements. That means that l looks like (x y . zs). What you need to do is call split-list on zs to get some result of the form (odd-zs even-zs), and then take it apart and construct ((x . odd-zs) (y . even-zs)). That would look something like this:
(t (let ((split-rest (split-list (rest (rest l)))))
(list (list* (first l) (first split-rest))
(list* (second l) (second split-rest)))))
There are actually some ways you can clean that up. We can use destructuring-bind to pull odd-zs and even-zs out at the same time. Since this is the last clause of the cond, and a clause returns the value of the test if there are no body forms, we don't need the initial t. The last clause can be:
((destructuring-bind (odd-zs even-zs) ; *
(split-list (rest (rest l)))
(list (list* (first l) odd-zs)
(list* (second l) even-zs))))))
*I omitted the t test because if a cond clause has no body forms, then the value of the test is returned. That works just fine here.
Putting that all together, we've reworked your code into
(defun split-list (l)
(cond
((endp l) '(() ()))
((endp (rest l)) (list (list (first l)) '()))
((destructuring-bind (odd-zs even-zs)
(split-list (rest (rest l)))
(list (list* (first l) odd-zs)
(list* (second l) even-zs))))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
Other approaches
I think it's worth exploring some approaches that are tail recursive, as an implementation that supports tail call optimization can convert them to loops. Tail recursive functions in Common Lisp are also typically easy to translate into do loops, which are much more likely to be implemented as iteration. In these solutions, we'll build up the result lists in reverse, and then reverse them when it's time to return them.
Recursing one element at a time
If the left and right slices are interchangeable
If it doesn't matter which of the two lists is first, you can use something like this:
(defun split-list (list &optional (odds '()) (evens '()))
(if (endp list)
(list (nreverse odds)
(nreverse evens))
(split-list (rest list)
evens
(list* (first list) odds))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((B D 2) (A C 1 3))
This can actually be written very concisely using a do loop, but that's typically seen as iterative, not recursive:
(defun split-list (list)
(do ((list list (rest list))
(odds '() evens)
(evens '() (list* (first list) odds)))
((endp list) (list (nreverse odds) (nreverse evens)))))
If they're not interchangable
If you always need the list containing the first element of the original list to be first, you'll need a little bit more logic. One possibility is:
(defun split-list (list &optional (odds '()) (evens '()) (swap nil))
(if (endp list)
(if swap
(list (nreverse evens)
(nreverse odds))
(list (nreverse odds)
(nreverse evens)))
(split-list (rest list)
evens
(list* (first list) odds)
(not swap))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
I think that (if swap … …) is actually a bit ugly. We can use cond so that we can get multiple forms (or if and progn), and swap the values of odds and evens before returning. I think this is actually a bit easier to read, but if you're aiming for a pure recursive solution (academic assignment?), then you might be avoiding mutation, too, so rotatef wouldn't be available, and using a when just to get some side effects would probably be frowned upon.
(defun split-list (list &optional (odds '()) (evens '()) (swap nil))
(cond
((endp list)
(when swap (rotatef odds evens))
(list (nreverse odds) (nreverse evens)))
((split-list (rest list)
evens
(list* (first list) odds)
(not swap)))))
This lends itself to do as well:
(defun split-list (list)
(do ((list list (rest list))
(odds '() evens)
(evens '() (list* (first list) odds))
(swap nil (not swap)))
((endp list)
(when swap (rotatef odds evens))
(list (nreverse odds) (nreverse evens)))))
Recursing two elements at a time
Another more direct approach would recurse down the list by cddr (i.e., (rest (rest …))) and add elements to the left and right sublists on each recursion. We need to be a little careful that we don't accidentally add an extra nil to the right list when there are an odd number of elements in the input, though.
(defun split-list (list &optional (left '()) (right '()))
(if (endp list)
(list (nreverse left)
(nreverse right))
(split-list (rest (rest list))
(list* (first list) left)
(if (endp (rest list))
right
(list* (second list) right)))))
CL-USER> (split-list '(a b c 1 2 3))
((A C 2) (B 1 3))
CL-USER> (split-list '(a b c d 1 2 3))
((A C 1 3) (B D 2))
And again, a do version:
(defun split-list (list)
(do ((list list (rest (rest list)))
(left '() (list* (first list) left))
(right '() (if (endp (rest list)) right (list* (second list) right))))
((endp list) (list (nreverse left) (nreverse right)))))
Here's what I've got:
(defun split-list (lst)
(if lst
(if (cddr lst)
(let ((l (split-list (cddr lst))))
(list
(cons (car lst) (car l))
(cons (cadr lst) (cadr l))))
`((,(car lst)) ,(cdr lst)))
'(nil nil)))
After reading SICP I'm rarely confused about recursion.
I highly recommend it.
Here's my take, using an inner function:
(defun split-list (lst)
(labels ((sub (lst lst1 lst2 flip)
(if lst
(if flip
(sub (cdr lst) (cons (car lst) lst1) lst2 (not flip))
(sub (cdr lst) lst1 (cons (car lst) lst2) (not flip)))
(list (reverse lst1) (reverse lst2)))))
(sub lst nil nil t)))
As a Common Lisp LOOP:
(defun split-list (list)
"splits a list into ((0th, 2nd, ...) (1st, 3rd, ...))"
(loop for l = list then (rest (rest l))
until (null l) ; nothing to split
collect (first l) into l1 ; first split result
unless (null (rest l))
collect (second l) into l2 ; second split result
finally (return (list l1 l2))))
With internal tail-recursive function building the lists in top-down manner (no reverses, loop code probably compiles to something equivalent), with a head-sentinel trick (for simplicity).
(defun split-list (lst &aux (lst1 (list 1)) (lst2 (list 2)))
(labels ((sub (lst p1 p2)
(if lst
(progn (rplacd p1 (list (car lst)))
(sub (cdr lst) p2 (cdr p1)))
(list (cdr lst1) (cdr lst2)))))
(sub lst lst1 lst2)))
Flatten is fun to define in Lisp. But I've never had a use for it.
So if you think "I could use flatten to solve this problem" it's probably because you're trying to solve the wrong problem.
(defun split-list (L)
(if (endp L)
'(nil nil)
(let ((X (split-list (cdr L))))
(list (cons (car L) (cadr X)) (car X))
)))