3

I want to implement Heap's algorithm in Scheme (Gambit).
I read his paper and checked out lots of resources but I haven't found many functional language implementations.

I would like to at least get the number of possible permutations.
The next step would be to actually print out all possible permutations.

Here is what I have so far:

  3 (define (heap lst n)
  4   (if (= n 1)
  5     0
  6     (let ((i 1) (temp 0))
  7       (if (< i n)
  8         (begin
  9           (heap lst (- n 1))
 10           (cond
 11             ; if even:  1 to n -1 consecutively cell selected
 12             ((= 0 (modulo n 2))
 13               ;(cons (car lst) (heap (cdr lst) (length (cdr lst)))))
 14               (+ 1 (heap (cdr lst) (length (cdr lst)))))
 15
 16             ; if odd:   first cell selectd
 17             ((= 1 (modulo n 2))
 18               ;(cons (car lst) (heap (cdr lst) (length (cdr lst)))))
 19               (+ 1 (heap (car lst) 1)))
 20           )
 21         )
 22         0
 23       )
 24     )
 25   )
 26 )
 27
 28 (define myLst '(a b c))
 29
 30 (display (heap myLst (length myLst)))
 31 (newline)

I'm sure this is way off but it's as close as I could get.
Any help would be great, thanks.

RonanCodes
  • 1,016
  • 9
  • 14

1 Answers1

6

Here's a 1-to-1 transcription of the algorithm described on the Wikipedia page. Since the algorithm makes heavy use of indexing I've used a vector as a data structure rather than a list:

(define (generate n A)
  (cond
    ((= n 1) (display A)
             (newline))
    (else    (let loop ((i 0))
               (generate (- n 1) A)
               (if (even? n)
                   (swap A i (- n 1))
                   (swap A 0 (- n 1)))
               (if (< i (- n 2))
                   (loop (+ i 1))
                   (generate (- n 1) A))))))

and the swap helper procedure:

(define (swap A i1 i2)
  (let ((tmp (vector-ref A i1)))
    (vector-set! A i1 (vector-ref A i2))
    (vector-set! A i2 tmp)))

Testing: 

Gambit v4.8.4

> (generate 3 (vector 'a 'b 'c))
#(a b c)
#(b a c)
#(c a b)
#(a c b)
#(b c a)
#(c b a)
uselpa
  • 18,732
  • 2
  • 34
  • 52
  • 1
    Thanks for the solution! – RonanCodes Mar 24 '16 at 01:42
  • 2
    I hate to put this down, but this question is tagged `[functional-programming]`, is one of the top hits on Google for a functional implementation of the algorithm, and seems to be decidedly non-functional. Do you know of a functional implementation? – Carcigenicate Jun 03 '18 at 01:07