(terpri stream)))
(defun demonstrate-permutation-network
- (n steps &optional reference (stream *standard-output*))
+ (n steps
+ &key reference
+ offsets
+ (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."
+ 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 OFFSETS is non-nil, then also print a table of offsets showing how far
+ each bit has yet to move.
+
+ 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)
+
+ (when offsets
+ (dotimes (j mapwd)
+ (let ((k (+ i j)))
+ (when (plusp j) (write-char #\space stream))
+ (cond ((>= k n)
+ (format stream "~v@T" (1+ ixwd)))
+ (t
+ (format stream "~*~[~2:*~vD~:;~2:*~v@D~]"
+ (1+ ixwd)
+ (- (aref end-inv (aref v k)) k))))))
+ (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 v k))))
+ (terpri))))
+
+ (fresh-line)
+ (show-stage 0 0 v)
- (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)))
-
- (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.
(fixed-ip (map '(vector fixnum)
(lambda (x) (- 64 x))
(reverse ip)))
+
+ ;; The traditional network.
(trad-network
(make-permutation-network
64 ; 5 4 3 2 1 0
(:exchange-invert 0 3) ; ~2 ~1 ~0 ~5 ~4 ~3
(: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.
(new-network
(make-permutation-network
64 ; 5 4 3 2 1 0
(let ((benes-network (benes-search fixed-ip)))
(print-permutation-network benes-network)
- (demonstrate-permutation-network 64 benes-network fixed-ip))
+ (demonstrate-permutation-network 64 benes-network :reference fixed-ip))
(terpri)
(print-permutation-network trad-network)
- (demonstrate-permutation-network 64 trad-network fixed-ip)
+ (demonstrate-permutation-network 64 trad-network :reference fixed-ip)
(terpri)
(print-permutation-network new-network)
- (demonstrate-permutation-network 64 new-network fixed-ip))
+ (demonstrate-permutation-network 64 new-network :reference fixed-ip))
#+example
(benes-search-des #( 0 0 0 0