I am trying to 'correct' my c++/java training and get the lisp feeling.
Below is my third attempt at the problem. I am looking for pointers on
improving it, or even better changing my approach. Any comments are appreciated.
The problem is summarizing or rolling up numeric values found in a in a list
of lists. An example of the structure would be:
((a b 1) (a b 2) (a c 3) (a c 7))
Yes it is a simplified database table style structure and does have uniform
'columns'. The result of summarizing should produce a result of:
((a b 3) (a c 10))
One other criteria is that result should conform to this general structure,
otherwise a hash may tempt me.
In the approach below, for brevity, i am just dealing with pairs not more
generic tuples. Calling (a-test) produces:
((A 4) (B 111) (C 7))
The code:
(defun a-test ()
(let ((input '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100))))
(sort input #'(lambda (a b) (string< (string a) (string b))) :key #'car)
(summarize input)))
(defun summarize (input)
(let ((summary-rec '(nil 0))
(result-list '()))
(flet ((append-summary-rec ()
(when (first summary-rec)
(setf result-list
(append result-list (list (copy-list summary-rec))))))
(clear-summary-rec ()
(setf (first summary-rec) nil)
(setf (second summary-rec) 0)))
(flet ((sum-rec (rec)
(when (not (eql (first rec) (first summary-rec)))
(append-summary-rec)
(clear-summary-rec))
(setf (second summary-rec) (+ (second summary-rec) (second rec)))
(when (not (first summary-rec))
(setf (first summary-rec) (first rec)))))
(map nil (lambda (rec) (sum-rec rec)) input)
(append-summary-rec)))
result-list))
I just realized of a built-in way to do this,
(its even named correctly)
(defun summarize (list)
(remove-duplicates list
:test (lambda (e1 e2)
(when (eql (first e1) (first e2))
(incf (second e1) (second e2))))))
CL-USER 2 > (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
((C 7) (A 4) (B 111))
CL-USER 3 >
Wade
Wade Humeniuk <··················@telus.net> writes:
> I just realized of a built-in way to do this,
> (its even named correctly)
>
> (defun summarize (list)
> (remove-duplicates list
> :test (lambda (e1 e2)
> (when (eql (first e1) (first e2))
> (incf (second e1) (second e2))))))
>
> CL-USER 2 > (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
> ((C 7) (A 4) (B 111))
REMOVE-DUPLICATES and DELETE-DUPLICATES specification includes:
The elements of sequence are compared pairwise, and if any two
match, then the one occurring earlier in sequence is discarded,
unless from-end is true, in which case the one later in sequence
is discarded.
This means that the algorithm is Theta(n�). Well, I bet most
implementations are just O(n�), and optimize-out the discarded items.
But in anycase,
This means that the cons cell that's kept is not e1, but e2!
Indeed, on clisp:
[30]> (summarize '((c 7) (c 1) (c 3)))
((C 3))
so you need at least to invert e1 and e2 in this form:
(incf (second e2) (second e1))
to make it correct.
--
__Pascal Bourguignon__ http://www.informatimago.com/
NOTE: The most fundamental particles in this product are held
together by a "gluing" force about which little is currently known
and whose adhesive power can therefore not be permanently
guaranteed.
Pascal Bourguignon wrote:
>
>
> REMOVE-DUPLICATES and DELETE-DUPLICATES specification includes:
>
> The elements of sequence are compared pairwise, and if any two
> match, then the one occurring earlier in sequence is discarded,
> unless from-end is true, in which case the one later in sequence
> is discarded.
>
> This means that the algorithm is Theta(n�). Well, I bet most
> implementations are just O(n�), and optimize-out the discarded items.
> But in anycase,
>
> This means that the cons cell that's kept is not e1, but e2!
>
>
> Indeed, on clisp:
>
> [30]> (summarize '((c 7) (c 1) (c 3)))
> ((C 3))
>
>
> so you need at least to invert e1 and e2 in this form:
> (incf (second e2) (second e1))
> to make it correct.
>
>
That is what I thought originally, but LW needs it just the way it is.
Since it just craps out in CMUCL I assume the authors of remove-duplicates
did not forsee the test modifying the elements.
It should probably say that modifying the elements of the original sequence
in the test is undefined.
Wade
Wade Humeniuk <··················@telus.net> writes:
> I just realized of a built-in way to do this,
> (its even named correctly)
>
> (defun summarize (list)
> (remove-duplicates list
> :test (lambda (e1 e2)
> (when (eql (first e1) (first e2))
> (incf (second e1) (second e2))))))
>
> CL-USER 2 > (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
> ((C 7) (A 4) (B 111))
>
> CL-USER 3 >
>
I was a bit concerned about this solution as it seemed to me this
would only work correctly if the elements in the list were sorted
according to the firswt element of each sublist. However, when I try
out your function, it doesn't work in CMUCL at all i.e.
CL-USER> (defun summarize (list)
(remove-duplicates list
:test (lambda (e1 e2)
(when (eql (first e1) (first e2))
(incf (second e1) (second e2))))))
SUMMARIZE
CL-USER> (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 1000)))
((C 7) (A 3) (B 1000))
I've not tried debugging it at all - just a simple cut 'n paste and
execute.
Tim
--
Tim Cross
The e-mail address on this message is FALSE (obviously!). My real e-mail is
to a company in Australia called rapttech and my login is tcross - if you
really need to send mail, you should be able to work it out!
Wade Humeniuk <··················@telus.net> writes:
> I just realized of a built-in way to do this,
> (its even named correctly)
>
> (defun summarize (list)
> (remove-duplicates list
> :test (lambda (e1 e2)
> (when (eql (first e1) (first e2))
> (incf (second e1) (second e2))))))
>
> CL-USER 2 > (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
> ((C 7) (A 4) (B 111))
>
> CL-USER 3 >
>
I was a bit concerned about this solution as it seemed to me this
would only work correctly if the elements in the list were sorted
according to the firswt element of each sublist. However, when I try
out your function, it doesn't work in CMUCL at all i.e.
CL-USER> (defun summarize (list)
(remove-duplicates list
:test (lambda (e1 e2)
(when (eql (first e1) (first e2))
(incf (second e1) (second e2))))))
SUMMARIZE
CL-USER> (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 1000)))
((C 7) (A 3) (B 1000))
I've not tried debugging it at all - just a simple cut 'n paste and
execute.
Tim
--
Tim Cross
The e-mail address on this message is FALSE (obviously!). My real e-mail is
to a company in Australia called rapttech and my login is tcross - if you
really need to send mail, you should be able to work it out!
Wade Humeniuk <··················@telus.net> writes:
> I just realized of a built-in way to do this,
> (its even named correctly)
>
> (defun summarize (list)
> (remove-duplicates list
> :test (lambda (e1 e2)
> (when (eql (first e1) (first e2))
> (incf (second e1) (second e2))))))
>
> CL-USER 2 > (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
> ((C 7) (A 4) (B 111))
>
> CL-USER 3 >
>
I was a bit concerned about this solution as it seemed to me this
would only work correctly if the elements in the list were sorted
according to the firswt element of each sublist. However, when I try
out your function, it doesn't work in CMUCL at all i.e.
CL-USER> (defun summarize (list)
(remove-duplicates list
:test (lambda (e1 e2)
(when (eql (first e1) (first e2))
(incf (second e1) (second e2))))))
SUMMARIZE
CL-USER> (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 1000)))
((C 7) (A 3) (B 1000))
I've not tried debugging it at all - just a simple cut 'n paste and
execute.
Tim
--
Tim Cross
The e-mail address on this message is FALSE (obviously!). My real e-mail is
to a company in Australia called rapttech and my login is tcross - if you
really need to send mail, you should be able to work it out!
Wade Humeniuk <··················@telus.net> writes:
> I just realized of a built-in way to do this,
> (its even named correctly)
>
> (defun summarize (list)
> (remove-duplicates list
> :test (lambda (e1 e2)
> (when (eql (first e1) (first e2))
> (incf (second e1) (second e2))))))
>
> CL-USER 2 > (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
> ((C 7) (A 4) (B 111))
>
> CL-USER 3 >
>
I was a bit concerned about this solution as it seemed to me this
would only work correctly if the elements in the list were sorted
according to the firswt element of each sublist. However, when I try
out your function, it doesn't work in CMUCL at all i.e.
,----
| CL-USER> (defun summarize (list)
| (remove-duplicates list
| :test (lambda (e1 e2)
| (when (eql (first e1) (first e2))
| (incf (second e1) (second e2))))))
| SUMMARIZE
| CL-USER> (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 1000)))
| ((C 7) (A 3) (B 1000))
`----
I've not tried debugging it at all - just a simple cut 'n paste and
execute.
Tim
--
Tim Cross
The e-mail address on this message is FALSE (obviously!). My real e-mail is
to a company in Australia called rapttech and my login is tcross - if you
really need to send mail, you should be able to work it out!
My apologies for the multiple posts. Gnus kept informing me it could
not send the article and I was trying to diagnose why not when in
fact, it was sending the article each time it told me it could not!
Tim
--
Tim Cross
The e-mail address on this message is FALSE (obviously!). My real e-mail is
to a company in Australia called rapttech and my login is tcross - if you
really need to send mail, you should be able to work it out!
Pascal Bourguignon wrote:
> Wade Humeniuk <··················@telus.net> writes:
>
>> Try
>>
>> (defun summarize (list)
>> (when list
>> (destructuring-bind ((key numeric-value) &rest rest)
>> list
>> (let* ((elements-in (remove key rest :test-not #'eql :key #'first))
>> (elements-out (remove key rest :key #'first)))
>> (cons (list key (+ numeric-value (reduce #'+ (mapcar #'second elements-in))))
>> (summarize elements-out))))))
>
> Nice, but O(n�).
>
Yeah i like this, i hadn't thought to approach the problem like this at all.
It wouldn't be appropriate for my problem domain because the lists are very
large, but it looks like a handy technique.
i feel more educated, and thats gotta be good.
Geoffrey King <··············@optushome.com.au> writes:
> I am trying to 'correct' my c++/java training and get the lisp
> feeling. Below is my third attempt at the problem. I am looking for
> pointers on improving it, or even better changing my approach. Any
> comments are appreciated.
>
> The problem is summarizing or rolling up numeric values found in a in
> a list of lists. An example of the structure would be:
> ((a b 1) (a b 2) (a c 3) (a c 7))
> Yes it is a simplified database table style structure and does have
> uniform 'columns'. The result of summarizing should produce a result
> of:
> ((a b 3) (a c 10))
>
> One other criteria is that result should conform to this general
> structure, otherwise a hash may tempt me.
If you don't need the result sorted, then using a hash table you can
reach a complexity of O(n) while sort is O(n*log(n)). And when you
use APPEND in a loop, you usually get O(n�).
(defun key (row) (first row))
(defun value (row) (second row))
(defun make-row (key value) (list key value))
(defun summarize (rows)
(loop with h = (make-hash-table :test (function equal)) ; for complex keys
for row in rows
do (incf (gethash (key row) h 0) (value row))
finally (let ((result '()))
(maphash (lambda (k v) (push (make-row k v) result)) h)
(return result))))
(summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
--> ((C 7) (A 4) (B 111))
(defun key (row) (subseq row 0 2))
(defun value (row) (elt row 2))
(defun make-row (key value) (append key (list value)))
(summarize '((a b 1) (a b 2) (a c 3) (a c 7)))
--> ((A B 3) (A C 10))
You probably need a more sophisticated data structure for rows,
involving a vector of fields and some meta-data.
Also, you can easily keep more data than the sum in the hash table:
...
(incf (cdr (gethash (key row) h (cons (data row) 0))) (value row))
...
(push (make-row k (car v) (cdr v)) result)
...
Or you can accumulate several columns at the same time, etc...
--
__Pascal Bourguignon__ http://www.informatimago.com/
"Specifications are for the weak and timid!"
Thanks Pascal thats much better than my complicated approach. It looks like
i dismissed hashes too early.
Pascal Bourguignon wrote:
> Geoffrey King <··············@optushome.com.au> writes:
[solution snipped]
>
Geoffrey King wrote:
> I am trying to 'correct' my c++/java training and get the lisp feeling.
> Below is my third attempt at the problem. I am looking for pointers on
> improving it, or even better changing my approach. Any comments are appreciated.
>
> The problem is summarizing or rolling up numeric values found in a in a list
> of lists. An example of the structure would be:
> ((a b 1) (a b 2) (a c 3) (a c 7))
> Yes it is a simplified database table style structure and does have uniform
> 'columns'. The result of summarizing should produce a result of:
> ((a b 3) (a c 10))
>
> One other criteria is that result should conform to this general structure,
> otherwise a hash may tempt me.
>
> In the approach below, for brevity, i am just dealing with pairs not more
> generic tuples. Calling (a-test) produces:
> ((A 4) (B 111) (C 7))
After someone pointed it out earlier here, I've noticed a big class of
"partition" problems...
(defun entry+ (entry-1 entry-2)
(let* ((reversed (reverse entry-1))
(n1 (first reversed))
(n2 (first (reverse entry-2))))
(reverse (cons (+ n1 n2) (rest reversed)))))
(defun sum-entries (entries)
(flet ((entry-equiv (entry-1 entry-2)
(equalp (butlast entry-1) (butlast entry-2))))
(loop for i in (partition #'entry-equiv entries)
collect (reduce #'entry+ i))))
It can be made simpler if a hashtable is used...
(defun sum-entries (entries)
(loop for i in (partition-hash #'butlast entries :hash-test 'equalp)
collect (reduce #'entry+ i)))
The partition functions are below (I hope they're not buggy; I'm just
taking a break from some extremely tedious non-Lisp code, with all its
semicolons and whatnot):
(defun partition (equivalent? set)
(flet ((make-equiv-tester (set)
(lambda (x) (funcall equivalent? (first set) x))))
(if (null set)
nil
(let ((equiv (remove-if-not (make-equiv-tester set) set))
(not-equiv (remove-if (make-equiv-tester set) set)))
(cons equiv (partition equivalent? not-equiv))))))
(defun partition-hash (equivalence-key set &key (hash-test 'eql))
(flet ((hash-values (hash)
(loop for v being the hash-values of hash collect v)))
(loop with hash = (make-hash-table :test hash-test)
for elem in set
do (push elem (gethash (funcall equivalence-key elem) hash))
finally (return (hash-values hash)))))
I even have a partition-sort function, which I suppose operates in log
time, but it's a little verbose to supply lexicographic<...
Tayssir
Tayssir John Gabbour wrote:
> Geoffrey King wrote:
> > The problem is summarizing or rolling up numeric values found in a in a list
> > of lists. An example of the structure would be:
> > ((a b 1) (a b 2) (a c 3) (a c 7))
> > Yes it is a simplified database table style structure and does have uniform
> > 'columns'. The result of summarizing should produce a result of:
> > ((a b 3) (a c 10))
> >
> > One other criteria is that result should conform to this general structure,
> > otherwise a hash may tempt me.
> >
> > In the approach below, for brevity, i am just dealing with pairs not more
> > generic tuples. Calling (a-test) produces:
> > ((A 4) (B 111) (C 7))
>
> After someone pointed it out earlier here, I've noticed a big class of
> "partition" problems...
>
> (defun entry+ (entry-1 entry-2)
> (let* ((reversed (reverse entry-1))
> (n1 (first reversed))
> (n2 (first (reverse entry-2))))
> (reverse (cons (+ n1 n2) (rest reversed)))))
>
> (defun sum-entries (entries)
> (flet ((entry-equiv (entry-1 entry-2)
> (equalp (butlast entry-1) (butlast entry-2))))
> (loop for i in (partition #'entry-equiv entries)
> collect (reduce #'entry+ i))))
>
>
> It can be made simpler if a hashtable is used...
>
> (defun sum-entries (entries)
> (loop for i in (partition-hash #'butlast entries :hash-test 'equalp)
> collect (reduce #'entry+ i)))
>
>
> The partition functions are below (I hope they're not buggy; I'm just
> taking a break from some extremely tedious non-Lisp code, with all its
> semicolons and whatnot):
Whoops, I didn't stick to your naming conventions; rename SUM-ENTRIES
-> SUMMARIZE.
(Boy, my brain is frazzled. Ironically, the thing making me the tiniest
bit productive is writing a PHP array -> sexp converter, and generating
PHP from a Lisp minilanguage. So it's not that bad.)
Tayssir
Tayssir John Gabbour <···········@yahoo.com> writes:
> I even have a partition-sort function, which I suppose operates in
> log time, but it's a little verbose to supply lexicographic<...
Here's a utility I wrote to generate such lexicographic orderings. It
presumes the existence of a set of single-argument reader functions to
extract the respective slot value from each object under comparison.
(defun make-ordering-form (lhs-sym rhs-sym cmp-fun reader-funcs)
(flet ((make-simple-form (lhs rhs func)
`(,cmp-fun (,func ,lhs) (,func ,rhs))))
(when reader-funcs
(if (null (cdr reader-funcs))
(make-simple-form lhs-sym rhs-sym (car reader-funcs))
`(or ,(make-simple-form lhs-sym rhs-sym (car reader-funcs))
(and (not ,(make-simple-form rhs-sym lhs-sym (car reader-funcs)))
,(make-ordering-form lhs-sym rhs-sym cmp-fun (cdr reader-funcs))))))))
(defmacro defcompoundordering (function-name type reader-funcs)
(when reader-funcs
`(defmethod ,function-name ((lhs ,type) (rhs ,type))
,(make-ordering-form 'lhs 'rhs function-name reader-funcs))))
An example usage:
,----
| (defgeneric lessp (lhs rhs)
| (:documentation "Determine whether lhs is less than rhs."))
|
| (defmethod lessp ((lhs number) (rhs number))
| (< lhs rhs))
|
| (defstruct endpoint
| (address nil :type number)
| (port nil :type number))
|
| (defcompoundordering lessp endpoint
| (endpoint-address endpoint-port))
`----
With these definitions present, I could supply #'lessp as a predicate
function to various binary search functions.
--
Steven E. Harris