Simultaneously assign same value to multiple places? - common-lisp

I would like to assign to two (or more) variables, e.g., x and y (z etc.) the same value read from user input. Now I have (setf x (read)), but I'd like to also have the input value put in y as well. Do I have to then do (setf y x)? Is there something more elegant?
(setf x (read) y (read))
only makes the user input twice, so that's no good.

There's nothing quite like that built into the language, though you can easily implement it. E.g., here's a macro setf* (not the best name, though), that assigns a single value to a bunch of places (which don't have to be variables):
(defmacro setf* ((&rest places) value)
(let ((temp (gensym)))
`(let ((,temp ,value))
(setf ,#(mapcan (lambda (place)
(list place temp))
places)))))
CL-USER> (macroexpand-1 '(setf* (a (car list) (aref array 2 3)) d))
(LET ((#:G1043 D))
(SETF A #:G1043
(CAR LIST) #:G1043
(AREF ARRAY 2 3) #:G1043))
You'd do
(setf* (x y) (read))
Of course, for a simple one off, you might as well just do this by hand, as either (as sds suggested):
(setf x (read)
y x)
or
(let ((temp (read)))
(setf x temp
y temp))

you can assign x to y in the same form:
(setf x (read) y x)

Related

How to write a function that calls a function with its arguments?

I'm trying to write functions that wrap another function but I'm not sure how to pass parameters correctly while maintaining a sensible lambda-list.
E.g. if I have a function
(defun f (x &key y z) ...)
I want to write something like
(defun g (x &key y z)
(h (f x :y y :z z)))
This isn't satisfactory because I want to call f from g with the exact arguments g was called with, which doesn't happen (e.g. I don't want to supply keyword arguments to f that weren't supplied to g by the caller).
I initially wrote something like:
(defun g (&rest f-args)
(apply #'f f-args))
And that's the effect I want, however the lambda list for g is now very cryptic and I keep having to navigate to f to see what the arguments should be.
I did come up with a solution (and it's mostly satisfactory so I posted it as an answer), but I need to be explicit with every single key argument, and with large lambda-lists (e.g. if I want to wrap drakma:http-request), it will be a pain. I hope that maybe there's a better way.
You could write a macro that defines a function by copying the lambda list from another function. The problem is that there isn't a standard way to get the lambda list, but for SBCL you can use SB-INTROSPECT:FUNCTION-LAMBDA-LIST (although that won't work with (declaim (optimize (debug 0)))). You could try reading Swank source code to see how it gets the lambda lists for various implementations.
(defmacro define-wrapper (name lambda-source &body body)
`(defun ,name ,(sb-introspect:function-lambda-list lambda-source)
,#body))
(defun f (x &key (y 3) (z 4))
(+ x y z))
(define-wrapper g f
(* 2 (f x :y y :z z)))
(f 2) ;=> 9
(g 2) ;=> 18
That's a bit ugly since the code doesn't show the variable definitions. A bit more complex solution might be to do something like
;; Requires Alexandria.
(defmacro define-wrapper (name lambda-source &body body)
(let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
(multiple-value-bind (required optional rest keywords)
(alexandria:parse-ordinary-lambda-list lambda-list)
(declare (ignore rest))
`(defun ,name ,lambda-list
,#(sublis `((_ . (,lambda-source ,#(loop for r in required collect r)
,#(loop for (name init suppliedp)
in optional collect name)
,#(loop for ((k-name name) init suppliedp)
in keywords
append (list k-name name)))))
body)))))
(defun f (x &key (y 3) (z 4))
(+ x y z))
(define-wrapper g f
(* 2 _))
Where the _ in the wrapper is replaced with a call to the function F with the given arguments. You do still have to remember that the argument variables exist and can conflict with ones you define yourself.
That passes all arguments to the function regardless of whether they were given. That might mess up a function that behaves differently depending on whether an argument was supplied or not. You could avoid that by using APPLY, but it's a bit more complex.
(defmacro define-wrapper (name lambda-source &body body)
(let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
(alexandria:with-gensyms (deparsed-arglist-sym
key-sym val-sym suppliedp-sym)
(multiple-value-bind (required optional rest keywords)
(alexandria:parse-ordinary-lambda-list lambda-list)
(declare (ignore rest))
(multiple-value-bind (body declarations docstring)
(alexandria:parse-body body :documentation t)
`(defun ,name ,lambda-list
,#(when docstring (list docstring))
,#declarations
(let ((,deparsed-arglist-sym
(nconc (loop for ,val-sym in (list ,#required) collect ,val-sym)
(loop for (,val-sym . ,suppliedp-sym)
in (list ,#(loop for (name init suppliedp)
in optional
collect (list 'cons name
(or suppliedp t))))
when ,suppliedp-sym collect ,val-sym)
(loop for (,key-sym ,val-sym ,suppliedp-sym)
in (list ,#(loop for ((kname name) init suppliedp)
in keywords
collect (list 'list kname name
(or suppliedp t))))
when ,suppliedp-sym append (list ,key-sym ,val-sym)))))
,#(sublis `((_ . (apply #',lambda-source ,deparsed-arglist-sym)))
body))))))))
(define-wrapper bar drakma:http-request
"Return the length of a response to http-request."
;; HTTP-REQUEST has some &aux variables.
(declare (ignore drakma::unparsed-uri
drakma::args))
(length _))
(bar "http://www.google.com") ;=> 11400 (14 bits, #x2C88)
I came up with this:
(defun g (x &rest f-keys &key y z)
(declare (ignorable y z))
(apply #'f x f-keys))
It's great for small lambda-lists but I hope I could do better.
I also can't see default values unless I type them explicitly.

Scheme Make list of all pair permutations of elements in two equal length lists

I am trying to combine two lists of x coordinates and y coordinates into pairs in scheme, and I am close, but can't get a list of pairs returned.
The following can match up all the pairs using nested loops, but I'm not sure the best way to out put them, right now I am just displaying them to console.
(define X (list 1 2 3 4 5))
(define Y (list 6 7 8 9 10))
(define (map2d X Y)
(do ((a 0 (+ a 1))) ; Count a upwards from 0
((= a (length X) ) ) ; Stop when a = length of list
(do ((b 0 (+ b 1))) ; Count b upwards from 0
((= b (length Y) ) ) ; Stop when b = length of second list
(display (cons (list-ref X a) (list-ref Y b))) (newline)
))
)
(map2d X Y)
I am looking to have this function output
((1 . 6) (1 . 7) (1 . 8) ... (2 . 6) (2 . 7) ... (5 . 10))
I will then use map to feed this list into another function that takes pairs.
Bonus points if you can help me make this more recursive (do isn't 'pure' functional, right?), this is my first time using functional programming and the recursion has not been easy to grasp. Thanks!
The solutions of Óscar López are correct and elegant, and address you to the “right” way of programming in a functional language. However, since you are starting to study recursion, I will propose a simple recursive solution, without high-level functions:
(define (prepend-to-all value y)
(if (null? y)
'()
(cons (cons value (car y)) (prepend-to-all value (cdr y)))))
(define (map2d x y)
(if (null? x)
'()
(append (prepend-to-all (car x) y) (map2d (cdr x) y))))
The function map2d recurs on the first list: if it is empty, then the cartesian product will be empty; otherwise, it will collect all the pairs obtained by prepending the first element of x to all the elements of y, with all the pairs obtained by applying itself to the rest of x and all the elements of y.
The function prepend-to-all, will produce all the pairs built from a single value, value and all the elements of the list y. It recurs on the second parameter, the list. When y is empty the result is the empty list of pairs, otherwise, it builds a pair with value and the first element of y, and “conses” it on the result of prepending value to all the remaining elements of y.
When you will master the recursion, you can pass to the next step, by learning tail-recursion, in which the call to the function is not contained in some other “building” form, but is the first one of the recursive call. Such form has the advantage that the compiler can transform it into a (much) more efficient iterative program. Here is an example of this technique applied to your problem:
(define (map2d x y)
(define (prepend-to-all value y pairs)
(if (null? y)
pairs
(prepend-to-all value (cdr y) (cons (cons value (car y)) pairs))))
(define (cross-product x y all-pairs)
(if (null? x)
(reverse all-pairs)
(cross-product (cdr x) y (prepend-to-all (car x) y all-pairs))))
(cross-product x y '()))
The key idea is to define an helper function with a new parameter that “accumulates” the result while it is built. This “accumulator”, which is initialized with () in the call of the helper function, will be returned as result in the terminal case of the recursion. In this case the situation is more complex since there are two functions, but you can study the new version of prepend-to-all to see how this works. Note that, to return all the pairs in the natural order, at the end of the cross-product function the result is reversed. If you do not need this order, you can omit the reverse to make the function more efficient.
Using do isn't very idiomatic. You can try nesting maps instead, this is more in the spirit of Scheme - using built-in higher-order procedures is the way to go!
; this is required to flatten the list
(define (flatmap proc seq)
(fold-right append '() (map proc seq)))
(define (map2d X Y)
(flatmap
(lambda (i)
(map (lambda (j)
(cons i j))
Y))
X))
It's a shame you're not using Racket, this would have been nicer:
(define (map2d X Y)
(for*/list ([i X] [j Y])
(cons i j)))

What's wrong with my Lisp code?

I have some lisp code that I have to write multiple different ways. I've tried two different ways and I'm unsure of why they don't work. The function has to take a list and return only integers in that list. The first one has to take a map function and the second one has to use loop. This is in Clisp.
Here is my code.
(defun posint1 (l)
(mapcan #'(lambda (x)
(and (integerp x)
(list l)))))
and
(defun posint1 (l)
(loop for x in (list l)
when (integerp x)
collect x)
(format t "~A " x))))
mapcan requires at least one list argument and you have supplied none in your first function (I can't use names since you call both the same)
The second function tried to format a variable, x, that does not exist in that scope. In loop x are the one element in (list l) which probably should just be l since making a one number list doesn't really need iteration. Perhaps you wanted something like:
(defun print-integers (list)
(loop :for x :in list
:when (integerp x)
:collect x :into result
:finally (format t "~A " result)))
;; or using the result as argument
(defun print-integers (list)
(format t
"~A "
(loop :for x :in list
:when (integerp x)
:collect x)))
(print-integers '(-1 0.5 1/3 +inf.0 9)) ; ==> NIL (prints (-1 9)
Also notice that integerp works for whole numbers, also negative ones. The name hinted that you might want to use (and (integerp x) (>= x 0)) instead.

Recursive lisp-function to solve N-Queen

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).

Scheme - How to apply a recursive function to a list of variable length

Say I have a function recurse that takes three parameters x,y,z. y and z remain fixed, but x is iterative. I know how to generate a list of x values. How can I write code so that recurse is applied to the list of xs, but y and z remain the same?
I know map works like this but I don't know how to implement it considering it only works on lists of the same size. I do not know what the length of x will be. What I'm trying to do conceptually is call recurse on a list (x1, x2,...,xn) as such:
recurse x1 y z
recurse x2 y z
recurse xn y z
Just pass the parameters y and z unchanged:
(define (recurse x y z)
(unless (null? x)
;; … use x, y, z
;; then:
(recurse (cdr x) y z)))
Alternately you can define a helper function; made easy with 'named let`:
(define (recurse x y z)
(let recursing ((x x))
;; … use x, y, z
;; then:
(recursing (cdr x))))
An example:
(define (all-in-range? values min max)
(or (null? values)
(and (< min (car values) max)
(all-in-range? (cdr values) min max))))
You can use map:
(define (between x y z) (<= x y z))
(define (between-list xlist y z)
(map (lambda (e) (between e y z)) xlist))
> (between-list '(1 20 3 100 99 2) 5 15)
'(#t #f #t #f #f #t)
As an alternative to the lambda function used with map, in Racket you can use curryr. Also, if you just do it for side-effects, you can use for-each instead of map:
(define (between x y z) (display (<= x y z)))
(define (between-list xlist y z)
(for-each (curryr between y z) xlist))
> (between-list '(1 20 3 100 99 2) 5 15)
#t#f#t#f#f#t
You have a list '(x1 x2 … xn) and you want to apply a function recurse to each element xn as well as y and z. You haven't said what the return value will be. I will assume there is no return value.
(for-each (lambda (x) (recurse x y z)) <your list of x1, … xn>)
The lambda captures the values for y and z, takes the provided x argument and applies your recurse procedure to all three.
You either pass the same variable to the next recursion or you leave it out completely so that it is a free variable.
Eg. send it:
(define (make-list items value)
(if (zero? items)
'()
(cons value (make-list (- items 1) value))))
Have it as a free variable:
(define (make-list items value)
(let loop ((items items)(acc '()))
(if (zero? items)
acc
(loop (- items 1) (cons value acc)))))
For higher order procedures you also keep it as a free (closed over) variable:
(define (make-list items value)
(map (lambda (x) value) (range items))) ;; value exists in the anonymous functions scope

Resources