;;; along with SOD; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-(cl:defpackage #:sod-utilities
- (:use #:common-lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (handler-bind ((warning #'muffle-warning))
+ (cl:defpackage #:sod-utilities
+ (:use #:common-lisp
- ;; MOP from somewhere.
- #+sbcl #:sb-mop
- #+(or cmu clisp) #:mop
- #+ecl #:clos))
+ ;; MOP from somewhere.
+ #+sbcl #:sb-mop
+ #+(or cmu clisp) #:mop
+ #+ecl #:clos))))
(cl:in-package #:sod-utilities)
and return the result of appending all of the resulting lists."
(reduce #'append (apply #'mapcar function list more-lists) :from-end t))
+(export 'cross-product)
+(defun cross-product (&rest pieces)
+ "Return the cross product of the PIECES.
+
+ Each arguments may be a list, or a (non-nil) atom, which is equivalent to
+ a singleton list containing just that atom. Return a list of all possible
+ lists which can be constructed by taking one item from each argument list
+ in turn, in an arbitrary order."
+ (reduce (lambda (piece tails)
+ (mapcan (lambda (tail)
+ (mapcar (lambda (head)
+ (cons head tail))
+ (if (listp piece) piece
+ (list piece))))
+ tails))
+ pieces
+ :from-end t
+ :initial-value '(nil)))
+
(export 'distinguished-point-shortest-paths)
(defun distinguished-point-shortest-paths (root neighbours-func)
"Moderately efficient shortest-paths-from-root computation.
(setf (gethash k seen) item)))))
sequence)))
((listp sequence)
- (mapl (lambda (tail)
- (let* ((item (car tail))
- (rest (cdr tail))
- (match (member (funcall key item) rest
- :test test :key key)))
- (when match (funcall report item (car match)))))
- sequence))
+ (do ((tail sequence (cdr tail))
+ (i 0 (1+ i)))
+ ((endp tail))
+ (let* ((item (car tail))
+ (match (find (funcall key item) sequence
+ :test test :key key :end i)))
+ (when match (funcall report item match)))))
((vectorp sequence)
(dotimes (i (length sequence))
(let* ((item (aref sequence i))
(pos (position (funcall key item) sequence
- :key key :test test :start (1+ i))))
+ :key key :test test :end i)))
(when pos (funcall report item (aref sequence pos))))))
(t
(error 'type-error :datum sequence :expected-type 'sequence))))