Search code examples
functional-programmingschemelisppermutationgambit

Implementation of Heaps Algorithm in Scheme (permutation generation)


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.


Solution

  • 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)