Re: "Interleave" permutation algorithm?

pjb@xxxxxxxxxxxxxxxxx (Pascal J. Bourguignon) writes:

mike3 <mike4ty4@xxxxxxxxx> writes:

On Aug 25, 8:00 pm, p...@xxxxxxxxxxxxxxxxx (Pascal J. Bourguignon)
wrote:
mike3 <mike4...@xxxxxxxxx> writes:
Is there a fast algorithm to compute the "interleave" and
"deinterleave" permutation of any even-number-length data in-place?

Yes.  Any in place permutation can be implemented in O(1) space and
O(n) time, n being the length of the sequence.


So what would be a good in-place algorithm for this permutation?

;; A good one, but not the best:
#+emacs (require 'cl)

(defun interleave (vector)
(flet ((swap (i j) (rotatef (elt vector i) (elt vector j))))
(swap 1 5) ; (0 1 2 3 4 5 6 7 8 9)
(swap 2 5) ; (0 5 2 3 4 1 6 7 8 9)
(swap 3 6) ; (0 5 1 3 4 2 6 7 8 9)
(swap 4 5) ; (0 5 1 6 2 4 3 7 8 9)
(swap 5 7) ; (0 5 1 6 2 7 3 4 8 9)
(swap 7 8) ; (0 5 1 6 2 7 3 8 4 9)
vector))

(let ((v (vector 0 1 2 3 4 5 6 7 8 9)))
(interleave v)
v)
[0 5 1 6 2 7 3 8 4 9]

(Notice that deinterleave is the same with the order of swaps reversed,
(swap 7 8) first and (swap 1 5) last).


Of course, the question is to generate this sequence of swap for any
even length of vector. And we can optimize the shuffling, by
processing the vector cycle by cycle and avoiding storing moving
values in the vector.

I'll give the answer this evening. ;-)

