stable-union lisp - lisp

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

Related

How do I fix "BINDING form is not a proper list" error

I'm new in lisp, I'm trying to define a simple function that search an element in a list.
I'm not finding myself comfortable with the sintax of the language, also I don't quite understand the error/warning messages.
(defun in-list (x l)
(let y (car l))
(let z (cdr l))
(if (null l)
nil
(if (equal x y)
t
(in-list x z)
)
)
)
I also tried to replace let with seq, but still gave me warnings on "variables assumed to be special".
There is an error in the syntax of let. The correct form is:
(let ((var1 exp1)
(var2 exp2)
...
(varn expn))
body-of-let)
So you should write:
(defun in-list (x l)
(let ((y (car l))
(z (cdr l)))
(if (null l)
nil
(if (equal x y)
t
(in-list x z)))))
Note that it is not necessary define the two local variables since the corresponding expression is used only once, so you could abbreviate the function in this way:
(defun in-list (x l)
(if (null l)
nil
(if (equal x (car l))
t
(in-list x (cdr l)))))
and, since you have three different cases in the body, you could use a single cond instead of two if:
(defun in-list (x l)
(cond ((null l) nil)
((equal x (car l)) t)
(t (in-list x (cdr l)))))
There are very good free books on the web to learn the basis of the language. See for instance this one.
To be able to use setq, you can declare your function's inner variables after the &aux keyword in the function's lambda-list:
(defun in-list (x l &aux y z)
(setq y (car l)
z (cdr l))
(and l
(or (equal x y)
(in-list x z))))
A better style is to give the auxiliary variables their values right at the point of declaration:
(defun in-list (x l &aux (y (car l)) (z (cdr l)))
(and l
(or (equal x y)
(in-list x z))))

Write a function COUNT-NUMBERS that counts the number of numbers in a list

