Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!tut.cis.ohio-state.edu!ucbvax!agate!labrea!csli!johnson
From: johnson@csli.STANFORD.EDU (Mark Johnson)
Newsgroups: comp.lang.lisp
Subject: Re: lisp problem
Keywords: help
Message-ID: <8493@csli.STANFORD.EDU>
Date: 11 Apr 89 20:06:42 GMT
References: <10053@ihlpl.ATT.COM>
Sender: johnson@csli.Stanford.EDU (Mark Johnson)
Reply-To: johnson@csli.stanford.edu (Mark Johnson)
Organization: Center for the Study of Language and Information, Stanford U.
Lines: 74

#| /*
canoura@ihlpl.ATT.COM asks...

By using recursion and the Append function, Given a list of
nondistinct elements and a positive number K where K is <=
the size of the list, I need to write a function which returns
a list, the element of whose are the combinations of the 
element of the given list taken K at a time. 
e.g.(COMB '(n1 n2 ....n) K)

Examples. ( COMB is the name of the function)

(COMB '(1 2 3 ) 2) should return  
  ((1 2) (1 3) (2 3))

(COMB '(1 2 3) 3) should return
  ((1 2 3))

(COMB '(1 2 3) 1) should return
  ((1) (2) (3))
  */

/* Here is the complete prolog program to solve this problem! */

sublist([],[]).
sublist([E|S],[E|L]) :- sublist(S,L).
sublist(S,[_|L]) :- sublist(S,L).

/*  Here's a sample run 

?- length(L,2),sublist(L,[1,2,3]).  % length is built-in in my Prolog
L = [1,2] ;
L = [1,3] ;
L = [2,3] ;
No more solutions.

*/
|#

;;; Now we switch to Lisp
;;;
;;; We use the standard trick of modelling a Prolog procedure
;;; with a Lisp procedure plus an accumulator (here called 'so-far').
;;; We loose the neat pattern matching abilities of Prolog in Lisp,
;;; so we approximate them with the additional argument 'elts-needed'.
;;;
;;; It doesn't have the brevity of the Prolog solution, but the essential
;;; recursive structure is still visible (if you squint a bit).  Note
;;; that it is pure Lisp (in the real sense, not even iteration).

(defun comb (elts n)
  (labels ((try (so-far partial-soln remaining-elts elts-needed)
             (if (= elts-needed 0)
               (cons partial-soln so-far)
               (if (consp remaining-elts)
                 (try (try so-far 
                           (cons (first remaining-elts) partial-soln)
                           (rest remaining-elts)
                           (1- elts-needed))
                      partial-soln
                      (rest remaining-elts)
                      elts-needed)
                 so-far))))
    (try '() '() elts n)))

#|
? (comb '(1 2 3) 2)
((3 2) (3 1) (2 1))
? (comb '(1 2 3 4) 3)
((4 3 2) (4 3 1) (4 2 1) (3 2 1))
|#

;;; You can get the order required in the original problem by reversing
;;; each list before it is put on the accumulator.