This posting is mainly for people who have access to Paul Grahams book
"ANSI Common Lisp". In chapter 3 he gave among other things these two tasks:
1. Writing a new version of union that preserves the order of the
elements in the original lists
2. A function that counts occurrences of elements that are (eql) to each
other
Please make suggestions how to improve my solutions.
To exercise 1. my first idea was this:
(defun new-union-old (list1 list2)
(if (eql list2 nil)
list1
(let ((l1 list2)
(l2 (reverse list1)))
(if (member (car l1) l2)
(new-union-old (reverse l2) (cdr l1))
(new-union-old (reverse (cons (car l1) l2)) (cdr l1))))))
I forgot the append function, so I had to built new-union-old without
it. My idea was to let new-union-old swap my lists and reverse the first
one. So (new-union-old '(a b c d) '(c d e f)) becomes internally to a
comparison between (c d e f) and (d c b a).
This way I can cons the car of my second list (c d e f) to my reversed
first list (a b c d) and don't worry about the original order.
When I cons the 'e to (d c b a) it becomes (e d c b a) and reversed the
right solution (a b c d e).
But then I found append, yeah :)
It was also in this chapter so I was allowed to use it:
(defun new-union (list1 list2)
(if (null list2)
list1
(if (member (car list2) list1)
(new-union list1 (cdr list2))
(new-union (append list1 (list (car list2))) (cdr list2)))))
Look at the difference:
CL-USER 3 > (time (dotimes (x 1000000) (new-union-old '(a b c d e f g)
'(h i a j e e k e l))))
Timing the evaluation of (DOTIMES (X 1000000) (NEW-UNION-OLD (QUOTE (A B
C D E F G)) (QUOTE (H I A J E E K E L))))
user time = 22.592
system time = 0.030
Elapsed time = 0:00:23
Allocation = 2696 bytes standard / 1991003212 bytes conses
0 Page faults
Calls to %EVAL 3000035
NIL
compared to the "append-version":
CL-USER 4 > (time (dotimes (x 1000000) (new-union '(a b c d e f g) '(h i
a j e e k e l))))
Timing the evaluation of (DOTIMES (X 1000000) (NEW-UNION (QUOTE (A B C D
E F G)) (QUOTE (H I A J E E K E L))))
user time = 13.369
system time = 0.020
Elapsed time = 0:00:13
Allocation = 2712 bytes standard / 561003223 bytes conses
0 Page faults
Calls to %EVAL 1188180
NIL
Is there a way to improve it even more with
a) only using the functions of the first 3 chapters in the book
b) with all power and tricks you can get from CL?
And to exercise 2.:
(defun occurrences (list)
(let ((result nil))
(dolist (element list)
(if (not (member element result :key #'car))
(let ((count 0))
(dolist (obj list)
(if (eql obj element)
(setf count (+ count 1))))
(setf result (cons (cons element count) result)))))
(sort result (lambda (x y) (> (cdr x) (cdr y))))))
I don't know how to avoid the setf's. Any suggestions?
Again with
a) only functions of the first three chapters
b) using all CL offers
Regards,
Andr�
Hi,
I'm usually a passive reader of c.l.l, but now I
think I can help.
Here go my solutions to these problems, though I'm
no expert in Common Lisp. I just read ACL some time
ago, working through the exercises.
> 1. Writing a new version of union that preserves the order of the
> elements in the original lists
My solution assumes there are no repeated elements in the lists.
I guess this is correct since these lists are representing sets:
(defun new-union (a b)
;; we assume a has no repeated elements
(let ((tmp (reverse a)))
(dolist (obj b)
(setf tmp (adjoin obj tmp)))
(reverse tmp)))
>
> 2. A function that counts occurrences of elements that are (eql) to each
> other
>
(defun ocurrences (lst)
(sort (ocurrences-aux lst) #'> :key #'cdr))
(defun ocurrences-aux (lst)
(if (null lst)
NIL
(let ((lwc (remove (car lst) lst)))
(let ((hm (- (length lst) (length lwc))))
(cons (cons (car lst) hm) (ocurrences-aux lwc))))))
I guess both functions could be greatly improved...
Hope this helps.
Jordi
Andr� Thieme wrote:
> 1. Writing a new version of union that preserves the order of the
> elements in the original lists
>
Here's a pretty straightforward version:
(defun union (A B)
(cond ((null A) B)
((member (car A) B) (union (cdr A) B))
(t (cons (car A) (union (cdr A) B)))) )
Unfortunately, this doesn't completely satisfy Graham's requirements.
(Plus COND isn't introduced until ch. 5)
I found my solution to this exercise and it's essentially the same as yours.
Here are a couple more variants:
(defun new-union3 (a b)
(dolist (elt b a)
(unless (member elt a)
(setf a (append a (list elt)))) ))
(defun new-union4 (a b)
(let ((union (reverse a)))
(dolist (elt b (reverse union))
(unless (member elt a)
(push elt union)))) )
I wrote some stuff about sets and recursion awhile ago:
http://66.91.184.215/sets/sets.html
I should reread it to see if it still makes sense...
David Sletten
David Sletten <·····@slytobias.com> wrote in message news:<···················@twister.socal.rr.com>...
> Andr� Thieme wrote:
>
> > 1. Writing a new version of union that preserves the order of the
> > elements in the original lists
> >
> Here's a pretty straightforward version:
>
> (defun union (A B)
> (cond ((null A) B)
> ((member (car A) B) (union (cdr A) B))
> (t (cons (car A) (union (cdr A) B)))) )
>
> Unfortunately, this doesn't completely satisfy Graham's requirements.
Correct, since his one example is (union '(a b c) '(b a d)) => '(a b c
d) which clearly implies that the first list dominates in defining the
ordering. That seems reasonable to me but makes the problem harder for
union (not for intersection or set-difference though).
> (Plus COND isn't introduced until ch. 5)
It's trivial to replace COND with IF but all this does is promote bad
programming practice. Graham should've introduced COND along with IF.
>
> I found my solution to this exercise and it's essentially the same as yours.
>
> Here are a couple more variants:
> (defun new-union3 (a b)
> (dolist (elt b a)
> (unless (member elt a)
> (setf a (append a (list elt)))) ))
This does N-squared CONSes to construct a final result N long.
Definitely NOT the way to go.
Yet another solution is to first define stable-set-difference, which
doesn't have the same difficulties union does. Then stable-union
follows fairly simply.
"Andr� Thieme" <······································@justmail.de> wrote in
message ·················@ulric.tng.de...
> And to exercise 2.:
> (defun occurrences (list)
> (let ((result nil))
> (dolist (element list)
> (if (not (member element result :key #'car))
> (let ((count 0))
> (dolist (obj list)
> (if (eql obj element)
> (setf count (+ count 1))))
> (setf result (cons (cons element count) result)))))
> (sort result (lambda (x y) (> (cdr x) (cdr y))))))
>
>
> I don't know how to avoid the setf's. Any suggestions?
Why do you want to avoid the setf's?
I would probably do something like this (not tested):
(defun occurrences (list)
(let ((table '()))
(dolist (element list)
(let ((element-occurrences (assoc element table)))
(if (null element-occurrences)
(push (cons element 1) table)
(incf (cdr element-occurrences)))))
(sort table #'> :key #'cdr)))
I just found an old thread about this, and an elegant solution
was given by Kent Pitman:
(defun occurrences (list &key (test #'eql))
(let ((alist '()))
(dolist (item list)
(incf (cdr (or (assoc item alist :test test)
(let ((entry (cons item 0)))
(push entry alist)
entry)))))
(sort alist #'> :key #'cdr)))
Note: those run in O(n^2), a solution using a hashtable instead
of an alist would run in O(n).
--
Matthieu Villeneuve
Andr� Thieme <······································@justmail.de> writes:
> This posting is mainly for people who have access to Paul Grahams book
> "ANSI Common Lisp". In chapter 3 he gave among other things these two
> tasks:
>
> 1. Writing a new version of union that preserves the order of the
> elements in the original lists.
What does that mean? What if A is before B in the first, but B is
before A in the second?
Here's a version that attempts to minimize the amount of shuffling:
(defun stable-union (left right)
"Return the union of left and right preserving order as much as
possible. We assume that left and right have no duplicates."
(cond ((null left) right)
((null right) left)
(t (let ((l1 (car left))
(r1 (car right)))
(if (eql l1 r1)
(cons l1 (stable-union (cdr left) (cdr right)))
;; If the heads of the lists are different,
;; search the other list to find the positions.
;; We may have to move one, so we want to minimize
;; the distance.
(let ((probe-l (position l1 (cdr right))))
(if (null probe-l) ;; l1 is not in right, insert it
(cons l1 (stable-union (cdr left) right))
(let ((probe-r (position r1 (cdr left))))
(cond ((null probe-r)
(cons r1 (stable-union left (cdr right))))
((< probe-l probe-r)
(cons l1 (stable-union (cdr left) (remove l1 right))))
(t
(cons r1 (stable-union (remove r1 left) (cdr right)))))))))))))
--
~jrm
Joe Marshall <·············@comcast.net> writes:
> Andr� Thieme <······································@justmail.de> writes:
>
>> This posting is mainly for people who have access to Paul Grahams book
>> "ANSI Common Lisp". In chapter 3 he gave among other things these two
>> tasks:
>>
>> 1. Writing a new version of union that preserves the order of the
>> elements in the original lists.
>
> What does that mean? What if A is before B in the first, but B is
> before A in the second?
>
> Here's a version that attempts to minimize the amount of shuffling:
[snipped]
Grr. I should've thought harder. A stable-union function that
minimizes shuffling of elements would have to work like 2-file merging
in a diff. It's doable, but it isn't trivial by any means.
--
~jrm
Andr� Thieme wrote:
(defun occurrences (list)
(let ((result nil))
(dolist (element list)
(if (not (member element result :key #'car))
(let ((count 0))
(dolist (obj list)
(if (eql obj element)
(setf count (+ count 1))))
(setf result (cons (cons element count) result)))))
(sort result (lambda (x y) (> (cdr x) (cdr y))))))
I don't know how to avoid the setf's. Any suggestions?
I offer suggestions of two different kinds:
Pragmatically, one would use incf and push instead of setf
(setf number (+ number 1)) == (incf number)
(setf list (cons object list)) == (push object list)
Artistically, one is interested in learning to write
the traditional "New Orleans" style Lisp, that was so
popular in the 1920's. It looks like this:
(defun trad-count (symbol start list)
"'a 0 '(a b a d a c d c a) => (A . 4)"
(cond ((endp list)
(cons symbol start))
((eq symbol (car list)) ; found another one
(trad-count symbol
(+ start 1) ; instead of incf
(cdr list)))
(t (trad-count symbol start (cdr list)))))
(defun find-types (tokens types)
"'(a b a d a c d c a) '() => (C D B A)"
(cond ((endp tokens) types)
((member (car tokens) types) ; seen it before
(find-types (cdr tokens) types))
(t (find-types (cdr tokens)(cons (car tokens) types)))))
(defun multi-count (types tokens)
"'(a e) '(a b a d a c d c a) => ((A . 4) (E . 0))"
(if (endp types) '()
(cons ; instead of push
(trad-count (car types) 0 tokens)
(multi-count (cdr types) tokens))))
(defun occurrences (list)
(sort (multi-count (find-types list '())
list)
#'> :key #'cdr))
The core of the style is
(defun function ( arguments )
(cond (test1 code1)
(test2 code2)
(test3 code3)))
the tests analyse the arguments and call the appropriate
code. The code always has the form
(constructor (function-1 (destructor-1 arguments))
(function-2 (destructor-2 arguments)))
that is to say, one is always building the return value by
breaking up the arguments, doing one step of processing, and
putting them back together in a new way.
It is an important style to master, because there are
certain programming challenges, involving recursion, that
yield easily to the discipline of the New Orleans style, but
which become mired in confusion if attempted in a freer,
be-bop style.
On the other hand I am careful to locate the style in a
mythical past. There is an unhappy history of the
style being taught as the one true way to program in Lisp,
even though it is a rather clumsy style for day
to day programming. For example, all my routines get reduced
to one liners by using CL's built-in functions.
(defun trad-count-CL (symbol start list)
(declare (ignore start))
(cons symbol (count symbol list)))
(defun find-types-CL(tokens types)
(declare (ignore types))
(remove-duplicates tokens))
(defun multi-count-CL (types tokens)
(loop for x in types collect (trad-count-CL x 0 tokens)))
(defun occurrences-CL (list)
(sort (multi-count-CL (find-types-CL list '())
list)
#'> :key #'cdr))
leading to
(defun occurrences-CL-condensed (list)
(sort (loop for x in (remove-duplicates list)
collect (cons x (count x list)))
#'> :key #'cdr))
Alan Crowe
Edinburgh
Scotland
P.S. Every-one else refers to the New Orleans style by different and
even less helpful name, redolent of "us" versus "them" rather
than Baroque versus Romantic.
Alan Crowe <····@cawtech.freeserve.co.uk> wrote in message news:<··············@cawtech.freeserve.co.uk>...
> P.S. Every-one else refers to the New Orleans style by different and
> even less helpful name, redolent of "us" versus "them" rather
> than Baroque versus Romantic.
I think that it's really known as the `12 bar boogie' or occasionally
`status quo' style: 12 bars, three chords, one rhythm, keys of E, A, D
strongly preferred, G or C possible, no change or development beyond
these constraints is allowed or really conceivable. `New Orleans'
has, I think, possibilities of development, and also it's nice to
listen to.
`We do 12 bar Lisp around here, boy, same as we'm always done. We
don't hold with that modern-fangled Lisp like they do do in them thar
big cities, now. Just 'cause we'm got funny accents, it don't mean
we'm stupid'.
--tim (in Exeter)