Lisp macro that does loop "unrolling" - macros

My first steps with Lisp macros...
(defconstant width 7)
(defconstant height 6)
...
; board is a 2D array of width x height
; and this is my first ever macro:
(defmacro at (y x)
`(aref board ,y ,x))
; "board" must be available wherever the macro is used.
(defun foo (board ...)
...
(loop for y from 0 to (1- height) do
; thanks to the "at" macro, this is cleaner:
(let ((score (+ (at y 0) (at y 1) (at y 2))))
(loop for x from 3 to (1- width) do
(incf score (at y x))
; ...do something with score
(decf score (at y (- x 3)))))))
The code uses my first ever macro, the "at" one. It emits "access instructions" to read from board[y][x], so it can only be used in places where "board" exists, like the function "foo" above.
This worked - and then I realized that... I can go further.
The two nested loops are "statically" constrained: from 0 to height-1 for y, from 3 to (width-1) for x... so in theory, I can create a macro that emits (unrolls!) the exact incf and decf instructions done in the loops' code!
I tried this:
(defmacro unroll ()
(loop for y from 0 to (1- height) do
`(setf score (+ (at ,y 0) (at ,y 1) (at ,y 2)))
(loop for x from 3 to (1- width) do
`(incf score (at ,y ,x))
`(decf score (at ,y (- ,x 3))))))
...but failed - "(macroexpand-1 '(unroll))" shows me NIL.
What am I doing wrong?
In case it is not clear, I want to use two nested loops and emit "code" at the beginning of the outer loop, and for each iteration of the inner loop.
Any help most appreciated (I am a LISP newbie).
UPDATE: After #larsmans' kind advice, I succeeded in applying this change to my code - and to my immense satisfaction, I watched the Lisp version of my Score4 algorithm become the 2nd fastest implementation, behind only C and C++ (and faster than OCaml!).

You should collect the statements you generate inside the macro's loop, not pretend to execute them with do:
(defmacro unroll ()
(loop for y from 0 to (1- height)
collect
`(begin (setf score (+ (at ,y 0) (at ,y 1) (at ,y 2)))
,#(loop for x from 3 to (1- width)
collect `(begin (incf score (at ,y ,x))
(decf score (at ,y (- ,x 3))))))))

Related

a function called A-SUM that calculates Σpi=ni, where n≥0,p≥0. Below are examples of what A-SUM returns considering different arguments

