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 :)
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)))))))
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))
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 am writing a lisp function and I keep getting EVAL - undefined function x when I try to return the value of x from the function.
(defun p+ (x y)
(recurcollect (gluelist x y) '()))
(defun isinlist (x y)
(if (car y)
(if (equal (cdr x) (cdar y))
t
(if (cdr y)
(isinlist(x (cdr y)))
NIL))
NIL))
(defun collectvalue (x y) ;takes an expression and a list and returns the sum of all like expressions from the list
(if (equal x NIL)
(print '(x is NIL))
(if (equal (cdr x) (cdar y))
(if (cdr y)
(collectvalue (list (+ (car x) (caar y)) (cdr x)) (cdr y))
(list (+ (car x) (caar y)) (cdr x)))
(if (cdr y)
(collectvalue x (cdr y))
x))))
(defun recurcollect (x y) ;returns a flat list of collected expressions
(if (isinlist (car x) y)
(recurcollect (cdr x) y)
(if (cdr x)
(recurcollect x (cons y (collectvalue (car x) (cdr x))))
(cons y (car x)))))
(defun gluelist (x y)
(if (cdr x)
(cons (car x) (gluelist (cdr x) y))
(cons (car x) y)))
(print (p+ '(2 0 1) '(4 0 1))) ;(6 0 1)
I believe the error is caused by the x at the end of the function but I cant see why, as far as I can tell my brackets are correctly paired up and I cant see why it is trying to evaluate x as a function.
The problem is in isinlist which is called recursively as (isinlist(x (cdr y))).
(x ...) is interpreted as a function call of function x.
You probably want (isinlist x (cdr y)) instead.
Incidentally, you can replace isinlist with member (with :key #'cdr :test #'equal).
I am trying to do a quicksort using LISP but I am having trouble with my functions output.
(defun qsort (L)
(cond
((null L) nil)
(t(append
(qsort (list< (car L) (cdr L)))
(cons (car L) nil)
(qsort (list>= (car L) (cdr L)))))))
(defun list< (a b)
(cond
(( or(null a)(null b) nil))
(( < a (car b)) (list< a (cdr b)))
(t(cons (car b) (list< a (cdr b))))))
(defun list>= (a b)
(cond
(( or( null a)(null b) nil))
(( >= a (car b)) (list> a (cdr b)))
(t(cons (car b) (list> a (cdr b))))))
My problem being when list< and list>= finish the list always ends with a .T. For instance:
> (list< '4 '(1 5 3 8 2))
Entering: LIST<, Argument list: (4 (1 5 3 8 2))
Entering: LIST<, Argument list: (4 (5 3 8 2))
Entering: LIST<, Argument list: (4 (3 8 2))
Entering: LIST<, Argument list: (4 (8 2))
Entering: LIST<, Argument list: (4 (2))
Entering: LIST<, Argument list: (4 NIL)
Exiting: LIST<, Value: T
Exiting: LIST<, Value: (2 . T)
Exiting: LIST<, Value: (2 . T)
Exiting: LIST<, Value: (3 2 . T)
Exiting: LIST<, Value: (3 2 . T)
Exiting: LIST<, Value: (1 3 2 . T)
(1 3 2 . T)
Why is (4 NIL) evaluating as T?
Your problem with list<, and also with list>=, lies on ((or ( null a)(null b) nil)), it should be (( or( null a)(null b)) nil). Note nil was moved outside of the condition to be the returned value.
Furthermore, on the definition of list>= you are calling list>, but I'm positive you meant list>= instead.
I would also suggest some indentation to address the legibility of lisp, like follows
(defun qsort (L)
(cond
((null L) nil)
(t
(append
(qsort (list< (car L) (cdr L)))
(cons (car L) nil)
(qsort (list>= (car L) (cdr L)))))))
(defun list< (a b)
(cond
((or (null a) (null b)) nil)
((< a (car b)) (list< a (cdr b)))
(t (cons (car b) (list< a (cdr b))))))
(defun list>= (a b)
(cond
((or (null a) (null b)) nil)
((>= a (car b)) (list>= a (cdr b)))
(t (cons (car b) (list>= a (cdr b))))))
Some testing follows:
(list< '4 '(1 5 3 8 2))
=> (1 3 2)
(list>= '4 '(1 5 3 8 2))
=> (5 8)
(qsort '(1 5 3 8 2))
=> (1 2 3 5 8)
Lisp has different kinds of collections. I think sort a list using quick-sort is not a good choice. In the implementation of STL in C++, the sorting method of list is merge-sort. I have tried to implement a 3-way quick-sort using the collections of array.
(defun quick-sort (arr start end)
"Quick sort body"
(if (< start end)
(let ((n-pair (partition arr start end)))
(quick-sort arr start (car n-pair))
(quick-sort arr (cdr n-pair) end))
))
(defun partition (arr start end)
"Partition according to pivot."
(let ((pivot (aref arr start)) (cur start))
(loop while (<= start end) do
(cond
((< pivot (aref arr start)) ; pivot < arr[start], swap with arr[end]
(swap arr start end) (decf end))
((> pivot (aref arr start)) ; pivot > arr[start], swap with arr[start]
(swap arr cur start) (incf cur) (incf start))
(t ; otherwise
(incf start))))
(cons (decf cur) start)))
(defun swap (arr i j)
"Swap element of arr"
(let ((tmp (aref arr i)))
(setf (aref arr i) (aref arr j))
(setf (aref arr j) tmp)))
(defun quick (list)
(when (< = (length list) 1) (return-from quick list))
(let ((pivot (car list)) (rest (cdr list)) (less nil) (greater nil))
(loop for i in rest do
(if (< i pivot) (push i less) (push i greater)))
(append (quick less) (list pivot) (quick greater))))
I'd recommend to change the code of liya babu/Will Ness like this:
(defun quick (list)
(if (null list) nil
(let ((pivot (first list)) (less nil) (greater nil))
(dolist (i (rest list))
(if (< i pivot) (push i less) (push i greater)))
(append (quick less) (list pivot) (quick greater)))))
Although just slightly edited I find it both more lispy and more succinct.
There are some errors in the program. The corrected program is:
(defun qsort (L)
(cond
((null L) nil)
(t (append
(qsort (list< (car L) (cdr L)))
(cons (car L) nil)
(qsort (list>= (car L) (cdr L)))))))
(defun list< (a b)
(cond
(( or (null a) (null b)) nil)
(( < a (car b)) (list< a (cdr b)))
(t (cons (car b) (list< a (cdr b))))))
(defun list>= (a b)
(cond
(( or ( null a)(null b)) nil)
(( >= a (car b)) (list>= a (cdr b)))
(t (cons (car b) (list>= a (cdr b))))))
This should also work:
(defun qsort (l)
(cond
((null l) nil)
(t (append
(qsort (car(list<> (car l)(cdr l))))
(cons (car l) nil)
(qsort (cadr(list<> (car l)(cdr l))))))))
(defun list<> (a b &optional rl rr)
(cond
((null b) (list rl rr))
((<=(car b)a) (list<> a (cdr b) (cons (car b) rl) rr))
(t (list<> a (cdr b)rl (cons (car b) rr)))))
(setq l (loop for j from 1 to 20 append (list(random 100))))
(qsort l)
;=> (86 99 9 31 66 58 57 43 48 21 51 0 32 69 39 47 59 76 69 23)
;=> (0 9 21 23 31 32 39 43 47 48 51 57 58 59 66 69 69 76 86 99)