TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: JohnK on January 16, 2007, 12:40:46 PM
-
Return the sum of values for each class.
-i.e.
(summation '(("one" 1) ("two" 2) ("three" 3)))
> one = 1
two = 2
three = 3
Further, return the sum of values for each class if there are several instances of each class.
-i.e.
(summation '(("one" 1) ("two" 2) ("three" 3)
("one" 4) ("two" 5) ("three" 6)
("one" 7) ("two" 8) ("three" 9)) )
> one = 12
two = 15
three = 18
Rules:
You may only ``go thru'' this list once.
You may return a formatted screen print or a list (which ever is easier for you).
And to make this a bit more challenging, you must use a recursive process.
(You may use variables or a ``wrapper''.)
Note:
o This idea came from a program I just made for reporting/calcing the len and vol of pipe in a selection. (It is a generalized concept of a function I just created.)
o I used variables in my procedure but I would be very interested in seeing a solution that uses neither. (I could not think of a way to do that.)
-
Not tested extensively
but it may works I hope
(defun summation (lst / extrakt)
(defun extrakt (test lst / ret)
(setq ret
(apply 'append
(mapcar '(lambda (x)
(if (eq (car x) test)
(list x)
)
)
lst
)
)
)
(list test (apply '+ (mapcar 'cadr ret)))
)
(if (car lst)
(cons (extrakt (caar lst) lst)
(summation
(vl-remove-if
(function (lambda (a)
(eq (car a) (caar lst))
)
)
lst
)
)
)
)
)
~'J'~
-
hi,
Here's my contribution :
(defun summation (lst / m)
(cond
((atom lst) nil)
((setq m (assoc (caar lst) (cdr lst)))
(summation
(subst (list (caar lst) (+ (cadr m) (cadar lst)))
m
(cdr lst)
)
)
)
(T (cons (car lst) (summation (cdr lst))))
)
)
-
Wonderful gile!! Simple and elegant. (Makes mine look like a child with a
crayon--which I will post tomorrow morn.)
Fatty, Very nice, but you can only iterate thru the list once. I count 5
times.
-
(defun summation_1 (lst)
(if lst
(cons
(list
(caar lst)
(apply '+ (mapcar 'cadr (vl-remove-if-not '(lambda (x) (= (caar lst) (car x))) lst)))
) ;_ list
(summation_1 (vl-remove-if '(lambda (x) (= (caar lst) (car x))) lst))
) ;_ cons
) ;_ if
)
-
I don't know why the challenge is 'one pass only' through the list
... wouldn't that preclude recursion ? ? ? :|
-
Wonderful gile!! Simple and elegant. (Makes mine look like a child with a
crayon--which I will post tomorrow morn.)
Fatty, Very nice, but you can only iterate thru the list once. I count 5
times.
Hi John, I agree with you
Looks ugly and work sloooooowly :)
~'J'~
-
(defun summation_2 (lst)
(if (cdr lst)
(if (= (caadr lst) (caar lst))
(summation_2 (cons (list (caar lst) (+ (cadar lst) (cadadr lst))) (cddr lst)))
(if (assoc (caar lst) (cdr lst))
(summation_2 (cons (car lst)(append (cddr lst) (list (cadr lst)))))
(cons (car lst) (summation_2 (cdr lst)))
) ;_ if
) ;_ if
lst
) ;_ if
)
-
(defun summation_3 (lst)
(defun summation_3 (lst)
(if lst
(if (= (caar lst) (caadr lst))
(summation_3 (cons (list (caar lst) (+ (cadar lst) (cadadr lst))) (cddr lst)))
(cons (car lst) (summation_2 (cdr lst)))
) ;_ if
) ;_ if
) ;_ defun
(summation_3 (vl-sort lst '(lambda (a b) (< (car a) (car b)))))
)
-
I don't know why the challenge is 'one pass only' through the list
... wouldn't that preclude recursion ? ? ? :|
Kerry, Im sorry bout that. I guess your kinda right in that the list itself is ``handed-off'' serveral times...but I was thinking more about the contents of the list.
-
My 2 cents - if the solution can be found via one-pass through the list, why recurse?
(defun summ3(pClassList)
(setq sumList (list))
(last (mapcar '(lambda(x) (if (setq SumListElem (assoc (car x) SumList))
(setq SumList (subst (cons (car x) (+ (cdr SumListElem) (cdr x)))
SumListElem SumList))
(setq SumList (append SumList (list x)))
);if
);lambda
pClassList
);mapcar
);last
);defun summ3
-
Hi John, I agree with you
Looks ugly and work sloooooowly :)
~'J'~
Hey dont sweat it; wait till you see my monster! Its fricken ug-ly! After seeing some of these others, I dont even want to post the darn thing! *lol*)
Here was my version. (I took mine from that procedure I was doing and modified it to fit into this challenge.) please dont run this on a production dwg. It creates some global vars.
(defun summation ( lst / item temp )
;|
Example:
(setq one nil two nil three nil _masterlist nil)
Just to make sure these vars are nil...
(summation '(("one" 1) ("two" 2) ("Three" 3)
("one" 3) ("two" 6) ("Three" 8)))
Sum up all the diff types of sizes.
(mapcar '(lambda ( x ) (eval (read x))) _masterlist)
report the sizes summed up
|;
;;
(defun set! ( item val )
(set (eval (list 'quote item)) val) )
(setq item (car (car lst)))
(cond
((null lst) nil)
((eval (read item))
(setq temp (eval (quote (read item))))
(set!
(eval (quote (read item)))
(+ (eval temp) (car (reverse (car lst))))
)
(summation (cdr lst))
)
((not (eval (read item)))
(set!
(eval (quote (read item)))
(car (reverse (car lst)))
)
(if (not (member item _masterlist))
(setq _masterlist (cons item _masterlist)))
(summation (cdr lst))
)
)
(setq _masterlist (reverse _masterlist))
)
-
One more variant, slow, but interesting...
(defun lst->matrix (lst)
(if lst
(cons (mapcar (function cadr) lst)
(lst->matrix (vl-member-if (function (lambda (x) (= (car x) (caar lst)))) (cdr lst)))
) ;_ cons
) ;_ if
) ;_ defun
(defun summation_4 (lst)
(mapcar
(function list)
(mapcar (function car) lst)
(apply (function mapcar) (cons (function +) (lst->matrix lst)))
) ;_ mapcar
) ;_ defun
Ps. This function works, only for the structured list!
(summation_4'(("one" 1) ("two" 2) ("three" 3)
("one" 4) ("two" 5) ("three" 6)
("one" 7) ("two" 8) ("three" 9)
)
)
(summation_4'(("one" 1) ("two" 2) ("three" 3) ("Four" 4)
("one" 4) ("two" 5) ("three" 6) ("Four" 7)
("one" 7) ("two" 8) ("three" 9) ("Four" 10)
)
)
-
There is some very good code in this thread ('cept my contribution.)!
Please, continue. forget the rules. Go for it! (Post your best!)
-
Mine turned out much like SomeCallMeDave routine
(defun sum (lst / total result)
(mapcar '(lambda (x)
(setq result
(cond
((null result) (list x))
((setq total (assoc (car x) result))
(subst (list (car x) (+ (cadr x) (cadr total))) total result)
)
((cons x result))
)
)
)
lst
)
result
)
-
Here is mine:
;;;GETVALS
;;;_$ (getvals lst)
;;;(("two" . 15) ("three" . 18) ("one" . 12))
(defun getvals (lst / total tmp l i)
(setq total 0
tmp lst
i 0)
(setq items (acad_strlsort (mapcar 'car lst)))
(while (< i (length items))
(if (setq add (cadr (assoc (nth i items) tmp)))
(progn
(if (not (setq value (cdr (assoc (nth i items) l))))
(setq value 0))
(setq dot (cons (nth i items) (+ add value))
tmp (vl-remove (list (nth i items) add) tmp))))
(if (assoc (nth i items) l)
(setq l (subst dot (assoc (nth i items) l) l))
(setq l (cons dot l)))
(setq i (1+ i)))
l)
-
There is some amazing code in this thread. Im trying to study it all but right at this moment i find myself stuck on Evgeniy's summation_2 :)
I think it maybe time to start up that vlide. :( :)
-
Here is again my function, now using the mapcar style, and the same algorithm:
(defun getvals (lst / value add total tmp l items)
(setq total 0
tmp lst)
(mapcar (function
(lambda (i)
(if (setq add (cadr (assoc i tmp)))
(progn
(setq value (if (not (cdr (assoc i l)))
0
(cdr (assoc i l))))
(setq dot (cons i (+ add value))
tmp (vl-remove (list i add) tmp))))
(setq l (if (assoc i l)
(subst dot (assoc i l) l)
(cons dot l)))))
(setq items (acad_strlsort (mapcar 'car lst))))
l)
-
There is some amazing code in this thread. Im trying to study it all but right at this moment i find myself stuck on Evgeniy's summation_2 :)
I think it maybe time to start up that vlide. :( :)
The best code in this thread has written gile!
-
The best code in this thread has written gile!
How do you came up with that conclusion? :-o
-
The best code in this thread has written gile!
I haven't gotten to look at all of them yet but so far I agree. Very nice code! (clean!)
-
How do you came up with that conclusion? :-o
Excuse!
It only my opinion.
Its code is minimal on the size and at small lists it the fastest.
-
How do you came up with that conclusion? :-o
Excuse!
It only my opinion.
Its code is minimal on the size and at small lists it the fastest.
Thanks.
I am not fan of recursion at all, I normally avoid that in all my code, I think I had use it once in C++ and maybe once in Autolisp.
-
How do you came up with that conclusion? :-o
I dont think theres any thing bad about anyones code LE, I agree that gile's code was very good because it was very simple and easy. I know I was shocked at how easy the code was. I learned tons from that proced. ...all of them so far. No judging, just learning.
-
Please;
My comment is not to say what it is best or worst... I simple asked how it went to that conclusion.... :)
-
Oh okay. Gotcha. :)
-
Here are some comments about Recursion vs Iteration.
http://www.cs.wisc.edu/~vernon/cs367/notes/6.RECURSION.html
-
Nice link there Luis.
-
The best code in this thread has written gile!
First, many thanks to Evgeniy. Comming from you, the comment realy touch me. I admire the way you write LISP (your style), I consider you as a recursion master and learn a lot reading your codes.
About recursion form, even it's often slower and needs more memory than an iterative form, I like it it very much for its elegancy and its way of thinking (and when I posted my code, recursive form was the rule).
In my opinion, all posted codes are interesting because they're all different.
I enjoy these kind of challenge.
-
In my opinion, all posted codes are interesting because they're all different.
Ditto^
-
Ditto^
What does it mean ???
My English is poor.
-
Ditto^
What does it mean ???
My English is poor.
I think it is "idem" in French
(means that I think the same as your comment) :)
-
OK ,Thanks :-)
-
Note:
I'll start a new topic in the ARX forum, in case some of the masters in arx, end up adding some more solutions...
Just for fun, here is a function in C++/ARX
Here is:
http://www.theswamp.org/index.php?topic=14600.msg176186#msg176186
-
I always use sort+combination like this below codes
(DEFUN Sort&Comb (lst func / tmplst)
(SETQ tmplst nil)
(FOREACH item (VL-SORT lst
(FUNCTION (LAMBDA (p1 p2) (< (CAR p1) (CAR p2))))
)
(IF (AND tmplst (EQUAL (CAAR tmplst) (CAR item)))
(SETQ tmplst (SUBST (LIST (CAR item)
(APPLY func (LIST (CADR item) (CADAR tmplst)))
)
(CAR tmplst)
tmplst
)
)
(SETQ tmplst (CONS item tmplst))
)
)
tmplst
)
(setq aaa '(("one" 1) ("two" 2) ("three" 3)
("one" 4) ("two" 5) ("three" 6)
("one" 7) ("two" 8) ("three" 9)
)
)
(Sort&Comb aaa '+)
;;return (("two" 15) ("three" 18) ("one" 12))
(Sort&Comb aaa '*)
;;return (("two" 80) ("three" 162) ("one" 28))
(Sort&Comb aaa (FUNCTION (LAMBDA (P1 P2) (IF (ATOM P2) (LIST P1 P2) (CONS P1 P2)))))
;;return (("two" (8 5 2)) ("three" (9 6 3)) ("one" (7 4 1)))
-
Also can like this
(DEFUN Sort&Comb (lst SortFunc CombFunc / tmplst)
(SETQ tmplst nil)
(FOREACH item (VL-SORT lst SortFunc)
(IF (AND tmplst (EQUAL (CAAR tmplst) (CAR item)))
(SETQ tmplst (SUBST (LIST (CAR item)
(APPLY CombFunc (LIST (CADR item) (CADAR tmplst)))
)
(CAR tmplst)
tmplst
)
)
(SETQ tmplst (CONS item tmplst))
)
)
tmplst
)
(SORT&COMB AAA (FUNCTION (LAMBDA (p1 p2) (< (CAR p1) (CAR p2)))) '+)
;;ruturn (("two" 15) ("three" 18) ("one" 12))