Post Reply 
(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
(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
;
Find all posts by this user
Quote this message in a reply
Post Reply 




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