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 attempting to write a program in Common Lisp that dynamically creates other lisp files. Common Lisp's print function seems very useful for this purpose. Unfortunately, the function outputs data on a single line. For example (just printing to standard output):
(print '(let ((a 1) (b 2) (c 3)) (+ a b c)))
>> (let ((a 1) (b 2) (c 3)) (+ a b c))
The generated lisp files need to be human readable and thus shouldn't minimize whitespace. It seems that the pprint function is the solution to my problem. Since pprint sets *pretty-print* to true, the function should print on multiple lines. In other words:
(pprint '(let ((a 1) (b 2) (c 3)) (+ a b c)))
>> (let ((a 1)
>> (b 2)
>> (c 3))
>> (+ a b c))
However, in Allegro CL, pprint seems to behave in an identical manner to print. Output is only on a single line. Is there a way to cause the function to print s-expressions in a "pretty" way? Are there any other globals that need to be set before the function prints correctly? Is there an alternative function/macro that I'm looking for? Thanks for the help!
The pretty printer is controlled by more than just *print-pretty*. E.g., look at the interaction with *print-right-margin* in SBCL (under SLIME):
CL-USER> (pprint '(let ((a 1) (b 2) (c 3)) (+ a b c)))
(LET ((A 1) (B 2) (C 3))
(+ A B C))
; No value
CL-USER> (let ((*print-right-margin* 10))
(pprint '(let ((a 1) (b 2) (c 3)) (+ a b c))))
(LET ((A
1)
(B
2)
(C
3))
(+ A B
C))
; No value
CL-USER> (let ((*print-right-margin* 20))
(pprint '(let ((a 1) (b 2) (c 3)) (+ a b c))))
(LET ((A 1)
(B 2)
(C 3))
(+ A B C))
; No value
You might be able to get satisfactory results just by setting that variable, but in general you'll want to have a look at 22.2 The Lisp Pretty Printer. Pretty printing functions have lots of places for optional newlines and the like, and where they get put depends on a number of things (like *print-right-margin* and *print-miser-width*). There are some examples of using the pretty printer to format Lisp source code in 22.2.2 Examples of using the Pretty Printer. There's too much to quote it all, but it shows how the following pretty printing code can produce all these outputs, depending on context:
(defun simple-pprint-defun (*standard-output* list)
(pprint-logical-block (*standard-output* list :prefix "(" :suffix ")")
(write (first list))
(write-char #\Space)
(pprint-newline :miser)
(pprint-indent :current 0)
(write (second list))
(write-char #\Space)
(pprint-newline :fill)
(write (third list))
(pprint-indent :block 1)
(write-char #\Space)
(pprint-newline :linear)
(write (fourth list))))
(DEFUN PROD (X Y)
(* X Y))
(DEFUN PROD
(X Y)
(* X Y))
(DEFUN
PROD
(X Y)
(* X Y))
;;; (DEFUN PROD
;;; (X Y)
;;; (* X Y))
In my little project I have two arrays, lets call them A and B. Their values are
#(1 2 3) and #(5 6 7). I also have two lists of symbols of identical length, lets call them C and D. They look like this: (num1 num2 num3) and (num2 num3 num4).
You could say that the symbols in lists C and D are textual labels for the values in the arrays A and B. So num1 in A is 1. num2 in A is 2. num2 in B is 5. There is no num1 in B, but there is a num3, which is 6.
My goal is to produce a function taking two arguments like so:
(defun row-join-function-factory (C D)
...body...)
I want it to return a function of two arguments:
(lambda (A B) ...body...)
such that this resulting function called with arguments A and B results in a kind of "join" that returns the new array: #(1 5 6 7)
The process taking place in this later function obtained values from the two arrays A and B such that it produces a new array whose members may be represented by (union C D). Note: I haven't actually run (union C D), as I don't actually care about the order of the symbols contained therein, but lets assume it returns (num1 num2 num3 num4). The important thing is that (num1 num2 num3 num4) corresponds as textual labels to the new array #(1 5 6 7). If num2, or any symbol, exists in both C and D, and subsequently represents values from A and B, then the value from B corresponding to that symbol is kept in the resulting array rather than the value from A.
I hope that gets the gist of the mechanical action here. Theoretically, I want row-join-function-factory to be able to do this with arrays and symbol-lists of any length/contents, but writing such a function is not beyond me, and not the question.
The thing is, I wish the returned function to be insanely efficient, which means that I'm not willing to have the function chase pointers down lists, or look up hash tables at run time. In this example, the function I require to be returned would be almost literally:
(lambda (A B)
(make-array 4
:initial-contents (list (aref A 0) (aref B 0) (aref B 1) (aref B 2))))
I do not want the array indexes calculated at run-time, or which array they are referencing. I want a compiled function that does this and this only, as fast as possible, which does as little work as possible. I do not care about the run-time work required to make such a function, only the run-time work required in applying it.
I have settled upon the use of (eval ) in row-join-function-factory to work on symbols representing the lisp code above to produce this function. I was wondering, however, if there is not some simpler method to pull off this trick that I am not thinking of, given one's general cautiousness about the use of eval...
By my reasoning, i cannot use macros by themselves, as they cannot know what all values and dimensions A, B, C, D could take at compile time, and while I can code up a function that returns a lambda which mechanically does what I want, I believe my versions will always be doing some kind of extra run-time work/close over variables/etc...compared to the hypothetical lambda function above
Thoughts, answers, recommendations and the like are welcome. Am I correct in my conclusion that this is one of those rare legitimate eval uses? Apologies ahead of time for my inability to express the problem as eloquently in english...
(or alternatively, if someone can explain where my reasoning is off, or how to dynamically produce the most efficient functions...)
From what I understand, you need to precompute the vector size and the aref args.
(defun row-join-function-factory (C D)
(flet ((add-indices (l n)
(loop for el in l and i from 0 collect (list el n i))))
(let* ((C-indices (add-indices C 0))
(D-indices (add-indices D 1))
(all-indices (append D-indices
(set-difference C-indices
D-indices
:key #'first)))
(ns (mapcar #'second all-indices))
(is (mapcar #'third all-indices))
(size (length all-indices)))
#'(lambda (A B)
(map-into (make-array size)
#'(lambda (n i)
(aref (if (zerop n) A B) i))
ns is)))))
Note that I used a number to know if either A or B should be used instead of capturing C and D, to allow them to be garbage collected.
EDIT: I advise you to profile against a generated function, and observe if the overhead of the runtime closure is higher than e.g. 5%, against a special-purpose function:
(defun row-join-function-factory (C D)
(flet ((add-indices (l n)
(loop for el in l and i from 0 collect (list el n i))))
(let* ((C-indices (add-indices C 0))
(D-indices (add-indices D 1))
(all-indices (append D-indices
(set-difference C-indices
D-indices
:key #'first)))
(ns (mapcar #'second all-indices))
(is (mapcar #'third all-indices))
(size (length all-indices))
(j 0))
(compile
nil
`(lambda (A B)
(let ((result (make-array ,size)))
,#(mapcar #'(lambda (n i)
`(setf (aref result ,(1- (incf j)))
(aref ,(if (zerop n) 'A 'B) ,i)))
ns is)
result))))))
And validate if the compilation overhead indeed pays off in your implementation.
I argue that if the runtime difference between the closure and the compiled lambda is really small, keep the closure, for:
A cleaner coding style
Depending on the implementation, it might be easier to debug
Depending on the implementation, the generated closures will share the function code (e.g. closure template function)
It won't require a runtime license that includes the compiler in some commercial implementations
I think the right approach is to have a macro which would compute the indexes at compile time:
(defmacro my-array-generator (syms-a syms-b)
(let ((table '((a 0) (b 0) (b 1) (b 2)))) ; compute this from syms-a and syms-b
`(lambda (a b)
(make-array ,(length table) :initial-contents
(list ,#(mapcar (lambda (ai) (cons 'aref ai)) table))))))
And it will produce what you want:
(macroexpand '(my-array-generator ...))
==>
#'(LAMBDA (A B)
(MAKE-ARRAY 4 :INITIAL-CONTENTS
(LIST (AREF A 0) (AREF B 0) (AREF B 1) (AREF B 2))))
So, all that is left is to write a function which will produce
((a 0) (b 0) (b 1) (b 2))
given
syms-a = (num1 num2 num3)
and
syms-b = (num2 num3 num4)
Depends on when you know the data. If all the data is known at compile time, you can use a macro (per sds's answer).
If the data is known at run-time, you should be looking at loading it into an 2D array from your existing arrays. This - using a properly optimizing compiler - should imply that a lookup is several muls, an add, and a dereference.
By the way, can you describe your project in a wee bit more detail? It sounds interesting. :-)
Given C and D you could create a closure like
(lambda (A B)
(do ((result (make-array n))
(i 0 (1+ i)))
((>= i n) result)
(setf (aref result i)
(aref (if (aref use-A i) A B)
(aref use-index i)))))
where n, use-A and use-index are precomputed values captured in the closure like
n --> 4
use-A --> #(T nil nil nil)
use-index --> #(0 0 1 2)
Checking with SBCL (speed 3) (safety 0) the execution time was basically identical to the make-array + initial-contents version, at least for this simple case.
Of course creating a closure with those precomputed data tables doesn't even require a macro.
Have you actually timed how much are you going to save (if anything) using an unrolled compiled version?
EDIT
Making an experiment with SBCL the closure generated by
(defun merger (clist1 clist2)
(let ((use1 (list))
(index (list))
(i1 0)
(i2 0))
(dolist (s1 clist1)
(if (find s1 clist2)
(progn
(push NIL use1)
(push (position s1 clist2) index))
(progn
(push T use1)
(push i1 index)))
(incf i1))
(dolist (s2 clist2)
(unless (find s2 clist1)
(push NIL use1)
(push i2 index))
(incf i2))
(let* ((n (length index))
(u1 (make-array n :initial-contents (nreverse use1)))
(ix (make-array n :initial-contents (nreverse index))))
(declare (type simple-vector ix)
(type simple-vector u1)
(type fixnum n))
(print (list u1 ix n))
(lambda (a b)
(declare (type simple-vector a)
(type simple-vector b))
(let ((result (make-array n)))
(dotimes (i n)
(setf (aref result i)
(aref (if (aref u1 i) a b)
(aref ix i))))
result)))))
runs about 13% slower than an hand-written version providing the same type declarations (2.878s instead of 2.529s for 100,000,000 calls for the (a b c d)(b d e f) case, a 6-elements output).
The inner loop for the data based closure version compiles to
; 470: L2: 4D8B540801 MOV R10, [R8+RCX+1] ; (aref u1 i)
; 475: 4C8BF7 MOV R14, RDI ; b
; 478: 4C8BEE MOV R13, RSI ; source to use (a for now)
; 47B: 4981FA17001020 CMP R10, 537919511 ; (null R10)?
; 482: 4D0F44EE CMOVEQ R13, R14 ; if true use b instead
; 486: 4D8B540901 MOV R10, [R9+RCX+1] ; (aref ix i)
; 48B: 4B8B441501 MOV RAX, [R13+R10+1] ; load (aref ?? i)
; 490: 4889440B01 MOV [RBX+RCX+1], RAX ; store (aref result i)
; 495: 4883C108 ADD RCX, 8 ; (incf i)
; 499: L3: 4839D1 CMP RCX, RDX ; done?
; 49C: 7CD2 JL L2 ; no, loop back
The conditional is not compiled to a jump but to a conditional assignment (CMOVEQ).
I see a little room for improvement (e.g. using CMOVEQ R13, RDI directly, saving an instruction and freeing a register) but I don't think this would shave off that 13%.
I want to count the number of moves of the diskc. but Instead As a result I get something else.
(setq x 0)
(defun towersOfHanoi (n from to help)
(if (> n 0)
;progn evaluates multiple forms and returns the result from the last one.*/
(progn
(towersOfHanoi (- n 1) from help to)
(format t "~d ----> ~d~%" from to)
(towersOfHanoi (- n 1) help to from)
(+ 1 x)
)
))
;(towersOfHanoi 3 'A 'B 'C)
When I run it I get
(towersOfHanoi 3 'A 'B 'C)
A ----> B
A ----> C
B ----> C
A ----> B
C ----> A
C ----> B
A ----> B
1
why it is one instead of 7, I guess with every recursive call is resetting the value of x to 0 but, how can I get the number of moves of the disks. Thanks.
In lisp if takes at most three arguments; the condition, the form to evaluate when the condition is true, and the form to evaluate if it is false.
Se http://www.lispworks.com/documentation/HyperSpec/Body/s_if.htm for details.
In order to evaluate more than one form in a branch, you can use progn that evaluates multiple forms and returns the result from the last one.
Also, princ expects just one argument to be printed. In order to print several things at once, you may use format
In your case (remark also the placement of the parentheses):
(defun towersOfHanoi (n from to help)
(if (> n 0)
(progn
(towersOfHanoi (1- n) from to help)
(format t "~d ----> ~d~%" from to)
(towersOfHanoi (1- n) help to from))))
Having no false branch, you may also use when that can evaluate more than one form:
(defun towersOfHanoi (n from to help)
(when (> n 0)
(towersOfHanoi (1- n) from to help)
(format t "~d ----> ~d~%" from to)
(towersOfHanoi (1- n) help to from)))
In order to count the moves, you can use a local counting variable (introduced with let), and an inner working function (introduced with labels) that updates this variable:
(defun towers-of-hanoi (n &optional (from 1) (to 2) (help 3))
(let ((counter 0)) ; local variable
(labels ((towers-of-hanoi-core (n from to help) ; local function
(when (> n 0)
(towers-of-hanoi-core (1- n) from to help)
(incf counter)
(format t "~d ----> ~d~%" from to)
(towers-of-hanoi-core (1- n) help to from))))
(towers-of-hanoi-core n from to help)) ; leave work to inner function
(format t "Moves: ~d ~%" counter)))
Here, from, to, and help is made optional as well, defaulting to 1, 2, and 3.
Again: The details are found in the Hyperspec: http://www.lispworks.com/documentation/HyperSpec/Front/
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)))