;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;
;;;   Touched: Fri Apr 13 08:24:08 2007 -0600 <madhu@cs>
;;;   Time-stamp: <2007-04-13 08:24:39 madhu>
;;;
(in-package "CL-USER")

(defun map-combinations (list k f)
  "LIST is a sequence of N elements. F is a function of K arguments.
F is called repeatedly on the different combinations of elements
of LIST, chosen K at a time. Adapted from comp.lang.lisp Message
<418E9715.64282438@ieee.org>"
  (let* ((n (length list))
         (o (make-array n :initial-contents list))
         (l (make-array (1+ k) :initial-element 0))
         (j k)
         (c (make-array (+ k 1 2) :initial-element 0)))
    (loop for i from 1 to k
          do (setf (svref l i) i
                   (svref c i) i))
    (apply f (loop for i below k collect (svref o i)))
    (setf (aref c (+ k 1 0)) (1+ n) (aref c (+ k 1 1)) 0)
    (prog (x)
     loop
       (when (> j 0)
         (setq x (1+ j))
         (go incr))
       (when (< (1+ (svref c 1)) (svref c 2))
         (incf (svref c 1))
         (apply f (loop for i from 1 to k collect (svref o (1- (svref c i)))))
         (go loop))
       (setq j 2)
     domore
       (setf (svref c (1- j)) (1- j))
       (setf x (1+ (svref c j)))
       (when (= x (svref c (1+ j))) (incf j) (go domore))
       (when (> j k) (return))
     incr
       (setf (svref c j) x)
       (apply f (loop for i from 1 to k collect (svref o (1- (svref c i)))))
       (decf j)
       (go loop))))

;;; Local Variables:
;;; eval: (put 'prog 'common-lisp-indent-function 'lisp-indent-tagbody)
;;; End: