Subject: Re: sum over list?
From: Erik Naggum <erik@naggum.net>
Date: Mon, 28 May 2001 14:19:38 GMT
Newsgroups: comp.lang.lisp
Message-ID: <3200048369259034@naggum.net>

* Drew Krause <drkrause@mindspring.com>
> Boy is this a dumb question, but ....
> 
> I need to create a function which sums all members of a variable-length
> list, e.g.
> 
> (sum '(2 3 4)) => 9
> (sum '(5 6)) => 11
> 
> I'm having trouble doing this for variable lengths, as using '+'
> directly on the list of course won't work.

  There are a number of reasonably obvious answers to your question, but
  the reasons for choosing one among them might be worth investigating.

(apply <function> [<arg>...] <arglist>)

  calls <function> with the arguments that first include all the
  <args>... and then those that results from "spreading" <arglist> into
  separate arguments.  This function is most applicable in combination with
  the &rest lambda list keyword, which does the reverse operation: it makes
  a bunch of arguments into a list.  apply is a good function use when the
  arguments originate under complete program control.  Otherwise, you may
  run into the system limit on the number of arguments in argument lists,
  you may get run-time errors reflecting unexpected types of arguments, and
  you may in pathological cases come across a circular or dotted list,
  which may have rather severe consequences on your Common Lisp system.
  (Surprisingly, Allegro CL just drops dead if apply gets a circular list.)

(reduce <function> <sequence>)

  calls <function> with the first two elements from the sequence, then uses
  that value as the first argument in the next call, which takes the next
  element from the sequence, and thus it walks through the entire sequence,
  yielding the value of the final call to <function>.  (You can cause it to
  start with an initial value or to walk from the end with keyword args.)
  This is good when the sequence is not a list, and when it is really long,
  as it does not use more than two arguments to <function>.  Mind you, +
  would have to be called (1- n) times for a sequence of length n, anyway,
  so if you can avoid the overhead of calling + with all the arguments at
  once, that is a winner.  However, it will fail with unknown argument
  types, circular lists and dotted lists.

(let ((sum 0)) (dolist (elt <list> sum) (when (numberp elt) (incf sum elt))))

  is an inlined, iterative version that checks for numberness of each
  element before summing them.  This version also dies with circular lists
  and dotted lists.

(loop for elt in <list> when (numberp element) sum elt)

  is a specialized version for summation, which in this case may be the
  most appropriate.  It ensure that non-number elements are excluded from
  the process.  This avoid argument type errors.  The loop will still fail
  with an error if the list is dotted, and will never terminate if the list
  is circular.  One problem here is that it might be an error if there is a
  non-number in the list, and you would never detect that.  This could
  happen if you read numbers from a file that had gotten corrupted or were
  written by another program that, say, had a different floating-point
  format that turned into symbols for some of the not-quite-numbers.

(and (list-length <list>)
     ...)

  using any of the above forms in place of the ellipsis, will ensure that
  circular lists are detected and dotted lists cause an error before
  anything else happens.

(cond ((not (ignore-errors (list-length <list>)))
       ...)
      ((not (every #'numberp <list>))
       ...)
      (t (loop ...)))

  will test the primary conditions for success before trying to do the real
  work.  However, this is a rather expensive approach, so what if we do it
  all in one fell swoop?

(defun list-sum (list)
  (unless (and (listp list)
	       (listp (cdr list)))
    (error "~S is not a proper list." list))
  (do ((accum 0)
       (tortoise list (cdr tortoise))
       (hare (cdr list) (cddr hare)))
      ((null tortoise)
       accum)
    (when (eq tortoise hare)
      (error "~S is a circular list." list))
    (unless (and (consp tortoise)
		 (listp hare)
		 (listp (cdr hare)))
      (error "~S is a dotted list." list))
    (unless (numberp (first tortoise))
      (error "~S is not a number." (first tortoise)))
    (incf accum (first tortoise))))

  Of course, this is suitable for a program that can bitch at the user, but
  what if you want to bitch in a way tha that the _program_ can handle, and
  want to make this idiomatic expression into a standard tool?

(defmacro do-proper-list ((var listform &optional resultform &key if-circular if-dotted)
			  &body body)
  "Traverse the value of listform, binding var to each element over body.
Returns the value of resultform (default nil), upon completion.  If the list is
a circular list and if-circular is not a form that causes a non-local exit,
return nil.  Similarly with dotted lists and if-dotted.  The form establishes a
block named nil, like dolist."
  (let ((list (make-symbol "list"))
	(tortoise (make-symbol "tortoise"))
	(hare (make-symbol "hare")))
    `(do* ((,var nil)
	   (,list ,listform)
	   (,tortoise ,list (cdr ,tortoise))
	   (,hare (cdr ,list) (cddr ,hare)))
	 ((null ,tortoise)
	  ,resultform)
       ;; circular list?
       (when (eq ,tortoise ,hare)
	 ,if-circular
	 (return nil))
       ;; dotted list?
       (unless (and (listp ,tortoise)
		    (listp ,hare)
		    (listp (cdr ,hare)))
	 ,if-dotted
	 (return nil))
       ;; proper list, use element
       (setq ,var (car ,tortoise))
       ,@body)))

(defun proper-list-p (list)
  "If <list> is a proper list, return the number of elements, otherwise nil."
  (and (listp list)
       (listp (cdr list))
       (do-proper-list (ignore list t))))

(deftype proper-list ()
  `(and list (satisfies proper-list-p)))

(defun list-sum (list &key junk-allowed)
  "Return the sum of the elements of list, which must be numbers unless
junk-allowed is true, in which case non-numbers are ignored."
  (let ((sum 0))
    (if (do-proper-list (elt list t)
	  (if (numberp elt)
	      (incf sum elt)
	    (unless junk-allowed
	      (error 'type-error :datum elt :expected-type 'number))))
	sum
      (error 'type-error :datum list :expected-type 'proper-list))))

  Unfortunately, Allegro CL discourages the use of typed conditions by
  lacking any useful default :report method for most of them, but I believe
  the above is in the spirit of the language as specified, so those who
  want this to be more user-friendly may decide to use the internal
  function excl::.type-error with the datum and the exected-type as
  ordinary (not keyword) arguments, or the _non-standard_ arguments
  :format-control and :format-arguments that should only have been in
  simple-type-error.  If you dare to mess with the system internals, this
  also works well:

#+allegro
(defmethod print-object ((condition type-error) stream)
  (if (or *print-readably* *print-escape*)
      (call-next-method)
      (format stream "~1@<~@<~S is not of the expected type ~S~:@>~:@>"
	      (type-error-datum condition)
	      (type-error-expected-type condition))))

  This is one of those small things that make using the excellent condition
  system in Common Lisp properly less than enticing.

#:Erik
-- 
  Travel is a meat thing.