CL-USER> (a-sum 0 3)
->> 6
I wrote this program :
(defun a-sum (x y)
(if (and (> x -1) (> y -1))
(do ((i 0 (1+ i))
(sum 0)
(num x))
((equal i (+ (- y x) 1)))
(setq sum (+ sum num))
(setq num (+ num 1))
sum)
(print " NOPE")))
put if I run it in the terminal it returns nil and not the answer stated above;
can someone help with the problem so it returns the value then Boolean.
DO,DO* Syntax
The entry for DO,DO* says that the syntax is as follows:
do ({var | (var [init-form [step-form]])}*)
(end-test-form result-form*)
declaration*
{tag | statement}*
The body is used as a list of statements and no intermediate value in this body is used as the result form of the do form. Instead, the do form evaluates as the last expression in result-form*, which defaults to nil.
(do ((i 0 (1+ i))
(sum 0)
(num x))
((equal i (+ (- y x) 1))
;;; RESULT FORMS HERE
)
(setq sum (+ sum num)) ;; (*)
(setq num (+ num 1)) ;; (*)
sum ;; (*)
)
All the expressions marked commented (*) above are used for side-effects only: the result of their evaluation is unused and discarded.
Problem statement
It is not clear to me what Σpi=ni means, and your code does not seem to compute something that could be expressed as that mathematical expression.
One red flag for example is that if (+ (- y x) 1) is negative (i.e. if y < x-1, for example y=1,x=3), then your loop never terminates because i, which is positive or null, will never be equal to the other term which is negative.
I would try to rewrite the problem statement more clearly, and maybe try first a recursive version of your algorithm (whichever is easier to express).
Remarks
Please indent/format your code.
Instead of adding setq statements in the body, try to see if you can define them in the iteration clauses of the loop (since I'm not sure what you are trying to achieve, the following example is only a rewrite of your code):
(do ((i 0 (1+ i))
(sum 0 (+ sum num)
(num x (1+ num))
(... sum))
Consider what value(s) a function returns. It's the value of the last form evaluated. In your case, that appears to be a do or maybe a setq or print (It's difficult to read as it's formatted now, and I don't have question edit privileges).
In short, the form that's returning the value for the function looks to be one evaluated for side-effects instead of returning a value.

Questions about replacing while and if statements with lisp

I want to change the code below to Lisp code, but I keep getting errors in grammar. How do I fix the if statement?
int promising(int i)
{
int k = 1;
while (k < i)
{
if (col[i] == col[k] || abs(col[i] - col[k]) == abs(i - k))
return 0;
k++;
}
return 1;
}
Below is the one I changed to the Lisp code.
(setq col (list 0 0 0 0))
(DEFUN promising (i)
(let ((k 1)) ; k =1
(loop while (< k i)
do((if (or ( = (nth i col) (nth k col))
(= ( abs((setq a (- (nth i col) (nth k col)))))
( abs((setq b (- i k ))))))
(return-from promising 0)))
do (setq k (1+ k)))
(return-from promising 1))
)
It is difficult for me to flexibly change the complicated condition of the if statement to the lisp code.
You are doing "C-in-Lisp". Trying to directly translate C (or for that matter, C++/Java/C#/Python ...) programs into Lisp will often lead to poor code, and you should be better off trying to understand how those problems are sovled in Lisp.
That being said:
You should not use (setq col <whatever>) at the toplevel. Global variables are introduced using defvar or defparameter and their name is of the form *variable-name* to distinguish them from other variables. This is because they have different scoping rules, and behave differently (i.e. they are not equivalent to other languages' global variables). In particular, using setq with a variable that has not been declared with defvar or defparameter is undefined behaviour, and most implementations will allow it, but they will then create this global variable. You generally don't want that. To sum up: either use (defvar *col* (list 0 0 ...)) if you need this really is a global variable, or simply use (let ((col (list 0 ...))) <more-code>) where you need it.
loop is a complicated construct. This is, in itself, another mini-language that you have to learn on top of Lisp. In particular, if all you ever want to do is "loop with some variable between some bounds and increment it by some value at each step", use
(loop for k from 1 do ...) ;; this introduces a local variable k, incremented by 1 at each step, with no upper bound
(loop for k from 1 to 10 do ...) ;; same, but only loop until k reaches 10
(loop for k from 1 to 10 by 3 do ...) same, but increments k by 3 at each step
Other constructs are available. Read this section of Practical Common Lisp for a good introduction, and the relevant CLHS section for a technical description and documentation.
Please follow conventions for whitespace this makes it much easier to read. For example, never place a parenthesis alone on its line (e.g. your very last parenthesis), and ( abs((setq b (- i k )))) should really be written (abs ((setq b (- i k)))) (ignoring the fact that this is incorrect, see below ...). As far as style is concerned, you also need to fix the indentation, and don't write DEFUN is uppercase, it is unnecessary and looks weird.
You cannot place extra parenthensis just to group things together, parenthesis have semantic meaning. In particular, in most cases, calling a function or using pretty much any special operator is done by (<operator-name> <first-arg> <second-arg> ... ). You almost never have 2 consecutive opening parenthesis.
Why are you using (setq a ...) and (setq b ...) in your loop ? Neither a nor b is ever declared or used anywhere else.
If you want to access specific elements of a list, don't use a list, use a vector. In particular, several calls to the nth function is often the sign that you really should have been using a vector.
A correct version of your code, using a few loop facilities, and still assuming that col is a list (which is should not be) although there would be other loop constructs making this even clearer ...
(defun promising (i)
(loop for k from 1 below i
for col-k = (nth k col)
do (when (or (= (nth i col) (nth k col))
(= (abs (- (nth i col) (nth k col)))
(abs (- i k))))
(return-from promising 0)))
1)
Note that this code is incredibly inefficient and this is why I suggested not to translate directly from C to Lisp. In particular, although you traverse a list (you access the k-th element at the k-th step), your code calls nth at each step instead of traversing the list ! You also compute (nth i col) at each step, which is already useless in C (it is constant so doesn't need to be recomputed at every step), but is catastrophic here. This should really be:
(defun promising (i)
(let ((col-i (nth i col)))
(loop for k from 1 below i
for col-k in (cdr col) ;; you start from the index 1, not 0
do (when (or (= col-i col-k)
(= (abs (- col-i col-k))
(abs (- i k))))
(return-from promising 0))))
1)
There are several mistakes in the code.
Incorrect function calls
(DEFUN promising (i)
(let ((k 1)) ; k =1
(loop while (< k i)
do((if (or ( = (nth i col) (nth k col))
;; ^^
;; Incorrect
)
And also here:
(setq col (list 0 0 0 0))
(DEFUN promising (i)
(let ((k 1)) ; k =1
(loop while (< k i)
do((if (or ( = (nth i col) (nth k col))
(= ( abs((setq a (- (nth i col) (nth k col)))))
;; ^^
;; Incorrect
( abs((setq b (- i k ))))))
;; ^^
;; Incorrect
(return-from promising 0)))
do (setq k (1+ k)))
(return-from promising 1))
)
The loop macro have 2 do keywords
(setq col (list 0 0 0 0))
(DEFUN promising (i)
(let ((k 1)) ; k =1
(loop while (< k i)
do((if (or ( = (nth i col) (nth k col))
;; ^^
;; First do
(= ( abs((setq a (- (nth i col) (nth k col)))))
( abs((setq b (- i k ))))))
(return-from promising 0)))
do (setq k (1+ k)))
;; ^^
;; Second do
(return-from promising 1))
)
return-from is used several times
return-from is usually not present in Common Lisp code, this is pretty much like C goto, something developers try to avoid.
Incoherent setq defining a and b (probably old code)
(setq col (list 0 0 0 0))
(DEFUN promising (i)
(let ((k 1)) ; k =1
(loop while (< k i)
do((if (or ( = (nth i col) (nth k col))
(= ( abs((setq a (- (nth i col) (nth k col)))))\
;; ^^^^^^
;; ??
( abs((setq b (- i k ))))))
;; ^^^^^^
;; ??
Weird incrementation scheme
(setq k (1+ k))
While being correct, Common Lisp programmers will simply use the increment function:
(incf k)
Final code
The code you might looking for should be close to that one:
(defun promising (i)
(let ((k 1))
(loop while (< k i) do
(if (or (= (nth i col) (nth k col))
(= (abs (- (nth i col) (nth k col)))
(abs (- i k ))))
(return-from promising 0))
(incf k))
;; return value
k))
Please note that the code is not equivalent to the C version, because the data structure is completely different. In the C version, the access to the data will be very fast O(1). The Common Lisp version will be slow if you have a large number of elements O(n). You can be fast with Common Lisp if you replace your list by an array/vector.

Unused Lexical Variable

Just started learning lisp. I have no idea why I am getting these errors or even what they mean. I am simply trying to code an approximation of pi using the Gregory-Leibniz series, here is the code.
(defun gl (n)
(defparameter x 0) ;init variable to hold our runnning sum
(loop for y from 0 to n ;number of iterations, starting from 0 to desired n
(if (= y 0) ;if n is 0 then we just want 4
(defparameter w 4))
(if (> y 0) ;else, 4*(-1^y)/((2 * y)+1)
(defparameter w (* 4 (/ (exp -1 y) (+ (* 2 y) 1)))))
(+ x w)) ;add to our running sum
(write x)) ;once loop is over, print x.
I have tried using setq, defvar, let etc. instead of defparameter but I still get "Undeclared free variable X".
I also get the error "Unused lexical variable N" even though I am using it for my loop, which is weird also.
How can I fix this and why is it happening? Thanks!
Here is the code after Emacs auto-indented it:
(defun gl (n)
(defparameter x 0)
(loop for y from 0 to n
(if (= y 0)
(defparameter w 4))
(if (> y 0)
(defparameter w (* 4 (/ (exp -1 y) (+ (* 2 y) 1)))))
(+ x w))
(write x))
Compiling the following code with SBCL gives one error and two warnings.
One warning says that x is undefined.
You should not call defparameter from inside your function, since defvar and defparameter are used to declare dynamic variables and to set their value in the global scope. Prefer to have let bindings, or, since you already are using a loop, a with clause. When you want to modify a binding, use setf.
The errors comes from the macroexpansion of LOOP, which is malformed. For SBCL, that means that the code is treated as dead-code for the rest of the function compilation; that explains why n appears not to be used, which is what the second warning is about.
There are various fixes remaining to be done:
Use function EXPT, not EXP.
Calling (+ x w) only computes a value but does not modify x, the result is useless.
Prefer using if as expression, like a ternary operator in other languages, in your case the code can be simplified
Adding one can be done with function 1+ (that's the name of the function, not a special syntax for adding constants)
The write operation is rarely needed, especially if you are computing a mathematical formula; just return the value, and the REPL will print it automatically.
Small corrections that make your code works:
(defun gl (n)
(let ((x 0))
(loop
for y from 0 to n
for w = (if (= y 0)
4
(* 4 (/ (expt -1 y) (+ (* 2 y) 1))))
do (setf x (+ x w)))
(write x)))
I would personally get rid of x and w, and use a SUM loop clause.
(defun gl (n)
(loop
for y from 0 to n
sum (if (zerop y)
4
(* 4 (/ (expt -1 y)
(1+ (* 2 y)))))))

Position of All Matching Elements in List

I'm trying to write a function in Common Lisp similar to the built in position function, that returns a list of the positions of all elements in the haystack that match the needle, as opposed to just the first. I've come up with a few possible solutions (for example recursively searching for the next element using a cdr-from function on the position and adding the result to the previous position) but none of the approaches I've come up with so far seem particularly elegant.
Can anyone suggest what would be the best way of approaching this, as I'm currently struggling.
The obvious way to solve the problem is just to look at each element of the list in turn, and each time one compares as equal to the needle collect its position into an output list. Getting the position is very easy in this case, because we are starting from the beginning of haystack; we can use a variable to count the current position starting from 0.
So if we describe the full algorithm in a sentence, we'd say something like "to find all the positions of a needle in a haystack, for each element in the haystack, and the position starting from 0, when the element is equal to the needle, collect the position."
The LOOP facility is basically the right thing to break out when you want to do iterative processing. Even though its syntax is complicated to describe formally, after some experience you can pretty much just put the English-language description of the algorithm in the body of LOOP and it will work.
(defun all-positions (needle haystack)
(loop
for element in haystack
and position from 0
when (eql element needle)
collect position))
Take this one with a grain of salt (and be sure to load Alexandria beforehand):
(defun positions (item sequence &key (test #'eql))
(mapcar #'car
(remove item (map 'list #'cons (alexandria:iota (length sequence)) sequence)
:test-not test
:key #'cdr)))
That said, it does have the advantage of working on arbitrary sequences:
CL-USER> (positions 'x #(x x y y x x y y))
(0 1 4 5)
CL-USER> (positions 5 (list 5.0 -1 5 5.0 -1) :test #'=)
(0 2 3)
CL-USER> (positions #\l "Hello")
(2 3)
If you want a recursive function, rather than a (loop ...) based one, you could use something like:
(defun all-positions (needle haystack)
(labels ((f (n h c r)
(if (null h)
r
(if (eql (car h) n)
(f n (cdr h) (1+ c) (cons c r))
(f n (cdr h) (1+ c) r))))))
(reverse (f needle haystack 0 nil)))
Here's another (not necessarily better) way to do it.
(defun get-positions (needle haystack)
(let ((result nil))
(dotimes (i (length haystack))
(if (eq (nth i haystack) needle)
(push i result)))
(nreverse result)))

Is it correct to use the backtick / comma idiom inside a (loop ...)?

I have some code which collects points (consed integers) from a loop which looks something like this:
(loop
for x from 1 to 100
for y from 100 downto 1
collect `(,x . ,y))
My question is, is it correct to use `(,x . ,y) in this situation?
Edit: This sample is not about generating a table of 100x100 items, the code here just illustrate the use of two loop variables and the consing of their values. I have edited the loop to make this clear. The actual loop I use depends on several other functions (and is part of one itself) so it made more sense to replace the calls with literal integers and to pull the loop out of the function.
It would be much 'better' to just do (cons x y).
But to answer the question, there is nothing wrong with doing that :) (except making it a tad slower).
I think the answer here is resource utilization (following from This post)
for example in clisp:
[1]> (time
(progn
(loop
for x from 1 to 100000
for y from 1 to 100000 do
collect (cons x y))
()))
WARNING: LOOP: missing forms after DO: permitted by CLtL2, forbidden by ANSI
CL.
Real time: 0.469 sec.
Run time: 0.468 sec.
Space: 1609084 Bytes
GC: 1, GC time: 0.015 sec.
NIL
[2]> (time
(progn
(loop
for x from 1 to 100000
for y from 1 to 100000 do
collect `(,x . ,y)) ;`
()))
WARNING: LOOP: missing forms after DO: permitted by CLtL2, forbidden by ANSI
CL.
Real time: 0.969 sec.
Run time: 0.969 sec.
Space: 10409084 Bytes
GC: 15, GC time: 0.172 sec.
NIL
[3]>
dsm: there are a couple of odd things about your code here. Note that
(loop for x from 1 to 100000
for y from 1 to 100000 do
collect `(,x . ,y))
is equivalent to:
(loop for x from 1 to 100
collecting (cons x x))
which probably isn't quite what you intended. Note three things: First, the way you've written it, x and y have the same role. You probably meant to nest loops. Second, your do after the y is incorrect, as there is not lisp form following it. Thirdly, you're right that you could use the backtick approach here but it makes your code harder to read and not idiomatic for no gain, so best avoided.
Guessing at what you actually intended, you might do something like this (using loop):
(loop for x from 1 to 100 appending
(loop for y from 1 to 100 collecting (cons x y)))
If you don't like the loop macro (like Kyle), you can use another iteration construct like
(let ((list nil))
(dotimes (n 100) ;; 0 based count, you will have to add 1 to get 1 .. 100
(dotimes (m 100)
(push (cons n m) list)))
(nreverse list))
If you find yourself doing this sort of thing a lot, you should probably write a more general function for crossing lists, then pass it these lists of integers
If you really have a problem with iteration, not just loop, you can do this sort of thing recursively (but note, this isn't scheme, your implementation may not guaranteed TCO). The function "genint" shown by Kyle here is a variant of a common (but not standard) function iota. However, appending to the list is a bad idea. An equivalent implementation like this:
(defun iota (n &optional (start 0))
(let ((end (+ n start)))
(labels ((next (n)
(when (< n end)
(cons n (next (1+ n))))))
(next start))))
should be much more efficient, but still is not a tail call. Note I've set this up for the more usual 0-based, but given you an optional parameter to start at 1 or any other integer. Of course the above can be written something like:
(defun iota (n &optional (start 0))
(loop repeat n
for i from start collecting i))
Which has the advantage of not blowing the stack for large arguments. If your implementation supports tail call elimination, you can also avoid the recursion running out of place by doing something like this:
(defun iota (n &optional (start 0))
(labels ((next (i list)
(if (>= i (+ n start))
nil
(next (1+ i) (cons i list)))))
(next start nil)))
Hope that helps!
Why not just
(cons x y)
By the way, I tried to run your code in CLISP and it didn't work as expected. Since I'm not a big fan of the loop macro here's how you might accomplish the same thing recursively:
(defun genint (stop)
(if (= stop 1) '(1)
(append (genint (- stop 1)) (list stop))))
(defun genpairs (x y)
(let ((row (mapcar #'(lambda (y)
(cons x y))
(genint y))))
(if (= x 0) row
(append (genpairs (- x 1) y)
row))))
(genpairs 100 100)