(stream *standard-output*))
"Print, on STREAM, a demonstration of the permutation STEPS.
- Begin, on the left, with the integers from 0 up to N - 1. For each
- (SHIFT . MASK) element in STEPS, print an additional column showing the
- effect of that step on the vector. If REFERENCE is not nil, then it
- should be a vector of length at least N: on the right, print the REFERENCE
- vector, showing where the result of the permutation STEPS differs from the
- REFERENCE. Return non-nil if the output matches the reference; return nil
- if the output doesn't match, or no reference was supplied."
-
- (let ((v (make-array n)))
-
- ;; Initialize a vector of lists which will record, for each step in the
- ;; permutation network, which value is in that position. The lists are
- ;; reversed, so the `current' value is at the front.
- (dotimes (i n) (setf (aref v i) (cons i nil)))
-
- ;; Work through the permutation steps updating the vector.
- (dolist (step steps)
- (let ((shift (car step)) (mask (cdr step)))
-
- (dotimes (i n) (push (car (aref v i)) (aref v i)))
+ The output is intended to be useful to human readers and is subject to
+ change. Currently, it prints a sequence of diagrams on STREAM. The left
+ hand side of each row shows a map of which bits are affected: `-' means
+ that the bit remains in the same position, `*' means that it moves
+ forward, and `#' means that it moves back; each `*' pairs with the
+ earliest unpaired `#' marker. The right hand side shows the arrangement
+ of the original input bits.
+
+ If REFERENCE is not nil, then print a final pair of diagrams. This time,
+ the map shows `-' for correct bits and `x' for incorrect ones, with the
+ right hand side showing the expected arrangement of input bits.
+
+ The function returns non-nil if the STEPS resulted in the REFERENCE
+ permutation, and nil if either the STEPS are incorrect or no REFERENCE was
+ provided."
+
+ (flet ((apply-step (shift mask v)
+ (dotimes (k n)
+ (when (logbitp k mask)
+ (rotatef (aref v k) (aref v (+ k shift)))))))
+
+ (let* ((v (identity-permutation n))
+ (end (or reference
+ (let ((e (identity-permutation n)))
+ (dolist (step steps e)
+ (let ((shift (car step)) (mask (cdr step)))
+ (apply-step shift mask e))))))
+ (end-inv (invert-permutation end))
+ (mapwd (ceiling (sqrt n)))
+ (ixwd (length (format nil "~D" (1- n)))))
+
+ (flet ((show-stage (shift mask v)
+ (do ((i 0 (+ i mapwd)))
+ ((>= i n))
+ (write-string ";; " stream)
+ (dotimes (j mapwd)
+ (let ((k (+ i j)))
+ (when (plusp j) (write-char #\space stream))
+ (write-char (cond ((>= k n)
+ #\space)
+ ((logbitp k mask)
+ #\*)
+ ((and (>= k shift)
+ (logbitp (- k shift) mask))
+ #\#)
+ (t
+ #\-))
+ stream)))
+ (write-string " | " stream)
+
+ (fresh-line)
+ (show-stage 0 0 v)
- (dotimes (i n)
- (when (logbitp i mask)
- (rotatef (car (aref v i))
- (car (aref v (+ i shift))))))))
+ (dolist (step steps)
+ (let ((shift (car step)) (mask (cdr step)))
+ (apply-step shift mask v)
+ (format stream ";;~%")
+ (show-stage shift mask v)))
- ;; Print the result.
- (let ((ok (not (null reference))))
- (dotimes (i n)
- (let* ((entry (aref v i))
- (final (car entry)))
- (format stream "~{ ~7D~}" (reverse entry))
+ (let ((ok (not (null reference))))
(when reference
- (let* ((want (aref reference i))
- (match (eql final want)))
- (format stream " ~:[/=~;==~] ~7D" match want)
- (unless match (setf ok nil))))
- (terpri stream)))
- (when reference
- (format stream "~:[FAIL~;pass~]~%" ok))
- ok)))
+ (format stream ";;~%")
+ (do ((i 0 (+ i mapwd)))
+ ((>= i n))
+ (write-string ";; " stream)
+ (dotimes (j mapwd)
+ (let ((k (+ i j)))
+ (when (plusp j) (write-char #\space stream))
+ (write-char (cond ((>= k n) #\space)
+ ((/= (aref v k) (aref reference k)) #\x)
+ (t #\-))
+ stream)))
+ (write-string " | " stream)
+ (dotimes (j (min mapwd (- n i)))
+ (let ((k (+ i j)))
+ (when (plusp j) (write-char #\space stream))
+ (format stream "~vD" ixwd (aref reference k))))
+ (terpri))
+ (unless (every #'= v reference)
+ (setf ok nil))
+ (format stream "~:[FAIL~;pass~]~%" ok))
+ ok)))))
;;;--------------------------------------------------------------------------
;;; Beneš networks.
(lambda (x) (- 64 x))
(reverse ip)))
- ;; The traditional network. (Exchange each `*' with the earliest
- ;; available `#'.)
- ;;
- ;; - - - - - - - - 0 1 2 3 4 5 6 7
- ;; - - - - - - - - 8 9 10 11 12 13 14 15
- ;; - - - - - - - - 16 17 18 19 20 21 22 23
- ;; - - - - - - - - 24 25 26 27 28 29 30 31
- ;; - - - - - - - - 32 33 34 35 36 37 38 39
- ;; - - - - - - - - 40 41 42 43 44 45 46 47
- ;; - - - - - - - - 48 49 50 51 52 53 54 55
- ;; - - - - - - - - 56 57 58 59 60 61 62 63
- ;;
- ;; * * * * - - - - 36 37 38 39 4 5 6 7
- ;; * * * * - - - - 44 45 46 47 12 13 14 15
- ;; * * * * - - - - 52 53 54 55 20 21 22 23
- ;; * * * * - - - - 60 61 62 63 28 29 30 31
- ;; - - - - # # # # 32 33 34 35 0 1 2 3
- ;; - - - - # # # # 40 41 42 43 8 9 10 11
- ;; - - - - # # # # 48 49 50 51 16 17 18 19
- ;; - - - - # # # # 56 57 58 59 24 25 26 27
- ;;
- ;; * * - - * * - - 54 55 38 39 22 3 26 7
- ;; * * - - * * - - 62 63 46 47 30 11 34 15
- ;; - - # # - - # # 52 53 36 37 20 1 24 5
- ;; - - # # - - # # 60 61 44 45 28 19 22 13
- ;; * * - - * * - - 50 51 34 35 18 9 12 3
- ;; * * - - * * - - 58 59 42 43 26 17 20 11
- ;; - - # # - - # # 48 49 32 33 16 7 10 1
- ;; - - # # - - # # 56 57 40 41 24 5 28 9
- ;;
- ;; * - * - * - * - 63 55 47 39 21 13 35 7
- ;; - # - # - # - # 62 54 46 38 20 12 34 6
- ;; * - * - * - * - 61 53 45 37 29 11 23 5
- ;; - # - # - # - # 60 52 44 36 28 10 22 4
- ;; * - * - * - * - 59 51 43 35 17 19 21 3
- ;; - # - # - # - # 58 50 42 34 16 18 20 2
- ;; * - * - * - * - 57 49 41 33 15 7 29 1
- ;; - # - # - # - # 56 48 40 32 14 6 28 0
- ;;
- ;; * * * * * * * * 60 52 44 36 28 20 12 4
- ;; - - - - - - - - 62 54 46 38 30 22 14 6
- ;; - - - - - - - - 61 53 45 37 29 21 13 5
- ;; # # # # # # # # 63 55 47 39 31 23 15 7
- ;; * * * * * * * * 56 48 40 32 24 16 8 0
- ;; - - - - - - - - 58 50 42 34 26 18 10 2
- ;; - - - - - - - - 57 49 41 33 25 17 9 1
- ;; # # # # # # # # 59 51 43 35 27 19 11 3
- ;;
- ;; * * * * * * * * 57 49 41 33 25 17 9 1
- ;; * * * * * * * * 59 51 43 35 27 19 11 3
- ;; - - - - - - - - 61 53 45 37 29 21 13 5
- ;; - - - - - - - - 63 55 47 39 31 23 15 7
- ;; - - - - - - - - 56 48 40 32 24 16 8 0
- ;; - - - - - - - - 58 50 42 34 26 18 10 2
- ;; # # # # # # # # 60 52 44 36 28 20 12 4
- ;; # # # # # # # # 62 54 46 38 30 22 14 6
+ ;; The traditional network.
(trad-network
(make-permutation-network
64 ; 5 4 3 2 1 0
(:exchange-invert 3 4) ; ~2 0 1 ~5 ~4 ~3
(:exchange-invert 4 5)))) ; ~0 2 1 ~5 ~4 ~3
- ;; The new twizzle-optimized network. (Exchange each `*' with the
- ;; earliest available `#'.)
- ;;
- ;; - - - - - - - - 0 1 2 3 4 5 6 7
- ;; - - - - - - - - 8 9 10 11 12 13 14 15
- ;; - - - - - - - - 16 17 18 19 20 21 22 23
- ;; - - - - - - - - 24 25 26 27 28 29 30 31
- ;; - - - - - - - - 32 33 34 35 36 37 38 39
- ;; - - - - - - - - 40 41 42 43 44 45 46 47
- ;; - - - - - - - - 48 49 50 51 52 53 54 55
- ;; - - - - - - - - 56 57 58 59 60 61 62 63
- ;;
- ;; * * * * - - - - 36 37 38 39 4 5 6 7
- ;; * * * * - - - - 44 45 46 47 12 13 14 15
- ;; * * * * - - - - 52 53 54 55 20 21 22 23
- ;; * * * * - - - - 60 61 62 63 28 29 30 31
- ;; - - - - # # # # 32 33 34 35 0 1 2 3
- ;; - - - - # # # # 40 41 42 43 8 9 10 11
- ;; - - - - # # # # 48 49 50 51 16 17 18 19
- ;; - - - - # # # # 56 57 58 59 24 25 26 27
- ;;
- ;; * * * * * * * * 48 49 50 51 16 17 18 19
- ;; * * * * * * * * 56 57 58 59 24 25 26 27
- ;; - - - - - - - - 52 53 54 55 20 21 22 23
- ;; - - - - - - - - 60 61 62 63 28 29 30 31
- ;; - - - - - - - - 32 33 34 35 0 1 2 3
- ;; - - - - - - - - 40 41 42 43 8 9 10 11
- ;; # # # # # # # # 36 37 38 39 4 5 6 7
- ;; # # # # # # # # 44 45 46 47 12 13 14 15
- ;;
- ;; - - * * - - * * 48 49 32 33 16 17 0 1
- ;; - - * * - - * * 56 57 40 41 24 25 8 9
- ;; - - * * - - * * 52 53 36 37 20 21 4 5
- ;; - - * * - - * * 60 61 44 45 28 29 12 13
- ;; # # - - # # - - 50 51 34 35 18 19 2 3
- ;; # # - - # # - - 58 59 42 43 26 27 10 11
- ;; # # - - # # - - 54 55 38 39 22 23 6 7
- ;; # # - - # # - - 62 63 46 47 30 31 14 15
- ;;
- ;; - - - - - - - - 48 49 32 33 16 17 0 1
- ;; * * * * * * * * 50 51 34 35 18 19 2 3
- ;; - - - - - - - - 52 53 36 37 20 21 4 5
- ;; * * * * * * * * 54 55 38 39 22 23 6 7
- ;; # # # # # # # # 56 57 40 41 24 25 8 9
- ;; - - - - - - - - 58 59 42 43 26 27 10 11
- ;; # # # # # # # # 60 61 44 45 28 29 12 13
- ;; - - - - - - - - 62 63 46 47 30 31 14 15
- ;;
- ;; * - * - * - * - 57 49 41 33 25 17 9 1
- ;; * - * - * - * - 59 51 43 35 27 19 11 3
- ;; * - * - * - * - 61 53 45 37 29 21 13 5
- ;; * - * - * - * - 63 55 47 39 31 23 15 7
- ;; - # - # - # - # 56 48 40 32 24 16 8 0
- ;; - # - # - # - # 58 50 42 34 26 18 10 2
- ;; - # - # - # - # 60 52 44 36 28 20 12 4
- ;; - # - # - # - # 62 54 46 38 30 22 14 6
+ ;; The new twizzle-optimized network.
(new-network
(make-permutation-network
64 ; 5 4 3 2 1 0
~mdw / catacomb / commitdiff