For Programmers: Free Programming Magazines  


Home > Archive > Scheme > November 2005 > Permutation Generator









You are viewing an archived Text-only version of the thread. To view this thread in it's original format and/or if you want to reply to this thread please [click here]

 

Author Permutation Generator
A Little Scheme Monster

2005-11-23, 7:01 pm

Hi,

Does anyone have a PLT Scheme implementation of a function taking a
list or vector and returning a generator that generates permutations of
the list without repetitions, false if no more are available? (see
example below)

Of course, this only makes sense if the permutations aren't stored in
memory but really generated on the fly. Is that possible?

Best regards,

Eric

P.S. This is *not* a homework assignment!

------------
Permutation Generator Example:

(define generate (make-permutation-generator '(a b c)))

(generate)
==> (a b c)
(generate)
==> (a c b)
(generate)
==> (b a c)
(generate)
==> (b c a)
(generate)
==> (c a b)
(generate)
==> (c b a)
(generate)
==> #f

christophe.poucet@gmail.com

2005-11-23, 7:01 pm

Hello,

I'm not going to give the full implementation, but typically such
problems are solved by yielding. You write the algorithm to just make
all the permutatiions, and then you basically yield the current value
you're at. Typically yielding is done with continuations.

Regards,
Christophe

Ray Dillinger

2005-11-23, 7:01 pm

christophe.poucet@gmail.com wrote:
> Hello,
>
> I'm not going to give the full implementation, but typically such
> problems are solved by yielding. You write the algorithm to just make
> all the permutatiions, and then you basically yield the current value
> you're at. Typically yielding is done with continuations.


Hmm, that could work. My first thought was to close a function
over a number initialized to zero, and whenever the function is
called, increment the number and use it to generate a permutation.
It has the advantage, in most implementations, of being more
efficient than a continuation-based implementation.


Generating a permutation from a number with no repetitions is
relatively straightforward. A permutation is essentially a
mixed-base number where the bases decrease with diminishing
numbers of remaining choices. So instead of thousands, hundreds,
tens, units, you have (for a 5-element sequence) 4!'s, 3!'s,
2!'s and units. (the last "digit" represents the second-to-
last element, since there's no choice to make for the last
element; it's merely whichever one is left over.

So you take the number, divide it by 4!, and treat the
quotient as the choice-among-five for the first element;
then take the remainder, divide it by 3! and treate the
quotient as the choice-among-four for the second element;
etc.

Bear


Hermann Jurksch

2005-11-23, 9:57 pm

john@peppermind.com wrote:

> Hi,


> Does anyone have a PLT Scheme implementation of a function taking a
> list or vector and returning a generator that generates permutations of
> the list without repetitions, false if no more are available? (see
> example below)


> Of course, this only makes sense if the permutations aren't stored in
> memory but really generated on the fly. Is that possible?


> Best regards,


> Eric


Hi,

here is a solution, which should work, but it's not
at all elegant, needs full continuations and the
delivered permutations are not naturally sorted:

(define (make-permutations l)
(let ((call-up #f)
(call-back #f)
(result #f))
(letrec
((mll1 (lambda (l)
(if (null? l)
l
(if (null? (cdr l))
l
(cons (car l) (delay (mll1 (cdr l))))))))
(mll2 (lambda (left right)
(if (null? left)
right
(cons (car left) (delay (mll2 (cdr left) right))))))
(mp
(lambda (toplevel prefix lazy-list)
(if (null? lazy-list)
(call-with-current-continuation
(lambda (down)
(set! call-back down)
(call-up prefix)))
(letrec ((iter (lambda (left right)
(if (not (null? right))
(begin
(mp #f (cons (car right) prefix) (mll2 left (force (cdr right))))
(iter (cons (car right) left) (force (cdr right))))))))
(iter '() lazy-list)))
(if toplevel
(call-up #f)))))
(set! result
(call-with-current-continuation
(lambda (up)
(set! call-up up)
(mp #t '() (mll1 l)))))
(lambda ()
(let ((r result))
(if r
(set! result
(call-with-current-continuation
(lambda (up)
(set! call-up up)
(call-back #t)))))
r)))))

Regards
Hermann






John Gilson

2005-11-24, 3:59 am

"A Little Scheme Monster" <john@peppermind.com> wrote in message
news:1132755714.969940.286410@g14g2000cwa.googlegroups.com...
> Hi,
>
> Does anyone have a PLT Scheme implementation of a function taking a
> list or vector and returning a generator that generates permutations of
> the list without repetitions, false if no more are available? (see
> example below)
>
> Of course, this only makes sense if the permutations aren't stored in
> memory but really generated on the fly. Is that possible?
>
> Best regards,
>
> Eric
>
> P.S. This is *not* a homework assignment!
>
> ------------
> Permutation Generator Example:
>
> (define generate (make-permutation-generator '(a b c)))
>
> (generate)
> ==> (a b c)
> (generate)
> ==> (a c b)
> (generate)
> ==> (b a c)
> (generate)
> ==> (b c a)
> (generate)
> ==> (c a b)
> (generate)
> ==> (c b a)
> (generate)
> ==> #f


A natural way of doing this in Scheme is with streams, which are delayed lists.
If you're unfamiliar with this, see Section 3.5 of SICP which you can read at
http://mitpress.mit.edu/sicp/full-t...html#%_sec_3.5.

First, I'll define some basic streams functionality that the permutations function
will use.

;;; Stream constructor
;;; Defined as a macro so arguments are not evaluated upon being
;;; passed in, i.e., evaluation of both args is delayed
(define-syntax stream-cons
(syntax-rules ()
((stream-cons object stream)
(delay (cons object stream)))))

;;; Empty stream
(define stream-null (delay '()))

;;; Returns true if argument is the empty stream
(define (stream-null? stream)
(null? (force stream)))

;;; Selector returning first element of stream
(define (stream-car stream)
(car (force stream)))

;;; Selector returning rest of stream after first element
(define (stream-cdr stream)
(cdr (force stream)))

;;; Returns a finite stream constructed from a list
(define (list->stream l)
(if (null? l)
stream-null
(stream-cons (car l)
(list->stream (cdr l)))))

;;; Append streams that are the elements of the argument stream
(define (stream-append stream)
(if (stream-null? stream)
stream-null
(let ((head-stream (stream-car stream)))
(if (stream-null? head-stream)
(stream-append (stream-cdr stream))
(stream-cons (stream-car head-stream)
(stream-append (stream-cons (stream-cdr head-stream)
(stream-cdr
stream))))))))

;;; Return a stream with all elements from the input stream that
;;; satisfy the predicate
(define (stream-filter pred stream)
(cond ((stream-null? stream) stream-null)
((pred (stream-car stream))
(stream-cons (stream-car stream)
(stream-filter pred (stream-cdr stream))))
(else
(stream-filter pred (stream-cdr stream)))))

;;; Remove all elements of the given value from a stream
(define (stream-remove item stream)
(stream-filter (lambda (x) (not (eq? x item))) stream))

;;; Like map function on lists
(define (stream-map proc stream)
(if (stream-null? stream)
stream-null
(stream-cons (proc (stream-car stream))
(stream-map proc (stream-cdr stream)))))

(define (stream-flatmap proc stream)
(stream-append (stream-map proc stream)))

;;; The next function actually lazily computes permutations
;;; Given an input list of length L, return a stream of L-length
;;; permutations of this list
(define (stream-permutations l)
(define (permutations stream)
(if (stream-null? stream)
(stream-cons '() stream-null)
(stream-flatmap (lambda (elt)
(stream-map (lambda (p) (cons elt p))
(permutations (stream-remove elt
stream))))
stream)))
(permutations (list->stream l)))

;;; permutations
(define p (stream-permutations '(1 2 3 4 5 6 7 8 9 10))) ; 10! results lazily computed

;;; First result
(stream-car p)

;;; Second result
(stream-car (stream-cdr p))

;;; and so on

;;; Return list of first N elements of stream
(define (stream-take stream n)
(if (= n 0)
'()
(cons (stream-car stream)
(stream-take (stream-cdr stream) (- n 1)))))

;;; First 10 permutations
(stream-take p 10)

--
JAG


A Little Scheme Monster

2005-11-24, 7:57 am

Hermann's version gives error "force: expects argument of type
<promise>; given ()" in DrScheme, but perhaps he has deliberately left
some little error in it or is using another version of force. But as I
said, it's not for a homework assignment (I'm not studying CS anyway),
and the lazy stream version by John Gilson works like a charm. Thanks a
lot!!!

Perhaps someone should make a Scheme cookbook entry for that.
Permutations are sometimes needed, and when it's in a fixed place in
the Cookbook tutors can easily recognize copy-and-paste cheating.

Anyway, many thanks again!

Best regards,

Eric

Marcin 'Qrczak' Kowalczyk

2005-11-24, 7:57 am

"John Gilson" <jag@acm.org> writes:

> (define (stream-remove item stream)
> (stream-filter (lambda (x) (not (eq? x item))) stream))

[...]
> (define (stream-permutations l)
> (define (permutations stream)
> (if (stream-null? stream)
> (stream-cons '() stream-null)
> (stream-flatmap (lambda (elt)
> (stream-map (lambda (p) (cons elt p))
> (permutations (stream-remove elt
> stream))))
> stream)))
> (permutations (list->stream l)))


Doesn't it appply eq? to elements being permuted? Then its results are
not reliable if the elements are numbers.

--
__("< Marcin Kowalczyk
\__/ qrczak@knm.org.pl
^^ http://qrnik.knm.org.pl/~qrczak/
John Gilson

2005-11-24, 7:57 am

"Marcin 'Qrczak' Kowalczyk" <qrczak@knm.org.pl> wrote in message
news:871x16ck0a.fsf@qrnik.zagroda...
> "John Gilson" <jag@acm.org> writes:
>
> [...]
>
> Doesn't it appply eq? to elements being permuted? Then its results are
> not reliable if the elements are numbers.


Yes, eqv? would've been a better default choice.

Another simple change. For all k-length permutations, where 0<=k<=(length l),
the function can be written

(define (stream-permutations l k)
(define (permutations stream k)
(if (= k 0)
(stream-cons '() stream-null)
(stream-flatmap
(lambda (elt)
(stream-map (lambda (p) (cons elt p))
(permutations (stream-remove elt stream) (- k 1))))
stream)))
(permutations (list->stream l) k))

;;; All permutations of length 3
(define p (stream-permutations '(1 2 3 4 5 6 7 8 9 10) 3))

;;; List of 5 permutations
(stream-take p 5)

>
> --
> __("< Marcin Kowalczyk
> \__/ qrczak@knm.org.pl
> ^^ http://qrnik.knm.org.pl/~qrczak/



Hermann Jurksch

2005-11-24, 7:00 pm

john@peppermind.com wrote:

> Hermann's version gives error "force: expects argument of type
> <promise>; given ()" in DrScheme, but perhaps he has deliberately left
> some little error in it or is using another version of force. But as I
> said, it's not for a homework assignment (I'm not studying CS anyway),
> and the lazy stream version by John Gilson works like a charm. Thanks a
> lot!!!


The semantic of Gambit-C force is
(lambda (x) (if (promise? x) (force x) x)).
This should explain the error message.

Regards
Hermann
Sponsored Links







Also available: Server administration forum archive | Web Design forum archive | Software forum archive | Hardware reviews archive

Copyright 2008 codecomments.com