I don't understand why my program is behaving as it does.
(defvar A '((X Y Z) (J L O P) (G W U))
(defvar Z '(X W D U G))
(defvar STOP 'G)
(defun ADD_to_Z(A2)
(prog()
(cond
((equal (Member_Of_Z (list A2)) 0) )
(t (setq Z (append Z (list A2))) )
)
)
)
(defun Member_of_Z(cdr_A1)
(prog(n temp)
(setq n 0)
(setq temp cdr_A1)
repeat
(cond
((null temp) (return n))
((null (member (car temp) Z) ) (setq n (+ n 1)) (setq temp (cdr temp)))
(t (setq n (+ n 0)) (setq temp (cdr temp)))
)
(go repeat)
)
)
(defun TEST(A)
(prog(A1 A2)
(cond
((null A ) (return 'Fail))
(t (setq A1 (car A)) (setq A (cdr A)) (setq A2 (car A1))
(cond
((equal (Member_Of_Z (cdr A1)) 0)
(cond
((equal A2 STOP) (return 'SUCCESS))
(t (ADD_to_Z A2) (setq A (cdr A)) (TEST A) )
)
)
(t (TEST A) )
)
)
)
)
)
Goal of the functions :
- Member_of_Z will verify if all elements of cdr A1 belong to Z. If they do , it will return 0 (some other number else otherwise). This is what is not happening It was suppose to return SUCCESS when A is equal to ((G W U))
ADD_to_Z will add A2 to Z when Member_Of_Z does not return 0
Problem : Not only A seems to be never modified (at the end of the function TEST, A is still equal to its original value set by defvar even though I'm modifying it with (setq A (cdr A)). Also SUCCESS is never returned.
Could you help me ?
Step 1: use standard formatting (repairing the first toplevel form).
(defvar A '((X Y Z) (J L O P) (G W U)))
(defvar Z '(X W D U G))
(defvar STOP 'G)
(defun ADD_to_Z (A2)
(prog ()
(cond ((equal (Member_Of_Z (list A2)) 0))
(t (setq Z (append Z (list A2)))))))
(defun Member_of_Z (cdr_A1)
(prog (n temp)
(setq n 0)
(setq temp cdr_A1)
repeat
(cond ((null temp) (return n))
((null (member (car temp) Z) ) (setq n (+ n 1)) (setq temp (cdr temp)))
(t (setq n (+ n 0)) (setq temp (cdr temp))))
(go repeat)))
(defun TEST (A)
(prog (A1 A2)
(cond ((null A ) (return 'Fail))
(t (setq A1 (car A))
(setq A (cdr A))
(setq A2 (car A1))
(cond ((equal (Member_Of_Z (cdr A1)) 0)
(cond ((equal A2 STOP) (return 'SUCCESS))
(t (ADD_to_Z A2) (setq A (cdr A)) (TEST A) )))
(t (TEST A)))))))
Step 2: use standard naming.
(defvar *a* '((x y z) (j l o p) (g w u)))
(defvar *z* '(x w d u g))
(defvar *stop* 'g)
(defun add-to-z (a2)
(prog ()
(cond ((equal (member-of-z (list a2)) 0))
(t (setq *z* (append *z* (list a2)))))))
(defun member-of-z (cdr-a1)
(prog (n temp)
(setq n 0)
(setq temp cdr-a1)
repeat
(cond ((null temp) (return n))
((null (member (car temp) *z*)) (setq n (+ n 1)) (setq temp (cdr temp)))
(t (setq n (+ n 0)) (setq temp (cdr temp))))
(go repeat)))
(defun test (a)
(prog (a1 a2)
(cond ((null a) (return 'fail))
(t (setq a1 (car a))
(setq a (cdr a))
(setq a2 (car a1))
(cond ((equal (member-of-z (cdr a1)) 0)
(cond ((equal a2 *stop*) (return 'success))
(t (add-to-z a2) (setq a (cdr a)) (test a))))
(t (test a)))))))
Step 3: get rid of PROG.
(defvar *a* '((x y z) (j l o p) (g w u)))
(defvar *z* '(x w d u g))
(defvar *stop* 'g)
(defun add-to-z (a2)
(cond ((equal (member-of-z (list a2)) 0))
(t (setq *z* (append *z* (list a2))))))
(defun member-of-z (cdr-a1)
(let ((n 0)
(temp cdr-a1))
repeat
(cond ((null temp) (return n))
((null (member (car temp) z)) (setq n (+ n 1)) (setq temp (cdr temp)))
(t (setq n (+ n 0)) (setq temp (cdr temp))))
(go repeat)))
(defun test (a)
(cond ((null a) (return 'fail))
(t (let ((a1 (car a))
(a (cdr a))
(a2 (car a1)))
(cond ((equal (member-of-z (cdr a1)) 0)
(cond ((equal a2 *stop*) (return 'success))
(t (add-to-z a2) (setq a (cdr a)) (test a))))
(t (test a)))))))
Step 4: replace hand-rolled loop with a structured one.
(defvar *a* '((x y z) (j l o p) (g w u)))
(defvar *z* '(x w d u g))
(defvar *stop* 'g)
(defun add-to-z (a2)
(cond ((equal (member-of-z (list a2)) 0))
(t (setq *z* (append *z* (list a2))))))
(defun member-of-z (cdr-a1)
(let ((n 0)
(temp cdr-a1))
(loop :for element :in temp
:unless (member element *z*)
:do (incf n))
n))
(defun test (a)
(cond ((null a) (return 'fail))
(t (let ((a1 (car a))
(a (cdr a))
(a2 (car a1)))
(cond ((equal (member-of-z (cdr a1)) 0)
(cond ((equal a2 *stop*) (return 'success))
(t (add-to-z a2) (setq a (cdr a)) (test a))))
(t (test a)))))))
Step 5: replace two-clause COND with IF. Reduce RETURN forms when they are in
tail position anyway (and they don't work like that).
(defvar *a* '((x y z) (j l o p) (g w u)))
(defvar *z* '(x w d u g))
(defvar *stop* 'g)
(defun add-to-z (a2)
(if (equal (member-of-z (list a2)) 0)
nil
(setq *z* (append *z* (list a2)))))
(defun member-of-z (cdr-a1)
(let ((n 0)
(temp cdr-a1))
(loop :for element :in temp
:unless (member element *z*)
:do (incf n))
n))
(defun test (a)
(if (null a)
'fail
(let ((a1 (car a))
(a (cdr a))
(a2 (car a1)))
(if (equal (member-of-z (cdr a1)) 0)
(if (equal a2 *stop*)
'success
(progn (add-to-z a2) (setq a (cdr a)) (test a)))
(test a)))))
Step 6: replace loop with simple counting function.
(defvar *a* '((x y z) (j l o p) (g w u)))
(defvar *z* '(x w d u g))
(defvar *stop* 'g)
(defun add-to-z (a2)
(if (equal (member-of-z (list a2)) 0)
nil
(setq *z* (append *z* (list a2)))))
(defun member-of-z (cdr-a1)
(count-if-not (lambda (element)
(member element *z*))
cdr-a1))
(defun test (a)
(if (null a)
'fail
(let ((a1 (car a))
(a (cdr a))
(a2 (car a1)))
(if (equal (member-of-z (cdr a1)) 0)
(if (equal a2 *stop*)
'success
(progn
(add-to-z a2)
(setq a (cdr a))
(test a)))
(test a)))))
At this point, I still have no idea what you are trying to do. Perhaps you want
to find a list in *a* that is completely contained in *z*:
(defun test (a)
(find-if (lambda (list)
(every (lambda (element)
(member element *z*))
list))
a))
Related
I'm new to lisp, and am writing code for quicksort. I am almost done, although the output is giving me some trouble. This is currently what I have:
(defun fil(P L)
(if (null L) nil
(if (funcall P (first L)) (cons (first L) (fil P (rest L)))
(fil P (rest L)))))
(defun qs(L)
(if (null L) nil
(let ((x (first L))
(gt (fil (lambda (x) (<= (first L) x))(rest L) ))
(lt (fil (lambda (x) (> (first L) x))(rest L))))
(cons (cons (qs lt) (first L)) (qs gt)))))
(write (qs '(4 2 3 1 7 3 5 3 6)))
This works, but the output looks like this:
((((((NIL . 1)) . 2) (NIL . 3) (NIL . 3) (NIL . 3)) . 4)
(((NIL . 5) (NIL . 6)) . 7))
I am not sure where the extra nils and periods and parentheses are coming from or how to fix it. Any advice is appreciated.
Look at
(cons '(a b c d) 'e)
Above code does not append E to the list.
CL-USER 4 > (cons '(a b c d) 'e)
((A B C D) . E)
It creates a new cons cell (a two element container) with the first arg and the second arg with its elements.
What you need, is to APPEND lists into a result list.
Adding to what #RainerJoswig said:
(defun %filter (pred l)
(cond ((null l) nil)
((funcall pred (car l)) (cons (car l) (%filter pred (cdr l))))
(t (%filter pred (cdr l)))))
(defun quicksort (l)
(cond ((null l) nil)
(t (let ((greater-than (%filter (lambda (x) (<= (car l) x)) (cdr l)))
(less-than (%filter (lambda (x) (> (car l) x)) (cdr l))))
(append (quicksort less-than) (list (car l)) (quicksort greater-than))))))
(quicksort '(4 2 3 1 7 3 5 3 6))
;; (1 2 3 3 3 4 5 6 7)
Alternatively also:
(defun %filter (pred l)
(mapcan (lambda (x) (if (funcall pred x) (list x) nil)) l))
(defun quicksort (l)
(cond ((null l) nil)
(t (append (quicksort (%filter (lambda (x) (< x (car l))) (cdr l)))
(list (car l))
(quicksort (%filter (lambda (x) (<= (car l) x)) (cdr l)))))))
Starting to learn LISP and wrote two simple programs, which uses functions as params.
The first:
;gnu clisp 2.49.60
(defun pf (x f123) (cond ((null x) nil)
(T (cons ( f123 (car x) ) (pf (cdr x) f123)))))
(defun f2 (x) (* x x))
(print (pf '(1 2 3 4) 'f2 ) )
The second:
(defun some1(P1 P2 x)
(if (not( = (length x) 0))
(cond
(
(or ( P1 (car x) ) ( P2 (car x)) )
(cons (car x) (some1 P1 P2 (cdr x) ))
)
(t (some1 P1 P2 (cdr x) ))
)
)
)
(print (some1 'atom 'null '( 5 1 0 (1 2) 10 a b c) ) )
The both of program aren't working. And I don't know how to fix it :(
(funcall f123 x y z) is works, so results:
;gnu clisp 2.49.60
(defun pf (x f123)
(cond ((null x) nil)
(T (cons (funcall f123 (car x))
(pf (cdr x) f123)))))
(defun f2 (x) (* x x))
(print (pf '(1 2 3 4) 'f2))
And
;gnu clisp 2.49.60
(defun eq0(x)
(if (= x 0)
t
nil))
(defun bg10(x)
(if (> x 10)
t
nil))
(defun some1 (P1 P2 x)
(if (not (= (length x) 0))
(cond
((or (funcall P1 (car x)) (funcall P2 (car x)))
(cons (car x) (some1 P1 P2 (cdr x))))
(t (some1 P1 P2 (cdr x))))))
(print (some1 'eq0 'bg10 '(5 0 0 11)))
Maybe it will be useful for someone :)
I'm trying to multiplicate two vectors in lisp.
My code is:
(defun produs(x y)
(cond
((or (null x) (null y))
nil)
((eq (cdr x) nil)
(cons (* (car x) (car y))
(cdr y)))
((eq (cdr y) nil)
(cons (* (car x) (car y))
(cdr x)))
(t
(cons (* (car x) (car y))
(produs (cdr x) (cdr y))))))
When I verify
(produs '(7) '(1 2))
it gives me (7 2).
The 4rd line of code doesn't specify that if the rest of the body of x is nil, then to multiplicate it with all elements of y?
If I correctly understand what you want to achieve this code should work:
(defun produs(x y)
(cond
((or (null x) (null y)) nil)
((eq (cdr x) nil) ( cons (* (car x)(car y))(produs (cdr y) x )))
((eq (cdr y) nil) ( cons (* (car x)(car y)) (produs (cdr x) y)))
(t (cons (*(car x)(car y)) (produs (cdr x)(cdr y))))
)
)
The problem was that you were not "saying" to multiplicate all elements with the head x, but just adding all remaining elements in y to your result list.
(produs '(7) '(1 2)) => (7 14)
You could also try to refactor the code a little to avoid repeating yourself:
(defun produs (x y)
(when (and x y)
(cons (* (first x) (first y))
(let ((rx (rest x))
(ry (rest y)))
(cond
((and rx ry) (produs rx ry))
(rx (produs rx y))
(ry (produs ry x)))))))
i have a simple boolean expression presented as a lisp list like this :
'(OR 0 (AND A1 A2))
the previous list is the presentation of ((A1 AND A2)OR 0).
anyway , i am writing a function to simplify this expression ..
for example :
calling the function "reduce" like this :
(reduce '(OR 0 (AND A1 A2)))
would yield
(AND A1 A2)
i firstly tried to create base rules , so i defined
the following identities:
(AND 1 S) == S,
(OR 0 S ) == S,
(AND 0 S) == 0,
( OR 1 S) == 1,
(NOT O) == 1,
(NOT 1) == 0.*
i was thinking of defining 6 functions , one for each rule , and then
call them one by one in a wrapper , i am new to lisp so i don't have a clue to implement that , i made it in java once , but i dont know how to handle such problem using the syntax of lisp so please help me ..
Given the complexity of your solution, here's my implementation that's a lot shorter and more readable:
(defun reduc (exp)
(if (atom exp)
exp
(flet ((helper (op args n) ; and and or is nearly the same code so we factor it out
(let ((newargs (remove n args)) (cn (- 1 n)))
(cond
((null newargs) n)
((some (lambda (e) (eql cn e)) newargs) cn)
((null (cdr newargs)) (car newargs))
((cons op newargs))))))
(let ((op (car exp)) (args (mapcar #'reduc (cdr exp))))
(ecase op
((not) (if (= 1 (length args))
(let ((arg1 (car args)))
(if (and (numberp arg1) (<= 0 arg1 1)) (- 1 arg1) exp))
(error "'not' must have exactly one parameter")))
((and) (helper op args 1))
((or) (helper op args 0)))))))
Testing:
? (reduc '(OR 0 (AND A1 A2)))
(AND A1 A2)
? (reduc '(OR 0 (AND A1 1 A2)))
(AND A1 A2)
? (reduc '(or ERROR (not 0)))
1
? (reduc '(AND ERROR (not 0)))
ERROR
? (reduc '(OR 0 (AND A1 0)))
0
? (reduc '(OR 0 (AND A1 1)))
A1
i finally came up with this solution .
(defun simplify (EXPR)
(simplify-expr NIL EXPR))
(defun simplify-expr (EXPR1 EXPR2)
(cond
((or (atom EXPR2) (equal EXPR1 EXPR2)) EXPR2)
(T (simplify-expr EXPR2 (simplify-boolean-expr EXPR2)))))
(defun simplify-boolean-expr (EXPR)
(cond
((and (equal (first EXPR) `and) (>= (length EXPR) 3))
(simplify-and-expr (rest EXPR)))
((and (equal (first EXPR) `or) (>= (length EXPR) 3))
(simplify-or-expr (rest EXPR)))
((and (equal (first EXPR) `not) (= (length EXPR) 2))
(simplify-not-expr (rest EXPR)))
(T
(error "~S is not a valid circuit descriptor expression or has an unknown operator." EXPR))))
(defun simplify-and-expr (EXPR)
(let ((SIMPLIFIED_EXPR (remove `T (remove-duplicates EXPR))))
(cond
((null SIMPLIFIED_EXPR) `T)
((member `NIL SIMPLIFIED_EXPR) `NIL)
((null (second SIMPLIFIED_EXPR)) (first SIMPLIFIED_EXPR))
(T (cons `and (simplify-operand SIMPLIFIED_EXPR))))))
(defun simplify-or-expr (EXPR)
(let ((SIMPLIFIED_EXPR (remove `NIL (remove-duplicates EXPR))))
(cond
((null SIMPLIFIED_EXPR) `NIL)
((member `T SIMPLIFIED_EXPR) `T)
((null (second SIMPLIFIED_EXPR)) (first SIMPLIFIED_EXPR))
(T (cons `or (simplify-operand SIMPLIFIED_EXPR))))))
(defun simplify-not-expr (EXPR)
(cond
((equal (first EXPR) `NIL) `T)
((equal (first EXPR) `T) `NIL)
((and (listp (first EXPR)) (equal (first (first EXPR)) `not))
(first (rest (first EXPR))))
(T (cons `not (simplify-operand EXPR)))))
(defun simplify-operand (OPERAND_LIST)
(cond
((null OPERAND_LIST) NIL)
((atom (first OPERAND_LIST))
(cons (first OPERAND_LIST) (simplify-operand (rest OPERAND_LIST))))
(T
(cons (simplify-expr NIL (first OPERAND_LIST)) (simplify-operand (rest OPERAND_LIST))))))
it takes (nil , T) for (0 , 1) and reduces any boolean expression , i tried it and it works fine .
Need to write a union function in lisp that takes two lists as arguments and returns a list that is the union of the two with no repeats. Order should be consistent with those of the input lists
For example: if inputs are '(a b c) and '(e c d) the result should be '(a b c e d)
Here is what I have so far
(defun stable-union (x y)
(cond
((null x) y)
((null y) x))
(do ((i y (cdr i))
(lst3 x (append lst3
(cond
((listp i)
((null (member (car i) lst3)) (cons (car i) nil) nil))
(t (null (member i lst3)) (cons i nil) nil)))))
((null (cdr i)) lst3)))
My error is that there is an "illegal function object" with the segment (null (member (car i) lst3))
Advice?
You've got your parens all jumbled-up:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x) ) END OF COND form - has no effect
(do ((i y (cdr i))
^^
(lst3 x (append lst3
(cond
((listp i)
( (null (member (car i) lst3))
^^ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ called as a function
(cons (car i) nil) with two arguments
nil ) )
^^
(t NEXT 3 forms have no effect
(null (member i lst3))
(cons i nil)
nil )))) )
^^
((null (cdr i)) lst3)))
Here's your code as you probably intended it to be, with corrected parenthesization and some ifs added where needed:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x)
(t
(do ((i y (cdr i))
(lst3 x (append lst3
(cond
((listp i)
(if (null (member (car i) lst3))
(cons (car i) nil)
nil))
(t
(if (null (member i lst3))
(cons i nil)
nil))))))
((null (cdr i)) lst3)))))
There are still problems with this code. Your do logic is wrong, it skips the first element in y if it contains just one element. And you call append all the time whether it is needed or not. Note that calling (append lst3 nil) makes a copy of top-level cons cells in lst3, entirely superfluously.
Such long statements as you have there are usually placed in do body, not inside the update form for do's local variable.
But you can use more specialized forms of do, where appropriate. Here it is natural to use dolist. Following "wvxvw"'s lead on using hash-tables for membership testing, we write:
(defun stable-union (a b &aux (z (list nil)))
(let ((h (make-hash-table))
(p z))
(dolist (i a)
(unless (gethash i h)
(setf (cdr p) (list i) p (cdr p))
(setf (gethash i h) t)))
(dolist (i b (cdr z))
(unless (gethash i h)
(setf (cdr p) (list i) p (cdr p))
(setf (gethash i h) t)))))
using a technique which I call "head-sentinel" (z variable pre-initialized to a singleton list) allows for a great simplification of the code for the top-down list building at a cost of allocating one extra cons cell.
The error is because you're trying to execute the result of evaluating (null (member (car i) lst3)). In your cond expression, if i is a list, then it attempts to evaluate the expression
((null (member (car i) lst3)) (cons (car i) nil) nil))
And return the result. The first element in an expression should be a function, but
(null (member (car i) lst3))
Is going to return a boolean value. Hence the failure. The structure of your code needs some attention. What you've missed is that you need an inner cond, there.
Incidentally, this would be a much cleaner function if you did it recursively.
I'm a Schemer rather than a Lisper, but I had a little think about it. Here's the skeleton of a recursive implementation:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x)
((listp y)
(cond
((member (car y) x) (stable-union ??? (???)))
(t (stable-union (append x (??? (???))) (cdr y)))))
((not (member y x)) (append x (list y)))
(t x)))
(Edited to correct simple tyop in second-last line, thanks to Will Ness for spotting it)
(remove-duplicates (append '(a b c) '(e c d)) :from-end t)
Because you started off with do, and because a recursive solution would be even worse, here's what you could've done:
(defun union-stable (list-a list-b)
(do ((i list-b (cdr i))
filtered back-ref)
((null i) (append list-a back-ref))
(unless (member (car i) list-a)
(if back-ref
(setf (cdr filtered) (list (car i))
filtered (cdr filtered))
(setf back-ref (list (car i))
filtered back-ref)))))
This is still quadratic time, and the behaviour is such that if the first list has duplicates, or the second list has duplicates, which are not in the first list - they will stay. I'm not sure how fair it is to call this function a "union", but you'd have to define what to do with the lists if they have duplicates before you try to unify them.
And this is what you might've done if you were interested in the result, rather than just exercising. Note that it will ensure that elements are unique, even if the elements repeat in the input lists.
(defun union-stable-hash (list-a list-b)
(loop for c = (car (if list-a list-a list-b))
with back-ref
with hash = (make-hash-table)
for key = (gethash c hash)
with result
do (unless key
(if back-ref
(setf (cdr result) (list c)
result (cdr result))
(when (or list-a list-b)
(setf back-ref (list c)
result back-ref)))
(setf (gethash c hash) t))
do (if list-a (setf list-a (cdr list-a))
(setf list-b (cdr list-b)))
do (unless (or list-a list-b)
(return back-ref))))