Artifact 24a628ababc962a053cd2fbfa5d7431d373a3f42ac39c82150465a36cf6fdd2d:
- File
psl-1983/3-1/glisp/permute.old
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 9219) [annotate] [blame] [check-ins using] [more...]
- File
psl-1983/glisp/permute.old
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 9219) [annotate] [blame] [check-ins using]
(FILECREATED " 2-JAN-83 14:20:01" {DSK}PERMUTE.LSP;4 9267 changes to: (FNS HISTO-CREATE HISTO-PEAKS HISTO-ADD) (VARS PERMUTECOMS) previous date: "28-DEC-82 11:32:40" {DSK}PERMUTE.LSP;1) (PRETTYCOMPRINT PERMUTECOMS) (RPAQQ PERMUTECOMS ((GLISPOBJECTS HISTOGRAM PERMUTATION) (VARS PERM3S FOLD3S PERM4S FOLD4S) (FNS ALLPERMS BINLIST BITSHUFFLE COMPOSEBITSHUFFLES DOBITSHUFFLE GENPERMS HISTO-ADD HISTO-CREATE HISTO-PEAKS IDPERM LISTOFC LOG2 NEGINPPERM OUTPERMS PERM-INVERSE) (PROP GLRESULTTYPE BITSHUFFLE DOBITSHUFFLE))) [GLISPOBJECTS (HISTOGRAM (LISTOBJECT (MIN INTEGER) (MAX INTEGER) (TOTAL INTEGER) (COUNTS (LISTOF INTEGER))) PROP ((PEAKS HISTO-PEAKS)) MSG ((CREATE HISTO-CREATE) (+ HISTO-ADD)) ) (PERMUTATION (LISTOF INTEGER) PROP ((LENGTH LENGTH) (INVERSE PERM-INVERSE RESULT PERMUTATION)) MSG ((* COMPOSEBITSHUFFLES RESULT PERMUTATION)) ) ] (RPAQQ PERM3S ((7 3 5 1 6 2 4 0) (7 5 3 1 6 4 2 0) (7 3 6 2 5 1 4 0) (7 5 6 4 3 1 2 0) (7 6 3 2 5 4 1 0))) (RPAQQ FOLD3S ((3 2 1 0 7 6 5 4) (5 4 7 6 1 0 3 2) (6 7 4 5 2 3 0 1))) (RPAQQ PERM4S ((15 7 11 3 13 5 9 1 14 6 10 2 12 4 8 0) (15 11 7 3 13 9 5 1 14 10 6 2 12 8 4 0) (15 7 13 5 11 3 9 1 14 6 12 4 10 2 8 0) (15 11 13 9 7 3 5 1 14 10 12 8 6 2 4 0) (15 13 7 5 11 9 3 1 14 12 6 4 10 8 2 0) (15 13 11 9 7 5 3 1 14 12 10 8 6 4 2 0) (15 7 11 3 14 6 10 2 13 5 9 1 12 4 8 0) (15 11 7 3 14 10 6 2 13 9 5 1 12 8 4 0) (15 7 13 5 14 6 12 4 11 3 9 1 10 2 8 0) (15 11 13 9 14 10 12 8 7 3 5 1 6 2 4 0) (15 13 7 5 14 12 6 4 11 9 3 1 10 8 2 0) (15 13 11 9 14 12 10 8 7 5 3 1 6 4 2 0) (15 7 14 6 11 3 10 2 13 5 12 4 9 1 8 0) (15 11 14 10 7 3 6 2 13 9 12 8 5 1 4 0) (15 7 14 6 13 5 12 4 11 3 10 2 9 1 8 0) (15 11 14 10 13 9 12 8 7 3 6 2 5 1 4 0) (15 13 14 12 7 5 6 4 11 9 10 8 3 1 2 0) (15 13 14 12 11 9 10 8 7 5 6 4 3 1 2 0) (15 14 7 6 11 10 3 2 13 12 5 4 9 8 1 0) (15 14 11 10 7 6 3 2 13 12 9 8 5 4 1 0) (15 14 7 6 13 12 5 4 11 10 3 2 9 8 1 0) (15 14 11 10 13 12 9 8 7 6 3 2 5 4 1 0) (15 14 13 12 7 6 5 4 11 10 9 8 3 2 1 0))) (RPAQQ FOLD4S ((7 6 5 4 3 2 1 0 15 14 13 12 11 10 9 8) (11 10 9 8 15 14 13 12 3 2 1 0 7 6 5 4) (13 12 15 14 9 8 11 10 5 4 7 6 1 0 3 2) (14 15 12 13 10 11 8 9 6 7 4 5 2 3 0 1))) (DEFINEQ (ALLPERMS (GLAMBDA (N:INTEGER) (* edited: "27-DEC-82 15:36") (* Generate a list of all permutations of length N. The identity permutation is always the first member of the list.) (RESULT (LISTOF PERMUTATION)) (DECLARE (SPECVARS LST)) (PROG (LST) (IF N>5 (ERROR "TOO MANY PERMUTATIONS!")) (GENPERMS NIL (IDPERM N)) (RETURN LST)))) (BINLIST (GLAMBDA (N,NBITS:INTEGER) (* edited: "28-DEC-82 11:26") (* Convert N to a list of bit values.) (RESULT (LISTOF INTEGER)) (PROG (L I BIT) (I_0) (BIT_1) (WHILE I<NBITS DO (L+_(IF (LOGAND N BIT)=0 THEN 0 ELSE 1)) (I_+1) (BIT_+BIT)) (RETURN L)))) (BITSHUFFLE [LAMBDA (INPUT LST) (* edited: " 6-MAY-82 16:33") (* Compute a bit-shuffle of the input according to the specification list LST. LST gives, for each output bit in order, the input bit from which it comes.) (PROG (RES) (SETQ RES 0) [MAPC LST (FUNCTION (LAMBDA (X) (SETQ RES (IPLUS (IPLUS RES RES) (COND ((NULL X) 0) ((NOT (NUMBERP X)) 1) ((ZEROP (LOGAND INPUT (BITPICK X))) 0) (T 1] (RETURN RES]) (COMPOSEBITSHUFFLES [LAMBDA (FIRST SECOND) (* edited: "23-JUN-82 15:17") (* Compose two bitshuffles to produce a single bitshuffle which is equivalent.) (PROG (L) (COND ((NOT (EQUAL (SETQ L (LENGTH FIRST)) (LENGTH SECOND))) (ERROR))) (RETURN (MAPCAR SECOND (FUNCTION (LAMBDA (X) (COND [(FIXP X) (CAR (NTH FIRST (IDIFFERENCE L X] (T X]) (DOBITSHUFFLE [LAMBDA (INT PERM) (* edited: "27-DEC-82 15:44") (BITSHUFFLE INT PERM]) (GENPERMS [GLAMBDA (PREV,L:(LISTOF INTEGER)) (* edited: "27-DEC-82 15:38") (* Generate all permutations consisting of the list PREV followed by all permutations of the list L. The permutations which are generated are added to the global LST. Called by ALLPERMS.) (GLOBAL LST:(LISTOF PERMUTATION)) (PROG (I TMP N) (IF ~L THEN LST+_PREV (RETURN)) (N_(LENGTH L)) (I_0) (WHILE (I_+1) <=N DO (TMP_(CAR (NTH L I))) (GENPERMS (PREV+TMP) (L - TMP]) (HISTO-ADD (GLAMBDA (H:HISTOGRAM N:INTEGER) (* edited: "30-DEC-82 13:26") (IF N>MAX OR N<MIN THEN (ERROR) ELSE TOTAL_+1 (CAR (NTH COUNTS (N - MIN + 1)))_+1) H)) (HISTO-CREATE (GLAMBDA (H:HISTOGRAM) (* edited: " 2-JAN-83 14:14") (RESULT HISTOGRAM) (* Initialize a histogram.) (TOTAL_0) (COUNTS_(LISTOFC 0 (MAX - MIN + 1))) H)) (HISTO-PEAKS [GLAMBDA (H:HISTOGRAM) (* edited: " 2-JAN-83 14:10") (PROG (THRESH L MX N) (MX_0) (FOR X IN COUNTS (IF X>MX MX_X)) (THRESH_MX/2) (N_MIN) (FOR X IN COUNTS DO (IF X>=THRESH L+_N) N_+1) (RETURN (DREVERSE L]) (IDPERM (GLAMBDA (N:INTEGER) (* edited: "28-DEC-82 11:23") (* Produce an identity permutation of length N.) (RESULT PERMUTATION) (PROG (L (I 0)) (WHILE I<N L+_I I_+1) (RETURN L)))) (LISTOFC (GLAMBDA (C N:INTEGER) (* edited: "28-DEC-82 11:23") (* Make a list of N copies of the constant C.) (RESULT (LISTOF ATOM)) (PROG (I L) (I_0) (WHILE (I_+1) <=N DO L+_C) (RETURN L)))) (LOG2 (GLAMBDA (N:INTEGER) (* edited: "28-DEC-82 11:07") (* Log to the base 2 of an integer, rounded up.) (RESULT INTEGER) (PROG ((I 0) (M 1)) (WHILE M<N DO I_+1 M_+M) (RETURN I)))) (NEGINPPERM (GLAMBDA (N,M:INTEGER) (* edited: "28-DEC-82 11:03") (* Compute the permutation to be applied to the output of a boolean function of N inputs to account for negating the Mth input.) (RESULT PERMUTATION) (PROG (TWON TWOM (I 0) L) (TWON_2^N) (TWOM_2^M) (WHILE I<TWON L+_(IF (LOGAND I TWOM) ~=0 THEN I - TWOM ELSE I+TWOM) I_+1) (RETURN L)))) (OUTPERMS (GLAMBDA (N:INTEGER) (* edited: "28-DEC-82 11:02") (* Create the set of permutations of the set of 2^N outputs corresponding to isomorphisms, i.e., renamings of the N inputs of a boolean function. The identity isomorphism is omitted.) (RESULT (LISTOF PERMUTATION)) (PROG (I TMP RES TWON) (TWON_2^N) (FOR X IN (CDR (ALLPERMS N)) DO (I_0) (TMP_NIL) (WHILE I<TWON DO (TMP+_(DOBITSHUFFLE I X)) (I_+1)) (RES+_TMP)) (RETURN RES)))) (PERM-INVERSE (GLAMBDA (P:PERMUTATION) (* edited: " 2-SEP-82 10:47") (RESULT PERMUTATION) (* edited: " 2-SEP-82 10:44") (* Compute the inverse of a permutation.) (PROG (LST N M (I 0) J PP TMP) (N_P:LENGTH) (WHILE I<N DO (J _ N - 1) (PP_P) [WHILE PP DO (IF (CAR PP)=I THEN LST+_J PP_NIL ELSE TMP-_PP J_-1 (IF ~PP (ERROR] (I_+1)) (RETURN LST)))) ) (PUTPROPS BITSHUFFLE GLRESULTTYPE INTEGER) (PUTPROPS DOBITSHUFFLE GLRESULTTYPE INTEGER) (DECLARE: DONTCOPY (FILEMAP (NIL (2528 9147 (ALLPERMS 2538 . 3071) (BINLIST 3073 . 3528) (BITSHUFFLE 3530 . 4122) ( COMPOSEBITSHUFFLES 4124 . 4654) (DOBITSHUFFLE 4656 . 4799) (GENPERMS 4801 . 5395) (HISTO-ADD 5397 . 5635) (HISTO-CREATE 5637 . 5902) (HISTO-PEAKS 5904 . 6268) (IDPERM 6270 . 6598) (LISTOFC 6600 . 6950) (LOG2 6952 . 7296) (NEGINPPERM 7298 . 7897) (OUTPERMS 7899 . 8504) (PERM-INVERSE 8506 . 9145))))) STOP