From 45be3aa8d2469c8ca10097a178b0c026b9eb3cea Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sat, 3 Feb 2024 23:33:29 +0000 Subject: [PATCH] utils/permute.lisp (demonstrate-permutation-network): : Print nice diagrams. Delete the ones in the commentary again. --- utils/permute.lisp | 231 +++++++++++++++++++---------------------------------- 1 file changed, 81 insertions(+), 150 deletions(-) diff --git a/utils/permute.lisp b/utils/permute.lisp index b41b4d46..ee81bb36 100644 --- a/utils/permute.lisp +++ b/utils/permute.lisp @@ -210,47 +210,88 @@ (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. @@ -637,62 +678,7 @@ (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 @@ -702,62 +688,7 @@ (: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 -- 2.11.0