Setting up a equal function in common lisp using only "eq" - lisp

I've given the assingment to write a function in common lisp to compare two lists to see if they are equal and I have been bared from using the "equal" predicate I can only use "eq" and I seem to come to a wall. I get this error with my code EVAL: variable SETF has no value
The following restarts are available:
and he code:
(defun check(L1 L2)
(cond
((eq L nil) nil)
(setq x (first L1))
(setq y (first L2))
(setf L1 (rest L1))
(setf L2 (rest L2))
(if (eq x y) (check L1 L2))))
(defun b(L1 L2)
(cond
((eq L1 nil) nil)
(setf x (first L1))
(setf y (first L2))
(setf L1 (rest L1))
(setf L2 (rest L2))
(if (and (list x) (list y)
(check(x y))
(if (eq x y) (b(L1 L2))))))

I guess this is what you are looking for:
(defun compare-lists (list1 list2)
(if (and (not (null list1))
(not (null list2)))
(let ((a (car list1)) (b (car list2)))
(cond ((and (listp a) (listp b))
(and (compare-lists a b)
(compare-lists (cdr list1) (cdr list2))))
(t
(and (eq a b)
(compare-lists (cdr list1) (cdr list2))))))
(= (length list1) (length list2))))
Tests:
? (compare-lists '(1 2 3) '(1 2 3))
T
? (compare-lists '(1 2 3) '(1 2 3 4))
NIL
? (compare-lists '(1 2 3) '(1 2 (3)))
NIL
? (compare-lists '(1 2 (3)) '(1 2 (3)))
T
? (compare-lists '(1 2 (a b c r)) '(1 2 (a b c (r))))
NIL
? (compare-lists '(1 2 (a b c (r))) '(1 2 (a b c (r))))
T

Related

Issue with extra nils in quicksort result

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)))))))

Two common elements between lists

I have a problem with this function two-similar-p.
(defun two-similar-p (list1 list2)
(mapcar
(lambda (e)
(mapcar
(lambda (e1)
(if (equal e e1) t))
list2))
list1))
But is not correct use mapcar because this function returns a new list with T or NIL, but I need only to return a true or false.
ex.
(two-similar-p '(2 1 3) '(1 2 3))
==> ((NIL T NIL) (T NIL NIL) (NIL NIL T))
I was thinking to use recursion to compare the various elements, but I have no idea how to do that.
My function needs to work like:
(two-similar-p '(1 2 3) '(1 4 5)) ; ==> nil
(two-similar-p '(1 2 5) '(1 4 5)) ; ==> t
(two-similar-p '(1 2 6) '(6 4 2)) ; ==> t
Any advice?
The easiest "off-the-shelf" solution is to check that the intersection contains at least two elements:
(defun two-similar-p (l1 l2)
(consp (cdr (intersection l1 l2 :test #'equal))))
A slightly less OTS solution is to use hash tables:
(defun two-similar-p (l1 l2)
(let ((h1 (make-hash-table :test 'equal))
(common 0))
(dolist (x l1)
(setf (gethash x h1) t))
(dolist (x l2)
(when (gethash x h1)
(incf common))
(when (>= common 2)
(return t)))))
The advantage of the second approach is that its complexity is O(len(l1) + len(l2)),
while the mapcar approach will be O(len(l1) * len(l2)).
The standard does not specify the complexity of intersection and friends, but most implementations take good care of their users here (IOW, the complexity will be linear, not quadratic).

Reverse a list with dolist in LISP

I try to reverse a list, i can't use the function "nreverse"
I try :
(defun dolist-reverse (l)
(let ((new-list (make-list (length l))))
(dolist (x l new-list)
(setf new-list (cons x new-list)))))
But the result is :
CL-USER> (dolist-reverse '(1 2 3))
(3 2 1 NIL NIL NIL)
How can i do ? (i need to use dolist)
EDIT :
Finally fix my problem :
(defun dolist-reverse (l)
(let ((new-list))
(dolist (x l new-list)
(setf new-list (cons x new-list)))))
CL-USER 11 > (defun dolist-reverse (list &aux (reverse-list nil))
(dolist (element list reverse-list)
(push element reverse-list)))
DOLIST-REVERSE
CL-USER 12 > (dolist-reverse '(1 2 3))
(3 2 1)
This one makes same thing, without changing argument to the procedure;
(defun my-reverse (l)
(if (null l) nil
(append
(my-reverse (cdr l))
(list (car l)))))

Quicksort in LISP

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)

Recursing Through Nested List LISP

How would I recurse through nested lists?
For example, given: '((A 1 2) (B 3 4))
How would I add 2 to the second element in each nested sublist?
(defun get-p0 (points)
(loop for x from 0 to
(- (list-length points) 1) do
(+ 2 (cadr (nth x points)))
)
)
I'm not really sure why (get-p0 '((A 1 2) (B 3 4))) returns NIL.
I'd go with something like this:
(loop for (letter x y) in '((A 1 2) (B 3 4))
collect (list letter (+ 2 x) y))
The reason: it's shorter and you don't measure the length of the list in order to iterate over it (why would you do that?)
Since you ask for a recursive solution:
(defun get-p0 (lst &optional (n 0))
(if (null lst)
nil
(let ((elt1 (first lst)) (eltn (cdr lst)))
(if (listp elt1)
(cons (get-p0 elt1) (get-p0 eltn))
(cons (if (= n 1) (+ elt1 2) elt1) (get-p0 eltn (+ n 1)))))))
so
? (get-p0 '((A 1 2) (B 3 4)))
((A 3 2) (B 5 4))
and it recurses further down if necessary:
? (get-p0 '((A 0 2) ((B -4 4) (C 10 4))))
((A 2 2) ((B -2 4) (C 12 4)))
The way you put it, you can consider the problem as a basic recursion pattern: you go through a list using recursion or iteration (mapcar, reduce, etc.; dolist, loop, etc.) and apply a function to its entries. Here is a functional solution:
(defun get-p0 (points)
(mapcar #'add-2 points))
where the auxiliary function can be defined as follows:
(defun add-2 (lst)
"Add 2 to the 2nd item"
(let ((res '()))
(do ((l lst (cdr l))
(i 1 (1+ i)))
((null l) (nreverse res))
(push (if (= 2 i)
(+ 2 (car l))
(car l))
res))))
As written your 'loop' use does not return anything; thus NIL is returned. As is your code is simply iterating over x and computing something; that something isn't stored anywhere.
So, how to get your desired result? Assuming you are willing to modify each point in points, this should work:
(defun get-p0 (points)
(loop for x from 0 to (- (list-length points) 1) do
(let ((point (nth x points)))
(setf (cadr point) (+ 2 (cadr point)))))
points)