|
Does anyone have a reasonable Pseudo random number routine for RPG? I need something does doesn't rely on any calls to system routines.
Interesting. What's wrong with the system routines?But, as luck would have it, I did write my own random numbr generator. I have no clue how it stacks up to the other ones out there (I never did many tests with it) but it seems to basically work. I have to admit that I haven't used this thing in quite a long time -- I just use the system APIs when I want a random number.
But, since I have one, it's no problem to post it for you to try... if you can use it, great... if not, no harm done.
midrange.com
* A Random Number Generator
* SCK 06/15/1998 at 3:45am
* (Something to do when I can't sleep)
*
* This program accepts up to 2 parameters:
* 1. The random number (11 digit, 9 dec, packed)
* - Will return a random number from 00 - 00.999999999
* 2. (optional) Seed Value (85 Char)
* - Set this on the first call, or every 50 calls or
* so to randomize the output. If you do not give
* a seed value, it will use the system time, but
* will start to repeat after about 55 calls.
*
* Call this program with no parameters to unload it from memory.
*
* NOTE: If you do not call this program with no parms, it will
* remain in memory until the job ends, or a RCLRSC command
* is issued!
*
*
D dsErrCode DS
D dsBytesPrv 1 4I 0 INZ(256)
D dsBytesAvl 5 8I 0 INZ(0)
D dsExcpID 9 15
D dsReserved 16 16
D dsExcpData 17 256
D dsBinVal DS
D dsBinary 1 2I 0 INZ(0)
D dsChar 2 2A
D r S 10I 0 DIM(100)
D i S 10I 0
D j S 10I 0
D k S 10I 0
D t S 10I 0
D wkSeedFlg S 1A INZ(*OFF)
D wkSeed S 85A
D wkBuf S 97A
D wkRandom S 11 0
c *entry plist
c parm peRandom 11 9
c parm peSeed 85
C***********************************************************
C* This program can be called 3 different ways:
C*
C* 1) with only one parm, looking for a random number
C* 2) with two parms, a random number request, and
C* a seed value to seed the generator.
C* 3) with no parms at all, to unload this program
c* from memory.
C*
c* If the program has not yet been seeded, it will use
c* the time as a seed on the first call.
C***********************************************************
c Select
c when %parms = 1 and wkSeedFlg = *OFF
c exsr TimeSeed
c exsr Seed
c exsr Rand
c when %parms = 1
c exsr Rand
c when %parms = 2
c eval wkSeed = peSeed
c exsr Seed
c exsr Rand
c Other
c eval *INLR = *ON
c endSl
c Return
C*===============================================================
C* This subroutine loads the time from the system clock into
c* the seed value, (called when no seed provided by calling pgm)
C*===============================================================
csr TimeSeed begsr
C*-----------------------
C*************************************************
C* This API will return the system time in
C* YYYYMMDDHHMMSSZZZ format, where:
C* YYYYMMDD = System Date
C* HHMMSS = System Time
C* ZZZ = Milliseconds
C*************************************************
c call 'QWCCVTDT'
c parm '*CURRENT' peInpFmt 10
c parm *blanks peInpVar 1
c parm '*YYMD' peOutFmt 10
c parm *zeros peOutput 17
c parm dsErrCode
c if dsBytesAvl > 0
c 'QWCCVTDT' dsply dsExcpID
c eval *INLR = *ON
c Return
c endif
C*************************************************
C* We only use the time & milliseconds in our seed
C*************************************************
c eval wkSeed = %subst(peOutput:9:9)
c*------------------------
c endsr
C*===============================================================
C* This seeds (sets up) the random number generation table.
C*===============================================================
csr Seed begsr
c*------------------------
c eval wkBuf = 'aEbFcGdHeI ' + wkSeed
c do 97 i
c eval dsChar = %subst(wkBuf:i:1)
c eval r(i) = (dsBinary*8171717) + (i*997)
c enddo
c eval i=97
c eval j=12
c do 997 k
c eval r(i) = r(i) - r(j)
c if r(i) < 0
c eval r(i) = r(i) + 1000000000
c endif
c eval i = i - 1
c if i = 0
c eval i = 97
c endif
c eval j = j - 1
c if j = 0
c eval j = 97
c endif
c enddo
c eval r(98) = 55
c eval r(99) = 24
c eval r(100) = 77
c eval wkSeedFlg = *ON
c*------------------------
csr endsr
C*===============================================================
C* This generates the random number, assumes that the seed
c* subroutine was already called.
C*===============================================================
csr Rand begsr
c*------------------------
c eval i = r(98)
c eval j = r(99)
c eval t = r(i) - r(j)
c if t < 0
c eval t = t + 1000000000
c endif
c eval r(i) = t
c eval r(98) = r(98) - 1
c if r(98) = 0
c eval r(98) = 55
c endif
c eval r(99) = r(99) - 1
c if r(99) = 0
c eval r(99) = 55
c endif
c r(100) div 42 wkJunk 10 0
c mvr k
c eval k = k + 56
c eval r(100) = r(k)
c eval r(k) = t
c eval wkRandom = r(100)
c move wkRandom peRandom
c*------------------------
csr endsr
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
