Circular permutation in scheme

Question

Hello I try to make circular permutations in Scheme (Dr. Racket) using recursion.

For example, if we have (1 2 3) a circular permutation gives ((1 2 3) (2 3 1) (3 1 2)).

I wrote a piece of code but I have a problem to make the shift.

My code:

(define cpermit
  (lambda (lst)
    (cpermitAux lst (length lst))))

(define cpermitAux
  (lambda (lst n)
    (if (zero? n) '()
        (append (cpermitAux lst (- n 1)) (cons lst '())))))

Where (cpermit '(1 2 3)) gives '((1 2 3) (1 2 3) (1 2 3))

The issue here is that you never actually do anything to `lst` that would rearrange its elements. The only place it is actually used (as opposed to just threading it through calls to `cpermitAux`) is in `(cons lst '())`, which just uses `lst` without modification. The recursive call also just passes `lst` without modification, so all you’ve done is implement a `replicate` function. — Alexis King, Aug 14 '16 at 08:30

score 2 · Accepted Answer · answered Aug 14 '16 at 10:48

You can use function that shifts your list

(defun lshift (l) (append (cdr l) (list (car l))))

This will shift your list left.

Use this function before appendings

(define cpermit
  (lambda (lst)
    (cpermitAux lst (length lst))))

(define cpermitAux
  (lambda (lst n)
    (if (zero? n) '()
      (append (cpermitAux (lshift lst) (- n 1)) (lshift (cons lst '()))))))

score 2 · Answer 2 · answered Aug 15 '16 at 20:40

This answer is a series of translations of @rnso's code, modified to use a recursive helper function instead of repeated set!.

#lang racket
(define (cpermit sl)
  ;; n starts at (length sl) and goes towards zero
  ;; sl starts at sl
  ;; outl starts at '()
  (define (loop n sl outl)
    (cond [(zero? n) outl]
          [else
           (loop (sub1 n) ; the new n
                 (append (rest sl) (list (first sl))) ; the new sl
                 (cons sl outl))])) ; the new outl
  (loop (length sl) sl '()))

> (cpermit (list 1 2 3 4))
(list (list 4 1 2 3) (list 3 4 1 2) (list 2 3 4 1) (list 1 2 3 4))

For a shorthand for this kind of recursive helper, you can use a named let. This brings the initial values up to the top to make it easier to understand.

#lang racket
(define (cpermit sl)
  (let loop ([n (length sl)] ; goes towards zero
             [sl sl]
             [outl '()])
    (cond [(zero? n) outl]
          [else
           (loop (sub1 n) ; the new n
                 (append (rest sl) (list (first sl))) ; the new sl
                 (cons sl outl))]))) ; the new outl

> (cpermit (list 1 2 3 4))
(list (list 4 1 2 3) (list 3 4 1 2) (list 2 3 4 1) (list 1 2 3 4))

To @rnso, you can think of the n, sl, and outl as fulfilling the same purpose as "mutable variables," but this is really the same code as I wrote before when I defined loop as a recursive helper function.

The patterns above are very common for accumulators in Scheme/Racket code. The (cond [(zero? n) ....] [else (loop (sub1 n) ....)]) is a little annoying to write out every time you want a loop like this. So instead you can use for/fold with two accumulators.

#lang racket
(define (cpermit sl)
  (define-values [_ outl]
    (for/fold ([sl sl] [outl '()])
              ([i (length sl)])
      (values (append (rest sl) (list (first sl))) ; the new sl
              (cons sl outl)))) ; the new outl
  outl)

> (cpermit (list 1 2 3 4))
(list (list 4 1 2 3) (list 3 4 1 2) (list 2 3 4 1) (list 1 2 3 4))

You might have noticed that the outer list has the (list 1 2 3 4) last, the (list 2 3 4 1) second-to-last, etc. This is because we built the list back-to-front by pre-pending to it with cons. To fix this, we can just reverse it at the end.

#lang racket
(define (cpermit sl)
  (define-values [_ outl]
    (for/fold ([sl sl] [outl '()])
              ([i (length sl)])
      (values (append (rest sl) (list (first sl))) ; the new sl
              (cons sl outl)))) ; the new outl
  (reverse outl))

> (cpermit (list 1 2 3 4))
(list (list 1 2 3 4) (list 2 3 4 1) (list 3 4 1 2) (list 4 1 2 3))

And finally, the (append (rest sl) (list (first sl))) deserves to be its own helper function, because it has a clear purpose: to rotate the list once around.

#lang racket
;; rotate-once : (Listof A) -> (Listof A)
;; rotates a list once around, sending the first element to the back
(define (rotate-once lst)
  (append (rest lst) (list (first lst))))

(define (cpermit sl)
  (define-values [_ outl]
    (for/fold ([sl sl] [outl '()])
              ([i (length sl)])
      (values (rotate-once sl) ; the new sl
              (cons sl outl)))) ; the new outl
  (reverse outl))

> (cpermit (list 1 2 3 4))
(list (list 1 2 3 4) (list 2 3 4 1) (list 3 4 1 2) (list 4 1 2 3))

rnso · Answer 3 · 2016-08-14T23:25:13.703

1

Following code also works (without any helper function):

(define (cpermit sl)
  (define outl '())
  (for((i (length sl)))
    (set! sl (append (rest sl) (list (first sl))) )
    (set! outl (cons sl outl)))
  outl)

(cpermit '(1 2 3 4))

Output is:

'((1 2 3 4) (4 1 2 3) (3 4 1 2) (2 3 4 1))

edited Aug 14 '16 at 23:25

answered Aug 14 '16 at 23:19

rnso

23,686
25
112
234

1

That's fine *but*, "without any helper functions" should not be a goal. Helper functions are a good thing, especially if they have clear purposes – Alex Knauth Aug 15 '16 at 20:00
1

Also, you should avoid `set!`, since imperative code can disable optimizations. Instead, you could use a recursive helper function. If you want, you can define the helper function within the body of the `cpermit` function, I'll post an answer translating yours to that pattern – Alex Knauth Aug 15 '16 at 20:07

rnso · Answer 4 · 2016-08-16T09:25:47.583

Following solution is functional and short. I find that in many cases, helper functions can be replaced by default arguments:

(define (cpermit_1 sl (outl '()) (len (length sl)))
  (cond ((< len 1) outl)
        (else (define sl2 (append (rest sl) (list (first sl))))
              (cpermit_1 sl2 (cons sl2 outl) (sub1 len)))))

The output is:

(cpermit_1 '(1 2 3 4))
'((1 2 3 4) (4 1 2 3) (3 4 1 2) (2 3 4 1))

Circular permutation in scheme

4 Answers4