From: Jimka
Subject: CPS transform to iterate over permuations
Date: 
Message-ID: <1157303186.153309.295950@i3g2000cwc.googlegroups.com>
I've written this function which calls the given ACTION function on
every
permutation of the elements of a given list.

With such a function i can implement a function to print all
permutations,
find all permutations which match a given predicate, find the first
such
permutation.  But what i'd like to do i just cannot get my head around.

I'd like to modify the function or make a varient of the function which
rather
than iterating over the permuations, rather on each iteration calls the
given
ACTION function on a permuation, and returns a function which can be
called
with no arguments will call the ACTION function on the next permutation
and return the next such continuation function.

Can this be done simply by refactoring LOOP-PERMUTATIONS, or must the
calling function as well as the ACTION function also be CPS
transformed?

Could someone please show me how this transformation can be done?

thanks.

(defun loop-permutations (elements action)
  (labels ((do-perms (rest-elements current-perm)
	    (dolist (element rest-elements)
	      (let ((rest-elements (remove-preserving-tail element
							   rest-elements)))
		(do-perms rest-elements (cons element current-perm))))
	    (unless rest-elements
	      (funcall action current-perm))))
    (do-perms elements nil)))


;; example usage of loop-permutations
(defun find-all-matching-permutations (elements predicate)
  (let (perms)
    (loop-permutations elements
		       (lambda (perm)
			 (when (funcall predicate perm)
			   (pushnew perm perms :test #'equal))))
    perms))

(defun find-palendrones (elements)
  (find-all-matching-permutations elements
				  (lambda (perm)
				    (equal perm (reverse perm)))))

From: Jens Axel Søgaard
Subject: Re: CPS transform to iterate over permuations
Date: 
Message-ID: <44fb129b$0$860$edfadb0f@dread12.news.tele.dk>
Jimka skrev:

> I'd like to modify the function or make a varient of the function which
> rather than iterating over the permuations, rather on each iteration calls 
 > the given ACTION function on a permuation, and returns a function
 > which can be called with no arguments will call the ACTION function
 > on the next permutation and return the next such continuation
 > function.

If only call-with-current-continuation were available...

Anyways, perhaps you can find an algorithm suited for generation
of the permuations one at a time in Knuth's volume 4?

     <http://www-cs-faculty.stanford.edu/~uno/fasc2b.ps.gz>

-- 
Jens Axel S�gaard
From: Jimka
Subject: Re: CPS transform to iterate over permuations
Date: 
Message-ID: <1157305419.368335.60120@m73g2000cwd.googlegroups.com>
yes i read that fascile but it did not touch on the concept of CPS
transform
as far as i recall... He mainly emphasized how to do the computation
in a way that was measureable and efficient as possible.   Although i
did not figure out from reading it how to generate the Nth permuation
of a list.  :-(  or how given the Nth permuation how to generate the
nth+first. :-(

-jim


Jens Axel Søgaard wrote:
> Jimka skrev:
>
> > I'd like to modify the function or make a varient of the function which
> > rather than iterating over the permuations, rather on each iteration calls
>  > the given ACTION function on a permuation, and returns a function
>  > which can be called with no arguments will call the ACTION function
>  > on the next permutation and return the next such continuation
>  > function.
>
> If only call-with-current-continuation were available...
>
> Anyways, perhaps you can find an algorithm suited for generation
> of the permuations one at a time in Knuth's volume 4?
>
>      <http://www-cs-faculty.stanford.edu/~uno/fasc2b.ps.gz>
> 
> -- 
> Jens Axel Søgaard
From: Jens Axel Søgaard
Subject: Re: CPS transform to iterate over permuations
Date: 
Message-ID: <44fb23c0$0$863$edfadb0f@dread12.news.tele.dk>
Jimka skrev:
> yes i read that fascile but it did not touch on the concept of CPS
> transform as far as i recall... 

True.

> He mainly emphasized how to do the computation
> in a way that was measureable and efficient as possible.   Although i
> did not figure out from reading it how to generate the Nth permuation
> of a list.  :-(  or how given the Nth permuation how to generate the
> nth+first. :-(

If you want to visit the permutations in lexicographical order,
you can use Algoritm L on page 1 and 2 of the note.

Steps L2, L3 and L4 describes how to go from a permutation to the next.

-- 
Jens Axel S�gaard
From: levy
Subject: Re: CPS transform to iterate over permuations
Date: 
Message-ID: <1157356855.788647.253100@h48g2000cwc.googlegroups.com>
I'm not sure if this helps, but still...

Did you take a look at arnesi? It uses CPS transformation and supports
a limited call/cc.

http://common-lisp.net/project/bese/arnesi.html
http://www.cliki.net/CPS

levy
From: Damien Diederen
Subject: Re: CPS transform to iterate over permuations
Date: 
Message-ID: <87ejuseixm.fsf@keem.bcc>
Hi Jim,

"Jimka" <·····@rdrop.com> writes:
> I've written this function which calls the given ACTION function on
> every permutation of the elements of a given list.
>
> With such a function i can implement a function to print all
> permutations, find all permutations which match a given predicate,
> find the first such permutation.  But what i'd like to do i just
> cannot get my head around.
>
> I'd like to modify the function or make a varient of the function
> which rather than iterating over the permuations, rather on each
> iteration calls the given ACTION function on a permuation, and
> returns a function which can be called with no arguments will call
> the ACTION function on the next permutation and return the next such
> continuation function.

Cf. below.

> Can this be done simply by refactoring LOOP-PERMUTATIONS, or must
> the calling function as well as the ACTION function also be CPS
> transformed?

Any "continuable" function has to be CPS-transformed, since there is
no support for general continuations in the language.

> Could someone please show me how this transformation can be done?
> thanks.
>
> (defun loop-permutations (elements action)
>   (labels ((do-perms (rest-elements current-perm)
>           (dolist (element rest-elements)
>             (let ((rest-elements (remove-preserving-tail element
>                                                          rest-elements)))
>               (do-perms rest-elements (cons element current-perm))))
>           (unless rest-elements
>             (funcall action current-perm))))
>     (do-perms elements nil)))

Hmm... let's start by creating a CPS version of DOLIST, in which THUNK
gets repeatedly called with two arguments: the current element and a
continuation.  Note that K is the continuation of the loop itself.

,----
| (defun do-list-k (elements thunk k)
|   (cond (elements 
|          (funcall thunk (car elements) 
|                   (lambda () (do-list-k (cdr elements) thunk k))))
|         (t
|          (funcall k))))
`----

It then becomes a matter of porting your algorithm to use DO-LIST-K:

,----
| (defun loop-permutations-k (elements action k)
|   (labels ((do-perms-k (rest-elements current-perm rec-k)
|              (do-list-k rest-elements
|                (lambda (element loop-k)
|                  (let ((rest-elements (remove element rest-elements)))
|                    (do-perms-k rest-elements (cons element current-perm)
|                                loop-k)))
|                (lambda ()
|                  (cond ((null rest-elements)
|                         (funcall action current-perm rec-k))
|                        (t
|                         (funcall rec-k)))))))
|     (do-perms-k elements nil k)))
`----

Two intermediate continuations are used in the above code: LOOP-K,
which continues the iteration at a given level, and REC-K, which
"returns" from a recursive call.

> ;; example usage of loop-permutations
> (defun find-all-matching-permutations (elements predicate)
>   (let (perms)
>     (loop-permutations elements
>                      (lambda (perm)
>                        (when (funcall predicate perm)
>                          (pushnew perm perms :test #'equal))))
>     perms))
>
> (defun find-palendrones (elements)
>   (find-all-matching-permutations elements
>                                 (lambda (perm)
>                                   (equal perm (reverse perm)))))

Yes; those have to be CPS-transformed to become "continuable"; here is
how it can be done for FIND-ALL-MATCHING-PERMUTATIONS:

,----
| (defun find-all-matching-permutations (elements predicate)
|   (loop-permutations-k elements
|        (lambda (perm k)
|          (if (funcall predicate perm)
|              (values perm k)
|              (funcall k)))
|        (lambda () (values))))
`----

Cheers,
Damien

-- 
http://foobox.net/~dash/

If you think education is expensive, try ignorance.
                -- Derek Bok
From: Alan Crowe
Subject: Re: CPS transform to iterate over permuations
Date: 
Message-ID: <86zmddni8r.fsf@cawtech.freeserve.co.uk>
"Jimka" <·····@rdrop.com> writes:
> I've written this function which calls the given ACTION
> function on every permutation of the elements of a given
> list.
...
> I'd like to modify the function or make a varient of the
> function which rather than iterating over the permuations,
> rather on each iteration calls the given ACTION function
> on a permuation, and returns a function which can be
> called with no arguments will call the ACTION function on
> the next permutation and return the next such continuation
> function.

My CPS-fu isn't strong enough to let me tackle your
code. Instead I've written a permutation generator as a
single recursive function, wrapped by

(defun call-on-permutations (function elements)
  (perm function
        (reverse elements) ;all elements
        (reverse elements) ;permitted first choices
        '() ;already chosen
        ))

which just sets up the extra arguments. The idea of my code
is that  abc acb bac bca cab cba gets split into two cases:

abc acb --- definitely start with a, make a recursive call
            to generate all permutations on {b,c}

bac bca cab cba --- start with b or c but with `a' still an
                    option later in the permutation

(defun perm (function elements start-set stack)
  (if start-set
      (let ((remainder (remove (first start-set) elements))
            (chosen (cons (first start-set) stack)))
        (if remainder
            (perm function
                  remainder
                  remainder
                  chosen)
            (funcall function chosen))
        (perm function
              elements
              (rest start-set)
              stack))))

I am able to CPS transform that to this:

(defun perm (continuation function elements start-set stack)
  (if start-set
      (let ((remainder (remove (first start-set) elements))
            (chosen (cons (first start-set) stack)))
        (labels ((second-step ()
                   (perm continuation
                         function
                         elements
                         (rest start-set)
                         stack)))
          (if remainder
              (perm #'second-step
                    function
                    remainder
                    remainder
                    chosen)
              (funcall function chosen #'second-step))))
      (funcall continuation)))

and try it out using

(defun call-on-permutations/cont (function elements)
  (perm (constantly 'finished)
        function
        (reverse elements) ;all elements
        (reverse elements) ;permitted first choices
        '() ;already chosen
        ))

and

(defun print-and-prompt (data continuation)
  (print data)
  (when (y-or-n-p "More? ")
    (funcall continuation)))

CL-USER> (call-on-permutations/cont #'print-and-prompt '(1 2 3 4))

(1 2 3 4) 
More? y

(2 1 3 4) 
More? y

(1 3 2 4) 
More? y

(3 1 2 4) 
More? n

NIL

Alan Crowe
Edinburgh
Scotland