(49G) Spectral Test for LCPRNG
07-04-2015, 11:38 AM (This post was last modified: 06-15-2017 01:42 PM by Gene.)
Post: #1
 Gerald H Senior Member Posts: 1,452 Joined: May 2014
(49G) Spectral Test for LCPRNG
The programme STEST implements the spectral test for efficacy of LCPRNG presented in

Knuth: Seminumerical Algorithms, beginning at section 3.3.4, 3rd edition, 1998.

The programme takes three parameters, two integers stored in m, the modulus, & multiplier in a, eg

m = 339149426196985951

a = 967494892105817999

The third parameter is taken from the stack, an integer setting the number of dimensions of accuracy to be determined, from two upwards. Six should normally suffice.

For 6 the m & a above return

{ { 967494892105817999 339149426196985951 } "PASS" 305838803583608674 "PASS" 199091765810 "PASS" 519004521 "PASS" 3237231 "PASS" 229982 }

stored in STRES, indicating they are a good choice.

STEST has four sub-programmes, see below.

STEST

Code:
 ::   CK1&Dispatch   BINT1   ::     ID a     DUPTYPEZINT?     NcaseTYPEERR     ID m     DUPTYPEZINT?     NcaseTYPEERR     DUP     FPTR2 ^ZSQ_     3UNROLL     DOCLLCD     "m="     OVER     FPTR2 ^Z>S     &$BIGDISPROW1 "a=" 3PICK FPTR2 ^Z>S &$     BIGDISPROW2     4ROLL     COERCE     BINT2     #MAX     BINT8     #MIN     BINT2     4PICK     DUPDUP     FPTR2 ^ZSQ_     Z1_     FPTR2 ^QAdd     6PICK     ZINT1_0_     BINT11     NDUPN     BINT10     #+     ROMPTR B0 DE     BEGIN     14GETLAM     DUP     17GETLAM     FPTR2 ^ZQUOText     DUP     11PUTLAM     17GETLAM     FPTR2 ^QMul     FPTR2 ^QSub     12GETLAM     11GETLAM     13GETLAM     FPTR2 ^QMul     ID x010     WHILE     ::       15PUTLAM       17GETLAM       14PUTLAM       10GETLAM       17PUTLAM       13GETLAM       12PUTLAM       9GETLAM       13PUTLAM     ;     REPEAT     DROP     10GETLAM     17GETLAM     FPTR2 ^QSub     9GETLAM     13GETLAM     ID x010     ITE     ::       15PUTLAM       10GETLAM       14PUTLAM       9GETLAM       12PUTLAM     ;     DROP     ID x00B     17GETLAM     FPTR2 ^RNEGext     13GETLAM     14GETLAM     FPTR2 ^RNEGext     12GETLAM     {       BINT2       BINT2     }     BINT4     FPTR2 ^XEQ>ARRAY1     8PUTLAM     12GETLAM     14GETLAM     13GETLAM     FPTR2 ^RNEGext     17GETLAM     FPTR2 ^RNEGext     {       BINT2       BINT2     }     BINT4     FPTR2 ^XEQ>ARRAY1     12GETLAM     Z0_     Z>     IT     FPTR2 ^MATCHS     7PUTLAM     BEGIN     18GETLAM     19GETLAM     #<     WHILE     ::       18GETLAM       #1+       18PUTLAM       21GETLAM       16GETLAM       FPTR2 ^QMul       20GETLAM       FPTR2 ^ZMod       16PUTLAM       8GETLAM       Z0_       18GETLAM       #1-       NDUPN       TYPEMATRIX_       COMPN_       18GETLAM       FPTR2 ^INSERTCOL[]       16GETLAM       FPTR2 ^RNEGext       Z0_       18GETLAM       #2-       NDUPN       Z1_       SWAP       #2+       TYPEMATRIX_       COMPN_       18GETLAM       FPTR2 ^INSERTROW[]       8PUTLAM       7GETLAM       DUPINCOMP       #1+_ONE_DO       ISTOP@       #1-       ROLL       CARCOMP       DUP       16GETLAM       FPTR2 ^QMul       20GETLAM       ID x00A       11PUTLAM       16GETLAM       FPTR2 ^QMul       11GETLAM       20GETLAM       FPTR2 ^QMul       FPTR2 ^QSub       11GETLAM       DUPINDEX@       18GETLAM       8GETLAM       5ROLL       FPTR2 ^MATRIXRCIJ       8PUTLAM       LOOP       18GETLAM       #1-       TYPEMATRIX_       COMPN_       18GETLAM       FPTR2 ^INSERTCOL[]       Z0_       18GETLAM       #1-       NDUPN       20GETLAM       SWP1+       TYPEMATRIX_       COMPN_       18GETLAM       FPTR2 ^INSERTROW[]       7PUTLAM       15GETLAM       8GETLAM       18GETLAM       FPTR2 ^MATRIX-ROW       SWAPDROP       ID x011       FPTR2 ^ZNMin       15PUTLAM       18GETLAM       4PUTLAM       BINT1       6PUTLAM       BEGIN       6GETLAM       4GETLAM       #<>       WHILE       ::         18GETLAM         #1+_ONE_DO         INDEX@         6GETLAM         #=?SKIP         ::           7GETLAM           DUPINDEX@           FPTR2 ^MATRIX-ROW           SWAPDROPSWAP           6GETLAM           FPTR2 ^MATRIX-ROW           SWAPDROP           DUPUNROT           FPTR2 ^XYext           SWAP           ID x011           2DUPSWAP           FPTR2 ^ZAbs           DUP           FPTR2 ^QAdd           Z>           case2DROP           ID x00A           11PUTLAM           6GETLAM           DUPINDEX@           7GETLAM           11GETLAM           FPTR2 ^RNEGext           FPTR2 ^MATRIXRCIJ           7PUTLAM           INDEX@           DUP           6GETLAM           8GETLAM           11GETLAM           FPTR2 ^MATRIXRCIJ           DUP           8PUTLAM           6GETLAM           FPTR2 ^MATRIX-ROW           SWAPDROP           ID x011           15GETLAM           FPTR2 ^ZNMin           15PUTLAM           6GETLAM           4PUTLAM         ;         LOOP         6GETLAM         18GETLAM         #=ITE         BINT1         ::           6GETLAM           #1+         ;         6PUTLAM       ;       REPEAT       Z0_       18GETLAM       NDUPN       TYPEMATRIX_       COMPN_       DUP       5PUTLAM       3PUTLAM       18GETLAM       4PUTLAM       7GETLAM       INNERCOMP       ZERO_DO       ID x011       15GETLAM       FPTR2 ^QMul       22GETLAM       FPTR2 ^ZQUOText       FPTR2 ^ZSQRT       DROP       18GETLAM       UNROLL       LOOP       18GETLAM       TYPEMATRIX_       COMPN_       2PUTLAM       BEGIN       5GETLAM       4GETLAM       FPTR2 ^PULLEL[S]       4GETLAM       SWAP       2GETLAM       4GETLAM       NTHCOMPDROP       OVER       Z<>       ITE       ::         Z1_         FPTR2 ^QAdd         SWAPROT         FPTR2 ^BANGARRY         5PUTLAM         3GETLAM         8GETLAM         4GETLAM         FPTR2 ^MATRIX-ROW         SWAPDROP         FPTR2 ^VADD         3PUTLAM         BEGIN         4GETLAM         #1+         DUP4PUTLAM         18GETLAM         #<=_         WHILE         ::           5GETLAM           4GETLAM           2GETLAM           4GETLAM           NTHCOMPDROP           DUP4UNROLL           FPTR2 ^RNEGext           SWAPROT           FPTR2 ^BANGARRY           5PUTLAM           3GETLAM           SWAPDUP           FPTR2 ^RADDext           8GETLAM           4GETLAM           FPTR2 ^MATRIX-ROW           SWAPDROPSWAP           FPTR2 ^MAT*SCL           FPTR2 ^VSUB           3PUTLAM         ;         REPEAT         4GETLAM         18GETLAM         #>         NOT?SEMI         15GETLAM         3GETLAM         ID x011         FPTR2 ^ZNMin         15PUTLAM       ;       3DROP       4GETLAM       #1-       DUP4PUTLAM       #0=       UNTIL       ID x00B     ;     REPEAT     19GETLAM     #1-     #2*     {}N     21GETLAM     20GETLAM     TWO{}N     >HCOMP     ABND     '     ID STRES     ?STO_HERE     SetDAsTemp   ; ; x00A ::   DUPUNROT   FPTR2 ^ZDIVext   DUP   FPTR2 ^QAdd   ROT   FPTR2 ^ZQUOText   FPTR2 ^QAdd ; x00B ::   "N"   18GETLAM   #:>$&$   15GETLAM   FPTR2 ^Z>R   %SQRT   %2   BINT30   18GETLAM   #/   SWAPDROP   FPTR2 ^RP#   %<   ITE   "FAIL"   "PASS"   DUPUNROT   &\$   18GETLAM   #1+   BIGDISPN   15GETLAM ; x010 ::   FPTR2 ^QSub   2DUP   9PUTLAM   10PUTLAM   FPTR2 ^ZSQ_   SWAP   FPTR2 ^ZSQ_   FPTR2 ^QAdd   DUP   15GETLAM   Z< ; x011 ::   INNERCOMP   Z0_   SWAP   ZERO_DO   SWAP   FPTR2 ^ZSQ_   FPTR2 ^RADDext   LOOP ;
 « Next Oldest | Next Newest »

User(s) browsing this thread: 1 Guest(s)