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.
Related
I'm trying to do a recursive version of the function position called positionRec. The objective is define the position of an element in a list, and if the element is not in the list return "nil". For exemple:
(positionRec 'a '(b c d a e)) => 4
(positionRec 'a '(b c d e)) => nil
I have written:
(defun positionRec (c l)
(cond
((atom l) (return nil))
((equal c (first l)) 1)
(t (+ 1 (positionRec c (rest l)))) ) )
I don't succeed to return nil. I have an error "*** - return-from: no block named nil is currently visible"
Anyone can teach me how to do it?
Lisp is an expression language: it has only expressions an no statemends. This means that the value of a call to a function is simply the value of the last form involved in that call This is different than many languages which have both statements and expressions and where you have to explicitly litter your code with explicit returns to say what the value of a function call is.
A cond form in turn is an expression. The value of an expression like
(cond
(<test1> <test1-form1> ... <test1-formn>)
(<test2> <test1-form1> ... <test1-formn>)
...
(<testn> <testn-form1> ... <testn-formnn>))
is the <testm-formn> of the first <testm> which is true, or nil if none of them are (and as a special case, if there are no forms after a test which is true the value is the value of that test).
So in your code you just need to make sure that the last form in the test which succeeds is the value you want:
(defun positionRec (c l)
(cond
((atom l) nil)
((equal c (first l)) 1)
(t (+ 1 (positionRec c (rest l))))))
So, what use is return? Well, sometimes you really do want to say 'OK, in the middle of some complicated loop or something, and I'm done now':
(defun complicated-search (...)
(dolist (...)
(dolist (...)
(dotimes (...)
(when <found-the-interesting-thing>
(return-from complicated-search ...))))))
return itself is simply equivalent to (return-from nil ...) and various constructs wrap blocks named nil around their bodies. Two such, in fact, are dotimes and dolist, so if you want to escape from a big loop early you can do that:
(defun complicated-search (...)
(dolist (...)
(when ...
(return 3)))) ;same as (return-from nil 3)
But in general because Lisp is an expression language you need to use return / return-from much less often than you do in some other languages.
In your case, the modified function is going to fail: if you get to the ((atom l) nil) case, then it will return nil to its parent which will ... try to add 1 to that. A better approach is to keep count of where you are:
(defun position-of (c l)
(position-of-loop c l 1))
(defun position-of-loop (c l p)
(cond
((atom l) nil)
((equal c (first l)) p)
(t (position-of-loop c (rest l) (1+ p)))))
Note that this (as your original) uses 1-based indexing: zero-based would be more compatible with the rest of CL.
It would probably be idiomatic to make position-of-loop a local function:
(defun position-of (c l)
(labels ((position-of-loop (lt p)
(cond
((atom lt) nil)
((equal c (first lt)) p)
(t (position-of-loop (rest lt) (1+ p))))))
(position-of-loop l 1)))
And you could then use an iteration macro if you wanted to make it a bit more concise:
(defun position-of (c l)
(iterate position-of-loop ((lt l) (p 1))
(cond
((atom lt) nil)
((equal c (first lt)) p)
(t (position-of-loop (rest lt) (1+ p))))))
The main problem is that you're trying to deal with incommensurable values. On the one hand, you want to deak with numbers, on the other, you want to deal with the empty list. You cannot add a number to a list, but you will inherently try doing so (you have an unconditional (1+ ...) call in your default branch in your cond).
There are ways to work around that, one being to capture the value:
(cond
...
(t (let ((val (positionRec c (rest l))))
(when val ;; Here we "pun" on nil being both false and the "not found" value
(1+ val)))))
Another would be to use a method amenable to tail-recursion:
(defun positionrec (element list &optional (pos 1))
(cond ((null list) nil)
((eql element (head list)) pos)
(t (positionrec element (rest list) (1+ pos)))))
The second function can (with a sufficently smart compiler) be turned into, basically, a loop. The way it works is by passing the return value as an optional parameter.
You could build a version using return, but you would probably need to make use of labels for that to be straight-forward (if you return nil directly from the function, it still ends up in the (1+ ...), where you then have numerical incompatibility) so I would go with either "explicitly capture the value and do the comparison against nil/false" or "the version amenable to tail-call elimination" and simply pick the one you find the most readable.
Is it possible to write the following without using backquote?
(defmacro while (test &rest body)
`(do ()
((not ,test))
,#body))
Thought I'd try this as an experiment to understand benefit of backquote.
I got as far as this:
(let* ((test '(> 10))
(x 0)
(body '((princ x) (incf x))))
(list 'do nil (list (list 'not test))))
Which successfully generates:
(DO NIL ((NOT (> 10))))
To finish this I need a way to spread the n elements of the list body into the generated form.
I know that's the entire purpose of the unquote splice ,# but is this actually impossible without it? Curious... It's similar to what apply does but I don't want to call a function at this point obviously.
In your case the body contains the remaining forms to be evaluated, and can be added with LIST*:
(let* ((test '(> 10))
(x 0)
(body '((princ x) (incf x))))
(list* 'do
nil
(list (list 'not test))
body))
Another example, where the spliced list is not at the end:
`(,x ,#y ,z)
The above can be written without backquotes as:
(list* x (append y (list z)))
I tried implementing Brainf**k in Common Lisp, SBCL. I have encountered some problems.
(defparameter *tape* (make-array '(1) :adjustable t))
(defparameter *pointer* 0)
(defparameter *tape-size* 1)
(defparameter *output* (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t))
(defun move-pointer-right (a b)
(declare (ignore a))
(declare (ignore b))
'(progn
(incf *tape-size*)
(adjust-array *tape* (list *tape-size*))
(incf *pointer*)))
(defun move-pointer-left (a b)
(declare (ignore a))
(declare (ignore b))
'(progn (decf *pointer*)))
(defun increment-byte (a b)
(declare (ignore a))
(declare (ignore b))
'(incf (aref *tape* *pointer*)))
(defun decrement-byte (a b)
(declare (ignore a))
(declare (ignore b))
'(decf (aref *tape* *pointer*)))
(defun start-loop (stream ch)
(declare (ignore ch))
(let ((loop-body (read-delimited-list #\] stream t)))
`(loop :until (zerop (aref *tape* *pointer*))
:do ,#loop-body)))
(defun print-one-char (a b)
(declare (ignore a))
(declare (ignore b))
'(with-output-to-string (s *output*) (write-char (code-char (aref *tape* *pointer*)) s)))
(defun read-one-char (a b)
(declare (ignore a))
(declare (ignore b))
'(setf (aref *tape* *pointer*) (char-code (read-char *standard-input*))))
(defun flush-output (a b)
(declare (ignore a))
(declare (ignore b))
'(progn *output*))
(defun reset-me (a b)
(declare (ignore a))
(declare (ignore b))
'(progn
(setf *output* (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t))
(adjust-array *tape* '(1))
(setf (aref *tape* 0) 0)
(setf *pointer* 0)))
(set-macro-character #\< #'move-pointer-left)
(set-macro-character #\> #'move-pointer-right)
(set-macro-character #\+ #'increment-byte)
(set-macro-character #\[ #'start-loop)
(set-macro-character #\= #'flush-output)
(set-macro-character #\. #'print-one-char)
(set-macro-character #\, #'read-one-char)
(set-macro-character #\! #'reset-me)
(set-macro-character #\- #'decrement-byte)
input doesn't work
I am not sure whether nested loops would work because "[" reads to "]" and if you try "[/commands[/more]/dubious]" I don't how /dubious could be loaded with this methods.
I tried "++[->+>+<<]". As far as I know array should have: "0 2 2" but I got "0 2 0" instead. I conclude something is deeply wrong.
I am getting a lot of warnings from SBCL - it would be better to not have them:/
Is there a quick way to output all generated code (returned from functions such as "move-pointer-right") to file?
output is saved in one string to be printed at "=" command. I did it, because other operations were printing a lot of useless things to standard output. It is not a big problem for me - it seems easy to imagine just printing to file, instead of this workaround.
I am sorry for possible mistakes in my English.
Edit: I edited code (again - thank you for help, Sylwester). Everything but input seems to work.
As for input: I used read-char, but it doesn't work the way I want it. For example ,D inputs "D". I would like to redo it so it stops evaluation at each , and waits for user input.
Question: Is there an alternative to progn that does not return values (I want to just evaluate but not return)? For example (what-i-look-for (setf a 1) 1 2) sets a to 1 but does not return 2.
Without knowing too much about how you think its supposed to work you need to define tape, pointer and output as global variables, preferrably with *earmuffs* so that you can see they are globals.
(defparameter *tape* (make-array '(1) :adjustable t))
Then I noticed > extends the *tape* with a default element nil. Thus for every > you do you should set it to 0 if it's not true (every value is true except nil) It also seem to think that pointer is always at the end of the tape. When doing >>>++++<<< the element with 4 in it is long gone.
loop-body is a global variable. You should have used let here to not clobber package level variables. You use loopwrong. See examples in Loop for black belts. Eg.
(defun start-loop (stream ch)
(declare (ignore ch))
(let ((loop-body (read-delimited-list #\] stream t)))
`(loop :until (zerop (aref *tape* *pointer*))
:do ,#loop-body)))
Notice the declare there that tells Common Lisp to ignore ch not being used. The nesting is done automatically since read-deliited-list calls start-loop at a new [.
print-one-char doesn't add the char based on the ascii value but adds it as a number. Also usually it's common to print right away in BF so print-char might be better. You can print to a string input stream if you want to continue keeping it in memory until you press =.
read reads lisp data. Thus you would need to give it #\a instead of an a. Use read-char instead.
I guess you have enough to tacke at this point. Doing it with macros and reader-macros looked cool, but it is difficult to debug and extending since after the reader macros are added you have problems with code consisting those characters. Making one function for each operation except [ would simplify testing since you can test that and the macro would just expand to calling it.
(defun move-pointer-left ()
(assert (> *pointer* 0) (*pointer*) "Tape pointer out of bounds: ~a" *pointer*)
(decf *pointer*))
(set-macro-character #\< (constantly '(move-pointer-left)))
UPDATED: The code should compile now without errors or warnings. Sorry about the previous one. The problem I have now is that when a run (or with any other integer)
(NxNqueen-solver 10)
The function getqueencol will return nil because there are no queens on the board in the first place, hence there will be a (= number nil) in the queen-can-be-placed-here because tcol will be nil. I think this will happen everytime there is no queen in the row passed as argument to the queen-can-be-placed-here function.
Please share some advice on how to fix this problem. Thank you in advance.
Here is the code
(defvar *board* (make-array '(10 10) :initial-element nil))
(defun getqueencol (row n)
"Traverses through the columns of a certain row
and returns the column index of the queen."
(loop for i below n
do (if (aref *board* row i)
(return-from getqueencol i))))
(defun print-board (n)
"Prints out the solution, e.g. (1 4 2 5 3),
where 1 denotes that there is a queen at the first
column of the first row, and so on."
(let ((solutionlist (make-list n)))
(loop for row below n
do (loop for col below n
do (when (aref *board* row col)
(setf (nth row solutionlist) col))))
(print solutionlist)))
(defun queen-can-be-placed-here (row col n)
"Returns t if (row,col) is a possible place to put queen, otherwise nil."
(loop for i below n
do (let ((tcol (getqueencol i n)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil)))))
(defun backtracking (row n)
"Solves the NxN-queen problem with backtracking"
(if (< row n)
(loop for i below n
do (when (queen-can-be-placed-here row i n)
(setf (aref *board* row i) 't)
(return-from backtracking (backtracking (+ row 1) n))
(setf (aref *board* row i) 'nil))
(print-board n))))
(defun NxNqueen-solver (k)
"Main program for the function call to the recursive solving of the problem"
(setf *board* (make-array '(k k) :initial-element nil))
(backtracking 0 k))
You say that you compiled your code. That can't be the case, since then you would have see the compiler complaining about errors. You want to make sure that you really compile the code and correct the code, such that it compiles without errors and warnings.
You might want to get rid of the errors/problems in the code (see Renzo's comment) and then look at the algorithmic problem. I makes very little sense to look into an algorithmic problem, when the code contains errors.
SETQ does not introduce a variable, the variable has to be defined somewhere
DEFVAR makes no sense inside a function.
Something like (let (x (sin a)) ...) definitely looks wrong. The syntax of LET requires a pair of parentheses around the bindings list.
RETURN-FROM takes as first argument the name of an existing block to return from. The optional second argument is a return value. Get the syntax right and return from the correct block.
in a call to MAKE-ARRAY specify the default value: (make-array ... :initial-element nil), otherwise it's not clear what it is.
The variable *board* is undefined
Style
in LOOP: for i to (1- n) is simpler for i below n
you don't need to quote NIL and T.
(if (eq foo t) ...) might be simpler written as (if foo ...). Especially if the value of foo is either NIL or T.
(if foo (progn ...)) is simply (when foo ...)
I'm not sure what you are doing to claim that your code compiles. It does not compile.
Every function has compiler warnings. You should check the compiler warnings and fix the problems.
(defun getqueencol (row)
"Traverses through the columns of a certain row
and returns the column index of the queen."
(loop for i below n
do (if (aref board row i)
(return-from getqueencol i))))
The compiler complains:
;;;*** Warning in GETQUEENCOL: N assumed special
;;;*** Warning in GETQUEENCOL: BOARD assumed special
Where is n defined? Where is board coming from?
(defun print-board (board)
"Prints out the solution, e.g. (1 4 2 5 3),
where 1 denotes that there is a queen at the first
column of the first row, and so on."
(let (solutionlist)
(setq solutionlist (make-list n)))
(loop for row below n
do (loop for col below n
do (when (aref board row col)
(setf (nth row solutionlist) col))))
(print solutionlist))
The LET makes no sense. (let (foo) (setq foo bar) ...) is (let ((foo bar)) ...).
Why is solutionlist not defined? Look at the LET... it does not make sense.
Where is n coming from?
(defun queen-can-be-placed-here (row col)
"Returns t if (row,col) is a possible place to put queen, otherwise nil."
(loop for i below n
do (let (tcol)
(setq tcol (getqueencol i)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil))))
where is n coming from? The LET makes no sense.
(defun backtracking (row)
"Solves the NxN-queen problem with backtracking"
(if (< row n)
(loop for i below n
do (when (queen-can-be-placed-here row i)
(setf (aref board row i) 't)
(return-from backtracking (backtracking (+ row 1)))
(setf (aref board row i) 'nil))
(print-board board))))
Where is n coming from? Where is board defined?
(defun NxNqueen-solver (k)
"Main program for the function call to the recursive solving of the problem"
(let (n board)
(setq n k)
(setq board (make-array '(k k) :initial-element nil)))
(backtracking 0))
Why use setq when you have a let? The local variables n and board are unused.
MAKE-ARRAY expects a list of numbers, not a list of symbols.
I propose you use a basic Lisp introduction (Common Lisp: A Gentle Introduction to Symbolic Computation - free download) and a Lisp reference (CL Hyperspec).
I'm a CommonLisp noob with a question. I have these two functions below.
A helper function:
(defun make-rests (positions rhythm)
"now make those positions negative numbers for rests"
(let ((resultant-rhythm rhythm))
(dolist (i positions resultant-rhythm)
(setf (nth i resultant-rhythm) (* (nth i resultant-rhythm) -1)))))
And a main function:
(defun test-return-rhythms (rhythms)
(let ((positions '((0 1) (0)))
(result nil))
(dolist (x positions (reverse result))
(push (make-rests x rhythms) result))))
When I run (test-return-rhythms '(1/4 1/8)), it evaluates to: ((1/4 -1/8) (1/4 -1/8))
However, I expected: (test-return-rhythms '(1/4 1/8)) to evaluate to: ((-1/4 -1/8) (-1/4 1/8)).
What am I doing wrong?
Your implementation of make-rests is destructive.
CL-USER> (defparameter *rhythm* '(1/4 1/4 1/4 1/4))
*RHYTHM*
CL-USER> (make-rests '(0 2) *rhythm*)
(-1/4 1/4 -1/4 1/4)
CL-USER> *rhythm*
(-1/4 1/4 -1/4 1/4)
So, if you run your test, the second iteration will see (-1/4 -1/8), and (make-rests '(0) '(-1/4 -1/8)) returns (1/4 -1/8). Your use of let in make-rests does not copy the list, it just creates a new binding that references it. Use copy-list in your let, or write a non-destructive version in the first place:
(defun make-rests (positions rhythm)
(loop for note in rhythm
for i from 0
collect (if (member i positions) (* note -1) note)))