I've seen this function elsewhere, and as I recall, it's got a standard name. I can't remember it though, and perusing Alexandria's list.lisp library didn't reveal any secrets to me.
(defun familiar-function (list func)
(loop for e in list
collect (if (listp e)
(familiar-function e func)
(funcall func e))))
It looks like tree-map, also called maptree:
(familiar-function '(() (3 2 3) (2) (2) (55 22 33))
#'1+)
=> (NIL (4 3 4) (3) (3) (56 23 34))
As mentioned in the comment, your approach assume trees are proper lists and do not apply the function to non-nil cdr cells, contrary to the linked functions.
Related
i would like to visit all the cons cells in a list and perform some action on them (including such things as setcar). is there an idiomatic way of doing this?
i can, i think, do something like this
(progn
(setq a (list 1 2 3 4 5 6))
(setq okay a)
(while okay
(if (eq (car okay) 3)
(setcar okay 22))
(setq okay (cdr okay))))
(where the if expression is my "application logic", say.)
but, if there's a terser way of doing this, i'd be interested in hearing about it.
If you want to mutate the cars of the list, then in recent emacsen the likely think you want is cl-mapl, which maps a function over successive tails of the list. This is essentially Common Lisp's mapl function: CL has
maplist which maps a function over tails and returns a new list of the values of the function, so (maplist (lambda (e) e) '(1 2 3)) is ((1 2 3) (2 3) (3));
mapl which is like maplist but returns the original list.
elisp (courtesy of some now-standard library) now has both cl-mapl and cl-maplist.
So:
> (let ((y (list 1 2 3 4 5 6 7)))
(cl-mapl (lambda (tail)
(rplaca tail 0))
y)
y)
(0 0 0 0 0 0 0)
or
> (let ((y (list 1 2 3 4 5 6 7)))
(cl-mapl (lambda (tail)
(rplaca tail (if (cdr tail) (cadr tail) 'fish)))
y)
y)
(2 3 4 5 6 7 fish)
(In neither of these cases do you need to make sure that y is returned: I just did it to make it clear that y is being destructively modified by this.)
(setq a (mapcar (lambda (x) (if (equal x 3) 22 x)) a))
That sets the value of variable a to the result of changing any members of a that are 3 to 22.
Choose the equality operator you want, equal, eql, or =, depending on whether you know that either all list members are numbers (use =) or you know that they are either numbers or you want to test object equality otherwise, (use eql), or you don't know what they might be (use equal).
You haven't indicated any need to do list-structure modification (setcar). It appears that all you care about is for a to be a list as I described.
To construct the transitive and reflexive closure R *.
The binary relation R = {(1,1), (1,2), (2,1), (2,2), (3,1), (3,4), (4,1), (4,2), (4,4)}
What we can do is turn the data into some graph structure, like an adjacency hash table. Then we can traverse it and back-fill the missing transitive and reflexive relationships.
TXR Lisp program:
;; association data
(defvar rel-pairs '((1 1) (1 2) (2 1) (2 2) (3 1) (3 4) (4 1) (4 2) (4 4)))
;; turn data into hash table associating each domain value
;; with its range values.
(defvar rel [group-reduce (hash) car (op cons (cadr #2) #1) rel-pairs])
(defun ensure-trans-reflex (hash)
;; ensure reflexivity: if [hash key] maps to some values,
;; each of those values should appears as keys mapping
;; back to the key.
(dohash (key values hash)
(each ((val values))
(pushnew key [hash val])))
;; ensure transivity: individually starting at each
;; key in the hash, we recursively traverse the graph,
;; and associate that key with values thus reachable.
(dohash (key values hash hash)
(let ((visited (hash)))
(labels ((transitivize (key value)
(each ((next-val [hash value]))
(when (test-set [visited next-val])
(pushnew next-val [hash key])
(transitivize key next-val)))))
(each ((val values))
(transitivize key val))))))
(prinl rel)
(ensure-trans-reflex rel)
(prinl rel)
Output:
$ txr rel.tl
#H(() (1 (2 1)) (2 (2 1)) (3 (4 1)) (4 (4 2 1)))
#H(() (1 (4 3 2 1)) (2 (3 4 2 1)) (3 (2 3 4 1)) (4 (3 4 2 1)))
Basically, the example data ends up associating every key with every key including itself.
Here is an implementation in Common Lisp which exhibits a problem with a naïve approach to this sort of question.
First of all some definitions.
The kernel of the relation is a map with entries which look like (x . y). R(a, b) if there is an entry in the kernel like (a . b). I am not sure if 'kernel' is the correct mathematical term (I'm pretty sure it's not), but it's what I'm going to use.
The relation R is reflexive if R(a, a) for any a which occurs either in the domain or the range of the relation.
The transitive closure of R, R* is the relation such that R*(a, b if R(a, b) or (R(a, c) and R*(c, b)).
So I'm going to implement the kernel of the map just as a list, and I will explicitly use car, cdr, and cons to extract the parts of entries in the kernel. This is grotty old-fashioned Lisp, but in this case it's pretty much fine, since the natural objects in this part of the language (conses) map very nicely onto the objects in the problem. Note also that I have not tried to use any fancy data structures at all: everything is just walking down lists. This would make the thing slow if the kernel was very large. But it's not very large.
Here is the kernel you are given:
(defparameter *kernel*
'((1 . 1)
(1 . 2)
(2 . 1)
(2 . 2)
(3 . 1)
(3 . 4)
(4 . 1)
(4 . 2)
(4 . 4)))
This kernel is not reflexive: (3 . 3) is missing for instance. Here is a function which, given a kernel, returns a reflexive version of it. This function has very poor complexity, but the kernel is small and the function gets called once.
(defun reflexifize-kernel (kernel)
;; given the kernel of a map, return a reflexive version of it
;; This has pretty grotty complexity but it gets called only once
(loop for element in (loop with d/r = '()
for e in kernel
do (pushnew (car e) d/r)
do (pushnew (cdr e) d/r)
finally (return d/r))
for ik = (cons element element)
unless (member ik kernel :test #'equal)
collect ik into identities
finally (return (append kernel identities))))
And we can check this:
> (reflexifize-kernel *kernel*)
((1 . 1)
(1 . 2)
(2 . 1)
(2 . 2)
(3 . 1)
(3 . 4)
(4 . 1)
(4 . 2)
(4 . 4)
(3 . 3))
You can see it's added the appropriate entry at the end (and it would have added more entries if it needed to).
Now I'll write a function which, given the left-hand-side of a mapping and a kernel returns two things:
the first match for this left-hand-side in the kernel, or nil if there is none;
the remainder of the kernel after this match, or () if there is one (note that nil and () are the same in Common Lisp, but they might not be in other Lisps).
The nice thing here is that we can just use the remainder of the kernel to look for more matches, and this function works really nicely with the implementation of the kernel above: this is a case where Lisp's data structures really work well for us.
(defun next-match (lhs kernel)
;; return the next match (as (lhs . rhs)) for lhs in kernel, and the
;; remainder of the kernel, or nil and () if there is no match
(let ((found (member lhs kernel :key #'car)))
(if found
(values (first found) (rest found))
(values nil '()))))
So, now we can write a function, Rp which is true if R(a, b) is true:
(defun Rp (lhs rhs kernel)
;; is R(lhs, rhs) true
(multiple-value-bind (entry remaining-kernel) (next-match lhs kernel)
(cond ((null entry)
nil)
((eql (cdr entry) rhs)
t)
(t (Rp lhs rhs remaining-kernel)))))
This is called Rp because it's a predicate (ending in p in the usual Lisp convention), and it tells us if two elements satisfy R. And of course since CL is case-insensitive by default, this is the same function as rp.
And this function works fine:
> (rp 1 1 (reflexifize-kernel *kernel*))
t
> (rp 1 3 (reflexifize-kernel *kernel*))
nil
And now we can write R*p: it's clearer, I think and certainly more efficient to write a 'unified' version of R*p which does not rely on Rp, but is very similar code with it: it's really just got a final step which searches for the transitive closure.
(defun R*p (lhs rhs kernel)
;; is lhs related to rhs in kernel? (See note below!)
(multiple-value-bind (entry remaining-kernel) (next-match lhs kernel)
(if (null entry)
nil
(let ((match-rhs (cdr entry)))
(if (eql rhs match-rhs)
t
(or (R*p lhs rhs remaining-kernel)
(R*p match-rhs rhs kernel)))))))
OK, so this looks obviously correct, right?
first we look for a match for lhs;
if there's a match, and its rhs is rhs then we're done;
if there isn't then
first search for more matches in the kernel and check them
if that fails look for matches for the rhs we found whose rhs is rhs.
And this is just transparently the definition of the transitive closure, right? So if we feed it a reflexive kernel (which we can create now), it will work.
Well, no, it won't work. It won't work because there are loops in the kernel you've been given. Let's say we want to call (R*p 1 3 (reflexivize-kernel *kernel*)). It's obvious from the kernel that this should be false.
But in fact the function fails to terminate. It fails to terminate because it finds there's an entry for R(1, 2) and so it starts looking for R*(2, 3): it then finds R(2, 1), starts looking for R*(1, 3) ... oops.
(Note that the implementation above does depth-first search. Breadth-first search doesn't help: it will help find a mapping when there is one but when there isn't it will just loop in the same way.)
The way to deal with this is to use what's called an occurs check: when searching we keep track of the things we have already looked at up the search tree. If we find we're looking at a lhs which we have already looked at we fail immediately, as this is a loop. Here is an implementation of a version of R*p which does that, using a local function so we don't need to provide the so-far list in the interface, whichh would be annoying.
(defun R*p (lhs rhs kernel)
;; is lhs related to rhs in kernel, with an occurs check.
(labels ((R*p-loop (lhs rhs kernel so-far)
(if (member lhs so-far)
;; we've looped, give up
nil
(multiple-value-bind (entry remaining-kernel)
(next-match lhs kernel)
(if (null entry)
nil
(let ((match-rhs (cdr entry)))
(if (eql rhs match-rhs)
t
(or (R*p-loop lhs rhs remaining-kernel so-far)
(R*p-loop match-rhs rhs kernel
(cons lhs so-far))))))))))
(R*p-loop lhs rhs kernel '())))
And this version works:
> (R*p 1 3 (reflexifize-kernel *kernel*))
nil
> (R*p 1 1 (reflexifize-kernel *kernel*))
t
> (R*p 1 2 (reflexifize-kernel *kernel*))
t
> (R*p 2 1 (reflexifize-kernel *kernel*))
t
> (R*p 2 3 (reflexifize-kernel *kernel*))
nil
This question already has answers here:
Why does this function return a different value every time?
(4 answers)
Unexpected persistence of data [duplicate]
(1 answer)
Closed 7 years ago.
First of all, let me say I'm a beginner in Lisp. To be honest I have been a beginner for some time now, but there are still many things I don't know well.
While I was writing this question, I came up with a strange bug in my code.
Here is a function that will return the list (0 1 ... n) with the list e appended. It uses rplacd along the way to keep track of the last element, to avoid a final call to last.
For example, (foo 4 '(x)) returns (0 1 2 3 4 x).
The "head" is stored in a, which is not simply nil, because there is only one nil, and never a copy of it (if I understand correctly), hence I can't simply append to nil.
(defun foo (n e)
(let* ((a (list nil)) (tail a))
(loop for i to n
do (rplacd tail (setf tail (list i)))
finally (rplacd tail (setf tail e))
(return (cdr a)))))
(defun bar (n e)
(let* ((a '(nil)) (tail a))
(loop for i to n
do (rplacd tail (setf tail (list i)))
finally (rplacd tail (setf tail e))
(return (cdr a)))))
The only difference between these functions is the (list nil) replaced by '(nil) in bar. While foo works as expected, bar always returns nil.
My initial guess is this happens because the original cdr of a is indeed nil, and the quoted list may be considered constant. However, if I do (setf x '(nil)) (rplacd x 1) I get (nil . 1) as expected, so I must be at least partially wrong.
When evaluated, '(nil) and (list nil) produce similar lists, but the former can be considered constant when present in source code. You should not perform any destructive operations on a constant quoted list in Common Lisp. See http://l1sp.org/cl/3.2.2.3 and http://l1sp.org/cl/quote. In particular, the latter says "The consequences are undefined if literal objects (including quoted objects) are destructively modified."
Quoted data is considered a constant. If you have two functions:
(defun test (&optional (arg '(0)))
(setf (car arg) (1+ (car arg)))
(car arg))
(defun test2 ()
'(0))
These are two functions both using the constant list (0) right?
The implementation may choose to not mutate constants:
(test) ; ==> Error, into the debugger we go
The implementation can cons the same list twice (the reader might do that for it)
(test2) ; ==> (0)
(test) ; ==> 1
(test) ; ==> 2
(test) ; ==> 3
(test2) ; ==> (0)
The implementation can see it's the same and hench save space:
(test2) ; ==> (0)
(test) ; ==> 1
(test) ; ==> 2
(test) ; ==> 3
(test2) ; ==> (3)
In fact. The last two behavior might happen in the same implementation dependent on the function being compiled or not.
In CLISP both functions work the same. I also see when disassembling with SBCL that the constant actually is mutated so I wonder if perhaps it has constant folded (cdr '(0)) at compile time and doesn't use the mutated list at all. It really doesn't matter since both are considered good "undefined" behavior.
The part from CLHS about this is very short
The consequences are undefined if literal objects (including quoted
objects) are destructively modified.
I am not very good in Lisp and I need to do a function which allows evaluating of infix expressions. For example: (+ 2 3) -> (infixFunc 2 + 3). I tried some variants, but none of them was successful.
One of them:
(defun calcPrefInf (a b c)
(funcall b a c))
OK, let's do it just for fun. First, let's define order of precedence for operations, since when one deals with infix notation, it's necessary.
(defvar *infix-precedence* '(* / - +))
Very good. Now imagine that we have a function to-prefix that will convert infix notation to polish prefix notation so Lisp can deal with it and calculate something after all.
Let's write simple reader-macro to wrap our calls of to-prefix, for aesthetic reasons:
(set-dispatch-macro-character
#\# #\i (lambda (stream subchar arg)
(declare (ignore sub-char arg))
(car (reduce #'to-prefix
*infix-precedence*
:initial-value (read stream t nil t)))))
Now, let's write a very simple function to-prefix that will convert infix notation to prefix notation in given list for given symbol.
(defun to-prefix (lst symb)
(let ((pos (position symb lst)))
(if pos
(let ((e (subseq lst (1- pos) (+ pos 2))))
(to-prefix (rsubseq `((,(cadr e) ,(car e) ,(caddr e)))
e
lst)
symb))
lst)))
Good, good. Function rsubseq may be defined as:
(defun rsubseq (new old where &key key (test #'eql))
(labels ((r-list (rest)
(let ((it (search old rest :key key :test test)))
(if it
(append (remove-if (constantly t)
rest
:start it)
new
(r-list (nthcdr (+ it (length old))
rest)))
rest))))
(r-list where)))
Now it's time to try it!
CL-USER> #i(2 + 3 * 5)
17
CL-USER> #i(15 * 3 / 5 + 10)
19
CL-USER> #i(2 * 4 + 7 / 3)
31/3
CL-USER> #i(#i(15 + 2) * #i(1 + 1))
34
etc.
If you want it to work for composite expressions like (2 + 3 * 5 / 2.4), it's better to convert it into proper prefix expression, then evaluate it. You can find some good example of code to do such convetion here: http://www.cs.berkeley.edu/~russell/code/logic/algorithms/infix.lisp or in Piter Norvigs "Paradigs of Artificial Intelligence Programming" book. Code examples here: http://www.norvig.com/paip/macsyma.lisp
It's reall too long, to be posted in the aswer.
A different approach for "evaluating infix expressions" would be to enable infix reading directly in the Common Lisp reader using the "readable" library, and then have users use the notation. Then implement a traditional Lisp evaluator (or just evaluate directly, if you trust the user).
Assuming you have QuickLisp enabled, use:
(ql:quickload "readable")
(readable:enable-basic-curly)
Now users can enter any infix expression as {a op b op c ...}, which readable automatically maps to "(op a b c ...)". For example, if users enter:
{2 + 3}
the reader will return (+ 2 3). Now you can use:
(eval (read))
Obviously, don't use "eval" if the user might be malicious. In that case, implement a function that evaluates the values the way you want them to.
Tutorial here:
https://sourceforge.net/p/readable/wiki/Common-lisp-tutorial/
Assuming that you're using a lisp2 dialect, you need to make sure you're looking up the function you want to use in the function namespace (by using #'f of (function f). Otherwise it's being looked up in the variable namespace and cannot be used in funcall.
So having the definition:
(defun calcPrefInf (a b c)
(funcall b a c))
You can use it as:
(calcPrefInf 2 #'+ 3)
You can try http://www.cliki.net/infix.
(nfx 1 + (- x 100)) ;it's valid!
(nfx 1 + (- x (3 * 3))) ;it's ALSO valid!
(nfx 1 + (- x 3 * 3)) ;err... this can give you unexpected behavior
I am trying define symbols a and b in following way
a + 1 1 b
2
I am trying to do this by using define-symbol-macro
(define-symbol-macro a '( )
(define-symbol-macro b ') )
but this way is not working.
What Lisp does with source code
Common Lisp is an incredibly flexible language, in part because its source code can be easily represented using the same data structures that are used in the language. The most common form of macro expansion transforms the these structures into other structures. These are the kind of macros that you can define with define-symbol-macro, define-compiler-macro, defmacro, and macrolet. Before any of those kind of macroexpansions can be performed, however, the system first needs to read the source from an input stream (typically a file, or an interactive prompt). That's the reader's responsibility. The reader also is capable of executing some special actions when it encounters certain characters, such ( and '. What you're trying to do probably needs to be happening down at the reader level, if you want to have, e.g., (read-from-string "a + 1 1 b") return the list (+ 1 1), which is what you want if you want (eval (read-from-string "a + 1 1 b")) to return 2. That said, you could also define a special custom language (like loop does) where a and b are treated specially.
Use set-macro-character, not define-symbol-macro
This isn't something that you would do using symbol-macros, but rather with macro characters. You can set macro characters using the aptly named set-macro-character. For instance, in the following, I set the macro character for % to be a function that reads a list, using read-delimited-list that should be terminated by ^. (Using the characters a and b here will prove very difficult, because you won't be able to write things like (set-macro-character ...) afterwards; it would be like writing (set-m(cro-ch(r(cter ...), which is not good.)
CL-USER> (set-macro-character #\% (lambda (stream ignore)
(declare (ignore ignore))
(read-delimited-list #\^ stream)))
T
CL-USER> % + 1 1 ^
2
The related set-syntax-from-char
There's a related function that almost does what you want here, set-syntax-from-char. You can use it to make one character behave like another. For instance, you can make % behave like (
CL-USER> (set-syntax-from-char #\% #\()
T
CL-USER> % + 1 1 )
2
However, since the macro character associated with ( isn't looking for a character that has the same syntax as ), but an actual ) character, you can't simply replace ) with ^ in the same way:
CL-USER> (set-syntax-from-char #\^ #\))
T
CL-USER> % + 1 1 ^
; Evaluation aborted on #<SB-INT:SIMPLE-READER-ERROR "unmatched close parenthesis" {1002C66031}>.
set-syntax-from-char is more useful when there's an existing character that, by itself does something that you want to imitate. For instance, if you wanted to make ! an additional quotation character:
CL-USER> (set-syntax-from-char #\! #\')
T
CL-USER> (list !a !(1 2 3))
(A (1 2 3))
or make % be a comment character, like it is in LaTeX:
CL-USER> (set-syntax-from-char #\% #\;)
T
CL-USER> (list 1 2 % 3 4
5 6)
(1 2 5 6)
But consider why you're doing this at all…
Now, even though you can do all of this, it seems like something that would be utterly surprising to anyone who ran into it. (Perhaps you're entering an obfuscated coding competition? ;)) For the reasons shown above, doing this with commonly used characters such as a and b will also make it very difficult to write any more source code. It's probably a better bet to define an entirely new readtable that does what you want, or even write a new parser. even though (Common) Lisp lets you redefine the language, there are still things that it probably makes sense to leave alone.
A symbol-macro is a symbol that stands for another form. Seems like you want to look at reader macros.
http://clhs.lisp.se/Body/f_set__1.htm
http://dorophone.blogspot.no/2008/03/common-lisp-reader-macros-simple.html
I would second Rainer's comment though, what are you trying to make?
Ok so I love your comment on the reason for this and now I know this is for 'Just because it's lisp' then I am totally on board!
Ok so you are right about lisp being great to use to make new languages because we only have to 'compile' to valid lisp code and it will run. So while we cant use the normal compiler to do the transformation of the symbols 'a and 'b to brackets we can write this ourselves.
Ok so lets get started!
(defun symbol-name-equal (a b)
(and (symbolp a) (symbolp b) (equal (symbol-name a) (symbol-name b))))
(defun find-matching-weird (start-pos open-symbol close-symbol code)
(unless (symbol-name-equal open-symbol (nth start-pos code))
(error "start-pos does not point to a weird open-symbol"))
(let ((nest-index 0))
(loop :for item :in (nthcdr start-pos code)
:for i :from start-pos :do
(cond ((symbol-name-equal item open-symbol) (incf nest-index 1))
((symbol-name-equal item close-symbol) (incf nest-index -1)))
(when (eql nest-index 0)
(return i))
:finally (return nil))))
(defun weird-forms (open-symbol close-symbol body)
(cond ((null body) nil)
((listp body)
(let ((open-pos (position open-symbol body :test #'symbol-name-equal)))
(if open-pos
(let ((close-pos (find-matching-weird open-pos open-symbol close-symbol body)))
(if close-pos
(weird-forms open-symbol close-symbol
`(,#(subseq body 0 open-pos)
(,#(subseq body (1+ open-pos) close-pos))
,#(subseq body (1+ close-pos))))
(error "unmatched weird brackets")))
(if (find close-symbol body :test #'symbol-name-equal)
(error "unmatched weird brackets")
(loop for item in body collect
(weird-forms open-symbol close-symbol item))))))
(t body)))
(defmacro with-weird-forms ((open-symbol close-symbol) &body body)
`(progn
,#(weird-forms open-symbol close-symbol body)))
So there are a few parts to this.
First we have (symbol-name-equal), this is a helper function because we are now using symbols and symbols belong to packages. symbol-name-equal gives us a way of checking if the symbols have the same name ignoring what package they reside in.
Second we have (find-matching-weird). This is a function that takes a list and and index to an opening weird bracket and returns the index to the closing weird bracket. This makes sure we get the correct bracket even with nesting
Next we have (weird-forms). This is the juicy bit and what it does is to recursively walk through the list passed as the 'body' argument and do the following:
If body is an empty list just return it
if body is a list then
find the positions of our open and close symbols.
if only one of them is found then we have unmatched brackets.
if we find both symbols then make a new list with the bit between the start and end positions inside a nested list.
we then call weird forms on this result in case there are more weird-symbol-forms inside.
there are no weird symbols then just loop over the items in the list and call weird-form on them to keep the search going.
OK so that function transforms a list. For example try:
(weird-forms 'a 'b '(1 2 3 a 4 5 b 6 7))
But we want this to be proper lisp code that executes so we need to use a simple macro.
(with-weird-forms) is a macro that takes calls the weird-forms function and puts the result into our source code to be compiled by lisp. So if we have this:
(with-weird-forms (a b)
(+ 1 2 3 a - a + 1 2 3 b 10 5 b 11 23))
Then it macroexpands into:
(PROGN (+ 1 2 3 (- (+ 1 2 3) 10 5) 11 23))
Which is totally valid lisp code, so it will run!
CL-USER> (with-weird-forms (a b)
(+ 1 2 3 a - a + 1 2 3 b 10 5 b 11 23))
31
Finally if you have settled on the 'a' and 'b' brackets you could write another little macro:
(defmacro ab-lang (&rest code)
`(with-weird-forms (a b) ,#code))
Now try this:
(ab-lang a let* a a d 1 b a e a * d 5 b b b a format t "this stupid test gives: ~a" e b b)
Cheers mate, this was great fun to write. Sorry for dismissing the problem earlier on.
This kind of coding is very important as ultimately this is a tiny compiler for our weird language where symbols can be punctuation. Compilers are awesome and no language makes it as effortless to write them as lisp does.
Peace!