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

Answer 1

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 '()))))))

Answer 2

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

Answer 3

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

Answer 4

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