Верхняя граница генератора случайных чисел

Это на самом деле следующий вопрос предыдущего: округление двойной точности до одинарной точности: форсирование верхней границы

После того, как я решил, что решение моих проблем было ответом на предыдущий вопрос, я снова попытался запустить свою программу и обнаружил, что у меня та же проблема.

Используемая мной реализация Mersenne Twister генерирует случайное целое число со знаком 32 бита. Парень, который реализовал ГСЧ, сделал эту функцию для генерации случайного числа с плавающей запятой двойной точности в диапазоне [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

И это работает безупречно, поэтому, следуя предложению в предыдущем вопросе, я использовал следующую функцию для генерации случайного числа с плавающей запятой одинарной точности, в диапазоне, который я считал равным [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

Однако я получил ту же ошибку, что и раньше, вызванную номером 1.0. Поэтому я написал небольшую программу, чтобы показать, что мой genrand_real действительно генерирует 1.0, и обнаружил, что я был прав, и что 1.0 генерируется. Это приводит к тому, что способ, которым я использую для генерации целое число в диапазоне [1,MAX] (в этом примере [1,5]), не может генерировать значение MAX+1, среди прочих неудобств в коде, над которым я работаю.

  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

Мой вопрос: почему это работает для двойной точности, а не для поплавка одинарной точности? Я не вижу причин, по которым он может потерпеть неудачу, так как 2**32 помещается в поплавок одинарной точности. Кроме того, что я должен сделать, чтобы это исправить? Я думал о делении числа на 2,0**32+1 вместо 2,0**32, но я не уверен, что это теоретически правильно и что числа будут одинаковыми.

2 ответа

Решение

Я не уверен, стоит ли размещать этот ответ на старый вопрос или здесь. В любом случае у меня может быть решение (во втором кодовом блоке).

Процедура, которую я использовал для той же задачи около двух лет назад, такова:

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

Я забыл, откуда код, и всегда, хотя он прост, но есть тонкая хитрость, которую я понял только сейчас. Очевидным отличием является умножение вместо деления, но это только потому, что умножать с фиксированным числом быстрее, чем делить (0,2328306e-9 = 1 / 4294967296).
Хитрость в том, что это не совсем так. 1 / 4294967296 = 0,23283064365386962890625e-9, поэтому программа использует менее значимые цифры, чем могла бы иметь двойная точность (15, в то время как используется только 7). Если вы увеличите количество цифр, результирующее число станет ближе к 1 и станет ровно единицей при последующем преобразовании. Вы можете попробовать это: если вы используете только еще одну цифру, она начинает давать сбой ( = 1,0). По-видимому, это решение в некотором роде взломано, поэтому я также попробовал другой подход, передискретизируя, если результат равен 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

Я написал программу, которая тестирует функции (модуль, который содержит функции и подпрограммы, находится в конце поста, он относительно длинный):

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

В результате чего genrand_real часто терпит неудачу ( = 1,0) (мы говорим каждые несколько миллионов цифр), в то время как другие два до сих пор никогда не терпели неудачу. Версия рекурсии стоит вашего времени, но технически лучше, потому что максимально возможное число ближе к 1.

Я также проверил скорость и "равномерность" и по сравнению с внутренней random_number подпрограмма, которая также дает равномерные случайные числа в [0,1). (Осторожно, это создает файлы размером 3 x 512 МБ)

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

Результаты всегда одинаковы в принципе, хотя время различается:

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 работает быстрее, чем resample_uniran, который работает быстрее, чем собственный (хотя это в значительной степени зависит от PRNG, твистер Мерсенна будет медленнее, чем собственный).

Я также посмотрел на вывод, который обеспечивает каждый метод (с 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()

Все три гистограммы выглядят очень хорошо визуально, но наибольшее значение выявляет недостатки uniran:

uniran:
0.999999880790710
resample uniran:
0.999999940395355
intrinsic:
0.999999940395355

Я запускал это пару раз, и результат всегда одинаков. resample_uniran и внутренние имеют то же самое высокое значение, в то время как uniranЭто тоже всегда то же самое, но ниже. Я хотел бы иметь какой-то надежный статистический тест, который показывает, насколько равномерным является результат на самом деле, но, пробуя тест Андерсона-Дарлинга, тест Кейпера и тест Колмогорова-Смирнова, я столкнулся с этой проблемой. По сути, чем больше у вас сэмплов, тем выше вероятность того, что тесты обнаружат что-то не так с выводом. Может быть, нужно сделать что-то подобное, но я пока не дошел до этого.

Для полноты 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

Я вообще не знаю Фортрана, но попробую что-то вроде этого:

function genrand_real()
  real genrand_real, r
  integer genrand_int32
  r = real(IAND(genrand_int32(), 16777215))
  genrand_real = r / 16777216.0
  return
end

Я рискую исказить тонкости округления с плавающей точкой на языке, который я не знаю, но все равно попробую...

Ваша проблема в том, что вы пытаетесь втиснуть слишком много битов в мантиссу 32-битного значения с плавающей точкой. Это вызывает проблемы округления, которые могут выдвинуть значение слишком близко к 1.0 к точно 1.0. В то же время это может привести к тому, что значения будут округлены от 0,0, и, поскольку нет ничего меньше 0, чтобы округлить до 0, у вас остается меньше шансов получить 0,0.

Если вы попытаетесь решить эту проблему, используя 32-битный код и подстроить масштабный коэффициент, чтобы безопасно довести его до значения ниже 1,0, вы все равно столкнетесь с проблемой неравномерного распределения. Но если вы фиксируете диапазон в целочисленном пространстве, используя только столько бит, сколько вы можете точно представить (24 бита для 32-разрядного числа с плавающей запятой), тогда вам не нужно беспокоиться о том, что значения округляются в большую или меньшую сторону несбалансированным образом.,

Другие вопросы по тегам