i have a function that is supposed to convert a wff in a cnf, one part of that function doesnt want to work, and i managed to pinpoint the problem, here is the code
(defun skole-gay (fbf &optional (var-for nil) (var-ex nil))
(if (consp fbf)
(case (car fbf)
(forall ;nel caso di forall salvo il prossimo elemento assieme a possibile altri elementi di altri forall
(skole-gay (third fbf) (cons (second fbf) var-for) var-ex))
(exist ;nel caso di exist salvo il suo elemento
(skole-gay (third fbf) var-for (cons (second fbf) var-ex)))
((car var-ex) ;nel caso che trovo l'elemento salvato della exist faccio dei contrllo per vedere cosa devo fare
(cond
((eql (car var-for) nil) ;se sub-for e' vuoto vuol dire che non ci sn stati forall indi devo solo inserire la const
(cons (skolem-variable)
(skole-gay (cdr fbf) nil var-ex))) ;dopo la costante metter il resto della fbf
((not(eql (car var-for) nil)) ;ci sono stati forall
(cons (skolem-function var-for)
(cons (car var-for) (skole-gay (cdr fbf) nil var-ex))))))
((and or) ;se trovo and or not semplicemente li riscrivo e continuo con la ricorsione
(list (car fbf) (skole-gay (second fbf) var-for var-ex) (skole-gay (third fbf) var-for var-ex)))
((not) ;se trovo and or not semplicemente li riscrivo e continuo con la ricorsione
(list (car fbf) (skole-gay (second fbf) var-for var-ex)))
(otherwise
;; e' solo 1 proposizione, la ritorno
fbf))
fbf))
at one point im doing (case (car fbf) ; where car of fbf = ?x
and one of the cases is ((car var-ex) ; that at that point of them program is also ?x
but it doenst run that part of the program and i dont know why,
ignore the comments in the code because they are in italian
The clauses in a case form has to be available at compile time. The clauses are not evaluated and will be used exactly as they were written in the code.
In your example, the clause specifies (car var-ex) which is a list of two symbols: car and var-ex. If the value is either of these, that clause will be called. I doubt that is ever the case, which is why it seems like it was ignored.
Related
I am just now learning about macros. I find them really cool as a concept, but I still have a really hard time programming them, as this post will amply demonstrate.
I'm posting this question because I could not solve an exercise I set up for myself.
Basically, I want to define the "macro-equivalent" of the following function:
(defun fn-get-at (deeply-nested-thing address)
(if address
(if (eql (car address) 'l)
(fn-get-at (caar deeply-nested-thing) (cdr address))
(fn-get-at (cddr deeply-nested-thing) (cdr address)))
deeply-nested-thing))
As an example of how one would use this function, if I first set
(setf deeply-nested-thing
'((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))
...then I could evaluate (fn-get-at deeply-nested-thing '(l l r)) to get ((NIL) P). In this example, the address parameter is the list '(l l r), where the 'l and 'r stand for "go left" and "go right", respectively. One can think of this list as a set of directions, starting from the root node of some binary tree1.
So far, so good. Now I would like to define macro-get-at, a macro version of fn-get-at. With this macro, the expression (macro-get-at deeply-nested-thing '(l l r)) should expand to2
(cddr (caar (caar deeply-nested-thing)))
My first attempt was this:
(defmacro macro-get-at (deeply-nested-thing address)
(if address
(if (eql (car address) 'l)
`(macro-get-at (caar ,deeply-nested-thing) ,(cdr address))
`(macro-get-at (cddr ,deeply-nested-thing) ,(cdr address)))
deeply-nested-thing))
This did not meet my already extremely low expectations. I had expected that
(pprint (macroexpand-1 '(macro-get-at deeply-nested-thing '(l l r))))
...would, at worst, output something like
(MACRO-GET-AT (CAAR DEEPLY-NESTED-THING) '(L R))
Instead, I got this:
(MACRO-GET-AT (CDDR DEEPLY-NESTED-THING) ((L L R)))
To me, baffling. First, since the output has CDDR rather than CAAR, I must conclude that the (eql (car address) 'l) test in macro-get-at evaluated to nil; I don't get it: the same test behaves correctly in fn-get-at. Second, I just can't make any sense of that ((L L R)) in the output.
My second (and final) attempt was this:
(defmacro macro-get-at (deeply-nested-thing address)
(if address
(if (eql (car address) 'l)
`(macro-get-at (caar ,deeply-nested-thing) (cdr ,address))
`(macro-get-at (cddr ,deeply-nested-thing) (cdr ,address)))
deeply-nested-thing))
The results of this are marginally better, but still completely wrong. The macroexpand-1 output this time is:
(MACRO-GET-AT (CDDR DEEPLY-NESTED-THING) (CDR '(L L R)))
Again, the CDDR is wrong (though that's to be expected, since my new version does not address this problem at all). The second argument in the expansion is at least nominally correct, but if one simulates recursively expanding the resulting macro expression, one can see that the process will be an infinite loop (since the second argument of every expansion will always be non-null):
* (pprint (macroexpand-1 (macroexpand-1 (macroexpand-1 (macroexpand-1 '(macro-get-at deeply-nested-thing '(l l r)))))))
(MACRO-GET-AT (CDDR (CDDR (CDDR (CDDR DEEPLY-NESTED-THING))))
(CDR (CDR (CDR (CDR '(L L R))))))
I hope that by now I have given enough evidence of my cluelessness to elicit the flinging of a few merciful cluebricks my way.
1 Granted, in this example, it is not at all easy, at least for me, to see that the sequence "turn left, turn left, turn right" corresponds to ((NIL) P).
2 Note that the order of caar's and cddr's corresponds to the order of the reverse of the "address" '(l l r).
Your first attempt works.
(defparameter *deeply-nested-thing*
'((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))
(defmacro macro-get-at (deeply-nested-thing address)
(if address
(if (eql (car address) 'l)
`(macro-get-at (caar ,deeply-nested-thing) ,(cdr address))
`(macro-get-at (cddr ,deeply-nested-thing) ,(cdr address)))
deeply-nested-thing))
CL-USER 14 > (macroexpand '(macro-get-at *deeply-nested-thing* (l l r)))
(CDDR (CAAR (CAAR *DEEPLY-NESTED-THING*)))
T
CL-USER 12 > (macro-get-at *deeply-nested-thing* (l l r))
((NIL) P)
Macros don't evaluate their arguments, so list of directions has to be written as (l l r). In each step of recursion, car is removed:
(cdr (l l r)) => (L R)
(cdr (L R)) => (R)
(cdr (R)) => NIL
You used '(l l r)- and this happened inside macro:
(cdr (quote (l l r)) => ((L L R))
(cdr ((L L R))) => NIL
Replacing functions by macros is never a good idea in a modern Lisp (there were some uses for it in very antique Lisps). Macros transform source code to other source code: a macro compiles a language into a simpler language, it does not operate on run-time data.
So what you need to be thinking about is what language this macro will understand and what it needs to emit. Well, the language it consumes is something like:
a name for some kind of expression;
a list of the names of zero or more single-argument operations to perform on that expression, in the order given, with the value of each operation being the argument to the next.
And the language it will produce is going to be a bit of CL source which does this.
So, well, lets first write a slightly simpler thing than yours. Lets write a macro which lets you, for instance say:
(-> thing car cdr cdr)
and will turn this into (cdr (cdr (car thing)))
Note this takes any number of arguments, not an argument and an argument which must be a list of operations, because why have extra useless parens?
Note also that this is kind of like a Unix pipeline: it pipes its first argument through a number of operations
Here's a macro which does that: as with many cases where you have something with an &rest argument it's usually convenient to do most of the work with an auxiliary function:
(defmacro -> (e &body opnames)
(labels ((expand-> (otail)
(if (null otail)
e
`(,(first otail) ,(expand-> (rest otail))))))
(expand-> (reverse opnames))))
Another way to implement this which in some ways is nicer (well, I think so) is:
(defmacro -> (e &body opnames)
(do* ((otail opnames (rest otail))
(expression (if (not (null otail))
`(,(first otail) ,e)
e)
(if (not (null otail))
`(,(first otail) ,expression)
expression)))
((null otail) expression)))
So now we've got this thing, but we're stuck with operation names being function names. But that's fine, we can now turn this into something very close to your get-at macro:
(defmacro get-at (thing &body lrs)
`(-> ,thing ,#(mapcar (lambda (op)
(ecase op
(l 'caar)
(r 'cddr))) lrs)))
And now you have both get-at and a much more general tool.
Solution by a function
Though the question is about a macro, this can be solved entirely by a function:
(defun get-at (nested-thing commands)
(let ((result nested-thing)
(lookup (list (cons 'l #'caar) (cons 'r #'cddr))))
(loop for c in commands
do (setf result (funcall (cdr (assoc c lookup)) result))
finally (return result))))
This function is like an interpreter for the mini l-r-language.
Let's test:
(setf deeply-nested-thing
'((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))
(get-at deeply-nested-thing '(l l r))
;; => ((NIL) P)
Solution by a macro
As a macro, you could construct the code using cons into code:
(defmacro get-at (nested-thing commands)
(let ((atable '((l . caar) (r . cddr)))
(code (list nested-thing)))
(loop for c in commands
do (setf code (list (cons (cdr (assoc c atable)) code)))
finally (return (car code)))))
Test it:
(macroexpand-1 '(get-at deeply-nested-thing (l l r)))
;; (CDDR (CAAR (CAAR DEEPLY-NESTED-THING))) ;
;; T
(get-at deeply-nested-thing (l l r))
;; => ((NIL) P)
With the MEMBER I get the searched element and the rest of the LIST. But how did I get the elements befor the searched element is coming?
(CDR (MEMBER 'DURCH '(ZEIT MAL LAENGE DURCH MASSE MAL ZEIT))); with this I get (MASSE MAL ZEIT)
;But how did I get (ZEIT MAL LAENGE)
Sometimes these functions are so easy to write and the solution is so transparent to read that there's no point in working out which combination of standard functions will do what you want:
(defun elts-before (l elt &key (test #'eql))
(loop for e in l
until (funcall test e elt)
collect e))
The accepted answer is correct (and more efficient), but if you are after standard functions, use LDIFF (i.e. list difference):
(let ((list '(ZEIT MAL LAENGE DURCH MASSE MAL ZEIT)))
(ldiff list (MEMBER 'DURCH list)))
=> (ZEIT MAL LAENGE)
You can return both parts with a single traversal:
CL-USER> (defun split-at (item list &key (test #'eql))
(loop :for (x . rest) :on list
:until (funcall test x item)
:collect x :into head
:finally (return (values head rest))))
SPLIT-AT
CL-USER> (split-at 'durch '(a mal b durch c mal d))
(A MAL B)
(C MAL D)
Why does this work?
(define (rev l)
(cond ((null? l) l)
(else (append (rev(cdr l)) (list (car l))))))
Output:
> (rev L1)
(d c b a)
and this not?
(define (rev l)
(cond ((null? l) l)
(append (rev(cdr l)) (list (car l)))))
Output:
> (rev L1)
(a)
Isn't "else" implicit in Lisp?
In the second example the procedure append is the predicate and since it is a procedure and every value except #f is true it does the consequent (rev (cdr l))
cond has to have its terms in parentheses. There is no explicit else, thought if neither predicate matches the implementation can choose the result (undefined value).
if is a different conditional that perhaps is better suited in this case.
(define (rev l)
(if (null? l)
l
(append (rev (cdr l))
(list (car l)))))
Changing the indentation makes it easier to see what happens:
(define (rev l)
(cond
[(null? l) l]
[else (append (rev(cdr l)) (list (car l)))]))
(define (rev l)
(cond
[(null? l) l]
[append (rev(cdr l))
(list (car l))]))
Note that in the second version you have a clause
[append (rev(cdr l))
(list (car l))]))
When the cond-expression is evaluated it tries to evaluate each left hand side until it finds one that gives a non-false value. Here the left-hand side append evaluates to the append function, which is a non-false value.
The next thing that happens, is the right hand side is evaluated. Due to an implicit begin on the right hand side, this is evaluated:
(begin
(rev(cdr l))
(list (car l)))
To conclude: You accidentally wrote an expression that had correct syntax, but meant something different than you expected.
Note that the error is easier to spot, if you use square brackets around the clauses in the cond. (The square brackets [] and the standard () mean the same).
I've got a homework assignment that has stumped me! I have to create a function goo(A L) that will remove every A in L and it has to work on nested lists also.
Here's what I've got so far
(defun goo(A L)
(cond ((null L) nil) ; if list is null, return nil
(T ; else list is not null
(cond ((atom (car L))) ;if car L is an atom
((cond ((equal A (car L)) (goo A (cdr L))) ;if car L = A, call goo A cdr L
(T (cons (car L) (goo A (cdr L)))))) ;if car L != A,
(T (cons (goo A (car L)) (goo A (cdr L)))))) ;else car L is not atom, call goo on car L and call goo on cdr L
))
This function returns True no matter what I give it.
You parens are messed up. Move the last paren around (atom (car L)) to include the next cond expression. I suggest using an IDE which shows matching parens.
As for styling, if you didn't know, cond can accept multiple clauses. This way you don't need to have the t and then the cond again. You can also use 'if' if you are only testing a single predicate and making a decision based solely on that.
Note: this was originally posted as an edit to the question by the original asker in revision 2.
I tried another approach and it's working now.
(defun goo(A L)
(cond ((null L) nil)
((atom (car L)) (cond ((equal A (car L)) (goo A (cdr L)))
(T (cons (car L) (goo A (cdr L))))))
(T (cons (goo A (car L)) (goo A (cdr L))))
))
Note 2: this should conventionally be formatted like this to show the program structure:
(defun goo (a l)
(cond ((null l) nil)
((atom (car l))
(cond ((equal a (car l))
(goo a (cdr l)))
(t (cons (car l)
(goo a (cdr l))))))
(t (cons (goo a (car l))
(goo a (cdr l))))))
I think it might be easier to look at this a replacement into trees problem. It's easy to define a function that takes a tree and replaces subtrees in it that satisfy a test. There's a standard function subst-if that does that, but it replaces every matching subtree with the same thing. It will be more useful to us if we replace the element with a value computed from the subtree:
(defun %subst-if (new test tree)
"Replace subtrees of TREE that satisfy TEST with the result
of calling NEW with the subtree."
(cond
;; If tree satifies the test, return (new tree).
((funcall test tree)
(funcall new tree))
;; If tree is a cons, recurse.
((consp tree)
(cons (%subst-if new test (car tree))
(%subst-if new test (cdr tree))))
;; Otherwise, just return the leaf.
(tree)))
With this, its easy to define the kind of function we need. When an element X appears somewhere in a nested list structure, it means that there is a cons cell whose car is X. We want to replace that cons cell with its cdr, but to also recurse on the cdr of the cell. This isn't hard:
(defun replace* (x list &key (test 'eql))
"Remove occurrences of X in LIST and its sublists."
(%subst-if
(lambda (cons)
"Replace elements of the form (X . more) with
(replace* x more :test test)."
(replace* x (cdr cons) :test test))
(lambda (subtree)
"Detect subtrees of the form (X . more)."
(and (consp subtree)
(funcall test x (car subtree))))
list))
(replace* 'a '(1 a (2 a 3) a 4 a 5))
;=> (1 (2 3) 4 5)
I need to remove an element from a list which contain inner lists inside. The predefined element should be removed from every inner list too.
I have started working with the following code:
(SETQ L2 '(a b ( a 2 b) c 1 2 (D b (a s 4 2) c 1 2 a) a )) ; defined my list
; Created a function for element removing
(defun elimina (x l &optional l0)
(cond (( null l)(reverse l0))
((eq x (car l))(elimina x (cdr l) l0))
(T (elimina x (cdr l) (cons (car l) l0))))
)
(ELIMINA 'a L2)
But unfortunately it removes only elements outside the nested lists.
I have tried to create an additional function which will remove the element from the inner lists.
(defun elimina-all (x l)
(cond ((LISTP (CAR L))(reverse l)(elimina x (car l)))
(T (elimina-all x (CDR L)))
)
)
but still unsuccessfully.
Can you please help me to work it out?
Thank you in advance.
First of all, I'd suggest you read this book, at least, this page, it explains (and also gives very good examples!) of how to traverse a tree, but most importantly, of how to combine functions to leverage more complex tasks from more simple tasks.
;; Note that this function is very similar to the built-in
;; `remove-if' function. Normally, you won't write this yourself
(defun remove-if-tree (tree predicate)
(cond
((null tree) nil)
((funcall predicate (car tree))
(remove-if-tree (cdr tree) predicate))
((listp (car tree))
(cons (remove-if-tree (car tree) predicate)
(remove-if-tree (cdr tree) predicate)))
(t (cons (car tree)
(remove-if-tree (cdr tree) predicate)))))
;; Note that the case of the symbol names doesn't matter
;; with the default settings of the reader table. I.e. `D' and `d'
;; are the same symbol, both uppercase.
;; Either use \ (backslash) or || (pipes
;; around the symbol name to preserve the case. Eg. \d is the
;; lowercase `d'. Similarly, |d| is a lowercase `d'.
(format t "result: ~s~&"
(remove-if-tree
'(a b (a 2 b) c 1 2 (D b (a s 4 2) c 1 2 a) a)
#'(lambda (x) (or (equal 1 x) (equal x 'a)))))
Here's a short example of one way to approaching the problem. Read the comments.
Maybe like this:
(defun elimina (x l &optional l0)
(cond ((null l) (reverse l0))
((eq x (car l)) (elimina x (cdr l) l0))
(T (elimina x (cdr l) (cons (if (not (atom (car l)))
(elimina x (car l))
(car l))
l0)))))
I was looking for the same answer as you and, unfortunately, I couldn't completely understand the answers above so I just worked on it and finally I got a really simple function in Lisp that does exactly what you want.
(defun remove (a l)
(cond
((null l) ())
((listp (car l))(cons (remove a (car l))(remove a (cdr l))))
((eq (car l) a) (remove a (cdr l)))
(t (cons (car l) (remove a (cdr l))))
)
)
The function begins with two simple cases, which are: 'list is null' and 'first element is a list'. Following this you will "magically" get the car of the list and the cdr of the list without the given element. To fixed that up to be the answer for the whole list you just have to put them together using cons.