Ok, here is the answer. (An interesting problem can't wait).


;;; Common Lisp code follows. If you want to try it out, you can
;;; download any Common Lisp implementation, such as
;;; http://clisp.cons.org http://sbcl.sf.net etc.

;;; Three-semicolon comments are explainations, Two-semicolon comments
;;; are examples. The results are after the --> arrow. To try the
;;; example at the REPL (interactive loop), just remove the
;;; semi-colons prefixing the expressions.


;;; IOTA is used only to generate use cases.

(defun iota (count &optional start step)
"
RETURN: A list containing the elements
(start start+step ... start+(count-1)*step)
The start and step parameters default to 0 and 1, respectively.
This procedure takes its name from the APL primitive.
EXAMPLES: (iota 5) => (0 1 2 3 4)
(iota 5 0 -0.1) => (0 -0.1 -0.2 -0.3 -0.4)
"
(setf start (or start 0) step (or step 1))
(when (< 0 count)
(do ((result '())
(item (+ start (* step (1- count))) (- item step)))
((< item start) result)
(push item result))))



;;; Most of the following code is meta programming. That is, the
;;; complexities of the algorithms don't matter at run-time, only when
;;; the wanted interleave and deinterleave algorithms are generated.


;;; We will build the INTERLEAVE-PERMUTATION of (iota n) to find in it
;;; the cycles. This is done in O(n).

;; (0 1 2 3 4 5 6 7 8 9)
;; (0 1 2 3 4 )
;; ( 5 6 7 8 9)
;; (0 1 2 3 4 )
;; ( 5 6 7 8 9)
;; (0 5 1 6 2 7 3 8 4 9)

(defun interleave-permutation (length)
"Returns the interleave permutation of the vector (iota length)."
(assert (evenp length))
(coerce (loop
:for l :from 0 :below (/ length 2)
:for r :from (/ length 2)
:collect l :collect r) 'vector))

;; (interleave-permutation 20)
;; --> #(0 10 1 11 2 12 3 13 4 14 5 15 6 16 7 17 8 18 9 19)



;;; PERMUTATION-CYCLES will find the cycles of any permutation of
;;; (iota n). This is done in O(n): we visit each slot of the vector
;;; once, marking it visited, and following the cycles.

(defun permutation-cycles (permutation)
"
PERMUTATION: A permutation of (iota (length permutation))
RETURN: A list of cycles in the permutation.
Each cycle is represented by an open path of the cycle
The order of the cycles is unspecified.
The starting element of the cycles is unspecified.
The meaning of (a0... ai aj ... an) is that
the aith element goes to the ajth position, and
the anth element goes to the a0th position.
EXAMPLE: (permutation-cycles #(1 2 3 0 4 6 7 8 5))
--> ((0 1 2 3) (4) (5 6 7 8))
"
(loop
:with cycles = '()
:with walked = (make-array (length permutation) :initial-element nil)
:for i :from 0 :below (length permutation)
:do (unless (aref walked i)
(loop
:with cycle = '()
:for k = i :then (elt permutation k)
:until (aref walked k)
:do (push k cycle) (setf (aref walked k) t)
:finally (push cycle cycles)))
:finally (return cycles)))


;; (values (iota 16) (interleave-permutation 16) (permutation-cycles (interleave-permutation 16)))
;; -->
;; (00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15)
;; #(00 08 01 09 02 10 03 11 04 12 05 13 06 14 07 15)
;; ((15) (14 13 11 07) (10 05) (06 12 09 03) (02 04 08 01) (00))


;;; Now that we have cycles, we can generate the rotation of the
;;; elements in the cycle. In Common Lisp we have a ROTATEF operator
;;; that could be used to do it in one step. It is used here only for
;;; two elements (reducing to a swap operation), so you can easily
;;; transpose the algorithm to other programming languages lacking a
;;; variable arity ROTATEF operator.
;;;
;;; We use two temporaries so we can generate reading and writing each
;;; slot only once. GENERATE-CYCLE-SWAPS itself is O(n), n being the
;;; length of the cycle.
;;;
;;; Notice that in the code generated, there is only O(n) operations
;;; (at most one read and one write for each slot of the vector, n
;;; being the length of the vector.

(defun generate-cycle-swaps (cycle vector-name)
"
CYCLE: A list of positions.
The meaning of (a0... ai aj ... an) is that
the aith element goes to the ajth position, and
the anth element goes to the a0th position.
RETURN: Code implementing the permutation corresponding to the
cycle shifting.
"
(case (length cycle)
((0 1) '(progn)) ; nothing to do.
((2) `(rotatef (elt ,vector-name ,(first cycle))
(elt ,vector-name ,(second cycle))))
(otherwise
`(let ((t1 (elt ,vector-name ,(first cycle)))
t2)
,@(loop
:for step :from 0
:for j :in (rest cycle)
:collect (if (evenp step)
`(setf t2 (elt ,vector-name ,j)
(elt ,vector-name ,j) t1)
`(setf t1 (elt ,vector-name ,j)
(elt ,vector-name ,j) t2)) :into expressions
:finally (return (append expressions
(list (if (evenp step)
`(setf (elt ,vector-name ,(first cycle)) t1)
`(setf (elt ,vector-name ,(first cycle)) t2))))))))))

;; (setf *print-circle* nil
;; *PRINT-PRETTY* t)
;;
;; (mapcar (lambda (cycle) (generate-cycle-swaps cycle 'vector))
;; (permutation-cycles (interleave-permutation 16)))
;; -->
;; ((PROGN)
;; (LET ((T1 (ELT VECTOR 14)) T2)
;; (SETF T2 (ELT VECTOR 13) (ELT VECTOR 13) T1)
;; (SETF T1 (ELT VECTOR 11) (ELT VECTOR 11) T2)
;; (SETF T2 (ELT VECTOR 7) (ELT VECTOR 7) T1)
;; (SETF (ELT VECTOR 14) T2))
;; (ROTATEF (ELT VECTOR 10) (ELT VECTOR 5))
;; (LET ((T1 (ELT VECTOR 6)) T2)
;; (SETF T2 (ELT VECTOR 12) (ELT VECTOR 12) T1)
;; (SETF T1 (ELT VECTOR 9) (ELT VECTOR 9) T2)
;; (SETF T2 (ELT VECTOR 3) (ELT VECTOR 3) T1)
;; (SETF (ELT VECTOR 6) T2))
;; (LET ((T1 (ELT VECTOR 2)) T2)
;; (SETF T2 (ELT VECTOR 4) (ELT VECTOR 4) T1)
;; (SETF T1 (ELT VECTOR 8) (ELT VECTOR 8) T2)
;; (SETF T2 (ELT VECTOR 1) (ELT VECTOR 1) T1)
;; (SETF (ELT VECTOR 2) T2))
;; (PROGN))



;;; Now we can generate the interleave and deinterleave functions. We
;;; just wrap calls to the GENERATE-CYCLE-SWAPS function for each
;;; cycle in a function.
;;;
;;; For deinterleave, we reverse the order of each cycle.
;;;
;;; Since the function called are all O(n), and the loop (hidden in
;;; MAPCAR) covers different ranges of the input, these generations
;;; are done in O(n) (n being the LENGTH parameter).

(defun generate-interleave (name length)
(assert (and (not (minusp length)) (evenp length)))
`(defun ,name (vector)
(assert (= ,length (length vector)))
,@(mapcar (lambda (cycle) (generate-cycle-swaps cycle 'vector))
(permutation-cycles (interleave-permutation length)))
vector))

(defun generate-deinterleave (name length)
(assert (and (not (minusp length)) (evenp length)))
`(defun ,name (vector)
(assert (= ,length (length vector)))
,@(mapcar (lambda (cycle) (generate-cycle-swaps (reverse cycle) 'vector))
(permutation-cycles (interleave-permutation length)))
vector))


;;; Finally we define a macro to define these couple of functions easily.
;;; In another programming language, you would just use the equivalent
;;; of the above function to generate a source file, and feed it to
;;; your compiler.

(defmacro define-interleave-functions (interleave-name deinterleave-name length)
`(values
,(generate-interleave interleave-name length)
,(generate-deinterleave deinterleave-name length)))


;; (generate-interleave 'interleave-16 16)
;; -->
;; (DEFUN INTERLEAVE-16 (VECTOR)
;; (ASSERT (= 16 (LENGTH VECTOR)))
;; (PROGN)
;; (LET ((T1 (ELT VECTOR 14)) T2)
;; (SETF T2 (ELT VECTOR 13) (ELT VECTOR 13) T1)
;; (SETF T1 (ELT VECTOR 11) (ELT VECTOR 11) T2)
;; (SETF T2 (ELT VECTOR 7) (ELT VECTOR 7) T1)
;; (SETF (ELT VECTOR 14) T2))
;; (ROTATEF (ELT VECTOR 10) (ELT VECTOR 5))
;; (LET ((T1 (ELT VECTOR 6)) T2)
;; (SETF T2 (ELT VECTOR 12) (ELT VECTOR 12) T1)
;; (SETF T1 (ELT VECTOR 9) (ELT VECTOR 9) T2)
;; (SETF T2 (ELT VECTOR 3) (ELT VECTOR 3) T1)
;; (SETF (ELT VECTOR 6) T2))
;; (LET ((T1 (ELT VECTOR 2)) T2)
;; (SETF T2 (ELT VECTOR 4) (ELT VECTOR 4) T1)
;; (SETF T1 (ELT VECTOR 8) (ELT VECTOR 8) T2)
;; (SETF T2 (ELT VECTOR 1) (ELT VECTOR 1) T1)
;; (SETF (ELT VECTOR 2) T2))
;; (PROGN)
;; VECTOR)

;; (generate-deinterleave 'deinterleave-16 16)
;; -->
;; (DEFUN DEINTERLEAVE-16 (VECTOR)
;; (ASSERT (= 16 (LENGTH VECTOR)))
;; (PROGN)
;; (LET ((T1 (ELT VECTOR 7)) T2)
;; (SETF T2 (ELT VECTOR 11) (ELT VECTOR 11) T1)
;; (SETF T1 (ELT VECTOR 13) (ELT VECTOR 13) T2)
;; (SETF T2 (ELT VECTOR 14) (ELT VECTOR 14) T1)
;; (SETF (ELT VECTOR 7) T2))
;; (ROTATEF (ELT VECTOR 5) (ELT VECTOR 10))
;; (LET ((T1 (ELT VECTOR 3)) T2)
;; (SETF T2 (ELT VECTOR 9) (ELT VECTOR 9) T1)
;; (SETF T1 (ELT VECTOR 12) (ELT VECTOR 12) T2)
;; (SETF T2 (ELT VECTOR 6) (ELT VECTOR 6) T1)
;; (SETF (ELT VECTOR 3) T2))
;; (LET ((T1 (ELT VECTOR 1)) T2)
;; (SETF T2 (ELT VECTOR 8) (ELT VECTOR 8) T1)
;; (SETF T1 (ELT VECTOR 4) (ELT VECTOR 4) T2)
;; (SETF T2 (ELT VECTOR 2) (ELT VECTOR 2) T1)
;; (SETF (ELT VECTOR 1) T2))
;; (PROGN)
;; VECTOR)

;; (define-interleave-functions interleave-16 deinterleave-16 16)
;; -->
;; INTERLEAVE-16
;; DEINTERLEAVE-16
;;
;; (interleave-16 (iota 16))
;; -->
;; (0 8 1 9 2 10 3 11 4 12 5 13 6 14 7 15)
;;
;; (deinterleave-16 (interleave-16 (iota 16)))
;; -->
;; (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)


--
__Pascal Bourguignon__
.

Relevant Pages

  • Re: Rearranging based on permutation of indices
    ... When you have a permutation, you can see it as a bunch of disjoint ... (loop; this loop returns the minimum i ... was in the permutation of the cycle. ... (defun permute-cycle (vector permutation cycle) ...
    (comp.programming)
  • Re: looking for random array reshuffling algorithm
    ... >) based on n and reverse it back to n and is as ... >) chaotic as possible and has a very big cycle period. ... >- A permutation can be subdivided into a number of cycles. ... Right now i use a sequence of pre-defined functions to ...
    (comp.programming)
  • Re: Expected average cycle length...
    ... > in a random permutation of N elements, all N cycle lengths are ... Using the first definition, for the case of S4, you get 1.92. ... To me, the second definition seems more reasonable, since we want to know ...
    (sci.crypt)
  • Re: Expected average cycle length...
    ... > random permutation of the M-bit vectors, ... > cycle lengths are equally likely. ... First, only one permutation has ... the expected cycle length on 4 elements is 2.875. ...
    (sci.crypt)
  • Re: "Interleave" permutation algorithm?
    ... ;;; the wanted interleave and deinterleave algorithms are generated. ... the time complexity stays the same since all the generating ... (defun execute-cycle-swaps (cycle vector) ... (elt vector (second cycle)))) ...
    (comp.programming)