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
;
Search
Member List
Calendar
Help
