On this line ((pointerp (first args)) (mem-aref (%vector-float-to-c-array (first args)) :float (second args))) in the below code the (second args) compiles with the warning This is not a number NIL. The function works but how do I get rid of this warning in an implimentation independent way using just Lisp. The solution would need to be really fast. The code took a long time to get to right and runs great so I can't really change the operation of it. the functions you don't recognize don't really matter as far getting warning to go away...Thank you in advance for any help.
(defun vector-float (&rest args)
(cond ((eq (first args) nil) (return-from vector-float (%vector-float)))
((listp (first args))
(c-arr-to-vector-float (first args)))
((symbolp (cadr args)) (%vector-float-size (first args)))
((pointerp (first args)) (mem-aref (%vector-float-to-c-array (first args)) :float (second args)))
(t nil)))
If (second args) is NIL then either args has no second or its second is NIL. However, the third argument to mem-aref must be a number since it is an index. Therein lies the problem.
If in your program (second args) is allowed to be NIL (or to not exist), then you'll have to test for that possibility and avoid passing NIL to mem-aref (maybe by leaving out that optional argument). If (second args) is not allowed to be NIL, then the bug is somewhere else in your program.
E.g. (untested),
(defun vector-float (&rest args)
(cond
((null (first args))
(return-from vector-float (%vector-float)))
((listp (first args))
(c-arr-to-vector-float (first args)))
((symbolp (second args))
(%vector-float-size (first args)))
((pointerp (first args))
(if (null (second args))
(mem-aref (%vector-float-to-c-array (first args)) :float)
(mem-aref (%vector-float-to-c-array (first args)) :float (second args))))
(t nil)))
Related
I want to get a function argument value, using an argument name.
The following code don't works, because symbol-value working only with global variables:
(defun test1 (&key v1)
(format t "V1: ~A~%" (symbol-value (intern "V1"))))
Is there a portable way to do this in Common Lisp?
You can use a custom environment to map strings to functions:
(use-package :alexandria)
(defvar *env* nil)
(defun resolve (name &optional (env *env*))
(if-let (entry (assoc name env :test #'string=))
(cdr entry)
(error "~s not found in ~a" name env)))
(defmacro bind (bindings env &body body)
(assert (symbolp env))
(let ((env (or env '*env*)))
(loop
for (n v) in bindings
collect `(cons ,n ,v) into fresh-list
finally
(return
`(let ((,env (list* ,#fresh-list ,env)))
,#body)))))
(defmacro call (name &rest args)
`(funcall (resolve ,name) ,#args))
For example:
(bind (("a" (lambda (u) (+ 3 u)))
("b" (lambda (v) (* 5 v))))
nil
(call "a" (call "b" 10)))
Here is another version of an explicit named-binding hack. Note this isn't well (or at all) tested, and also note the performance is not going to be great.
(defun named-binding (n)
;; Get a binding by its name: this is an error outside
;; WITH-NAMED-BINDINGS
(declare (ignore n))
(error "out of scope"))
(defun (setf named-binding) (val n)
;; Set a binding by its name: this is an error outside
;; WITH-NAMED-BINDINGS
(declare (ignore val n))
(error "out of scope"))
(defmacro with-named-bindings ((&rest bindings) &body decls/forms)
;; establish a bunch of bindings (as LET) but allow access to them
;; by name
(let ((varnames (mapcar (lambda (b)
(cond
((symbolp b) b)
((and (consp b)
(= (length b) 2)
(symbolp (car b)))
(car b))
(t (error "bad binding ~S" b))))
bindings))
(decls (loop for df in decls/forms
while (and (consp df) (eql (car df) 'declare))
collect df))
(forms (loop for dft on decls/forms
for df = (first dft)
while (and (consp df) (eql (car df) 'declare))
finally (return dft)))
(btabn (make-symbol "BTAB")))
`(let (,#bindings)
,#decls
(let ((,btabn (list
,#(mapcar (lambda (v)
`(cons ',v (lambda (&optional (val nil valp))
(if valp
(setf ,v val)
,v))))
varnames))))
(flet ((named-binding (name)
(let ((found (assoc name ,btabn)))
(unless found
(error "no binding ~S" name))
(funcall (cdr found))))
((setf named-binding) (val name)
(let ((found (assoc name ,btabn)))
(unless found
(error "no binding ~S" name))
(funcall (cdr found) val))))
(declare (inline named-binding (setf named-binding)))
,#forms)))))
And now:
> (with-named-bindings ((x 1))
(setf (named-binding 'x) 2)
(named-binding 'x))
2
Even better:
(defun amusing (x y)
(with-named-bindings ((x x) (y y))
(values #'named-binding #'(setf named-binding))))
(multiple-value-bind (reader writer) (amusing 1 2)
(funcall writer 2 'x)
(funcall reader 'x))
will work.
I have developed code to check through input to see if it is a palindrome or not but I am having difficulty figuring out how to print the output. I want the output to return "t" if the input is a palindrome and "nil" if not. Also a challenge that I wanted to give myself was to not use the reverse function so thats why my code is not as simple as it could be. Thanks in advance.
(defun palindromep(l)
(cond ((null l) nil (write nil))
(t (append (list (car l)) (palindromep (cdr l)) (list (car l) )))))
(palindromep '(a b b a))
(terpri)
(palindromep '(a b c b a))
(terpri)
(palindromep '(a b c))
(terpri)
(palindromep '(a (d e) (d e) a))
(terpri)
(palindromep '(a (d e) (e d) a))
Firstly, an empty list is a palindrome! If we reverse it, we get the same empty list.
Secondly, Lisp functions don't print their result values; they return these values.
In an interactive session, it is the listener which prints the resulting value(s) that emerge from the expression being evaluated. That expression itself doesn't have to print anything.
Therefore, we begin like this:
(defun palindromep (l)
(cond
((null l) t) ;; the empty list is a palindrome: yield true.
Note, by the way, that if we write this:
((null l) nil t) ;; the empty list is a palindrome: yield true.
that doesn't do anything. The extra nil expression is evaluated, producing nil, which is thrown away. The Lisp compiler will completely eliminate that.
What if the list is not a list at all, but an atom other than nil? Let's just go with that being a palindrome. A clarification of requirements is needed, though:
((atom l) t)
Now we know we are dealing with a non-empty list. If it has exactly one item, then it is a palindrome:
((null (cdr l)) t)
Now we know we are dealing with a list of two or more items. That is a palindrome if the first and last items are the same, and if the items in between them form a palindrome.
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
The whole thing:
(defun palindromep (l)
(cond
((null l) t)
((atom l) t)
((null (cdr l)) t)
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
Code golfing: in the cond construct described by ANSI CL, a clause is permitted to have just one form. If that forms yields a true value, then that value is returned. Thus we can remove the t's:
(defun palindromep (l)
(cond
((null l)) ;; t removed
((atom l)) ;; likewise
((null (cdr l))) ;; likewise
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
Documentation about the functions ldiff and last can be found here.
Further golfing: if we have this pattern (cond (A) (B) ... (t Z)) we can just replace it by (or A B ... Z):
(defun palindromep (l)
(or (null l)
(atom l)
(let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior)))))
cond is like a generalization of or that can specify an alternative result value for the each terminating true case.
To go on with code-golfing, since t or nil is expected, you can use only or and nil to express conditionals (and using short-circuitry of or and nil expressions).
Also it is good to be able to determine a :test keyword - since you want to control the crucial testing behavior.
To be able to use also inner lists, one could e.g. use equalp or even a custom comparison function.
(defun palindromep (l &key (test #'equalp))
(or (null l) (and (funcall test (car l) (car (last l)))
(palindromep (butlast (cdr l)) :test test))))
This evaluates
(palindromep '(a (d e) (d e) a))
as t but
(palindromep '(a (d e) (e d) a))
as nil.
Well, it is maybe a philosophical question, whether the latter should be t and the former nil.
To revert that behavior, we could write a custom testing function.
Like this:
(defun reverse* (l &optional (acc '()))
(cond ((null l) acc)
((atom (car l)) (reverse* (cdr l) (cons (car l) acc)))
(t (reverse* (cdr l) (cons (reverse* (car l) '()) acc)))))
(defun to-each-other-symmetric-p (a b)
(cond ((and (atom a) (atom b)) (equalp a b))
(t (equalp a (reverse* b)))))
Well, I use here some kind of a reverse*.
Then if one does:
(palindromep '(a (d e) (d e) a) :test #'to-each-other-symmetric-p) ;; NIL
;; and
(palindromep '(a (d e) (e d) a) :test #'to-each-other-symmetric-p) ;; T
Just to complete the other answers, I would like to point out that not using reverse will not only complicate your code enormously, but also make it far more inefficient. Just compare the above answers with the classic one:
(defun palindromep (l)
(equal l (reverse l)))
reverse is o(l), i.e. it takes time proportional to the length of the list l, and so does equal. So this function will run in o(l). You can't get faster than this.
I attempted a question of making a program that replaces all instances of an element A within a list L with T and unlike elements with NIL. The bet is to not use mapcar.
Here is what I did earlier. I am storing all T and NIL in a new list POS then returning POS.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Current behaviour:
The program is working nicely, except when searching for NIL itself, but that special case is not of concern here.
Few example runs of my code:-
(SRC 'g '(a g g o t g))
> (nil t t nil nil t)
When searching for NIL in a list:-
(SRC nil '(t a t nil nil))
> (nil nil nil t)
In this singular case our program ends on finding the first NIL in the list, for other searches, the program works fine. So I tried adding the ability of searching within lists of lists.
My updated code for searching within lists of lists without mapcar:
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((LISTP (CAR L))
(APPEND POS (LIST (SRC A (CAR L)))))
((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Now, the output that I expect from this code is as follows:
(SRC 'e '(a b e c (e g e) h t e))
> (nil nil t nil (t nil t) nil nil t)
Instead my code runs forever, causing stack overflow, and I could not figure out anything with callstacks or backtracking.
Unreadable code due to lack of indentation.
Your code is unreadable, because your code is not indented.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL)) (_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL) (APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Let's indent your code.
(defun SRC (A L)
(defun _SRC (A L POS)
(COND ((NOT (EQUAL (CAR L) NIL))
(_SRC A (CDR L) (APPEND POS (LIST (EQUAL A (CAR L))))))
((EQUAL (CAR L) NIL)
(APPEND POS (LIST (EQUAL A NIL))))
(T POS)))
(CDR (_SRC A L (LIST NIL))))
Style and basic mistakes
Basic mistakes or programming style problems:
defun should not be nested. defun is not for defining local functions. defun should only be used for global functions. Use flet or labels for local functions.
use first and rest instead of car and cdr
use speaking variables
use lowercase
Don't start with nested functions
I would start without nested functions.
(defun _src (element list pos)
(cond ((not (equal (first list) nil))
(_src a (rest list) (append pos (list (equal element (car list))))))
((equal (first list) nil)
(append pos (list (equal element nil))))
(t pos)))
(defun src (element list)
(cdr (_src element list (list nil))))
Simplify recursion
But then you can greatly simplify it using the usual recursive pattern:
(defun mark% (element list result)
(if (null list)
result ; empty list -> return result
(mark% element ; mark the rest of the list
(rest list)
(cons (equal element (first list)) ; equal for the first element?
result))))
(defun mark (element list)
"return a list with boolean values if element is found in the list"
(reverse (mark% element list nil))) : needs to reverse the result
Note
Generally don't program recursive functions like that, since Lisp actually already offers MAP and MAPCAR - those provide the mapping functionality in one place and it is not needed to bake the recursive mapping into each function of your own.
Preferably use higher level iteration facilities like LOOP:
CL-USER 13 > (loop for e in '(a b a b)
collect (equal 'a e))
(T NIL T NIL)
Nested lists
You can adapt the above function to nested lists by adding a case testing for the first element being a list and then doing something in that case...
(defun mark% (element list result)
(cond ((null list)
result)
((consp (first list))
(mark% element
(rest list)
(cons (mark element (first list))
result)))
(t
(mark% element
(rest list)
(cons (equal element (first list))
result)))))
Debugging
Use trace and/or step to see what your code is doing.
I am trying to find the position of an atom in the list.
Expected results:
(position-in-list 'a '(a b c d e)) gives 0
(position-in-list 'b '(a b c d e)) gives 1
(position-in-list 'Z '(a b c d e)) gives nil.
I have a function that gives the position correctly when the item is in the list:
(defun position-in-list (letter list)
(cond
((atom list) nil)
((eq (car list) letter) 0)
(t (+ 1 (position-in-list letter (cdr list))))))
The problem is that it doesn't return nil when the item is not present, as if it reaches (atom list) nil it will give this error: *** - 1+: nil is not a number as when it unstacks, it will try to add the values to nil.
Is there a way to adapt this function (keeping the same structure) so that it correctly returns nil when the item is not in the list?
Notes:
I know that there is a position function in the library, but I don't want to use it.
I know my question is similar to this one, but the problem I mention above is not addressed.
* edit *
Thanks to all of you for your answers. Although I don't have the necessary knowledge to understand all the suggestions you mentioned, it was helpful.
I have found another fix to my problem:
(defun position-in-list (letter liste)
(cond
((atom liste) nil)
((equal letter (car liste)) 0)
((position-in-list letter (cdr liste)) (+ 1 (position-in-list letter (cdr liste)))) ) )
One possible solution is to make the recursive function a local function from another function. At the end one would then return from the surrounding function - thus you would not need to return the NIL result from each recursive call.
Local recursive function returns from a function
Local recursive functions can be defined with LABELS.
(defun position-in-list (letter list)
(labels ((position-in-list-aux (letter list)
(cond
((atom list) (return-from position-in-list nil))
((eql (first list) letter) 0)
(t (+ 1 (position-in-list-aux
letter (cdr list)))))))
(position-in-list-aux letter list)))
This RETURN-FROM is possible because the function to return from is visible from the local function.
Recursive function returns to another function
It's also possible to return control to another function using CATCH and THROW:
(defun position-in-list (letter list)
(catch 'position-in-list-catch-tag
(position-in-list-aux letter list)))
(defun position-in-list-aux (letter list)
(cond
((atom list) (throw 'position-in-list-catch-tag nil))
((eql (first list) letter) 0)
(t (+ 1 (position-in-list-aux
letter (cdr list))))))
Test function EQL
Note also that the default test function by convention is EQL, not EQ. This allows also numbers and characters to be used.
You need to check the value returned by the recursive call:
(defun position-in-list (letter list)
(cond
((atom list) nil)
((eq (car list) letter) 0)
(t
(let ((found (position-in-list letter (cdr list))))
(and found
(1+ found))))))
Please note that this implementation is not tail-recursive.
In general, it's useful to provide a :test keyword parameter to pick what equality function we should use, so we do that. It's also handy to give the compiler the ability to tail-call-optimise (note, TCO is not required in Common Lisp, but most compilers will do so with the right optimisation settings, consult your compiler manual), so we use another keyword parameter for that. It also means that whatever we return from the innermost invocation is returned exactly as-is, so it does not matter if we return a number or nil.
(defun position-in-list (element list &key (test #'eql) (position 0))
(cond ((null list) nil)
((funcall test element (car list)) position)
(t (position-in-list element
(cdr list)
:test test :position (1+ position)))))
Of course, it is probably better to wrap the TCO-friendly recursion in an inner function, so we (as Rainer Joswig correctly points out) don't expose internal implementation details.
(defun position-in-list (element list &key (test #'eql)
(labels ((internal (list position)
(cond ((null list) nil)
((eql element (car list)) position)
(t (internal (cdr list) (1+ position))))))
(internals list 0)))
I am trying to find the other element in the nested list when querying the first one. Something like this. (findOther 'a '((a b) (b c) (a d)))--> b and d. I have done this so far: The problem is I only get b.
(defun findOther (elem L)
(cond (NIL (null L))
((eq elem (caar L)) (cdar L))
((findOther elem (cdr L)))))
First some comments on the original code:
(defun findOther (elem L)
(cond
;; NIL is always false, so you *never* end up using this
;; case. You probably want something like ((null l) '()),
;; NULL is still pretty common for this, but since you're
;; expecting a list, you could use the slighly more
;; descriptive ENDP.
(NIL (null L))
;; When you find an element, you immediately return its
;; counterpart, and don't collect it and continue on to
;; the rest of the list. It's also easier to read if
;; you use more descriptive names like FIRST and SECOND,
;; as in ((eq elem (first (first l))) (second (first l))).
;; It's worth noting that unless you have a specific reason
;; to use EQ, you might want to use EQL, which is the
;; default comparison in most CL functions.
((eq elem (caar L)) (cdar L))
;; Else, you continue to the rest of the list. In my
;; opinion, REST would be more decriptive than CDR here,
;; but recursing and returning the value *is* what you
;; want to do here.
((findOther elem (cdr L)))))
Taking some of those into consideration, we could do something like this:
(defun others (element list)
(cond
((endp list) '())
((eql element (first (first list)))
(list* (second (first list))
(others element (rest list))))
((others element (rest list)))))
All that said, the functions in the standard library
would make this much easier. E.g. using mapcan:
(defun others (element list)
(mapcan (lambda (sublist)
(when (eql (first sublist) element)
(rest sublist)))
list))
(others 'a '((a b) (b c) (a d)))
;=> (B D)
I am not sure if you are looking for pair of two elements or may be more elements in list as well. Just in case you have more elements and you want all of them as well and also of some of them are not really pairs,
(defun pair-of (elem lis)
(let ((temp nil))
(cond
((and (listp lis) (not (null lis)))
(mapcar
#'(lambda (x)
(cond
((and (listp x) (not (null x)) (eql elem (car x)))
(push (cdr x) temp))))
lis)))
(nreverse temp)))
USAGE:(pair-of 'a '((a b) (b c) (a d w) 1))
OUTPUT: ((B) (D W))
But in case you want them combined in one list,
(reduce #'append (pair-of 'a '((a s) (a 3 8) (2 5 1))):initial-value '())
=> (S 3 8)