Just learning Common Lisp for a few days, but Professor had assigned an exercise for me. However, my code is not able to compile, Can anyone show me where I did wrong with my coding part?
(defun( MIN-2 a b)
(cond
((and (numberp a) (numberp b) (<= a b)) a b)
((and (numberp a) (numberp b) nil) ERROR)
)
)
Literal translation:
(defun min-2 (a b) ; Define a Lisp function MIN-2 … takes two arguments A and B
(cond ((and (every #'numberp (list a b)) (<= a b)) a) ; if … A <= B, returns A
((and (every #'numberp (list a b)) (> a b)) b) ; if … A > B, returns B
(t 'error) ; if A or B is not a number (i. e. “else”), returns ERROR
Improvement: check for numbers just once beforehand.
(defun min-2 (a b)
(cond ((not (every #'numberp (list a b))) 'error)
((<= a b) a)
((> a b) b)))
And please indent your code and don't leave the parentheses lying around.
Why your code fails
Can anyone show me where I did wrong with my coding part?
(defun( MIN-2 a b)
(cond
((and (numberp a) (numberp b) (<= a b)) a b)
((and (numberp a) (numberp b) nil) ERROR)
)
)
Let me reformat your code (auto-indent + compress parentheses):
(defun (MIN-2 a b) ;; << bad syntax, as already pointed out in another answer
(cond
((and (numberp a) (numberp b) (<= a b))
a
b)
((and (numberp a) (numberp b) nil)
ERROR)))
Let's fix the syntax of defun:
(defun MIN-2 (a b)
(cond
((and (numberp a) (numberp b) (<= a b))
a
b)
((and (numberp a) (numberp b) nil)
ERROR)))
Error (I am compiling the code under Emacs + SBCL):
Undefined variable: ERROR
Indeed, error is a free variable here. You need to quote it.
(defun MIN-2 (a b)
(cond
((and (numberp a) (numberp b) (<= a b))
a
b)
((and (numberp a) (numberp b))
'ERROR)))
Warning:
Deleting unreachable code (ERROR is underlined).
Indeed, the condition here is a and expression where at least one of the
expression is NIL, which means the conjunction is always false. The case can never happen, which is why the was optimized away.
Also, the first clause's test is:
(and (numberp a) (numberp b) (<= a b))
And the clause body is a followed by b, which means a is evaluated, its value discarded (it is never used), then b is evaluated and its value is the value of the cond expression: you always return b when both inputs are numbers such that a <= b.
Clearly, this is not what you should do. Other answers already covered good solutions.
Alternatives
I am also here to offer alternative, not necessarily homework-friendly answers:
Catch exceptions
(defun min-2 (a b)
(handler-case (if (<= a b) a b)
(error () 'error)))
Catch exceptions (bis)
(defun min-2 (a b)
(or (ignore-errors (if (<= a b) a b))
'error))
Use generic functions
(defgeneric min-2 (a b)
(:method ((a number) (b number)) (if (<= a b) a b))
(:method (a b) 'error))
You are using the wrong syntax for defining a function. Use defun function-name (args)
(defun MIN-2 (a b)
(cond
((and (numberp a) (numberp b) (<= a b)) a b)
((and (numberp a) (numberp b) nil) ERROR)
)
)
I think it's worth writing functions like this in a way which makes clear what is the sanity check and what is the actual computation. So in this case the sanity check is: 'are both arguments numbers?' and the computation is the comparison of them if they are. So separate these two things rather than bundling it all into one conditional:
(defun min-2 (a b)
(if (and (numberp a) (numberp b))
;; sanity check OK, so compare them
(if (<= a b)
a
b)
'error))
Unfortunately, of course, the sanity check is not adequate:
> (min-2 1 2)
1
> (min-2 1 'a)
error
> (min-2 1 #c(1 1))
Error: In <= of (1 #C(1 1)) arguments should be of type real.
Oops: what the sanity check should be is whether the two arguments are real numbers. Fortunately, there's a predicate for that, which is realp. So a correct version of min-2 is:
(defun min-2 (a b)
(if (and (realp a) (realp b))
;; sanity check OK, so compare them
(if (<= a b)
a
b)
'error))
Related
Exercise 11.22d of David Touretzky's "A Gentle Introduction to Symbolic Computation" states:
"[...] Write a function COUNT-BASES that
counts the number of bases of each type in a DNA strand, and returns
the result as a table. Your function should work for both single-and
double-stranded DNA. Example: (COUNT-BASES '((G C) (A T) (T A) (T A) (C G))) should return ((A 3) (T 3) (G 2) (C 2)), whereas
(COUNT-BASES '(A G T A C T C T)) should return ((A 2) (T 3) (G 1) (C 2)). [...]"
My solution:
(defun count-bases (strand)
(labels ((flatten (tree)
(cond
((atom tree) (list tree))
(t (append (flatten (car tree))
(and (cdr tree)
(flatten (cdr tree))))))))
(let ((flat-strand (flatten strand))
(cnt-list '((a 0) (t 0) (c 0) (g 0))))
(dolist (el flat-strand cnt-list)
(incf (cadr (assoc el cnt-list)))))))
So the idea is to first flatten STRAND and then count with assoc and incf.
The problem is that this somehow retains the state of cnt-list, like so:
(count-bases '((g c) (a t) (t a) (t a) (c g))) ;; ((A 3) (T 3) (C 2) (G 2))
(count-bases '((g c) (a t) (t a) (t a) (c g))) ;; ((A 6) (T 6) (C 4) (G 4))
;; etc
I am aware that incf is de/con-structive, nonetheless cnt-list should reset after the function returns, right?
You're modifying a quoted list which is undefined behavior. If you want to construct a list to modify, you should use (list ...) instead of '(...).
If you initialize cnt-list to (list (list 'a 0) (list 't 0) (list 'c 0) (list 'g 0)), it should work as intended.
One can call (copy-tree '((a 0) (t 0) (c 0) (g 0))) to get a tree with fresh cons cells.
I think that something Lisp people tend to do is to write over-general solutions to problems while not paying enough attention to domain knowledge.
Strands of DNA are, well, strands: they're chains of either bases or pairs of bases. No strand contains both single bases and pairs of bases. There are exactly four possible bases. There are exactly two possible base pairs.
So while it's nice to be able to treat a strand as a general tree and flatten it, it's not actually a very good approach: it deals with objects which are far more general than DNA strands actually are, and also almost certainly does not detect errors in the data its being asked to process.
And while it's nice to use an alist to record the counts, and it certainly will be useful when we need to deal with alien DNA with some large number of bases, it's not actually very useful in this case.
Furthermore both these techniques make the program much slower and much consier than it needs to be. (I have a suspicion one of the other answers also turns a linear problem into a quadratic one). And so of course the old myth that lisp is slow will be reinforced, again, and that helps no-one.
(And of course, we all know that alien DNA is DAG-structured, so the tree-flattening approach, which seems like it might be useful, will horribly double-count the bases.)
Here's a solution which relies on some domain knowledge, and also does some checking of the data it gets. You can call it with an optional 'be more fussy' argument which makes it be more fussy. It's longer than the clever/general answers, but, well. Inevitably it will have some idiot bug [it did].
(defun count-bases (strand &key (carefully nil))
(let ((adenine 0) (thymine 0) (guanine 0) (cytosine 0)
(double (consp (first strand))))
(dolist (base/pair strand `((a ,adenine)
(t ,thymine)
(g ,guanine)
(c ,cytosine)))
(typecase base/pair
(symbol
(when double
(error "horrible aliens ahavere eaten my brain"))
(case base/pair
((a) (incf adenine))
((t) (incf thymine))
((g) (incf guanine))
((c) (incf cytosine))
(otherwise (error "aliens have horribly eaten my brain"))))
(cons
(unless double
(error "aliens have eaten my horrible brain"))
(when carefully
(unless (member base/pair '((a t) (t a) (c g) (g c)) :test #'equal)
(error "horrible brains have eaten my alien")))
(case (first base/pair)
((a t) (incf adenine) (incf thymine))
((c g) (incf cytosine) (incf guanine))
(otherwise (error "brains have horribly eaten my alien"))))
(t
(error "brains have eaten my horrible alien"))))))
I want a predicate as a parameter of a function.
(DEFUN per (F L)
(cond ((F L) 'working)
(T 'anything)))
(per 'numberp 3)
as result it raises an error:
Undefined operator F in form (F L).
As explained in Technical Issues of Separation in Function Cells and Value Cells,
Common Lisp is a Lisp-2, i.e., you
need funcall:
(defun per (F L)
(if (funcall F L)
'working
'other))
(per #'numberp 3)
==> WORKING
(per #'numberp "3")
==> OTHER
See also apply.
Late to the party, but here's another example:
(defun strip-predicate (p list)
(cond ((endp list) nil)
((funcall p (first list)) (strip-predicate (rest list)))
( T (cons (first list) (strip-Predicate p (rest list))))))
This could be used on predicates such as atom or numberp:
(strip-predicate 'numberp '(a 1 b 2 c 3 d))
(a b c d)
or:
(strip-predicate 'atom '(a (a b) b c d))
((a b))
Preface: I'm currently taking a condensed course that is apparently taught in LISP and I've never worked with LISP in my life so I had to learn the language over a weekend. I apologize in advance for the abysmal code. I'm just familiar enough with LISP's syntax to get the code working and not much more.
I'm currently working on a program that solves the map coloring problem. This code takes a sequence where the first element of each sub sequence is a state and the second element represents a color. ex: '((A R) (B G) (C G) (D Y) (E B) (F B)) and then checks to make sure that no state has the same color as a state it's constrained by (defined by the constraint list). I know there are probably a lot of cleaner and simpler ways to do this but what I'm currently struggling with is having my dolist loops immediately return the value T whenever the if statement is met. So far I've been unable to get the functions to simply return a value and had to resort to this really ugly/wrong method of setting a variable to true and waiting for the loop to finish in order to make the code work. I've tried using return and just having T inside the if statements but, in both cases, the loop would finish instead of returning a value and I have no idea why.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (f s)
(setf ans nil)
(dolist (state constraint)
(if (eq (first state) f)
(if (search (list s) (second state))
(setf ans T) ;;where I want it to just return T
)
)
)
ans
)
;;ex: ((A R) (B R) (C B) (D R) (E B) (F G))
(defun check_conflict (lst)
(setf anb nil)
(dolist (state lst)
(dolist (neighbor (remove state lst))
(if (check_constraint (first state) (first neighbor))
(if (eq (second state) (second neighbor))
(setf anb T)) ;;where I want it to just return T
)
)
)
anb
)
EDIT: I ended up just fixing this with recursion. The code is cleaner now but I'd still love to know what my issue was. This is the recursive code.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (lst f s)
(COND
((null lst) nil)
((search (list (car (car lst))) f)
(if (search s (second (car lst))) T))
(t (check_constraint (cdr lst) f s))
)
)
(defun check_neighbor (check lst)
(COND
((null lst) nil)
((check_constraint constraint (list (car check)) (list (first (first lst))))
(if (eq (second check) (second (car lst))) T))
(t (check_neighbor check (cdr lst)))
)
)
;;(check_state '((A R) (B R) (C B) (D R) (E B) (F G)))
(defun check_state (lst)
(COND
((null lst) nil)
((check_neighbor (car lst) (cdr lst)) T)
(t (check_state (cdr lst)))
)
)
First a few style issues. You should use DEFVAR or DEFPARAMETER to declare global variables. Those should also have asterisks around the name to show that they are global (or special actually).
(defparameter *constraint*
'((A (B C E))
(B (A E F))
(C (A E F))
(D (F))
(E (A B C F))
(F (B C D E))))
The lisp convention for naming things is to use dashes between words (CHECK-CONSTRAINT instead of CHECK_CONSTRAINT). You should also prefer full words for variable names instead of abbreviations (LIST instead of LST). The closing parentheses should not be written on their own line.
Then the actual problem. You can use RETURN to return a value from a block named NIL. Loops establish such a block, so you can write the first function like
(defun check-constraint (first second)
(dolist (state *constraint*)
(when (and (eq first (first state))
(member second (second state)))
(return t))))
It's better to use WHEN instead of IF when there's only a then-branch. I also combined the two IFs into one using AND. Since you were wrapping S in a list for using SEARCH, I figured you probably want to use MEMBER instead (although I'm not sure since I don't exactly know what the code is supposed to do). You can change that back if it's wrong.
You probably could also simplify it to
(defun check-constraint (first second)
(member second (second (find first *constraint* :key #'first))))
In the second function you have two loops. If you use RETURN to return from the inner one, you just end up continuing the outer loop and ignoring the return value. So you have to use RETURN-FROM to return from the function instead of the inner loop.
(defun check-conflict (list)
(dolist (state list)
(dolist (neighbor (remove state list))
(when (and (check-constraint (first state) (first neighbor))
(eq (second state) (second neighbor)))
(return-from check-conflict t)))))
The Program is supposed to find each symbol in the List, that comes after a certain symbol.
The function gets to parameters passed in. A List which could contain nested-lists and a symbol.
The function has to scan thru the list and search for the given symbol and print the symbols that come after the given symbol.
Examples:
(find-all 'a '((b a) ((c a b)))) --> (c b)
(find-all 'a '(b (a a) c)) --> (a c)
(find-all 'a '(b d c e)) --> nil
My Code So Far:
(defun find-all (a list)
(if (consp list)
(if (consp (car list))
(find-all a (car list))
(if (eq a (car list))
(cons (car(cdr list)) (find-all a(cdr list)))
(find-all a(cdr list))))))
This code works except when the symbol its looking for is the last atom in the list.
it fails in these test cases:
(find-all 'a '((b a) ((c a b)))) --> (c b)
(find-all 'a '(b (a a) c)) --> (a c)
but works fine in these cases:
(find-all 'a '(b a c a e)) --> (c e)
The issue is probably at my cons statement and i am unable to fix this.
I don't think your code is correct. First of all, it's not correctly indented, which makes it difficult to read. The correct indentation should be:
(defun find-all (a list)
(if (consp list)
(if (consp (car list))
(find-all a (car list))
(if (eq a (car list)) ; if properly intended here
(cons (car(cdr list)) (find-all a(cdr list)))
(find-all a(cdr list)))))))))
Even after that I have trouble following your logic. For example, when something is a cons, then you should process both the car and the cdr, but you don't. I didn't go through the the debugging process, but you should.
Instead, I'd like to show you an alternative. I would suggest splitting the problem in 2 parts:
flattening the list
Since we start with a nested list but end up with a flat list, it's easier to flatten the list first. Here is a classical flatten function:
(defun flatten (sxp)
(labels
((sub (sxp res)
(cond
((null sxp) res)
((consp sxp) (sub (car sxp) (sub (cdr sxp) res)))
(t (cons sxp res)))))
(sub sxp nil)))
processing the flat list
Now, with a flat list, the rest becomes obvious, using the member function (and calling my function find-from to distinguish it from yours at the REPL):
(defun find-from (a lst)
(labels
((sub (lst)
(when lst
(let ((rst (cdr (member a lst))))
(when rst
(cons (car rst) (sub rst)))))))
(sub (flatten lst))))
testing
? (find-from 'a '((b a) ((c a b))))
(C B)
? (find-from 'a '(b (a a) c))
(A C)
? (find-from 'a '(b d c e))
NIL
? (find-from 'a '(b a c a e))
(C E)
I have a lisp homework I am having a hard time with it.
I have to write a function that perform a union operation. The function takes 2 inputs, either in the form of either atom or list and unions every element, preserving the order and stripping off all levels of parenthesis.
The output for the function:
(my-union 'a 'b) ;; (a b)
(my-union 'a '(b)) ;; (a b)
(my-union '(a b) '(b c)) ;; (a b c)
(my-union '(((a))) '(b(c((d e))a))) ;; (a b c d e)
I am fairly new to lisp.
Here is what I have written so far and it works only for the third example:
(defun new-union (a b)
(if (not b)
a
(if (member (car b) a)
(new-union a (cdr b))
(new-union (append a (list (car b))) (cdr b)))))
Any help would be appreciated!
Since this is your first homework, and you are new to Lisp, here is a very simple top-down approach, not worrying about performance, and making good use of the tools CL offers:
In Common Lisp, there is already a function which removes duplicates: remove-duplicates. Using it with the :from-end keyword-argument will "preserve order". Now, imagine you had a function flatten, which flattens arbitrarily nested lists. Then the solution to your question would be:
(defun new-union (list1 list2)
(remove-duplicates (flatten (list list1 list2)) :from-end t))
This is how I would approach the problem when no further restrictions are given, and there is no real reason to worry much about performance. Use as much of the present toolbox as possible and do not reinvent wheels unless necessary.
If you approach the problem like this, it boils down to writing the flatten function, which I will leave as an exercise for you. It is not too hard, one easy option is to write a recursive function, approaching the problem like this:
If the first element of the list to be flattened is itself a list, append the flattened first element to the flattened rest. If the first element is not a list, just prepend it to the flattened rest of the list. If the input is not a list at all, just return it.
That should be a nice exercise for you, and can be done in just a few lines of code.
(If you want to be very correct, use a helper function to do the work and check in the wrapping function whether the argument really is a list. Otherwise, flatten will work on atoms, too, which may or may not be a problem for you.)
Now, assuming you have written flatten:
> (defun new-union (list1 list2)
(remove-duplicates (flatten (list list1 list2)) :from-end t))
NEW-UNION
> (new-union 'a 'b)
(A B)
> (new-union 'a '(b))
(A B)
> (new-union '(a b) '(b c))
(A B C)
> (new-union '(((a))) '(b (c ((d e)) a)))
(A B C D E)
One way to approach this is to separate your concerns. One is flattening; another is duplicates-removing; yet another is result-building.
Starting with empty list as your result, proceed to add into it the elements of the first list, skipping such elements that are already in the result.
Then do the same with the second list's elements, adding them to the same result list.
(defun my-union (a b &aux (res (list 1)) (p res))
(nadd-elts p a)
(nadd-elts p b)
(cdr res))
nadd-elts would add to the end of list, destructively updating its last cell (pointed to by p) using e.g. rplacd. An example is here.
To add elements, nadd-elts would emulate the flattening procedure, and add each leaf element into p after checking res for duplicates.
Working in functional style, without destructive update, the general approach stays the same: start with empty result list, add first list into it - without duplicates - then second.
(defun my-union (a b &aux res)
(setq res (add-into res a))
(setq res (add-into res b))
res)
Now we're left with implementing the add-into function.
(defun add-into (res a &aux r1 r2)
(cond
((atom a) .... )
(T (setq r1 (add-into res (car a)))
(setq r2 (............ (cdr a)))
r2)))
The above can be re-written without the auxiliary variables and without set primitives. Try to find out how... OK here's what I meant by that:
(defun my-union (a b) (add-into NIL (cons a b)))
(defun add-into (res a)
(cond
((atom a) .... )
(T (add-into (add-into res (car a))
(cdr a)))))
Unless you are not allowed to use hash table (for some reason I've encountered this as a requirement before), you could come up with an ordering function that will help you build the resulting set in the way, that you don't have to repeat the search over and over again.
Also, since nested lists are allowed your problem scales down to only removing duplicates in a tree (as you can simply append as many lists as you want before you start processing them.
Now, I'll try to show few examples of how you could do it:
;; Large difference between best and worst case.
;; Lists containing all the same items will be processed
;; in square time
(defun union-naive (list &rest lists)
(when lists (setf list (append list lists)))
(let (result)
(labels ((%union-naive (tree)
(if (consp tree)
(progn
(%union-naive (car tree))
(when (cdr tree) (%union-naive (cdr tree))))
(unless (member tree result)
(setq result (cons tree result))))))
(%union-naive list) result)))
;; Perhaps the best solution, it is practically linear time
(defun union-hash (list &rest lists)
(when lists (setf list (append list lists)))
(let ((hash (make-hash-table)) result)
(labels ((%union-hash (tree)
(if (consp tree)
(progn
(%union-hash (car tree))
(when (cdr tree) (%union-hash (cdr tree))))
(setf (gethash tree hash) t))))
(%union-hash list))
(maphash
#'(lambda (a b)
(declare (ignore b))
(push a result)) hash)
result))
;; This will do the job in more time, then the
;; solution with the hash-map, but it requires
;; significantly less memory. Memory is, in fact
;; a more precious resource some times, but you
;; have to decide what algo to use based on the
;; data size
(defun union-flatten (list &rest lists)
(when lists (setf list (append list lists)))
(labels ((%flatten (tree)
(if (consp tree)
(if (cdr tree)
(nconc (%flatten (car tree))
(%flatten (cdr tree)))
(%flatten (car tree)))
(list tree))))
;; the code below is trying to do something
;; that you could've done using
;; (remove-duplicates (%flatten list))
;; however sorting and then removing duplicates
;; may prove to be more efficient
(reduce
#'(lambda (a b)
(cond
((atom a) (list a))
((eql (car a) b) b)
(t (cons b a))))
(sort (%flatten list)
#'(lambda (a b)
(string< (symbol-name a)
(symbol-name b)))))))
(union-naive '(((a))) '(b(c((d e))a)))
(union-hash '(((a))) '(b(c((d e))a)))
(union-flatten '(((a))) '(b(c((d e))a)))
Notice that the function I've used to order elements is not universal, but you would probably be able to come up with an alternative function for any sort of data. Any fast hashing function in general would do, I've used this one for simplicity.