I'm begginer at LISP, and I have a question need your help.
Write a function COUNT-NUMBERS that counts the number of numbers in a list,and return " NO NUMBER" if there is no number in the list
For example, for a list: (A 2.3 B C 4 5), it returns 3.
I've tried with the following code, but it doesn't work . Could you help me to figure out? Moreover, I don't know how to return "NO NUMBER" if there is no number in the list.
(defun count-numbers (x)
(cond ((null x) 0)
((numberp x) 1)
(t (+(count-numbers (car x))(count-numbers (cdr x))))))
Thanks in advance,
You could to define a inner helper function to do the counting, and check the result to decide what to return in the main function:
(defun number-counter (lst)
(labels ((do-count (l)
(cond ((null l) 0)
((numberp (car l)) (+ 1 (do-count (cdr l))))
(t (do-count (cdr l))))))
(let ((r (do-count lst)))
(if (= r 0) 'NO-NUMBER r))))
This would be a tail-recursive version. Somehow you have to check what to return.
(defun count-numbers (list &optional (n 'no-number))
(cond ((null list) n)
((numberp (first list))
(count-numbers (rest list)
(if (eq n 'no-number)
1
(1+ n))))
(t (count-numbers (rest list) n))))
With a LOOP you can write that this way:
(defun count-numbers (list)
(loop for element in list
count (numberp element) into n
finally (return (if (zerop n) 'no-number n))))

Scheme; Error Holes in a Macro List

So for a college assignment we've been asked to work with macros and I'm finding it hard to understand how to implement code in scheme (we went from reversing a string to building an interpreter in one lecture).
(define macro-alist
`((and ,(λ (e)
(let ((forms (cdr e)))
(cond ((null? forms) '#t)
((null? (cdr forms)) (car forms))
(else `(if ,(car forms) (and ,#(cdr forms)) #f))))))
;(or ,error)
;(let ,error)
;(cond ,error)
(if ,(λ (e) (let ((guard (cadr e))
(then-part (caddr e))
(else-part (cadddr e)))
`((%if ,guard (λ () ,then-part) (λ () ,else-part))))))
))
We were asked to 'fill in the error holds in macro-alist' for the weekend and I'm finding it difficult.
I found some resources and combining them with my own brief knowledge I have :
`((or ,(lambda (e)
(and (list-strictly-longer-than? e 0)
(equal? (list-ref e 0) 'or)
(letrec ([visit (lambda (i)
(if(null? i)
#t
(and (is-exression? (car i))
(visit (cdr i)))))])
(visit (cdr e)))))))
`((let ,(lambda (e)
(and (proper-list-of-given-length? e 3)
(equal? (car e) 'let)
(list? (cadr e))
(is-expression? (list-ref e 2))
(lectrec ([visit (trace-lambda visit (i a)
(if(null? i)
#t
(and (proper-list-of-given-length? (car i) 2)
(is-identifier? (caar i))
(is-expression? (cadar i))
(not (member (caar i) a))
(visit (cdr i) (cons (caar i) a)))))])
(visit (cadr e) '()))))))
`((cond ,(lambda (e)
(and (list-strictly-longer-than? e 1)
(equal? (car v) 'cond)
(lectrec ([visit (lambda (i)
(if (null? (cdr i))
(is-else-clause? (car i))
(if (pair? (cdr i))
(and (cond? (car i))
(visit (cdr i))))))])
(visit (cdr e)))))))
For or, let and cond. I'm wondering if these are correct or if I'm close. I don't understand much about macros or scheme in general so some information/help on what to do would be appreciated.
If you look at the implementation of and:
(define expand-and
(λ (e)
(let ((forms (cdr e)))
(cond ((null? forms) '#t)
((null? (cdr forms)) (car forms))
(else `(if ,(car forms) (and ,#(cdr forms)) #f))))))
(expand-and '(and)) ; ==> #t
(expand-and '(and a)) ; ==> a
(expand-and '(and a b)) ; ==> (if a (and b) #f)
I notice two things. It doesn't really double check that the first element is and or if it's a list. Perhaps the interpreter doesn't use this unless it has checked this already?
Secondly it doesn't seem like you need to expand everything. As you see you might end up with some code + and with fewer arguments. No need for recursion since the evaluator will do that for you.
I think you are overthinking it. For or it should be very similar:
(expand-or '(or)) ; ==> #f
(expand-and '(or a b c)) ; ==> (let ((unique-var a)) (if unique-var unique-var (or b c)))
The let binding prevents double evaluation of a but if you have no side effects you might just rewrite it to (if a a (or b)). As with and or might expand to use or with fewer arguments than the original. This trick you can do with cond as well:
(cond (a b c)
...) ; ==>
(if a
(begin b c)
(cond ...))
let does not need this since it's perhaps the simplest one if you grasp map:
(let ((a x) (c y))
body ...) ; ==>
((lambda (a c) body ...) x y)
The report has examples of how the macros for these are made, but they might not be the simplest to rewrite to functions that takes code as structure like your interpeter. However using the report to understand the forms would perhaps worked just as well as posting a question here on SO.

how to solve badly formed lambda in lisp?

I am trying to check if a list has a mountain aspect or not in lisp.
e.g:1,5,9,6,4,3
l is my list and aux is 0-the ascending part of l or 1-the descending part of the list.
muntemain just call munte starting with aux=0,the ascending part
my error is :
Badly formed lambda: (AND (< (CAR L) (CAR (CDR L))) (EQ AUX 0))
and I can't see the problem.Can someone help please?
(defun munte (l aux)
(cond
((and (atom l) (null aux)) NIL)
((and (null l) (null aux)) NIL)
((and (atom l) (eq aux 1)) T)
((and (null l) (eq aux 1) T)
((and (< (car l) (car(cdr l))) (eq aux 0)) (munte(cdr l) 0))
((and (or (> (car l) (cadr l)) (= (car l) (cadr l))) (eq aux 0))(munte(cdr l) 1))
( and (> (car l) (cadr l)) (eq aux 1)) (munte(cdr l) 1))
(T NIL)
)
)
(defun muntemain (l)
(cond
((> (car l) (cadr l)) NIL)
((< (length l) 2) NIL)
(T (munte l 0))
)
)
Formatting
As noted by Barmar, you really need to use an editor to help you with the parenthesis. There are many tutorials for installing Emacs+Slime. Take some time to install proper tools.
Don't use EQ for numbers and characters
An implementation is permitted to make "copies" of characters and
numbers at any time. The effect is that Common Lisp makes no guarantee
that eq is true even when both its arguments are "the same thing" if
that thing is a character or number.
Factorize tests
((and (atom l) (null aux)) NIL)
((and (null l) (null aux)) NIL)
((and (atom l) (eq aux 1)) T)
((and (null l) (eq aux 1) T)
From the definition of atom, NIL is an atom, so you don't need (null L). The different cases for aux can be grouped too. The clause below is sufficient to account for all the above ones:
((atom L) (eql aux 1))
But I don't understand why aux is not a boolean in the first place if you always bind it to 0 or 1. Just use t and nil and return aux in the above clause.
Use meaningful functions
(< (car l) (car(cdr l)))
Of course, (car(cdr ..)) is known as (cadr ..), but also as second. The above test is equivalent to:
(< (first L) (second L))
And what if your list has no second element? You will compare a number against nil and signal an error (not what you want). You need more tests. In muntemain, you seem to have a special case for when length is below 2, but the test is done only if the previous returns nil, which won't happen if an error is signaled.
An iterative alternative
Here is a completely different way to attack the problem, just to give you ideas.
(lambda (list)
(loop
;; memories
for px = nil then x
for pdx = nil then dx
;; current element
for x in list
;; first and second "derivatives" (signs only)
for dx = 1 then (signum (- x px))
for ddx = 0 then (signum (- dx pdx))
;; checks
sum ddx into total
always (and (<= dx 0) (<= -1 total 0))
finally (return (= total -1))))

Finding the maximum number of child nodes in a tree

First, I should make it clear that this is required for an academic project. I am trying to find the maximum number of child nodes for any node in a tree, using Common Lisp.
My current code is shown below - I'm not 100% on the logic of it, but I feel it should work, however it isn't giving me the required result.
(defun breadth (list y)
(setf l y)
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element)))
))) list)
l)
(defun max-breadth(list)
(breadth list (length list))
)
As an example, running
(max-breadth '(a ( (b (c d)) e) (f g (h i) j)))
should return 4.
Edit:
Trace results and actual return values, forgot these:
CG-USER(13): (max-breadth '(a ( (b (c d)) e) (f g (h i) j)))
0[6]: (BREADTH (A ((B (C D)) E) (F G (H I) J)) 3)
1[6]: (BREADTH ((B (C D)) E) 2)
2[6]: (BREADTH (B (C D)) 2)
3[6]: (BREADTH (C D) 2)
3[6]: returned 2
2[6]: returned 2
1[6]: returned 2
1[6]: (BREADTH (F G (H I) J) 4)
2[6]: (BREADTH (H I) 2)
2[6]: returned 2
1[6]: returned 2
0[6]: returned 2
2
Does anyone have any ideas where I'm going wrong? I suspect it's related to the second conditional, but I'm not sure.
First, standard formatting:
(defun breadth (list y)
(setf l y)
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element))))))
list)
l)
(defun max-breadth (list)
(breadth list (length list)))
Your problem is the (setf l y), which should give you a warning about l being undefined. Setf should not be used on unbound variables. Use let to make a lexical scope:
(defun breadth (list y)
(let ((l y))
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element))))))
list)
l))
Then, instead of two nested when, use a single one and and:
(when (and (listp element)
(> (breadth element (length element)) 1))
(setf l (breadth element (length element))))
I find dolist more concise here:
(dolist (element list)
(when (and (listp element)
(> (breadth element (length element)) l))
(setf l (breadth element (length element)))))
The parameter y is always the length of the parameter list, so this call can be simplified. You also do not need to alias y:
(defun breadth (list &aux (y (length list)))
(dolist (element list)
(when (and (listp element)
(> (breadth element) y))
(setf y (breadth element))))
y)
You could eliminate the double recursive call through a let, but we can use max here:
(defun breadth (list &aux (y (length list)))
(dolist (element list)
(when (listp element)
(setf y (max y (breadth element)))))
y)
You could also use reduce for this:
(defun breadth (l)
(if (listp l)
(reduce #'max l
:key #'breadth
:initial-value (length l))
0))
L is not a local variable, so the function will return the last value assigned to it (ie, the breadth of the last subtree).
Use LET to declare a local variable:
(LET ((l y))
...
)
Isn't the correct answer 6? Since e and j in your example are also technically child nodes? If that's how you're defining your problem, the following solution should get you there:
(defun max-breadth (lst)
(cond
((atom lst) 0)
((every #'atom lst) (length lst))
(t (+ (max-breadth (car lst)) (max-breadth (cdr lst))))))
version 2:
(defun max-breadth (lst)
(cond
((atom lst) 0)
((every #'atom lst) (length lst))
(t (+
(max-breadth (car lst))
(max-breadth (remove-if-not #'consp (cdr lst)))))))