I am trying to use recursion in a Common Lisp project to check if a regular expression follows specific "rules". Here is precisely what I need to achieve:
I can have different types of regular expressions (RE), the basic one is just an atom (e.g. 'a), then we can have more complex expressions represented as follows (e.g '(star (seq a b)):
[re1][re2]…[rek] becomes (seq [re1] [re2] … [rek])
[re1]|[re2]…[rek] becomes (or [re1] [re2] … [rek])
[re]* becomes (star [re])
[re]+ becomes (plus [re])
The alphabet of the symbols is composed of Lisp S-exps.
I want to implement this function in COMMON LISP:
(is-regular-xp RE) returns TRUE when RE is a regular expression; false (NIL) in any other case.
This is what I have already written, it works in every case, EXCEPT when I check a RE that starts with an accepted atom, but then contains a not accepted one. For example: if you try to check (is-regexp '(seq a b)) LispWorks returns TRUE. Which is correct! But if you try (is-regexp '(seq (crazytest a b))) it returns, again TRUE, which is wrong! In this case "crazytest" doesn't exist in my grammar and the console should return NIL.
(defun is-regexp (RE)
;;Enters this check only if RE is a list
(if (listp RE)
(if (atom (car RE))
;;Verifies that the first element of the list is accepted
(cond ((eql (car RE) 'seq) T)
((eql (car RE) 'or) T)
((eql (car RE) 'star) T)
((eql (car RE) 'plus) T)))
;;Enters this check only if RE is not a list
(if (not(listp RE))
(if (atom 'RE) T)
)
)
)
The problem that I want to resolve is the recursive check of the inner regular expressions, I tried to put a recursive call to "is-regexp" using "cdr" to analyze only the rest of the list, but it still doesn't work...
Thank you in advance for your precious help!
Try this:
CL-USER> (defun is-regexp (RE)
(cond ((null RE) nil)
((atom RE) t)
((consp RE)
(and (member (car RE) '(seq or star plus))
(every #'is-regexp (cdr RE))))
(t nil)))
IS-REGEXP
CL-USER> (is-regexp 'a)
T
CL-USER> (is-regexp '(star (seq a b)))
T
CL-USER> (is-regexp '(seq (crazytest a b)))
NIL
Note that this function does not check for the length of the list of the operators as it should. This is left as exercise to you.
This sort of problem is quite a natural fit for CLOS, if you have the right mindset. Using CLOS also has the advantage that it's probably not something people can submit as homework.
This code doesn't do quite what you want (it assumes that the basic regexps are only symbols), but could be changed to do so.
(defgeneric valid-regexp-p (r)
;; Is something a valid regular expression?
(:method ((r t))
nil))
(defmethod valid-regexp-p ((r symbol))
t)
(defmethod valid-regexp-p ((r cons))
(valid-operator-regexp-p (first r) (rest r)))
(defgeneric proper-list-p (l)
(:method ((l t))
nil)
(:method ((l null))
t)
(:method ((l cons))
(proper-list-p (rest l))))
(defgeneric valid-operator-regexp-p (op body)
(:method :around (op body)
(and (proper-list-p body)
(call-next-method)
(every #'valid-regexp-p body)))
(:method (op body)
nil))
(defmethod valid-operator-regexp-p ((op (eql 'seq)) body)
t)
(defmethod valid-operator-regexp-p ((op (eql 'or)) body)
t)
(defmethod valid-operator-regexp-p ((op (eql 'star)) body)
(= (length body) 1))
(defmethod valid-operator-regexp-p ((op (eql '+)) body)
(= (length body) 1))
I don't think that, in real life, I'd write proper-list-p like that, but it's quite cool I think.
Related
I was writing a procedure that takes 2 expressions, and if there is a way for exp1 to be created through exp2 (when we replace exp2 with 'sss) using first, rest, cons, it then returns the code needed to produce exp1.
For example, this is what I would want to produce.
(find-in '(e r t) '(e t) ) => '(cons (first sss) (rest (rest sss)))
My code works for a lot of the test cases but when I ran through
(find-in '(a '(((v)) l) (f g)) '( (v g) l a))
It returns this error:
first: contract violation
expected: (and/c list? (not/c empty?))
given: 'g
The same error shows up when I try running this test case:
(find-in '(x a (x y)) '(z a (b)))
;supposed to return #f
This is my code so far:
(define find-in
(lambda (exp2 exp1)
(cond
((equal? exp2 exp1) 'sss)
((null? exp2) #f)
((not (list? exp2)) #f)
((find-in (first exp2) exp1) (repl 'sss '(first sss) (find-in (first exp2) exp1)))
((find-in (rest exp2) exp1) (repl 'sss '(rest sss) (find-in (rest exp2) exp1)))
(else (list? exp1)
(if
(and (find-in exp2 (first exp1)) (find-in exp2 (rest exp1)))
(list 'cons (find-in exp2 (first exp1)) (find-in exp2 (rest exp1)))
#f) #f))))
I am confused as to which condition I missed when I coded or if there was a logic error. What could have gone wrong?
Your last clause doesn't look right to me. When you use the special else token for your last clause, you are saying "There's nothing to test here, execute the body of this unconditionally if you've made it this far". Thus, your next expression, (list? exp1), is not a test as far as cond is concerned: it is evaluated for side effects, and the results discarded. Then the next expression is also evaluated, whether exp1 was a list or not.
If you want to make this conditional on whether exp1 is a list, you should remove the excess else at the beginning (and probably add an else clause to the end to return #f if none of your cases matched).
I have written a function in Clojure that is supposed to take a logical expression and return an equivalent expression where all not statements act directly on variables, like so:
(not (and p q r))
becomes
(or (not p) (not q) (not r))
It uses De Morgan's laws to push the nots inwards, and if a not acts directly on another not statement, they cancel out. The code looks like this:
(defn transform [expr]
(if
(list? expr)
(if
(=
'not
(first expr)
)
(if
(list? (nth expr 1))
(if
(=
'not
(first (nth expr 1))
)
(transform (first (rest (first (rest expr)))))
(if
(=
'and
(first (nth expr 1))
)
(cons
'or
(map
transform
(map
not-ify
(rest (first (rest expr)))
)
)
)
(if
(=
'or
(first (nth expr 1))
)
(cons
'and
(map
transform
(map
not-ify
(rest (first (rest expr)))
)
)
)
expr
)
)
)
expr
)
expr
)
expr
)
)
The problem lies in this part:
(map
transform
(map
not-ify
(rest (first (rest expr)))
)
)
The first map statement uses a function not-ify (excuse the pun) to basically put a not before each statement. That part works. However, the output doesn't work with the map transform, although the map transform part works by itself. Let me show you:
If I write the following in the REPL:
(def expr '(not (and q (not (or p (and q (not r)))))))
(map
not-ify
(rest (first (rest expr)))
)
I get the output ((not q) (not (not (or p (and q (not r))))))
If I then take that output and run (map transform '((not q) (not (not (or p (and q (not r))))))), I get the output ((not q) (or p (and q (not r)))). So far so good.
However if I run it all at once, like so:
(map
transform
(map
not-ify
(rest (first (rest expr)))
)
)
I get this output instead: ((not q) (not (not (or p (and q (not r)))))).
If run
(def test1
(map
not-ify
(rest (first (rest expr)))
)
)
(map transform test1)
I also get ((not q) (not (not (or p (and q (not r)))))).
However if I run
(def test2 '((not q) (not (not (or p (and q (not r)))))))
(map transform test2)
I once again get the correct result: ((not q) (or p (and q (not r)))).
My guess is that this is somehow related to the map not-ify output (test1) having the type LazySeq, while if I manually type the input (test2) it becomes a PersistentList. I've tried running (into (list)) on test1 to convert it to a PersistentList, as well as doRun and doAll, with no results. Can I somehow stop my map not-ify statement from returning a LazySeq?
The short answer is to use seq? instead of list?
Here is how I would implement it:
(defn push-not-down [expr]
(if (and (seq? expr) (seq? (second expr)))
(let [[outer-op & [[inner-op & inner-args] :as outer-args] :as expr] expr]
(if (= 'not outer-op)
(condp = inner-op
'and (cons 'or (map #(push-not-down (list 'not %)) inner-args))
'or (cons 'and (map #(push-not-down (list 'not %)) inner-args))
'not (first inner-args)
expr)
(if (#{'or 'and} outer-op)
(cons outer-op (map push-not-down outer-args))
expr)))
expr))
(deftest push-not-down-test
(testing "Not or and not and are transformed to and not and or not"
(is (= '(or (not :a) (not :b))
(push-not-down
'(not (and :a :b)))))
(is (= '(and (not :a) (not :b))
(push-not-down
'(not (or :a :b))))))
(testing "Double nots cancel"
(is (= :a
(push-not-down
'(not (not :a))))))
(testing "The rules work together in complex combinations"
(is (= '(and :a (and :b (not :c)))
(push-not-down
'(and (not (not :a)) (not (or (not :b) :c))))))
(is (= '(or (or (and (not :a))))
(push-not-down
'(or (or (and (not :a))))))))
(testing "Nested expressions that don't fit the rules are preserved"
(is (= '(not (inc 1))
(push-not-down
'(not (inc 1)))))
(is (= '(inc (or 2 1))
(push-not-down
'(inc (or 2 1)))))))
For forms and expressions, there is no significant difference between a list or a sequence. Alternatively if you did want to preserve listiness, you just need to be a bit more thorough in converting sequences to lists :)
For what it's worth, ...
First, let's define what a logical inverse becomes:
(def opposite {'and 'or, 'or 'and})
(defn inverse [expr]
(let [default (list 'not expr)]
(if (seq? expr)
(let [[op & args] expr]
(if (= op 'not)
(first args)
(cons (opposite op) (map inverse args))))
default)))
Let's test it:
(map inverse ['p '(not p) '(and a b) '(and (not a) b)])
;((not p) p (or (not a) (not b)) (or a (not b)))
It short-circuits double negatives as well as doing the DeMorgan thing.
Now we can express the transformation:
(defn transform [expr]
(if (seq? expr)
(let [[op & args] expr]
(if (= op 'not)
(inverse (first args))
(cons op (map transform args))))
expr))
For example,
(transform '(not (and p q r)))
;(or (not p) (not q) (not r))
Where it finds a not, it returns the inverse of the argument.
Otherwise, it reconstructs the expression, transforming
sub-expressions where it can, just as inverse does.
If we're not fussed about transforming sub-expressions, we can simplify to
(defn transform [expr]
(or (and (seq? expr)
(let [[op & args] expr]
(if (= op 'not) (inverse (first args)))))
expr))
I find pulling out the inverse manipulation easier to follow.
In the simple transform, I've played with and and or and
one-armed if to avoid repeating the do-nothing case that weighs
down OP's text.
How does this relate to #TimothyPratley's answer?
I shamelessly stole his observation on using seq? instead of
list?.
His throws an exception on unrecognised operations. Mine just makes
them nil.
I've factored the ands and ors into a single case.
I have been trying to transform a linear list into a set but with no avail. Everytime I run this, I get some weird compilation errors like "badly formed lambda" which points to the way I use append. Here is my code:
(defun mem(e l)
(cond
((null l) nil)
((equal e (car l)) t)
((listp (car l)) (mem e (car l)))
(t(mem e (cdr l)))
)
)
(defun st(l k)
(cond
((null l) nil)
(( mem '(car l) 'k) (st (cdr l) k))
((listp (car l)) (st (car l) k))
( t (st (cdr l) (append((car l) k)) ))
(t(mem e (cdr l)))
)
)
EDIT: frankly I just want to remove the duplicates from list l
Prefer Standard Library Functions
EDIT: frankly I just want to remove the duplicates from list l
Common Lisp has a remove-duplicates function. The documentation inclues examples:
Examples:
(remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t) => "aBcD"
(remove-duplicates '(a b c b d d e)) => (A C B D E)
(remove-duplicates '(a b c b d d e) :from-end t) => (A B C D E)
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr) => ((BAR #\%) (BAZ #\A))
(remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
:test #'char-equal :key #'cadr :from-end t) => ((FOO #\a) (BAR #\%))
Are you trying to flatten the list too?
From your code for mem, where you do:
((listp (car l)) (mem e (car l)))
it looks like you want your member function to also recurse into sublists. That's a bit questionable, even when working with sets, since sets can traditionally include other sets. E.g., {{3},{4},5} is a set containing 5, the set {3}, and the set {4}. It's not the same as the set {3,4,5}. Your st function also looks like it's trying to recurse into lists, which makes it seem like you want to flatten you lists, too. Again, that's a bit questionable, but if you want to do that, then your conversion to a set would be easier as a "flatten, then remove duplicates" process:
(defun flatten (list)
"Returns a fresh list containing the leaf elements of LIST."
(if (listp list)
(mapcan 'flatten list)
(list list)))
;; CL-USER> (flatten '(1 2 (3 4) 5 ((6))))
;; (1 2 3 4 5 6)
(defun to-set (list)
"Returns a set based on the elements of LIST. The result
is a flat list containing the leaf elements of LIST, but
with any duplicate elements removed."
(delete-duplicates (flatten list)))
;; CL-USER> (to-set '(1 3 (3 4) ((4) 5)))
;; (1 3 4 5)
Notes
I get some weird compilation errors like "badly formed lambda" which points to the way I use append.
Yes, you're trying to call append like: (append((car l) k)). That's actually not a problem for append. Remember, the syntax for a function call in Lisp is (function argument…). That means that you've got:
(append ((car l) k))
<function> <argument1>
But your argument1 is also a function call:
((car l) k )
<function> <argument1>
In Common Lisp, you can't use (car l) as a function. The only thing that can appear for a function is a symbol (e.g., car, append) or a lambda expression (e.g., (lambda (x) (+ x 1)).
You want to call (append (car l) k) instead.
First, CL does not have a set data type.
Lists, however, can be used as sets, you do not need to write any special code for that.
Second, I don't understand what your st function is supposed to do, but I bet that in the second cond clause you should not quote (car l) and k. You should use meaningful names for your functions and avoid abbreviations. As per your explanation in the comment, you should use pushnew instead.
Third, your mem function is quite weird, I am pretty sure you do not mean what you wrote: e is searched along a path in the tree l, not in the list l. As per your explanation in the comment, you should check both car and cdr:
(defun tree-member (tree element &key (test #'eql))
(if (consp tree)
(or (tree-member (car tree) element :test test)
(tree-member (cdr tree) element :test test))
(funcall test element tree)))
I want to write a recursive function that checks the list and either returns true if the list is in ascending order or NIL otherwise. If the list is empty it is still true. I am completely new to Lisp, so its still very confusing.
(defun sorted (x)
(if (null x)
T
(if (<= car x (car (cdr x)))
(sorted (cdr x))
nil)))
The recursive version:
(defun sorted (list)
(or (endp list)
(endp (cdr list))
(and (<= (first list) (second list))
(sorted (cdr list)))))
The more idiomatic loop-based predicate accepting a :test argument:
(defun sortedp (list &key (test #'<=))
(loop for (a b) on list
while b
always (funcall test a b)))
The version accepting a :key; we only call the key function once per visited element:
(defun sortedp (list &key (test #'<=) (key #'identity))
(loop for x in list
for old = nil then new
for new = (funcall key x)
for holdp = T then (funcall test old new)
always holdp))
Some tests:
(loop for k in '(()
((1))
((1) (2))
((2) (1))
((1) (2) (3))
((3) (2) (1)))
collect (sortedp k :test #'> :key #'car))
=> (T T NIL T NIL T)
This one also works with other kinds of sequences:
(defun sortedp (sequence &key (test #'<=) (key #'identity))
(reduce (lambda (old x &aux (new (funcall key x)))
(if (or (eq old t)
(funcall test old new))
new
(return-from sortedp nil)))
sequence
:initial-value t))
The above test gives:
(T 1 NIL 1 NIL 1)
... which is a correct result thanks to generalized booleans.
If you are doing your homework (seems so), then the above answers are fine. If you are just learning Lisp, and don't have constraints about recursivity, then the following might give you a glimpse about the power of Lisp:
(defun sorted (l)
(or (null l) (apply #'< l)))
The first problem with your solution is the base case You need to stop not at the end of the list, but when looking at the last to elements, as you need to elements to do the comparison. Also the parens are missing in the call to (car x)
(defun sorted (list)
(if (endp (cddr list))
(<= (car list) (cadr list))
(and (<= (car list) (cadr list))
(sorted (cdr list)))))
Bare in mind that recursive solutions are discouraged in CL
This is what I must do! I have a lot of list and I must return list without integer.
(functInt '(f 3 (v) (((7))) n ()))
-------->
(f (v) ((())) n ())
This is my code:
(defun functInt (list)
(cond ((atom list) (if (not(integerp list)) list))
((null (cdr list)) (functInt (car list)))
(T (cons (functInt (car list)) (functInt (cdr list))))))
But what I get is (F NIL V NIL N)
How can I correct my code to get the output that I want?
One of the problems is that
(if (not (integerp list)) list)
returns nil when list is an integer, so you're replacing integers with nil.
I think the only way to get this right is by assuming that no-one will ever call your function on a non-list value. Then you can rewrite it in the form
(defun functInt (x)
(cond ((atom x) x)
((integerp (car x)) FOO)
(t BAR)))
where I leave the expressions to substitute for FOO and BAR as exercises. (functInt 3) will still return 3, but that violates the function's contract.
Note that (atom nil) is true, so you don't need a special case for (null x).
It might be helpful to not try to do all this in a single function, but use a higher-order function to solve the general case and then only fill in a very simple function for the specific case. This is one suitable higher-order function:
(defun tree-mapcan (function tree)
(if (listp tree)
(list (mapcan (lambda (elt) (tree-mapcan function elt))
tree))
(funcall function tree)))