[Small-cl-src] Re: Small, occasionally handy piece of code

[Steven E. Harris]

Ingvar <ingvar at cathouse.bofh.se> writes:

> Haven't we all felt the need of generating combinations from a
> collection and calling a function for every combination?

I wrote one a while ago that may cons less because it requires use of
vectors to represent the sequences. The interface to
call-with-combinations is similar to yours, with the argument order
mixed up.

There's a lower-level function call-with-n-combo-slots that is useful
when one has both the source and working "target" vectors in hand. The
target vector is used to present the caller-provided function with the
current combination, similar to your "acc" argument.

-------------- next part --------------
;;; Combinations

(defun call-with-last-combo-slots (function source-vector start end
                                            target-vector pos)
  (loop for i from start below end
        do (setf (aref target-vector pos)
                 (aref source-vector i))
        (funcall function target-vector)))


(defun call-with-n-combo-slots (function source-vector src-start src-end
                                         target-vector tgt-start tgt-end)
  (labels ((rec (function source-vector src-start src-end
                          target-vector tgt-start tgt-end)
             (let ((slots-remaining (- tgt-end tgt-start)))
               (if (= 1 slots-remaining)
                   (call-with-last-combo-slots function
                                               source-vector src-start src-end
                                               target-vector tgt-start)
                   (loop 
                       for i-src from src-start to (- src-end slots-remaining)
                       do (setf (aref target-vector tgt-start)
                                (aref source-vector i-src))
                       (rec function
                            source-vector (1+ i-src) src-end
                            target-vector (1+ tgt-start) tgt-end))))))
    ;; TODO: This check is redundant when called from the function
    ;; below, but we want to protect the core loop above from
    ;; unchecked calls. We could just factor it out into a
    ;; non-exported function.
    (when (> tgt-end tgt-start)
      (rec function
           source-vector src-start src-end
           target-vector tgt-start tgt-end))))


(defun call-with-combinations (function k vector
                                        &key (start 0) (end (length vector)))
  (check-type k (integer 0) "a nonnegative integer")
  (when (not (zerop k))
    ;; TODO: Consider validating start and end.
    (when (< (- end start) k)
      (error "Not enough source slots to fill ~A target slots." k))
    (call-with-n-combo-slots function vector start end
                             (make-array k :element-type (array-element-type vector))
                             0 k)))




#+test
(call-with-n-combo-slots #'print (vector 1 2 3 4 5) 0 5
                         (vector 0 0 0) 0 2)

#+test
(call-with-combinations #'print 3 (vector 1 2 3 4 5))
-------------- next part --------------

-- 
Steven E. Harris        :: seharris at raytheon.com
Raytheon                :: http://www.raytheon.com