Topic: -={ Challenge }=- Nested Summing

[Lee Mac]

Just for fun 

The Challenge:

Sum a list of numerical elements, nested to any level 

Example:

Code: [Select]

(SumList '( 1 2 3 ))
==> 6


Code: [Select]

(SumList '( 1 2 ( 3 4 ( 1 ))))
==> 11

Have fun!

Lee

[It's Alive!]

Code: [Select]

static int ads_nsum(void)
  {
    struct resbuf *pArgs=acedGetArgs();
    double ans = 0;
    for(resbuf *pRbTmp=pArgs;pRbTmp!=NULL;pRbTmp=pRbTmp->rbnext)
    {
      switch(pRbTmp->restype)
      {
      case RTSHORT:   { ans+=pRbTmp->resval.rint; } break;
      case RTLONG:    { ans+=pRbTmp->resval.rlong; } break;
      case RTREAL:    { ans+=pRbTmp->resval.rreal; } break;
      case RTPOINT:   { ans+=pRbTmp->resval.rpoint[0];
                        ans+=pRbTmp->resval.rpoint[1];} break;
      case RT3DPOINT: { ans+=pRbTmp->resval.rpoint[0];
                        ans+=pRbTmp->resval.rpoint[1];
                        ans+=pRbTmp->resval.rpoint[2];} break;
      }
    }
    acedRetReal(ans);
    return (RSRSLT) ;
  }


[David Bethel]

Lee,

I always liked this one from the Compuserve days:

Code: [Select]

;;;++++++++++++ Explode Any List Steve Johnson +++++++++++++++++++++
(defun exlist (LST / expl new)
  (defun expl (SUBLST)
    (foreach one SUBLST
      (if (atom one)
          (setq new (cons one new))
          (if (listp (cdr one))
              (expl one)
              (setq new (cons (cdr one) (cons (car one) new)))))))
  (expl (list LST))
  (reverse new))


Code: [Select]

 (defun SumList (l)
    (apply '+ (exlist l)))

(SumList '(1 2 ( 3 4 ( 1 ))))

-David

[Lee Mac]

Dan - I'm blown out of the water by that  I can't even begin to dissect it to try to understand it...

David - that reminds me of Michaels 'Squish' function - nice approach.

Here is my submission:

Code: [Select]

(defun LM:SumList ( l )
  (if l
    (+ (if (eq 'list (type (car l)))
         (LM:SumList (car l))
         (car l)
       )
       (LM:SumList (cdr l))
    )
    0
  )
)


[David Bethel]

Lee,

Try a list like this:

Code: [Select]

(setq l1 '( 1 2 (3 . 4)(5 6 7) 8))
That could have came from same stuff.  There were quite a few of us on the Compuserve forum that are still hanging around.  It was Autodesk's 'official' forum.  ALT- & COMP- stuff was around, just loaded with flamers and junk...

-David

[gile]

Hi,

the same as Lee:

Code: [Select]

(defun sumlist (l / e)
  (if (setq e (car l))
    (+ (if (atom e)
         e
         (sumlist e)
       )
       (sumlist (cdr l))
    )
    0
  )
)
or using cond

Code: [Select]

(defun sumlist (l / e)
  (cond
    ((null (setq e (car l))) 0)
    ((atom (car l)) (+ e (sumlist (cdr l))))
    (T (+ (sumlist e) (sumlist (cdr l))))
  )
)

[gile]

This one should work with the list posted by David

Code: [Select]

(defun sumlist (l / e)
  (cond
    ((and l (atom l)) l)
    ((null (setq e (car l))) 0)
    ((atom (car l)) (+ e (sumlist (cdr l))))
    (T (+ (sumlist e) (sumlist (cdr l))))
  )
)

[Lee Mac]

Lee,

Try a list like this:

Code: [Select]

(setq l1 '( 1 2 (3 . 4)(5 6 7) 8))
That could have came from same stuff.  There were quite a few of us on the Compuserve forum that are still hanging around.  It was Autodesk's 'official' forum.  ALT- & COMP- stuff was around, just loaded with flamers and junk...

-David

Ah yes - I hadn't accounted for any dotted pairs... 

[gile]

Or, using if statement:

Code: [Select]

(defun sumlist (l / e)
  (if (setq e (car l))
    (+ (if (atom e)
         e
         (sumlist e)
       )
       (if (listp (cdr l))
         (sumlist (cdr l))
         (cdr l)
       )
    )
    0
  )
)

[Lee Mac]

Along the same lines as Gile I'm afraid 

Code: [Select]

(defun LM:SumList ( l )
  (if l
    (if (atom l) l
      (if (atom (car l))
        (+ (car l) (LM:SumList (cdr l)))
        (+ (LM:SumList (car l)) (LM:SumList (cdr l)))
      )
    )
    0
  )
)


Code: [Select]

(defun LM:SumList2 ( l / x )
  (if l
    (if (atom l) l
      (+
        (if (atom (setq x (car l))) x (LM:SumList2 x))
        (LM:SumList2 (cdr l))
      )
    )
    0
  )
)


[It's Alive!]

good here   

[Lee Mac]

good here   

Yours will probably wipe the floor with us speedwise too 

[gile]

I tried a C# solution, but it's not very elegant 

Code: [Select]

using Autodesk.AutoCAD.DatabaseServices;
using Autodesk.AutoCAD.Geometry;
using Autodesk.AutoCAD.Runtime;

namespace ChallengeSumList
{
    public class SumListClass
    {
        [LispFunction("gc-SumList")]
        public double SumList(ResultBuffer resbuf)
        {
            TypedValue[] args = resbuf.AsArray();
            double result = 0;
            foreach (TypedValue tv in args)
            {
                switch (tv.TypeCode)
                {
                    case (short)LispDataType.Int16:
                        result += (short)tv.Value;
                        break;
                    case (short)LispDataType.Int32:
                        result += (int)tv.Value;
                        break;
                    case (short)LispDataType.Double:
                        result += (double)tv.Value;
                        break;
                    case (short)LispDataType.Point2d:
                        result += ((Point2d)tv.Value).X + ((Point2d)tv.Value).Y;
                        break;
                    case (short)LispDataType.Point3d:
                        result += ((Point3d)tv.Value).X + ((Point3d)tv.Value).Y + ((Point3d)tv.Value).Z;
                        break;
                    default:
                        break;
                }
            }
            return result;
        }
    }
}


[Lee Mac]

One more for the mix 

Code: [Select]

(defun LM:SumList3 ( l )
  (cond
    ( (not l)  0)
    ( (atom l) l)
    ( (vl-list-length l) (apply '+ (mapcar 'LM:SumList3 l)))
    ( (+ (LM:SumList3 (car l)) (LM:SumList3 (cdr l))))
  )
)


[gile]

Another way:

Code: [Select]

(defun sumlist (l)
  (eval
    (read
      (strcat "(+ "
      (vl-string-translate "(.)" "   " (vl-princ-to-string l))
      ")"
      )
    )
  )
)

[It's Alive!]

I tried a C# solution, but it's not very elegant 

A work of art... I see you caught the point2d -3d too 

[gile]

A work of art...

Thanks, but I think it's very exaggerated...

[Lee Mac]

Another way:

Superb Gile - thinking outside the box 

[LE3]

I will try with this old style school and mickey mouse approach and solution (and without looking into any of already code posted), compared to you masters of lisp 
... and don't laugh..... ok you can 

(setq lst '( 1 2 ( 3 4 ( 1 ))))
Command: tst
Total: 11

(setq lst '( 1 2 ( 3 4 ( 1 )) ( 3 4 ( 1 ))))
Command: tst
Total: 19

Code: [Select]

(defun sum (lst / lth cont)
(setq lth (length lst) cont 0)
(while (< cont lth)
  (setq item (nth cont lst))
  (cond
  ((eq (type item) 'list) (sum item))
  ((eq (type item) 'int) (setq total (+ item total))))
  (setq cont (1+ cont))))

(defun summer (/ lth cont total)
(setq lth (length lst) cont 0 total 0)
(while (< cont lth)
  (setq item (nth cont lst))
  (cond
  ((eq (type item) 'list) (sum item))
  ((eq (type item) 'int) (setq total (+ item total))))
  (setq cont (1+ cont))
  total))

(defun c:tst () (princ "\nTotal: ") (princ (summer)) (princ))

[Lee Mac]

Thanks for joining in the fun Luis 

Try with a dotted pair 

[LE3]

let's see...

(setq lst '( 1 2 ( 3 4 ( 1 ) (3 . 4))))
Command: tst
Total: 18

Code: [Select]

(defun isDottedPair (item) (and (car item) (cdr item) (atom (car item)) (atom (cdr item))))
   
(defun sum (lst / lth cont)
(setq lth (length lst) cont 0)
(while (< cont lth)
  (setq item (nth cont lst))
  (cond
  ((and (eq (type item) 'list) (isDottedPair item)) (setq total (+ (car item) (cdr item) total)))
  ((eq (type item) 'list) (sum item))
  ((eq (type item) 'int) (setq total (+ item total))))
  (setq cont (1+ cont))))

(defun summer (/ lth cont total)
(setq lth (length lst) cont 0 total 0)
(while (< cont lth)
  (setq item (nth cont lst))
  (cond
  ((and (eq (type item) 'list) (isDottedPair item)) (setq total (+ (car item) (cdr item) total)))
  ((eq (type item) 'list) (sum item))
  ((eq (type item) 'int) (setq total (+ item total))))
  (setq cont (1+ cont))
  total))


Thanks for joining in the fun Luis 

Try with a dotted pair 

[pkohut]

Lee,

I always liked this one from the Compuserve days:
-David

Ah, yes. 100 virtual points for anyone that can remember the moderator's name?

[LE3]

Hi Gile,
Just tried this, and does not return the right sum... ?

(1 2 3)
_$ (SUMLIST lst)
6 ;; ok

(1 2 (3 4 (1)))
_$ (SUMLIST lst)
6 ;; ?

Another way:

Code: [Select]

(defun sumlist (l)
  (eval
    (read
      (strcat "(+ "
      (vl-string-translate "(.)" "   " (vl-princ-to-string l1))
      ")"
      )
    )
  )
)

[gile]

Oops !!!

I forgot to change l1 for l after debugging...
Try with corrected code.

[LE3]

I'll check... Je sais que c'était quelque chose de simple

Oops !!!

I forgot to change l1 for l after debugging...
Try with corrected code.

[pkohut]

Slightly reworked version of D's. Call to acedGetArgs eliminated. pRbTmp != NULL eliminated. RTPOINT and RT3DPOINT reworked. Got rid of unneeded curly brackets in each of the case statements (not needed unless a local variable needs to be assigned defined at case scope).

Code: [Select]

static int ads_nsum(resbuf * pArgs)
{
    double ans = 0;
    for(resbuf *pRbTmp = pArgs; pRbTmp; pRbTmp=pRbTmp->rbnext)
    {
        switch(pRbTmp->restype)
        {
        case RTSHORT: ans+=pRbTmp->resval.rint; break;
        case RTLONG: ans+=pRbTmp->resval.rlong; break;
        case RTREAL: ans+=pRbTmp->resval.rreal; break;
        case RTPOINT: ans += pRbTmp->resval.rpoint[0] +
                          pRbTmp->resval.rpoint[1]; break;
        case RT3DPOINT: ans+=pRbTmp->resval.rpoint[0] +
                            pRbTmp->resval.rpoint[1] +
                            pRbTmp->resval.rpoint[2]; break;
        }
    }
    acedRetReal(ans);
    return (RSRSLT) ;
}


[David Bethel]

Lee,

I always liked this one from the Compuserve days:
-David

Ah, yes. 100 virtual points for anyone that can remember the moderator's name?

Anne Brown


She was into quilting or something.  Not a CAd person at all.

Some of the threadmatsers that I remember were

Jon Fleming
Bill Townsend
Tony Tanzillio ( for a while )
Steve Johhnson
Ditmar Rudolph

[pkohut]

Anne Brown

She was into quilting or something.  Not a CAd person at all.

Yep. You can collect your points at the CompuServe front desk. 

Some of the threadmatsers that I remember were

Jon Fleming
Bill Townsend
Tony Tanzillio ( for a while )
Steve Johhnson
Ditmar Rudolph

Wow, scored bonus on those. I'd forgotten.

[It's Alive!]

Slightly reworked version of D's. Call to acedGetArgs eliminated. pRbTmp != NULL eliminated. RTPOINT and RT3DPOINT reworked. Got rid of unneeded curly brackets in each of the case statements (not needed unless a local variable needs to be assigned defined at case scope).

Code: [Select]

static int ads_nsum(resbuf * pArgs)
{
    double ans = 0;
    for(resbuf *pRbTmp = pArgs; pRbTmp; pRbTmp=pRbTmp->rbnext)
    {
        switch(pRbTmp->restype)
        {
        case RTSHORT: ans+=pRbTmp->resval.rint; break;
        case RTLONG: ans+=pRbTmp->resval.rlong; break;
        case RTREAL: ans+=pRbTmp->resval.rreal; break;
        case RTPOINT: ans += pRbTmp->resval.rpoint[0] +
                          pRbTmp->resval.rpoint[1]; break;
        case RT3DPOINT: ans+=pRbTmp->resval.rpoint[0] +
                            pRbTmp->resval.rpoint[1] +
                            pRbTmp->resval.rpoint[2]; break;
        }
    }
    acedRetReal(ans);
    return (RSRSLT) ;
}


so your adding another function call for acedGetArgs() somewhere?

[pkohut]

so your adding another function call for acedGetArgs() somewhere?

No, check the signature of ads_nsum.

[It's Alive!]

It gives a compiler error

Code: [Select]

error C2664: '_AdsRegisteredSymbol::_AdsRegisteredSymbol(const _AdsFuncPtr,const ACHAR *,const bool,const UINT)' :
cannot convert parameter 1 from 'int (__cdecl *)(resbuf *)' to 'const _AdsFuncPtr'
Maybe your getting the args from lisp another way ?

[It's Alive!]

Oh I see from looking at your shell routine, you use another function "DoFunc" whereas I'm using a macro

ACED_ADSSYMBOL_ENTRY_AUTO(CBrxApp, nsum, false)

[pkohut]

Oh I see from looking at your shell routine, you use another function "DoFunc" whereas I'm using a macro

ACED_ADSSYMBOL_ENTRY_AUTO(CBrxApp, nsum, false)

Ya, I don't have the ARX wizard installed in VC2008 so I just grabbed some boiler plate code from the
frac sample. (edit) and didn't think about the fact you are.

[It's Alive!]

Yes, I tend to use the wizard or grab one of my templates (based off the wizard) . I've never seen the resbuf passed through dofun though, I always used

Code: [Select]

rc = (*exfun[val].fptr)();
learn something new everyday 

[ElpanovEvgeniy]

my variant:

Code: [Select]

(defun f (l)
 (if (listp l)
  (apply '+ (mapcar 'f l))
  l
 )
)test:

Code: [Select]

(f '(1 2 (3 4 (1)))) ;=>> 11

[Lee Mac]

Very concise Evgeniy!

Great solution for lists with no dotted pairs 

[ElpanovEvgeniy]

Very concise Evgeniy!

Great solution for lists with no dotted pairs 

variant 2:

Code: [Select]

(defun f (l)
 (cond ((not l) 0)
       ((numberp l) l)
       ((+ (f (car l)) (f (cdr l))))
 )
)test:

Code: [Select]

(f '( 1 2 ( 3 4 ( 1 ) (3 . 4)))) ;=>> 18

[ElpanovEvgeniy]

variant 2.5 (optimized)

Code: [Select]

(defun f (l)
 (cond ((numberp l) l)
       (l (+ (f (car l)) (f (cdr l))))
       (0)
 )
)

[gile]

 
You're a master Evgeniy !

[ElpanovEvgeniy]

You're a master Evgeniy !

Thanks!
You took the best of my! 

[Lee Mac]

You're a master Evgeniy !

x2 

[pkohut]

variant 2.5 (optimized)

Masterful.  :kewl:

[highflyingbird]

variant 2.5 (optimized)

Code: [Select]

(defun f (l)
 (cond ((numberp l) l)
       (l (+ (f (car l)) (f (cdr l))))
       (0)
 )
)

I think it will be better.

Code: [Select]

(defun f (l)
  (cond ((numberp l) l)
((atom l) 0)
(t (+ (f (car l)) (f (cdr l))))
  )
)
for example:

(f (list 1 (list (ssget) 1) (entsel "select:") (cons 2 (cons nil (cons nil 1)))))

[Lee Mac]

variant 2.5 (optimized)

Code: [Select]

(defun f (l)
 (cond ((numberp l) l)
       (l (+ (f (car l)) (f (cdr l))))
       (0)
 )
)

I think it will be better.

Code: [Select]

(defun f (l)
  (cond ((numberp l) l)
((atom l) 0)
(t (+ (f (car l)) (f (cdr l))))
  )
)
for example:

(f (list 1 (list (ssget) 1) (entsel "select:") (cons 2 (cons nil (cons nil 1)))))

Perhaps, but the original spec was for lists of purely numerical elements.