问题
This is actually a follow up question of a previous one: Rounding of double precision to single precision: Forcing an upper bound
After what I thought was the solution of my problems with the answer of previous question, I tried running my program again and found that I had the same problem.
The Mersenne Twister implementation I'm using generates a signed 32 bits random integer. The guy who implemented the RNG made this function to generate a random double precision float in the range [0,1):
function genrand_real2()
double precision genrand_real2,r
integer genrand_int32
r=dble(genrand_int32())
if(r.lt.0.d0)r=r+2.d0**32
genrand_real2=r/4294967296.d0
return
end
And it works flawlessly, so following the suggestion in the previous question I used the following function to generate a random single precision float, in the range I thought would be [0,1):
function genrand_real()
real genrand_real, r
integer genrand_int32
r = real(genrand_int32())
if (r .lt. 0.0) r = r + 2.0**32
genrand_real = r / 4294967296.0
return
end
However I got the same error I got before, caused by a 1.0 number. So I wrote a small program to show that my genrand_real actually generates a 1.0, and found that I was right, and the 1.0 is generated. This causes the way I use to generate an integer in the range [1,MAX] (in this example [1,5]) to fail generating a value MAX+1, among other inconveniences along the code I'm working on.
i = 0
do while (.true.)
r = genrand_real()
if (r .gt. 0.99999) then
i = i + 1
print *, 'number is:', r
print *, 'conversion is: ', int(5*r)+1
endif
if (i .gt. tot_large) exit
enddo
My question is, why does it work for the double precision but not for the single precision float? I don't see a reason for it to fail since 2**32 fits in a single precision float. Also, what should I do to fix it? I thought about dividing the number by 2.0**32+1 instead of 2.0**32, but I'm not sure it's theoretically correct and that the numbers would be uniform.
回答1:
I'm unsure on whether to post this answer on the old question or here. In any case, I may have a solution (in the second code-block).
The routine that I have used for the same task since about two years ago is this:
function uniran( )
implicit none
integer, parameter :: dp = selected_real_kind(15, 307)
real(dp) :: tmp
real :: uniran
tmp = 0.5_dp + 0.2328306e-9_dp * genrand_int32( )
uniran = real(tmp)
end function uniran
I forgot where the code is from and always though it's straightforward, but there is a subtle trick to it, which I only now realized. The obvious difference is the multiplication instead of the division, but that's just because it is faster to multiply with a fixed number than to divide (0.2328306e-9 = 1 / 4294967296).
The Trick is: that is not really true. 1 / 4294967296 = 0.23283064365386962890625e-9, so the program uses less significant digits than the double precision could hold (15, while only 7 are used). If you increase the number of digits, the resulting number comes closer to 1 and becomes exactly one during the later conversion. You can try it: if you use just one more digit, it starts to fail ( = 1.0).
Apparently, this solution is somewhat of a hack, so I also tried a different approach, resampling if the result is exactly 1:
recursive function resample_uniran( ) result(res)
implicit none
integer, parameter :: dp = selected_real_kind(15, 307)
real(dp) :: tmp
real :: res
tmp = 0.5_dp + 0.23283064365386962890625e-9_dp * genrand_int32( )
res = real(tmp)
if (res == 1.0) then
res = resample_uniran()
end if
end function resample_uniran
I wrote a program that tests the functions (the module that contains the functions and subroutines is at the end of the post, it's relatively long):
program prng_fail
use mod_prngtest
implicit none
integer(kind=16) :: i, j, k
! loop counters
i = 0
j = 0
k = 0
call init_genrand_int32()
do
i = i + 1
j = j + 1
k = k + 1
if (genrand_real() == 1.0) then
print*, 'genrand_real fails after ', i, ' iterations'
i = 0
end if
if (uniran() == 1.0) then
print*, 'uniran fails after ', j, ' iterations'
j = 0
end if
if (resample_uniran() == 1.0) then
print*, 'resample_uniran fails after ', k, ' iterations'
k = 0
end if
end do
end program prng_fail
With the result that genrand_real fails (= 1.0) often (we're talking every few million numbers), while the other two have so far never failed.
The recursion-version costs you time, but is technically better, because the highest possible number is closer to 1.
I also tested the speed and the "uniformity" and compared to the intrinsic random_number subroutine, that also gives uniform random numbers in [0,1).
(Careful, this creates 3 x 512 MB files)
program prng_uniformity
use mod_prngtest
implicit none
integer, parameter :: n = 2**27
real, dimension(n) :: uniran_array, resamp_array, intrin_array
integer :: array_recl, i
real :: start_time, end_time
call init_genrand_int32()
call init_random_seed()
! first check how long they take to produce PRNs
call cpu_time(start_time)
do i=1,n
uniran_array(i) = uniran()
end do
call cpu_time(end_time)
print*, 'uniran took ', end_time - start_time, ' s to produce ', n, ' PRNs'
call cpu_time(start_time)
do i=1,n
resamp_array(i) = resample_uniran()
end do
call cpu_time(end_time)
print*, 'resamp took ', end_time - start_time, ' s to produce ', n, ' PRNs'
call cpu_time(start_time)
do i=1,n
call random_number(resamp_array(i))
end do
call cpu_time(end_time)
print*, 'intrin took ', end_time - start_time, ' s to produce ', n, ' PRNs'
! then save PRNs into files. Use both() to have the same random
! underlying integers, reducing the difference purely to
! the scaling into the interval [0,1)
inquire(iolength=array_recl) uniran_array
open(11, file='uniran.out', status='replace', access='direct', action='write', recl=array_recl)
open(12, file='resamp.out', status='replace', access='direct', action='write', recl=array_recl)
open(13, file='intrin.out', status='replace', access='direct', action='write', recl=array_recl)
do i=1,n
call both(uniran_array(i), resamp_array(i))
call random_number(intrin_array(i))
end do
write(11, rec=1) uniran_array
write(12, rec=1) resamp_array
write(13, rec=1) intrin_array
end program prng_uniformity
The results are always the same in principle, even though the timings are differnt:
uniran took 0.700139999 s to produce 134217728 PRNs
resamp took 0.737253010 s to produce 134217728 PRNs
intrin took 0.773686171 s to produce 134217728 PRNs
uniran is faster than resample_uniran, which is faster than the intrinsic (although that largely depends on the PRNG, Mersenne twister will be slower than the intrinsic).
I also looked at the output each method provides (with Python):
import numpy as np
import matplotlib.pyplot as plt
def read1dbinary(fname, xdim):
with open(fname, 'rb') as fid:
data = np.fromfile(file=fid, dtype=np.single)
return data
if __name__ == '__main__':
n = 2**27
data_uniran = read1dbinary('uniran.out', n)
print('uniran:')
print('{0:.15f}'.format(max(data_uniran)))
plt.hist(data_uniran, bins=1000)
plt.show()
data_resamp = read1dbinary('resamp.out', n)
print('resample uniran:')
print('{0:.15f}'.format(max(data_resamp)))
plt.hist(data_resamp, bins=1000)
plt.show()
data_intrin = read1dbinary('intrin.out', n)
print('intrinsic:')
print('{0:.15f}'.format(max(data_intrin)))
plt.hist(data_intrin, bins=1000)
plt.show()
All three histograms look very good visually, but the highest value reveals the shortcomings of uniran:
uniran:
0.999999880790710
resample uniran:
0.999999940395355
intrinsic:
0.999999940395355
I ran this a couple of times and the outcome is always identical. resample_uniran and the intrinsic have the same highest value, while uniran's is also always the same, but lower.
I'd like to have some robust statistical test that indicates how uniform the output really is, but while trying the Anderson-Darling test, Kuiper's test and the Kolmogorov-Smirnov test I ran into this problem. Essentially, the more samples you have, the higher the chance is that the tests find something wrong with the output.
Maybe one should do something like this, but I haven't gotten around to that yet.
For completeness, the module:
module mod_prngtest
implicit none
integer :: iseed_i, iseed_j, iseed_k, iseed_n
integer, dimension(4) :: seed
contains
function uniran( )
! Generate uniformly distributed random numbers in [0, 1) from genrand_int32
! New version
integer, parameter :: dp = selected_real_kind(15, 307)
real(dp) :: tmp
real :: uniran
tmp = 0.5_dp + 0.2328306e-9_dp * genrand_int32( )
uniran = real(tmp)
end function uniran
recursive function resample_uniran( ) result(res)
! Generate uniformly distributed random numbers in [0, 1) from genrand_int32
! New version, now recursive
integer, parameter :: dp = selected_real_kind(15, 307)
real(dp) :: tmp
real :: res
tmp = 0.5_dp + 0.23283064365386962890625e-9_dp * genrand_int32( )
res = real(tmp)
if (res == 1.0) then
res = resample_uniran()
end if
end function resample_uniran
recursive subroutine both(uniran, resamp)
integer, parameter :: dp = selected_real_kind(15, 307)
real(dp) :: tmp1, tmp2
integer :: prn
real :: uniran, resamp
prn = genrand_int32( )
tmp1 = 0.5_dp + 0.2328306e-9_dp * prn
uniran = real(tmp1)
tmp2 = 0.5_dp + 0.23283064365386962890625e-9_dp * prn
resamp = real(tmp2)
if (resamp == 1.0) then
call both(uniran, resamp)
end if
end subroutine both
function genrand_real()
! Generate uniformly distributed random numbers in [0, 1) from genrand_int32
! Your version, modified by me earlier
real genrand_real, r
r = real(genrand_int32())
if (r .lt. 0.0) r = r + 2.0**32
genrand_real = r / 4294967296.0
return
end
subroutine init_genrand_int32()
! seed the PRNG, if you don't have /dev/urandom comment out this block ...
open(11, file='/dev/urandom', form='unformatted', access='stream')
read(11) seed
iseed_i=1+abs(seed( 1))
iseed_j=1+abs(seed( 2))
iseed_k=1+abs(seed( 3))
iseed_n=1+abs(seed( 4))
! ... and use this block instead (any integer > 0)
!iseed_i = 1253795357
!iseed_j = 520466003
!iseed_k = 68202083
!iseed_n = 1964789093
end subroutine init_genrand_int32
function genrand_int32()
! From Marsaglia 1994, return pseudorandom integer over the
! whole range. Fortran doesn't have a function like that intrinsically.
! Replace this with your Mersegne twister PRNG
implicit none
integer :: genrand_int32
genrand_int32=iseed_i-iseed_k
if(genrand_int32.lt.0)genrand_int32=genrand_int32+2147483579
iseed_i=iseed_j
iseed_j=iseed_k
iseed_k=genrand_int32
iseed_n=69069*iseed_n+1013904243
genrand_int32=genrand_int32+iseed_n
end function genrand_int32
subroutine init_random_seed()
use iso_fortran_env, only: int64
implicit none
integer, allocatable :: seed(:)
integer :: i, n, un, istat, dt(8), pid
integer(int64) :: t
call random_seed(size = n)
allocate(seed(n))
! First try if the OS provides a random number generator
open(newunit=un, file="/dev/urandom", access="stream", &
form="unformatted", action="read", status="old", iostat=istat)
if (istat == 0) then
read(un) seed
close(un)
else
! Fallback to XOR:ing the current time and pid. The PID is
! useful in case one launches multiple instances of the same
! program in parallel.
call system_clock(t)
if (t == 0) then
call date_and_time(values=dt)
t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 &
+ dt(2) * 31_int64 * 24 * 60 * 60 * 1000 &
+ dt(3) * 24_int64 * 60 * 60 * 1000 &
+ dt(5) * 60 * 60 * 1000 &
+ dt(6) * 60 * 1000 + dt(7) * 1000 &
+ dt(8)
end if
pid = getpid()
t = ieor(t, int(pid, kind(t)))
do i = 1, n
seed(i) = lcg(t)
end do
end if
call random_seed(put=seed)
contains
! This simple PRNG might not be good enough for real work, but is
! sufficient for seeding a better PRNG.
function lcg(s)
integer :: lcg
integer(int64) :: s
if (s == 0) then
s = 104729
else
s = mod(s, 4294967296_int64)
end if
s = mod(s * 279470273_int64, 4294967291_int64)
lcg = int(mod(s, int(huge(0), int64)), kind(0))
end function lcg
end subroutine init_random_seed
end module mod_prngtest
回答2:
I don't know Fortran at all, but try something like this:
function genrand_real()
real genrand_real, r
integer genrand_int32
r = real(IAND(genrand_int32(), 16777215))
genrand_real = r / 16777216.0
return
end
I run the risk of misrepresenting the finer points of floating-point rounding in a language I don't know, but I'll try anyway...
Your problem is that you're trying to squeeze too many bits into the mantissa of a 32-bit floating-point value. This causes roundoff issues which can push a value too near to 1.0 to exactly 1.0. At the same time it can cause values to be rounded away from 0.0, and because there's nothing lower than 0 to get rounded up to 0, it leaves you with a smaller than normal chance of getting 0.0.
If you try to fix the problem by using 32 bits and tweaking the scale factor to bring it in safely below 1.0, then you still face the problem of having a non-uniform distribution. But if you fix the range in the integer space by using only as many bits as you can accurately represent (24 bits for a 32-bit float) then you don't have to worry about values being rounded up or down in an unbalanced way.
来源：https://stackoverflow.com/questions/37859027/upper-bound-of-random-number-generator