Lisp use member through a list of lists - lisp

in common lisp I have a tree of symbols like:
(setf a '((shoe (walks(town)) (has-laces(snow)))
(tree (grows(bob)) (is-green(house)) (is tall(work)))))
all are symbols.
I want to return the sublist that contains the symbol I search for (in this case I might search using the symbol shoe and return the entire sublist in which they are contained. the keywords are always in the second layer never deeper
trying to use:
(mapcar #'member (shoe my-list))
but requires shoe to be a list (because of mapcar?) things got very convoluted after that. help please!

Given:
(setf a '((shoe (walks(town)) (has-laces(snow)))
(tree (grows(bob)) (is-green(house)) (is tall(work)))))
We can find the first (shoe ...) sublist like this:
(find 'shoe a :key #'car)
-> (SHOE (WALKS (TOWN)) (HAS-LACES (SNOW)))
I.e. search through the list of objects, which are lists, and use their car as the search key.
If there can be duplicates and we want a list of all of the sublists which start with shoe, then Common Lisp's standard library shows itself a bit clumsy. There isn't a nice function which finds all occurrences of an item; we resort to remove-if-not with a lambda:
(remove-if-not (lambda (x) (eq x 'shoe)) a :key #'car)
We can also write a loop expression:
(loop for (sym . rest) in a and
for whole in a
if (eq sym 'shoe) collect whole)
We can also make ourselves a quick and dirty find-all which can be invoked similarly to all:
(defun find-all (item sequence &key (key #'identity) (test #'eql))
(remove-if-not (lambda (elem) (funcall test item elem)) sequence :key key))
Then:
(find-all 'shoe a :key #'car)
--> ((SHOE (WALKS (TOWN)) (HAS-LACES (SNOW))))
(find-all 'x '((x 1) (y 2) (x 3) (z 4)) :key #'car)
--> ((X 1) (X 3))
(find 'x '((x 1) (y 2) (x 3) (z 4)) :key #'car)
--> ((X 1))

Related

What does gensym do in Lisp?

contextualization: I've been doing a university project in which I have to write a parser for regular expressions and build the corresponding epsilon-NFA. I have to do this in Prolog and Lisp.
I don't know if questions like this are allowed, if not I apologize.
I heard some of my classmates talking about how they used the function gensym for that, I asked them what it did and even checked up online but I literally can't understand what this function does neither why or when is best to use it.
In particular, I'm more intrested in what it does in Lisp.
Thank you all.
GENSYM creates unique symbols. Each call creates a new symbol. The symbol usually has a name which includes a number, which is counted up. The name is also unique (the symbol itself is already unique) with a number, so that a human reader can identify different uninterned symbols in the source code.
CL-USER 39 > (gensym)
#:G1083
CL-USER 40 > (gensym)
#:G1084
CL-USER 41 > (gensym)
#:G1085
CL-USER 42 > (gensym)
#:G1086
gensym is often used in Lisp macros for code generation, when the macro needs to create new identifiers, which then don't clash with existing identifiers.
Example: we are going to double the result of a Lisp form and we are making sure that the Lisp form itself will be computed only once. We do that by saving the value in a local variable. The identifier for the local variable will be computed by gensym.
CL-USER 43 > (defmacro double-it (it)
(let ((new-identifier (gensym)))
`(let ((,new-identifier ,it))
(+ ,new-identifier ,new-identifier))))
DOUBLE-IT
CL-USER 44 > (macroexpand-1 '(double-it (cos 1.4)))
(LET ((#:G1091 (COS 1.4)))
(+ #:G1091 #:G1091))
T
CL-USER 45 > (double-it (cos 1.4))
0.33993432
a little clarification of the existing answers (as the op is not yet aware of the typical common lisp macros workflow):
consider the macro double-it, proposed by mr. Joswig. Why would we bother creating this whole bunch of let? when it can be simply:
(defmacro double-it (it)
`(+ ,it ,it))
and ok, it seems to be working:
CL-USER> (double-it 1)
;;=> 2
but look at this, we want to increment x and double it
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> 5
;; WHAT? it should be 4!
the reason can be seen in macro expansion:
(let ((x 1))
(+ (setq x (+ 1 x)) (setq x (+ 1 x))))
you see, as the macro doesn't evaluate form, just splices it into generated code, it leads to incf being executed twice.
the simple solution is to bind it somewhere, and then double the result:
(defmacro double-it (it)
`(let ((x ,it))
(+ x x)))
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> 4
;; NICE!
it seems to be ok now. really it expands like this:
(let ((x 1))
(let ((x (setq x (+ 1 x))))
(+ x x)))
ok, so what about the gensym thing?
let's say, you want to print some message, before doubling your value:
(defmacro double-it (it)
`(let* ((v "DOUBLING IT")
(val ,it))
(princ v)
(+ val val)))
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> DOUBLING IT
;;=> 4
;; still ok!
but what if you accidentally name value v instead of x:
CL-USER> (let ((v 1))
(double-it (incf v)))
;;Value of V in (+ 1 V) is "DOUBLING IT", not a NUMBER.
;; [Condition of type SIMPLE-TYPE-ERROR]
It throws this weird error! Look at the expansion:
(let ((v 1))
(let* ((v "DOUBLING IT") (val (setq v (+ 1 v))))
(princ v)
(+ val val)))
it shadows the v from the outer scope with string, and when you are trying to add 1, well it obviously can't. Too bad.
another example, say you want to call the function twice, and return 2 results as a list:
(defmacro two-funcalls (f v)
`(let ((x ,f))
(list (funcall x ,v) (funcall x ,v))))
CL-USER> (let ((y 10))
(two-funcalls (lambda (z) z) y))
;;=> (10 10)
;; OK
CL-USER> (let ((x 10))
(two-funcalls (lambda (z) z) x))
;; (#<FUNCTION (LAMBDA (Z)) {52D2D4AB}> #<FUNCTION (LAMBDA (Z)) {52D2D4AB}>)
;; NOT OK!
this class of bugs is very nasty, since you can't easily say what's happened.
What is the solution? Obviously not to name the value v inside macro. You need to generate some sophisticated name that no one would reproduce in their code, like my-super-unique-value-identifier-2019-12-27. This would probably save you, but still you can't really be sure. That's why gensym is there:
(defmacro two-funcalls (f v)
(let ((fname (gensym)))
`(let ((,fname ,f))
(list (funcall ,fname ,v) (funcall ,fname ,v)))))
expanding to:
(let ((y 10))
(let ((#:g654 (lambda (z) z)))
(list (funcall #:g654 y) (funcall #:g654 y))))
you just generate the var name for the generated code, it is guaranteed to be unique (meaning no two gensym calls would generate the same name for the runtime session),
(loop repeat 3 collect (gensym))
;;=> (#:G645 #:G646 #:G647)
it still can potentially be clashed with user var somehow, but everybody knows about the naming and doesn't call the var #:GXXXX, so you can consider it to be impossible. You can further secure it, adding prefix
(loop repeat 3 collect (gensym "MY_GUID"))
;;=> (#:MY_GUID651 #:MY_GUID652 #:MY_GUID653)
GENSYM will generate a new symbol at each call. It will be garanteed, that the symbol did not exist before it will be generated and that it will never be generated again. You may specify a symbols prefix, if you like:
CL-USER> (gensym)
#:G736
CL-USER> (gensym "SOMETHING")
#:SOMETHING737
The most common use of GENSYM is generating names for items to avoid name clashes in macro expansion.
Another common purpose is the generaton of symbols for the construction of graphs, if the only thing demand you have is to attach a property list to them, while the name of the node is not of interest.
I think, the task of NFA-generation could make good use of the second purpose.
This is a note to some of the other answers, which I think are fine. While gensym is the traditional way of making new symbols, in fact there is another way which works perfectly well and is often better I find: make-symbol:
make-symbol creates and returns a fresh, uninterned symbol whose name is the given name. The new-symbol is neither bound nor fbound and has a null property list.
So, the nice thing about make-symbol is it makes a symbol with the name you asked for, exactly, without any weird numerical suffix. This can be helpful when writing macros because it makes the macroexpansion more readable. Consider this simple list-collection macro:
(defmacro collecting (&body forms)
(let ((resultsn (make-symbol "RESULTS"))
(rtailn (make-symbol "RTAIL")))
`(let ((,resultsn '())
(,rtailn nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null ,rtailn)
(setf ,resultsn new
,rtailn new)
(setf (cdr ,rtailn) new
,rtailn new)))
it))
,#forms
,resultsn))))
This needs two bindings which the body can't refer to, for the results, and the last cons of the results. It also introduces a function in a way which is intentionally 'unhygienic': inside collecting, collect means 'collect something'.
So now
> (collecting (collect 1) (collect 2) 3)
(1 2)
as we want, and we can look at the macroexpansion to see that the introduced bindings have names which make some kind of sense:
> (macroexpand '(collecting (collect 1)))
(let ((#:results 'nil) (#:rtail nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null #:rtail)
(setf #:results new #:rtail new)
(setf (cdr #:rtail) new #:rtail new)))
it))
(collect 1)
#:results))
t
And we can persuade the Lisp printer to tell us that in fact all these uninterned symbols are the same:
> (let ((*print-circle* t))
(pprint (macroexpand '(collecting (collect 1)))))
(let ((#2=#:results 'nil) (#1=#:rtail nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null #1#)
(setf #2# new #1# new)
(setf (cdr #1#) new #1# new)))
it))
(collect 1)
#2#))
So, for writing macros I generally find make-symbol more useful than gensym. For writing things where I just need a symbol as an object, such as naming a node in some structure, then gensym is probably more useful. Finally note that gensym can be implemented in terms of make-symbol:
(defun my-gensym (&optional (thing "G"))
;; I think this is GENSYM
(check-type thing (or string (integer 0)))
(let ((prefix (typecase thing
(string thing)
(t "G")))
(count (typecase thing
((integer 0) thing)
(t (prog1 *gensym-counter*
(incf *gensym-counter*))))))
(make-symbol (format nil "~A~D" prefix count))))
(This may be buggy.)

multiplying each element of a list with each element of another list in lisp

i want to write a function that accepts 2 lists as argument and return multiplication of them in a list.
like this:
(3 4) (3 5 6) => (9 15 18 12 20 24)
this is the code that i've came up with but i receive an error which is telling me that i have too few arguments for map.
(defun multip (lst lst2)
;this is a function to flatten the result
(defun flatten (tree)
(let ((result '()))
(labels ((scan (item)
(if (listp item)
(map nil #'scan item)
(push item result))))
(scan tree))
(nreverse result)))
(flatten (map (lambda (i) (map (lambda (j) (* i j)) lst )) lst2))
)
(write (multip '(3 4 6) '(3 2) ))
i can not understand what am i doing wrong. i appreciate your comment.
You don't need to flatten the list, if you create a flat list.
Use MAPCAN:
CL-USER 4 > (flet ((mult (a b)
(mapcan #'(lambda (a1)
(mapcar (lambda (b1) (* a1 b1))
b))
a)))
(mult '(3 4) '(3 5 6)))
(9 15 18 12 20 24)
You should use mapcar instead of map:
(mapcar (lambda (i) (mapcar (lambda (j) (* i j)) lst )) lst2))
These are two different functions: mapcar maps a function on one or more lists, and requires at least two arguments, while map is the equivalent but for any kind of sequences (e.g. vectors), and requires an additional argument specifying the type of the result. See the reference for map here, and the reference for mapcar here.
Style
You are using a defun inside another defun: this is not good style, since every time multip is called it redefines globally the function flatten. You should either define flatten externally, only once, or use a local declaration of function with flet or labels (as for the internal function scan inside flatten.)
For alternative and more simple definitions of flatten, you can see this question in SO.

LISP - count occurences of every value in a list

I apologize for the bad English..
I have a task to write a function called "make-bag" that counts occurences of every value in a list
and returns a list of dotted pairs like this: '((value1 . num-occurences1) (value2 . num-occurences2) ...)
For example:
(make-bag '(d c a b b c a))
((d . 1) (c . 2) (a . 2) (b . 2))
(the list doesn't have to be sorted)
Our lecturer allows us to us functions MAPCAR and also FILTER (suppose it is implemented),
but we are not allowed to use REMOVE-DUPLICATES and COUNT-IF.
He also demands that we will use recursion.
Is there a way to count every value only once without removing duplicates?
And if there is a way, can it be done by recursion?
First of, I agree with Mr. Joswig - Stackoverflow isn't a place to ask for answers to homework. But, I will answer your question in a way that you may not be able to use it directly without some extra digging and being able to understand how hash-tables and lexical closures work. Which in it's turn will be a good exercise for your advancement.
Is there a way to count every value only once without removing duplicates? And if there is a way, can it be done by recursion?
Yes, it's straight forward with hash-tables, here are two examples:
;; no state stored
(defun make-bag (lst)
(let ((hs (make-hash-table)))
(labels ((%make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(%make-bag (cdr lst)))
hs)))
(%make-bag lst))))
Now, if you try evaluate this form twice, you will get the same answer each time:
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
And this is a second example:
;; state is stored....
(let ((hs (make-hash-table)))
(defun make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(make-bag (cdr lst)))
hs)))
Now, if you try to evaluate this form twice, you will get answer doubled the second time:
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 5
> T
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 10
> T
Why did the answer doubled?
How to convert contents of a hash table to an assoc list?
Also note that recursive functions usually "eat" lists, and sometimes have an accumulator that accumulates the results of each step, which is returned at the end. Without hash-tables and ability of using remove-duplicates/count-if, logic gets a bit convoluted since you are forced to use basic functions.
Well, here's the answer, but to make it a little bit more useful as a learning exercise, I'm going to leave some blanks, you'll have to fill.
Also note that using a hash table for this task would be more advantageous because the access time to an element stored in a hash table is fixed (and usually very small), while the access time to an element stored in a list has linear complexity, so would grow with longer lists.
(defun make-bag (list)
(let (result)
(labels ((%make-bag (list)
(when list
(let ((key (assoc (car <??>) <??>)))
(if key (incf (cdr key))
(setq <??>
(cons (cons (car <??>) 1) <??>)))
(%make-bag (cdr <??>))))))
(%make-bag list))
result))
There may be variations of this function, but they would be roughly based on the same principle.

Lisp recursion with lists

I need a function that will take in a list with words and split that list into two lists if at any point the word 'FOO' is found. I have come up with a recursive solution, may not be the best, but I am having a bit of trouble. I only need to pass 1 argument, the list to be analyzed, but I do not know how to build up the second list off to the side. Any suggestions? Thanks!
;Splits a list into 2 if the word 'FOO' is present
;----------------------------------------------------------------------
;LOAD FILE: (load "C:\\split.lisp")
;USAGE: (split '(with great power foo comes great responsibility) '())
;OUTPUT: ((with great power)(comes great responsibility))
(defun split (x y)
(cond
( ;IF: first element in list is nil
(EQ (car x) nil)
x ;RETURN the list
)
( ;ELSE IF: first element is 'FOO'
(EQ (car x) 'FOO)
(cons (reverse y ) (cons (cdr x) nil))
)
( ;ELSE: recursively call split but pass the rest of x and
;prepend y with the head of x
t
(split (cdr x) (cons (car x) y))
)
) ;END cond
) ;END split
The first test should be different.
The following is not a really good solution: it is not tail-recursive and it uses side-effects. But still...
(defun split (x)
(cond ((null x) x)
((eq (first x) 'foo)
(list nil (rest x)))
(t (let ((l (split (rest x))))
(push (first x) (first l))
l))))
Above uses the PUSH macro. One of the interesting facilities of Common Lisp is that you can use places to modify. In this cases we modify the first sublist of our list to be returned. We push the first element of the list onto the first sublist.
CL-USER 12 > (split '(1 2 3 foo a b c))
((1 2 3) (A B C))
In Common Lisp one would usually write a solution in a non-recursive fashion.
In your recursive version, the typical way to reduce a function to one argument is this: Write the function with one argument and this function then calls a helper function with two arguments. The helper function can also be locally defined using LABELS.
Here's my take on it, using nothing but lists:
(defun split (lst)
(labels ((split-rec (lst a)
(cond
((or (null lst)
(eq (car lst) 'foo))
(values (reverse a) (cdr lst)))
(t (split-rec (cdr lst) (cons (car lst) a))))))
(split-rec lst ())))
split offloads most of the work to split-rec (defined in the labels call), which recursively consumes the list of tokens, until it reaches the end of the list, or sees 'foo. At that point, it immediately takes the remainder of the list and treats that as the second list. Because the first list (a) is being built-up recursively, split-rec has to reverse it before returning it.
Here are a couple of runs through the REPL:
> (split '(with great power foo comes great responsibility))
(WITH GREAT POWER) ;
(COMES GREAT RESPONSIBILITY)
> (split '(with great power comes great responsibility))
(WITH GREAT POWER COMES GREAT RESPONSIBILITY) ;
NIL
> (split nil)
NIL ;
NIL
> (split '(with great power foo comes great foo responsibility) :on 'foo)
(COMES GREAT) ;
(WITH GREAT POWER RESPONSIBILITY)
> (split '(foo with great power comes great responsibility) :on 'foo)
NIL ;
(WITH GREAT POWER COMES GREAT RESPONSIBILITY)
Most of the edge cases that I could think up are handled, and two lists are always returned. Callers can use multiple-value-bind to get both lists out, i.e.:
(multiple-value-bind (a b)
(split '(with great power foo comes great responsibility))
; do something useful with a and b
)
(defun split (lst)
(let* ((a (make-array (length lst) :initial-contents lst))
(index (position 'foo a)))
(cond ((null index) a)
(t (cons (loop for i from 0 to (1- index)
collect (aref a i))
(list (loop for i from (1+ index) to (1- (length a))
collect (aref a i))))))))
Create an array from the list so that there elements are easier to access.
Check if foo exists, if it does mark the index
Use loop to create two lists, one of the elements before foo, and another one of the elements after foo, and cons them together.
Here I've also tried! :)
There's one thing you would want to clarify though: in corner cases like: foo is the first element of the list, should you return two lists or only the second one? If foo is the last element in the list, should you return list and nil or only the first list? If foo isn't in the list, should you return just the list, or list and nil / nil and list?
(defun split (list &key (on-symbol 'foo))
(let (result result-head)
(mapl
#'(lambda (a)
(if (eql (car a) on-symbol)
(return-from split
(if result
(values result (copy-list (cdr a)))
(copy-list (cdr a))))
(if result
(setf (cdr result-head) (list (car a))
result-head (cdr result-head))
(setf result (list (car a))
result-head result)))) list) result))
(split '(1 2 3 4 5 foo a b c))
(split '(foo 1 2 3 4 5 foo a b c))
(split '(1 2 3 4 5 a b c))

How to replace the number in a nested list with symbols?

It seems that I have to make it in detail; it's my homework. I don't
want to copy the code written by you. I'm a newbie; what I'm trying
to learn is how to decompose a subject to single pieces, and then
focus on what function should I use to solve the problem. It's a
little hard to finish these problems by my own, because I'm completely
a newbie in Lisp, actually in how to program. I hope you can help me
out.
Here is the problem: there is a given constant
(defconstant *storms* '((bob 65)
(chary 150)
(jenny 145)
(ivan 165)
(james 120)))
Each storm is represented by a list of its name and its wind speed.
The wind speeds are to be categorized as follows:
39–74 → tropical
75–95 → cat-1
96–110 → cat-2
111–130 → cat-3
131–155 → cat-4
156 or more → cat-5
Now I have to write two functions:
storm-categories should generate category names, like this: (bob
tropical), (chary cat-1), …
and storm-distribution should generate the number of storms in
each category, like this: (cat-1 1), (cat-2 0), …
The way I try to solve this problem is:
Use if statements to judge the type of windspeed:
(if (and (> x 39) (< x 73)) (print 'tropical))
(if (and (> x 74) (< x 95)) (print 'cat-1))
(if (and (> x 96) (< x 110)) (print 'cat-2))
(if (and (> x 111) (< x 130)) (print'cat-3))
(if (and (> x 131) (< x 155)) (print'cat-4))
(if (and (> x 156)) (print 'cat-5))
Replace the windspeed (like 65) with windtype (like cat-1)
(loop for x in storms
do (rplacd x ‘windtype)
I just have a simple idea of the first function, but still don't know
how to implement it. I haven't touched the distribution function,
because I am still stuck on the first one.
DEFCONSTANT is wrong. It makes no sense to make your input a constant. A variable defined with DEFVAR or DEFPARAMETER is fine.
Instead of IF use COND. COND allows the testing of several conditions.
You don't want to use PRINT. Why print something. You want to compute a value.
RPLACA is also wrong. That's used for destructive modification. You don't want that. You want to create a new value. Something like RPLACA might be used in the function DISTRIBUTION (see below).
Use functional abstraction. Which functions are useful?
BETWEEN-P, is a value X between a and b ?
STORM-CATEGORY, for a given wind speed return the category
STORM-CATEGORIES, for a list of items (storm wind-speed) return a list of items (storm category). Map over the input list to create the result list.
DISTRIBUTION, for a list of items (tag category) return a list with items (category number-of-tags-in-this-category).
STORM-DISTRIBUTION, for a list of items (storm category) return a list with items (category number-of-storms-in-this-category). This basically calls DISTRIBUTION with the right parameters.
The function DISTRIBUTION is the most complicated of the above. Typically one would use a hashtable or a assoc list as an intermediate help to keep a count of the occurrences. Map over the input list and update the corresponding count.
Also: a good introduction into basic Lisp is the book Common Lisp: A Gentle Introduction to Symbolic Computation - it is freely available as a PDF for download. A more fun and also basic introduction to Lisp is the book Land of Lisp.
Okay roccia, you have posted your answer. Here comes mine hacked in a few minutes, but it should give you some ideas:
First let's start with the data:
(defparameter *storms2004*
'((BONNIE 65)
(CHARLEY 150)
(FRANCES 145)
(IVAN 165)
(JEANNE 120)))
(defparameter *storm-categories*
'((39 73 tropical-storm)
(74 95 hurricane-cat-1)
(96 110 hurricane-cat-2)
(111 130 hurricane-cat-3)
(131 155 hurricane-cat-4)
(156 nil hurricane-cat-5)))
A function that checks if a value is between two bounds. If the right bound can also be missing (NIL).
(defun between (value a b)
(<= a value (if b b value)))
Note that Lisp allows the comparison predicate with more than two arguments.
Let's find the category of a storm. The Lisp functions FIND and FIND-IF find things in lists.
(defun storm-category (storm-speed)
(third (find-if (lambda (storm)
(between storm-speed (first storm) (second storm)))
*storm-categories*)))
Let's compute the category for each storm. Since we get a list of (storm wind-speed), we just map over the function which computes the category over the list. We need to return a list of storms and category.
(defun storm-categories (list)
(mapcar (lambda (storm)
(list (first storm)
(storm-category (second storm))))
list))
Now we take the the same list of storms, but use a hash table to keep track of how many storms there were in each category. MAPC is like MAPCAR, but only for the side effect of updating the hash table. ÌNCF increments the count. When we have filled the hash table, we need to map over it with MAPHASH. For each pair of key and value in the table, we just push the pair onto a result list and then we are returning that result.
(defun storm-distribution (storms)
(let ((table (make-hash-table)))
(mapc (lambda (storm)
(incf (gethash (second storm) table 0)))
(storm-categories storms))
(let ((result nil))
(maphash (lambda (key value)
(push (list key value) result))
table)
result)))
Test:
CL-USER 33 > (storm-category 100)
HURRICANE-CAT-2
CL-USER 34 > (storm-categories *storms2004*)
((BONNIE TROPICAL-STORM)
(CHARLEY HURRICANE-CAT-4)
(FRANCES HURRICANE-CAT-4)
(IVAN HURRICANE-CAT-5)
(JEANNE HURRICANE-CAT-3))
CL-USER 35 > (storm-distribution *storms2004*)
((HURRICANE-CAT-5 1)
(HURRICANE-CAT-4 2)
(HURRICANE-CAT-3 1)
(TROPICAL-STORM 1))
Looks fine to me.
Finally finished this problem. the second part is really makes me crazy. I cant't figure out how to use hashtable or assoc list to slove it. Anyway the assignment is done, but I want to know how can I simplify it... Hope u guys can help me . Thanks for your help Joswing, your idea really helps me a lot...
(defconstant *storms2004* '((BONNIE 65)(CHARLEY 150)(FRANCES 145)(IVAN 165)(JEANNE 120)))
(defun storm-category (x) ; for given windspeed return the category
(cond
((and (> x 39) (< x 73) 'tropical-storm))
((and (> x 74) (< x 95) 'hurricane-cat-1))
((and (> x 96) (< x 110) 'hurricane-cat-2))
((and (> x 111) (< x 130) 'hurricane-cat-3))
((and (> x 131) (< x 155) 'hurricane-cat-4))
( t 'hurricane-cat-5)
)
);end storm-category
(defun storm-categories (lst) ;for a list of storm and windspeed return storm's name and wind type
(let ((result nil))
(dolist (x lst (reverse result)) ;
(push
(list (first x) (storm-category (second x)) ) result)
)
)
);end storm-categories
(defun storm-distribution (lst)
(setq stormcategories '(tropical-storm hurricane-cat-1 hurricane-cat-2 hurricane-cat-3 hurricane-cat-4 hurricane-cat-5))
(setq stormlist (storm-categories lst))
(let( (tropicalcount 0)
(hurricane-cat-1count 0)
(hurricane-cat-2count 0)
(hurricane-cat-3count 0)
(hurricane-cat-4count 0)
(hurricane-cat-5count 0)
(result nil)
)
(dolist (y stormlist )
(cond
((eql (second y) 'tropical-storm) (setq tropicalcount (+ tropicalcount 1)))
((eql (second y) 'hurricane-cat-1) (setq hurricane-cat-1count (+ hurricane-cat-1count 1)))
((eql (second y) 'hurricane-cat-2) (setq hurricane-cat-2count (+ hurricane-cat-2count 1)))
((eql (second y) 'hurricane-cat-3) (setq hurricane-cat-3count (+ hurricane-cat-3count 1)))
((eql (second y) 'hurricane-cat-4) (setq hurricane-cat-4count (+ hurricane-cat-4count 1)))
((eql (second y) 'hurricane-cat-5)(setq hurricane-cat-5count (+ hurricane-cat-5count 1)))
)
);ebd dolist
(push
(list (list 'tropicalstorm tropicalcount )
(list 'hurricane-cat-1 hurricane-cat-1count)
(list 'hurricane-cat-2 hurricane-cat-2count )
(list 'hurricane-cat-3 hurricane-cat-3count )
(list 'hurricane-cat-4 hurricane-cat-4count )
(list 'hurricane-cat-5 hurricane-cat-5count )
) ;end list
result) ;end push
);end let
);end distribution