Author Topic: (Challenge) Summation  (Read 14308 times)

0 Members and 1 Guest are viewing this topic.

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
(Challenge) Summation
« 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.)
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

Fatty

  • Guest
Re: (Challenge) Summation
« Reply #1 on: January 16, 2007, 03:47:47 PM »
Not tested extensively
but it may works I hope

Code: [Select]
(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'~

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: (Challenge) Summation
« Reply #2 on: January 16, 2007, 04:54:45 PM »
hi,

Here's my contribution :

Code: [Select]
(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))))
    )
  )
Speaking English as a French Frog

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: (Challenge) Summation
« Reply #3 on: January 16, 2007, 09:36:32 PM »
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.



TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) Summation
« Reply #4 on: January 17, 2007, 12:39:53 AM »
Code: [Select]
(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
)

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: (Challenge) Summation
« Reply #5 on: January 17, 2007, 12:50:26 AM »
I don't know why the challenge is 'one pass only' through the list
... wouldn't that preclude recursion ? ? ?  :|
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Fatty

  • Guest
Re: (Challenge) Summation
« Reply #6 on: January 17, 2007, 02:41:41 AM »
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'~

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) Summation
« Reply #7 on: January 17, 2007, 03:09:23 AM »
Code: [Select]
(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
)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) Summation
« Reply #8 on: January 17, 2007, 03:56:20 AM »
Code: [Select]
(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)))))
)

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: (Challenge) Summation
« Reply #9 on: January 17, 2007, 09:12:52 AM »
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. 
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

SomeCallMeDave

  • Guest
Re: (Challenge) Summation
« Reply #10 on: January 17, 2007, 09:15:50 AM »
My 2 cents -  if the solution can be found via one-pass through the list, why recurse?

Code: [Select]

(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



JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: (Challenge) Summation
« Reply #11 on: January 17, 2007, 09:19:36 AM »
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.

Code: [Select]
(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))
 )
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) Summation
« Reply #12 on: January 17, 2007, 09:31:55 AM »
One more variant, slow, but interesting...
Code: [Select]
(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!

Code: [Select]
(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)
              )
 )
« Last Edit: January 17, 2007, 09:57:34 AM by ElpanovEvgeniy »

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: (Challenge) Summation
« Reply #13 on: January 17, 2007, 10:04:02 AM »
There is some very good code in this thread ('cept my contribution.)!
Please, continue. forget the rules. Go for it! (Post your best!)
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: (Challenge) Summation
« Reply #14 on: January 17, 2007, 10:45:50 AM »
Mine turned out much like  SomeCallMeDave routine
Code: [Select]
  (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
  )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

LE

  • Guest
Re: (Challenge) Summation
« Reply #15 on: January 17, 2007, 10:47:27 AM »
Here is mine:

Code: [Select]
;;;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)

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: (Challenge) Summation
« Reply #16 on: January 17, 2007, 11:12:30 AM »
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. :(   :)

TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

LE

  • Guest
Re: (Challenge) Summation
« Reply #17 on: January 17, 2007, 12:15:32 PM »
Here is again my function, now using the mapcar style, and the same algorithm:

Code: [Select]
(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)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) Summation
« Reply #18 on: January 17, 2007, 12:26:10 PM »
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!

LE

  • Guest
Re: (Challenge) Summation
« Reply #19 on: January 17, 2007, 12:28:26 PM »
The best code in this thread has written gile!

How do you came up with that conclusion?  :-o

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: (Challenge) Summation
« Reply #20 on: January 17, 2007, 12:30:45 PM »
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!)


TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) Summation
« Reply #21 on: January 17, 2007, 12:35:13 PM »
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.

LE

  • Guest
Re: (Challenge) Summation
« Reply #22 on: January 17, 2007, 12:37:29 PM »
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.
« Last Edit: January 17, 2007, 12:43:11 PM by LE »

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: (Challenge) Summation
« Reply #23 on: January 17, 2007, 12:38:49 PM »
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.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

LE

  • Guest
Re: (Challenge) Summation
« Reply #24 on: January 17, 2007, 12:44:41 PM »
Please;

My comment is not to say what it is best or worst... I simple asked how it went to that conclusion.... :)

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: (Challenge) Summation
« Reply #25 on: January 17, 2007, 12:58:22 PM »
Oh okay. Gotcha. :)
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

LE

  • Guest
Re: (Challenge) Summation
« Reply #26 on: January 17, 2007, 01:12:16 PM »
Here are some comments about Recursion vs Iteration.

http://www.cs.wisc.edu/~vernon/cs367/notes/6.RECURSION.html

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: (Challenge) Summation
« Reply #27 on: January 17, 2007, 01:26:54 PM »
Nice link there Luis.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: (Challenge) Summation
« Reply #28 on: January 17, 2007, 03:22:35 PM »
Quote
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.
« Last Edit: January 17, 2007, 03:27:44 PM by gile »
Speaking English as a French Frog

LE

  • Guest
Re: (Challenge) Summation
« Reply #29 on: January 17, 2007, 04:10:05 PM »
In my opinion, all posted codes are interesting because they're all different.

Ditto^

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: (Challenge) Summation
« Reply #30 on: January 17, 2007, 04:29:47 PM »
Quote
Ditto^

What does it mean ???

My English is poor.
Speaking English as a French Frog

LE

  • Guest
Re: (Challenge) Summation
« Reply #31 on: January 17, 2007, 04:32:40 PM »
Quote
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) :)

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: (Challenge) Summation
« Reply #32 on: January 17, 2007, 04:34:33 PM »
OK ,Thanks  :-)
Speaking English as a French Frog

LE

  • Guest
Re: (Challenge) Summation
« Reply #33 on: January 18, 2007, 12:53:49 AM »
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
« Last Edit: January 18, 2007, 10:02:08 PM by LE »

fools

  • Newt
  • Posts: 72
  • China
Re: (Challenge) Summation
« Reply #34 on: March 02, 2007, 03:25:06 AM »
I always use sort+combination like this below codes
Code: [Select]
(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
)

Code: [Select]
(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)))
« Last Edit: March 02, 2007, 03:38:42 AM by fools »
Good good study , day day up . Sorry about my Chinglish .

fools

  • Newt
  • Posts: 72
  • China
Re: (Challenge) Summation
« Reply #35 on: March 02, 2007, 03:47:34 AM »
Also can like this
Code: [Select]
(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
)
Code: [Select]
(SORT&COMB AAA (FUNCTION (LAMBDA (p1 p2) (< (CAR p1) (CAR p2)))) '+)
;;ruturn (("two" 15) ("three" 18) ("one" 12))
Good good study , day day up . Sorry about my Chinglish .